حيل للفيجوال بيسك

كيف تغير هيئة التاريخ القصير في نظام الويندوز.
ربما كنت تحتاج في برنامجك إلي التعامل مع التاريخ بهيئة معينة مثل "dd/MM/yyyy" وتود التأكيد على تلك الهيئة عند فتح البرنامج فهذا هو الكود الذي يؤدي ذلك.

انسخ الكود التالي إلى قسم الـ General في Module أو الـ Form.

Private Declare Function SetLocaleInfo Lib "kernel32" Alias "SetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String) As Long
Private Const LOCALE_IDATE = &H21 ' short date format ordering
Private Const LOCALE_SSHORTDATE = &H1F ' short date format string

Public Sub SetDateFormat(ByVal theFormat As String)
Dim strBuffer As String
Dim Res As Long

strBuffer = theFormat & Chr(0)
Res = SetLocaleInfo(LOCALE_IDATE, LOCALE_SSHORTDATE, strBuffer)
End Sub


هذا مثال على استخدام تلك الدالة

Call SetDateFormat("dd/MM/yyyy")
------------------------------------------

تغلب على قصور دالة IsDate
لو أنك حاولت اختبار التاريخ بدالة IsDate لتعرف إذا ما كان التاريخ صحيح أم لا فإنك ستفاجأ بسلوك غريب لهذة الدالة بفرض أن إعدادات الويندوز تشير إلى أن هيئة التاريخ القصير هي "dd/MM/yyyy" وكنت تختبر التاريخ "26/01/2000" مثلا سترجع لك الدالة True دلالة على أن هذا النص يمكن أن يمثل تاريخ ولو اختبرت النص "01/26/2000" ستفاجأ بنفس النتيجة حيث أن الدالة حولت النص للهيئة السليمة فبل الإختبار وبذلك كانت النتيجة خاطئة بالنسبة لنا
لذلك فقد كتبت هذه الدالة لإختبار التاريخ بشكل صحيح.
ضع الكود التالي في قسم الـ General من Module

Private Type SYSTEMTIME wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Declare Function GetDateFormat Lib "kernel32" Alias "GetDateFormatA" _
(ByVal Locale As Long, ByVal dwFlags As Long, _
lpDate As SYSTEMTIME, ByVal lpFormat As String, ByVal lpDateStr As String, ByVal cchDate As Long) As Long
Private Const LOCALE_IDATE = &H21

Private Sub Main()
If ValidateDate("26/01/2000") Then MsgBox "هذا التاريخ صحيح & "26/01/2000", _
vbMsgBoxRight + vbMsgBoxRtlReading + vbInformation
If Not ValidateDate("01/26/2000") Then MsgBox "هذا التاريخ غير صحيح " & "01/26/2000", _ vbMsgBoxRight + vbMsgBoxRtlReading + vbInformation
End
End Sub

Public Function ValidateDate(theDate As String) As Boolean
Dim cd As SYSTEMTIME
Dim strBuffer As String
Dim Res As Long

cd.wDay = CInt(Left(theDate, 2))
cd.wMonth = CInt(Mid(theDate, 4, 2))
cd.wYear = CInt(Right(theDate, 4))

strBuffer = Space(255)
Res = GetDateFormat(LOCALE_IDATE, 0&, cd, "dd/MM/yyyy", strBuffer, Len(strBuffer))
If Res > 0 Then
ValidateDate = True
End If

End Function
------------------------------------------
تحريك نافذة من أى نقطة.
يمكنك تحريك نافذة من أى نقطة بهذا الكود
هذا الجزء من الكود في قسم الـ General

Private X1 As Integer
Private Y1 As Integer

وهذه الجزء من الكود في حدث Form_MouseMove

If Button = 0 Then
X1 = X
Y1 = Y
End If
If Button = 1 Then
Call Me.Move (Me.Left - (X1 - X), Me.Top - (Y1 - Y))
End If
---------------------------------------------------------------------

كيف تشغل حافظة الشاشة؟

تري هل من الممكن تشغيل حافظة الشاشة الحالية من داخل برنامجك؟ بالطبع نعم ما عليك إلا أن تفح اـ Form وتضع عليها زر ثم تنسخ هذا الكود إلي قسم General من الـ Form .

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Const WM_SYSCOMMAND = &H112&
Private Const SC_SCREENSAVE = &HF140&

Private Sub Command1_Click()
Dim Res As Long
Res = SendMessage(Me.hWnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
End Sub

CTRL+ALT+DEL كيفية ابطال عمل مفاتيح

ويهدف هذا الإجراء إلى منع المستخدم من إغلاق برنامجك أثناء التنفيذ حيث أن الضغط على هذه المفاتيح يمكنه من إنهاء البرنامج أو إنهاء ويندوز بكاملها

ويتم ذلك باستخدام الأسطر التالية

Declarations ضع التعريفين التاليين في قسم التعريفات

Private Declare Function SystemParametersInfo Lib _
"user32" Alias "SystemParametersInfoA" (ByVal uAction _
As Long, ByVal uParam As Long, ByVal lpvParam As Any, _
ByVal fuWinIni As Long) As Long
Sub DisableCtrlAltDelete(bDisabled As Boolean)
Dim X As Long
X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub
لإبطال عمل المفاتيح ضع السطر التالي في المكان المناسب

Call DisableCtrlAltDelete(True)

لإعادة عمل المفاتيح ضع السطر التالي في المكان المناسب

Call DisableCtrlAltDelete(False)
--------------------------------------------
هـل الملف موجود أم لا ؟

قد يحتاج برنامجك في بعض الأحيان أن يعرف عن أحد الملفات كونه موجوداً على القرص أم لا ، يمكن عمل ذلك باستخدام الأسطر التالية :

If Dir(myfilename, vbNormal or vbReadOnly or vbHidden or vbSystem or vbArchive) = "" then
Msgbox "الملف غير موجود"
Else
Msgbox "الملف موجود"
End If

عدل السطور السابقة حسب احتياج برنامجك
--------------------------------------------------------------------------------

تخصيص مفتاح HotKey لصندوق نص

يمكنك تخصيص مفتاح ساخن HotKey لصندوق نص TextBox بالطريقة التالية : أنشيء أداة من نوع Label و ضع لها المفتاح الساخن الذي تريده لصندوق النص ثم عدل خاصية TabIndex لها لتكون أقل بواحد من قيمة نفس الخاصية في صندوق النص ( مثال : إذا كانت قيمة TabIndex لصندوق النص هي 4 فاجعل قيمتها للأداة من نوع Label الرقم 3 )
--------------------------------------------------------------------------------

كيف تجعل النص يظهر بشكل عمودي في الأداة Label

يمكن عمل ذلك باستخدام الرمز vbCrLf ، حيث يوضع بعد كل حرف في محتوى الأداة Label كما يلي :

Private Sub Form_Activate()
Dim s As String
For i = 1 To Len(Label1)
s = s & Mid$(Label1, i, 1) & vbCrLf
Next
Label1 = s
End Sub
--------------------------------------------------------------------------------

كيفية إغلاق ويندوز من داخل البرنامج أو إعادة تشغيلها

قد تحتاج في بعض البرامج أن تقوم بإعادة تشغيل ويندوز بعد قيام المستخدم بتعديل بعض الخيارات أو لدواع أمنية أو غير ذلك

لعمل ذلك ألصق الأسطر التالية في قسم التعريفات من برنامجك

Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Declare Function ExitWindowsEx Lib "user32" Alias _
"ExitWindowsEx" (ByVal uFlags As Long, ByVal dwReserved _
As Long) As Long

وفي المكان المناسب ، ضع السطر التالي و الذي يقوم بإغلاق ويندوز

t& = ExitWindowsEx(EWX_REBOOT, 0)

EWX_REBOOT و يلاحظ أنه يمكن وضع أي من المتغيرات الموجودة أعلاه بدلاً من
---------------------------------------------------

تحديد النص في صندوق النص ذاتياً

تلاحظ في بعض البرامج عند انتقال التركيز من أداة ما على النافذة إلى صندوق نص يحتوي على نص فإنه يتم تحديد النص ذاتياً ، للحصول على ذلك في برنامجك قم بكتابة النص التالي في المكان المناسب ليتم تحديد النص

Text1.SelStart = 0
Text1.SelLength = Len(Text1)
--------------------------------------------------

إخفاء مؤشر الفأرة في تطبيق فيجوال بيسك

تستطيع إخفاء مؤشر الفأرة في موضع معين من برنامجك باستخدام الدالة ShowCursor و التي يتم تعريفها في قسم التعريفات أعلى البرنامج لأنها من دوال واجهة برمجة التطبيقات API على النحو التالي :

Private Declare Function ShowCursor Lib "user32" _
(ByVal bShow As Long) As Long


ومن ثم تستطيع اخفاء المؤشر بتنفيذ الدالة بالشكل التالي

x = ShowCursor(False)

و تستطيع إعادة إظهار المؤشر بتنفيذ الدالة بالشكل التالي

x = ShowCursor(True)
-------------------------------------------------

هل يحتوي مشغل الأقراص المدمجة على قرص أم لا ؟؟

تستطيع من خلال إضافة السطور التالية إلى برنامجك تحديد ما إذا كان مشغل الأقراص المدمجة يحتوي على قرص أم لا

Dim FSO As FileSystemObject
Dim aDrive As Drive
Set FSO = New FileSystemObject
For Each aDrive In FSO.Drives
If aDrive.DriveType = CDRom And aDrive.IsReady = False Then
MsgBox "لا يوجد قرص في المشغل"
Exit For
ElseIf aDrive.DriveType = CDRom Then
MsgBox aDrive.VolumeName
Exit For
End If
Next
Set FSO = Nothing
---------------------------------------------

تحديد ما إذا كان تاريخان في نفس الشهر أم لا

تستطيع أن تحدد في برنامجك ما إذا كان تاريخان مدخلان يقعان في نفس الشهر أم لا باستخدام الدالة DateDiff

المثال التالي يوضح كيفية ذلك

Date1 = "01/02/1999"

Date2 = "15/02/1999"

If DateDiff("m", Date1, Date2) Then
MsgBox "التاريخان في شهرين مختلفين"
Else
MsgBox "التاريخان في نفس الشهر"
End If
-----------------------------------------------

تحديد دقة عرض الشاشة في جهاز المستخدم

تستطيع من خلال أسطر بسيطة تضيفها إلى برنامجك أن تحدد دقة عرض الشاشة في جهاز المستخدم وذلك كما يلي

Dim x,y As Integer
x = Screen.Width / 15
y = Screen.Height / 15
If x = 640 And y = 480 Then MsgBox ("640 * 480")
If x = 800 And y = 600 Then MsgBox ("800 * 600")
If x = 1024 And y = 768 Then MsgBox ("1024 * 768")