【VB】VB用纯API设计图形界面窗口程序
这个略鬼畜，请看图：看起来好像很正常，但是它是用纯API就像C语言写界面一样设计出来的，而并不是用Form弄出来的界面。
这是VB最蛋疼的写法了。有Form不用，用API创建窗体。
当然对于大家来说，这个可以帮助你们了解VB使用窗口API的方法。
下载地址：
Option Explicit '保存为bas文件
'VB完全可以不这么来的，因为VB本身就是这些API封装好了的语言。
'当然我这样写其实是为了演示Windows程序如何通过API进行窗口创建和消息循环。
'这也证明了VB在这方面的实力。
'从VB6开始，VB的程序不再是解释执行的了。
'结构体定义
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 Type
Type POINTAPI
X As Long
Y As Long
End Type
Type Msg
hWnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
'API声明
Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, lpCursorName As Any) As Long
Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (pcWndClassEx As WNDCLASSEX) As Long
Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, lpClassName As Any, 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
Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long
Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long
Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (lpClassName As Any, ByVal hInstance As Long) As Long
Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long
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
Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
'常数定义
Global Const WM_DESTROY = &H2
Global Const IDC_ARROW = 32512
Global Const CW_USEDEFAULT = &H80000000
Global Const WS_CAPTION = &HC00000
Global Const WS_SYSMENU = &H80000
Global Const WS_THICKFRAME = &H40000
Global Const WS_MINIMIZEBOX = &H20000
Global Const WS_MAXIMIZEBOX = &H10000
Global Const WS_VISIBLE = &H10000000
Global Const WS_OVERLAPPEDWINDOW = WS_VISIBLE Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
Global Const SW_SHOWNORMAL = 1
'定义变量
Global g_WCEx As WNDCLASSEX
Global g_ClassAtom As Long
Global g_hWnd As Long
Sub Main()
With g_WCEx
.cbSize = LenB(g_WCEx)
.lpfnWndProc = GetAddressOfFunction(AddressOf WndProc)
.hInstance = App.hInstance
.hCursor = LoadCursor(0, ByVal IDC_ARROW) '默认光标
.hbrBackground = (vbButtonFace And &H7FFFFFFF) + 1 '去掉最高位就是COLOR_BTNFACE了
.lpszClassName = "VBWIN32APPBYUSINGAPI" '翻译成中文就是“用API的VB的Win32的应用程序”
End With
g_ClassAtom = RegisterClassEx(g_WCEx)
If g_ClassAtom = 0 Then
MsgBox "注册窗口类失败。", vbExclamation
Exit Sub
End If
g_hWnd = CreateWindowEx(0, ByVal g_ClassAtom, "VB的API窗口", WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 888, 666, 0, 0, App.hInstance, ByVal 0)
If g_hWnd = 0 Then
MsgBox "创建窗口失败。", vbExclamation
UnregisterClass ByVal g_ClassAtom, App.hInstance
Exit Sub
End If
ShowWindow g_hWnd, SW_SHOWNORMAL
UpdateWindow g_hWnd
Dim Message As Msg
Do While GetMessage(Message, 0, 0, 0)
TranslateMessage Message
DispatchMessage Message
Loop
UnregisterClass ByVal g_ClassAtom, App.hInstance
End Sub
Function WndProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal WP As Long, ByVal LP As Long) As Long
Select Case wMsg
Case WM_DESTROY
PostQuitMessage 0
Case Else
WndProc = DefWindowProc(hWnd, wMsg, WP, LP)
End Select
End Function
Function GetAddressOfFunction(ByVal Value As Long) As Long
GetAddressOfFunction = Value
End Function
论坛有你真的精彩~ 占排位
页:
[1]