Search Tools Links Login

Create a Window without a Form !!!


This module demonstrates how to generate a Window using the API. Why use the Visual Basic FormDesigner when you can use the API?
Okay it's much easier to
use the Designer, but a good VB-Developer has to see and understand a module like this ;-).
I have translated the C++ - Code (MSDNSDK) to VB.

Original Author: Henning Tillmann

Assumptions

Create a new Project and add a module. Remove Form1. Add the following API Declarations and the code.

API Declarations


Private Declare Function apiRegisterClass Lib "user32" _
Alias "RegisterClassA" _
(Class As WNDCLASS) As Long
Private Declare Function apiCreateWindowEx 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


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

Private Declare Function apiLoadCursor Lib "user32" _
Alias "LoadCursorA" _
(ByVal hInstance As Long, _
ByVal lpCursorName As String) As Long

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

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

Private Declare Function apiDefWindowProc Lib "user32" _
Alias "DefWindowProcA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Private Declare Function apiSetWindowPos Lib "user32" _
Alias "SetWindowPos" _
(ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Private Declare Function apiUnregisterClass Lib "user32" _
Alias "UnregisterClassA" _
(ByVal lpClassName As String, _
ByVal hInstance As Long) As Long
Private 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 Const CS_OWNDC = &H20
Private Const CS_VREDRAW = &H1
Private Const CS_HREDRAW = &H2
Private Const IDI_APPLICATION = 32512&
Private Const IDC_ARROW = 32512&
Private Const COLOR_WINDOW = 5
Private Const WS_OVERLAPPED = &H0&
Private Const WS_CAPTION = &HC00000
Private Const WS_SYSMENU = &H80000
Private Const WS_THICKFRAME = &H40000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Private Const WS_HSCROLL = &H100000
Private Const WS_VSCROLL = &H200000
Const HT_CLASSNAME = "PlanetSourceCodeTest"
Const HT_WINDOWTITLE = "HELLO WORLD!"
Dim hWnd As Long

Code

Sub Main()
  Dim WC As WNDCLASS
  Dim dwRetVal As Long
  Dim msgWnd As MSG
  
  WC.lpszClassName = HT_CLASSNAME
  WC.lpfnwndproc = GetAddressOf(AddressOf MainWndProc)
  WC.style = CS_OWNDC Or CS_VREDRAW Or CS_HREDRAW
  WC.hInstance = App.hInstance
  WC.hIcon = apiLoadIcon(0, IDI_APPLICATION)
  WC.hCursor = apiLoadCursor(0, IDC_ARROW)
  WC.hbrBackground = COLOR_WINDOW
  WC.cbClsextra = 0
  WC.cbWndExtra2 = 0
  
  dwRetVal = apiRegisterClass(WC)
  Debug.Print "RegisterClass returns '" & CStr(dwRetVal) & "'."
  
  hWnd = apiCreateWindowEx(0, HT_CLASSNAME, HT_WINDOWTITLE, WS_OVERLAPPEDWINDOW, 0, 0, 0, 0, 0, 0, App.hInstance, 0)
  Debug.Print "CreateWindowEx returns hWnd '" & CStr(hWnd) & "'."
  
  dwRetVal = apiSetWindowPos(hWnd, 0, 200, 200, 300, 300, &H40)
  Debug.Print "SetWindowPos returns '" & CStr(dwRetVal) & "'."
  
  Do While apiGetMessage(msgWnd, hWnd, 0&, 0&) > 0
   apiDispatchMessage msgWnd ': DoEvents
  Loop
  
  dwRetVal = apiUnregisterClass(HT_CLASSNAME, App.hInstance)
  Debug.Print "UnregisterClass returns '" & CStr(dwRetVal) & "'."
End Sub
Private Function MainWndProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  MainWndProc = apiDefWindowProc(hWnd, wMsg, wParam, lParam)
End Function
Private Function GetAddressOf(ProcAddress As Long) As Long
  GetAddressOf = ProcAddress
End Function

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 126 times

Categories

Visual Basic 6

Attachments

No attachments for this post


Loading Comments ...

Comments

No comments have been added for this post.

You must be logged in to make a comment.