【VB】VB用纯API设计图形界面窗口程序

0xAA55

这个略鬼畜，请看图：

看起来好像很正常，但是它是用纯API就像C语言写界面一样设计出来的，而并不是用Form弄出来的界面。
这是VB最蛋疼的写法了。有Form不用，用API创建窗体。
当然对于大家来说，这个可以帮助你们了解VB使用窗口API的方法。
下载地址：
VBAPIWin32.7z (4.91 KB, 下载次数: 21, 售价: 1 个宅币)

2014-4-16 16:50 上传

点击文件名下载附件

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

复制代码

xiawan

论坛有你真的精彩~