Binaryworld - Creating an API Window (Using C Style Message Loop and Window Proc) ... [ VB -> Windows ]

Sometimes you might need to create a window using code on the fly. Many times I have been asked that why do I write this odd code to create a very simple form,I can use VB form instead of Dynamic C style window creation....

Now here is the answer

One common use of this technique in socket programming is to create a hidden window (i.e form) on the fly and use that Window Handle to receive winsock mesages. CreateWindowEx is not limited to form, you can create any window (i.e. tooltip, button, listbox, combobox...)

This code will show you Pure C Style window creation which responds window messages from Windows Procedure.

To use it, simply create a new standard exe project and add a module to it, remove Form1, and paste the code into the module. Set your project's default startup object to Sub Main, save the code and run it.

Click here to copy the following block

Option Explicit

' Application Defined Constants
Public Const CLASS_NAME As String = "VB_WIN"
Public Const APP_TITLE As String = "API Window from VB"

' API Constants
Public Const WS_CAPTION = &HC00000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_OVERLAPPED = &H0&
Public Const WS_SYSMENU = &H80000
Public Const WS_THICKFRAME = &H40000
Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION _
    Or WS_SYSMENU Or WS_THICKFRAME Or _
    WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Public Const CS_HREDRAW = &H2
Public Const CS_VREDRAW = &H1
Public Const IDI_APPLICATION = 32512&
Public Const IDC_ARROW = 32512&
Public Const LTGRAY_BRUSH = 1
Public Const SW_SHOWNORMAL = 1

Public Const WM_CREATE = &H1
Public Const WM_CLOSE = &H10
Public Const WM_PAINT = &HF
Public Const WM_KEYDOWN = &H100
Public Const WM_KEYUP = &H101
Public Const WM_CHAR = &H102
Public Const WM_DESTROY = &H2
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_RBUTTONDOWN = &H204
Public Const MB_OK = &H0&

' API Defined Types
Public Type WNDCLASSEX
  cbSize As Long      ' Size in bytes of the WNDCLASSEX structure
  style As Long      ' Class style
  lpfnWndProc As Long   ' Pointer to the classes Window Procedure
  cbClsExtra As Long    ' Number of extra bytes to allocate for class
  cbWndExtra As Long    ' Number of extra bytes to allocate for window
  hInstance As Long    ' Applications instance handle Class
  hIcon As Long      ' Handle to the classes icon
  hCursor As Long     ' Handle to the classes cursor
  hbrBackground As Long  ' Handle to the classes background brush
  lpszMenuName As String ' Resource name of class menu
  lpszClassName As String ' Name of the Window Class
  hIconSm As Long     ' Handle to the classes small icon
End Type

Type POINTAPI
  x As Long        ' X-Coordinate in pixels
  y As Long        ' Y-Coordinate in pixels
End Type

Type MSG
  hWnd As Long       ' Window handle of the associated window
  Message As Long     ' Message identifier
  wParam As Long      ' Additional message info
  lParam As Long      ' Additional message info
  time As Long       ' Time message was posted
  pt As POINTAPI      ' Cursor position when message was posted
End Type

' API Declare Statements
Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" _
    (ByVal hInstance As Long, _
    ByVal lpCursorName As String) As Long

Declare Function LoadIcon Lib "user32" Alias "LoadIconA" _
    (ByVal hInstance As Long, _
    ByVal lpIconName As String) As Long

Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" _
    (pcWndClassEx As WNDCLASSEX) As Long

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

Declare Function ShowWindow Lib "user32" _
    (ByVal hWnd As Long, _
    ByVal nCmdShow As Long) As Long

Declare Function UpdateWindow Lib "user32" _
    (ByVal hWnd As Long) As Long

Declare Function GetMessage Lib "user32" Alias "GetMessageA" _
    (lpMsg As MSG, _
    ByVal hWnd As Long, _
    ByVal wMsgFilterMin As Long, _
    ByVal wMsgFilterMax As Long) As Long

Declare Function TranslateMessage Lib "user32" _
    (lpMsg As MSG) As Long

Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" _
    (lpMsg As MSG) As Long

Declare Sub PostQuitMessage Lib "user32" _
    (ByVal nExitCode As Long)

Declare Function GetStockObject Lib "gdi32" _
    (ByVal nIndex As Long) As Long

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

Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long

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

Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
    (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

' **********************************************************************
' SUB: Main
' PURPOSE: This is the default startup procedure it simply provides
' an entry point for the application, all the real work is done in
' the WinMain procedure.
' **********************************************************************
Public Sub Main()
  WinMain         ' Call the WinMain procedure
End Sub
' **********************************************************************
' FUNCTION: WinMain
' PURPOSE: This function coresponds to the WinMain of a standard
' API program. It sets up the WNDCLASSEX structure, registers the
' class, creates the window, then makes sure it is drawn to the
' screen. The last part of the procedure is the main message loop,
' whose job it is to get messages from the queue, translate them and
' dispatch them to the classes Window Procedure.
' **********************************************************************
Public Function WinMain() As Long
  Dim wndClass As WNDCLASSEX  ' Structure that represents our win class
  Dim hWndMain As Long   ' hWnd of our new window
  Dim Message As MSG    ' Hold current system message

  ' Fill in our WNDCLASSEX structure
  With wndClass
    .cbSize = Len(wndClass)
    .style = CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc = GetFunctionPtr(AddressOf WndProc)
    .cbClsExtra = 0
    .cbWndExtra = 0
    .hInstance = App.hInstance
    .hIcon = LoadIcon(App.hInstance, IDI_APPLICATION)
    .hCursor = LoadCursor(App.hInstance, IDC_ARROW)
    .hbrBackground = GetStockObject(LTGRAY_BRUSH)
    .lpszMenuName = vbNullString
    .lpszClassName = CLASS_NAME
    .hIconSm = LoadIcon(App.hInstance, IDI_APPLICATION)
  End With

  ' Register the class
  RegisterClassEx wndClass

  ' Create the window
  hWndMain = CreateWindowEx(0&, CLASS_NAME, APP_TITLE, _
      WS_OVERLAPPEDWINDOW, 0&, 0&, 640&, 480&, 0&, 0&, _
      App.hInstance, 0&)

  ' Show the window and make sure it is drawn and has focus
  ShowWindow hWndMain, SW_SHOWNORMAL
  UpdateWindow hWndMain
  SetFocus hWndMain

  ' Our windows main message loop.
  Do While 0 <> (GetMessage(Message, 0&, 0&, 0&))
    TranslateMessage Message
    DispatchMessage Message
  Loop

  ' return from function
  WinMain = Message.wParam
End Function
' **********************************************************************
' FUNCTION: WndProc
' PURPOSE: This is the Window Procedure for our class, it's purpose
' is to provide handling for all the messages we wish to respond
' to. All other messages are sent on to the Windows Default
' message handler.
' **********************************************************************
Public Function WndProc(ByVal hWnd As Long, ByVal Message As Long, _
            ByVal wParam As Long, ByVal lParam As Long) As Long
  Select Case Message

    Case WM_CREATE
      ' Acknowledge window creation!
    Case WM_CHAR
      ' Bail if escape key was pressed.
      If wParam = vbKeyEscape Then
        Call PostMessage(hWnd, WM_CLOSE, 0, 0)
      Else
        WndProc = DefWindowProc(hWnd, Message, wParam, lParam)
      End If
    Case WM_PAINT
      ' Paint something, anything...
    Case WM_LBUTTONDOWN
      MessageBox hWnd, "Left Mouse Button Pressed", APP_TITLE, MB_OK
      Exit Function
    Case WM_RBUTTONDOWN
      MessageBox hWnd, "Right Mouse Button Pressed", APP_TITLE, MB_OK
      Exit Function
    Case WM_DESTROY
      PostQuitMessage 0&
      Exit Function
    Case Else
      WndProc = DefWindowProc(hWnd, Message, wParam, lParam)
  End Select
End Function
' **********************************************************************
' FUNCTION: GetFunctionPtr
' PURPOSE: To return the address of the procedure passed using the
' AddressOf operater.
' **********************************************************************
Public Function GetFunctionPtr(ByVal Func As Long) As Long
  GetFunctionPtr = Func
End Function