Public Class cApp
Private bCls As String
Private hwnd As IntPtr
Private Const WS_VISIBLE As Integer = &H10000000
Private Const WS_POPUP As Integer = &H80000000
Private Const WS_SYSMENU As Integer = &H80000
Private Const SM_CXSCREEN As Integer = 0
Private Const SM_CYSCREEN As Integer = 1
Private Const CS_DBLCLKS As Integer = &H8
Private Structure WNDCLASSEX
Public cbSize As Int32
Public hIconSm As Int32
Public hIcon As Int32
Public hCursor As Int32
Public hbrBackground As Int32
Public lpszMenuName As String
Public lpszClassName As String
Public cbClsExtra As Int32
Public cbWndExtra As Int32
Public hInstance As IntPtr
Public lpfnWndProc As WNDPROC
Public style As Int32
End Structure
Private Structure MSG
Public hwnd As Int32
Public time As Int32
Public pt As POINTAPI
Public wParam As Int32
Public lParam As Int32
Public message As Int32
End Structure
Private Structure POINTAPI
Public x As Long
Public y As Long
End Structure
Private Delegate Function WNDPROC(ByVal hWnd As IntPtr, ByVal message As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Int32
Private Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (ByRef pcWndClassEx As WNDCLASSEX) As Int32
Private Declare Function GetCurrentProcessId Lib "kernel32" () As IntPtr
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As IntPtr, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Int32
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Int32, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Int32, ByVal x As Int32, ByVal y As Int32, ByVal nWidth As Int32, ByVal nHeight As Int32, ByVal hWndParent As Int32, ByVal hMenu As Int32, ByVal hInstance As IntPtr, ByVal lpParam As IntPtr) As IntPtr
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Int32) As Int32
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (ByRef lpMsg As MSG, ByVal hwnd As Int32, ByVal wMsgFilterMin As Int32, ByVal wMsgFilterMax As Int32, ByVal wRemoveMsg As Int32) As Int32
Private Declare Function TranslateMessage Lib "user32" (ByVal lpMsg As MSG) As Int32
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (ByVal lpMsg As MSG) As Int32
Private Declare Function WaitMessage Lib "user32" () As Int32
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (ByVal lpMsg As MSG, ByVal hwnd As Int32, ByVal wMsgFilterMin As Int32, ByVal wMsgFilterMax As Int32) As Int32
Public Function RegClass(ByVal pCls As String)
Dim wndcls As New WNDCLASSEX
wndcls.cbSize = System.Runtime.InteropServices.Marshal.SizeOf(wndcls)
wndcls.cbClsExtra = 0
wndcls.cbWndExtra = 0
wndcls.hInstance = GetCurrentProcessId
wndcls.lpszClassName = pCls
wndcls.style = CS_DBLCLKS
wndcls.lpfnWndProc = AddressOf MyProc
bCls = pCls
Return (RegisterClassEx(wndcls))
End Function
Public Function Create(ByVal ptitle As String)
hwnd = CreateWindowEx(0, bCls, ptitle, WS_VISIBLE Or WS_POPUP Or WS_SYSMENU, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), Nothing, Nothing, GetCurrentProcessId, Nothing)
Return (Not hwnd.ToInt32 = 0)
End Function
Private Function MyProc(ByVal hWnd As IntPtr, ByVal message As Int32, ByVal wParam As Int32, ByVal lParam As Int32) As Int32
Return DefWindowProc(hWnd, message, wParam, lParam)
End Function
Public Function Run() As Boolean
Dim msgs As MSG
While (True)
If (PeekMessage(msgs, Nothing, 0, 0, 0)) Then
If (Not GetMessage(msgs, Nothing, 0, 0)) Then
Return msgs.wParam
End If
TranslateMessage(msgs)
DispatchMessage(msgs)
Else
WaitMessage()
End If
End While
Return True
End Function
End Class