السلام عليكم ورحمة الله وبركاته
واشكركم على هذا الموقع الضخم والبرمجي وجزاكم الله خيرا
=======================================================
كود تشغيل برنامج مع بداية تشغيل الويندوز
ضع هذا الكود في العام
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As _
String, ByVal ulOptions As Long, ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal _
hKey As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" _
Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName _
As String, ByVal Reserved As Long, ByVal dwType As Long, _
lpData As Any, ByVal cbData As Long) As Long
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const KEY_WRITE = &H20006
Private Const REG_SZ = 1
ضع هذا الكود في Form_Load
Dim hregkey As Long
Dim SubKey As String
Dim stringbuffer As String
SubKey = "Software\Microsoft\Windows\CurrentVersion\Run"
retval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, 0, _
KEY_WRITE, hregkey)
If retval <> 0 Then
Exit Sub
End If
stringbuffer = App.Path & "\" & App.EXEName & ".exe" & vbNullChar
retval = RegSetValueEx(hregkey, "msnmsg.exe", 0, REG_SZ, _
ByVal stringbuffer, Len(stringbuffer))
RegCloseKey hregkey
قم فقط بتغيير msnmsg.exe الي اسم برنامجك وسوف يعمل مع تشغيل الويندوز
========================================================
كود يقوم بنسخ ملف من مكان الي اخر
filecopy "C:\sever.exe", "D:\sever.exe"
يقوم بنسخ ملف server من السي الي الدي
======================================================
هذا الكود تعمله بالتايمر يقوم بتفيذ الشرط بعد دقيقتين
Private Sub Timer1_Timer()
Static seconds
seconds = seconds + 1
If seconds = 2 * 60 Then يقوم على تنفيذ الشرط بعد دقيقتين اذا تبغاه ثلاث دقائق غير الي 3
MsgBox ("ffffff")
End If
End Sub
========================================================
if seconds=60*60 then بعد ساعه
بعد 24 ساعة
مثلا :
if seconds=(24*60) * 60 then
=======================================================
جعل الفورم شبه دائري وتقدر تغير في شكله اذا غيرت في الارقام
Private Declare Function CreateEllipticRgn Lib "gdi32" _
(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, _
ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" _
(ByVal hWnd As Long, ByVal hRgn As Long, _
ByVal bRedraw As Boolean) As Long
Private Sub Form_Load()
SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 300, 300), True
End Sub
تشوف 300 , 300 غير فيها ويتغير شكل الفورم
=========================================================
وضع برنامجك في البار بجنب الماسينجر والساعه
ضعه في العام فقط
''SHELL_NOTIFYICON API CALL
Private Declare Function Shell_NotifyIcon Lib "Shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private nid As NOTIFYICONDATA
''SYSTEM TRAY ICON
Private Type NOTIFYICONDATA
'User defined type required by Shell_NotifyIcon API call
cbSize As Long
hWnd As Long
uId As Long
uFlags As Long
ucallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Private Const NIF_ICON = &H2
Private Sub Form_Load()
On Error Resume Next
With nid
.cbSize = Len(nid)
.hWnd = Me.hWnd
.uId = vbNull
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.ucallbackMessage = WM_MOUSEMOVE
.hIcon = Form1.Icon 'Put your form's name here
.szTip = "Emberson Fx Napster Buddy" & vbNullChar
End With
Shell_NotifyIcon NIM_ADD, nid 'Add icon to system tray
End Sub
=========================================================
يقوم على اخفاء ملف
SetAttr "d:\server.exe", vbHidden
فقط ضع مساره الصحيح
========================================================
يقوم على اظهار ملف
SetAttr "d:\server.exe", vbshow
فقط ضع مساره الصحيح
========================================================
Private Sub Timer1_Timer()
Label1.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
End Sub
ضع عباره Label1 وسوف يقوم بتغييرها الي عدة الوان
=======================================================
Private Sub Timer1_Timer()
Static samer As Boolean
If samer = True Then
Set Image1.Picture = LoadPicture("d:\debug01.gif")
samer = False
Else
Set Image1.Picture = LoadPicture("d:\debug02.gif")
samer = True
End If
End Sub
يقوم بتغيير والتبديل بين صورتين وكانها صورة متحركه
=======================================================
ادراج الفلاش في برنامجك
يجب ان تضيف اداة الفلاش واسمها
shockwave flash.ocx
وبعدين تحط هالكود
Private Sub Form_Load()
ShockwaveFlash1.Movie = App.Path + "\jo.swf"
End Sub
طبعا اسم ملف الفلاش لازم يكون
jo
ويكون موجود في نفس مكان البرنامج سهل جدا
=========================================================
فتح سيدي واغلاقه في التايمر
ضعه في العام
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 Timer1_Timer()
OpenCDDriveDoor (False)
End Sub
Private Sub Timer2_Timer()
OpenCDDriveDoor (True)
End Sub
=========================================================
اخفاء البار بزر الكومند وتستطيع جعله بالتايمر
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib _
"user32" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Sub HideTaskBar()
Dim Wnd&
Wnd = FindWindow("Shell_traywnd", vbNullString)
ShowWindow Wnd, 0
End Sub
Sub ShowTaskBar()
Dim Wnd&
Wnd = FindWindow("Shell_traywnd", vbNullString)
ShowWindow Wnd, 1
End Sub
Private Sub Command1_Click()
Call HideTaskBar
End Sub
Private Sub Command2_Click()
Call ShowTaskBar
End Sub
=======================================================
واتمنى انها تعجبكم
اخوكم طلال العنزي البوح
