回 帖 发 新 帖 刷新版面

主题:在VB中,用API建窗体的问题

在VB中,程序用sub main启动,用API建了个窗体,当窗体销毁时,进程不会结束,此时CPU狂飙至100%,这是怎么回事?是不是代码有问题,消息响应都很正常,在C下写也不会,就是VB里会出现这问题!

符上我的代码:
'**********************常数*********************************
Public Const IDC_ARROW As Long = 32512&
Public Const IDI_APPLICATION As Long = 32512&
Public Const CS_VREDRAW As Long = &H1
Public Const CS_HREDRAW As Long = &H2
Public Const CS_OWNDC As Long = &H20
Public Const WS_OVERLAPPED As Long = &H0&
Public Const WS_CAPTION As Long = &HC00000
Public Const WS_SYSMENU As Long = &H80000
Public Const WS_THICKFRAME As Long = &H40000
Public Const WS_MINIMIZEBOX As Long = &H20000
Public Const WS_MAXIMIZEBOX As Long = &H10000
Public Const WS_OVERLAPPEDWINDOW As Long = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Public Const CW_USEDEFAULT As Long = &H80000000
Public Const MB_OK As Long = &H0&
Public Const SW_NORMAL As Long = 1
Public Const WM_DESTROY As Long = &H2
Public Const WM_LBUTTONDOWN As Long = &H201
Public Const WM_CLOSE As Long = &H10
Public Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Public Const SYNCHRONIZE As Long = &H100000
Public Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)

'**********************类型*********************************
Public 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
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 Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Public Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Public Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Public Declare Function LoadIcon Lib "user32.dll" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long) As Long
Public Declare Function RegisterClassEx Lib "user32.dll" Alias "RegisterClassExA" (ByRef pcWndClassEx As WNDCLASSEX) As Integer
Public Declare Function CreateWindowEx Lib "user32.dll" 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, ByRef lpParam As Any) As Long
Public Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function UpdateWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Public Declare Function GetMessage Lib "user32.dll" Alias "GetMessageA" (ByRef lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Public Declare Function TranslateMessage Lib "user32.dll" (ByRef lpMsg As MSG) As Long
Public Declare Function DispatchMessage Lib "user32.dll" Alias "DispatchMessageA" (ByRef lpMsg As MSG) As Long
Public Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Sub PostQuitMessage Lib "user32.dll" (ByVal nExitCode As Long)
Public Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Public Declare Function TerminateProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public Declare Function GetCurrentProcessId Lib "kernel32.dll" () As Long
Public Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

'****************开始*****************************************
Sub Main()
    Dim wndClass As WNDCLASSEX
    Dim hwnd As Long
    Dim wndMsg As MSG
    
    With wndClass
        .cbClsExtra = 0&
        .cbSize = Len(wndClass)
        .cbWndExtra = 0&
        .hbrBackground = CreateSolidBrush(&HD4D0C8)
        .hCursor = LoadCursor(GetModuleHandle(Chr(0)), IDC_ARROW)
        .hIcon = LoadIcon(GetModuleHandle(Chr(0)), IDI_APPLICATION)
        .hIconSm = 0&
        .hInstance = GetModuleHandle(Chr(0))
        .lpfnWndProc = getFunAddress(AddressOf wndProc)
        .lpszClassName = "My Window"
        .lpszMenuName = Chr(0)
        .style = CS_VREDRAW Or CS_HREDRAW Or CS_OWNDC
    End With
    
    RegisterClassEx wndClass
    
    hwnd = CreateWindowEx(0, "My Window", "Window", WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, 0&, 0&, GetModuleHandle(Chr(0)), ByVal 0&)
    If hwnd = 0& Then
        MessageBox 0&, "Create window fail", "Fail", MB_OK
        Exit Sub
    End If
    
    ShowWindow hwnd, SW_NORMAL
    UpdateWindow hwnd
    
    Do While GetMessage(wndMsg, hwnd, 0&, 0&)
        TranslateMessage wndMsg
        DispatchMessage wndMsg
    Loop
End Sub


Public Function wndProc(ByVal hwnd As Long, ByVal wndMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case wndMsg
        Case WM_LBUTTONDOWN
            MessageBox 0&, "正常", "正常", MB_OK
        Case WM_DESTROY
            PostQuitMessage 0&
            'SendMessage hwnd, 0&, 0&, 0&
    End Select
    wndProc = DefWindowProc(hwnd, wndMsg, wParam, lParam)
End Function

Public Function getFunAddress(ByVal funAddr As Long) As Long
    getFunAddress = funAddr
End Function

回复列表 (共1个回复)

沙发

问题找到,就此结贴
GetMessage(wndMsg, 0&, 0&, 0&)

另:感谢anbry提供的帮助

我来回复

您尚未登录,请登录后再回复。点此登录或注册