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
pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 250, 140, 75, 23)
you can also use
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.
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)
Regarding the problem of the "A" and "W" functions, I'm thinking to have an unicode version only and return a variant.
For example:
' ========================================================================================
' 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
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
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...
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.
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.
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).
' ========================================================================================
' 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
' ========================================================================================
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:
#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.
' ========================================================================================
' 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.