Last night I was feeling a little bored and I happend to come across a
bit of code I wrote way back in the VB5 days. This code, was a simple
little windows application - but was created strictly using the windows
API. In other words, no forms. Just a module with a sub main. If your
interested in looking at it, you can find the code here:
http://www.mtogden.com/~tom/backup/code.html
Anyway, I thought it might be kind of interesting to convert this to
VB.NET. So, here you go. A simple windows application - with no forms:
Option Strict On
Option Explicit On
Imports System.Runtime. InteropServices
Public Class Window
Private Const CLASS_NAME As String = "VB_NET_WIN DOW"
Private Const APP_TITLE As String = "API Window from VB.NET"
' API Constants
Private Const WS_CAPTION As Integer = &HC00000
Private Const WS_MAXIMIZEBOX As Integer = &H10000
Private Const WS_MINIMIZEBOX As Integer = &H20000
Private Const WS_OVERLAPPED As Integer = &H0
Private Const WS_SYSMENU As Integer = &H80000
Private Const WS_THICKFRAME As Integer = &H40000
Private Const WS_OVERLAPPEDWI NDOW As Integer = _
(WS_OVERLAPPED Or _
WS_CAPTION Or _
WS_SYSMENU Or _
WS_THICKFRAME Or _
WS_MINIMIZEBOX Or _
WS_MAXIMIZEBOX)
Private Const CS_HREDRAW As Integer = &H2
Private Const CS_VREDRAW As Integer = &H1
Private Const IDI_APPLICATION As Integer = 32512
Private Const IDC_ARROW As Integer = 32512
Private Const LTGRAY_BRUSH As Integer = 1
Private Const SW_SHOWNORMAL As Integer = 1
Private Const WM_DESTROY As Integer = &H2
Private Const WM_LBUTTONDOWN As Integer = &H201
Private Const WM_RBUTTONDOWN As Integer = &H204
Private Const MB_OK As Integer = &H0
' Delegate instance for our window procedure...
Private Delegate Function WndProcDelgate _
(ByVal hWnd As IntPtr, _
ByVal Message As Integer, _
ByVal wParam As IntPtr, _
ByVal lParam As IntPtr) As IntPtr
' API Defined Types
<StructLayout(L ayoutKind.Seque ntial, CharSet:=CharSe t.Auto)> _
Private Structure WNDCLASSEX
Public cbSize As Integer ' Size in bytes of the WNDCLASSEX structure
Public style As Integer ' Class style
Public lpfnWndProc As WndProcDelgate ' Pointer to the classes Window Procedure
Public cbClsExtra As Integer ' Number of extra bytes to allocate for class
Public cbWndExtra As Integer ' Number of extra bytes to allocate for window
Public hInstance As IntPtr ' Applications instance handle Class
Public hIcon As IntPtr ' Handle to the classes icon
Public hCursor As IntPtr ' Handle to the classes cursor
Public hbrBackground As IntPtr ' Handle to the classes background brush
Public lpszMenuName As String ' Resource name of class menu
Public lpszClassName As String ' Name of the Window Class
Public hIconSm As IntPtr ' Handle to the classes small icon
End Structure
<StructLayout(L ayoutKind.Seque ntial)> _
Private Structure POINTAPI
Public x As Integer ' X-Coordinate in pixels
Public y As Integer ' Y-Coordinate in pixels
End Structure
<StructLayout(L ayoutKind.Seque ntial, CharSet:=CharSe t.Auto)> _
Private Structure MSG
Public hWnd As IntPtr ' Window handle of the associated window
Public Message As Integer ' Message identifier
Public wParam As IntPtr ' Additional message info
Public lParam As IntPtr ' Additional message info
Public time As Integer ' Time message was posted
Public pt As POINTAPI ' Cursor position when message was posted
End Structure
' API Declare Statements
Private Declare Auto Function LoadCursor Lib "user32" _
(ByVal hInstance As IntPtr, _
ByVal lpCursorName As IntPtr) As IntPtr
Private Declare Auto Function LoadIcon Lib "user32" _
(ByVal hInstance As IntPtr, _
ByVal lpIconName As IntPtr) As IntPtr
Private Declare Auto Function RegisterClassEx Lib "user32" _
(ByRef pcWndClassEx As WNDCLASSEX) As Integer
Private Declare Auto Function CreateWindowEx Lib "user32" _
(ByVal dwExStyle As Integer, _
ByVal lpClassName As String, _
ByVal lpWindowName As String, _
ByVal dwStyle As Integer, _
ByVal x As Integer, _
ByVal y As Integer, _
ByVal nWidth As Integer, _
ByVal nHeight As Integer, _
ByVal hWndParent As IntPtr, _
ByVal hMenu As IntPtr, _
ByVal hInstance As IntPtr, _
ByVal lpParam As IntPtr) As IntPtr
Private Declare Function ShowWindow Lib "user32" _
(ByVal hWnd As IntPtr, _
ByVal nCmdShow As Integer) As Boolean
Private Declare Function UpdateWindow Lib "user32" _
(ByVal hWnd As IntPtr) As Boolean
Private Declare Auto Function GetMessage Lib "user32" _
(ByRef lpMsg As MSG, _
ByVal hWnd As IntPtr, _
ByVal wMsgFilterMin As Integer, _
ByVal wMsgFilterMax As Integer) As Boolean
Private Declare Function TranslateMessag e Lib "user32" _
(ByRef lpMsg As MSG) As Boolean
Private Declare Auto Function DispatchMessage Lib "user32" _
(ByRef lpMsg As MSG) As IntPtr
Private Declare Sub PostQuitMessage Lib "user32" _
(ByVal nExitCode As Integer)
Private Declare Function GetStockObject Lib "gdi32" _
(ByVal nIndex As Integer) As IntPtr
Private Declare Auto Function MessageBox Lib "user32" _
(ByVal hWnd As IntPtr, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Integer) As Integer
Private Declare Function SetFocus Lib "user32" _
(ByVal hWnd As IntPtr) As IntPtr
Private Declare Auto Function DefWindowProc Lib "user32" _
(ByVal hWnd As IntPtr, _
ByVal wMsg As Integer, _
ByVal wParam As IntPtr, _
ByVal lParam As IntPtr) As IntPtr
Public Sub New()
Dim wndClass As WNDCLASSEX
Dim hWnd As IntPtr
Dim message As MSG
Dim hInstance As IntPtr = Marshal.GetHINS TANCE(GetType(W indow).Module)
With wndClass
.cbSize = Marshal.SizeOf( wndClass)
.style = CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc = New WndProcDelgate( AddressOf WndProc)
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = hInstance
.hIcon = LoadIcon(hInsta nce, New IntPtr(IDI_APPL ICATION))
.hIconSm = LoadIcon(hInsta nce, New IntPtr(IDI_APPL ICATION))
.hCursor = LoadCursor(hIns tance, New IntPtr(IDC_ARRO W))
.hbrBackground = GetStockObject( LTGRAY_BRUSH)
.lpszMenuName = Nothing
.lpszClassName = CLASS_NAME
End With
' register the class
RegisterClassEx (wndClass)
' Create the window
hWnd = CreateWindowEx _
(0, _
CLASS_NAME, _
APP_TITLE, _
WS_OVERLAPPEDWI NDOW, _
0, _
0, _
640, _
480, _
IntPtr.Zero, _
IntPtr.Zero, _
hInstance, _
IntPtr.Zero)
ShowWindow(hWnd , SW_SHOWNORMAL)
UpdateWindow(hW nd)
SetFocus(hWnd)
Do While GetMessage(mess age, IntPtr.Zero, 0, 0)
TranslateMessag e(message)
DispatchMessage (message)
Loop
End Sub
Private Function WndProc(ByVal hWnd As IntPtr, _
ByVal Message As Integer, _
ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
Select Case Message
Case WM_LBUTTONDOWN
MessageBox(hWnd , "Left Mouse Button Pressed", APP_TITLE, MB_OK)
Return IntPtr.Zero
Case WM_RBUTTONDOWN
MessageBox(hWnd , "Right Mouse Button Pressed", APP_TITLE, MB_OK)
Return IntPtr.Zero
Case WM_DESTROY
PostQuitMessage (0)
Return IntPtr.Zero
Case Else
Return DefWindowProc(h Wnd, Message, wParam, lParam)
End Select
End Function
Public Shared Sub Main()
Dim wnd As New Window
End Sub
End Class
It doesn't do anything - but it was sort of ammusing :)
--
Tom Shelton
MVP [Visual Basic]
