Ayuda crear formulario en tiempo de ejecuciÃ³n

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

Private Type POINTAPI
x As Long
y As Long
End Type

Private Type Msg
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Public Declare Function SetMenu Lib "user32.dll" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Public Declare Function CreateMenu Lib "user32.dll" () As Long
Public Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Public Declare Function CreatePopupMenu Lib "user32.dll" () As Long

Public Declare Function TextOut Lib "gdi32.dll" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Public Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) 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 RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long
'Window API Stuff for createing and showing a window
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, lpParam As Any) 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 DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long

'APIs used for dealing with the window messages
Public Declare Function GetMessage Lib "user32.dll" 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.dll" (lpMsg As Msg) As Long
Public Declare Function DispatchMessage Lib "user32.dll" Alias "DispatchMessageA" (lpMsg As Msg) 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, lParam As Any) As Long

'Window Style consts see API Viewer for more
Private Const WS_SYSMENU As Long = &H80000
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_MINIMIZE As Long = &H20000000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const WS_THICKFRAME As Long = &H40000
Private Const WS_SIZEBOX As Long = WS_THICKFRAME
'API MessageBox consts
Public Const MB_OK As Long = &H0&
Public Const MB_ICONASTERISK As Long = &H40&
Public Const MB_ICONEXCLAMATION As Long = &H30&
Public Const MB_ICONQUESTION As Long = &H20&
Public Const MB_ICONINFORMATION As Long = MB_ICONASTERISK
Public Const MB_YESNO As Long = &H4&

'Default X and Y position of were the window is placed
Public Const CW_USEDEFAULT As Long = &H80000000

Public Const WindowStyle = WS_SYSMENU + WS_CAPTION + WS_MINIMIZEBOX + WS_MAXIMIZEBOX + WS_SIZEBOX
Public Const SW_NORMAL As Long = 1 'Show the window in normal mode also see API View for more

Public WinHwnd As Long, WndDC As Long ' Hangle for the window to be created and the DC Hangle
Public wc As WNDCLASS
'Public wc As WNDCLASS ' Class type information for our window to be created
Public WinMsg As Msg ' Used to hold the messages of a window

Public WindowCaption As String ' Caption of our the window
Public WinClassName As String 'Our new window's ClassName

'Used for windows messages
Public Const WM_CLOSE As Long = &H10
Public Const WM_DESTROY As Long = &H2
Public Const WM_MOUSEMOVE As Long = &H200
Public Const WM_SIZE As Long = &H5
Public Const WM_CREATE As Long = &H1
Public Const WM_COMMAND As Long = &H111
' Public consts that Identify the menu items been clicked
Public Const DM_MENU_ABOUT = 1
Public Const DM_MENU_EXIT = 2
'Menu consts
Public Const MF_POPUP As Long = &H10&
Public Const MF_APPEND As Long = &H100&
Public Const MF_STRING As Long = &H0&
Public Const MF_SEPARATOR As Long = &H800&

Function LoWord(ByVal DWord As Long) As Integer
If DWord And &H8000& Then
LoWord = DWord Or &HFFFF0000
Else
LoWord = DWord And &HFFFF&
End If
End Function

Function HiWord(ByVal DWord As Long) As Integer
HiWord = (DWord And &HFFFF0000) \ 65536
End Function

' Hi All
' This is some code I wipped up about an hour ago and shows you how to create a Window / Form from just API Calls
' Why I am I reiventing the wheel. since I been using C++ I noticed in VB we take eveything for granted.
' I mean almost eveything is done for you. I my self like to see exacly how something is working.
' And if you use C++ then you see exacly that.

' IN VB as we all know a from is simple you click add form and Bingo there you have a form.
' But how did it get there? how was it created by Magic umm I thing not, well with any look this example should expain
' how it is created.
' Ok at the moment the code only support some basic things such as

' Createing a new widnow from class information we give it
' Displaying the new window
' Identifying messages and dealing with them
' Displaying a Message Box with only API
' I also added a menu to the window that is also API Created

' Well hope you like this code I will try and get a new update mabe add some
' other controls to it such as editboxes. static lables and statusbars etc

' PS Note to beginners running this code always make sure you save your work when using this code
' If you want to close down the example do it in the correct way File->Exit or click the X
' Doing this by just by clicking the stop button in VB IDE will crash simple

Sub main()
' This is the part that loads our window first
WindowCaption = "MY API Created Window" 'Caption for our new window
WinClassName = "MyWinClass" 'Class name for our window

'Fill the class struc with the information needed for the new window
With wc
.lpfnwndproc = GetAddress(AddressOf WinProc)
.cbClsextra = 0
.cbWndExtra2 = 0
.hInstance = App.hInstance
.lpszMenuName = vbNullString
.style = 0
.hbrBackground = 16
.lpszClassName = WinClassName
End With

If RegisterClass(wc) = 0 Then ' Check if the windows class was registered
MessageBox 0, "RegisterClass Faild.", "Error", MB_ICONEXCLAMATION Or MB_OK
End
Else
' Create the window
WinHwnd = CreateWindowEx(0&, WinClassName, WindowCaption, _
WindowStyle, CW_USEDEFAULT, CW_USEDEFAULT, 240, 120, 0, 0, App.hInstance, ByVal 0&)

If WinHwnd = 0 Then ' Check if the window was created
MessageBox 0, "CreateWindowEx Faild.", "Error", MB_ICONEXCLAMATION Or MB_OK
Exit Sub
End
Else
WndDC = GetDC(WinHwnd) ' Get the Windows DC
ShowWindow WinHwnd, SW_NORMAL ' Show the window in normal mode
UpdateWindow WinHwnd ' Update the new window

'Do the Message Loop
Do While GetMessage(WinMsg, WinHwnd, 0, 0) > 0
TranslateMessage WinMsg
DispatchMessage WinMsg
DoEvents
Loop
End If
End If

End Sub

Private Sub PrintToToWindow(lpStr As String, Optional xPos As Long = 10, Optional yPos As Long = 10)
' All the little function does is print out some text to the window
TextOut WndDC, xPos, yPos, lpStr, Len(lpStr)
End Sub

Function WinProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
' This function is used to hangle all the messages that the window will recive
Dim sTmp As String
Dim ans As Integer
Dim hMenu As Long, hSubMenu As Long

Select Case wMsg
Case WM_CREATE ' Window is created
hMenu = CreateMenu() ' Create a new menu for our window
hSubMenu = CreatePopupMenu() ' Create a popup menu that we put out sub-items into
AppendMenu hMenu, MF_STRING Or MF_POPUP, hSubMenu, "&File" ' Top Level Menu
AppendMenu hSubMenu, MF_STRING, DM_MENU_ABOUT, "&About" ' Sub item
AppendMenu hSubMenu, MF_STRING, DM_MENU_EXIT, "E&xit.." ' Sub Item
AppendMenu hSubMenu, MF_SEPARATOR, -1, 0&
AppendMenu hSubMenu, MF_STRING, 3, "Add other items here" ' Sub Item
SetMenu hwnd, hMenu ' update the window with our menu
MessageBox WinHwnd, "Your API Window has been created", "VB-API Window App", MB_OK Or MB_ICONINFORMATION
Exit Function
Case WM_COMMAND
Select Case wParam
Case DM_MENU_EXIT ' menu exit
SendMessage hwnd, WM_CLOSE, ByVal 0&, ByVal 0&
Exit Function
Case DM_MENU_ABOUT
' Display an about messagebox
MessageBox hwnd, "ALL API Window Created by Ben Jones", "About..", MB_ICONINFORMATION Or MB_OK
Exit Function
End Select

Case WM_CLOSE ' User has clicked the X on the form so we need to destroy the window
ans = MessageBox(WinHwnd, "Do you want to quite this program now?", "Quit...", MB_ICONQUESTION Or MB_YESNO)
If ans = vbNo Then Exit Function ' If the users answer was yes then we can then destroy the window
DestroyWindow WinHwnd
'Case WM_DESTROY ' Using this seems to close down the VB IDE so make sure you save any work first
'PostQuitMessage 0
Case WM_MOUSEMOVE
UpdateWindow WinHwnd
' Use is moveing the mouse lets show the x and y positions
sTmp = "x = " & LoWord(lParam) & ", " & " y = " & HiWord(lParam) ' Str(LoWord(lParam) & " , " & Str(HiWord(lParam)))
PrintToToWindow sTmp, 10, 10
sTmp = ""
Exit Function
Case WM_SIZE ' Window is resizeing
MessageBox WinHwnd, "Windows has been resize.", "WM_SIZE", MB_OK Or MB_ICONINFORMATION
Exit Function
Case Else
WinProc = DefWindowProc(hwnd, wMsg, wParam, lParam) ' Keep fireing the messages back to the window
End Select

End Function

Function GetAddress(Address) As Long
GetAddress = Address
End Function