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

0xAA55

这个略鬼畜，请看图：

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

2014-4-16 16:50 上传

点击文件名下载附件

0xAA55

1. Option Explicit '保存为bas文件
   
2. 
   
3. 'VB完全可以不这么来的，因为VB本身就是这些API封装好了的语言。
   
4. '当然我这样写其实是为了演示Windows程序如何通过API进行窗口创建和消息循环。
   
5. '这也证明了VB在这方面的实力。
   
6. '从VB6开始，VB的程序不再是解释执行的了。
   
7. 
   
8. '结构体定义
   
9. Type WNDCLASSEX
   
10.     cbSize As Long
    
11.     style As Long
    
12.     lpfnWndProc As Long
    
13.     cbClsExtra As Long
    
14.     cbWndExtra As Long
    
15.     hInstance As Long
    
16.     hIcon As Long
    
17.     hCursor As Long
    
18.     hbrBackground As Long
    
19.     lpszMenuName As String
    
20.     lpszClassName As String
    
21.     hIconSm As Long
    
22. End Type
    
23. Type POINTAPI
    
24.     X As Long
    
25.     Y As Long
    
26. End Type
    
27. Type Msg
    
28.     hWnd As Long
    
29.     Message As Long
    
30.     wParam As Long
    
31.     lParam As Long
    
32.     time As Long
    
33.     pt As POINTAPI
    
34. End Type
    
35. 
    
36. 'API声明
    
37. Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, lpCursorName As Any) As Long
    
38. Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (pcWndClassEx As WNDCLASSEX) As Long
    
39. 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
    
40. Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
    
41. Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
    
42. Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long
    
43. Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long
    
44. Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (lpClassName As Any, ByVal hInstance As Long) As Long
    
45. Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long
    
46. 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
    
47. Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
    
48. 
    
49. '常数定义
    
50. Global Const WM_DESTROY = &H2
    
51. Global Const IDC_ARROW = 32512
    
52. Global Const CW_USEDEFAULT = &H80000000
    
53. Global Const WS_CAPTION = &HC00000
    
54. Global Const WS_SYSMENU = &H80000
    
55. Global Const WS_THICKFRAME = &H40000
    
56. Global Const WS_MINIMIZEBOX = &H20000
    
57. Global Const WS_MAXIMIZEBOX = &H10000
    
58. Global Const WS_VISIBLE = &H10000000
    
59. Global Const WS_OVERLAPPEDWINDOW = WS_VISIBLE Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
    
60. Global Const SW_SHOWNORMAL = 1
    
61. 
    
62. '定义变量
    
63. Global g_WCEx As WNDCLASSEX
    
64. Global g_ClassAtom As Long
    
65. Global g_hWnd As Long
    
66. 
    
67. Sub Main()
    
68. With g_WCEx
    
69.     .cbSize = LenB(g_WCEx)
    
70.     .lpfnWndProc = GetAddressOfFunction(AddressOf WndProc)
    
71.     .hInstance = App.hInstance
    
72.     .hCursor = LoadCursor(0, ByVal IDC_ARROW) '默认光标
    
73.     .hbrBackground = (vbButtonFace And &H7FFFFFFF) + 1 '去掉最高位就是COLOR_BTNFACE了
    
74.     .lpszClassName = "VBWIN32APPBYUSINGAPI" '翻译成中文就是“用API的VB的Win32的应用程序”
    
75. End With
    
76. g_ClassAtom = RegisterClassEx(g_WCEx)
    
77. If g_ClassAtom = 0 Then
    
78.     MsgBox "注册窗口类失败。", vbExclamation
    
79.     Exit Sub
    
80. End If
    
81. g_hWnd = CreateWindowEx(0, ByVal g_ClassAtom, "VB的API窗口", WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 888, 666, 0, 0, App.hInstance, ByVal 0)
    
82. If g_hWnd = 0 Then
    
83.     MsgBox "创建窗口失败。", vbExclamation
    
84.     UnregisterClass ByVal g_ClassAtom, App.hInstance
    
85.     Exit Sub
    
86. End If
    
87. ShowWindow g_hWnd, SW_SHOWNORMAL
    
88. UpdateWindow g_hWnd
    
89. Dim Message As Msg
    
90. Do While GetMessage(Message, 0, 0, 0)
    
91.     TranslateMessage Message
    
92.     DispatchMessage Message
    
93. Loop
    
94. UnregisterClass ByVal g_ClassAtom, App.hInstance
    
95. End Sub
    
96. 
    
97. Function WndProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal WP As Long, ByVal LP As Long) As Long
    
98. Select Case wMsg
    
99.     Case WM_DESTROY
    
100.         PostQuitMessage 0
     
101.     Case Else
     
102.         WndProc = DefWindowProc(hWnd, wMsg, WP, LP)
     
103. End Select
     
104. End Function
     
105. 
     
106. Function GetAddressOfFunction(ByVal Value As Long) As Long
     
107. GetAddressOfFunction = Value
     
108. End Function
     
109. 
     

复制代码

xiawan

论坛有你真的精彩~

liu496324

占排位