أكواد فجول بيسك8

لإنهاء صلاحيات برنامجك التجريبي بعد30 يوماً فقط

Dim startdate As String
Dim differenceofdate
Dim TRACEDATE As String
Dim newdate
Dim chk

If GetSetting(App.Title, "Startup", "counter", "") = "" Then
SaveSetting App.Title, "Startup", "counter", 1
SaveSetting App.Title, "Startup", "Started", Format(Date, "mm dd yyyy")
SaveSetting App.Title, "Startup", "Last Used", Format(Date, "mm dd yyyy")
lblcnt.Caption = "1"

ElseIf GetSetting(App.Title, "Startup", "counter", "") = "31" Then

MsgBox "شكراً لستخدامك هذا البرنامج " & Chr(10) + Chr(1) & "الرجاء إيقاف عمل هذا البرنامج او سيتم فقدان كل المعلومات التي قمت بإدخالها ", vbCritical, "شكراً لك "

End

Else
TRACEDATE = GetSetting(App.Title, "Startup", "Last Used", "")
chk = DateDiff("d", CDate(TRACEDATE), Now)
If chk < 0 Then 'CHECK IF THE DATE WAS CHANGE which is lesser than the PREVIOUS DATE WHERE THE SYSTEM USED.

MsgBox "لم يتم العثور على تاريخ النظام لديك !! " & Chr(10) + Chr(13) & " الرجاء تغييرة الأن وإلا لن يكون بإمكانك إستخدام هذا البرنامج لاحقاً", vbCritical, "تاريخ مفقود"

End
Else
startdate = GetSetting(App.Title, "Startup", "Started", "")
differenceofdate = DateDiff("d", startdate, Now)
If differenceofdate <> 0 Then
lblcnt.Caption = differenceofdate + 1
SaveSetting App.Title, "Startup", "Last Used", Format(Now, "MM DD YYYY")
SaveSetting App.Title, "Startup", "counter", differenceofdate + 1
End If
If differenceofdate = 0 Then
lblcnt.Caption = GetSetting(App.Title, "Startup", "Counter", "")
End If
End If
End If
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
لتبديل أزرار الفأرة

Const SPI_SETMOUSEBUTTONSWAP = 33
Const SPIF_UPDATEINIFILE = &H1
Private Declare Function SystemParametersInfo Lib "user32.dll" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uiParam As Long, _
pvParam As Any, ByVal fWinIni As Long) As Long
Private Sub Form_Load()
SystemParametersInfo SPI_SETMOUSEBUTTONSWAP, 1, 0, SPIF_UPDATEINIFILE
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
لإنهاء البرنامج عند النقر على Esc في لوحة المفاتيح مهما كان موقع التركيز بين الأدوات.....

'Load انسخ هذا الكود لحدث تحميل النموذج

Private Sub Form_Load()
Form1.KeyPreview = True
End Sub

'KeyPress انسخ هذا الكود لحدث النموذج

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 27 Then
End
End If
End Sub


'KeyPress بدلاً من كود الحدث KeyDownويمكن ايضاًوضع الكود التالي في الحدث

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then End
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
لاختبار وجود بطاقة إخراج الصوت

Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
Private Sub Command1_Click()
'Get the number of installed waveout devices
ret& = waveOutGetNumDevs
If ret& > 0 Then
MsgBox "يوجد بطاقة لإخراج الصوت مثبتة على هذا الجهاز"
Else
MsgBox "للأسف لايوجد بطاقة لإخراج الصوت على هذا الجهاز"
End If
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
كلمة مرور لنموذج في برنامجك

rivate Sub Form_Load()
'تعريف المتغيرات

Dim s As Integer
Dim passw As String
'اعطاء قيمة اولية

s = 1
'بدية التكرار واختبار ووضع كلمة المرور

Do Until (s = 5 Or passw = "هنا ضع كلمة المرور")
'عرض مربع الادخال لكتابة كلمة المرور

passw = InputBox("ادخل كلمة المرور الى قاعدة البيانات", "كلمة مرور مطلوبة")
'مقدار زيادة لستمرار التكرار

s = s + 1
Loop
If s = 5 Then
'عرض رسالة للمستخدم بعد التكرار دون تحقق الشرط

MsgBox "كلمة المرور التي ادخلتها خاطئة... الرجاء حاول مرة أخرى", vbOKOnly, "خطأ في كلمة المرور"
End
'عرض النموذج بعد التأكد من تحقق الشرط

Form1.Show "form1"
'خروج من التكرار

End If
End Sub