module1.bas

来自「很好的教程原代码！」· BAS 代码 · 共 86 行

Attribute VB_Name = "Module1"
Option Explicit

Public Const GWL_WNDPROC = (-4)

Public Const WM_LBUTTONDOWN = &H201
Public Const WM_NCHITTEST = &H84
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCLIENT = 1
Public Const HTCAPTION = 2

Public Const LF_FACESIZE = 32
Public Const DEFAULT_CHARSET = 1
Public Const DT_CALCRECT = &H400

Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName(0 To LF_FACESIZE - 1) As Byte
End Type

Declare Function SelectObject Lib "gdi32" _
    (ByVal hDC As Long, ByVal hObject As Long) As Long
Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As Long) As Long
Declare Function CreateFontIndirect Lib "gdi32" _
    Alias "CreateFontIndirectA" (lpLogFont As _
    LOGFONT) As Long
Declare Sub RtlMoveMemory Lib "KERNEL32" _
    (lpvDest As Any, lpvSource As Any, _
    ByVal cbCopy As Long)
Declare Function DrawText Lib "user32" Alias _
    "DrawTextA" (ByVal hDC As Long, ByVal lpStr _
     As String, ByVal nCount As Long, lpRect _
    As RECT, ByVal wFormat As Long) As Long

Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Declare Function GetWindowRect Lib "user32" _
    (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetClientRect Lib "user32" _
    (ByVal hwnd As Long, lpRect As RECT) As Long

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
Declare Function GetWindowLong Lib "user32" Alias _
    "GetWindowLongA" (ByVal hwnd As Long, _
    ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias _
    "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex _
    As Long, ByVal dwNewLong As Long) As Long
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 prevWndProc As Long

Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, _
        ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_LBUTTONDOWN Then
        SendMessage Main.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
    Else
        WndProc = CallWindowProc(prevWndProc, hwnd, Msg, wParam, lParam)
    End If
End Function