windows API的功能真是强大

 立此存照.

Java代码

1. Option Explicit   
2. Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long   
3.   Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long   
4.   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   
5.   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   
6.   Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)   
7.   Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long   
8.   Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long   
9.   Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long   
10.   Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long   
11.   Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long   
12.   Declare Function DefMDIChildProc Lib "user32" Alias "DefMDIChildProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long   
13.   '     Define   information   of   the   window   (pointed   to   by   hWnd)   
14.   Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long   
15.   Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long   
16.   Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long   
17.        
18.   Type WNDCLASS   
19.           style   As Long   
20.           lpfnwndproc   As Long   
21.           cbClsextra   As Long   
22.           cbWndExtra2   As Long   
23.           hInstance   As Long   
24.           hIcon   As Long   
25.           hCursor   As Long   
26.           hbrBackground   As Long   
27.           lpszMenuName   As String   
28.           lpszClassName   As String   
29.   End Type   
30.   Type POINTAPI   
31.           x   As Long   
32.           y   As Long   
33.   End Type   
34.   Type Msg   
35.           hWnd   As Long   
36.           message   As Long   
37.           wParam   As Long   
38.           lParam   As Long   
39.           time   As Long   
40.           pt   As POINTAPI   
41.   End Type   
42.        
43.   '   Class   styles   
44.   Public Const CS_VREDRAW = &H1   
45.   Public Const CS_HREDRAW = &H2   
46.   Public Const CS_KEYCVTWINDOW = &H4   
47.   Public Const CS_DBLCLKS = &H8   
48.   Public Const CS_OWNDC = &H20   
49.   Public Const CS_CLASSDC = &H40   
50.   Public Const CS_PARENTDC = &H80   
51.   Public Const CS_NOKEYCVT = &H100   
52.   Public Const CS_NOCLOSE = &H200   
53.   Public Const CS_SAVEBITS = &H800   
54.   Public Const CS_BYTEALIGNCLIENT = &H1000   
55.   Public Const CS_BYTEALIGNWINDOW = &H2000   
56.   Public Const CS_PUBLICCLASS = &H4000   
57.   '   Window   styles   
58.   Public Const WS_OVERLAPPED = &H0&   
59.   Public Const WS_POPUP = &H80000000   
60.   Public Const WS_CHILD = &H40000000   
61.   Public Const WS_MINIMIZE = &H20000000   
62.   Public Const WS_VISIBLE = &H10000000   
63.   Public Const WS_DISABLED = &H8000000   
64.   Public Const WS_CLIPSIBLINGS = &H4000000   
65.   Public Const WS_CLIPCHILDREN = &H2000000   
66.   Public Const WS_MAXIMIZE = &H1000000   
67.   Public Const WS_CAPTION = &HC00000                                             '     WS_BORDER   Or   WS_DLGFRAME   
68.   Public Const WS_BORDER = &H800000   
69.   Public Const WS_DLGFRAME = &H400000   
70.   Public Const WS_VSCROLL = &H200000   
71.   Public Const WS_HSCROLL = &H100000   
72.   Public Const WS_SYSMENU = &H80000   
73.   Public Const WS_THICKFRAME = &H40000   
74.   Public Const WS_GROUP = &H20000   
75.   Public Const WS_TABSTOP = &H10000   
76.   Public Const WS_MINIMIZEBOX = &H20000   
77.   Public Const WS_MAXIMIZEBOX = &H10000   
78.   Public Const WS_TILED = WS_OVERLAPPED   
79.   Public Const WS_ICONIC = WS_MINIMIZE   
80.   Public Const WS_SIZEBOX = WS_THICKFRAME   
81.   Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)   
82.   Public Const WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW   
83.   Public Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)   
84.   Public Const WS_CHILDWINDOW = (WS_CHILD)   
85.   '   ExWindowStyles   
86.   Public Const WS_EX_DLGMODALFRAME = &H1&   
87.   Public Const WS_EX_NOPARENTNOTIFY = &H4&   
88.   Public Const WS_EX_TOPMOST = &H8&   
89.   Public Const WS_EX_ACCEPTFILES = &H10&   
90.   Public Const WS_EX_TRANSPARENT = &H20&   
91.   '   Color   constants   
92.   Public Const COLOR_SCROLLBAR = 0  
93.   Public Const COLOR_BACKGROUND = 1  
94.   Public Const COLOR_ACTIVECAPTION = 2  
95.   Public Const COLOR_INACTIVECAPTION = 3  
96.   Public Const COLOR_MENU = 4  
97.   Public Const COLOR_WINDOW = 5  
98.   Public Const COLOR_WINDOWFRAME = 6  
99.   Public Const COLOR_MENUTEXT = 7  
100.   Public Const COLOR_WINDOWTEXT = 8  
101.   Public Const COLOR_CAPTIONTEXT = 9  
102.   Public Const COLOR_ACTIVEBORDER = 10  
103.   Public Const COLOR_INACTIVEBORDER = 11  
104.   Public Const COLOR_APPWORKSPACE = 12  
105.   Public Const COLOR_HIGHLIGHT = 13  
106.   Public Const COLOR_HIGHLIGHTTEXT = 14  
107.   Public Const COLOR_BTNFACE = 15  
108.   Public Const COLOR_BTNSHADOW = 16  
109.   Public Const COLOR_GRAYTEXT = 17  
110.   Public Const COLOR_BTNTEXT = 18  
111.   Public Const COLOR_INACTIVECAPTIONTEXT = 19  
112.   Public Const COLOR_BTNHIGHLIGHT = 20  
113.   '   Window   messages   
114.   Public Const WM_NULL = &H0   
115.   Public Const WM_CREATE = &H1   
116.   Public Const WM_DESTROY = &H2   
117.   Public Const WM_MOVE = &H3   
118.   Public Const WM_SIZE = &H5   
119.   '   ShowWindow   commands   
120.   Public Const SW_HIDE = 0  
121.   Public Const SW_SHOWNORMAL = 1  
122.   Public Const SW_NORMAL = 1  
123.   Public Const SW_SHOWMINIMIZED = 2  
124.   Public Const SW_SHOWMAXIMIZED = 3  
125.   Public Const SW_MAXIMIZE = 3  
126.   Public Const SW_SHOWNOACTIVATE = 4  
127.   Public Const SW_SHOW = 5  
128.   Public Const SW_MINIMIZE = 6  
129.   Public Const SW_SHOWMINNOACTIVE = 7  
130.   Public Const SW_SHOWNA = 8  
131.   Public Const SW_RESTORE = 9  
132.   Public Const SW_SHOWDEFAULT = 10  
133.   Public Const SW_MAX = 10  
134.   '   Standard   ID's   of   cursors   
135.   Public Const IDC_ARROW = 32512&   
136.   Public Const IDC_IBEAM = 32513&   
137.   Public Const IDC_WAIT = 32514&   
138.   Public Const IDC_CROSS = 32515&   
139.   Public Const IDC_UPARROW = 32516&   
140.   Public Const IDC_SIZE = 32640&   
141.   Public Const IDC_ICON = 32641&   
142.   Public Const IDC_SIZENWSE = 32642&   
143.   Public Const IDC_SIZENESW = 32643&   
144.   Public Const IDC_SIZEWE = 32644&   
145.   Public Const IDC_SIZENS = 32645&   
146.   Public Const IDC_SIZEALL = 32646&   
147.   Public Const IDC_NO = 32648&   
148.   Public Const IDC_APPSTARTING = 32650&   
149.   Public Const GWL_WNDPROC = -4  
150.   
151. Dim hwnd2     As Long, hwnd3       As Long, old_proc       As Long, new_proc       As Long   
152.   Public Sub Main()   
153.           'KPD-Team   1999  
154.           'URL:   http://www.allapi.net/   
155.           'E-Mail:   KPDTeam@Allapi.net   
156.           Dim lngTemp     As Long   
157.           '   Register   class  
158.           If MyRegisterClass Then   
159.                   '   Window   created?   
160.                   If MyCreateWindow Then   
161.                   '   Change   the   button's   procedures   
162.                   '   Point   to   new   address   
163.                           new_proc = GetMyWndProc(AddressOf ButtonProc)   
164.                           old_proc = SetWindowLong(hwnd2, GWL_WNDPROC, new_proc)   
165.                           '   Message   loop   
166.                           MyMessageLoop   
167.                   End If   
168.                   '   Unregister   Class   
169.                   MyUnregisterClass   
170.           End If   
171.   End Sub   
172.   Private Function MyRegisterClass() As Boolean   
173.           '   WNDCLASS-structure   
174.           Dim wndcls     As WNDCLASS   
175.           wndcls.style = CS_HREDRAW + CS_VREDRAW   
176.           wndcls.lpfnwndproc = GetMyWndProc(AddressOf MyWndProc)   
177.           wndcls.cbClsextra = 0  
178.           wndcls.cbWndExtra2 = 0  
179.           wndcls.hInstance = App.hInstance   
180.           wndcls.hIcon = 0  
181.           wndcls.hCursor = LoadCursor(0, IDC_ARROW)   
182.           wndcls.hbrBackground = COLOR_WINDOW   
183.           wndcls.lpszMenuName = 0  
184.           wndcls.lpszClassName = "myWindowClass"  
185.           '   Register   class  
186.           MyRegisterClass = (RegisterClass(wndcls) <> 0)   
187.   End Function   
188.   Private Sub MyUnregisterClass()   
189.           UnregisterClass "myWindowClass", App.hInstance   
190.   End Sub   
191.   Private Function MyCreateWindow() As Boolean   
192.           Dim hWnd     As Long   
193.           '   Create   the   window   
194.           hWnd = CreateWindowEx(0, "myWindowClass", "My   Window", WS_OVERLAPPEDWINDOW, 0, 0, 400, 300, 0, 0, App.hInstance, ByVal 0&)   
195.           '   The   Button   and   Textbox   are   child   windows   
196.           hwnd2 = CreateWindowEx(0, "Button", "My   button", WS_CHILD, 50, 55, 100, 25, hWnd, 0, App.hInstance, ByVal 0&)   
197.           hwnd3 = CreateWindowEx(0, "edit", "My   textbox", WS_CHILD, 50, 25, 100, 25, hWnd, 0, App.hInstance, ByVal 0&)   
198.           If hWnd <> 0 Then ShowWindow hWnd, SW_SHOWNORMAL   
199.           '   Show   them   
200.           ShowWindow hwnd2, SW_SHOWNORMAL   
201.           ShowWindow hwnd3, SW_SHOWNORMAL   
202.           '   Go   back   
203.           MyCreateWindow = (hWnd <> 0)   
204.   End Function   
205.   Private Function MyWndProc(ByVal hWnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long   
206.              
207.           Select Case message   
208.                   Case WM_DESTROY   
209.                           '   Destroy   window   
210.                           PostQuitMessage (0)   
211.           End Select   
212.           '   calls   the   default   window   procedure   
213.           MyWndProc = DefWindowProc(hWnd, message, wParam, lParam)   
214.   End Function   
215.   Function GetMyWndProc(ByVal lWndProc As Long) As Long   
216.           GetMyWndProc = lWndProc   
217.   End Function   
218.   Private Sub MyMessageLoop()   
219.           Dim aMsg     As Msg   
220.           Do While GetMessage(aMsg, 0, 0, 0)   
221.                   DispatchMessage aMsg   
222.           Loop   
223.   End Sub   
224.   Private Function ButtonProc(ByVal hWnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long   
225.           Dim x     As Integer   
226.           If (message = 533) Then   
227.                   x = MsgBox("You   clicked   on   the   button", vbOKOnly)   
228.           End If   
229.           '   calls   the   window   procedure   
230.           ButtonProc = CallWindowProc(old_proc, hWnd, message, wParam, lParam)   
231.   End Function