⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 common.bas

📁 OpenPlayer代码
💻 BAS
字号:
Attribute VB_Name = "Module1"
Option Explicit
'==============================
'设置窗体总在最前面用到
' SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3   '设置
' SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 3   '取消
'==============================
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

'==============================
'移动窗体
'ReleaseCapture
'SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
'==============================
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1

'==============================
'取得鼠标的当前位置
'getcursorpos(mouse)
'==============================
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Type POINTAPI
   X As Long
   Y As Long
End Type

'==============================
'最小化及显示窗体
'ShowWindow(Me.hwnd, SW_HIDE)         '最小化
'ShowWindow(Me.hwnd, SW_SHOW)         '显示
'==============================
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Const SW_HIDE = 0     '最小化
Const SW_SHOW = 5     '显示

'=============================
'shell 打开
'=============================
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long




'==============================
'查找父、子窗口的名柄
'==============================
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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

'==============================
'HOOK 钩!
'回调函数
'==============================
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'Public Const GWL_WNDPROC = -4


'Public Const WM_RBUTTONUP = 516   'Flash右键菜单常数
'Public Const WM_CLICK = 514       'Flash单击
'Public Const WM_LBUTTONDOWN = &H201

Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)



Global Zoom As Integer
Global isFullScreen As Boolean
Global isNetFile As Boolean
Global netWidth, netHeight As Long
Global totalframes As Long

'================================
'以下全局变量用于初始化Dialog
'================================
Global ExtensionName1 As String
Global ExtensionName2 As String
Global dlgTitle As String
Global netEnable As Boolean
Global StartPath As String
Global dlgFilename As String
Global FlashPreviwe As Boolean



Public lpPrevWndProc As Long
Public lngHWnd As Long
'=============================================
'以下为ShockWaveFlash钩子
'=============================================

Public Sub Hook(hWnd As Long)

lngHWnd = hWnd
lpPrevWndProc = SetWindowLong(lngHWnd, GWL_WNDPROC, AddressOf WindowProc)

End Sub

'钩 子 函 数 撤 消:

Public Sub UnHook()

Dim lngReturnValue As Long

lngReturnValue = SetWindowLong(lngHWnd, GWL_WNDPROC, lpPrevWndProc)

End Sub

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Select Case uMsg

' 检 测 鼠 标 击 键 消 息, 如 果 是 单 击 右 键

Case 516  '右键
  Popupme
  
Case 513 'LeftMouseDown

     ReleaseCapture
     SendMessage Form1.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
     WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
Case Else


WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)

End Select

End Function

'================================
'弹出自定义菜单
'================================

Function Popupme()
     '================================
     '初始化菜单
     '================================
      '初始化[放大]
     If Zoom > 10 Then
        Form2.ZoomIn.Enabled = False
     Else
        Form2.ZoomIn.Enabled = True
     End If
     '初始化[缩小]
     If Zoom = 0 Then
         Form2.ZoomOut.Enabled = False
     Else
         Form2.ZoomOut.Enabled = True
     End If
      '初始化[全屏]
     If isFullScreen = True Then
        Form2.FullScreen.Caption = "返回"
        Form2.FullScreen.Checked = True
     Else
        Form2.FullScreen.Caption = "全屏"
        Form2.FullScreen.Checked = False
     End If
     '初始化[循环]
     If Form1.ShockwaveFlash1.Loop = True Then
        Form2.Loop1.Checked = True
     Else
        Form2.Loop1.Checked = False
     End If
     '初始化[播放]
     If Form1.ShockwaveFlash1.Playing = True Then
      Form2.play.Caption = "停止"
     Else
       Form2.play.Caption = "播放"
     End If
       
      
     Form1.PopupMenu Form2.popup '弹出菜单
End Function

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -