Windows程序设计读书笔记(用VB调用API创建窗口)

 最近在学习Program Windows这本巨著.
非常不幸,电脑上没有装VC,不过有VB.
能不能用VB来跑跑其中的程序呢.
答案是可以的.
代码如下,立此存照.
先是API,结果,常量的定义引入

Java代码

1. '方法定义   
2. 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   
3. Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As String) As Long   
4. Public Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long   
5. Public Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long   
6. Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long   
7. 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   
8. Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long   
9. Public Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long   
10. 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   
11. Public Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long   
12. Public Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As Long   
13. Public Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)   
14. Public Declare Function BeginPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long   
15. Public Declare Function EndPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long   
16. Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long   
17. Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long   
18.   
19.   
20. '下面是数据类型定义   
21. Public Type WNDCLASS   
22.     style As Long   
23.     lpfnwndproc As Long   
24.     cbClsextra As Long   
25.     cbWndExtra2 As Long   
26.     hInstance As Long   
27.     hIcon As Long   
28.     hCursor As Long   
29.     hbrBackground As Long   
30.     lpszMenuName As String   
31.     lpszClassName As String   
32. End Type   
33.   
34. Public Type POINTAPI   
35.         x As Long   
36.         y As Long   
37. End Type   
38.   
39. Public Type MSG   
40.     hwnd As Long   
41.     message As Long   
42.     wParam As Long   
43.     lParam As Long   
44.     time As Long   
45.     pt As POINTAPI   
46. End Type   
47.   
48. Public Type RECT   
49.         Left As Long   
50.         Top As Long   
51.         Right As Long   
52.         Bottom As Long   
53. End Type   
54.   
55.   
56. Public Type PAINTSTRUCT   
57.         hdc As Long   
58.         fErase As Long   
59.         rcPaint As RECT   
60.         fRestore As Long   
61.         fIncUpdate As Long   
62.         rgbReserved(32) As Byte   
63. End Type   
64.   
65. '下面是常数定义   
66. Public Const CS_HREDRAW = &H2   
67. Public Const CS_VREDRAW = &H1   
68.   
69. Public Const IDC_ARROW = 32512&   
70.   
71. Public Const WHITE_BRUSH = 0  
72. Public Const COLOR_WINDOW = 5  
73.   
74. Public Const WS_OVERLAPPED = &H0&   
75. Public Const WS_CAPTION = &HC00000                  '  WS_BORDER Or WS_DLGFRAME   
76. Public Const WS_SYSMENU = &H80000   
77. Public Const WS_THICKFRAME = &H40000   
78. Public Const WS_MINIMIZE = &H20000000   
79. Public Const WS_MINIMIZEBOX = &H20000   
80. Public Const WS_MAXIMIZEBOX = &H10000   
81. Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)   
82.   
83.   
84. Public Const CW_USEDEFAULT = &H80000000   
85.   
86. Public Const SW_SHOWNORMAL = 1  
87.   
88. Public Const WM_DESTROY = &H2   
89. Public Const WM_PAINT = &HF   
90.   
91. Public Const DT_SINGLELINE = &H20   
92. Public Const DT_CENTER = &H1   
93. Public Const DT_VCENTER = &H4  

'方法定义
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 Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As String) As Long
Public Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Public Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long
Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
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 ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
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 Long
Public Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
Public Declare Function BeginPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
Public Declare Function EndPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long


'下面是数据类型定义
Public Type WNDCLASS
    style As Long
    lpfnwndproc As Long
    cbClsextra As Long
    cbWndExtra2 As Long
    hInstance As Long
    hIcon As Long
    hCursor As Long
    hbrBackground As Long
    lpszMenuName As String
    lpszClassName As String
End Type

Public Type POINTAPI
        x As Long
        y As Long
End Type

Public Type MSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type


Public Type PAINTSTRUCT
        hdc As Long
        fErase As Long
        rcPaint As RECT
        fRestore As Long
        fIncUpdate As Long
        rgbReserved(32) As Byte
End Type

'下面是常数定义
Public Const CS_HREDRAW = &H2
Public Const CS_VREDRAW = &H1

Public Const IDC_ARROW = 32512&

Public Const WHITE_BRUSH = 0
Public Const COLOR_WINDOW = 5

Public Const WS_OVERLAPPED = &H0&
Public Const WS_CAPTION = &HC00000                  '  WS_BORDER Or WS_DLGFRAME
Public Const WS_SYSMENU = &H80000
Public Const WS_THICKFRAME = &H40000
Public Const WS_MINIMIZE = &H20000000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)


Public Const CW_USEDEFAULT = &H80000000

Public Const SW_SHOWNORMAL = 1

Public Const WM_DESTROY = &H2
Public Const WM_PAINT = &HF

Public Const DT_SINGLELINE = &H20
Public Const DT_CENTER = &H1
Public Const DT_VCENTER = &H4

下面是代码

Java代码

1. Option Explicit   
2. '代码从program windows这本书里面抄过来   
3. '改造成直接调用windowsAPI的形式   
4.   
5. Public Sub Main()   
6.        
7.     '1定义一个window类型   
8.     Dim wndclass1 As WNDCLASS   
9.     wndclass1.style = CS_HREDRAW + CS_VREDRAW   
10.     wndclass1.lpfnwndproc = GetMyWndProc(AddressOf WndProc)   
11.     wndclass1.cbClsextra = 0  
12.     wndclass1.cbWndExtra2 = 0  
13.     wndclass1.hInstance = App.hInstance   
14.     wndclass1.hIcon = 0  
15.     wndclass1.hCursor = LoadCursor(0, IDC_ARROW)   
16.     wndclass1.hbrBackground = COLOR_WINDOW   
17.     wndclass1.lpszMenuName = 0  
18.     wndclass1.lpszClassName = "myhello1"  
19.        
20.     '2注册这个window类   
21.     If RegisterClass(wndclass1) = 0 Then   
22.         MsgBox "This program need WindowsNT!", vbOKOnly, "register failed!"  
23.         Exit Sub   
24.     Else   
25.         'MsgBox "register ok"  
26.     End If   
27.        
28.     '3.创建一个window窗口出来   
29.     Dim hwnd As Long   
30.     hwnd = CreateWindowEx(0, "myhello1", "mywindow", WS_OVERLAPPEDWINDOW, _   
31.     CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0, 0, App.hInstance, ByVal 0&)   
32.     If hwnd <> 0 Then   
33.         MsgBox "create window ok."  
34.         'ShowWindow hwnd, SW_SHOWNORMAL   
35.         'UpdateWindow hwnd   
36.     Else   
37.         MsgBox "create window fail."  
38.         Exit Sub   
39.     End If   
40.            
41.     ShowWindow hwnd, SW_SHOWNORMAL   
42.     UpdateWindow hwnd   
43.            
44.                
45.     '4.消息处理   
46.     Dim msg1 As MSG   
47.     Do While GetMessage(msg1, hwnd, 0, 0) > 0  
48.         TranslateMessage msg1   
49.         DispatchMessage msg1   
50.     Loop   
51.        
52.     MsgBox ("unregister window class")   
53.     '3取消类的注册   
54.     UnregisterClass "myhello1", App.hInstance   
55.        
56. End Sub   
57.   
58. 'window procedure   
59. '窗口消息处理程序   
60. '先不进行额外处理   
61. Private Function WndProc(ByVal hwnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long   
62.     Select Case (message)   
63.         Case WM_PAINT   
64.             Dim ps As PAINTSTRUCT   
65.             Dim hdc As Long   
66.             Dim rect1 As RECT   
67.                
68.             hdc = BeginPaint(hwnd, ps)   
69.             GetClientRect hwnd, rect1   
70.             DrawText hdc, "Hello, Windows 98!", -1, rect1, _   
71.                     DT_SINGLELINE + DT_CENTER + DT_VCENTER   
72.             EndPaint hwnd, ps   
73.              
74.             WndProc = 0  
75.             Exit Function   
76.         Case WM_DESTROY   
77.             PostQuitMessage (0)   
78.             WndProc = 0  
79.             Exit Function   
80.     End Select   
81.         WndProc = DefWindowProc(hwnd, message, wParam, lParam)   
82. End Function   
83.   
84. '得到回调函数地址的方法   
85. Function GetMyWndProc(ByVal lWndProc As Long) As Long   
86.         GetMyWndProc = lWndProc   
87. End Function