' بدون تعديل ضع هذا الكود في الفورم
الرجاء وضع تايمرين قبل التشغيل

Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private …

[ Full reading ]

الى جميع اعضاء المنتدى والى جميع الزوار
انتظروا مفــــــــــــــــــاجئة 2012
من ابن الـــــــــســـــــــــــو يداء )
(al-master)
ومن اهم البرامج في مجموعتي
سوف تكون بين ايديكم
وعام سعيد على ابناء السويداء
والوطــــــــــــــن وقائده

' ضع هذا الكود في الفورم وقم بإضافة زر عليها

Private Sub Command1_Click()
Form1.Cls
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
i = Rnd * 15
If Button = 1 Then
Me.Circle (X, Y), 200, QBColor(i)
End If
End Sub

' ضع هذا الكود في الفورم وقم بإضافة زر عليها

Private Sub Command1_Click()
Form1.Cls
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
i = Rnd * 15
If Button = 1 Then
Me.Circle (X, Y), 200, QBColor(i)
End If
End Sub

' ضع هذا الكود في الفورم

Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Activate()
DoEvents
BlockInput True
Sleep 1000
BlockInput False
End Sub

' ضع هذا الكود في الفورم

Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21 ' default

'for FTP servers
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000 ' used

'for FTP connections
Const INTERNET_OPEN_TYPE_PRECONFIG = 0 '

'use registry configuration
Const INTERNET_OPEN_TYPE_DIRECT = 1 '

'direct to net
Const INTERNET_OPEN_TYPE_PROXY = 3 '

'via named proxy
Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4 ' prevent using …

[ Full reading ]

' ضع هذا الكود في الفورم

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Public Sub OpenCDDriveDoor(ByVal State As Boolean)
If State = True Then
Call mciSendString("Set CDAudio Door Open", 0&, 0&, 0&)
Else
Call mciSendString("Set CDAudio Door Closed", 0&, 0&, 0&)
End If
End Sub

Private Sub Command1_Click()
OpenCDDriveDoor (True)
End Sub

Private Sub Command2_Click()
OpenCDDriveDoor (False)
End Sub


'


[ Full reading ]

' ضع هذا الكود في الفورم

Dim WSH As Object
Set WSH = CreateObject("Wscript.Shell")
WSH.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDrives", 4, "REG_DWORD"
'يمكنك اختيار القرص عن طريق مضاعفة الرقم 4

' ضع هذا الكود في المودل

Public Const EWX_LOGOFF = 0
Public Const EWX_SHUTDOWN = 1
Public Const EWX_REBOOT = 2
Public Const EWX_FORCE = 4
Public Const CCDEVICENAME = 32
Public Const CCFORMNAME = 32
Public Const DM_BITSPERPEL = &H40000
Public Const DM_PELSWIDTH = &H80000
Public Const DM_PELSHEIGHT = &H100000
Public Const CDS_UPDATEREGISTRY = &H1
Public Const CDS_TEST = &H4
Public Const DISP_CHANGE_SUCCESSFUL = 0
Public Const DISP_CHANGE_RESTART = 1

Type typDevMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
…

[ Full reading ]