【API】VB用API编写Win32图形界面程序的方法（别学我）

0xAA55

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

东东哥

我运行，怎么会死机啊？

0xAA55

东东哥 发表于 2021-10-3 18:46
我运行，怎么会死机啊？

你不能直接运行，你要编译为exe来运行。另外，这份代码本身仅作为API调用创建窗体的示范，相当于告诉你如果不使用VB6的界面编辑器，你依然可以进行Win32图形界面开发。请了解。

VB小白

感谢大神，在此学习了。

刚刚好Jackson

谢谢分享，一会下载测试！