CWindow RC09

[José Roca]

CWindow Release Candidate 09

New release with the latest changes.

Tired of having to type pWindow.hWindow to pass the parent handle, I have made this parameter optional, so besides

Code Select Expand


pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 250, 140, 75, 23)


you can also use

Code Select Expand


pWindow.AddControl("Button", , IDCANCEL, "&Close", 250, 140, 75, 23)


Of course, only in the case that the parent is the handle of the window of the class. If you add, for example, a group box and then create controls that are children of the group box, you can omit the parent handle to create the group box, that is child of the window of the class, but you must specify the handle of the group box whe creating its child controls; otherwise, they will become children of the main window.

Code Select Expand


DIM hGroupBox AS HWND = pWindow.AddControl("GroupBox", , IDC_GROUPBOX, "GroupBox", 20, 20, 305, 100, , WS_EX_TRANSPARENT OR WS_EX_CONTROLPARENT)
pWindow.AddControl("Label", hGroupBox, IDC_LABEL, "Label", 40, 30, 75, 23)
pWindow.AddControl("Check3State", hGroupBox, IDC_CHECK3STATE, "Click me", 40, 60, 75, 23)
pWindow.AddControl("Edit", hGroupBox, IDC_EDIT, "", 190, 30, 75, 23)
pWindow.AddControl("Button", hGroupBox, IDC_BUTTON, "&Close", 190, 60, 75, 23)


[José Roca]

Regarding the problem of the "A" and "W" functions, I'm thinking to have an unicode version only and return a variant.

For example:

Code Select Expand


' ========================================================================================
' Returns an unicode text string from the clipboard.
' Usage:
' DIM vText AS VARIANT
' vText = AfxGetClipboardText
' PRINT AfxVarToStr(@vText, TRUE)
' ========================================================================================
PRIVATE FUNCTION AfxGetClipboardText () AS VARIANT
   ' // If the text format is available...
   IF IsClipboardFormatAvailable(CF_UNICODETEXT) <> 0 THEN
      ' // Opens the clipboard
      IF OpenClipboard(NULL) <> 0 THEN
         ' // Gets memory object of clipboard text
         DIM hMem AS HANDLE = GetClipboardData(CF_UNICODETEXT)
         IF hMem <> NULL THEN
            ' // Locks it and get a pointer
            DIM pMem AS HGLOBAL = GlobalLock(hMem)
            ' // Assigns the data to our function return value
            IF pMem <> NULL THEN
               ' // Gets the size of the global lock
               DIM dwSize AS DWORD = GlobalSize(hMem)
               IF dwSize > 0 THEN
                  ' // Allocates a variant and copies the contents of the clipboard to it
                  DIM v AS VARIANT
                  v.vt = VT_BSTR
                  v.bstrVal = SysAllocStringLen(pMem, dwSize)
                  FUNCTION = v
               END IF
            END IF
            ' // Releases the memory object
            GlobalUnlock hMem
         END IF
         ' // Closes the clipboard
         CloseClipboard
      END IF
   END IF
END FUNCTION
' ========================================================================================


It can be used as

Code Select Expand


DIM v AS VARIANT = AfxGetClipboardText
DIM s AS STRING = AfxVarToStr(@v, TRUE)
PRINT s

---or---

DIM v AS VARIANT = AfxGetClipboardText
PRINT AfxVarToStr(@v, TRUE)


and as

Code Select Expand


DIM v AS VARIANT = AfxGetClipboardText
DIM cbs AS CBStr = AfxVarToBStr(@v, TRUE)
PRINT cbs


The variant will be cleared by AfxVarToStr / AfxVarToBSTR if the second parameter is TRUE, and the BSTR returned by AfxVarToBStr will be freed when cbs goes out of scope.

The Windows API provides a ton of functions to work with variants. The most important are in Propsys.lib (header: Propvarutil.h), which unfortutately aren't included in the FreeBASIC headers.

Of course, we have to use intermediate steps to avoid memory leaks caused by temporary variables, but...

[José Roca]

With Unicode, the use of ansi strings is forbidden.

See in the captures below what you get using unicode and ansi (garbage) when copying and capturing Russian text to the clipboard.

[José Roca]

I have thought about returning a Variant as a way to standardize the use of the wrappers. Otherwise, with some you will have to use Delete, with others SysFreeString and with others CoTaskMemFree, to free the strings or buffers.

[José Roca]

The writing of the wrappers that convert the variant to a buffer, ansi string or BSTR has been complicated because we have not an import library for propsys.dll and because the function VariantToStringAlloc does not support floats (apparently, the C++ compiler promotes floats to doubles).

Code Select Expand


' ========================================================================================
' Extracts the contents of a VARIANT to a newly-allocated buffer.
' When pvarIn contains an array of bytes, it returns a pointer to a buffer with the raw
' contents, without unicode conversion.
' When pvarIn contains an array of other types, each element of the array is appended to
' the resulting string separated with a semicolon and a space.
' The returned pointer must be freed with CoTaskMemFree.
' Remarks: Requires Windows XP SP2 or superior.
' Since VariantToStringAlloc doesn't work with floats, I'm using workarounds.
' The memory block allocated by CoTaskMemAlloc may be larger than cb bytes because of the
' space required for alignment and for maintenance information. Therefore, I'm using LEFT
' to shorten it.
' Parameters:
' - pvarIn = Pointer to the variant.
' - bClear = Clear the contents of the variant (TRUE or FALSE).
' ========================================================================================
PRIVATE FUNCTION AfxVarToBuffer (BYVAL pvarIn AS VARIANT PTR, BYVAL bClear AS BOOLEAN = FALSE) AS ANY PTR

   SELECT CASE pvarIn->vt

      CASE VT_R4   ' // float
         DIM wsz AS WSTRING * 260 = WSTR(pvarIn->fltVal)
         DIM pv AS WSTRING PTR = CoTaskMemAlloc(LEN(wsz) * 2)
         IF pv THEN memcpy(pv, @wsz, LEN(wsz) * 2)
         IF LEN(*pv) > LEN(wsz) THEN *pv = LEFT(*pv, LEN(wsz)) & CHR(0)
         FUNCTION = pv

      CASE VT_ARRAY OR VT_R4   ' // array of floats - untested
         DIM AS ANY PTR pLib = DyLibLoad("propsys.dll")
         IF pLib = NULL THEN EXIT FUNCTION
         ' Prototype: FUNCTION VariantGetElementCount (BYVAL varIn AS VARIANT PTR) AS ULONG
         DIM pVariantGetElementCount AS FUNCTION (BYVAL varIn AS VARIANT PTR) AS ULONG
         pVariantGetElementCount = DyLibSymbol(pLib, "VariantGetElementCount")
         DIM cElements AS LONG
         IF pVariantGetElementCount THEN cElements = pVariantGetElementCount(pvarIn)
         IF cElements < 1 THEN EXIT FUNCTION
         IF pvarIn->parray = NULL THEN EXIT FUNCTION
         ' // Access the data directly and convert it to string
         DIM pvData AS SINGLE PTR
         DIM hr AS HRESULT = SafeArrayAccessData(pvarIn->parray, @pvData)
         IF hr <> S_OK THEN EXIT FUNCTION
         DIM i AS LONG, s AS STRING
         FOR i = 0 TO cElements - 1
            ' // The first one has not a leading space
            ' // and the last one has not a trailing ;
            IF i = 0 THEN s += STR(*pvData) & ";"
            IF i > 0 THEN s += " " & STR(*pvData)
            IF i < cElements - 1 THEN s += ";"
            pvData += 1
         NEXT
         SafeArrayUnaccessData pvarIn->parray
         DIM pbstr AS BSTR = AfxUcode(s)
         DIM cb AS DWORD = SysStringLen(pbstr)
         DIM pv AS WSTRING PTR = CoTaskMemAlloc(cb * 2)
         IF pv THEN memcpy(pv, pbstr, cb * 2)
         IF LEN(*pv) > cb THEN *pv = LEFT(*pv, cb) & CHR(0)
         SysFreeString(pbstr)
         FUNCTION = pv

      CASE VT_ARRAY OR VT_I1, VT_ARRAY OR VT_UI1   ' // array of bytes
         DIM hr AS HRESULT, cb AS ULONG
         DIM AS ANY PTR pLib = DyLibLoad("propsys.dll")
         IF pLib = NULL THEN EXIT FUNCTION
         ' Prototype: FUNCTION VariantGetElementCount (BYVAL varIn AS VARIANT PTR) AS ULONG
         DIM pVariantGetElementCount AS FUNCTION (BYVAL varIn AS VARIANT PTR) AS ULONG
         pVariantGetElementCount = DyLibSymbol(pLib, "VariantGetElementCount")
         IF pVariantGetElementCount THEN cb = pVariantGetElementCount(pvarIn)
         ' Prototype: FUNCTION VariantToBuffer (BYVAL varIn AS VARIANT PTR, BYVAL pv AS LPVOID, BYVAL cb AS DWORD) AS HRESULT
         DIM pVariantToBuffer AS FUNCTION (BYVAL varIn AS VARIANT PTR, BYVAL pv AS LPVOID, BYVAL cb AS ULONG) AS HRESULT
         pVariantToBuffer = DyLibSymbol(pLib, "VariantToBuffer")
         DIM pv AS WSTRING PTR = CoTaskMemAlloc(cb)
         IF pVariantToBuffer THEN hr = pVariantToBuffer(pvarIn, pv, cb)
         DyLibFree(pLib)
         IF hr <> S_OK THEN EXIT FUNCTION
         FUNCTION = pv

      CASE ELSE
         ' // Use VariantToStringAlloc to do the conversion
         DIM hr AS HRESULT
         DIM ppszBuf AS WSTRING PTR
         DIM AS ANY PTR pLib = DyLibLoad("propsys.dll")
         IF pLib = NULL THEN EXIT FUNCTION
         ' Prototype: FUNCTION VariantToStringAlloc (BYVAL varIn AS VARIANT PTR, BYVAL ppszBuf AS WSTRING PTR PTR) AS LONG
         DIM pVariantToStringAlloc AS FUNCTION (BYVAL pVar AS VARIANT PTR, BYVAL ppszBuf AS WSTRING PTR PTR) AS LONG
         pVariantToStringAlloc = DyLibSymbol(pLib, "VariantToStringAlloc")
         IF pVariantToStringAlloc THEN hr = pVariantToStringAlloc(pvarIn, @ppszBuf)
         DyLibFree(pLib)
         IF hr <> S_OK THEN EXIT FUNCTION
         FUNCTION = ppszBuf

   END SELECT

   ' // Clear the passed variant
   IF bClear THEN VariantClear(pVarIn)

END FUNCTION
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION AfxVarToStr OVERLOAD (BYVAL pvarIn AS VARIANT PTR, BYVAL bClear AS BOOLEAN = FALSE) AS STRING
   DIM pbuffer AS WSTRING PTR = AfxVarToBuffer(pvarIn, bClear)
   IF pbuffer THEN
      FUNCTION = STR(*pbuffer)
      CoTaskMemFree pbuffer
   END IF
END FUNCTION
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION AfxVarToBStr OVERLOAD (BYVAL pvarIn AS VARIANT PTR, BYVAL bClear AS BOOLEAN = FALSE) AS BSTR
   IF pvarIN = NULL THEN EXIT FUNCTION
   DIM pbuffer AS WSTRING PTR = AfxVarToBuffer(pvarIn, bClear)
   IF pbuffer THEN
      FUNCTION = SysAllocString(*pBuffer)
      CoTaskMemFree pbuffer
   END IF
END FUNCTION
' ========================================================================================


[José Roca]

I was having some problems allocating the memory with CoTaskMemAlloc because the allocated block may be larger than the specified number of bytes because of the space required for alignment and for maintenance information.

Therefore, I have switched to BSTR, but as the definition of BSTR in the latest FB headers is broken, I have used an alias:

Code Select Expand


#ifndef AFX_BSTR
   #define AFX_BSTR WSTRING PTR
#endif


So, instead of AS BSTR, we will have to use AS AFX_BSTR. A little inconvenience, but using AS BSTR is still more inconvenient, since we need to cast it to WSTRING PTR each time we want to get its contents (as it has been defined as WCHAR, deferencing the pointer we get the ASCII character of the first letter!).

As if it was not hard enough to work with unicode and COM at low level, I have also to deal with broken headers and broken or misisng libraries.

Code Select Expand


' ========================================================================================
' Retrieves the element count of a variant structure.
' Note: Requires Windows XP SP2 or superior.
' ========================================================================================
PRIVATE FUNCTION AfxVariantGetElementCount (BYVAL pvarIn AS VARIANT PTR) AS ULONG
   DIM AS ANY PTR pLib = DyLibLoad("propsys.dll")
   IF pLib = NULL THEN EXIT FUNCTION
   DIM pVariantGetElementCount AS FUNCTION (BYVAL varIn AS VARIANT PTR) AS ULONG
   pVariantGetElementCount = DyLibSymbol(pLib, "VariantGetElementCount")
   IF pVariantGetElementCount = NULL THEN EXIT FUNCTION
   FUNCTION = pVariantGetElementCount(pvarIn)
   DyLibFree(pLib)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Extracts the contents of a buffer stored in a VARIANT structure of type VT_ARRRAY | VT_UI1.
' Parameters:
' - pvarIn : [in] Reference to a source VARIANT structure.
' - pv     : [out] Pointer to a buffer of length cb bytes. When this function returns, contains
'            the first cb bytes of the extracted buffer value.
' - cb     : [in] The size of the pv buffer, in bytes. The buffer should be the same size as
'            the data to be extracted, or smaller.
' Return value:
' Returns one of the following values:
' - S_OK         : Data successfully extracted.
' - E_INVALIDARG : The VARIANT was not of type VT_ARRRAY | VT_UI1.
' - E_FAIL       : The VARIANT buffer value had fewer than cb bytes.
' Note: Requires Windows XP SP2 or superior.
' ========================================================================================
PRIVATE FUNCTION AfxVariantToBuffer (BYVAL pvarIn AS VARIANT PTR, BYVAL pv AS LPVOID, BYVAL cb AS ULONG) AS HRESULT
   DIM AS ANY PTR pLib = DyLibLoad("propsys.dll")
   IF pLib = NULL THEN EXIT FUNCTION
   DIM pVariantToBuffer AS FUNCTION (BYVAL pvarIn AS VARIANT PTR, BYVAL pv AS LPVOID, BYVAL cb AS ULONG) AS HRESULT
   pVariantToBuffer = DyLibSymbol(pLib, "VariantToBuffer")
   IF pVariantToBuffer = NULL THEN FUNCTION = E_FAIL
   FUNCTION = pVariantToBuffer(pvarIn, pv, cb)
   DyLibFree(pLib)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Extracts the variant value of a variant structure to a string.
' Parameters:
' - pvarIn  : [in] Reference to a source variant structure.
' - pwszBuf : [out] Pointer to the extracted property value if one exists; otherwise, empty.
' - cchBuf  : [in] Specifies string length, in characters.
' Return value:
' If this function succeeds, it returns S_OK. Otherwise, it returns an HRESULT error code.
' ========================================================================================
PRIVATE FUNCTION AfxVariantToString (BYVAL pvarIn AS VARIANT PTR, BYVAL pwszBuf AS WSTRING PTR, BYVAL cchBuf AS UINT) AS HRESULT
   DIM AS ANY PTR pLib = DyLibLoad("propsys.dll")
   IF pLib = NULL THEN EXIT FUNCTION
   DIM pVariantToString AS FUNCTION (BYVAL pVar AS VARIANT PTR, BYVAL pwszBuf AS WSTRING PTR, BYVAL cchBuf AS UINT) AS HRESULT
   pVariantToString = DyLibSymbol(pLib, "VariantToString")
   IF pVariantToString = NULL THEN FUNCTION = E_FAIL
   FUNCTION = pVariantToString(pvarIn, pwszBuf, cchBuf)
   DyLibFree(pLib)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Extracts the variant value of a variant structure to a string.
' Parameters:
' - pvarIn  : [in] Reference to a source variant structure.
' - pwszBuf : [out] Pointer to the extracted property value if one exists; otherwise, empty.
' Return value:
' If this function succeeds, it returns S_OK. Otherwise, it returns an HRESULT error code.
' ========================================================================================
PRIVATE FUNCTION AfxVariantToStringAlloc (BYVAL pvarIn AS VARIANT PTR, BYVAL ppwszBuf AS WSTRING PTR PTR) AS HRESULT
   DIM AS ANY PTR pLib = DyLibLoad("propsys.dll")
   IF pLib = NULL THEN EXIT FUNCTION
   DIM pVariantToStringAlloc AS FUNCTION (BYVAL pVar AS VARIANT PTR, BYVAL ppwszBuf AS WSTRING PTR PTR) AS HRESULT
   pVariantToStringAlloc = DyLibSymbol(pLib, "VariantToStringAlloc")
   IF pVariantToStringAlloc = NULL THEN FUNCTION = E_FAIL
   FUNCTION = pVariantToStringAlloc(pvarIn, ppwszBuf)
   DyLibFree(pLib)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Extracts the contents of a VARIANT to a newly-allocated buffer.
' When pvarIn contains an array of bytes, it returns a pointer to an ansi BSTR with the raw
' contents, without unicode conversion.
' When pvarIn contains an array of other types, each element of the array is appended to
' the resulting string separated with a semicolon and a space.
' The returned pointer must be freed with SysFreeString.
' Parameters:
' - pvarIn = Pointer to the variant.
' - bClear = Clear the contents of the variant (TRUE or FALSE).
' Return value:
' - If the function succeeds, it returns a pointer to an unicode strig on success;
'   if it fails, it returns a NULL pointer and the contents of the variant aren't cleared.
' Remarks:
'   As the function VariantToStringAlloc does not support floats, I'm using a workaround.
' ========================================================================================
PRIVATE FUNCTION AfxVarToBstr (BYVAL pvarIn AS VARIANT PTR, BYVAL bClear AS BOOLEAN = FALSE) AS AFX_BSTR

   SELECT CASE pvarIn->vt

      CASE VT_R4   ' // float
         FUNCTION = SysAllocString(WSTR(pvarIn->fltVal))

      CASE VT_ARRAY OR VT_R4   ' // array of floats - untested
         DIM cElements AS ULONG = AfxVariantGetElementCount(pvarIn)
         IF cElements < 1 THEN EXIT FUNCTION
         IF pvarIn->parray = NULL THEN EXIT FUNCTION
         ' // Access the data directly and convert it to string
         DIM pvData AS SINGLE PTR
         DIM hr AS HRESULT = SafeArrayAccessData(pvarIn->parray, @pvData)
         IF hr <> S_OK THEN EXIT FUNCTION
         DIM i AS LONG, s AS STRING
         FOR i = 0 TO cElements - 1
            ' // The first one has not a leading space
            ' // and the last one has not a trailing ;
            IF i = 0 THEN s += STR(*pvData) & ";"
            IF i > 0 THEN s += " " & STR(*pvData)
            IF i < cElements - 1 THEN s += ";"
            pvData += 1
         NEXT
         SafeArrayUnaccessData pvarIn->parray
         FUNCTION = AfxUcode(s)

      CASE VT_ARRAY OR VT_I1, VT_ARRAY OR VT_UI1   ' // array of bytes
         DIM cb AS ULONG = AfxVariantGetElementCount(pvarIn)
         DIM pbstr AS AFX_BSTR = SysAllocStringByteLen(NULL, cb)
         IF pbstr = NULL THEN EXIT FUNCTION
         DIM hr AS HRESULT = AfxVariantToBuffer(pVarIn, pbstr, cb)
         IF hr = S_OK THEN FUNCTION = pbstr

      CASE ELSE
         DIM ppwszBuf AS WSTRING PTR
         DIM hr AS HRESULT = AfxVariantToStringAlloc(pvarIn, @ppwszBuf)
         IF hr <> S_OK OR ppwszBuf = NULL THEN EXIT FUNCTION
         DIM pbstr AS AFX_BSTR = SysAllocString(*ppwszBuf)
         CoTaskMemFree ppwszBuf
         FUNCTION = pbstr

   END SELECT

   ' // Clear the passed variant
   IF bClear THEN VariantClear(pVarIn)

END FUNCTION
' ========================================================================================

' ========================================================================================
' Extracts the contents of a VARIANT to a newly-allocated buffer.
' ========================================================================================
PRIVATE FUNCTION AfxVarToStr (BYVAL pvarIn AS VARIANT PTR, BYVAL bClear AS BOOLEAN = FALSE) AS STRING
   DIM pbstr AS WSTRING PTR = AfxVarToBstr(pvarIn, bClear)
   IF pbstr THEN
      FUNCTION = STR(*pbstr)
      SysFreeString pbstr
   END IF
END FUNCTION
' ========================================================================================

' ========================================================================================
' Initializes a VARIANT structure with a string.
' ========================================================================================
PRIVATE SUB AfxVarFromStr OVERLOAD (BYVAL pvar AS VARIANT PTR, BYVAL pwsz AS WSTRING PTR)
   IF pvar = NULL THEN EXIT SUB
   VariantClear(pvar)
   V_VT(pvar) = VT_BSTR
   V_BSTR(pvar) = SysAllocString(pwsz)
END SUB
' ========================================================================================


To get the length of the returned AFX_BSTR, use SysStringLen (number of unicode characters) or SysStringByteLen (number of bytes). The FB LEN function will return the number of bytes.