تحريك الادوات داخل الفورم بطريقة طريفه وعشوائية

بسم الله الرحمن الرحيم

اليوم نضع لكم مثال لتحريك الادوات داخل الفورم بطريقة عشوائية وطريفه

ونستخدم فيها الدالة RandBetween

لتحريك الاداة بين قيمتين بطريقة شوائية

اتمنى ان يعجبكم هذا الملف :)

 الكود المستخدم داخل الملف

 #If VBA7 Then  
   Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long  
   Private Declare PtrSafe Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long  
   Private Declare PtrSafe Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long  
   Private Declare PtrSafe Function DrawMenuBar Lib "User32" (ByVal hWnd As LongPtr) As Long  
 #Else  
   Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long  
   Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long  
   Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long  
   Private Declare Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long  
 #End If  
 Const GWL_STYLE = -16  
 Const WS_CAPTION = &HC00000  
 Const WS_SYSMENU = &H80000  
 Private Sub CommandButton1_Click()  
   MsgBox "تسلم يامعلم الله ينور"  
   Me.Hide  
 End Sub  
 Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)  
   With CommandButton1  
     .Left = WorksheetFunction.RandBetween(20, 400)  
     .Top = WorksheetFunction.RandBetween(20, 400)  
   End With  
 End Sub  
 Private Sub CommandButton2_Click()  
 Label2.Visible = True  
 CommandButton3.Visible = True  
 End Sub  
 Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)  
   With CommandButton2  
     .Left = WorksheetFunction.RandBetween(20, 400)  
     .Top = WorksheetFunction.RandBetween(20, 400)  
   End With  
 End Sub  
 Private Sub CommandButton3_Click()  
   Me.Hide  
 End Sub  
 Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)  
   With Label1  
     .Left = WorksheetFunction.RandBetween(20, 400)  
     .Top = WorksheetFunction.RandBetween(20, 400)  
   End With  
 End Sub  
 Private Sub UserForm_Activate()  
   Application.WindowState = xlMaximized  
   With Me  
     .Height = Application.Height  
     .Width = Application.Width  
     .Left = Application.Left  
     .Top = Application.Top  
   End With  
 End Sub  
 Private Sub UserForm_Initialize()  
   Dim lngWindow As Long, lFrmHdl As Long  
   lFrmHdl = FindWindow(vbNullString, Me.Caption)  
   lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)  
   lngWindow = lngWindow And (Not WS_CAPTION)  
   Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)  
   Call DrawMenuBar(lFrmHdl)  
 End Sub  
 Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)  
   If unloadmode = vbFormControlMenu Then  
     Cancel = True  
     MsgBox "غير مسموح"  
   End If  
 End Sub  

اعداد / ياسر العربي

شارك المقال

شاركه على فيسبوكشاركه على جوجل+