' Ein Fenster per Code erstellen
Sub Main()
  Dim OwnClass As WNDCLASS
  Dim hwnd As Long
  Dim ClassAtom As Long
  Dim RetVal As Long
 
  ' Klasse beschreiben
  With OwnClass
    .style = CS_OWNDC Or CS_HREDRAW Or CS_VREDRAW
    .lpfnWndProc = GetFuncAddress(AddressOf WindowProc)
    .hInstance = App.hInstance
    .lpszClassName = "MeineKlasse"
    .hbrBackground = COLOR_APPWORKSPACE
  End With
 
  ' Neue Klasse registrieren
  ClassAtom = RegisterClass(OwnClass)
  If ClassAtom = 0 Then
    MsgBox "Die Fensterklasse konnte nicht registriert" & _
      " werden.", vbInformation, "Fehler"
      End
  End If
 
  ' Fenster erstellen
  Dim NormalStyles As Long
  Dim xPos As Long, yPos As Long
 
  NormalStyles = WS_OVERLAPPEDWINDOW Or WS_CAPTION Or _
    WS_BORDER Or WS_VISIBLE
 
  ' Positopn (zentriert)
  xPos = (Screen.Width / Screen.TwipsPerPixelX - 320) / 2
  yPos = (Screen.Height / Screen.TwipsPerPixelY - 200) / 2
 
  ' Größe 320x200
  hwnd = CreateWindowEx(WS_EX_APPWINDOW, "MeineKlasse", _
    "Hallo Welt !!!", NormalStyles, xPos, yPos, 320&, _
    200&, 0&, 0&, App.hInstance, ByVal 0&)
 
 
  ' Fenster konnte nicht erstellt werden
  If hwnd = 0 Then
    MsgBox "Das Fenster konnte nicht erstellt werden.", _
      vbInformation, "Fehler"
  Else
    ' Fenster anzeigen und Schleife durchlaufen,
    ' bis das Fenster geschlossen wird
    ShowWindow hwnd, 1
    SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
    SetFocus hwnd
 
    Do
      DoEvents
    Loop While WindowClose = False
 
    ' Klasse wieder deregistrieren
    RetVal = UnregisterClass("MeineKlasse", App.hInstance)
    If RetVal = 0 Then
        MsgBox "Fehler beim Deregistrieren der " & _
                "Fensterklasse", vbCritical, "Fehler"
    End If
  End If
End Sub
 
' Die Fensterprozedur unseres selbsterzeugten Fensters
' Hier treffen alle Ereigniss ein
Public Function WindowProc(ByVal hwnd As Long, _
  ByVal uMsg As Long, ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
 
  ' Auf bestimmte Ereignisse reagieren
  Select Case uMsg
    Case WM_DESTROY
        ' Fenster schließen
        WindowClose = True
 
    Case WM_MOVE
      ' Fenster verschieben
      Debug.Print "Das Fenster wird verschoben"
  End Select
 
  ' Standard-Prozedur aufrufen und Ergebnis zurückgeben
  WindowProc = DefWindowProc(hwnd, uMsg, wParam, _
    lParam)
End Function
 
' Dient nur zum Ermitteln der Funktionsadresse von
' WindowProc
Private Function GetFuncAddress(ByVal Address As Long) _
  As Long
 
  GetFuncAddress = Address
End Function