如何在VB里用API创建新的对话框?
比如用什么CreateWindowEx(VB里没有CreateWindow API的),又要用到RegisterClassEx API,应该不需要再用那个回调函数了吧,等等,怎么样才能正确的创建一个新对话框呢?
最好是给个代码,要调试正确的。用以下的API不知道能否实现?反正我是没有正确的实现,VB高手们帮俺看看吧,谢谢了:
Private 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
Private Declare Function CreateWindow Lib "user32" Alias "CreateWindowA" (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
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As String) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As wndClass) As Long
Private Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (pcWndClassEx As WNDCLASSEX) As Integer
Private 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
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

解决方案 »

  1.   

    我这里有用纯API创建窗体的代码,需要留下邮箱
      

  2.   

    Option ExplicitPublic 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 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 = &H1
    Public Const CS_HREDRAW = &H2Public Const CW_USEDEFAULT = &H80000000Public Const ES_MULTILINE = &H4&Public 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 Long
     '入口函数:'Sub Main()'代码如下:Public Sub Main()   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 Function
    Public Function CreateWindows() As Boolean
      
        ''''开始创建窗体'主窗体.
        gHwnd& = CreateWindowEx(0&, gClassName$, gAppName$, WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 208, 150, 0&, 0&, App.hInstance, ByVal 0&)
        ''''创建一个按钮
        gButtonHwnd& = CreateWindowEx(0&, "Button", "Click Here", WS_CHILD, 58, 90, 85, 25, gHwnd&, 0&, App.hInstance, 0&)
        ''''创建一个(WS_EX_CLIENTEDGE、ES_MULTILINE风格的TextBox
        gEditHwnd& = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", "This is the edit control." & vbCrLf & "As you can see, it''s multiline.", WS_CHILD Or ES_MULTILINE, 0&, 0&, 200, 80, gHwnd&, 0&, App.hInstance, 0&)'"Button ","Edit"系统中已经注册过了所以这里直接用
        '创建完别忘了显示出来否则是隐藏的    Call ShowWindow(gHwnd&, SW_SHOWNORMAL)
        Call ShowWindow(gButtonHwnd&, SW_SHOWNORMAL)
        Call ShowWindow(gEditHwnd&, SW_SHOWNORMAL)'记下按钮处理过错的当前所在地址gButOldProc& = GetWindowLong(gButtonHwnd&, GWL_WNDPROC)
        
        
        ''''Set default window procedure of button to ButtonWndProc. Different
        ''''settings of windows is listed in the MSDN Library. We are using GWL_WNDPROC
        ''''to set the address of the window procedure.'指向新的处理过程地址
        Call SetWindowLong(gButtonHwnd&, GWL_WNDPROC, GetAddress(AddressOf ButtonWndProc))    CreateWindows = (gHwnd& <> 0)
        
    End Function''窗体运行的主函数,在注册这个窗体时已经指定的
    Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long    Dim strTemp As String'处理消息,这里指处理了WM_DESTROY消息    Select Case uMsg&
           Case WM_DESTROY:
              ''''Since DefWindowProc doesn''t automatically call
              ''''PostQuitMessage (WM_QUIT). We need to do it ourselves.
              ''''You can use DestroyWindow to get rid of the window manually.
              Call PostQuitMessage(0&)
        End Select
          ''''Let windows call the default window procedure since we''re done.
      WndProc = DefWindowProc(hwnd&, uMsg&, wParam&, lParam&)End Function'又添加了一个Button的处理过程Public Function ButtonWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long    Select Case uMsg&
           Case WM_LBUTTONUP:
              Call MessageBox(gHwnd&, "You clicked the button!", App.Title, MB_OK Or MB_ICONEXCLAMATION)
        End Select
        
      ButtonWndProc = CallWindowProc(gButOldProc&, hwnd&, uMsg&, wParam&, lParam&)
       
    End Function
    Public Function GetAddress(ByVal lngAddr As Long) As Long
        GetAddress = lngAddr&
    End Function
      

  3.   

    //如何在VB里用API创建新的对话框?
    什么对话框?最简单的一个例子,相当于msgbox:
    Const MB_DEFBUTTON1 = &H0&
    Const MB_DEFBUTTON2 = &H100&
    Const MB_DEFBUTTON3 = &H200&
    Const MB_ICONASTERISK = &H40&
    Const MB_ICONEXCLAMATION = &H30&
    Const MB_ICONHAND = &H10&
    Const MB_ICONINFORMATION = MB_ICONASTERISK
    Const MB_ICONQUESTION = &H20&
    Const MB_ICONSTOP = MB_ICONHAND
    Const MB_OK = &H0&
    Const MB_OKCANCEL = &H1&
    Const MB_YESNO = &H4&
    Const MB_YESNOCANCEL = &H3&
    Const MB_ABORTRETRYIGNORE = &H2&
    Const MB_RETRYCANCEL = &H5&
    Private 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
    Private Sub Form_Load()
        MessageBox Me.hwnd, "this is test", App.Title, MB_OK
        End
    End Sub
      

  4.   

    其实是这样的,当你新建一个默认的工程时,就已经有一个Form1了,然后就在Form1里添加一个Command或是其实的控件也行,当你单击Command时或是MouseClick其实的可用控件时,就用上面那些所谓的API函数来创建一个对话框的,比如用来创建一个Form或是另一个Command等,就是这样子,也不知道各位大虾们有没弄明白啊Win32SDK编程里不是可以有那些WinMain入口函数的吗?在创建上面的那些Form或是Command时也模拟创建出来,不知能否行得通哦
      

  5.   

    不知道是基于dialog的应用,还是单纯的commondialg
      

  6.   

    也行啊就是在一个程里创建出另一个窗体来啊,只是不用dim oForm as new Form 形式和show方法,而是用API来完成这一系列的过程啊从RegisterClass到,CreateWindow,然后到ShowWindow以及UpdateWindow等等啊,
      

  7.   

    就是说,将上面的代码加入到一个form_load事件里,是会出错的
      

  8.   

    不能加到Form_load 事件里
    应该加到command_click之类的事件里
    因为会循环直到创建的窗体退出
      

  9.   

    //就是说,将上面的代码加入到一个form_load事件里,是会出错的要放到模块中(如果你是指 yunfeng007(一水寒) 那段代码的话)
      

  10.   

    但那样会在CreateWindowEx时出错的