شفرة التعامل مع الأداة AVI
Private Sub Command1_Click()
Dim z: Dim zz
zz = " c:boxGrolierspace1.avi" ' أكتب هنا مسا ر ملف الفيديو
MMControl1.DeviceType = "AVIVideo"
z = App.Path 'تستخدم هذه الشفرة إذا كان ملف الفيديو في نفس مسار المشروع
zz = z + "" + "5.avi" ' تكمل السابقة
MMControl1.FileName = zz
MMControl1.hWndDisplay = Form1.hWnd ' هذه تستخدم لتحديد المكان الذي سيظهر فيه الفيديو
MMControl1.Command = "open"
MMControl1.Command = "prev"
MMControl1.Command = "play"
End Sub
Private Sub MMControl1_Done(NotifyCode As Integer)
If MMControl1.Position = MMControl1.Length Then
Dim z: Dim zz
zz = " c:boxGrolierspace2.avi" ' أكتب هنا مسا ر ملف الفيديو
MMControl1.DeviceType = "AVIVideo"
z = App.Path 'تستخدم هذه الشفرة إذا كان ملف الفيديو في نفس مسار المشروع
zz = z + "" + "5.avi" ' تكمل السابقة
MMControl1.FileName = zz
MMControl1.hWndDisplay = Form1.hWnd ' هذه تستخدم لتحديد المكان الذي سيظهر فيه الفيديو
MMControl1.Command = "open"
MMControl1.Command = "prev"
MMControl1.Command = "play"
End If
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
إبطال عمل Ctrl+c
'فى موديول
Public Const WM_KEYDOWN = &H100
Public Const WM_CHAR = &H102
Public Const GWL_WNDPROC = (-4)
Public Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal _
nIndex As Long, ByVal dwNewLong As Long) _
As Lo
'فى الفورم
Private Sub Form_Load()
hPrevWndProc = SetWindowLong(RichTextBox1.hwnd, _
GWL_WNDPROC, AddressOf WindowProc)
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
إظهار نافذة الخطأ البيضاء
Private Declare Sub FatalAppExit Lib "kernel32" Alias "FatalAppExitA" (ByVal uAction As Long, ByVal lpMessageText As String)
Private Sub Form_Load()
FatalAppExit 0, "Contactez le revendeur de ce programme" & vbLf & vbLf & "(Cette source provient de
http://www.vbfrance.com/)" End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
إفراغ سلة المحذوفات
'إفراغ سلة المحذوفات
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
Private Sub Form_Load()
'الإفراغ
SHEmptyRecycleBin Me.hwnd, vbNullString, 0
'التحديث
SHUpdateRecycleBinIcon
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
اتصل تليفونيا
Private Declare Function tapiRequestMakeCall Lib "TAPI32.DLL" (ByVal Dest As String, ByVal AppName As String, ByVal CalledParty As String, ByVal Comment As String) As Long
Private Sub Command1_Click()
a = tapiRequestMakeCall((1014557524), "Program Name", (Name), "Addition Comments")
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
اخفاء واظهار زر ابدء
Const SW_SHOWNORMAL = 1
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias _
"FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0
Public Function hideStartButton()
'This Function Hides the Start Button'
OurParent& = FindWindow("Shell_TrayWnd", "")
OurHandle& = FindWindowEx(OurParent&, 0, "Button", _
vbNullString)
ShowWindow OurHandle&, SW_HIDE
End Function
Public Function showStartButton()
'This Function Shows the Start Button'
OurParent& = FindWindow("Shell_TrayWnd", "")
OurHandle& = FindWindowEx(OurParent&, 0, "Button", _
vbNullString)
ShowWindow OurHandle&, SW_SHOWNORMAL
End Function
Private Sub Command1_Click()
hideStartButton
End Sub
Private Sub Command2_Click()
showStartButton
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
اظهار واخفاء مؤشر الماوس
'فى الموديول
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
'Command1 + command2
Private Sub Command1_Click()
Dim x As Long
x = ShowCursor(True) 'اظهار المؤشر
End Sub
Private Sub Command2_Click()
Dim x As Long
x = ShowCursor(False) 'اخفاء المؤشر
End Sub
الخميس مارس 06, 2008 11:05 am