CreateObject peculiarities (2)

Lately I received some COM-automation related questions which I answered by referring to this blog post: CreateObject Peculiarities (part 1). It advised to use the CoCreateInstance() API with the IID_IUnknown parameter to connect to an automation server. However, after re-reading I realized I could have demonstrated how to use CoCreateInstance. Below is an example that replaces the GB32 CreateObject() function with the custom made CreateObject2() function. It provides the same functionality as CreateObject and more. Where CreateObject only returns an object if it supports the IDispatch inteface, the CreateObject2() function has an optional parameter that takes any interface you want to request from the server. By default, it returns an object that  supports the IDispatch interface, and if that fails it returns the IUnknown interface.

The code is heavily commented, so I hope you will be able to understand it. As an example, CreateObject2 is used to obtain the IDispatch interface of the Scripting's FileSystemObject.

$Library "gfawinx"
$Library "UpdateRT"
UpdateRuntime      ' Patches GfaWin23.Ocx

Dim FSO As Object
' CreateObject2(ClsID [, IID]) replaces CreateObject(ClsID).
Set FSO = CreateObject2("Scripting.FileSystemObject", IID_IDispatch)
MsgBox0("Successfully created object.")
' FSO object is released when it goes out-of-scope.

Function CreateObject2(ClassID As String, Optional IID_Interface As Long) As Object
  '-------------------------------------------------------------------
  '  Like CreateObject creates an Instance of an OLE Server.
  '  The ClassID argument creates a class & specifies the OLE Server.
  '  The IID_Interface argument specifies the interface to create.
  '  There are two formats for the ClassID class argument:
  '   1. PROGID: "Excel.Application"
  '   2. CLSID: "{00000010-0000-0010-8000-00AA006D2EA4}"
  ' If a ProgID is used, the client's registry is used to get the CLSID
  ' If the optional IID_Interface parameter isn't used, a reference
  ' to the IDispatch interface is created. If that fails, a reference
  ' to the IUnknown interface is created.
  ' The IID_Interface is pointer to GUID type, created by GUID command.
  '-------------------------------------------------------------------

  Dim wProgId As Variant = ClassID          ' to Unicode
  Dim Ptr_ProgID As Long = {V:wProgId + 8}  ' string address
  Dim HResult As Long           ' COM error code
  Dim ClsID_ProgID As GUID      ' GUID is built-in type
  Dim fAskDispatch              ' set if II_IDispatch is asked

  ' Get CLSID (GUID) type from either GUID$ or ProgID$
  If Left(ClassID) = "{" && Right(ClassID) = "}" && Len(ClassID) = 38
    HResult = CLSIDFromString(Ptr_ProgID, ClsID_ProgID)
  Else
    HResult = CLSIDFromProgID(Ptr_ProgID, ClsID_ProgID)
  End If
  If HResult != S_OK Then _
    Err.Raise HResult, "CreateObject2", "Wrong CLSID"

  ' The default is to ask for IDispatch (like CreateObject)
  If IID_Interface = 0 Then IID_Interface = IID_IDispatch
  ' Remember whether IID_IDispatch is asked
  fAskDispatch = IsEqualGUID(IID_Interface, IID_IDispatch)

  ' Create a single instance of an object (ClsID_ProgID) on
  ' the local machine that supports the requested interface.
  ' Store the instance in the local function-return variable.
  HResult = CoCreateInstance(ClsID_ProgID, Null, CLSCTX_ALL, _
    IID_Interface, V:CreateObject2)

  // Only if asked for IID_IDispatch and it failed, try IID_IUnknown
  If HResult == E_NOINTERFACE && fAskDispatch
    IID_Interface = IID_IUnknown
    HResult = CoCreateInstance(ClsID_ProgID, Null, CLSCTX_ALL, _
      IID_Interface, V:CreateObject2)
  EndIf

  // If all requests for an interface have failed raise error
  If HResult != S_OK Then _
    Err.Raise HResult, "CreateObject2", "No interface"

  ' ------------------------------------------------------
  ' Global declarations section
  ' ------------------------------------------------------
  Global Const E_NOTIMPL = 0x80004001
  Global Const E_NOINTERFACE = 0x80004002

  ' -------------------------------------------------------
  ' GUID Identifier = value    (global declaration command)
  ' Generates a pointer to a 128 bit memory block containing
  ' a GUID value. So, IID_IUnknown is a Long holding the
  ' address of the GUID value.
  ' -------------------------------------------------------
  GUID IID_IUnknown  = 00000000-0000-0000-c000-000000000046
  GUID IID_IDispatch = 00020400-0000-0000-c000-000000000046

  Global Enum CLSCTX, CLSCTX_INPROC_SERVER, CLSCTX_INPROC_HANDLER = 2, _
    CLSCTX_LOCAL_SERVER = 4, CLSCTX_REMOTE_SERVER = 16, _
    CLSCTX_SERVER = CLSCTX_INPROC_SERVER + CLSCTX_LOCAL_SERVER + _
    CLSCTX_REMOTE_SERVER, _
    CLSCTX_ALL = CLSCTX_INPROC_SERVER + CLSCTX_INPROC_HANDLER + _
    CLSCTX_LOCAL_SERVER + CLSCTX_REMOTE_SERVER

  ' -------------------------------------------------------
  ' CoCreateInstance note.
  ' The GB GUID is a pointer to a GUID type in memory.
  ' To make it possible to use a GB-GUID, we should adjust
  ' the Declare to receive a Long holding the address.
  ' -------------------------------------------------------
  Declare Function CoCreateInstance Lib "OLE32" _
    (ByRef rclsid As GUID, ByVal pUnkOuter As Long, _
    ByVal dwContent As Long, ByVal pIID As Long, _
    ByVal ppv As Long) As Long
  Declare Function CLSIDFromString Lib "OLE32" _
    (ByVal lpszCLSID As Long, pclsid As GUID) As Long
  Declare Function CLSIDFromProgID Lib "OLE32" _
    (ByVal lpszProgID As Long, pclsid As GUID) As Long
  Declare IsEqualGUID Lib "ole32" (ByVal prguid1 As Long, ByVal prguid2 As Long) As Bool
EndFunc

File Creation Date and Time

To read the file-time of a file GB32 offers the following functions:

Dim ft As Date
ft = FileDateTime(file$)        // last write time
ft = FileDateTimeAccess(file$)  // last access time
ft = FileDateTimeCreate(file$)  // creation time

They return a Date datatype with resp. the last write time. last access time, and the creation time.

A Date stores a date/time value as an 8-byte real value (Double), representing a date between January 1, 100 and December 31, 9999, inclusive. The integer part of the Double represents the day: - The value 2.0 represents January 1, 1900 - 3.0 represents January 2, 1900, and so on. Adding 1 to the value increments the date by a day. The fractional part of the value represents the time of day. Therefore, 2.5 represents noon on January 1, 1900; 3.25 represents 6:00 A.M. on January 2, 1900, and so on. Negative numbers represent dates prior to December 30, 1899. You can display the Double representation of the current time like this: Dim dt As Date = Now Debug CDbl(dt)

The FileDateTime* functions are wrappers around Windows API functions and from their name you expect the date of the last write, last access, or the creation time. For instance, the FileDateTimeCreate() should return the time at which a file is created, thus - for instance - the time a program executed the Open command to create a new file. (BTW the time of the file is not set before the Close command is invoked.) However, if the same file was created earlier, the date/time of the earlier creation is returned!
According to the MS documentation:

"If you rename or delete a file, then restore it shortly thereafter, Windows searches the cache for file information to restore. Cached information includes its short/long name pair and creation time."

Ok, that is a little disappointment, we cannot rely on FileDateTimeCreate to return the file's creation time. What's left is the most obvious function FileDateTime(), which is a kind of default function for a file's time. This first choice function returns the last write time, which seems to be the best thing to get the last time the file was created. The last write time returns the time the file is recreated, last updated or written to. So, you can use FileDateTime to obtain the 'last creation time', because FileDateTimeCreate returns the first creation time. To be sure I tested this by recreating an existing file created first at 3 March 2023:

Open "c:\tmp\test.txt" for Output As # 1
Print # 1; "Text"
Close # 1

After executing these codelines and subsequently choosing the file's properties in the Windows Explorer it indeed still shows a creation date of 3 March 2023. To force the file to a new creation date I changed the code with a Touch command:

Open "c:\tmp\test.txt" for Output As # 1
Print # 1; "Text"
Touch # 1
Close # 1

Now the Windows Explorer properties show the current date as the creation date. Using the Touch command will change all three filedates to the current time. To set each file date separately use one of the SetFileDateTime* functions after closing the file.

The Include directory

After installing GFA-BASIC 32 you’ll find four directories in the installation path: Bin, Doc, Include, and Samples.

The \Bin directory contains the GB32 binaries, the \Doc contains the original (German) doc-files that came with GFA-BASIC 32 back in 2001 (now obsolete because everything can be found in the English CHM helpfile), the \Include contains the Windows API include files, and the \Samples directory the samples g32 files, including the new Direct2D example programs.This time we’ll focus on the \Include directory only.

What is the \Include directory for?
The purpose of the \Include directory is to collect all Windows API definitions and declarations in one directory. Because of the huge amount of Windows APIs the definitions and declarations are split into multiple smaller include library files. These GB32 Windows API include-files come both with the source code and the compiled library (lg32) file. The organization of the GB32 include files follows the way the Windows SDK presents the C/C++ include header files. For instance, the C/C++ header file winuser.h has an equivalent GB32 include file winuser.inc.lg32. All include files follow this naming convention: name.inc.lg32.
You import a GB32 include library file using the $Library command, for instance:

$Library "winuser.inc"  ' .lg32 may be omitted

By default, the line doesn’t need to specify the full path, because the location of the \Include directory is pre-selected in the Properties | Extra tab dialog box.

You can easily add your own paths that contain your own library files. The entire string with the specified paths is stored in “lg32paths”registry key. To add a path first type a semicolon ; after the existing path and then specify the full path after the semicolon. Once a path is part of Library paths you do no longer need to type the full path in the $Library statement. Note that libraries are searched for (1) in the current program's directory, (2) in My Documents\lg32, and (3) in the paths stored in the registry key "lg32paths".

Note The \Include directory also contains the libraries gfawinx.lg32, direct2d.lg32 and variants.lg32. These are not include files and don’t have the .inc clause in their names. These are libraries that are part of the GFA-BASIC 32 updates and need an easily accessible path.

Why multiple include files?
Each include file contains only a part of the Windows API, that way you don’t need to include a single large file with many APIs just to have a few declarations. The GB32 include files only provide the APIs that are not built-in by GFA-BASIC32. (Note that the Win32API.g32 that originally came with GB is incomplete and full of errors.) Due to the amount of new APIs that come with each new Windows version, the include files in the \Include files aren’t complete either. They do however provide more declarations and definitions than the original Win32API.g32. Some of the include files are updated with the latest APIs (most specifically APIs supported by Win7 and Windows 10) like, for instance, winuser.inc.lg32. However, many haven’t been updated for a while. They tend to get an update on a ad hoc basis; when I need new APIs I add them to the include files. It is a boring job and, because of the translation from C/C++, errors are easily made. If you need an API that isn’t in one of the include library files yet, let me know (gfabasic32@gmail.com).

Contents of an include library
By default, the GB32 Windows include files only provide function declarations (Declare statements), constant definitions, and user-defined type definitions. They don’t contain executable code and besides the Declare’s they do not contribute to the size of the program. You should know that Declare-ed DLL functions are collected in a DLL-import table that do become part of the program (executable). By spreading the Declare’s over multiple include files the DLL-import table can remain small.
There is one “include” file that does contain executable code: winmacros.lib.lg32 (note the lacking .inc clause in the name). This library contains functions for often used Windows macros that are used as functions in C/C++, but are defined as macros in the C/C++ header files. Some of these function macros are collected into winmacros.lib.lg32. Among others, the library provides (Naked) functions for GET_X_PARAM, GET_Y_PARAM, MakeLParam, MakeIntResource, etc. Please take a look at the source code in winmacros.lib.g32 for an overview of the supported functions/macros.

How to locate a specific API
How do you know in which include file a specific API (type, constant, or function) is located? It might be that GB32 already supports the API as a built-in API, only function declarations and constant definitions. GB32 does not have built-in API support for user-defined API type definitions, they always have to be defined by the program or imported from an include library. The easiest way to check if GB32 supports a specific API is by using the auto-complete feature. Just type the first letters of the function or constant and check if the auto-complete pops up with the required name. If it isn’t provided by GB32 you’ll need to check the Windows SDK documentation to see which C/C++ include file provides the declaration or definition for that API and load the equivalent GB32 .inc library file.

An example of using an API
Each topic in the Windows SDK specifies in which C/C++ header file an API function, type, or constant is declared. For instance, if and API is located in the winuser.h C/C++ header file you have a big chance of finding it in the winuser.inc.lg32 file. Let’s look at an example. Suppose your program wants to process the WM_GETMINMAXINFO message. After looking up the documentation for this message, it tells you to obtain the  MINMAXINFO structure from the lParam. However, GB32 itself does not provide a definition for the MINMAXINFO user-defined type, and you need to import the type. When you go to the SDK page that describes this type you’ll find at the bottom of the page the location of the definition of this structure: the winuser.h C/C++ header file. Now you know which GB32 include library you need: winuser.inc and the program can import that library. As it happens this structure contains members of the API type POINT, which is defined in wingdi.inc. However, you won’t need to include wingdi.inc in your program, because it is imported by winuser.inc (otherwise it couldn’t be compiled). After importing winuser.inc in your program the constants and user-defined types from wingdi.inc are available as well. So, the POINT structure is available as a user-defined type in your program.

Note winuser.inc exports the constants and type definitions of wingdi.inc, but not the function declarations. If you need an API function declared in wingdi.inc you’ll need to import wingdi.inc as well. Importing both include files won’t collide with each other.

$Library "winuser.inc"
$Library "wingdi.inc"

Although both include files export the same constants and user-defined types they are added only once to the program. Now if winuser.inc would also export the function declares from wingdi.inc the internal database of GB32 may become corrupted. Therefor, winuser.inc exports all constants and types using the $Export Const * and $Export Type * statements, but the exported $Export Decl name statements must specify each exported declare separately. This is easily done using the App+E shortcut, it inserts $Export Decl lines for each Declare in the library file.

Conclusion
You can use the Windows API inc files to import Windows APIs easily. Because the (compiled) user-defined types are imported from a library the autocomplete function has direct access to their members and is fully operational without first compiling your program.

High resolution timer wrapped in a COM object

Only recently I needed a timer with a shorter interval than that the Ocx Timer can provide. The Ocx Timer smallest interval is 15.625 ms – 64 ticks per second - where I needed an interval of 10 ms to receive 100 timer-events per second. After some research I decided to use the API function CreateTimerQueueTimer() as a high-resolution timer. For a discussion on available timers see this Code Project article. I didn’t use the multi-media timers because MS advises against it, because these timers increase the system clock’s frequency which leads to a drain of battery-power on mobile devices. Nevertheless, the CreateTimerQueueTimer() API only produces shorter intervals than 15.625 ms if the the application’s system clock is adjusted as well using the multimedia function timeBeginPeriod(). This function cannot be used to increase the resolution of the SetTimer API which is used by the Ocx Timer.

A resource must be deleted
As with most Windows resources the queued timer comes with a create- and a release function. The created timer is released using the Windows API DeleteTimerQueueTimer() and is (usually) invoked when the program terminates. In addition, at the very end of the application, the system timer must be reset using timeEndPeriod(). The most common scenario for a GB program is outlined in this simple program:

$Library "mmsystem.inc"
OpenW 1
Global timerHandle As Handle, param As Large
' Create a 10 ms timer with ID=1 for Me
param = MakeLargeHiLo(Me.hWnd, 1)   ' assemble handle and ID
~timeBeginPeriod(1)
CreateTimerQueueTimer(timerHandle, Null, _
  ProcAddr(TimerQProc), V:param, 0, 10, WT_EXECUTEINTIMERTHREAD)
Do
  Sleep
Until Me Is Nothing
DeleteTimerQueueTimer(Null, timerHandle, Null)
~timeEndPeriod(1)

Proc TimerQProc(ByVal pParameter As Long, ByVal TimerOrWaitFired As Long) Naked
  ' Process timer event
  Dim pL As Pointer Large, hWnd As Handle, ID As Long
  Pointer pL = pParameter
  hWnd = HiLarge(pL), ID = LoLarge(pL)
EndProc

This sample only shows the general structure of a program that uses a Windows timer resource, the structure of the program is the same if it uses some other Windows resource. In this scenario a Windows resource is allocated before entering the message loop and released after the message loop has finished and the last Form has closed. However, when the program unexpectedly stops with a runtime-error the code below the message loop is never executed! This leads to unreleased Windows resources, something you don’t want. When GB raises a runtime error it stops at the line the error occurred and halts further execution of the program. The program’s windows (Forms) remain on the screen waiting to be closed or ‘cleaned up’ by using the wipe-window button in the IDE’s toolbar. Closing the remaining windows this way does not trigger any event subs like - for instance - the Form_Destroy event sub. Consequently, it is  pointless to move the resource delete function to this event sub, because it is not executed once the program stopped with a runtime error.

Each time the program is run within the IDE and stops with a runtime error it does not release the allocated resources. But, this is also true for the GB function mAlloc calls that require a call to mFree to release the memory. We need a way to release allocated resources under all circumstances. 

Using a COM wrapper
When GB stops executing after a runtime error it still releases GB resources, it closes I/O channels and deletes any TempFileName files, and finally it clears all the program’s global variables. For dynamic variables types (String, Object, arrays, hashes) the allocated memory is freed as well. (Therefore, it is sometimes better to use a string to allocate memory than to use mAlloc, strings are freed automatically.) For global variables that hold a COM object GB calls the Release vtable function of the IUnknown interface that each COM object implements. So, if we could wrap the resource handling in a (minimal) COM wrapper and store it in an Object type we are assured the Release function is called and we can properly delete the resource in the object’s Release function. This way we’re able to free the resources under all conditions.

If you’re not familiar with COM objects and the IUnknown implementation you might read a previous post first: COM in GB32 – IUnknown. The rest of this post discusses how to create a minimal COM wrapper for the queued timer APIs.

The minimal COM wrapper
The following full working sample creates a queued timer in the QueTimer function which returns an Object that holds a reference to the minimal COM object it creates. A COM object must at least implement the IUnknown interface that consists of the QueryInterface, AddRef and Release functions. Since this COM object doesn’t support any other interfaces (except IUnknown) we simply return with E_NOTIMPL from the QueryInterface function. The COM object is built manually in code and cannot be created by a function like CreateObject(). As a result QueryInterface is never called. The AddRef and Release functions require a proper implementation since these vtable functions are called by GB’s Set command.
The vtable functions must have the Naked attribute, or at least a $StepOff command, to prevent the GB compiler from inserting Tron code which can result in nasty and hard to find bugs. This is also true for any callback function Windows calls; the QueTimer callback procedure needs the Naked attribute as well.

$Library "mmsystem.inc"

OpenW 1, 0, 0, 300, 300, 48
PrintScroll = 1 : PrintWrap = 1

Global Object tmrQ1, tmrQ2
Set tmrQ1 = QueTimer(Me, 1, 10)   ' ID=1, 10 msec
Set tmrQ2 = QueTimer(Me, 2, 1000) ' ID=2, 1000 msec

Global Long Count, CountToErr
Do
  Sleep
Until Me Is Nothing

Sub Win_1_Message(hWnd%, Mess%, wParam%, lParam%)
  ' Process the WM_TIMER
  Static Long CountToErr
  If Mess% = WM_TIMER
    If wParam% == 1
      Count++
      Print ".";      // do something
    ElseIf wParam% == 2
      TitleW 1, "Timer Events/s:" + Str(Count) : Count = 0
      ' Interrupt GB with a runtime error after 10 sec
      CountToErr++ : If CountToErr = 10 Then Error 3
    EndIf
  EndIf
EndSub

Proc QueTimerProc(ByVal pParameter As Long, ByVal TimerOrWaitFired As Long) Naked
  ' Callback function
  Local hWnd As Handle, id As Long, pObj As Pointer IQueTimer
  Pointer pObj = pParameter             ' holds address of a IQueTimer object
  ~PostMessage(pObj.hWndTarget, WM_TIMER, pObj.TimerID, 0)
EndProc


Function QueTimer(frm As Form, id As Long, mSec As Long) As Object
  ' Create high-resolution timer wrapped in a minimal COM object.
  Global Long g_IQueTimerCnt

  Type IQueTimer         ' definition of object
    lpVtbl As Long
    refcount As Long
    Handle As Handle
    hWndTarget As Handle
    TimerID As Long
  EndType

  ' Set up the IUnknown vtable, same for each object
  Static vTable(0 .. 2) As Long    ' must remain in memory
  If vTable(0) == 0                ' do this only once
    vTable(0) = ProcAddr(IQueTimerVtbl_QueryInterface)
    vTable(1) = ProcAddr(IQueTimerVtbl_AddRef)
    vTable(2) = ProcAddr(IQueTimerVtbl_Release)
  EndIf

  ' Alloc and clear an IQueTimer object (Type) and
  ' assign it to an IQueTimer pointer.
  Local pObj As Pointer IQueTimer
  Pointer pObj = cAlloc(1, SizeOf(IQueTimer))

  ' Initialize the IQueTimer object
  pObj.lpVtbl = ArrayAddr(vTable())     ' set vtable
  pObj.refcount = 1                     ' set refcount
  pObj.hWndTarget = frm.hWnd            ' target window
  pObj.TimerID = id                     ' timer ID

  ' Create the API timerqueue resource and
  ' if succesfull finish the COM object, otherwise
  ' free the allocated memory.
  Local timerHandle As Handle
  If CreateTimerQueueTimer(timerHandle, Null, _
    ProcAddr(QueTimerProc), Pointer(pObj), 0, mSec, WT_EXECUTEINTIMERTHREAD)
    '  store the resource handle in the object
    pObj.Handle = timerHandle

    ' Set the system's clock resolution to 1 ms,
    ' do this only once per application.
    If g_IQueTimerCnt == 0 Then ~timeBeginPeriod(1)
    g_IQueTimerCnt++            ' count the number of instances

    ' Return COM object as Object
    {V:QueTimer} = Pointer(pObj)

  Else    ' something went wrong, release already allocated resource(s)
    ~mFree(Pointer(pObj))     ' free the alloced memory

    ' Do not set returnvalue to return Nothing
  EndIf
EndFunc

Function IQueTimerVtbl_QueryInterface(ByRef This As IQueTimer, _
  ByVal riid As Long, ByVal ppvObject As Long) As Long Naked
  Return E_NOTIMPL
EndFunc

Function IQueTimerVtbl_AddRef(ByRef this As IQueTimer) As Long Naked
  this.refcount++
  Return this.refcount
EndFunc

Function IQueTimerVtbl_Release(ByRef this As IQueTimer) As Long Naked
  this.refcount--
  If this.refcount == 0
    MsgBox "terminating" ' remove comment to see that Release is called
    DeleteTimerQueueTimer(Null, this.Handle, Null)
    g_IQueTimerCnt--     ' decrease instance counter
    ' If all instances are released, reset the system clock
    If g_IQueTimerCnt == 0 Then ~timeEndPeriod(1)
    ~mFree(*this)
  EndIf
  Return this.refcount
EndFunc

' Declares and Constants
Declare Function CreateTimerQueueTimer Lib "kernel32" (ByRef hNewTimer As Handle, _
  ByVal hTimer As Handle, ByVal Callbck As Long, ByVal Parameter As Long, _
  ByVal DueTime As Long, ByVal Period As Long, ByVal Flags As Long) As Long

Declare Function DeleteTimerQueueTimer Lib "kernel32" (ByVal hTimer As Handle, _
  ByVal Timer As Handle, ByVal CompletionEvent As Handle) As Long

Global Const E_NOTIMPL = 0x80004001
Global Const WT_EXECUTEINTIMERTHREAD = 0x00000020

The program creates two high-resolution timers and stores the minimal COM wrappers in the Object variables tmrQ1 and tmrQ2. The second timer is used to display the number of timer events per second produced by timer 1. There is nothing you can do with the Object variables, the minimal COM wrapper does not support any properties or methods. The Set command is the only command that can be used on these objects. The only reason for the existence of these Object variables is to sit and wait to be released so that the resources can be deleted properly. In fact, you could collect all globally used resources into the creation function – here QueTimer() - and release them in the Release vtable function.
To demonstrate the proper calling of the object’s Release the program raises an error after 10 seconds. A message box pops up to show you that Release is invoked after a runtime error.

Finally
If you’re not familiar with the binary layout of a COM object and maybe having trouble understanding how the COM object is build, don’t worry. You can copy paste this code to create your own minimal COM wrapper, simply replace the string ‘QueTimer’ with a name of your own (do not select Whole Word in the Replace dialog box). Then replace the code that creates and deletes the Windows resource with the functions you require. Of course you will need to edit the IQueTimer type that holds the information for a particular COM object.

Unicode controls

In the passed years I’m frequently asked for ‘Unicode support’ in GFA-BASIC 32. The issue here is that GB is an ANSI programming language; the IDE accepts only characters in the range from 0 to 255 and the string functions assume one byte per character. All commands and functions that accept a string parameter only take ANSI strings. However, it is possible to create UNICODE controls and let the user input text in the user’s locale setting and then retrieve the wide character text from the controls. To process the retrieved text the application will most likely use Windows API wide-string functions.

A few notes
An introduction to Unicode strings can be found in a previous post: Ansi and Unicode.

This blog post will discuss the use of Unicode (or wide character) controls on a GFA-BASIC 32 form, specifically on a Dialog form. The code is discussed in bits and pieces, but the code for the entire example program can be downloaded here.

Declaring wide API functions
When an application wants to use wide character controls the Ocx property and sub-event system cannot be used any longer. In addition, a dialog definition has to be set up in code, because the form-editor can no longer be used either. The controls have to be created and handled using Windows W-API functions. Windows defines both ANSI and Unicode variants for API functions that take a string parameter. Many of the ANSI APIs are built-in in GFA-BASIC, but the W variants are missing and have to be declared explicitly. Two wide char APIs an application will definitely use are CreateWindowExW and SendMessageW. They have to be declared explicitly (abbreviated):

Declare Function CreateWindowExW Lib "user32" (ByVal dwExStyle As Long,
Declare Function SendMessageW Lib "user32" (ByVal hWnd As Handle, …

Other possible declares are lstcmpW, lstrcmpiW, CharUpperW, and CharLowerW. To draw Unicode text on the screen the application needs to declare TextOutW and/or DrawTextW, etc.

• Recommended: A full set of wide-string functions can be found in the Shell Lightweight Utility functions (SHLWAPI) DLL. The Include library does not provide an include file with Wide function declarations though!

Defining controls
We cannot use any predefined control and we cannot use the Control command to create a wide character control. We can however create a procedure ControlW that allows an easy translation of Control statements to Unicode controls. Because we will use a W variant of the Control command, an easy way to add controls is by using a dialog box (which is a Form). This also allows us to use an external dialog box editor. The following piece of code is created using ResHacker, a GUI utility that provides the ability to create a dialog box definition. After copying and pasting the definition into the GB editor the command Control is replaced by ControlW. Note that ResHacker produces a dialog definition with dialog base units rather than pixels. Also, the dimension of the controls may need some editing once the dialog is used in GB. The WS_CHILD | WS_VISIBLE styles can be removed as well.

DlgBase Unit
Dlg 3D On
Dialog # 1, 0, 20, 261, 140, "Controls", WS_SYSMENU | WS_CAPTION
  ControlW "&OK", 1, "BUTTON", BS_DEFPUSHBUTTON | 
WS_CHILD | WS_VISIBLE | WS_TABSTOP, 130, 97, 50, 11
  ControlW "&Cancel", 2, "BUTTON", BS_PUSHBUTTON | 
WS_CHILD | WS_VISIBLE | WS_TABSTOP, 187, 97, 50, 11
  ControlW "Checkbox", 10, "BUTTON", BS_AUTOCHECKBOX | 
WS_CHILD | WS_VISIBLE | WS_TABSTOP, 7, 8, 60, 14
  ControlW "Group", 0, "BUTTON", BS_GROUPBOX | 
WS_CHILD | WS_VISIBLE, 7, 23, 59, 47, WS_EX_TRANSPARENT
  ControlW "Radio 1", 12, "BUTTON", BS_RADIOBUTTON | 
WS_CHILD | WS_VISIBLE | WS_TABSTOP, 12, 36, 43, 14
  ControlW "Radio 2", 13, "BUTTON", BS_RADIOBUTTON | 
WS_CHILD | WS_VISIBLE | WS_TABSTOP, 12, 51, 43, 14
  ControlW "Trackbar", 15, "msctls_trackbar32", TBS_HORZ | 
WS_CHILD | WS_VISIBLE | WS_TABSTOP, 7, 77, 60, 18
  ControlW "Insert Text:", 0, "STATIC", SS_LEFT | 
WS_CHILD | WS_VISIBLE | WS_GROUP, 82, 10, 45, 10
  ControlW "", 17, "EDIT", ES_LEFT | ES_MULTILINE | 
WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP, 122, 7, 116, 14
EndDialog

The ControlW procedure creates the wide control. The string input parameters are ANSI strings that are converted to Unicode before the CreateWindowsExW is invoked. Since the dialog definition uses dialog box units the Dlg Base Units command is added. This command initializes a few global variables in the runtime. The ControlW procedure tests if Dlg Base Units is used and if it is used converts the coordinates from dialog box units to pixels.

Proc ControlW(text$, id%, class$, style%, x%, y%, w%, h%, Optional exstyle%)
  Local hWnd As Handle, pText As Long
  If Len(text$) Then text$ = Wide(text$) : pText = V:text$
  class$ = Wide(class$)
  style% |= WS_CHILD | WS_VISIBLE
  If {$180B5F70} %& 1    ' DlgBase Units?
    x% = MulDiv(x%, {$180B5E98}, 4)
    y% = MulDiv(y%, {$180B5E94}, 8)
    w% = MulDiv(w%, {$180B5E98}, 4)
    h% = MulDiv(h%, {$180B5E94}, 8)
  EndIf
  hWnd = CreateWindowExW(exstyle%, V:class$, pText, style%, x%, y%, w%, h%, Me.hWnd, id%, _INSTANCE, 0)
  If hWnd _
    SendMessageW(hWnd, WM_SETFONT, Me.Font._hFont, 1)
EndProc

The controls are created using pure Windows API, this also means that the controls have to be initialized and modified by sending messages. You will need proper documentation to know which message and how to send it to the controls. The controls are not OCX controls and don’t respond to notification messages through an event sub. The notification messages from the controls come either in WM_COMMAND or WM_NOTIFY message. The application needs to process these messages the ‘API-way’.

Notes on using a dialog box
An advantage of using a Dialog form is the presence of properties and event-subs. To respond to control-messages a Dlg_n_Message sub is all that is needed. A disadvantage of using a Dialog form is the lack of Unicode support for the title of the ANSI-based dialog box. One solution could be to add an informative picture along the top (caption) of the dialog form. This would require a simple LoadPicture and PaintPicture sequence of commands.
In addition, ANSI and Unicode controls can not be used together, that would break the Tab-key navigation. Even worse, the navigation with Unicode controls differs from the navigation with ANSI controls. This means commands like Sleep and PeekEvent will mess up the key-navigation. A work-around is to trap the Tab- and arrow keys in the Screen_KeyPreview event sub and call IsDialogMessage ourselves.

Sub Screen_KeyPreview(hWnd%, uMsg%, wParam%, lParam%, Cancel?)
  Dim msg As MSG
  If GetForegroundWindow() = Dlg_1.hWnd
    msg.hwnd = hWnd%
    msg.MessageVar = uMsg%
    msg.wParam = wParam%
    msg.lParam = lParam%
    Cancel? = IsDialogMessage(Dlg_1.hWnd, msg) == 1
  EndIf
EndSub

Cancel is set to True when IsDialogMessage handled the key. This prevents the handling of the navigation key in commands like Sleep and PeekEvent.
IsDialogMessage is always called as part of the message handling commands and IsDialogMessage processes the key when the form contains at least one control (might be a toolbar or statusbar). It seems the GB application ‘eats’ the keypresses if you’re not aware of this behavior.

Another issue is the way the focus is handled in a form with controls. The application should always explicitly set the focus to a control before entering the main message loop. If it doesn’t the focus might not be set correctly when a navigation key is pressed or when the application is reactivated.

Processing Unicode strings
The ControlW custom procedure takes an ANSI string for the control text. However, the program needs to set the controls text using Unicode instead. Normally, a program assigns hard coded text to a control, but the text in the IDE is limited to ANSI characters. Somehow the text must be obtained from a Unicode source that can be used as literal strings. Because it is (almost) impossible to specify Unicode strings in code directly, strings have to be obtained from an external source. This is possible with the use of an editor that can save Unicode strings. For this example I used NotePad2 that can save Unicode strings by setting the Encoding in the File menu to Unicode. In the GB code I defined constants with the index of the strings after they have been loaded into an array. These lines can be found at the start of the example program:

Dim T$$()   ' storage for UNICODE strings
Enum wsHello, wsGFABASIC
LoadWStrings("unicode.txt", T$$())

The procedure LoadWStrings loads the Unicode text lines into the array T$$(). The double $ is used to indicate that the string array variable contains wide character strings.

Now, after the dialog box has been created, but before it is displayed, the text of the wide controls can be modified using a string from T$$(). For this to happen the program includes a SetW procedure which assigns a Unicode string to a window. In the same style a GetW function returns a Unicode string from a window.

Function GetW(ByVal hwnd As Handle, Optional InclTerm As Bool = False) As String
  Local size As Long, sBuf As String
  size = SendMessageW(hwnd, WM_GETTEXTLENGTH, 0, 0)
  If size
    size++     ' also obtain the terminating null bytes
    sBuf = String(size Mul 2, #0)
    SendMessageW(hwnd, WM_GETTEXT, size, V:sBuf)
    GetW = InclTerm ? sBuf : Left(sBuf, Len(sBuf) - 2)
  EndIf
EndFunc

Proc SetW(ByVal hwnd As Handle, ByVal wTxt As String)
  If Right(wTxt, 2) != #0#0 Then wTxt += #0#0
  SendMessageW(hwnd, WM_SETTEXT, 0, V:wTxt)
EndProc

For instance, to set the text of the wide EDIT control in the dialog box to Hello:

SetW Dlg(1, 17), T$$(wsHello)

By default GetW returns a Unicode without the terminating two null bytes. However, if a Unicode string is later to be passed to a Windows function, the string is expected to end with two terminating null bytes. So, it depends on the purpose of the string whether or not the string should include the terminating zeros. GetW can return the Unicode string with the terminating bytes as well.
As an example the program also provides a way to compare Unicode strings using Windows API functions:

Function StrCmpW(ByVal str1 As String, ByVal str2 As String, 
  Optional ignorecase As Bool) As Bool
  If Right(str1, 2) != #0#0 Then str1 += #0#0
  If Right(str2, 2) != #0#0 Then str2 += #0#0
  If ignorecase
    StrCmpW = lstrcmpiW(str1, str2) == 0
  Else
    StrCmpW = lstrcmpW(str1, str2) == 0
  EndIf
EndFunc

The function StrCmpW is wrapper around the declared lstrcmpiW and lstrcmpW APIs. Before these APIs are invoked the strings are tested for the two terminating null bytes. If they are missing the strings are modified. For example, to test if the edit-control holds the word ‘hello’ the following code might be used:

wTxt = GetW(Dlg(1, 17))
If StrCmpW(wTxt, T$$(wsHello), True)
  MsgBox "Edit control specified hello"
EndIf

Summary
A GFA-BASIC application can provide Form-based Unicode controls. The IDE does not allow Unicode literal strings so they must come from an external source. In addition, many other commands like MsgBox, Dlg Open/Save require ANSI strings, so the application must use the appropriate wide Windows API functions. To be fully Unicode the application should be created using wide character API functions entirely.

Task Dialog as a replacement for Alert

Since Vista Windows supports the Task Dialog, an extended Message Box with a lot of new features. As the message box the task dialog displays an application-defined message, title, icons and any combination of predefined push buttons. In addition it supports a verification checkbox, command links, and radio buttons. In this post I’ll show you how to use the latest GB update (version 2.56) to easily create a task dialog. At the end of this post we will create the following dialog as an replacement for the famous Alert box.

There are two APIs that create a dialog box: TaskDialog and TaskDialogIndirect. The links will take you to the MS SDK site, to the pages that formally describe the APIs. Starting with GFA-BASIC update version 2.56 the APIs are declared in the include library file commctrl.inc.lg32. To get to the actual declaration you should inspect commctrl.inc.g32 – the source file for the library.

The TaskDialog API
The TaskDialog API is declared as follows:

Declare Function TaskDialog Lib "comctl32.dll" ( _
  ByVal hwndParent As Long, ByVal hInstance As Long, _
  ByVal pszWindowTitle As Long, ByVal pszMainInstruction As Long, _
  ByVal pszContent As Long, _
  ByVal dwCommonButtons As Long, _
  ByVal pszIcon As Long, pnButton As Long) As Long

Note that only the last parameter takes a variable by reference, all others are declared as ByVal. The TaskDialog function returns the selected button through this variable. The return value of the function itself indicates success or failure.

The parameters that take a string expect a wide string, the string must be formatted as an Unicode string. I discussed Unicode strings in Ansi and Unicode. To convert an Ansi string to Unicode I’ll use the function Wide() from gfawinx.lg32, which is located in the Include directory as well. The name of this file does not include the inc part, because it is a library with executable code, which will add to the program’s size (be it minimal). The include files (those that include the inc extension in the filename) only contain declarations and definitions that don’t add to the program’s size.

If you didn’t change the path to the Include directory after installing the update the Extra tab in the GB Properties should contain a valid library-path. This also means that you can include commctrl.inc.lg32 and gfawinx.lg32 as shown in this code:

$Library "commctrl.inc"
$Library "gfawinx"
OpenW 1
Print DlgTask(Me.hWnd, "Prompt", "Content", "Demo" , , -3)
Do
  Sleep
Until Me Is Nothing

Function DlgTask(hOwner As Handle, sMainText$, sContent$, _
  Optional sTitle$, Optional iButtons% = TDCBF_OK_BUTTON, _
  Optional Icon& = 0) As Long
  Local Long RetVal, lIcon
  Local String Title

  sMainText$ = Wide(sMainText$)
  sContent$ = Wide(sContent$)
  Title = Wide( Iif(IsMissing(sTitle$), App.Name, sTitle$))
  lIcon = MakeLongHiLo(0, Icon&)

  If TaskDialog(hOwner, 0, V:Title, V:sMainText$, V:sContent$, _
    iButtons%, lIcon, RetVal) == S_OK
    Return RetVal
  EndIf
EndFunc

This code produces the following dialog box at the center of the parent window:

You can pass Null to the hOwner parameter of the TaskDialog, but that would display the dialog at the center of the main screen. Not very useful when using multiple monitors with high resolutions. The hInstance parameter can be 0 because we don’t use an icon from the EXE’s resources. Instead we pass a predefined value for the icon to display (-3). The wide strings are passed by providing their address. The RetVal variable is passed by reference to receive the button’s number (>1) that is selected. The DlgTask function returns 0 if TaskDialog doesn’t return with S_OK (=0).

Although commctrl.inc defines all constants to be used with the task dialog functions, it doesn’t provide constants for the icons (GFA-BASIC versions <= 2.56). The icons are defined as follows:

Icon	Value (Word)
Warning	-1
Error	-2
Information	-3
Shield	-4

The icon parameter must be an integer resource value created with the macro MAKEINTRESOURCE(). This macro, defined in some SDK header, creates a long where the high word is zero and the low word contains the resource identifier (Word). Here we use MakeLongHiLo() to create the integer resource value. With a newer version of GB (> 2.56) you can use the constants as defined in commctrl.inc without the need to convert with MakeLongHiLo.

The TaskDialogIndirect API
The TaskDialogIndirect function allows further fine tuning of the task dialog. For this to happen you need to fill out a structure of type TASKDIALOGCONFIG.

Declare Function TaskDialogIndirect Lib "comctl32.dll" ( _
  ByVal pTaskConfig As Long, pnButton As Long, _
  pnRadioButton As Long, pfVerificationFlagChecked As Long) As Long

By using TaskDialogIndirect you can create custom buttons rather than using predefined buttons only. Therefor it is a perfect candidate to replace the good old Alert box with a nicer version. The next example shows how to set up the TASKDIALOGCONFIG structure and pass it to the TaskDialogIndirect API to create the dialog box as shown at the beginning of this post. The Alert2 function takes the same arguments as the Alert box function. The IconAndFlag% argument specifies the icon and layout of the alert box. The MainText$ argument can specify multiple lines by using | as a separator. The ButtonText$ specifies the custom buttons and DefButton% the button to preselect. These parameters are translated to the task dialog features.

$Library "commctrl.inc"
$Library "gfawinx"
OpenW 1
Print Alert2(2, "Which procedure should|be executed", 1, "Input|Calculate|Print")
Do
  Sleep
Until Me Is Nothing

Function Alert2(IconAndFlag%, MainText$, DefButton%, ButtonText$) As Long
  Dim Icon As Word, RetVal As Long, VerFlag As Long, i As Long
  Dim sTitle As String, aBtn() As String, sVerificationText As String
  Dim tdc As TASKDIALOGCONFIG, taskBtn() As TASKDIALOG_BUTTON

  ' Provide a title (Unicode)
  sTitle = Wide(App.Name)
  sVerificationText = Wide("Don't ask again")

  ' Determine the icon
  Switch IconAndFlag% %& 7
  Case 1       : Icon = -2    ' Stop: Stop/Error icon
  Case 2, 4, 7 : Icon = -3    ' Question, Information: Information icon
  Case 3       : Icon = -1    ' Exclamation: Warning
  Case 5, 6    : Icon = -4    ' Windowsflag, Application: Shield icon
  EndSwitch

  ' Text lines are separated with |, but we need #10
  MainText$ = Replace(MainText$, "|", #10)
  MainText$ = Wide(MainText$) ' to UNICODE

  ' Copy the button text to the TASKDIALOG_BUTTON array
  StrToArr(ButtonText$, "|", aBtn())
  ReDim taskBtn(0 .. UBound(aBtn()))
  For i = 0 To UBound(aBtn())
    aBtn(i) = Wide(aBtn(i))        ' convert to Unicode
    taskBtn(i).nButtonID = i + 1   ' ID's are base 1
    taskBtn(i).pszButtonText = V:aBtn(i)
  Next

  tdc.cbSize = SizeOf(TASKDIALOGCONFIG)
  tdc.hwndParent = Me.hWnd
  tdc.dwFlags = TDF_ALLOW_DIALOG_CANCELLATION | TDF_POSITION_RELATIVE_TO_WINDOW
  ' Right align text?
  If IconAndFlag% %& 64 Then tdc.dwFlags = tdc.dwFlags | TDF_RTL_LAYOUT
  tdc.pszWindowTitle = V:sTitle
  tdc.hMainIcon = MakeLongHiLo(0, Icon)
  tdc.pszMainInstruction = V:MainText$
  tdc.cButtons = Dim?(taskBtn())
  tdc.pButtons = V:taskBtn(0)
  tdc.nDefaultButton = DefButton%
  tdc.pszVerificationText = V:sVerificationText

  If TaskDialogIndirect(V:tdc, RetVal, 0, VerFlag) == S_OK
    ' VerFlag is 1 if checkbox is checked
    Return RetVal   ' base 1
  EndIf
EndFunc

As with the TaskDialog function all strings must be UNICODE. After setting the tdc.cbSize member to the required size the hwndParent and dwFlags members are used to position the dialog in the center of the parent window.
If the IconAndFlag% parameter specifies right aligned text it is honored by including TDF_RTL_LAYOUT in the dwFlags member.
The main text string must contain LF (#10) characters to separate multiple lines. However, the MainText$ argument will separate multiple lines using the | character. So, before converting MainText$ to a wide string we need to replace all occurrences of | with #10 characters. The Replace function is located in gfawinx.lg32.
Setting up the custom buttons requires a bit more work. First we need to create separate strings for each button text. For this to happen we use the gfawinx procedure StrToArr, which splits a string into multiple array elements. Then, in a loop, each array element is converted to a wide string. In the same loop we assign the button’s ID-value and the string pointer to an array of TASKDIALOG_BUTTONs. After initializing this array, it is assigned it to the tdc members cButtons, pButtons, and nDefaultButton.
Finally, we specify text for an additional checkbox control with the pszVerification member. When pszVerification holds a valid memory address the checkbox control is displayed, but it is enabled only if the pfVerificationFlagChecked parameter of TaskDialogIndirect specifies the address of a return variable. If this parameter is Null the check box is displayed in a disabled state. This is also true for additional option boxes. Note that you may pass Null (0) to a ByRef parameter of a declared DLL function.