'code in modApi.basOption Explicit ' Window Functions Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long 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 LoadResImage Lib "user32" Alias "LoadImageA" (ByVal hinst As Long, ByVal lpsz As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long' Message Public Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long Public Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long Public Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As LongPublic Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (pcWndClassEx As WNDCLASSEX) As Integer Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long' Class Reg And Del Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long'--------------------------------------------------------- 'CreateWindowEx And Dialog Window Style '-------------------------------------------------------- Public Const WS_MINIMIZEBOX = &H20000 Public Const WS_MAXIMIZEBOX = &H10000 Public Const WS_CAPTION = &HC00000 ' WS_BORDER Or WS_DLGFRAME Public Const WS_OVERLAPPED = &H0& Public Const WS_THICKFRAME = &H40000Public Const WS_CHILD = &H40000000 Public Const WS_VISIBLE = &H10000000 Public Const WS_TABSTOP = &H10000 Public Const WS_DISABLED = &H8000000 Public Const WS_SYSMENU = &H80000 Public Const WS_POPUP = &H80000000 Public Const WS_GROUP = &H20000Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)' Window Message Public Const WM_TIMER = &H113 Public Const WM_USER = &H400 Public Const WM_NOTIFY = &H4E Public Const WM_MOUSEMOVE = &H200 Public Const WM_RBUTTONUP = &H205 Public Const WM_COMMAND = &H111 Public Const WM_ENABLE = &HA Public Const WM_INITDIALOG = &H110 Public Const WM_PAINT = &HF Public Const WM_CLOSE = &H10 Public Const WM_CREATE = &H1 Public Const WM_LBUTTONDOWN = &H201 Public Const WM_LBUTTONDBLCLK = &H203 Public Const WM_RBUTTONDBLCLK = &H206 Public Const WM_RBUTTONDOWN = &H204 Public Const WM_SIZE = &H5Public Const WM_MEASUREITEM = &H2C Public Const WM_DRAWITEM = &H2B Public Const WM_INITMENUPOPUP = &H117 Public Const WM_DESTROY = &H2' WNDCLASSEX Public Const CS_HREDRAW = &H2 Public Const CS_VREDRAW = &H1 Public Const CS_DBLCLKS = &H8' Window Color Public Const COLOR_WINDOW = 5' DefSystem Cursor Public Const IDC_HAND = 32649&' ShowWindow Public Const SW_NORMAL = 1Public Const IMAGE_ICON = 1' DefSystem Cursor Public Const IDC_ARROW = 32512&' Reg Window Public Type WNDCLASSEX cbSize As Long Style As Long lpfnWndProc As Long cbClsExtra As Long cbWndExtra As Long hInstance As Long hIcon As Long hCursor As Long hbrBackground As Long lpszMenuName As String lpszClassName As String hIconSm As Long End TypePublic Type POINTAPI X As Long Y As Long End TypePublic Type MSG hwnd As Long message As Long wParam As Long lParam As Long Times As Long pt As POINTAPI End Type
'code in modMain.bas Option ExplicitDim lpwcx As WNDCLASSEX Dim RegClass As LongPublic Function RegWinClass(lpClassName As String) '蛁聊敦諳濬 With lpwcx .cbSize = Len(lpwcx) .Style = CS_HREDRAW Or CS_VREDRAW Or CS_DBLCLKS .lpszClassName = lpClassName .hInstance = App.hInstance .cbClsExtra = 0 .cbWndExtra = 0 .hCursor = LoadCursor(0, IDC_ARROW) .lpfnWndProc = FnPtrToLong(AddressOf MainWinProc) .lpszMenuName = 0 .hbrBackground = COLOR_WINDOW End With Call RegisterClassEx(lpwcx) End FunctionPrivate Function MainWinProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Select Case uMsg Case WM_DESTROY Call PostQuitMessage(0) End Select MainWinProc = DefWindowProc(hwnd, uMsg, wParam, lParam) End FunctionPublic Function FnPtrToLong(ByVal lngFnPtr As Long) As Long FnPtrToLong = lngFnPtr End Function Public Function CreateMainForm(title As String, nWidth As Long, nHeight As Long) As Long Dim hWndMain As Long Dim lpMsg As MSG
If hWndMain <> 0 Then ShowWindow hWndMain, SW_NORMAL Do While GetMessage(lpMsg, 0, 0, 0) TranslateMessage lpMsg DispatchMessage lpMsg Loop End If UnregisterClass "Form", App.hInstance End FunctionPublic Sub Main() CreateMainForm "Windows", 500, 388 End Sub
http://www.imeic.net/shadow/code/form.zip這個是最簡單的窗體,比如 可以編寫字型等http://www.sijiqing.com/vbgood/forum/forum_posts.asp?TID=14034&PN=1
' Window Functions
Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
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 LoadResImage Lib "user32" Alias "LoadImageA" (ByVal hinst As Long, ByVal lpsz As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long' Message
Public Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Public Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
Public Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As LongPublic Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (pcWndClassEx As WNDCLASSEX) As Integer
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long' Class Reg And Del
Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long'---------------------------------------------------------
'CreateWindowEx And Dialog Window Style
'--------------------------------------------------------
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_CAPTION = &HC00000 ' WS_BORDER Or WS_DLGFRAME
Public Const WS_OVERLAPPED = &H0&
Public Const WS_THICKFRAME = &H40000Public Const WS_CHILD = &H40000000
Public Const WS_VISIBLE = &H10000000
Public Const WS_TABSTOP = &H10000
Public Const WS_DISABLED = &H8000000
Public Const WS_SYSMENU = &H80000
Public Const WS_POPUP = &H80000000
Public Const WS_GROUP = &H20000Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)' Window Message
Public Const WM_TIMER = &H113
Public Const WM_USER = &H400
Public Const WM_NOTIFY = &H4E
Public Const WM_MOUSEMOVE = &H200
Public Const WM_RBUTTONUP = &H205
Public Const WM_COMMAND = &H111
Public Const WM_ENABLE = &HA
Public Const WM_INITDIALOG = &H110
Public Const WM_PAINT = &HF
Public Const WM_CLOSE = &H10
Public Const WM_CREATE = &H1
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_SIZE = &H5Public Const WM_MEASUREITEM = &H2C
Public Const WM_DRAWITEM = &H2B
Public Const WM_INITMENUPOPUP = &H117
Public Const WM_DESTROY = &H2' WNDCLASSEX
Public Const CS_HREDRAW = &H2
Public Const CS_VREDRAW = &H1
Public Const CS_DBLCLKS = &H8' Window Color
Public Const COLOR_WINDOW = 5' DefSystem Cursor
Public Const IDC_HAND = 32649&' ShowWindow
Public Const SW_NORMAL = 1Public Const IMAGE_ICON = 1' DefSystem Cursor
Public Const IDC_ARROW = 32512&' Reg Window
Public Type WNDCLASSEX
cbSize As Long
Style As Long
lpfnWndProc As Long
cbClsExtra As Long
cbWndExtra As Long
hInstance As Long
hIcon As Long
hCursor As Long
hbrBackground As Long
lpszMenuName As String
lpszClassName As String
hIconSm As Long
End TypePublic Type POINTAPI
X As Long
Y As Long
End TypePublic Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
Times As Long
pt As POINTAPI
End Type
Option ExplicitDim lpwcx As WNDCLASSEX
Dim RegClass As LongPublic Function RegWinClass(lpClassName As String)
'蛁聊敦諳濬
With lpwcx
.cbSize = Len(lpwcx)
.Style = CS_HREDRAW Or CS_VREDRAW Or CS_DBLCLKS
.lpszClassName = lpClassName
.hInstance = App.hInstance
.cbClsExtra = 0
.cbWndExtra = 0
.hCursor = LoadCursor(0, IDC_ARROW)
.lpfnWndProc = FnPtrToLong(AddressOf MainWinProc)
.lpszMenuName = 0
.hbrBackground = COLOR_WINDOW
End With
Call RegisterClassEx(lpwcx)
End FunctionPrivate Function MainWinProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_DESTROY
Call PostQuitMessage(0)
End Select
MainWinProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
End FunctionPublic Function FnPtrToLong(ByVal lngFnPtr As Long) As Long
FnPtrToLong = lngFnPtr
End Function
Public Function CreateMainForm(title As String, nWidth As Long, nHeight As Long) As Long
Dim hWndMain As Long
Dim lpMsg As MSG
Call RegWinClass("Form")
hWndMain = CreateWindowEx(0, "Form", "Windows", WS_OVERLAPPEDWINDOW, 0, 0, nWidth, nHeight, 0, 0, App.hInstance, ByVal 0&)
If hWndMain <> 0 Then
ShowWindow hWndMain, SW_NORMAL
Do While GetMessage(lpMsg, 0, 0, 0)
TranslateMessage lpMsg
DispatchMessage lpMsg
Loop
End If
UnregisterClass "Form", App.hInstance
End FunctionPublic Sub Main()
CreateMainForm "Windows", 500, 388
End Sub