用api函数createwindow等不知行不行,我没有试过。

解决方案 »

  1.   

    就是想通过代码来完成:当往VB工程中添加一个窗体时,VB在后台完成的工作,窗体也是类,只是估计是不可以创建的类,能不能通过类似创建不可创建类的方法创建窗体,例如:CREATEOBJECT之类的方法来加载。
         我想应该是可以的,只是一直都不知道要加载哪个基类。望大侠指点,不甚感激。
      

  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 ''Will hold address of the old window proc for the button
    Public gHwnd As Long, gButtonHwnd As Long, gEditHwnd As Long ''You don't necessarily need globals, but if you're planning to gettext and stuff, then you're gona have to store the hwnds.
      

  3.   

    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
        
        ''Registers our new window with windows so we
        ''can use our classname.
        
        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
      
        ''Create actual window.
        gHwnd& = CreateWindowEx(0&, gClassName$, gAppName$, WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 208, 150, 0&, 0&, App.hInstance, ByVal 0&)
        ''Create button
        gButtonHwnd& = CreateWindowEx(0&, "Button", "Click Here", WS_CHILD, 58, 90, 85, 25, gHwnd&, 0&, App.hInstance, 0&)
        ''Create textbox with a border (WS_EX_CLIENTEDGE) and make it multi-line (ES_MULTILINE)
        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&)    
        ''Since windows are hidden, show them. You can use UpdateWindow to
        ''redraw the client area.
        Call ShowWindow(gHwnd&, SW_SHOWNORMAL)
        Call ShowWindow(gButtonHwnd&, SW_SHOWNORMAL)
        Call ShowWindow(gEditHwnd&, SW_SHOWNORMAL)
        
        ''Get the memory address of the default window
        ''procedure for the button and store it in gButOldProc
        ''This will be used in ButtonWndProc to call the original
        ''window procedure for processing.
        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  ''This our default window procedure for the window. It will handle all
      ''of our incoming window messages and we will write code based on the
      ''window message what the program should do.  Dim strTemp As String    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
    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:
              ''Left mouse button went up (user clicked the button)
              ''You can use WM_LBUTTONDOWN for the MouseDown event.
              
              ''We use the MessageBox API call because the built in
              ''function 'MsgBox' stops thread processes, which causes
              ''flickering.
              Call MessageBox(gHwnd&, "You clicked the button!", App.Title, MB_OK Or MB_ICONEXCLAMATION)
        End Select
        
      ''Since in MyCreateWindow we made the default window proc
      ''this procedure, we have to call the old one using CallWindowProc
      ButtonWndProc = CallWindowProc(gButOldProc&, hwnd&, uMsg&, wParam&, lParam&)
       
    End Function
    Public Function GetAddress(ByVal lngAddr As Long) As Long
        ''Used with AddressOf to return the address in memory of a procedure.    GetAddress = lngAddr&
        
    End Function
      

  4.   

    创建窗体你必须把它添加到control中,要不然vb不会知道该窗体的存在!
      

  5.   

    何必那么复杂呢
    Dim frmNewForm as Form
         Set frmNewForm = New Form1‘改成from1就行了 
         frmNewForm.show
      

  6.   

    private sub command1_click()
    dim Frm1 as new form1frm1.show
    end sub
      

  7.   

    hillmanweb(山人) 的方法是凭空创建窗体的方法
      

  8.   

    使用Add方法建立新窗体呢,可以吗?
      

  9.   

    不可以除了从已有的窗体继承外
    只能用RegisterClass注册窗口类,用CreateWindowEx创建窗口
      

  10.   

    dim newform as form1
    newform.show试试