home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD61545272000.psc / MNative.bas < prev    next >
Encoding:
BASIC Source File  |  2000-03-23  |  6.1 KB  |  160 lines
  1. Attribute VB_Name = "MNative"
  2. Option Base 1
  3. Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  4. 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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
  5. Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  6. Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  7. Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  8. Public 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
  9. Private Declare Function mciSendString Lib "winmm.dll" Alias _
  10.     "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
  11.     lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _
  12.     hwndCallback As Long) As Long
  13.  
  14.  
  15. Public Type RECT
  16.         Left As Long
  17.         Top As Long
  18.         Right As Long
  19.         Bottom As Long
  20. End Type
  21.  
  22. Public Type SizeRECT
  23. IWidth As Long
  24. IHight As Long
  25. End Type
  26.  
  27. Public Const HKEY_CLASSES_ROOT = &H80000000
  28. Public Const HKEY_CURRENT_USER = &H80000001
  29. Public Const HKEY_LOCAL_MACHINE = &H80000002
  30. Public Const HKEY_USERS = &H80000003
  31. Public Const HKEY_PERFORMANCE_DATA = &H80000004
  32.  
  33. Global PathFull As String
  34. Type ClassV
  35. Class(6) As String
  36. 'TitleClass(6) As String
  37. End Type
  38. Sub GetPlaceMe()
  39. On Error Resume Next
  40. '////////////////// //////////////////////////////////////
  41. '//////////GetPlace me.exe /////////////////////////////
  42. If Len(App.Path) > 3 Then
  43. PathFull = App.Path & "\" & App.EXEName & ".exe"
  44. Else
  45. PathFull = App.Path & App.EXEName & ".exe"
  46. End If
  47. '///////////////////////////////////////////////////////
  48. End Sub
  49. Public Function GetSize(hwnd) As SizeRECT
  50. Dim VRECT As RECT
  51. Call GetWindowRect(hwnd, VRECT)
  52. Dim IWidth As Long
  53. Dim IHight As Long
  54. GetSize.IWidth = VRECT.Right - VRECT.Left
  55. GetSize.IHight = VRECT.Bottom - VRECT.Top
  56. End Function
  57. Public Function GetHwndByClass(Class1 As String, Class2 As String, Class3 As String, Class4 As String, Class5 As String, Class6 As String) As Long
  58. Dim FindClass(6) As Long
  59.  
  60. FindClass(1) = FindWindow(Class1, vbNullString)
  61.  
  62. If Class2 = "0" Then GetHwndByClass = FindClass(1): Exit Function
  63.  
  64.  
  65. FindClass(2) = FindWindowEx(FindClass(1), 0, Class2, vbNullString)
  66. If Class3 = "0" Then GetHwndByClass = FindClass(2): Exit Function
  67.  
  68. FindClass(3) = FindWindowEx(FindClass(2), 0, Class3, vbNullString)
  69. If Class4 = "0" Then GetHwndByClass = FindClass(3): Exit Function
  70.  
  71. FindClass(4) = FindWindowEx(FindClass(3), 0, Class4, vbNullString)
  72. If Class5 = "0" Then GetHwndByClass = FindClass(4): Exit Function
  73.  
  74. FindClass(5) = FindWindowEx(FindClass(4), 0, Class5, vbNullString)
  75. If Class6 = "0" Then GetHwndByClass = FindClass(5): Exit Function
  76.  
  77. FindClass(6) = FindWindowEx(FindClass(5), 0, Class6, vbNullString)
  78. GetHwndByClass = FindClass(6): Exit Function
  79. End Function
  80. Sub OpenVideo(PathVideo As String, HandleVideo As String, TypeVideoAviOrMpeg As String, WherePlayVideo_HWnd As Long, VWidth As Long, VHight As Long, VTop As Long, VLeft As Long)
  81. Dim ToDo As String
  82.     Last$ = WherePlayVideo_HWnd & " Style " & &H40000000
  83.     
  84.     ToDo$ = "open " & PathVideo & " Type " & TypeVideoAviOrMpeg & "video Alias video parent " & Last$
  85.     'MsgBox ToDo$
  86.     X% = mciSendString(ToDo$, 0&, 0, 0)
  87.     
  88.     If VWidth = 0 And VHight = 0 Then
  89.     ToDo$ = "put video window at " & VLeft & " " & VTop & " "
  90.     'MsgBox ToDo$
  91.         X% = mciSendString(ToDo$, 0&, 0, 0)
  92.     Else
  93.     ToDo$ = "put video window at " & VLeft & " " & VTop & " " & VWidth & " " & VHight
  94.     'MsgBox ToDo$
  95.         X% = mciSendString(ToDo$, 0&, 0, 0)
  96.     End If
  97. End Sub
  98. Sub CloseVideo()
  99. X% = mciSendString("Close video", 0&, 0, 0&)
  100. End Sub
  101. Sub ResumeVideo()
  102. X% = mciSendString("Resume video", 0&, 0, 0&)
  103. End Sub
  104. Sub StopVideo()
  105. X% = mciSendString("Stop video", 0&, 0, 0&)
  106. End Sub
  107. Sub PlayVideo(FromWhereStartPlayVideo As String, ToWherePlayVideo As String)
  108. If FromWhereStartPlayVideo = "None" Then
  109.     ToDo$ = "play video"
  110.     'MsgBox ToDo$
  111.         X% = mciSendString(ToDo$, 0&, 0, 0)
  112.     ElseIf Not FromWhereStartPlayVideo = "None" And Not ToWherePlayVideo = "None" Then
  113.     ToDo$ = "play video from " & FromWhereStartPlayVideo & " to " & ToWherePlayVideo
  114.     'MsgBox ToDo$
  115.     X% = mciSendString(ToDo$, 0&, 0, 0)
  116.     ElseIf ToWherePlayVideo = "None" Then
  117.     ToDo$ = "play video from " & FromWhereStartPlayVideo
  118.     'MsgBox ToDo$
  119.     X% = mciSendString(ToDo$, 0&, 0, 0)
  120. End If
  121.  
  122. End Sub
  123. Sub ReSizeVideo(VWidth As Long, VHight As Long, VTop As Long, VLeft As Long)
  124. ToDo$ = "put video window at " & VLeft & " " & VTop & " " & VWidth & " " & VHight
  125.         X% = mciSendString(ToDo$, 0&, 0, 0)
  126. End Sub
  127. Sub PauseVideo()
  128.     X% = mciSendString("Pause video", 0&, 0, 0&)
  129. End Sub
  130. Sub SeekTo(Where As Long)
  131.     X% = mciSendString("seek video to " & Where, 0&, 0, 0)
  132. End Sub
  133. Public Function GetTotalFrames() As String
  134. Dim mssg As String * 255
  135.   X% = mciSendString("set video time format frames", mssg, 255, 0)
  136.   X% = mciSendString("status video length", mssg, 255, 0)
  137.   GetTotalFrames = Str(mssg)
  138. End Function
  139. Public Function GetTotalTimeBymilliseconds() As String
  140.   Dim mssg As String * 255
  141.   X% = mciSendString("set video time format ms", mssg, 255, 0)
  142.   X% = mciSendString("status video length", mssg, 255, 0)
  143. GetTotalTimeBymilliseconds = Str(mssg)
  144. End Function
  145. Public Function GetVideoStats() As String
  146.   Dim mssg As String * 255
  147.   X% = mciSendString("status video mode", mssg, 255, 0)
  148.   GetVideoStats = mssg
  149. End Function
  150.  
  151. '//regedit
  152. Public Sub SaveString(hKey As Long, StrPath As String, StrValue As String, StrData As String)
  153.    Dim KeyH&
  154.     r = RegCreateKey(hKey, StrPath, KeyH&)
  155.     r = RegSetValueEx(KeyH&, StrValue, 0, 1, ByVal StrData, Len(StrData))
  156.     r = RegCloseKey(KeyH&)
  157. End Sub
  158.  
  159.  
  160.