我的程序: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 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 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 Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Public Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) 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 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
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPublic Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode 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 TypePublic Const CS_VREDRAW = &H1Public Const CS_HREDRAW = &H2Public Const CW_USEDEFAULT = &H80000000Public Const ES_MULTILINE = &H4&Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOREDRAW = &H8
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_SHOWWINDOW = &H40
Public Const SWP_NOCOPYBITS = &H80
Public Const SWP_NOOWNERZORDER = &H200
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Public Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2Public Const WS_BORDER = &H800000
Public Const WS_CHILD = &H40000000
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_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 WS_EX_CLIENTEDGE = &H200&Public Const COLOR_WINDOW = 5Public Const WM_DESTROY = &H2
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202Public Const IDC_ARROW = 32512&Public Const IDI_APPLICATION = 32512&Public Const GWL_WNDPROC = (-4)
Public Const SW_SHOWNORMAL = 1Public Const MB_OK = &H0&
Public Const MB_ICONEXCLAMATION = &H30&Public Const gClassName = "MyClassName"
Public Const gAppName = "My Window Caption"Public gButOldProc As Long
Public gHwnd As Long, gButtonHwnd As Long, gEditHwnd As LongPublic Sub C_Window() Dim wMsg As Msg 'Call procedure to register window classname. If false, then exit.
If RegisterWindowClass = False Then Exit Sub
'Create window
If CreateWindows Then
'Loop will exit when WM_QUIT is sent to the window.
Do While GetMessage(wMsg, 0&, 0&, 0&)
'TranslateMessage takes keyboard messages and converts
'them to WM_CHAR for easier processing.
Call TranslateMessage(wMsg)
'Dispatchmessage calls the default window procedure
'to process the window message. (WndProc)
Call DispatchMessage(wMsg)
Loop
End If Call UnregisterClass(gClassName$, App.hInstance)
End SubPublic Function RegisterWindowClass() As Boolean Dim wc As WNDCLASS
wc.style = CS_HREDRAW Or CS_VREDRAW
wc.lpfnwndproc = GetAddress(AddressOf WndProc) 'Address in memory of default window procedure.
wc.hInstance = App.hInstance
wc.hIcon = LoadIcon(0&, IDI_APPLICATION) 'Default application icon
wc.hCursor = LoadCursor(0&, IDC_ARROW) 'Default arrow
wc.hbrBackground = COLOR_WINDOW 'Default a color for window.
wc.lpszClassName = gClassName$ RegisterWindowClass = RegisterClass(wc) <> 0
End FunctionPublic Function CreateWindows() As Boolean
'Begin creat window 'Main Window
' gHwnd& = CreateWindowEx(0&, gClassName$, gAppName$, WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 208, 150, 0&, 0&, App.hInstance, ByVal 0&)
' Call ShowWindow(gHwnd&, SW_SHOWNORMAL)
' Call SetWindowPos(gHwnd&, HWND_TOPMOST, 0, 0, 300, 300, SWP_NOACTIVATE)
CreateWindows = (gHwnd& <> 0)
End FunctionPublic Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim strTemp As String Select Case uMsg&
Case WM_DESTROY:
Call PostQuitMessage(0&)
End Select ''Let windows call the default window procedure since we're done.
WndProc = DefWindowProc(hwnd&, uMsg&, wParam&, lParam&)End FunctionPublic Function GetAddress(ByVal lngAddr As Long) As Long
GetAddress = lngAddr&
End FunctionPrivate Sub Command1_Click()
Dim i, j As Integer
Dim FileName As String
Dim filenum As Integer
Dim Point As Long
Dim prvPoint As Long Call C_Window
i = 100
MsgBox "The value of I is " & iEnd Sub
我点击某个按键,调用C_Window过程,打开一个窗口,我的问题就出来了,我不把这个窗口关闭,我的后续程序就不能运行。也就是
i = 100
MsgBox "The value of I is " & i这段程序就不能运行
Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
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 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 Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Public Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) 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 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
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPublic Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode 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 TypePublic Const CS_VREDRAW = &H1Public Const CS_HREDRAW = &H2Public Const CW_USEDEFAULT = &H80000000Public Const ES_MULTILINE = &H4&Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOZORDER = &H4
Public Const SWP_NOREDRAW = &H8
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_SHOWWINDOW = &H40
Public Const SWP_NOCOPYBITS = &H80
Public Const SWP_NOOWNERZORDER = &H200
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Public Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Public Const HWND_TOP = 0
Public Const HWND_BOTTOM = 1
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2Public Const WS_BORDER = &H800000
Public Const WS_CHILD = &H40000000
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_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 WS_EX_CLIENTEDGE = &H200&Public Const COLOR_WINDOW = 5Public Const WM_DESTROY = &H2
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202Public Const IDC_ARROW = 32512&Public Const IDI_APPLICATION = 32512&Public Const GWL_WNDPROC = (-4)
Public Const SW_SHOWNORMAL = 1Public Const MB_OK = &H0&
Public Const MB_ICONEXCLAMATION = &H30&Public Const gClassName = "MyClassName"
Public Const gAppName = "My Window Caption"Public gButOldProc As Long
Public gHwnd As Long, gButtonHwnd As Long, gEditHwnd As LongPublic Sub C_Window() Dim wMsg As Msg 'Call procedure to register window classname. If false, then exit.
If RegisterWindowClass = False Then Exit Sub
'Create window
If CreateWindows Then
'Loop will exit when WM_QUIT is sent to the window.
Do While GetMessage(wMsg, 0&, 0&, 0&)
'TranslateMessage takes keyboard messages and converts
'them to WM_CHAR for easier processing.
Call TranslateMessage(wMsg)
'Dispatchmessage calls the default window procedure
'to process the window message. (WndProc)
Call DispatchMessage(wMsg)
Loop
End If Call UnregisterClass(gClassName$, App.hInstance)
End SubPublic Function RegisterWindowClass() As Boolean Dim wc As WNDCLASS
wc.style = CS_HREDRAW Or CS_VREDRAW
wc.lpfnwndproc = GetAddress(AddressOf WndProc) 'Address in memory of default window procedure.
wc.hInstance = App.hInstance
wc.hIcon = LoadIcon(0&, IDI_APPLICATION) 'Default application icon
wc.hCursor = LoadCursor(0&, IDC_ARROW) 'Default arrow
wc.hbrBackground = COLOR_WINDOW 'Default a color for window.
wc.lpszClassName = gClassName$ RegisterWindowClass = RegisterClass(wc) <> 0
End FunctionPublic Function CreateWindows() As Boolean
'Begin creat window 'Main Window
' gHwnd& = CreateWindowEx(0&, gClassName$, gAppName$, WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 208, 150, 0&, 0&, App.hInstance, ByVal 0&)
' Call ShowWindow(gHwnd&, SW_SHOWNORMAL)
' Call SetWindowPos(gHwnd&, HWND_TOPMOST, 0, 0, 300, 300, SWP_NOACTIVATE)
CreateWindows = (gHwnd& <> 0)
End FunctionPublic Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim strTemp As String Select Case uMsg&
Case WM_DESTROY:
Call PostQuitMessage(0&)
End Select ''Let windows call the default window procedure since we're done.
WndProc = DefWindowProc(hwnd&, uMsg&, wParam&, lParam&)End FunctionPublic Function GetAddress(ByVal lngAddr As Long) As Long
GetAddress = lngAddr&
End FunctionPrivate Sub Command1_Click()
Dim i, j As Integer
Dim FileName As String
Dim filenum As Integer
Dim Point As Long
Dim prvPoint As Long Call C_Window
i = 100
MsgBox "The value of I is " & iEnd Sub
我点击某个按键,调用C_Window过程,打开一个窗口,我的问题就出来了,我不把这个窗口关闭,我的后续程序就不能运行。也就是
i = 100
MsgBox "The value of I is " & i这段程序就不能运行
'Loop will exit when WM_QUIT is sent to the window.
Do While GetMessage(wMsg, 0&, 0&, 0&)
'TranslateMessage takes keyboard messages and converts
'them to WM_CHAR for easier processing.
Call TranslateMessage(wMsg)
'Dispatchmessage calls the default window procedure
'to process the window message. (WndProc)
Call DispatchMessage(wMsg)
Loop这一段程序不要,这样倒是不用关闭窗口就可以把我后面的
i = 100
MsgBox "The value of I is " & i这段程序运行,但是会发生我把新开的窗口关闭的时候,整个程序出错,程序关闭。
不好意思,第一次写API函数,比较弱,