Re: Setting the BackColor of a Static Window !!

If you insist, here is a demo.

Sorry, it's not vb -- it is vbScript. But with the application
of a little effort, you should be able to convert the vbScript
to ordinary vb.

The script is an implementation of Petzold's "Hello World"
example from his "Programming Windows 9x" book. It uses a
proprietary actX control (wshATO) for calling api's (since
one can not normally do that from script). The actX control
is not supplied, but the calling sequence of the api's is
the same as what you find in win32api.txt -- so converting
the api's to the usual vb format should be easy enough.

In addition to simply creating a window (from api's), the
script also displays a static control, with a purple-colored
background, and this required subclassing for the wm_ctlcolorstatic
message.

Here is the critical code in the subclass routine:

--- <snip> ---

Case WM_CTLCOLORSTATIC

hDC_temp = wParam ' the wm_ctlcolorstatic provides hDC and hWnd
hWnd_temp = lParam

if (hWnd_temp = hSecret) then
Call SetTextColor(hDC_temp, m_crSecretText) ' set text color
Call SetBkColor(hDC_temp, m_crSectetBkgd) ' set text background color

' note: in order for the system to accept the above color adjustments,
' you MUST return a "brush", (used to paint the control's background)...
mySubClsWinProc = m_crBkBrush ' return brush (static control's background)
Exit Function ' exit here (DO NOT do the standard message processing)...
End If ' test caption
--- </snip> ---

If you care to see the entire script, if is attached.

And yes, I humbly apologize to all those whom I offended by
stating that the (static) control should be subclassed to detect
the wm_ctlcolorstatic message. It is of course the parent.
Mea Culpa, mea culpa, mea culpa.

cheers, jw


' wshMakeApiWindow.vbs, jw 11Dec00
'
' --- description block --------------------------
'
' Title: wsh Make API Window Script
'
' Description: Make a window from API calls, (a.k.a. "Petzold 101").
' This is a translation into script of the "Hello World"
' example from Charles Petzold's book: "Progamming Windows 9x",
' (subtitle: "The Definitive Developer's Guide to the Win 32 API").
'
' Author: mr_unreliable (who lurks about in ms.public.scripting.vbs)
' Website: none at this time.
'
' Usage: Use at you own risk, tested on win98se, and winXPsr2...
'
' --- revision history ---------------------------
' 11Dec00: original attempt...
' 14Apr01: after setting this one aside to take on some other projects,
' we returned and completed it, (after gaining some inspiration about
' how to reconfigure wshATO to accommodate this exercise)...
' 05Aug03: "modernized" a bit. Re-worked the wndClass typedef as class code.
' And, took advantage of some wshATO features, added since 2001...
' 05Aug03: noted that the window font is (defaulted) bold sans serif.
' create a (less obtrusive) "font object" for the logo font...
' 10July04: revised to use genII api calls...
' 10July04: Aaarrrggghhh!!! This script didn't work (i.e., createwindow failed),
' until I discovered that the oATO apiWndProc had been changed, the DefWindowProc
' call had been removed. This was done to allow THE SCRIPT to return a value
' to the system, in certain cases, if desired, to specifically request (or not)
' further processing. The remedy for the problem was to add back the
' DefWindowProc call here (in the script)...
' 29July04: changed from "wshAPIToolkitObject" to "wshAPIToolkit" control...
' 20July05: attempt to change text color w/SetTextColor...
' 20July05: uh-oh. A static control doesn't respond to SetTextColor (ugh!).
' So have to subclass the parent window and intercept wm_ctlcolorstatic messages.
' Er, wait. We are subclassing the parent here anyway (duh)...
' --- 2006 ---------------------------------------
' 23Apr06: the wscript.exe icon is being extracted and used for this dialog.
' On winXP wscript.exe is found in a location different from win98. Add
' the "IsNT" function to allow for both locations to be programmed in...
' 24Apr06: with the "genII" type wshATO calls, it is best to declare-and-release
' them AS-THEY-ARE-USED, rather than the visual basic custom of declariing
' the api's all-at-once in the header. So here, the declarations have been
' relocated to where they are being used...
' 25Apr06: use GetClientRectangle to adjust positioning of controls,
' as the xp titlebar takes up more space on a fixed size window than
' a win9x titlebar...
' --- end of description block -------------------

Option Explicit
'
' instantiate ActX components here...
Dim oATO : Call Instantiate(oATO, "wshAPIToolkit.ucATO", "") ' (no events)
Dim oTD : Call Instantiate(oTD, "wshAPIToolkit.ucTypedef", "") ' (no events)
Dim oSC : Call Instantiate(oSC, "wshAPIToolkit.ucSubclass", "") ' (no events)
'
' ------------------------------------------------
' --- API DECLARATIONS (in genII format) ---------
' ------------------------------------------------
' Note: These declarations are GLOBAL in scope...
' ------------------------------------------------
' this first batch of api's used by the winproc.
' (and NOT declared there, to avoid the overhead of making these
' declarations for EVERY system message (ugh!))...
Dim SetBkColor ' as object
Set SetBkColor = oATO.DeclareAPI("GDI32.DLL", "SetBkColor", "ByVal hDC As Long", _
"ByVal crColor As Long")
Dim CreateSolidBrush ' as object
Set CreateSolidBrush = oATO.DeclareAPI("GDI32.DLL", "CreateSolidBrush", "ByVal crColor As Long")
Dim UpdateWindow ' as object
Set UpdateWindow = oATO.DeclareAPI("USER32.DLL", "UpdateWindow", "ByVal hWnd As Long")
Dim ShowWindow ' as object
Set ShowWindow = oATO.DeclareAPI("USER32.DLL", "ShowWindow", "ByVal hWnd As Long", _
"ByVal nCmdShow As Long")
Dim SetTextColor ' as object
Set SetTextColor = oATO.DeclareAPI("GDI32.DLL", "SetTextColor", _
"ByVal hDC As Long", "ByVal crColor As Long")
Dim DefWindowProc ' (needed for winproc, as this call was removed from apiWinProc)...
Set DefWindowProc = oATO.DeclareAPI("USER32.DLL", "DefWindowProcA", _
"ByVal hWnd As Long", "ByVal wMsg As Long", "ByVal wParam As Long", "ByVal lParam As Long")

'
' this second batch of api's used at clean-up time...
Dim DestroyWindow ' as object
Set DestroyWindow = oATO.DeclareAPI("USER32.DLL", "DestroyWindow", "ByVal hWnd As Long")
Dim UnregisterClass ' as object
Set UnregisterClass = oATO.DeclareAPI("USER32.DLL", "UnregisterClassA", _
"ByVal lpClassName As String", "ByVal hInstance As Long")
Dim DestroyIcon ' as object
Set DestroyIcon = oATO.DeclareAPI("USER32.DLL", "DestroyIcon", "ByVal hIco As Long")
Dim DeleteObject ' as object
Set DeleteObject = oATO.DeclareAPI("GDI32.DLL", "DeleteObject", "ByVal hObject As Long")
' --- end of api declarations -------------------
'
'
' --- system constants (available to vb, but not vbs) ---
Const SW_HIDE = 0 ' showWindow constants...
Const SW_NORMAL = 1 ' (show the window)
'
Const AppIcon = "APPICON"
Const AppCursor = "#101"
'
' --- module level def's and const's -------------
'
Dim m_hLogoFont ' as long (logical font handle)
Dim m_hBtnFont
Dim m_hInstance ' as long (global)
Dim m_hIcon ' as long (global)
'
Const sCN = "sCN" ' key to classname mem alloc (must be global)
'
Const m_sWndClass = "wshWindowClass" ' wndcls name...
Const m_sOtherClass = "#32770"
'
Dim nRtn ' as long
'
Dim adrWCX ' as long
Dim adrSCMWP ' as long (must be global)
'
Const m_sCaption = " Create Window from Script (using ONLY api calls) "
'
Dim hWndDlg ' as long (various window handles)...
Dim hStatic, hSecret, hLogo ' static wnd handles
Dim hBtnSecret, hBtnCancel ' button wnd handles
'
Const ID_CMDSECRET = 101
Const ID_CMDCANCEL = 102
'
Dim bSecretClick, bCancelClick ' as boolean
Dim bUserClose ' as boolean
'
Dim crLtGrey : crLtGrey = RGB(&HD3, &HD3, &HD3)
Dim m_crSecretText : m_crSecretText = RGB(&HDD, 0, &HDD) ' magenta, was vbRed
Dim m_crSectetBkgd : m_crSectetBkgd = crLtGrey
Dim m_crBkBrush : m_crBkBrush = CreateSolidBrush(crLtGrey)
'
' create WNDCLASSX typedef - hold as global object until end...
Dim tWCX : Set tWCX = New clsWNDCLASSEX ' create typedef (class object)
'
Const tDoEvents = 100
' --- end of declarations and constants ----------


' ================================================
' === MAIN LINE SCRIPT LOGIC =====================
' ================================================
Const sMe = "[Main], "

' ----------------------------------------------
' Create some "custom" fonts, to use with buttons, and the logo
' ----------------------------------------------
Call Init_Fonts("Verdana", 10, "Arial", 7) ' Btn/Logo fonts/sizes
' WScript.Quit

' --- winClass prep: set up message processing ---
' set up the "MinimalWinProc" for processing the window messages,
' as it is the most primitive winproc available (from ucSubclass).
' In this situation, we wish to process all the system messages
' for ourself, here in the script winproc. For that we use an
' "OLE Callback" connection, i.e., first the internal winproc is
' called, then by "OLE-Callback-Magic" the script winproc is called...
adrSCMWP = oSC.adrMinimalWinProc(GetRef("mySubClsWinProc"))
' --- end of winclass prep work ----------------

' define and register a custom window class...
Call RegisterWindowClass(m_sWndClass)

' create the dialog and add the controls...
Call CreateTestDialog(m_sCaption)

' ----------------------------------------------
' wait loop (to detect button clicks, and/or close)...
' ----------------------------------------------
bSecretClick = False
bCancelClick = False
bUserClose = False

' Dim tWait ' add timeout and close...

Do ' wait forever, until something gets clicked...
WScript.Sleep tDoEvents
' tWait = tWait + tDoEvents
' if (tWait > 5000) then Exit Do ' test 5 secs

if bSecretClick then Call ShowSecretMsg()
Loop Until (bCancelClick or bUserClose)

' report on the cause of window closure,
' note: need to test for UserClose FIRST, otherwise calling
' DestroyWindow will cause a wm_destroy message to be generated,
' and give a false indication of userclose here...
If bUserClose then
' clicking userclose causes win to be closed w/o further ado...
MsgBox("You clicked the UserClose [X] Button")
ElseIf bCancelClick then
nRtn = DestroyWindow(hWndDlg) ' close the window...
MsgBox("You clicked the Cancel Button")
Else
' dlg must be closed by btn or user close, or something's out-of-whack...
' MsgBox("Uh, oh. Some unknown event closed the window")
BugAssert False, sMe & "Uh, oh. Some unknown event closed the window"
End If


' clean up...
nRtn = UnRegisterClass(m_sWndClass, m_hInstance)
' MsgBox("UnRegister Class Returned: " & CStr(nRtn))
BugAssert (nRtn <> 0), sMe & "failed to UnRegisterClass"
Set tWCX = nothing ' clean up class code
oTD.DestroyTypDef(sCN) ' clean up (winClassName) typedef

' release the icon handle to free up memory (avoid mem leaks)...
nRtn = DestroyIcon(m_hIcon)

' release "system objects" (do your bit to help prevent "memory leaks")...
Call DeleteObject(m_hLogoFont) ' various fonts...
Call DeleteObject(m_hBtnFont)
Call DeleteObject(m_crBkBrush)
' according to Dan Appleman, one does NOT delete system objects!!!
' Call DeleteObject(m_hBrush)

Set oATO = nothing
Set oTD = nothing
WScript.Quit



' ================================================
' === SUBROUTINES FOLLOW =========================
' ================================================


' --- SUBCLASSING CALLBACK ROUTINE ---------------

Function mySubClsWinProc(hWin, uMsg, wParam, lParam)

' ------------------------------------------------
' This "subclasser" is going to be looking for just a few specic
' system messages, associated with just a few windows. That is,
' the main (parent) window, and the button child windows.
' The vast majority of windows messages flowing through here
' are simply passed along to the system for processing...
' ------------------------------------------------
'
Const WM_COMMAND = &H111
Const WM_DESTROY = &H2
Const WM_CTLCOLORSTATIC = &H138
' User Button Notification Codes
Const BN_CLICKED = 0
Const BN_DOUBLECLICKED = 5
'
Dim idBtn ' as integer
'
Dim hDC_temp ' as long
Dim hWnd_temp ' as long
' --- end of declarations and constants ----------

'MsgBox("wndproc called:")

Select Case uMsg

Case WM_COMMAND
' --------------------------------------------
' The WM_COMMAND notify messages are formatted as follows:
' - hWnd is the window handle of the form...
' - uMsg is the windows message number (WM_XXX number)
' - wParam has two parts, the "High Word" contains the
' "notification type", in other words, one of the specific
' notifications associated with that type of control.
' And the "Low Word" contains the "control ID number"
' which is assigned by the programmer when the control
' is created, but not used by visual basic.
' - lParam contains the window handle of the form/control
' that originates the window message...
' --------------------------------------------

' MsgBox("Button Clicked") ' a button was clicked...

' detect which one...
If oSC.LoWord(wParam) = ID_CMDCANCEL Then bCancelClick = True
If oSC.LoWord(wParam) = ID_CMDSECRET Then bSecretClick = True
' finished w/wm_command, jump down to complete default/standard msg processing...


Case WM_CTLCOLORSTATIC
' m_bWM_CTLCOLOR_detected = True

hDC_temp = wParam ' the wm_ctlcolorstatic provides hDC and hWnd
hWnd_temp = lParam

if (hWnd_temp = hSecret) then
Call SetTextColor(hDC_temp, m_crSecretText) ' set text color
Call SetBkColor(hDC_temp, m_crSectetBkgd) ' set text background color

' note: in order for the system to accept the above color adjustments,
' you MUST return a "brush", (used to paint the control's background)...
mySubClsWinProc = m_crBkBrush ' return brush (static control's background)
Exit Function ' exit here (DO NOT do the standard message processing)...
End If ' test caption


Case WM_DESTROY
' deal with window close button (so as to avoid attempting to re-close it)...
bUserClose = True

End Select

' finally, call the "Standard Window Proc" for all other messages,
' (and return to the system whatever is returned by the stdproc)...
'
' The default window proc provides the absolute minimal functionality
' to bring a window "to life". You may process messages all you wish,
' but then you must tell the system whether or not you want any further
' message processing. More specifically, you tell the system to do
' what it would normally do, -or- do nothing, generally by returning
' a true or false. In this case, we are only attempting to detect
' button clicks or the window close btn [X] click. Other than that,
' all the messages are being passed along to the "Default Window Proc".
' (Note: failure to do this will result in NO window being produced).
' Caveat Emptor: if you don't use the defWindowProc, you must make
' provisions to handle EVERY system message yourself!!!
' --- end of discussion ------------------------

mySubClsWinProc = DefWindowProc(hWin, uMsg, wParam, lParam)
End Function



' --- SHOW THE SECRET MESSAGE --------------------

Sub ShowSecretMsg()
nRtn = ShowWindow(hSecret, SW_NORMAL) ' show the secret for a bit...
nRtn = UpdateWindow(hSecret) ' need repaint
WScript.Sleep 1000 ' can be made longer, for slow readers...
nRtn = ShowWindow(hSecret, SW_HIDE) ' then hide again...
nRtn = UpdateWindow(hSecret) ' another repaint
bSecretClick = False ' turn off flag...
End Sub


Function IsNT() ' as Boolean
Dim GetVersionEx ' as object (declare api)
Set GetVersionEx = oATO.DeclareAPI("KERNEL32.DLL", "GetVersionExA", "lpVersionInformation As Typedef")
Dim tOSI : Set tOSI = New clsOSVERSIONINFO ' create typedef
Const VER_PLATFORM_WIN32_WINDOWS = 1 ' win9x
Const VER_PLATFORM_WIN32_NT = 2 ' nt or xp
Dim nRtn ' as long

nRtn = GetVersionEx(tOSI) ' call system to fill in version info
BugAssert (nRtn <> False), "[GetVersionEx API], returned an error code"

IsNT = (tOSI.dwPlatformId = VER_PLATFORM_WIN32_NT) ' return t/f

' MsgBox("IsNT: " & CStr(IsNT))
' let ms do the api class code cleanup...
' Set tOSI = nothing : Set GetVersionEx = nothing
End Function



' ------------------------------------------------
' Create the Test Dialog...
' ------------------------------------------------

Sub CreateTestDialog(sCaption)
' ------------------------------------------------
' --- API DECLARATIONS (in genII format) ---------
' ------------------------------------------------
' Note: These declarations are LOCAL in scope to this routine
' ------------------------------------------------
Dim CreateWindowEx ' as object
Set CreateWindowEx = oATO.DeclareAPI("USER32.DLL", "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")
Dim GetClientRect ' as object
Set GetClientRect = oATO.DeclareAPI("USER32.DLL", "GetClientRect", "ByVal hWnd As Long", "lpRect As Typedef")
Dim SendMessage ' as object
Set SendMessage = oATO.DeclareAPI("USER32.DLL", "SendMessageA", "ByVal hWnd As Long", _
"ByVal wMsg As Long", "ByVal wParam As Long", "lParam As Any")
' --- end of api declarations -------------------
'
Const WS_OVERLAPPED = &H0& ' window styles (createwindow)
Const WS_CAPTION = &HC00000 ' WS_BORDER Or WS_DLGFRAME
Const WS_SYSMENU = &H80000
Const WS_THICKFRAME = &H40000
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const WS_EX_NOPARENTNOTIFY = &H4
Const WS_CHILD = &H40000000
Const WS_VISIBLE = &H10000000
'
Dim WS_OVERLAPPEDWINDOW
WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME _
Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
'
Const WM_SETFONT = &H30
'
Dim dwStyle, dwExStyle ' as long (style bits)
Dim iBtnSp ' as long
'
Const pxWdDlg = 420, pxHtDlg = 210 ' in pixels
Dim tCR ' as typedef object
Dim pxClientHt, htControls, pxSpace,pxYPos ' as long(s)
' --- end of declarations and constants ----------

dwStyle = WS_OVERLAPPEDWINDOW ' set style bits
dwExStyle = WS_EX_NOPARENTNOTIFY

' ----------------------------------------------
' finally, Create the main (parent) window, as: m_sWndClass...
hWndDlg = CreateWindowEx(dwExStyle, m_sWndClass, sCaption, dwStyle, _
100,100, pxWdDlg,pxHtDlg, 0, 0, m_hInstance, 0) ' was CStr(m_sWndClass)
' ----------------------------------------------
' note: if having trouble with your class registration code,
' try using the system standard dialog class, namely: "#32770"...
' hWndDlg = CreateWindowEx(dwExStyle, "#32770", m_sCaption, dwStyle, _
' 100,100, 400,200, 0, 0, m_hInstance, 0) ' was CStr(m_sWndClass)
' ----------------------------------------------
BugAssert (hWndDlg <> 0), sMe & "failed to Create Parent (Main) Window"

' once the window has been created, there must be some accounting for
' the "client" space, i.e., space available for controls. Since the
' winXP titlebar is "fatter" than the win9x titlebar, under winXP
' the controls need to be "smushed" together a bit...
Set tCR = oTD.CreateRECT() ' create rect typedef...
Call GetClientRect(hWndDlg, tCR)
pxClientHt = tCR.Bottom - tCR.Top

' do some "geometry calculations", to space down controls
' so they all fit...
htControls = (25+20+25+25+15)
pxSpace = (pxClientHt - htControls) / 5

' add some (child) controls to the window...
pxYPos = pxSpace
hStatic = CreateWindowEx(0, "Static", "Hello World!", _
WS_CHILD Or WS_VISIBLE, 40, pxYPos, 200, 25, hWndDlg, 0, m_hInstance, 0)
pxYPos = pxYPos + 25 + pxSpace
' note: the "&&" in the following line is INTENTIONAL!
hSecret = CreateWindowEx(0, "Static", " Secret Passion: Ben && Jerry's CHERRY GARCIA!", _
WS_CHILD, 40, pxYPos, 330, 20, hWndDlg, 0, m_hInstance, 0)

iBtnSp = CLng((pxWdDlg-170)/2)
pxYPos = pxYPos + 17 + (pxSpace) '\2)
hBtnSecret = CreateWindowEx(0, "Button", "Reveal Secret Passion", _
WS_CHILD Or WS_VISIBLE, iBtnSp, pxYPos, 170, 25, hWndDlg, ID_CMDSECRET, m_hInstance, 0)
pxYPos = pxYPos + 25 + (pxSpace) '\2)
hBtnCancel = CreateWindowEx(0, "Button", "Cancel", _
WS_CHILD Or WS_VISIBLE, iBtnSp, pxYPos, 170, 25, hWndDlg, ID_CMDCANCEL, m_hInstance, 0)

pxYPos = pxYPos + 25 + (pxSpace) '\2)
hLogo = CreateWindowEx(0, "Static", "brought to you by jawar productions (all rights reserved)... ", _
WS_CHILD Or WS_VISIBLE, pxWdDlg-285, pxYPos, 380, 15, hWndDlg, 0, m_hInstance, 0)


' now, set prepared fonts into their respective controls...
Call SendMessage(hLogo, WM_SETFONT, m_hLogoFont, 0)
Call SendMessage(hBtnCancel, WM_SETFONT, m_hBtnFont, 0)

' show the parent...
nRtn = ShowWindow(hWndDlg, SW_NORMAL) ' show parent
nRtn = UpdateWindow(hWndDlg) ' repaint

' let ms do the api class code cleanup...
End Sub



' ------------------------------------------------
' Define and Register a Custom Window Class...
' ------------------------------------------------

Sub RegisterWindowClass(sWndClass)
' ------------------------------------------------
' --- API DECLARATIONS (in genII format) ---------
' ------------------------------------------------
' Note: These declarations are LOCAL in scope to this routine
' ------------------------------------------------
Dim GetStockObject ' as object
Set GetStockObject = oATO.DeclareAPI("GDI32.DLL", "GetStockObject", "ByVal nIndex As Long")
Dim GetSysColorBrush ' as object
Set GetSysColorBrush = oATO.DeclareAPI("USER32.DLL", "GetSysColorBrush", "ByVal nIndex As Long")
Dim LoadCursorByNum ' as object
Set LoadCursorByNum = oATO.DeclareAPI("USER32.DLL", "LoadCursorA", "ByVal hInstance As Long", "ByVal lpCursorName As Long")
Dim ExtractIcon ' as object
Set ExtractIcon = oATO.DeclareAPI("SHELL32.DLL", "ExtractIconA", "ByVal hInst As Long", "ByVal lpszExeFileName As String", "ByVal nIconIndex As Long")
Dim RegisterClassEx ' as object
Set RegisterClassEx = oATO.DeclareAPI("USER32.DLL", "RegisterClassExA", "lpWNDCLASSEX As Typedef")
' --- end of api declarations -------------------
'
Const IDC_ARROW = 32512 ' stock system cursor
'
Const CS_VREDRAW = &H1 ' class styles (createclass)...
Const CS_HREDRAW = &H2
Const CS_CLASSDC = &H40
'
Const COLOR_WINDOW = 5 ' window background
Const COLOR_BTNFACE = 15 ' er, no. THIS is the window background!!!
'
' Dim m_hInstance ' as long (see global)
Dim m_hBrush ' as long
Dim m_hCursor ' as long
' Dim m_hIcon ' as long (see global)
Dim sWscriptFileSpec ' as string
'
Dim adrCN ' as long
Dim cbCN : cbCN = Len(sWndClass) + 2 ' space to alloc for cls name...
' --- end of declarations and constants ----------

' get an instance handle (from vbApp object)...
m_hInstance = oATO.vbApp.hInstance
BugAssert (m_hInstance <> 0), sMe & "failed to get hInstance"
' MsgBox("m_hInstance: " & CStr(m_hInstance))
m_hBrush = GetSysColorBrush(COLOR_BTNFACE)
m_hCursor = LoadCursorByNum(0, IDC_ARROW)
' extract the designated icon from the file (exe, dll, ocx)...
if (NOT IsNT()) then
sWscriptFileSpec = "c:\windows\wscript.exe" ' win9x
Else
sWscriptFileSpec = "c:\windows\system32\wscript.exe" ' xp
End If
m_hIcon = ExtractIcon(m_hInstance, sWscriptFileSpec, 0)
BugAssert (m_hIcon <> 0), "[ExtractIcon api], Uh-oh. failed to extract designated icon "

' allocate space to hold the wndClass string, and get address...
adrCN = oTD.CreateTypDef(sCN, cbCN) ' alloc memory for class name...
oTD.PutString(sCN, 0) = sWndClass ' & Chr(0)
' MsgBox(oTD.GetString(sCN, 0))

With tWCX
.Style = CS_CLASSDC Or CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc = adrSCMWP ' FcnPtr(AddressOf WindowProc)
.hInstance = m_hInstance ' App.hInstance
.hIcon = m_hIcon
.hCursor = m_hCursor
.hbrBackground = m_hBrush
.lpszClassName = adrCN ' m_sWndClass name
' adrWCX = .adrSTRUCT ' get memory address of this typedef
End With

nRtn = RegisterClassEx(tWCX) ' was: adrWCX)
BugAssert (nRtn <> 0), sMe & "failed to RegisterClass"

' let ms do the api class code cleanup...
End Sub



' --- CREATE FONTS TO USE WITH THE WINDOW --------

Sub Init_Fonts(sBtnFont, ptSizBtn, sLogoFont, ptSizLogo)
' ------------------------------------------------
' --- API DECLARATIONS (in genII format) ---------
' ------------------------------------------------
' Note: These declarations are LOCAL in scope to this routine
' ------------------------------------------------
Dim GetDC ' as object
Set GetDC = oATO.DeclareAPI("USER32.DLL", "GetDC", "ByVal hWnd As Long")
Dim GetDeviceCaps ' as object
Set GetDeviceCaps = oATO.DeclareAPI("GDI32.DLL", "GetDeviceCaps", "ByVal hDC As Long", "ByVal nIndex As Long")
Dim CreateFontIndirect ' as object
Set CreateFontIndirect = oATO.DeclareAPI("GDI32.DLL", "CreateFontIndirectA", "lpLogFont As Typedef")
' --- end of declarations and constants ----------
Const sMe = "[Init_Fonts], "
' font-related constants...
Const FW_NORMAL = 400 ' 100=Light, 400=Normal, 700=Bold, 900=Heavy
Const FW_BOLD = 700
'
Const DEFAULT_ASPECTRATIO = 0
Const DEFAULT_CHARSET = 1
Const OUT_DEFAULT_PRECIS = 0
Const CLIP_DEFAULT_PRECIS = 0
Const DEFAULT_QUALITY = 0
Const DEFAULT_PITCH = 0
Const FF_DONTCARE = 0
'
Const LOGPIXELSY = 90 ' Logical pixels/inch in Y
'
Dim tLogoFont : Set tLogoFont = New clsLOGFONT ' create font (for logo)
Dim tBtnFont : Set tBtnFont = New clsLOGFONT
' --- end of declarations and constants ----------

' --- initialize "font conversion factor" ------
' Calculate a conversion factor, point size to char height (in pixels)...
' keeping in mind there are 72 points per inch (a "point" is 1/72in).
' Get the "logical pixels per inch" using GetDeviceCaps.
' Then, to convert points, divide by 72 (to get inches)
' and multiply by pixels per inch...
' ----------------------------------------------
' Dim hDC : hDC = GetDC(hWndDlg)
' Dim logpixY : logpixY = GetDeviceCaps(hDC, LOGPIXELSY)

' Make it negative, so as to apply to "glyph", rather than "cell".
' MsgBox(CStr(GetDeviceCaps(GetDC(hWndDlg), LOGPIXELSY)))
Dim cf_PtSize : cf_PtSize = - CSng(GetDeviceCaps(GetDC(hWndDlg), LOGPIXELSY) / 72)
' --- finished with font conversion factor -----

' create fonts used for the button and the logo...
' Dim pxH_Logo : pxH_Logo = Int(ptSizLogo * cf_PtSize)
' Dim pxH_Btn : pxH_Btn = Int(ptSizBtn * cf_PtSize)

With tLogoFont
.lfHeight = Int(ptSizLogo * cf_PtSize) : .lfWidth = DEFAULT_ASPECTRATIO
.lfEscapement = 0 : .lfOrientation = 0 : .lfWeight = FW_NORMAL
.lfItalic = 1 : .lfUnderline = 0 : .lfStrikeout = 0 ' make it italic
.lfCharSet = DEFAULT_CHARSET
.lfOutPrecision = OUT_DEFAULT_PRECIS : .lfClipPrecision = CLIP_DEFAULT_PRECIS
.lfQuality = DEFAULT_QUALITY : .lfPitchAndFamily = DEFAULT_PITCH Or FF_DONTCARE
.lfFaceName = sLogoFont
End With

m_hLogoFont = CreateFontIndirect(tLogoFont.adrSTRUCT)

' ----------------------------------------------

With tBtnFont
.lfHeight = Int(ptSizBtn * cf_PtSize) : .lfWidth = DEFAULT_ASPECTRATIO
.lfEscapement = 0 : .lfOrientation = 0 : .lfWeight = FW_NORMAL
.lfItalic = 0 : .lfUnderline = 0 : .lfStrikeout = 0 ' not italic
.lfCharSet = DEFAULT_CHARSET
.lfOutPrecision = OUT_DEFAULT_PRECIS : .lfClipPrecision = CLIP_DEFAULT_PRECIS
.lfQuality = DEFAULT_QUALITY : .lfPitchAndFamily = DEFAULT_PITCH Or FF_DONTCARE
.lfFaceName = sBtnFont
End With

m_hBtnFont = CreateFontIndirect(tBtnFont.adrSTRUCT)

' clean up here (don't need those typedef's any more)...
Set tLogoFont = nothing
Set tBtnFont = nothing

' let ms do the api class code cleanup...
End Sub





' ================================================
' === WNDCLASSEX TYPEDEF CLASS WRAPPER ===========
' ================================================

Class clsWNDCLASSEX ' this rev: 10Jul04

' These definitions of the typedef fields OUGHT to be Const declarations.
' However, private const definitions apparently DON'T WORK in a class code.
' (Shame on you Microsoft). So, we are declaring them here,
' and assigning values in the init code.

' Type WNDCLASSEX ' field name (byte offset)
Private m_cbSize ' cbSize As Long (byte 0)
Private m_style ' style As Long (byte 4)
Private m_lpfnwndproc ' lpfnwndproc As Long (byte 8)
Private m_cbClsextra ' cbClsextra As Long (byte 12)
Private m_cbWndExtra2 ' cbWndExtra2 As Long (byte 16)
Private m_hInstance ' hInstance As Long (byte 20)
Private m_hIcon ' hIcon As Long (byte 24)
Private m_hCursor ' hCursor As Long (byte 28)
Private m_hbrBackground ' hbrBackground As Long (byte 32)
Private m_lpszMenuName ' lpszMenuName As String (byte 36)
Private m_lpszClassName ' lpszClassName As String (byte 40)
Private m_hIconSm ' hIconSm As Long (byte 44)
'

Private cbWNDCLSX ' as long (byte count of this typedef)
Private adrWNDCLSX ' as long
Private tWNDCLSX ' as string (key) = 'tWNDCLSX'

Private c_sMe
' --- end of declarations and constants ----------

' --- Discussion about storing values in the typedef ---
' Sorry, but you can't use the normal vbScript replace statements.
' You have to use oTD.PutLong (or putWhatever), as it behaves
' something like a 'CopyMemory', and gets a long (or whatever)
' into the typedef, instead of a variant...
' --- end of discussion --------------------------


Public Property Get cbSize()
cbSize = oTD.GetLong(tWNDCLSX, m_cbSize)
End Property

Public Property Let cbSize(vRHS)
oTD.PutLong(tWNDCLSX, m_cbSize) = vRHS
End Property

Public Property Get style()
style = oTD.GetLong(tWNDCLSX, m_style)
End Property

Public Property Let style(vRHS)
oTD.PutLong(tWNDCLSX, m_style) = vRHS
End Property

Public Property Get lpfnwndproc()
lpfnwndproc = oTD.GetLong(tWNDCLSX, m_lpfnwndproc)
End Property

Public Property Let lpfnwndproc(vRHS)
oTD.PutLong(tWNDCLSX, m_lpfnwndproc) = vRHS
End Property

Public Property Get cbClsextra()
cbClsextra = oTD.GetLong(tWNDCLSX, m_cbClsextra)
End Property

Public Property Let cbClsextra(vRHS)
oTD.PutLong(tWNDCLSX, m_cbClsextra) = vRHS
End Property

Public Property Get cbWndExtra2()
cbWndExtra2 = oTD.GetLong(tWNDCLSX, m_cbWndExtra2)
End Property

Public Property Let cbWndExtra2(vRHS)
oTD.PutLong(tWNDCLSX, m_cbWndExtra2) = vRHS
End Property

Public Property Get hInstance()
hInstance = oTD.GetLong(tWNDCLSX, m_hInstance)
End Property

Public Property Let hInstance(vRHS)
oTD.PutLong(tWNDCLSX, m_hInstance) = vRHS
End Property

Public Property Get hIcon()
hIcon = oTD.GetLong(tWNDCLSX, m_hIcon)
End Property

Public Property Let hIcon(vRHS)
oTD.PutLong(tWNDCLSX, m_hIcon) = vRHS
End Property

Public Property Get hCursor()
hCursor = oTD.GetLong(tWNDCLSX, m_hCursor)
End Property

Public Property Let hCursor(vRHS)
oTD.PutLong(tWNDCLSX, m_hCursor) = vRHS
End Property

Public Property Get hbrBackground()
hbrBackground = oTD.GetLong(tWNDCLSX, m_hbrBackground)
End Property

Public Property Let hbrBackground(vRHS)
oTD.PutLong(tWNDCLSX, m_hbrBackground) = vRHS
End Property

Public Property Get lpszMenuName()
lpszMenuName = oTD.GetLong(tWNDCLSX, m_lpszMenuName)
End Property

Public Property Let lpszMenuName(vRHS)
oTD.PutLong(tWNDCLSX, m_lpszMenuName) = vRHS
End Property

Public Property Get lpszClassName()
lpszClassName = oTD.GetLong(tWNDCLSX, m_lpszClassName)
End Property

Public Property Let lpszClassName(vRHS)
oTD.PutLong(tWNDCLSX, m_lpszClassName) = vRHS
End Property

Public Property Get hIconSm()
hIconSm = oTD.GetLong(tWNDCLSX, m_hIconSm)
End Property

Public Property Let hIconSm(vRHS)
oTD.PutLong(tWNDCLSX, m_hIconSm) = vRHS
End Property


' provides memory address (i.e., a long pointer)...
Public Default Property Get adrSTRUCT()
adrSTRUCT = adrWNDCLSX
End Property



Sub Class_Initialize()
c_sMe = "[clsWNDCLASSEX], "
' MsgBox(c_sMe & "Initializing")

' --- class prerequsites checking ------------
' this class requires that the script instantiate the "wshAPIToolkitObject.ucTypedef"
' control. If that is not present-and-accounted-for, then this class code will fail.
' (Yes, it also requires BugAssert, but you can figure that out for yourself)...
BugAssert (NOT IsEmpty(oTD)), c_sMe & "ERROR: found oTD has not been intialized"
BugAssert (IsObject(oTD)), c_sMe & "ERROR: found oTD is NOT an object"
BugAssert (TypeName(oTD) = "ucTypeDef"), c_sMe & "ERROR: oTD must be initialized to: ucTypedef"
' O.K. all the tests have been passed, so go ahead...
' --------------------------------------------

' fill in the typdef field constants,
' (maybe SOMEDAY we can just use: Private Const dwLength = 0)...
m_cbSize = 0 ' cbSize As Long (byte 0)
m_style = 4 ' style As Long (byte 4)
m_lpfnwndproc = 8 ' lpfnwndproc As Long (byte 8)
m_cbClsextra = 12 ' cbClsextra As Long (byte 12)
m_cbWndExtra2 = 16 ' cbWndExtra2 As Long (byte 16)
m_hInstance = 20 ' hInstance As Long (byte 20)
m_hIcon = 24 ' hIcon As Long (byte 24)
m_hCursor = 28 ' hCursor As Long (byte 28)
m_hbrBackground = 32 ' hbrBackground As Long (byte 32)
m_lpszMenuName = 36 ' lpszMenuName As String (byte 36)
m_lpszClassName = 40 ' lpszClassName As String (byte 40)
m_hIconSm = 44 ' hIconSm As Long (byte 44)

cbWNDCLSX = 48 ' (byte count)
tWNDCLSX = "tWNDCLSX" ' (key)


On Error Resume Next ' turn on error checking
' create the typedef itself...
' (note: CreateTypeDef allocates memory and clears to zeros)
adrWNDCLSX = oTD.CreateTypDef(tWNDCLSX, cbWNDCLSX)
' set the bytecount for THIS typedef/structure at creation time...
oTD.PutLong(tWNDCLSX, m_cbSize) = cbWNDCLSX

' check to make sure that the typedef creation succeeded...
BugAssert (err.number = 0), c_sME & "Unable to create typedef, " & vbCrlf _
& " most likely because oATO is not instantiated properly... "
On Error goto 0 ' turn off error checking...

End Sub


Sub Class_Terminate()
' MsgBox(c_sMe & "Terminating")
oTD.DestroyTypDef(tWNDCLSX) ' return typedef memory block(s)...
End Sub

End Class ' clsWNDCLASSEX




' ================================================
' === LOGFONT TYPEDEF CLASS WRAPPER ==============
' ================================================

Class clsLOGFONT

' These definitions of the typedef fields OUGHT to be Const declarations.
' However, private const definitions apparently DON'T WORK in a class code.
' (Shame on you Microsoft). So, we are declaring them here,
' and assigning values in the init code.

' Type LOGFONT ' field name (byte offset)
Private m_lfHeight ' lfHeight As Long (byte 0)
Private m_lfWidth ' lfWidth As Long (byte 4)
Private m_lfEscapement ' lfEscapement As Long (byte 8)
Private m_lfOrientation ' lfOrientation As Long (byte 12)
Private m_lfWeight ' lfWeight As Long (byte 16)
Private m_lfItalic ' lfItalic As Byte (byte 20)
Private m_lfUnderline ' lfUnderline As Byte (byte 21)
Private m_lfStrikeOut ' lfStrikeOut As Byte (byte 22)
Private m_lfCharSet ' lfCharSet As Byte (byte 23)
Private m_lfOutPrecision ' lfOutPrecision As Byte (byte 24)
Private m_lfClipPrecision ' lfClipPrecision As Byte (byte 25)
Private m_lfQuality ' lfQuality As Byte (byte 26)
Private m_lfPitchAndFamily' lfPitchAndFamily As Byte (byte 27)
Private m_lfFaceName ' lfFaceName(LF_FACESIZE) As B(byte 28) + 32
' End Type

' Private Const LF_FACESIZE = 32 ' from win32api.txt

Private cbLOGFONT ' as long (byte count of this typedef)
Private adrLOGFONT ' as long
Private tLOGFONT ' as string (key) = 'tLOGFONT'

Private c_sMe
' --- end of declarations and constants ----------

' --- Discussion about storing values in the typedef ---
' Sorry, but you can't use the normal vbScript replace statements.
' You have to use oTD.PutLong (or putWhatever), as it behaves
' something like a 'CopyMemory', and gets a long (or whatever)
' into the typedef, instead of a variant...
' --- end of discussion --------------------------


Public Property Get lfHeight()
lfHeight = oTD.GetLong(tLOGFONT, m_lfHeight)
End Property

Public Property Let lfHeight(vRHS)
oTD.PutLong(tLOGFONT, m_lfHeight) = vRHS
End Property

Public Property Get lfWidth()
lfWidth = oTD.GetLong(tLOGFONT, m_lfWidth)
End Property

Public Property Let lfWidth(vRHS)
oTD.PutLong(tLOGFONT, m_lfWidth) = vRHS
End Property

Public Property Get lfEscapement()
lfEscapement = oTD.GetLong(tLOGFONT, m_lfEscapement)
End Property

Public Property Let lfEscapement(vRHS)
oTD.PutLong(tLOGFONT, m_lfEscapement) = vRHS
End Property

Public Property Get lfOrientation()
lfOrientation = oTD.GetLong(tLOGFONT, m_lfOrientation)
End Property

Public Property Let lfOrientation(vRHS)
oTD.PutLong(tLOGFONT, m_lfOrientation) = vRHS
End Property

Public Property Get lfWeight()
lfWeight = oTD.GetLong(tLOGFONT, m_lfWeight)
End Property

Public Property Let lfWeight(vRHS)
oTD.PutLong(tLOGFONT, m_lfWeight) = vRHS
End Property

Public Property Get lfItalic()
lfItalic = oTD.GetByte(tLOGFONT, m_lfItalic)
End Property

Public Property Let lfItalic(vRHS)
oTD.PutByte(tLOGFONT, m_lfItalic) = vRHS
End Property

Public Property Get lfUnderline()
lfUnderline = oTD.GetByte(tLOGFONT, m_lfUnderline)
End Property

Public Property Let lfUnderline(vRHS)
oTD.PutByte(tLOGFONT, m_lfUnderline) = vRHS
End Property

Public Property Get lfStrikeOut()
lfStrikeOut = oTD.GetByte(tLOGFONT, m_lfStrikeOut)
End Property

Public Property Let lfStrikeOut(vRHS)
oTD.PutByte(tLOGFONT, m_lfStrikeOut) = vRHS
End Property

Public Property Get lfCharSet()
lfCharSet = oTD.GetByte(tLOGFONT, m_lfCharSet)
End Property

Public Property Let lfCharSet(vRHS)
oTD.PutByte(tLOGFONT, m_lfCharSet) = vRHS
End Property

Public Property Get lfOutPrecision()
lfOutPrecision = oTD.GetByte(tLOGFONT, m_lfOutPrecision)
End Property

Public Property Let lfOutPrecision(vRHS)
oTD.PutByte(tLOGFONT, m_lfOutPrecision) = vRHS
End Property

Public Property Get lfClipPrecision()
lfClipPrecision = oTD.GetByte(tLOGFONT, m_lfClipPrecision)
End Property

Public Property Let lfClipPrecision(vRHS)
oTD.PutByte(tLOGFONT, m_lfClipPrecision) = vRHS
End Property

Public Property Get lfQuality()
lfQuality = oTD.GetByte(tLOGFONT, m_lfQuality)
End Property

Public Property Let lfQuality(vRHS)
oTD.PutByte(tLOGFONT, m_lfQuality) = vRHS
End Property

Public Property Get lfPitchAndFamily()
lfPitchAndFamily = oTD.GetByte(tLOGFONT, m_lfPitchAndFamily)
End Property

Public Property Let lfPitchAndFamily(vRHS)
oTD.PutByte(tLOGFONT, m_lfPitchAndFamily) = vRHS
End Property

Public Property Get lfFaceName()
lfFaceName = oTD.GetString(tLOGFONT, m_lfFaceName)
End Property

Public Property Let lfFaceName(vRHS)
oTD.PutString(tLOGFONT, m_lfFaceName) = vRHS
End Property


' provides memory address (i.e., a long pointer)...
Public Default Property Get adrSTRUCT()
adrSTRUCT = adrLOGFONT
End Property



Sub Class_Initialize()
c_sMe = "[clsLOGFONT], "
' MsgBox(c_sMe & "Initializing")

' fill in the typdef field constants,
' (maybe SOMEDAY we can just use: Private Const dwLength = 0)...
m_lfHeight = 0 ' lfHeight As Long (byte 0)
m_lfWidth = 4 ' lfWidth As Long (byte 4)
m_lfEscapement = 8 ' lfEscapement As Long (byte 8)
m_lfOrientation = 12 ' lfOrientation As Long (byte 12)
m_lfWeight = 16 ' lfWeight As Long (byte 16)
m_lfItalic = 20 ' lfItalic As Byte (byte 20)
m_lfUnderline = 21 ' lfUnderline As Byte (byte 21)
m_lfStrikeOut = 22 ' lfStrikeOut As Byte (byte 22)
m_lfCharSet = 23 ' lfCharSet As Byte (byte 23)
m_lfOutPrecision = 24 ' lfOutPrecision As Byte (byte 24)
m_lfClipPrecision = 25 ' lfClipPrecision As Byte (byte 25)
m_lfQuality = 26 ' lfQuality As Byte (byte 26)
m_lfPitchAndFamily = 27 ' lfPitchAndFamily As Byte (byte 27)
m_lfFaceName = 28 ' lfFaceName(LF_FACESIZE) As B(byte 28)

cbLOGFONT = 60 ' (byte count) = 28 + 32
' tLOGFONT = "tLOGFONT" ' (key)
tLOGFONT = oTD.AssignUniqueKey("tLF_")


On Error Resume Next ' turn on error checking
' create the typedef itself...
' (note: CreateTypeDef allocates memory and clears to zeros)
adrLOGFONT = oTD.CreateTypDef(tLOGFONT, cbLOGFONT)
' no need to set bytecount for THIS typedef/structure...

' check to make sure that the typedef creation succeeded...
BugAssert (err.number = 0), c_sME & "Unable to create typedef, " & vbCrlf _
& " most likely because oATO is not instantiated properly... "
On Error goto 0 ' turn off error checking...

End Sub


Sub Class_Terminate()
' MsgBox(c_sMe & "Terminating")
oTD.DestroyTypDef(tLOGFONT) ' return typedef memory block(s)...
End Sub

End Class ' clsLOGFONT




' ================================================
' === OSVERSIONINFO TYPEDEF CLASS WRAPPER ========
' ================================================

Class clsOSVERSIONINFO

' These definitions of the typedef fields OUGHT to be Const declarations.
' However, private const definitions apparently DON'T WORK in a class code.
' (Shame on you Microsoft). So, we are declaring them here,
' and assigning values in the init code.

' Type OSVERSIONINFO ' field name (byte offset)
Private m_dwOSVersionInfoSize ' dwOSVersionInfoSize As Long (byte 0)
Private m_dwMajorVersion ' dwMajorVersion As Long (byte 4)
Private m_dwMinorVersion ' dwMinorVersion As Long (byte 8)
Private m_dwBuildNumber ' dwBuildNumber As Long (byte 12)
Private m_dwPlatformId ' dwPlatformId As Long (byte 16)
Private m_szCSDVersion ' szCSDVersion As String * 128 (byte 20)
' End Type
'
Private cbOSVERS ' as long (byte count of this typedef)
Private adrOSVERS ' as long
Private tOSVERS ' as string (key) = 'tOSVERS'
'
Private c_sMe
' --- end of declarations and constants ----------

' --- Discussion about storing values in the typedef ---
' Sorry, but you can't use the normal vbScript replace statements.
' You have to use oATO.PutLong (or putWhatever), as it behaves
' something like a 'CopyMemory', and gets a long (or whatever)
' into the typedef, instead of a variant...
' --- end of discussion --------------------------


Public Property Get dwOSVersionInfoSize()
dwOSVersionInfoSize = oTD.GetLong(tOSVERS, m_dwOSVersionInfoSize)
End Property

Public Property Let dwOSVersionInfoSize(vRHS)
oTD.PutLong(tOSVERS, m_dwOSVersionInfoSize) = vRHS
End Property

Public Property Get dwMajorVersion()
dwMajorVersion = oTD.GetLong(tOSVERS, m_dwMajorVersion)
End Property

Public Property Let dwMajorVersion(vRHS)
oTD.PutLong(tOSVERS, m_dwMajorVersion) = vRHS
End Property

Public Property Get dwMinorVersion()
dwMinorVersion = oTD.GetLong(tOSVERS, m_dwMinorVersion)
End Property

Public Property Let dwMinorVersion(vRHS)
oTD.PutLong(tOSVERS, m_dwMinorVersion) = vRHS
End Property

Public Property Get dwBuildNumber()
dwBuildNumber = oTD.GetLong(tOSVERS, m_dwBuildNumber)
End Property

Public Property Let dwBuildNumber(vRHS)
oTD.PutLong(tOSVERS, m_dwBuildNumber) = vRHS
End Property

Public Property Get dwPlatformId()
dwPlatformId = oTD.GetLong(tOSVERS, m_dwPlatformId)
End Property

Public Property Let dwPlatformId(vRHS)
oTD.PutLong(tOSVERS, m_dwPlatformId) = vRHS
End Property

Public Property Get szCSDVersion()
szCSDVersion = oTD.GetString(tOSVERS, m_szCSDVersion)
End Property



' provides memory address (i.e., a long pointer)...
Public Default Property Get adrSTRUCT()
adrSTRUCT = adrOSVERS
End Property



Sub Class_Initialize()
c_sMe = "[clsOSVERSIONINFO], "
' MsgBox(c_sMe & "Initializing")

' fill in the typdef field constants,
' (maybe SOMEDAY we can just use: Private Const dwLength = 0)...
m_dwOSVersionInfoSize = 0 ' dwOSVersionInfoSize As Long (byte 0)
m_dwMajorVersion = 4 ' dwMajorVersion As Long (byte 4)
m_dwMinorVersion = 8 ' dwMinorVersion As Long (byte 8)
m_dwBuildNumber = 12 ' dwBuildNumber As Long (byte 12)
m_dwPlatformId = 16 ' dwPlatformId As Long (byte 16)
m_szCSDVersion = 20 ' szCSDVersion As String * 128 (byte 20)

cbOSVERS = 148 ' (byte count)
tOSVERS = "tOSVERS" ' (key)


' On Error Resume Next ' turn on error checking
' create the typedef itself...
' (note: CreateTypeDef allocates memory and clears to zeros)
adrOSVERS = oTD.CreateTypDef(tOSVERS, cbOSVERS)
' set the bytecount for THIS typedef/structure with...
oTD.PutLong(tOSVERS, m_dwOSVersionInfoSize) = cbOSVERS

' check to make sure that the typedef creation succeeded...
BugAssert (err.number = 0), c_sME & "Unable to create typedef, " & vbCrlf _
& " most likely because oATO is not instantiated properly... "
On Error goto 0 ' turn off error checking...

End Sub


Sub Class_Terminate()
' MsgBox(c_sMe & "Terminating")
oTD.DestroyTypDef(tOSVERS) ' return typedef memory block(s)...
End Sub

End Class ' clsOSVERSIONINFO




' --- INSTANTIATE ACTX OBJECT (or class) AND CHECK ----
' (using a sub to get this ugly instantiation code out of main line code)...

Sub Instantiate (oObject, sProgramID, sEventPrefix)
Const sME = "[sub Instantiate], "
' check variant sub-type parameters...
BugAssert (VarType(sProgramID) = vbString), sME & "sProgramID must be a STRING!"
BugAssert (VarType(sEventPrefix) = vbString), sME & "sEventPrefix must be a STRING!"
On Error Resume Next ' turn on error checking
Set oObject = WScript.CreateObject(sProgramID, sEventPrefix)
BugAssert (err.number = 0), sME & "This script requires: " & sProgramID & vbCrlf _
& " kindly INSTALL and REGISTER this ActX component... "
On Error goto 0 ' turn off error checking...
End Sub


' --- BUGASSERT (yes, it's for debugging) --------

Sub BugAssert (bTest, sErrMsg)
Dim sDblSpace : sDblSpace = vbCrLf & vbCrLf

' BugAssert is a Bruce McKinney creation.
' It is used to test for intermediate results...

if bTest then Exit Sub ' normally (hopefully) test returns true...

MsgBox "Error Message reported by BugAssert: " & sDblSpace _
& sErrMsg & sDblSpace & " this script will terminate NOW. ", _
vbCritical, " << BugAssert FAILED in Script: " & Wscript.ScriptName & " >> "
WScript.Quit

End Sub



Sub Old_Code()

End Sub