请问VB6环境下怎样开发出没有任何设计窗体完全由API函数在运行期间创建窗体呢？

Question

请问，在VB6.0集成开发环境下，怎样开发出不包含任何设计窗体，工程中只添加一个模块，通过Sub Main()启动，并完全由API函数在运行期间动态创建所需窗体呢？

Answer 1

你只要知道 C++ 如何创建窗体，就知道在 VB 中该如何做了。

Answer 2

http://www.m5home.com/soft/ClassWindow.rar参考这个.

Answer 3

谢谢楼上的朋友！我在CSDN上也找到一个模块——VB 利用API创建窗体的模块代码
 
Option Explicit
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 String) 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 TypePublic Type POINTAPI
    x As Long
    y As Long
End TypePublic 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 'Powered by barenx
'入口函数：
'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 FunctionPublic 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 FunctionPublic Function GetAddress(ByVal lngAddr As Long) As Long
    GetAddress = lngAddr&
End Function本文来自CSDN博客，转载请标明出处：http://blog.csdn.net/barenx/archive/2008/03/29/2227181.aspx

Answer 4

其实没有那么复杂。可以新建一个对话框资源。（需要用VC的资源编辑器，手工链接到VB的EXE里面）
在VB里面使用 DialogBox 函数，再写一个小的窗口过程就实现了。雕虫小技而已，没有实际意义。

Answer 5

#3那个方法可以说是误导
LZ最好别无聊在VB中搞模拟SDK了，去VC实践才是真理。
在VB中模拟SDK还不如自己封装VB没有而需要OCX的Windows控件来得实在，杨过写的那些代码就不错。SDK中有很多创建的方法，注册类啊-创建属于自己类的窗口啊，或者说直接使用#32770也行了
或者说像#4那样，变通在VB里面使用DialogBox资源，直接使用对话框函数生成然后指向一个对话框回调函数就行了。