Registering and using a new window class

[XcodeX]

Public Type WNDCLASS 
    style As Long 
    lpfnwndproc As Long 
    cbClsextra As Long 
    cbWndExtra As Long 
    hInstance As Long 
    hIcon As Long 
    hCursor As Long 
    hbrBackground As Long 
    lpszMenuName As Long 
    lpszClassName As Long 
End Type 
 
Public Const COLOR_WINDOW = 5 
 
Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" _ 
(ByVal lpClassName As String, ByVal hInstance As Long) As Long 
Public Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" _ 
(Class As WNDCLASS) As Long 
Public 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 
Public 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 
 
Public Const WS_CHILD = &H40000000 
Public Const WS_BORDER = &H800000 
Public Const WS_VISIBLE = &H10000000 
 
Public Const TEST_CLASS         As String = "TestClass" 
 
Public Const WM_PAINT = &HF 
 
Public Type RECT 
        Left As Long 
        Top As Long 
        Right As Long 
        Bottom As Long 
End Type 
 
Public Declare Function GetClientRect Lib "user32" _ 
(ByVal hwnd As Long, lpRect As RECT) As Long 
Public Declare Function Rectangle Lib "gdi32" _ 
(ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, _ 
ByVal X2 As Long, ByVal Y2 As Long) As Long 
Public Declare Function SelectObject Lib "gdi32" _ 
(ByVal hdc As Long, ByVal hObject As Long) As Long 
Public Declare Function DeleteObject Lib "gdi32" _ 
(ByVal hObject As Long) As Long 
Public Declare Function CreateSolidBrush Lib "gdi32" _ 
(ByVal crColor As Long) As Long 
Public Declare Function CreatePen Lib "gdi32" _ 
(ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long 
 
Public Const PS_SOLID = 0 
 
 
Public Type PAINTSTRUCT 
        hdc As Long 
        fErase As Long 
        rcPaint As RECT 
        fRestore As Long 
        fIncUpdate As Long 
        rgbReserved(32) As Byte 
End Type 
 
Public Declare Function GetDC Lib "user32" _ 
(ByVal hwnd As Long) As Long 
Public Declare Function ReleaseDC Lib "user32" _ 
(ByVal hwnd As Long, ByVal hdc As Long) As Long 
 
Public Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" _ 
(ByVal hdc As Long, ByVal lpsz As String, ByVal n As Long, _ 
lpRect As RECT, ByVal un As Long, lpDrawTextParams As Any) As Long 
Public Declare Function SetTextColor Lib "gdi32" _ 
(ByVal hdc As Long, ByVal crColor As Long) As Long 
Public Declare Function SetBkMode Lib "gdi32" _ 
(ByVal hdc As Long, ByVal nBkMode As Long) As Long 
Public Const TRANSPARENT = 1 
Public Const DT_CENTER = &H1 
Public Const DT_VCENTER = &H4 
Public Const DT_SINGLELINE = &H20 
 
Public Const WM_LBUTTONDOWN = &H201 
Public Const WM_LBUTTONUP = &H202 
 
Private Function GetAddressOf(A As Long) As Long 
    GetAddressOf = A 
End Function 
 
Public Sub UnregisterWindowClass() 
    UnregisterClass TEST_CLASS, App.hInstance 
End Sub 
 
Public Sub RegisterWindowClass() 
    Dim wc              As WNDCLASS 
    Dim hAtom           As Long 
    Dim BytesArray()    As Byte 
     
    'The following code fills the WNDCLASS structure: 
    wc.style = 0 
    wc.lpfnwndproc = GetAddressOf(AddressOf MyWndProc) 
    wc.cbClsextra = 0 
    wc.cbWndExtra = 0 
    wc.hInstance = App.hInstance 
    wc.hIcon = 0 
    wc.hCursor = 0 
    wc.hbrBackground = COLOR_WINDOW 
    wc.lpszMenuName = 0 
     
    'Convert the class name from Unicode to array of bytes. 
    BytesArray = StrConv(TEST_CLASS & Chr$(0), vbFromUnicode) 
    wc.lpszClassName = VarPtr(BytesArray(0)) 
    'Register the new class 
    hAtom = RegisterClass(wc) 
     
End Sub 
 
'The following function draws a rectangle with 'ABC' letters in it. 
Private Sub DrawWin(hdc As Long, hwnd As Long) 
    Dim rcWin           As RECT 
    Dim hBrush          As Long 
    Dim hPen            As Long 
    Dim hOldBrush       As Long 
    Dim hOldPen         As Long 
     
    GetClientRect hwnd, rcWin 
     
    'Create and select new brush and new pen. 
    hBrush = CreateSolidBrush(RGB(240, 240, 255)) 
    hPen = CreatePen(PS_SOLID, 2, RGB(255, 0, 255)) 
    hOldBrush = SelectObject(hdc, hBrush) 
    hOldPen = SelectObject(hdc, hPen) 
     
    'Draw the rectangle 
    Rectangle hdc, rcWin.Left + 1, rcWin.Top + 1, rcWin.Right, rcWin.Bottom 
     
    'Deselect and delete the pen and brush objects. 
    SelectObject hdc, hOldBrush 
    DeleteObject hPen 
    DeleteObject hBrush 
    SelectObject hdc, hOldPen 
     
    'Set the text mode to transparent. 
    SetBkMode hdc, TRANSPARENT 
    'Select the color of the text 
    SetTextColor hdc, RGB(0, 128, 255) 
    'Draw the "ABC" letters 
    DrawTextEx hdc, "ABC", 3, rcWin, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE, ByVal 0 
End Sub 
 
'MyWndProc is the window procedure of the new window class that we create. 
'This procedure receives all messages of the windows we create from the new window class. 
Public Function MyWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
    Dim hdc         As Long 
    Dim ps          As PAINTSTRUCT 
     
    'Call the default window procedure. 
    MyWndProc = DefWindowProc(hwnd, uMsg, wParam, lParam) 
    If uMsg = WM_PAINT Then 
        'When we receive the WM_PAINT message, repaint the entire window. 
        hdc = GetDC(hwnd) 
        DrawWin hdc, hwnd 
        ReleaseDC hwnd, hdc 
    End If 
     
    If uMsg = WM_LBUTTONUP Then 
        When you click the left mouse button, the "click !" message will be shown. 
        MsgBox "click !", vbOKOnly 
    End If 
End Function 
 
Public Function CreateMyWindow(x As Long, y As Long, Width As Long, Height As Long, hParent As Long) As Long 
    CreateMyWindow = CreateWindowEx(0, TEST_CLASS, "", WS_CHILD Or WS_BORDER Or WS_VISIBLE, _ 
    x, y, Width, Height, hParent, 0, App.hInstance, ByVal 0) 
End Function