module1.bas

来自「一个利用VB + ACCESS数据库实现的人事管理系统 具有简单的添加」· BAS 代码 · 共 48 行

Attribute VB_Name = "Module1"
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) 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 Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, Y, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2          'msflexgrid
Public Const SWP_NOMOVE = &H2             'mschar    dtpicker
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const TOPMOST_FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Public Const a = &H115
Public Const b = 1
Public Const c = 0
Public byval0&
Public Declare Function GetCurrentTime Lib "kernel32" Alias "GetTickCount" () As Long


Public Sub AlwaysOnTop(TheForm As Form, Toggle As Boolean)
    If Toggle = True Then
        SetWindowPos TheForm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
    Else
        SetWindowPos TheForm.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, TOPMOST_FLAGS
    End If
End Sub

Public Sub DoDrag(TheForm As Form)
    ReleaseCapture
    SendMessage TheForm.hwnd, &HA1, 2, 0&
End Sub
Public Sub DoTransparency(TheForm As Form)
    Dim TempRegions(6) As Long
    Dim FormWidthInPixels As Long                        '实现不规则窗体
    Dim FormHeightInPixels As Long
    Dim a
    FormWidthInPixels = TheForm.Width / Screen.TwipsPerPixelX
    FormHeightInPixels = TheForm.Height / Screen.TwipsPerPixelY
    a = CreateRoundRectRgn(0, 0, FormWidthInPixels, FormHeightInPixels, 32, 32)
    a = SetWindowRgn(TheForm.hwnd, a, True)
End Sub