Aboud Aboud
06-22-2008, 01:55 PM
هذه :smailes60: مجموعة :smailes60: من :smailes60: الأكواد :smailes60: للفيجوال :smailes60: بيسك :smailes60:
تظليل النص
يمكن بهذا الكود تظليل النص لنسخة او حذفه اول شىء يجب ان تضع فى الفورم
Text1
Command1
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
----
Alt+Ctrl+Delete لإخفاء برنامجك من قائمة
لكي لا يستطيع المستخدم إغلاق برنامجك من هذه الازرار وفي هذا العمل لا تحتاج الى ازار
ضع هذا الكود فى التصريح
General
Private Const RSP_SIMPLE_SERVICE = 1
Private Const RSP_UNREGISTER_SERVICE = 0
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function RegisterServiceProcess Lib "kernel32" _
(ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Sub HideApp(Hide As Boolean)
Dim ProcessID As Long
ProcessID = GetCurrentProcessId()
If Hide Then
retval = RegisterServiceProcess(ProcessID, RSP_SIMPLE_SERVICE)
Else
retval = RegisterServiceProcess(ProcessID, RSP_UNREGISTER_SERVICE)
End If
End Sub
والكود التالي للفورم وطبعا لحدث التحميل اللى هو
Load
HideApp (True)
----
عمل كلمة مرور للبرنامج
لعمل كلمة سر للبرنامج وتحتاج لهذا العمل
Form1
form2
نضع هذا الكود للفورم رقم واحد وطبعا لا تنسى كلمه المرور واللى هي خمسة اصفار وبإمكانك طبعا تغيرها وعند كتابة كلمة المرور صحيحه راح يظهر لك الفورم رقم اثنين وبأمكانك انك تغبر طرقه عرض الفورم مثلا تريد ان تعرض رساله للمستخدم او اي شىء
نضع هذا الكود للفورم واحد فى حذث التحميل اللى هو
Load
Dim s As Integer
Dim passw As String
Do Until (s = 5 Or passw = "00000")
passw = InputBox("من فضلك اكتب كلمة المرور", "كلمة المرور")
s = s + 1
Loop
If s = 5 Then
MsgBox "كلمة المرور خاطئه حاول مره اخرى", vbOKOnly, "خطاء فى كلمة المرو"
End
form2.Show
End If
----
TextBox حساب عدد حروف
لمعرفه عدد الحروف فى صندوق النص اللى هو
Text box
نحتاج لهذا العمل زر وصندوق نص
Command1
Text1
نضع هذا الكود للزر
MsgBox ("number of charector =" + Str(Len(Text1.Text)))
----
(RND) برنامج لتوليد أرقام عشوائية و ذلك بإستخدام الدالة
في هذا العمل نحتاج الى زر وقائمه
Command1
List1
نضع الكود التالي في الزر
NR = Int(Rnd * 1000)
List1.AddItem NR
----
كــود لإعادة تشغيل الجهاز
في هذا العمل نحتاج لزر فقط
Command1
نضع هذا الكود للتصريح الجنرال General
Private Declare Function SetupPromptReboot Lib "setupapi.dll" (ByRef FileQueue As Long, ByVal Owner As Long, ByVal ScanOnly As Long) As Long
ونضع هذا الكود للزر
SetupPromptReboot ByVal 0&, Me.hWnd, 0
----
Command فتح صفحة انترنت عن طريق الضغط على
لهذا العمل نحتاج الى زر فقط Command
نضع هذا الكود للزر
Dim W As Object
Set W = CreateObject("InternetExplorer.Application")
W.Navigate "www.bramjnet.com"
W.Visible = True
----
كيف تحصل على اسم اليوم الحالى
لهذا العمل نحتاج الى زر وتسميه
Command1
Label1
نضع هذا الكود للزر وراح يطلع لك اسم اليوم بالانجليزي وبامكانك تغيرها للعربي فقط غير اسماء الايام من الانجليزي الى العربي
Dim D As Integer
D = Weekday(Date)
If D = 1 Then Label1 = "الأحد"
If D = 2 Then Label1 = "الاثنين"
If D = 3 Then Label1 = "الثلاثاء"
If D = 4 Then Label1 = "الأربعاء"
If D = 5 Then Label1 = "الخميس"
If D = 6 Then Label1 = "الجمعة"
If D = 7 Then Label1 = "السبت"
----
Label كيف نضع التاريخ والوقت فى
لهذا العمل نحتاج الى
Label1 , Label2 , Timer1
نضبط هذه الخاصيه لتايمر
Interval = 100 من الخصائص
Timer1 ومن ثم نضع هذا الكود
Label1.Caption = Time
label2.caption = date
----
هذا الكود لمنع تشغيل أكثر من نسخة من برنامجك
Load في هذا العمل لا نحتاج الى اي اداه فقط نضع هذا الكود للفورم فى حدث التحميل
If App.PrevInstance = True Then
MsgBox "أسف لا يمكنك تشغيل اكثر من نسخع من برنامجي"
Unload Me
Exit Sub
End If
وبإمكانك تغير الرساله التي ستظهر للمستخدم عندما يفتح اكثر من نسخه من برنامجك مثل
MsgBox "لا يمكن تشغيل أكثر من نسخة من البرنامج"
----
اكتب الارقام والبرناجم يحولها الى حروف
في هذا العمل سنحتاج الى
Command1 , Text1 , modul
Modul نضع هذا الكود للموديول
Public Function Horof(X)
N = Int(X)
B = Val(Right(Format(X, "000000000000.00"), 2))
R = SHorof(N)
If R <> "" And B > 0 Then Result = R & Ma & " و " & B & Mi
If R <> "" And B = 0 Then Result = R & Ma
If R = "" And B <> 0 Then Result = B & Mi
Horof = Result
End Function
Private Function SHorof(X)
N = Int(X)
C = Format(N, "000000000000")
C1 = Val(Mid(C, 12, 1))
Select Case C1
Case Is = 1: Letter1 = "واحد"
Case Is = 2: Letter1 = "اثنين"
Case Is = 3: Letter1 = "ثلاثة"
Case Is = 4: Letter1 = "اربعه"
Case Is = 5: Letter1 = "خمسه"
Case Is = 6: Letter1 = "سته"
Case Is = 7: Letter1 = "سبعه"
Case Is = 8: Letter1 = "ثمانيه"
Case Is = 9: Letter1 = "تسعه"
End Select
C2 = Val(Mid(C, 11, 1))
Select Case C2
Case Is = 1: Letter2 = "عشر"
Case Is = 2: Letter2 = "عشرون"
Case Is = 3: Letter2 = "ثلاثون"
Case Is = 4: Letter2 = "اربعون"
Case Is = 5: Letter2 = "خمسون"
Case Is = 6: Letter2 = "ستون"
Case Is = 7: Letter2 = "سبعون"
Case Is = 8: Letter2 = "ثمانون"
Case Is = 9: Letter2 = "تسعون"
End Select
If Letter1 <> "" And C2 > 1 Then Letter2 = Letter1 + " و" + Letter2
If Letter2 = "" Then Letter2 = Letter1
If C1 = 0 And C2 = 1 Then Letter2 = Letter2 + "ه"
If C1 = 1 And C2 = 1 Then Letter2 = "احدى عشر"
If C1 = 2 And C2 = 1 Then Letter2 = "اثنى عشر"
If C1 > 2 And C2 = 1 Then Letter2 = Letter1 + " " + Letter2
C3 = Val(Mid(C, 10, 1))
Select Case C3
Case Is = 1: Letter3 = "مائة"
Case Is = 2: Letter3 = "متان"
Case Is > 2: Letter3 = Left(SHorof(C3), Len(SHorof(C3)) - 1) + "مائه"
End Select
If Letter3 <> "" And Letter2 <> "" Then Letter3 = Letter3 + " و" + Letter2
If Letter3 = "" Then Letter3 = Letter2
C4 = Val(Mid(C, 7, 3))
Select Case C4
Case Is = 1: Letter4 = "الف"
Case Is = 2: Letter4 = "الفان"
Case 3 To 10: Letter4 = SHorof(C4) + " الاف"
Case Is > 10: Letter4 = SHorof(C4) + " الف"
End Select
If Letter4 <> "" And Letter3 <> "" Then Letter4 = Letter4 + " و" + Letter3
If Letter4 = "" Then Letter4 = Letter3
C5 = Val(Mid(C, 4, 3))
Select Case C5
Case Is = 1: Letter5 = "مليون"
Case Is = 2: Letter5 = "مليونين"
Case 3 To 10: Letter5 = SHorof(C5) + " ملايين"
Case Is > 10: Letter5 = SHorof(C5) + " مليون"
End Select
If Letter5 <> "" And Letter4 <> "" Then Letter5 = Letter5 + " و" + Letter4
If Letter5 = "" Then Letter5 = Letter4
C6 = Val(Mid(C, 1, 3))
Select Case C6
Case Is = 1: Letter6 = "مليار"
Case Is = 2: Letter6 = "ملياران"
Case Is > 2: Letter6 = SHorof(C6) + " مليار"
End Select
If Letter6 <> "" And Letter5 <> "" Then Letter6 = Letter6 + " و" + Letter5
If Letter6 = "" Then Letter6 = Letter5
SHorof = Letter6
End Function
ثم نضع هذا الكود للزر
strN = Horof(Text1.text)
msgbox strN
----
On Top كيف أجعل البرنامج فوق الكل
في هذا العمل لا نحتاج الى ازرار فقط ضع هذي الاكواد فى امكنها
General: تكتب الكود التالي في قسم التعريفات
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Const WM_SETHOTKEY = &H32
Private Const VK_F5 = &H74
Activate ونضع الكود التالي للفورم للحدث
Call SendMessage(Me.hwnd, WM_SETHOTKEY, VK_F5, 0)
----
X كيفية ابطال زر الاغلاق في فورم
فى هذا العمل لا نحتاج الى ادوات فقط نحتاج modul
Modul نضع الكود التالي للموديل
Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Declare Function GetMenuItemCount Lib "user32" _
(ByVal hMenu As Long) As Long
Declare Function DrawMenuBar Lib "user32" _
(ByVal hwnd As Long) As Long
Declare Function RemoveMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Public Const MF_BYPOSITION = &H400&
Public Const MF_REMOVE = &H1000&
Loadومن ثم نضع هذا الكود فى الفورم فى حدث التحميل
Dim hSysMenu As Long
Dim nCnt As Long
'First, show the form
Me.Show
'Get handle to our form's system menu
'(Restore, Maximize, Move, close etc.)
hSysMenu = GetSystemMenu(Me.hwnd, False)
If hSysMenu Then
'Get System menu's menu count
nCnt = GetMenuItemCount(hSysMenu)
If nCnt Then
'Menu count is based on 0 (0, 1, 2, 3...)
RemoveMenu hSysMenu, nCnt - 1, MF_BYPOSITION Or MF_REMOVE
RemoveMenu hSysMenu, nCnt - 2, _
MF_BYPOSITION Or MF_REMOVE
DrawMenuBar Me.hwnd
'Force caption bar's refresh. Disabling X button
Me.Caption = "Try to close me!"
End If
End If
----
ComboBox لتحميل جميع الخطوط في
Combobox طبعا في هذا العمل نحتاج الى
Load نضع الكود التالي فى الفورم في حدث التحميل
Dim i As Integer
For i = 0 To Screen.FontCount - 1
Combo1.AddItem Screen.Fonts(i)
Next i
Combo1.Text = Combo1.List(0)
----
هل يحتوي محرك الاقراص المدمجه على قرص
في هذا العمل نحتاج الى زر فقط Command
وظيفته يخبرك اذا كان القرص فى محرك الاقراص او لا نضع هذا الكود فى الكومند الزر
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 "There’s no CD…"
Exit For
ElseIf aDrive.DriveType = CDRom Then
MsgBox aDrive.VolumeName
Exit For
End If
Next
Set FSO = Nothing
----
إفراغ سلة المهملات
Command1 برنامج لمسح الملفات الموجوده فى سلة المهملات ونحتاج فقط لزر
Genral نضع الكود التالي فى تصريح
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Private Declare Function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Long
Command1 ونضع الكود التالي للزر
SHEmptyRecycleBin Me.hwnd, vbNullString, 0
SHUpdateRecycleBinIcon
----
رسم كرة تتبع الفأرة
لانحتاج الى اي اداه فقط نضع الكود التالي فى الفورم
mouse move ملاحظه يوضع الكود فى حدث
Me.Cls
Circle (X, Y), 100, vbRed
----
غلق الفورم بشكل انزلاق لليمين ثم الاسفل
Command في هذا العمل نحتاج الى زر فقط
Genralنضع هذا الكود فى التصريح
Sub SlideWindow(frmSlide As Form, iSpeed As Integer)
While frmSlide.Left + frmSlide.Width < Screen.Width
DoEvents
frmSlide.Left = frmSlide.Left + iSpeed
Wend
While frmSlide.Top - frmSlide.Height < Screen.Height
DoEvents
frmSlide.Top = frmSlide.Top + iSpeed
Wend
Unload frmSlide
End Sub
ومن ثم نضع الكود التالي للزر وطبعا تخلي اسمه إغلاق لانه راح يغلق البرنامج
Call SlideWindow(Form1, 250)
----
انتهينا .... :smailes12: :smailes12: .... الى القاء
تظليل النص
يمكن بهذا الكود تظليل النص لنسخة او حذفه اول شىء يجب ان تضع فى الفورم
Text1
Command1
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
----
Alt+Ctrl+Delete لإخفاء برنامجك من قائمة
لكي لا يستطيع المستخدم إغلاق برنامجك من هذه الازرار وفي هذا العمل لا تحتاج الى ازار
ضع هذا الكود فى التصريح
General
Private Const RSP_SIMPLE_SERVICE = 1
Private Const RSP_UNREGISTER_SERVICE = 0
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function RegisterServiceProcess Lib "kernel32" _
(ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Sub HideApp(Hide As Boolean)
Dim ProcessID As Long
ProcessID = GetCurrentProcessId()
If Hide Then
retval = RegisterServiceProcess(ProcessID, RSP_SIMPLE_SERVICE)
Else
retval = RegisterServiceProcess(ProcessID, RSP_UNREGISTER_SERVICE)
End If
End Sub
والكود التالي للفورم وطبعا لحدث التحميل اللى هو
Load
HideApp (True)
----
عمل كلمة مرور للبرنامج
لعمل كلمة سر للبرنامج وتحتاج لهذا العمل
Form1
form2
نضع هذا الكود للفورم رقم واحد وطبعا لا تنسى كلمه المرور واللى هي خمسة اصفار وبإمكانك طبعا تغيرها وعند كتابة كلمة المرور صحيحه راح يظهر لك الفورم رقم اثنين وبأمكانك انك تغبر طرقه عرض الفورم مثلا تريد ان تعرض رساله للمستخدم او اي شىء
نضع هذا الكود للفورم واحد فى حذث التحميل اللى هو
Load
Dim s As Integer
Dim passw As String
Do Until (s = 5 Or passw = "00000")
passw = InputBox("من فضلك اكتب كلمة المرور", "كلمة المرور")
s = s + 1
Loop
If s = 5 Then
MsgBox "كلمة المرور خاطئه حاول مره اخرى", vbOKOnly, "خطاء فى كلمة المرو"
End
form2.Show
End If
----
TextBox حساب عدد حروف
لمعرفه عدد الحروف فى صندوق النص اللى هو
Text box
نحتاج لهذا العمل زر وصندوق نص
Command1
Text1
نضع هذا الكود للزر
MsgBox ("number of charector =" + Str(Len(Text1.Text)))
----
(RND) برنامج لتوليد أرقام عشوائية و ذلك بإستخدام الدالة
في هذا العمل نحتاج الى زر وقائمه
Command1
List1
نضع الكود التالي في الزر
NR = Int(Rnd * 1000)
List1.AddItem NR
----
كــود لإعادة تشغيل الجهاز
في هذا العمل نحتاج لزر فقط
Command1
نضع هذا الكود للتصريح الجنرال General
Private Declare Function SetupPromptReboot Lib "setupapi.dll" (ByRef FileQueue As Long, ByVal Owner As Long, ByVal ScanOnly As Long) As Long
ونضع هذا الكود للزر
SetupPromptReboot ByVal 0&, Me.hWnd, 0
----
Command فتح صفحة انترنت عن طريق الضغط على
لهذا العمل نحتاج الى زر فقط Command
نضع هذا الكود للزر
Dim W As Object
Set W = CreateObject("InternetExplorer.Application")
W.Navigate "www.bramjnet.com"
W.Visible = True
----
كيف تحصل على اسم اليوم الحالى
لهذا العمل نحتاج الى زر وتسميه
Command1
Label1
نضع هذا الكود للزر وراح يطلع لك اسم اليوم بالانجليزي وبامكانك تغيرها للعربي فقط غير اسماء الايام من الانجليزي الى العربي
Dim D As Integer
D = Weekday(Date)
If D = 1 Then Label1 = "الأحد"
If D = 2 Then Label1 = "الاثنين"
If D = 3 Then Label1 = "الثلاثاء"
If D = 4 Then Label1 = "الأربعاء"
If D = 5 Then Label1 = "الخميس"
If D = 6 Then Label1 = "الجمعة"
If D = 7 Then Label1 = "السبت"
----
Label كيف نضع التاريخ والوقت فى
لهذا العمل نحتاج الى
Label1 , Label2 , Timer1
نضبط هذه الخاصيه لتايمر
Interval = 100 من الخصائص
Timer1 ومن ثم نضع هذا الكود
Label1.Caption = Time
label2.caption = date
----
هذا الكود لمنع تشغيل أكثر من نسخة من برنامجك
Load في هذا العمل لا نحتاج الى اي اداه فقط نضع هذا الكود للفورم فى حدث التحميل
If App.PrevInstance = True Then
MsgBox "أسف لا يمكنك تشغيل اكثر من نسخع من برنامجي"
Unload Me
Exit Sub
End If
وبإمكانك تغير الرساله التي ستظهر للمستخدم عندما يفتح اكثر من نسخه من برنامجك مثل
MsgBox "لا يمكن تشغيل أكثر من نسخة من البرنامج"
----
اكتب الارقام والبرناجم يحولها الى حروف
في هذا العمل سنحتاج الى
Command1 , Text1 , modul
Modul نضع هذا الكود للموديول
Public Function Horof(X)
N = Int(X)
B = Val(Right(Format(X, "000000000000.00"), 2))
R = SHorof(N)
If R <> "" And B > 0 Then Result = R & Ma & " و " & B & Mi
If R <> "" And B = 0 Then Result = R & Ma
If R = "" And B <> 0 Then Result = B & Mi
Horof = Result
End Function
Private Function SHorof(X)
N = Int(X)
C = Format(N, "000000000000")
C1 = Val(Mid(C, 12, 1))
Select Case C1
Case Is = 1: Letter1 = "واحد"
Case Is = 2: Letter1 = "اثنين"
Case Is = 3: Letter1 = "ثلاثة"
Case Is = 4: Letter1 = "اربعه"
Case Is = 5: Letter1 = "خمسه"
Case Is = 6: Letter1 = "سته"
Case Is = 7: Letter1 = "سبعه"
Case Is = 8: Letter1 = "ثمانيه"
Case Is = 9: Letter1 = "تسعه"
End Select
C2 = Val(Mid(C, 11, 1))
Select Case C2
Case Is = 1: Letter2 = "عشر"
Case Is = 2: Letter2 = "عشرون"
Case Is = 3: Letter2 = "ثلاثون"
Case Is = 4: Letter2 = "اربعون"
Case Is = 5: Letter2 = "خمسون"
Case Is = 6: Letter2 = "ستون"
Case Is = 7: Letter2 = "سبعون"
Case Is = 8: Letter2 = "ثمانون"
Case Is = 9: Letter2 = "تسعون"
End Select
If Letter1 <> "" And C2 > 1 Then Letter2 = Letter1 + " و" + Letter2
If Letter2 = "" Then Letter2 = Letter1
If C1 = 0 And C2 = 1 Then Letter2 = Letter2 + "ه"
If C1 = 1 And C2 = 1 Then Letter2 = "احدى عشر"
If C1 = 2 And C2 = 1 Then Letter2 = "اثنى عشر"
If C1 > 2 And C2 = 1 Then Letter2 = Letter1 + " " + Letter2
C3 = Val(Mid(C, 10, 1))
Select Case C3
Case Is = 1: Letter3 = "مائة"
Case Is = 2: Letter3 = "متان"
Case Is > 2: Letter3 = Left(SHorof(C3), Len(SHorof(C3)) - 1) + "مائه"
End Select
If Letter3 <> "" And Letter2 <> "" Then Letter3 = Letter3 + " و" + Letter2
If Letter3 = "" Then Letter3 = Letter2
C4 = Val(Mid(C, 7, 3))
Select Case C4
Case Is = 1: Letter4 = "الف"
Case Is = 2: Letter4 = "الفان"
Case 3 To 10: Letter4 = SHorof(C4) + " الاف"
Case Is > 10: Letter4 = SHorof(C4) + " الف"
End Select
If Letter4 <> "" And Letter3 <> "" Then Letter4 = Letter4 + " و" + Letter3
If Letter4 = "" Then Letter4 = Letter3
C5 = Val(Mid(C, 4, 3))
Select Case C5
Case Is = 1: Letter5 = "مليون"
Case Is = 2: Letter5 = "مليونين"
Case 3 To 10: Letter5 = SHorof(C5) + " ملايين"
Case Is > 10: Letter5 = SHorof(C5) + " مليون"
End Select
If Letter5 <> "" And Letter4 <> "" Then Letter5 = Letter5 + " و" + Letter4
If Letter5 = "" Then Letter5 = Letter4
C6 = Val(Mid(C, 1, 3))
Select Case C6
Case Is = 1: Letter6 = "مليار"
Case Is = 2: Letter6 = "ملياران"
Case Is > 2: Letter6 = SHorof(C6) + " مليار"
End Select
If Letter6 <> "" And Letter5 <> "" Then Letter6 = Letter6 + " و" + Letter5
If Letter6 = "" Then Letter6 = Letter5
SHorof = Letter6
End Function
ثم نضع هذا الكود للزر
strN = Horof(Text1.text)
msgbox strN
----
On Top كيف أجعل البرنامج فوق الكل
في هذا العمل لا نحتاج الى ازرار فقط ضع هذي الاكواد فى امكنها
General: تكتب الكود التالي في قسم التعريفات
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Const WM_SETHOTKEY = &H32
Private Const VK_F5 = &H74
Activate ونضع الكود التالي للفورم للحدث
Call SendMessage(Me.hwnd, WM_SETHOTKEY, VK_F5, 0)
----
X كيفية ابطال زر الاغلاق في فورم
فى هذا العمل لا نحتاج الى ادوات فقط نحتاج modul
Modul نضع الكود التالي للموديل
Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Declare Function GetMenuItemCount Lib "user32" _
(ByVal hMenu As Long) As Long
Declare Function DrawMenuBar Lib "user32" _
(ByVal hwnd As Long) As Long
Declare Function RemoveMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Public Const MF_BYPOSITION = &H400&
Public Const MF_REMOVE = &H1000&
Loadومن ثم نضع هذا الكود فى الفورم فى حدث التحميل
Dim hSysMenu As Long
Dim nCnt As Long
'First, show the form
Me.Show
'Get handle to our form's system menu
'(Restore, Maximize, Move, close etc.)
hSysMenu = GetSystemMenu(Me.hwnd, False)
If hSysMenu Then
'Get System menu's menu count
nCnt = GetMenuItemCount(hSysMenu)
If nCnt Then
'Menu count is based on 0 (0, 1, 2, 3...)
RemoveMenu hSysMenu, nCnt - 1, MF_BYPOSITION Or MF_REMOVE
RemoveMenu hSysMenu, nCnt - 2, _
MF_BYPOSITION Or MF_REMOVE
DrawMenuBar Me.hwnd
'Force caption bar's refresh. Disabling X button
Me.Caption = "Try to close me!"
End If
End If
----
ComboBox لتحميل جميع الخطوط في
Combobox طبعا في هذا العمل نحتاج الى
Load نضع الكود التالي فى الفورم في حدث التحميل
Dim i As Integer
For i = 0 To Screen.FontCount - 1
Combo1.AddItem Screen.Fonts(i)
Next i
Combo1.Text = Combo1.List(0)
----
هل يحتوي محرك الاقراص المدمجه على قرص
في هذا العمل نحتاج الى زر فقط Command
وظيفته يخبرك اذا كان القرص فى محرك الاقراص او لا نضع هذا الكود فى الكومند الزر
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 "There’s no CD…"
Exit For
ElseIf aDrive.DriveType = CDRom Then
MsgBox aDrive.VolumeName
Exit For
End If
Next
Set FSO = Nothing
----
إفراغ سلة المهملات
Command1 برنامج لمسح الملفات الموجوده فى سلة المهملات ونحتاج فقط لزر
Genral نضع الكود التالي فى تصريح
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Private Declare Function SHUpdateRecycleBinIcon Lib "shell32.dll" () As Long
Command1 ونضع الكود التالي للزر
SHEmptyRecycleBin Me.hwnd, vbNullString, 0
SHUpdateRecycleBinIcon
----
رسم كرة تتبع الفأرة
لانحتاج الى اي اداه فقط نضع الكود التالي فى الفورم
mouse move ملاحظه يوضع الكود فى حدث
Me.Cls
Circle (X, Y), 100, vbRed
----
غلق الفورم بشكل انزلاق لليمين ثم الاسفل
Command في هذا العمل نحتاج الى زر فقط
Genralنضع هذا الكود فى التصريح
Sub SlideWindow(frmSlide As Form, iSpeed As Integer)
While frmSlide.Left + frmSlide.Width < Screen.Width
DoEvents
frmSlide.Left = frmSlide.Left + iSpeed
Wend
While frmSlide.Top - frmSlide.Height < Screen.Height
DoEvents
frmSlide.Top = frmSlide.Top + iSpeed
Wend
Unload frmSlide
End Sub
ومن ثم نضع الكود التالي للزر وطبعا تخلي اسمه إغلاق لانه راح يغلق البرنامج
Call SlideWindow(Form1, 250)
----
انتهينا .... :smailes12: :smailes12: .... الى القاء