CWindow release candidate 12.
Support for scrollable windows has forced me to do a few small changes.
I also have added the function AfxSaveTempFile (in AfxWin.inc) and modified some Rebar wrappers that were using REBARBANDINFO instead of REBARBANDINFOW.
I also have revised all the templates.
The framework also includes CImageCtx.inc, an image control.
Example:
' ########################################################################################
' Microsoft Windows
' File: CW_ImageCtx.fbtpl
' Contents: CWindow with an image control
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#define _WIN32_WINNT &h0602
#INCLUDE ONCE "win/shobjidl.bi"
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/CImageCtx.inc"
' $FB_RESPATH = "FBRES.rc"
USING Afx.CWindowClass
USING Afx.CImageCtxClass
CONST IDC_LOAD = 100
CONST IDC_IMAGECTX = 101
CONST IDC_RADIO_AUTOSIZE = 102
CONST IDC_RADIO_ACTUALSIZE = 103
CONST IDC_RADIO_FITTOHEIGHT = 104
CONST IDC_RADIO_FITTOWIDTH = 105
CONST IDC_RADIO_STRETCH = 106
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)
' ========================================================================================
' Displays the File Open Dialog and loads the selected file in the image control.
' ========================================================================================
SUB AfxLoadFileDialog (BYVAL hwndOwner AS HWND, BYVAL pImageCtx AS CImageCtx PTR, BYVAL sigdnName AS SIGDN = SIGDN_FILESYSPATH)
' // Create an instance of the FileOpenDialog interface
DIM hr AS LONG
DIM pofd AS IFileOpenDialog PTR
hr = CoCreateInstance(@CLSID_FileOpenDialog, NULL, CLSCTX_INPROC_SERVER, @IID_IFileOpenDialog, @pofd)
IF pofd = NULL THEN EXIT SUB
' // Set the file types
DIM rgFileTypes(1 TO 5) AS COMDLG_FILTERSPEC
rgFileTypes(1).pszName = @WSTR("JPG Files (*.jpg)")
rgFileTypes(2).pszName = @WSTR("BMP Files (*.bmp)")
rgFileTypes(3).pszName = @WSTR("PNG Files (*.png)")
rgFileTypes(4).pszName = @WSTR("TIF Files (*.tif)")
rgFileTypes(5).pszName = @WSTR("All files")
rgFileTypes(1).pszSpec = @WSTR("*.jpg")
rgFileTypes(2).pszSpec = @WSTR("*.bmp")
rgFileTypes(3).pszSpec = @WSTR("*.png")
rgFileTypes(4).pszSpec = @WSTR("*.tif")
rgFileTypes(5).pszSpec = @WSTR("*.*")
pofd->lpVtbl->SetFileTypes(pofd, 5, @rgFileTypes(1))
' // Set the title of the dialog
hr = pofd->lpVtbl->SetTitle(pofd, "A Single-Selection Dialog")
' // Display the dialog
hr = pofd->lpVtbl->Show(pofd, hwndOwner)
' // Set the default folder
DIM pFolder AS IShellItem PTR
SHCreateItemFromParsingName (CURDIR, NULL, @IID_IShellItem, @pFolder)
IF pFolder THEN
pofd->lpVtbl->SetDefaultFolder(pofd, pFolder)
pFolder->lpVtbl->Release(pFolder)
END IF
' // Get the result
DIM pItem AS IShellItem PTR
DIM pwszName AS WSTRING PTR
IF SUCCEEDED(hr) THEN
hr = pofd->lpVtbl->GetResult(pofd, @pItem)
IF SUCCEEDED(hr) THEN
hr = pItem->lpVtbl->GetDisplayName(pItem, sigdnName, @pwszName)
pImageCtx->LoadImageFromFile(*pwszName)
CoTaskMemFree(pwszName)
END IF
END IF
' // Cleanup
IF pItem THEN pItem->lpVtbl->Release(pItem)
IF pofd THEN pofd->lpVtbl->Release(pofd)
END SUB
' ========================================================================================
' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
DIM pWindow AS CWindow PTR, pImageCtx AS CImageCtx PTR
SELECT CASE uMsg
CASE WM_CREATE
EXIT FUNCTION
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
' // If ESC key pressed, close the application sending an WM_CLOSE message
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
CASE IDC_LOAD
IF HIWORD(wParam) = BN_CLICKED THEN
' // Load the picture
AfxLoadFileDialog hwnd, AfxCImageCtxPtr(hwnd, IDC_IMAGECTX)
END IF
CASE IDC_RADIO_AUTOSIZE
IF HIWORD(wParam) = BN_CLICKED THEN
AfxCImageCtxPtr(hwnd, IDC_IMAGECTX)->SetImageAdjustment GDIP_IMAGECTX_AUTOSIZE, CTRUE
' // Alternate way: Get a pointer to the CImageCtx class
' pImageCtx = CAST(CImageCtx PTR, GetWindowLongPtr(GetDlgItem(hwnd, IDC_IMAGECTX), 0))
' pImageCtx->SetImageAdjustment GDIP_IMAGECTX_AUTOSIZE, CTRUE
EXIT FUNCTION
END IF
CASE IDC_RADIO_ACTUALSIZE
IF HIWORD(wParam) = BN_CLICKED THEN
AfxCImageCtxPtr(hwnd, IDC_IMAGECTX)->SetImageAdjustment GDIP_IMAGECTX_ACTUALSIZE, CTRUE
' // Alternate way: Get a pointer to the CImageCtx class
' pImageCtx = CAST(CImageCtx PTR, GetWindowLongPtr(GetDlgItem(hwnd, IDC_IMAGECTX), 0))
' pImageCtx->SetImageAdjustment GDIP_IMAGECTX_ACTUALSIZE, CTRUE
EXIT FUNCTION
END IF
CASE IDC_RADIO_FITTOWIDTH
IF HIWORD(wParam) = BN_CLICKED THEN
AfxCImageCtxPtr(hwnd, IDC_IMAGECTX)->SetImageAdjustment GDIP_IMAGECTX_FITTOWIDTH, CTRUE
' // Alternate way: Get a pointer to the CImageCtx class
' pImageCtx = CAST(CImageCtx PTR, GetWindowLongPtr(GetDlgItem(hwnd, IDC_IMAGECTX), 0))
' pImageCtx->SetImageAdjustment GDIP_IMAGECTX_FITTOWIDTH, CTRUE
EXIT FUNCTION
END IF
CASE IDC_RADIO_FITTOHEIGHT
IF HIWORD(wParam) = BN_CLICKED THEN
AfxCImageCtxPtr(hwnd, IDC_IMAGECTX)->SetImageAdjustment GDIP_IMAGECTX_FITTOHEIGHT, CTRUE
' // Alternate way: Get a pointer to the CImageCtx class
' pImageCtx = CAST(CImageCtx PTR, GetWindowLongPtr(GetDlgItem(hwnd, IDC_IMAGECTX), 0))
' pImageCtx->SetImageAdjustment GDIP_IMAGECTX_FITTOHEIGHT, CTRUE
EXIT FUNCTION
END IF
CASE IDC_RADIO_STRETCH
IF HIWORD(wParam) = BN_CLICKED THEN
AfxCImageCtxPtr(hwnd, IDC_IMAGECTX)->SetImageAdjustment GDIP_IMAGECTX_STRETCH, CTRUE
' // Alternate way: Get a pointer to the CImageCtx class
' pImageCtx = CAST(CImageCtx PTR, GetWindowLongPtr(GetDlgItem(hwnd, IDC_IMAGECTX), 0))
' pImageCtx->SetImageAdjustment GDIP_IMAGECTX_STRETCH, CTRUE
EXIT FUNCTION
END IF
END SELECT
CASE WM_NOTIFY
DIM phdr AS NMHDR PTR
phdr = cast(NMHDR PTR, lParam)
IF wParam = IDC_IMAGECTX THEN
SELECT CASE phdr->code
CASE NM_CLICK : MessageBox hwnd, "NM_CLICK", "", MB_OK
CASE NM_DBLCLK
CASE NM_RCLICK
CASE NM_RDBLCLK
CASE NM_SETFOCUS
CASE NM_KILLFOCUS
END SELECT
END IF
CASE WM_SIZE
pWindow = AfxCWindowPtr(hwnd)
' // Alternate way:
' pWindow = CAST(CWindow PTR, GetWindowLongPtr(hwnd, 0))
' // If the window isn't minimized, resize it
IF wParam <> SIZE_MINIMIZED THEN
pWindow->MoveWindow GetDlgItem(hwnd, IDC_IMAGECTX), 10, 10, pWindow->ClientWidth - 20, pWindow->ClientHeight - 65, CTRUE
pWindow->MoveWindow GetDlgItem(hwnd, IDC_LOAD), pWindow->ClientWidth - 185, pWindow->ClientHeight - 35, 75, 23, CTRUE
pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 95, pWindow->ClientHeight - 35, 75, 23, CTRUE
pWindow->MoveWindow GetDlgItem(hwnd, IDC_RADIO_AUTOSIZE), 15, pWindow->ClientHeight - 49, 100, 21, CTRUE
pWindow->MoveWindow GetDlgItem(hwnd, IDC_RADIO_ACTUALSIZE), 15, pWindow->ClientHeight - 28, 100, 21, CTRUE
pWindow->MoveWindow GetDlgItem(hwnd, IDC_RADIO_FITTOWIDTH), 150, pWindow->ClientHeight - 49, 100, 21, CTRUE
pWindow->MoveWindow GetDlgItem(hwnd, IDC_RADIO_FITTOHEIGHT), 150, pWindow->ClientHeight - 28, 100, 21, CTRUE
pWindow->MoveWindow GetDlgItem(hwnd, IDC_RADIO_STRETCH), 275, pWindow->ClientHeight - 28, 60, 21, CTRUE
END IF
CASE WM_DESTROY
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Initialize the COM library
CoInitialize(NULL)
' // Set process DPI aware
' AfxSetProcessDPIAware
' // Create the main window
DIM pWindow AS CWindow
pWindow.Create(NULL, "CWindow with an image control", @WndProc)
pWindow.SetClientSize(600, 350)
pWindow.Center
' // Add a button without coordinates (it will be reiszed in WM_SIZE, below)
DIM hCtl AS HWND = pWindow.AddControl("RadioButton", , IDC_RADIO_AUTOSIZE, "Autosize")
SendMessageW hCtl, BM_SETCHECK, BST_CHECKED, 0
SetFocus hCtl
pWindow.AddControl("RadioButton", , IDC_RADIO_ACTUALSIZE, "Actual size")
pWindow.AddControl("RadioButton", , IDC_RADIO_FITTOWIDTH, "Fit to width")
pWindow.AddControl("RadioButton", , IDC_RADIO_FITTOHEIGHT, "Fit to height")
pWindow.AddControl("RadioButton", , IDC_RADIO_STRETCH, "Stretch")
pWindow.AddControl("Button", , IDC_LOAD, "Load")
pWindow.AddControl("Button", , IDCANCEL, "Close")
' // Add an image control
DIM pImageCtx AS CImageCtx = CImageCtx(@pWindow, IDC_IMAGECTX, , 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
' // Load an image from disk
pImageCtx.LoadImageFromFile ExePath & "\Ciutat_de_les_Arts_i_de_les_Ciencies_01.jpg"
' // Process Windows messages
FUNCTION = pWindow.DoEvents(nCmdShow)
' // Uninitialize the COM library
CoUninitialize
END FUNCTION
' ========================================================================================
The attached file includes the source code and the resources.
Looking awesome! Great stuff :)
An updated version of CBSTR with the addition of a namespace (Afx.CBStrClass) and a new cast operator.
' ========================================================================================
OPERATOR CBStr.CAST () AS ANY PTR
OPERATOR = CAST(ANY PTR, m_bstr)
END OPERATOR
' ========================================================================================
This new operator allows to pass a CBSTR type to an API function that expects a WSTRING without having to use *, e.g.
' ========================================================================================
FUNCTION AfxGetWindowTextW (BYVAL hwnd AS HWND) AS CBSTR
DIM nLen AS LONG = SendMessageW(hwnd, WM_GETTEXTLENGTH, 0, 0)
DIM cbText AS CBSTR = SPACE(nLen + 1)
nLen = SendMessageW(hwnd, WM_GETTEXT, nLen + 1, cast(LPARAM, *cbText))
FUNCTION = LEFT(**cbText, nLen)
END FUNCTION
' ========================================================================================
MessageBoxW 0, AfxGetWindowTextW(hwndMain), "", MB_OK
That is too cool and works fine eliminating several lines of code in one of my tests.
James
Cooler than you think...
You can also do things like
DIM cbs AS CBSTR
cbs = "James " & "Fuller"
DIM cbs AS CBSTR
DIM cbs2 AS CBSTR = "James "
cbs = cbs2 & "Fuller"
DIM cbs AS CBSTR
DIM cbs2 AS CBSTR = "James "
DIM cbs3 AS CBSTR = "Fuller"
cbs = cbs2 & cbs3
And FB intrinsic string functions, such LEN, MID, TRIM, etc., work with them!
Only LEFT and RIGHT need the use of **cbs because for some reason the compiler finds the calls to them ambiguous.
We have managed to create a TYPE that almost works as if it was a native type.
Will try to use SysReallocStringLen instead of freeing the old BSTR and allocating a new one. Apparently, this can improve the performance.
These operators are the ones that allow to perform these concatenations without memory leaks and without having to use **:
' ========================================================================================
' Returns a pointer to the BSTR
' ========================================================================================
OPERATOR CBStr.CAST () BYREF AS WSTRING
OPERATOR = *CAST(WSTRING PTR, m_bstr)
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR CBStr.CAST () AS ANY PTR
OPERATOR = CAST(ANY PTR, m_bstr)
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR CBStr.Let (BYREF bstrHandle AS AFX_BSTR)
OutputDebugString "LET 4"
IF bstrHandle = NULL THEN EXIT OPERATOR
' Free the current OLE string
IF m_bstr THEN SysFreeString(m_bstr)
' Detect if the passed handle is an OLE string.
' If it is an OLE string it must have a descriptor; otherwise, don't.
' Get the length in bytes looking at the descriptor and divide by 2 to get the number of
' unicode characters, that is the value returned by the FreeBASIC LEN operator.
DIM res AS DWORD = PEEK(DWORD, CAST(ANY PTR, bstrHandle) - 4) \ 2
' If the retrieved length is the same that the returned by LEN, then it must be an OLE string
IF res = .LEN(*bstrHandle) THEN
' Attach the passed handle to the class
m_bstr = bstrHandle
ELSE
' Allocate an OLE string with the contents of the string pointed by bstrHandle
m_bstr = SysAllocString(*bstrHandle)
END IF
END OPERATOR
' ========================================================================================
Three ways to set the text of a button using CBSTR and the WinFBE editor (with the charset set to Russian for WYSIWYG):
DIM cbs AS CBSTR = CBSTR("&Закрыть", 1251)
SetWindowTextW hButton, cbs
--or--
Button_SetText(hButton, cbs)
1251 is the code page for Russian.
DIM cbs AS CBSTR
cbs.CodePage = 1251
cbs = "&Закрыть"
Button_SetText(hButton, cbs)
DIM cbs AS CBSTR = 1251
cbs = "&Закрыть"
Button_SetText(hButton, cbs)
Yes, CBSTR works also with the windowsx.bi macros.
Because the new operators allow to work with the FB intrinsic operators directly, all the code below will be removed from CBSTR.inc. Will see if I can remove something else. The class is becoming very small.
' ========================================================================================
' Appends a string to the BSTR. The string can be a literal or a FB STRING or WSTRING variable.
' To append another BSTR:
' DIM bs1 AS CBStr = "1st string"
' DIM bs2 AS CBStr = "2nd string"
' bs1.Append bs2
' -or-
' bs1.Append *bs2.Handle
' -or-
' bs1.Append **bs2
' ========================================================================================
'SUB CBStr.Append (BYREF wszStr AS CONST WSTRING)
' DIM n1 AS UINT = SysStringLen(m_bstr)
' DIM nLen AS UINT = .LEN(wszStr)
' IF nLen = 0 THEN EXIT SUB
' DIM b AS AFX_BSTR = SysAllocStringLen(NULL, n1 + nLen)
' IF b = NULL THEN EXIT SUB
' memcpy(b, m_bstr, n1 * SIZEOF(WSTRING))
' memcpy(b + n1, @wszStr, nLen * SIZEOF(WSTRING))
' IF m_bstr THEN SysFreeString(m_bstr)
' m_bstr = b
'END SUB
' ========================================================================================
' ========================================================================================
' Appends a string to the BSTR. The string can be a literal or a FB STRING or WSTRING variable.
' ========================================================================================
'OPERATOR CBStr.+= (BYREF wszStr AS CONST WSTRING)
' this.Append(wszStr)
'END OPERATOR
' ========================================================================================
' ========================================================================================
' Appends a BSTR to the BSTR.
' ========================================================================================
'OPERATOR CBStr.+= (BYREF pCBStr AS CBStr)
' this.Append(*pCBStr.Handle)
'END OPERATOR
' ========================================================================================
' ========================================================================================
' Appends a string to the BSTR. The string can be a literal or a FB STRING or WSTRING variable.
' ========================================================================================
'OPERATOR CBStr.&= (BYREF wszStr AS CONST WSTRING)
' this.Append(wszStr)
'END OPERATOR
' ========================================================================================
' ========================================================================================
' Appends a BSTR to the BSTR.
' ========================================================================================
'OPERATOR CBStr.&= (BYREF pCBStr AS CBStr)
' this.Append(*pCBStr.Handle)
'END OPERATOR
' ========================================================================================
' ========================================================================================
' Returns vbTrue (-1) if the two BSTRings are equal; FALSE, otherwise.
' ========================================================================================
'OPERATOR = (BYREF pCBStr1 AS CBStr, BYREF pCBStr2 AS CBStr) AS INTEGER
' OPERATOR = StrCmpW(*pCBStr1.Handle, *pCBStr2.Handle) = 0
'END OPERATOR
' ========================================================================================
' ========================================================================================
'OPERATOR = (BYREF pCBStr AS CBStr, BYREF wszStr AS CONST WSTRING) AS INTEGER
' OPERATOR = StrCmpW(*pCBStr.Handle, wszStr) = 0
'END OPERATOR
' ========================================================================================
'OPERATOR = (BYREF wszStr AS CONST WSTRING, BYREF pCBStr AS CBStr) AS INTEGER
' OPERATOR = StrCmpW(wszStr, *pCBStr.Handle) = 0
'END OPERATOR
' ========================================================================================
' ========================================================================================
' Returns vbTrue (-1) if the two BSTRings are not equal; FALSE, otherwise.
' ========================================================================================
'OPERATOR <> (BYREF pCBStr1 AS CBStr, BYREF pCBStr2 AS CBStr) AS INTEGER
' OPERATOR = StrCmpW(*pCBStr1.Handle, *pCBStr2.Handle) <> 0
'END OPERATOR
' ========================================================================================
' ========================================================================================
'OPERATOR <> (BYREF pCBStr AS CBStr, BYREF wszStr AS CONST WSTRING) AS INTEGER
' OPERATOR = StrCmpW(*pCBStr.Handle, wszStr) <> 0
'END OPERATOR
' ========================================================================================
'OPERATOR <> (BYREF wszStr AS CONST WSTRING, BYREF pCBStr AS CBStr) AS INTEGER
' OPERATOR = StrCmpW(wszStr, *pCBStr.Handle) <> 0
'END OPERATOR
' ========================================================================================
' ========================================================================================
' Returns vbTrue (-1) if the the first BSTR is greater than the 2nd BSTR; FALSE, otherwise.
' ========================================================================================
'OPERATOR > (BYREF pCBStr1 AS CBStr, BYREF pCBStr2 AS CBStr) AS INTEGER
' OPERATOR = StrCmpW(*pCBStr1.Handle, *pCBStr2.Handle) > 0
'END OPERATOR
' ========================================================================================
' ========================================================================================
'OPERATOR > (BYREF pCBStr AS CBStr, BYREF wszStr AS CONST WSTRING) AS INTEGER
' OPERATOR = StrCmpW(*pCBStr.Handle, wszStr) > 0
'END OPERATOR
' ========================================================================================
'OPERATOR > (BYREF wszStr AS CONST WSTRING, BYREF pCBStr AS CBStr) AS INTEGER
' OPERATOR = StrCmpW(wszStr, *pCBStr.Handle) > 0
'END OPERATOR
' ========================================================================================
' ========================================================================================
' Returns vbTrue (-1) if the the first BSTR is less than the 2nd BSTR; FALSE, otherwise.
' ========================================================================================
'OPERATOR < (BYREF pCBStr1 AS CBStr, BYREF pCBStr2 AS CBStr) AS INTEGER
' OPERATOR = StrCmpW(*pCBStr1.Handle, *pCBStr2.Handle) < 0
'END OPERATOR
' ========================================================================================
' ========================================================================================
'OPERATOR < (BYREF pCBStr AS CBStr, BYREF wszStr AS CONST WSTRING) AS INTEGER
' OPERATOR = StrCmpW(*pCBStr.Handle, wszStr) < 0
'END OPERATOR
' ========================================================================================
'OPERATOR < (BYREF wszStr AS CONST WSTRING, BYREF pCBStr AS CBStr) AS INTEGER
' OPERATOR = StrCmpW(wszStr, *pCBStr.Handle) < 0
'END OPERATOR
' ========================================================================================
' ========================================================================================
' Returns vbTrue (-1) if the the first BSTR is greater or equal than the 2nd BSTR; FALSE, otherwise.
' ========================================================================================
'OPERATOR >= (BYREF pCBStr1 AS CBStr, BYREF pCBStr2 AS CBStr) AS INTEGER
' DIM nResult AS LONG
' nResult = StrCmpW(*pCBStr1.Handle, *pCBStr2.Handle)
' IF nResult > 0 OR nResult = 0 THEN OPERATOR = -1 ELSE OPERATOR = 0
'END OPERATOR
' ========================================================================================
' ========================================================================================
'OPERATOR >= (BYREF pCBStr AS CBStr, BYREF wszStr AS CONST WSTRING) AS INTEGER
' DIM nResult AS LONG
' nResult = StrCmpW(*pCBStr.Handle, wszStr)
' IF nResult > 0 OR nResult = 0 THEN OPERATOR = -1 ELSE OPERATOR = 0
'END OPERATOR
' ========================================================================================
'OPERATOR >= (BYREF wszStr AS CONST WSTRING, BYREF pCBStr AS CBStr) AS INTEGER
' DIM nResult AS LONG
' nResult = StrCmpW(wszStr, *pCBStr.Handle)
' IF nResult > 0 OR nResult = 0 THEN OPERATOR = -1 ELSE OPERATOR = 0
'END OPERATOR
' ========================================================================================
' ========================================================================================
' Returns vbTrue (-1) if the the first BSTR is less or equal than the 2nd BSTR; FALSE, otherwise.
' ========================================================================================
'OPERATOR <= (BYREF pCBStr1 AS CBStr, BYREF pCBStr2 AS CBStr) AS INTEGER
' DIM nResult AS LONG
' nResult = StrCmpW(*pCBStr1.Handle, *pCBStr2.Handle)
' IF nResult < 0 OR nResult = 0 THEN OPERATOR = -1 ELSE OPERATOR = 0
'END OPERATOR
' ========================================================================================
' ========================================================================================
'OPERATOR <= (BYREF pCBStr AS CBStr, BYREF wszStr AS CONST WSTRING) AS INTEGER
' DIM nResult AS LONG
' nResult = StrCmpW(*pCBStr.Handle, wszStr)
' IF nResult < 0 OR nResult = 0 THEN OPERATOR = -1 ELSE OPERATOR = 0
'END OPERATOR
' ========================================================================================
'OPERATOR <= (BYREF wszStr AS CONST WSTRING, BYREF pCBStr AS CBStr) AS INTEGER
' DIM nResult AS LONG
' nResult = StrCmpW(wszStr, *pCBStr.Handle)
' IF nResult < 0 OR nResult = 0 THEN OPERATOR = -1 ELSE OPERATOR = 0
'END OPERATOR
' ========================================================================================
This constructor
CONSTRUCTOR CBStr (BYREF cbs AS CBStr)
m_bstr = SysAllocString(*pCBStr.Handle)
END CONSTRUCTOR
will become
CONSTRUCTOR CBStr (BYREF cbs AS CBStr)
m_bstr = SysAllocString(cbs)
END CONSTRUCTOR
It is incredibly the power of the two cast operators. Almost all of the FreeBASIC operators that work with strings can be used with CBSTR as if it was a native type, with the following exceptions:
LEN
The length of a BSTR is a DWORD value that prefixes the string data. FB has no idea of what a BSTR descriptor is, therefore can't retrieve that prefix lenght. However, I have overloaded this operator, so you can use LEN with CBSTRs and the overloaded operator will call SysStringLen(cbs), returning the correct lenght.
LEFT and RIGHT
For some unknown reason (maybe a quirk of the compiler's parser) FB finds the call to these functions ambiguous. Therefore, we have to use LEFT(**cbs, x) and RIGHT (**cbs, x). Notice the double indirection.
STRPTR
Because FB doesn't know anything about the BSTR descriptor, we need to use the overloaded operator *.
- One * returns the value of the BSTR pointer.
- Two ** returns the address of the start of the string data.
Note: VARPTR and @ work as expected.
A very good thing of working as if it was a native data type is that the users don't need to learn much to use it. Only to be aware of the LEFT, RIGHT and STRPTR exceptions.
We have managed to implement a new data type with this little code:
' ########################################################################################
' Microsoft Windows
' File: CBStr.inc
' Contents: Windows wrapper functions.
' Compiler: Free Basic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#pragma once
#include once "windows.bi"
#ifndef AFX_BSTR
#define AFX_BSTR WSTRING PTR
#endif
NAMESPACE Afx.CBStrClass
' ========================================================================================
' CBStr - OLE strings class
' ========================================================================================
TYPE CBStr
Public:
m_bstr AS AFX_BSTR
m_CodePage AS LONG
Public:
DECLARE CONSTRUCTOR
DECLARE CONSTRUCTOR (BYVAL nCopePage AS LONG)
DECLARE CONSTRUCTOR (BYREF wszStr AS CONST WSTRING = "")
DECLARE CONSTRUCTOR (BYREF ansiStr AS STRING = "", BYVAL nCodePage AS LONG = 0)
DECLARE CONSTRUCTOR (BYREF cbs AS CBStr)
DECLARE CONSTRUCTOR (BYREF bstrHandle AS AFX_BSTR = NULL)
DECLARE DESTRUCTOR
DECLARE OPERATOR Let (BYREF ansiStr AS STRING)
DECLARE OPERATOR Let (BYREF wszStr AS CONST WSTRING)
DECLARE OPERATOR Let (BYREF cbs AS CBStr)
DECLARE OPERATOR Let (BYREF bstrHandle AS AFX_BSTR)
DECLARE OPERATOR CAST () BYREF AS WSTRING
DECLARE OPERATOR CAST () AS ANY PTR
DECLARE PROPERTY CodePage () AS LONG
DECLARE PROPERTY CodePage (BYVAL nCodePage AS LONG)
END TYPE
' ========================================================================================
' ========================================================================================
' CBStr class constructors
' ========================================================================================
CONSTRUCTOR CBStr
m_bstr = SysAllocString("")
END CONSTRUCTOR
' ========================================================================================
CONSTRUCTOR CBStr (BYVAL nCodePage AS LONG)
m_CodePage = nCodePage
END CONSTRUCTOR
' ========================================================================================
CONSTRUCTOR CBStr (BYREF wszStr AS CONST WSTRING = "")
m_bstr = SysAllocString(wszStr)
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
CONSTRUCTOR CBStr (BYREF ansiStr AS STRING = "", BYVAL nCodePage AS LONG = 0)
m_bstr = SysAllocString(WSTR(ansiStr))
IF nCodePage <> 0 THEN
MultiByteToWideChar(nCodePage, MB_PRECOMPOSED, STRPTR(ansiStr), -1, m_bstr, LEN(ansiStr) * 2)
ELSEIF m_CodePage <> 0 THEN
MultiByteToWideChar(m_CodePage, MB_PRECOMPOSED, STRPTR(ansiStr), -1, m_bstr, LEN(ansiStr) * 2)
END IF
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
CONSTRUCTOR CBStr (BYREF cbs AS CBStr)
m_bstr = SysAllocString(cbs)
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
CONSTRUCTOR CBStr (BYREF bstrHandle AS AFX_BSTR = NULL)
IF bstrHandle = NULL THEN
m_bstr = SysAllocString("")
ELSE
' Detect if the passed handle is an OLE string
' If it is an OLE string it must have a descriptor; otherwise, don't
' Get the length looking at the descriptor
DIM res AS INTEGER = PEEK(DWORD, CAST(ANY PTR, bstrHandle) - 4) \ 2
' If the retrieved length if the same that the returned by LEN, then it must be an OLE string
IF res = .LEN(*bstrHandle) THEN
' Attach the passed handle to the class
m_bstr = bstrHandle
ELSE
' Allocate an OLE string with the contents of the string pointer by bstrHandle
m_bstr = SysAllocString(*bstrHandle)
END IF
END IF
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
' CBStr class destructor
' ========================================================================================
DESTRUCTOR CBStr
IF m_bstr THEN SysFreeString m_bstr
END DESTRUCTOR
' ========================================================================================
' ========================================================================================
' Assigns new text to the BSTR
' ========================================================================================
OPERATOR CBStr.Let (BYREF wszStr AS CONST WSTRING)
IF m_bstr THEN SysFreeString(m_bstr)
m_bstr = SysAllocString(wszStr)
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR CBStr.Let (BYREF ansiStr AS STRING)
IF m_bstr THEN SysFreeString(m_bstr)
m_bstr = SysAllocString(WSTR(ansiStr))
IF m_CodePage <> 0 THEN MultiByteToWideChar(m_CodePage, MB_PRECOMPOSED, STRPTR(ansiStr), -1, m_bstr, LEN(ansiStr) * 2)
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR CBStr.Let (BYREF cbs AS CBStr)
IF m_bstr THEN SysFreeString(m_bstr)
m_bstr = SysAllocString(cbs)
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR CBStr.Let (BYREF bstrHandle AS AFX_BSTR)
IF bstrHandle = NULL THEN EXIT OPERATOR
' Free the current OLE string
IF m_bstr THEN SysFreeString(m_bstr)
' Detect if the passed handle is an OLE string.
' If it is an OLE string it must have a descriptor; otherwise, don't.
' Get the length in bytes looking at the descriptor and divide by 2 to get the number of
' unicode characters, that is the value returned by the FreeBASIC LEN operator.
DIM res AS DWORD = PEEK(DWORD, CAST(ANY PTR, bstrHandle) - 4) \ 2
' If the retrieved length is the same that the returned by LEN, then it must be an OLE string
IF res = .LEN(*bstrHandle) THEN
' Attach the passed handle to the class
m_bstr = bstrHandle
ELSE
' Allocate an OLE string with the contents of the string pointed by bstrHandle
m_bstr = SysAllocString(*bstrHandle)
END IF
END OPERATOR
' ========================================================================================
' ========================================================================================
' One * returns the value of the BSTR pointer.
' Two ** returns the adress of the start of the string data.
' Needed because LEFT and RIGHT (cbs) fail with an ambiguous call error.
' We have to use **cbs (notice the double indirection) with these functions.
' ========================================================================================
OPERATOR * (BYREF cbs AS CBStr) AS AFX_BSTR
OPERATOR = cbs.m_bstr
END OPERATOR
' ========================================================================================
' ========================================================================================
' Returns a pointer to the BSTR
' ========================================================================================
OPERATOR CBStr.CAST () BYREF AS WSTRING
OPERATOR = *CAST(WSTRING PTR, m_bstr)
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR CBStr.CAST () AS ANY PTR
OPERATOR = CAST(ANY PTR, m_bstr)
END OPERATOR
' ========================================================================================
' ========================================================================================
' Returns the length of the BSTR in characters.
' Needed because FB's LEN operator does not work with BSTRs.
' ========================================================================================
OPERATOR Len (BYREF cbs AS CBStr) AS INTEGER
OPERATOR = SysStringLen(cbs)
END OPERATOR
' ========================================================================================
' ========================================================================================
' Gets/sets the code page used to ansi to unicode translations
' ========================================================================================
PROPERTY CBStr.CodePage () AS LONG
PROPERTY = m_CodePage
END PROPERTY
' ========================================================================================
' ========================================================================================
PROPERTY CBStr.CodePage (BYVAL nCodePage AS LONG)
m_CodePage = nCodePage
END PROPERTY
' ========================================================================================
END NAMESPACE
We can freely mix CBSTRs, STRINGs, WSTRINGs and literals, e.g.
DIM cbs AS CBSTR = "This is a"
DIM s AS STRING = " test "
DIM wsz AS WSTRING * 7 = "string"
DIM cbs2 AS CBSTR = cbs & s & wsz
MessageBoxW 0, cbs2, "", MB_OK
Works also with the wrapper function AfxMsg, so instead of MessageBoxW, you can also use:
AfxMsg cbs2
or if you are working with the console
PRINT cbs2
Jose,
I wrapped your IFileOpenDialog so it would return a Fb string. It worked fine.
I decided to do the same but with the new CBStr. Everything worked more than fine :) ??
At lines 72 & 73 of Dlg2CWin2.BAS I call Paul's FF_Parse with CBStr variables sFileTypes and sFileSpecs.
The Function expects a Fb String??? Is the compiler doing the conversion or the CBStr class?
DLG2SRC.RC and DLG2SRC2.RC are just files to be parsed by the app
compile Dlg2CWin2.bas as a console app.
James
> The Function expects a Fb String??? Is the compiler doing the conversion or the CBStr class?
The compiler does the conversions. The class gives him the pointer to the string data.