PlanetSquires Forums

Support Forums => WinFBX - Windows Framework for FreeBASIC => Topic started by: José Roca on May 08, 2016, 02:21:23 AM

Title: CWindow RC06
Post by: José Roca on May 08, 2016, 02:21:23 AM
The attached file containst CWindow.inc and the other classes, controls and wrapper procedures that I have been posting.

Does not include the BSTR class because with changes to the headers they have completely broken it. They have changed the definition from WSTRING to WCHAR_T and now I have to figure how to deal with that...

Sorry, I have forgot to change the number from 5 to 6 in CWindow. inc.
Title: Re: CWindow RC06
Post by: José Roca on May 08, 2016, 02:56:09 AM
Hi Paul,

If you want to report a bug to dkl....

He has changed

Code: [Select]
type WCHAR as wstring
type PWCHAR as wstring ptr
type LPWCH as wstring ptr
type PWCH as wstring ptr
type LPCWCH as const wstring ptr
type PCWCH as const wstring ptr

to

Code: [Select]
type WCHAR as wchar_t
type PWCHAR as WCHAR ptr
type LPWCH as WCHAR ptr
type PWCH as WCHAR ptr
type LPCWCH as const WCHAR ptr
type PCWCH as const WCHAR ptr

both in stddef.bi and winnt.bi.

As a result, if you use this test code

Code: [Select]
DIM pbstr AS BSTR
pbstr = SysAllocString("This is a test")
print *pbstr
SysFreeString(pbstr)

print "press esc"
sleep

It prints 84, that is the ASC code of the first character.

If I #undef BSTR and define it as WSTRING PTR, it works:

Code: [Select]
#undef BSTR
TYPE BSTR AS WSTRING PTR

DIM pbstr AS BSTR
pbstr = SysAllocString("This is a test")
print *pbstr
SysFreeString(pbstr)
Title: Re: CWindow RC06 - Visual Style Menus
Post by: José Roca on May 09, 2016, 04:12:47 AM
Code: [Select]
' ########################################################################################
'                              *** VISUAL STYLE MENUS ***
' ########################################################################################

' Windows Vista and porterior Windows versions provide menus that are part of the visual
' schema. These menus are rendered using visual styles, which can be added to existing
' applications. Adding code for new features to existing code must be done carefully to
' avoid breaking existing application behavior. Certain situations can cause visual styling
' to be disabled in an application. These situations include:
'    - Customizing menus using owner-draw menu items (MFT_OWNERDRAW)
'    - Using menu breaks (MFT_MENUBREAK or MFT_MENUBARBREAK)
'    - Using HBMMENU_CALLBACK to defer bitmap rendering
'    - Using a destroyed menu handle
' These situations prevent visual style menus from being rendered. Owner-draw menus can be
' used in Windows Vista and posterior Windows versions, but the menus will not be visually
' styled.
' Windows Vista and posterior Windows versions provide alpha-blended bitmaps, which enables
' menu items to be shown without using owner-draw menu items.
' Requirements:
'    - The bitmap is a 32bpp DIB section.
'    - The DIB section has BI_RGB compression.
'    - The bitmap contains pre-multiplied alpha pixels.
'    - The bitmap is stored in hbmpChecked, hbmpUnchecked, or hbmpItem fields.
' Note: MFT_BITMAP items do not support PARGB32 bitmaps.
' The following functions use the the Graphics Device Interface (GDI) to convert icons to
' bitmaps. Another solution is to use the Windows Imaging Component (WIC).
' Usage example:
'    DIM hSubMenu AS HMENU = GetSubMenu(hMenu, 1)
'    DIM hIcon AS HICON
'    hIcon = LoadImage(NULL, "MyIcon.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE)
'    IF hIcon THEN AfxAddIconToMenuItem(hSubMenu, 0, TRUE, hIcon)
' PNG icons can be used by converting them to an icon with AfxGdipImageFromFileEx:
'    hIcon = AfxGdipImageFromFileEx("MyIcon.png")
'    IF hIcon THEN AfxAddIconToMenuItem(hSubMenu, 0, TRUE, hIcon)

For more information, see: https://msdn.microsoft.com/en-us/library/bb757020.aspx?s=6

I have adapted the Microsoft code posted in the above link and incorporated it to AfxMenu.inc, attached to this post.
Title: Re: CWindow RC06 - Visual Style Menu Example
Post by: José Roca on May 09, 2016, 04:16:12 AM
Virtual Style Menu example:

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_Menu.fbtpl
' Contents: CWindow with a menu
' 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 "windows.bi"
#INCLUDE ONCE "win/uxtheme.bi"
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxMenu.inc"
#INCLUDE ONCE "Afx/AfxGdiplus.inc"
' $FB_RESPATH = "FBRES.rc"

USING Afx.CWindowClass

' // Menu identifiers
#define IDM_NEW      1001   ' New file
#define IDM_OPEN     1002   ' Open file...
#define IDM_SAVE     1003   ' Save file
#define IDM_SAVEAS   1004   ' Save file as...
#define IDM_EXIT     1005   ' Exit

#define IDM_UNDO     2001   ' Undo
#define IDM_CUT      2002   ' Cut
#define IDM_COPY     2003   ' Copy
#define IDM_PASTE    2004   ' Paste

#define IDM_TILEH    3001   ' Tile hosizontal
#define IDM_TILEV    3002   ' Tile vertical
#define IDM_CASCADE  3003   ' Cascade
#define IDM_ARRANGE  3004   ' Arrange icons
#define IDM_CLOSE    3005   ' Close
#define IDM_CLOSEALL 3006   ' Close all

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)

' ========================================================================================
' Build the menu
' ========================================================================================
FUNCTION BuildMenu () AS HMENU

   DIM hMenu AS HMENU
   DIM hPopUpMenu AS HMENU

   hMenu = CreateMenu
   hPopUpMenu = CreatePopUpMenu
      AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hPopUpMenu), "&File"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_NEW, "&New" & CHR(9) & "Ctrl+N"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_OPEN, "&Open..." & CHR(9) & "Ctrl+O"
         AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVE, "&Save" & CHR(9) & "Ctrl+S"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_SAVEAS, "Save &As..."
         AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_EXIT, "E&xit" & CHR(9) & "Alt+F4"
   hPopUpMenu = CreatePopUpMenu
      AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hPopUpMenu), "&Edit"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_UNDO, "&Undo" & CHR(9) & "Ctrl+Z"
         AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_CUT, "Cu&t" & CHR(9) & "Ctrl+X"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_COPY, "&Copy" & CHR(9) & "Ctrl+C"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_PASTE, "&Paste" & CHR(9) & "Ctrl+V"
   hPopUpMenu = CreatePopUpMenu
      AppendMenuW hMenu, MF_POPUP OR MF_ENABLED, CAST(UINT_PTR, hPopUpMenu), "&Window"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_TILEH, "&Tile Horizontal"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_TILEV, "Tile &Vertical"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_CASCADE, "Ca&scade"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_ARRANGE, "&Arrange &Icons"
         AppendMenuW hPopUpMenu, MF_SEPARATOR, 0, ""
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_CLOSE, "&Close" & CHR(9) & "Ctrl+F4"
         AppendMenuW hPopUpMenu, MF_ENABLED, IDM_CLOSEALL, "Close &All"
   FUNCTION = hMenu

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

' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   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 IDM_NEW   ' IDM_OPEN, IDM_SAVE, etc.
               MessageBox hwnd, "New option clicked", "Menu", MB_OK
               EXIT FUNCTION
         END SELECT

    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

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   DIM pWindow AS CWindow
   pWindow.Create(NULL, "CWindow with a menu", @WndProc)
   pWindow.SetClientSize(400, 250)
   pWindow.Center

   ' // Add a button
   pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close", 280, 180, 75, 23)

   ' // Create the menu
   DIM hMenu AS HMENU = BuildMenu
   SetMenu pWindow.hWindow, hMenu

DIM hSubMenu AS HMENU = GetSubMenu(hMenu, 1)
DIM hIcon AS HICON = LoadImage(NULL, ExePath & "\undo_32.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE)
IF hIcon THEN AfxAddIconToMenuItem(hSubMenu, 0, TRUE, hIcon)
hIcon = LoadImage(NULL, ExePath & "\cut_clipboard_32.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE)
IF hIcon THEN AfxAddIconToMenuItem(hSubMenu, 2, TRUE, hIcon)
hIcon = LoadImage(NULL, ExePath & "\copy_clipboard_lined_32.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE)
IF hIcon THEN AfxAddIconToMenuItem(hSubMenu, 3, TRUE, hIcon)
hIcon = LoadImage(NULL, ExePath & "\paste_clipboard_lined_32.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE)
IF hIcon THEN AfxAddIconToMenuItem(hSubMenu, 4, TRUE, hIcon)
'hIcon = AfxGdipImageFromFileEx(ExePath & "\arrow_left_32.png")
'IF hIcon THEN AfxAddIconToMenuItem(hSubMenu, 0, TRUE, hIcon)

   FUNCTION = pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================
Title: Re: CWindow RC06
Post by: José Roca on May 09, 2016, 04:21:20 AM
Alpha-blended icons in visually styled menus as easy as:

Code: [Select]
DIM hSubMenu AS HMENU = GetSubMenu(hMenu, 1)
DIM hIcon AS HICON = LoadImage(NULL, ExePath & "\undo_32.ico", IMAGE_ICON, 32, 32, LR_LOADFROMFILE)
IF hIcon THEN AfxAddIconToMenuItem(hSubMenu, 0, TRUE, hIcon)

Who can give more?

@Hi Paul,

You can finally made nice toolbars and menus for FireFly and the new editor.
Title: Re: CWindow RC06
Post by: Paul Squires on May 09, 2016, 03:12:18 PM
Awesome! I will be looking at this code closely tonight.
Title: Re: CWindow RC06
Post by: Andrew Lindsay on May 09, 2016, 07:49:49 PM
Paul,


Is the ultimate goal of this to have FireFlyFB use Jose's Window Class and wrappers?  I, like you, find hand coding interfaces a real pain, but I have found Jose's assistants and examples an absolute godsend on more than one occasion.


Regards


Andrew
Title: Re: CWindow RC06
Post by: José Roca on May 09, 2016, 08:44:50 PM
Times have changed. The old technique of creating bitmap strips with pink background is obsolete. Now it is time of using alpha-blended icons or png icons, although apparently Windows 10 users are using flat icons, many of them in black and white!

The old technique of calling the API function SetMenuItemBitmaps always has given horrible results. Making the menu ownerdraw and doing the drawing by yourself still works, but it is hard to code and you lose visual styling, unless you complicate still more it and do the drawing using the themed procedures declared in extheme.bi.

Applications that are not DPI aware are scaled by Windows virtualizing them and rendering an stretched bitmap, making everything to look fuzzy. The funny alternative suggested by some is to use always 96 DPI and buy a magnifier :) All the code that DDTers are writing is not DPI aware and looks horrible in my system. Also drag and drop does not work correctly between a DPI aware application and a virtualized one.

2/3 or more of the world poblation needs unicode aware controls because for some odd reason they don't speak English :)

CWindow works with FB 32 & 64 bit compilers without any change in the code and is unicode aware.

I stopped working with FB during several months because, silly me, didn't know that declaring the functions as PRIVATE the unused ones aren't included in the application. This is a partial implementation of dead code removal.


Title: Re: CWindow RC06
Post by: Paul Squires on May 09, 2016, 09:08:05 PM
Paul,


Is the ultimate goal of this to have FireFlyFB use Jose's Window Class and wrappers?  I, like you, find hand coding interfaces a real pain, but I have found Jose's assistants and examples an absolute godsend on more than one occasion.


Regards


Andrew

I am not 100% sure what the end goal is. I would like to build a good visual designer using Jose's classes and helper functions. It is a lot of work because the existing FireFlyFB can not simply be used (it is written in PB and is not unicode aware). I would want everything to be open source so others could scrutinize the code and help if they can.

The biggest issue is the amount of work involved. I do not program nearly as much as I used to. I still want to finish the grid control I am working on (all the color messages are done).


Title: Re: CWindow RC06
Post by: Paul Squires on May 09, 2016, 09:09:24 PM
I do find that when Jose gets excited and starts programming again that it reignites the passion inside me to program as well.

Title: Re: CWindow RC06
Post by: José Roca on May 10, 2016, 04:10:46 AM
Because they have broken BSTR support by changing the definition from WSTRING to WCHAR (WCHAR can only contain a 16 bit character) I can't do much COM programming testing. Meanwhile, I will write some supporting wrappers.

This overloaded function allows to create instances of an object in several ways. Later I will add another allowing to create instances of unregistered OCXs, licensed or not.

Code: [Select]
' ========================================================================================
' Creates a single uninitialized object of the class associated with a specified ProgID or CLSID.
' Parameter:
' - wszProgID = A ProgID or a CLSID in string format.
' Return value:
'   The interface pointer or NULL.
' Usage examples:
'   DIM pDic AS IDictionary PTR
'   pDic = AfxNewCom("Scripting.Dictionary")
' -or-
'   pDic = AfxNewCom(CLSID_Dictionary)
' where CLSID_Dictionary has been declared as
' CONST CLSID_Dictionary = "{EE09B103-97E0-11CF-978F-00A02463E06F}"
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION AfxNewCom OVERLOAD (BYREF wszProgID AS CONST WSTRING) AS ANY PTR
   DIM classID AS CLSID, pUnk AS ANY PTR
   IF VARPTR(wszProgID) = NULL THEN EXIT FUNCTION
   IF INSTR(wszProgID, "{") THEN CLSIDFromString(wszProgID, @classID) ELSE CLSIDFromProgID(wszProgID, @classID)
   CoCreateInstance(@classID, NULL, CLSCTX_INPROC_SERVER, @IID_IUnknown, @pUnk)
   FUNCTION = pUnk
END FUNCTION
' ========================================================================================

' ========================================================================================
' Creates a single uninitialized object of the class associated with a specified ProgID or CLSID.
' Parameters:
' - wszProgID = A CLSID in string format.
' - riid = A reference to the identifier of the interface to be used to communicate with the object.
' Return value:
'   The interface pointer or NULL.
' Usage examples:
'   pDic = AfxNewCom(CLSID_Dictionary, IID_IDictionary)
'   pDic = AfxNewCom(CLSID_Dictionary, IID_IDictionary)
' where CLSID_Dictionary has been declared as
'   CONST CLSID_Dictionary = "{EE09B103-97E0-11CF-978F-00A02463E06F}"
' and IID_IDictionary as
'   CONST IID_IDictionary = "{42C642C1-97E1-11CF-978F-00A02463E06F}"
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION AfxNewCom OVERLOAD (BYREF wszClsID AS CONST WSTRING, BYREF wszIID AS CONST WSTRING) AS ANY PTR
   DIM classID AS CLSID, riid AS IID, pUnk AS ANY PTR
   IF VARPTR(wszClsID) = NULL OR VARPTR(wszIID) = NULL THEN EXIT FUNCTION
   CLSIDFromProgID(wszClsID, @classID)
   CLSIDFromProgID(wszIID, @riid)
   CoCreateInstance(@classID, NULL, CLSCTX_INPROC_SERVER, @riid, @pUnk)
   FUNCTION = pUnk
END FUNCTION
' ========================================================================================

' ========================================================================================
' Creates a single uninitialized object of the class associated with a specified CLSID.
' Parameter:
' - classID = The CLSID (class identifier) associated with the data and code that will be
'   used to create the object.
' Return value:
'   The interface pointer or NULL.
' Usage examples:
'   DIM pDic AS IDictionary PTR
'   pDic = AfxNewCom(CLSID_Dictionary)
' where CLSID_Dictionary has been declared as
'   DIM CLSID_Dictionary AS CLSID = (&hEE09B103, &h97E0, &h11CF, {&h97, &h8F, &h00, &hA0, &h24, &h63, &hE0, &h6F})
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION AfxNewCom OVERLOAD (BYREF classID AS CONST CLSID) AS ANY PTR
   DIM pUnk AS ANY PTR
   IF VARPTR(classID) = NULL THEN EXIT FUNCTION
   CoCreateInstance(@classID, NULL, CLSCTX_INPROC_SERVER, @IID_IUnknown, @pUnk)
   FUNCTION = pUnk
END FUNCTION
' ========================================================================================

' ========================================================================================
' Creates a single uninitialized object of the class associated with the specified CLSID and IID.
' Parameters:
' - classID = The CLSID (class identifier) associated with the data and code that will be
'   used to create the object.
' - riid = A reference to the identifier of the interface to be used to communicate with the object.
' Return value:
'   The interface pointer or NULL.
' Usage examples:
'   DIM pDic AS IDictionary PTR
'   pDic = IDictionary PTR, AfxNewCom(CLSID_Dictionary, IID_IDictionary)
' where CLSID_Dictionary has been declared as
'   DIM CLSID_Dictionary AS CLSID = (&hEE09B103, &h97E0, &h11CF, {&h97, &h8F, &h00, &hA0, &h24, &h63, &hE0, &h6F})
' and IID_IDictionary as
'   DIM IID_IDictionary AS IID = (&h42C642C1, &h97E1, &h11CF, {&h97, &h8F, &h00, &hA0, &h24, &h63, &hE0, &h6F})
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION AfxNewCom OVERLOAD (BYREF classID AS CONST CLSID, BYREF riid AS CONST IID) AS ANY PTR
   DIM pUnk AS ANY PTR
   IF VARPTR(classID) = NULL OR VARPTR(riid) = NULL THEN EXIT FUNCTION
   CoCreateInstance(@classID, NULL, CLSCTX_INPROC_SERVER, @riid, @pUnk)
   FUNCTION = pUnk
END FUNCTION
' ========================================================================================
Title: Re: CWindow RC06
Post by: José Roca on May 10, 2016, 08:01:52 AM
The following function allows to use unregistered OCXs, licensed or not. The old VB6 OCXs can only be used with the 32-bit compiler, since there are not 64-bit versions of them.

Code: [Select]
' ========================================================================================
' Loads the specified library and creates an instance of an object.
' If it succeeds, returns a reference to the requested interface; otherwise, it returns null.
' Not every component is a suitable candidate for use under this overloaded AfxNewCom function.
'  - Only in-process servers (DLLs) are supported.
'  - Components that are system components or part of the operating system, such as XML,
'    Data Access, Internet Explorer, or DirectX, aren't supported
'  - Components that are part of an application, such Microsoft Office, aren't supported.
'  - Components intended for use as an add-in or a snap-in, such as an Office add-in or
'    a control in a Web browser, aren't supported.
'  - Components that manage a shared physical or virtual system resource aren't supported.
'  - Visual ActiveX controls aren't supported because they need to be initilized and
'    activated by the OLE container.
' Note: Do not use DyLibFree to unload the library once you have got a valid reference
' to an interface or your application will GPF. Before calling DyLibFree, all the
' interface references must be released. If you don't need to unload the library until
' the application ends, then you don't need to call FreeLibrary because CoUninitialize
' closes the COM library on the current thread, unloads all DLLs loaded by the thread,
' frees any other resources that the thread maintains, and forces all RPC connections on
' the thread to close.
' ========================================================================================
PRIVATE FUNCTION AfxNewCom OVERLOAD (BYREF wszLibName AS CONST WSTRING, BYREF rclsid AS CONST CLSID, BYREF riid AS CONST IID, BYREF wszLicKey AS WSTRING) AS ANY PTR

   DIM hr AS LONG, hLib AS HANDLE, pUnk AS IUnknown PTR
   DIM pIClassFactory AS IClassFactory PTR, pIClassFactory2 AS IClassFactory2 PTR

   ' // See if the library is already loaded in the address space
   hLib = GetModuleHandleW(wszLibName)
   ' // If it is not loaded, load it
   IF hLib = NULL THEN hLib = DyLibLoad(wszLibName)
   ' // If it fails, abort
   IF hLib = NULL THEN EXIT FUNCTION

   ' // Retrieve the address of the exported function DllGetClassObject
   DIM pfnDllGetClassObject AS FUNCTION (BYVAL rclsid AS CONST IID CONST PTR, BYVAL riid AS CONST IID CONST PTR, BYVAL ppv AS LPVOID PTR) AS HRESULT
   pfnDllGetClassObject = DyLibSymbol(hLib, "DllGetClassObject")
   IF pfnDllGetClassObject = NULL THEN EXIT FUNCTION

   IF LEN(wszLicKey) = 0 THEN
      ' // Request a reference to the IClassFactory interface
      hr = pfnDllGetClassObject(@rclsid, @IID_IClassFactory, @pIClassFactory)
      IF hr <> S_OK THEN EXIT FUNCTION
      ' // Create an instance of the server or control
      hr = pIClassFactory->lpVtbl->CreateInstance(pIClassFactory, NULL, @riid, @pUnk)
      IF hr <> S_OK THEN
         pIClassFactory->lpVtbl->Release(pIClassFactory)
         EXIT FUNCTION
      END IF
   ELSE
      ' // Request a reference to the IClassFactory2 interface
      hr = pfnDllGetClassObject(@rclsid, @IID_IClassFactory, @pIClassFactory2)
      IF hr <> S_OK THEN EXIT FUNCTION
      ' // Create a licensed instance of the server or control
      hr = pIClassFactory2->lpVtbl->CreateInstanceLic(pIClassFactory2, NULL, NULL, @riid, @wszLicKey, @pUnk)
      IF hr <> S_OK THEN
         pIClassFactory2->lpVtbl->Release(pIClassFactory2)
         EXIT FUNCTION
      END IF
   END IF

   IF pIClassFactory THEN pIClassFactory->lpVtbl->Release(pIClassFactory)
   IF pIClassFactory2 THEN pIClassFactory2->lpVtbl->Release(pIClassFactory2)
   FUNCTION = pUnk

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

' ========================================================================================
' Converts the wszClsid and wszIid parameters to GUIDs and calls the function above.
' ========================================================================================
PRIVATE FUNCTION AfxNewCom OVERLOAD (BYREF wszLibName AS CONST WSTRING, BYREF wszClsid AS CONST WSTRING, BYREF wszIid AS CONST WSTRING, BYREF wszLicKey AS WSTRING = "") AS ANY PTR
   DIM rclsid AS CLSID, riid AS IID
   rclsid = AfxGuid(wszClsid)
   riid = AfxGuid(wszIid)
   FUNCTION = AfxNewCom(wszLibName, rclsid, riid, wszLicKey)
END FUNCTION
' ========================================================================================
Title: Re: CWindow RC06
Post by: José Roca on May 10, 2016, 08:54:51 AM
Another bug. The library for the RPCRT4.DLL seems broken. If I try to use the function UuidCreate, the linker fails.

I have needed to call it dynamically:

Code: [Select]
DIM g AS GUID
DIM AS ANY PTR pLib = DyLibLoad("RPCRT4.DLL")
IF pLib  THEN
   DIM pProc AS FUNCTION (byval Uuid as UUID ptr) as RPC_STATUS
   pProc = DyLibSymbol(pLib, "UuidCreate")
   IF pProc THEN pProc(@g)
   DyLibFree(pLib)
END IF
Title: Re: CWindow RC06
Post by: José Roca on May 10, 2016, 09:10:33 AM
Two new functions, equivalent to PB's GUID$ and GUIDTXT$.

Code: [Select]
' ========================================================================================
' Converts a string into a 16-byte (128-bit) Globally Unique Identifier (GUID)
' To be valid, the string must contain exactly 32 hexadecimal digits, delimited by hyphens
' and enclosed by curly braces. For example: {B09DE715-87C1-11D1-8BE3-0000F8754DA1}
' If pwszGuidText is omited, AfxGuid generates a new unique guid.
' Remarks: I have need to call the UuidCreate function dynamically because, at the time of
' writing, the library for the RPCRT4.DLL seems broken and the linker fails.
' ========================================================================================
PRIVATE FUNCTION AfxGuid (BYVAL pwszGuidText AS WSTRING PTR = NULL) AS GUID
   DIM rguid AS GUID
   IF pwszGuidText = NULL THEN
      ' // Generate a new guid
      DIM AS ANY PTR pLib = DyLibLoad("RPCRT4.DLL")
      IF pLib  THEN
         DIM pProc AS FUNCTION (BYVAL Uuid AS UUID PTR) AS RPC_STATUS
         pProc = DyLibSymbol(pLib, "UuidCreate")
         IF pProc THEN pProc(@rguid)
         DyLibFree(pLib)
      END IF
   ELSE
      CLSIDFromString(pwszGuidText, @rGuid)
   END IF
   FUNCTION = rguid
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns a 38-byte human-readable guid string from a 16-byte GUID.
' ========================================================================================
PRIVATE FUNCTION AfxGuidText (BYVAL classID AS CLSID PTR) AS STRING
   DIM pwsz AS WSTRING PTR
   StringFromCLSID(classID, CAST(LPOLESTR PTR, @pwsz))
   FUNCTION = *pwsz
   CoTaskMemFree(pwsz)
END FUNCTION
' ========================================================================================
Title: Re: CWindow RC06
Post by: Petrus Vorster on May 10, 2016, 01:21:43 PM
Will you consider adding some of these controls soon to the Firefly for FB interface, because I really suck at placing controls manually.
Some of the stuff you posted here really is starting to make Freebasic look like a good move, but many of us would love just to click and place.
PLEASE...
Title: Re: CWindow RC06
Post by: José Roca on May 10, 2016, 08:22:31 PM
I have learned a technique that eases a little the use of COM interfaces with FB.

The classic way is to do this kind of declaration:

Code: [Select]
TYPE IDictionaryVtbl
   ' // IDispatch interface
   QueryInterface AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL riid AS CONST IID CONST PTR, BYVAL ppvObject AS any ptr PTR) AS HRESULT
   AddRef AS FUNCTION (BYVAL this AS IDictionary PTR) AS ULONG
   Release AS FUNCTION (BYVAL this AS IDictionary PTR) AS ULONG
   GetTypeInfoCount AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL pctinfo AS UINT PTR) AS HRESULT
   GetTypeInfo AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo ptr PTR) AS HRESULT
   GetIDsOfNames AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL riid AS CONST IID CONST PTR, BYVAL rgszNames AS LPOLESTR PTR, BYVAL cNames AS UINT, BYVAL lcid AS LCID, BYVAL rgDispId AS DISPID PTR) AS HRESULT
   Invoke AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL dispIdMember AS DISPID, BYVAL riid AS CONST IID CONST PTR, BYVAL lcid AS LCID, BYVAL wFlags AS WORD, BYVAL pDispParams AS DISPPARAMS PTR, BYVAL pVarResult AS VARIANT PTR, BYVAL pExcepInfo AS EXCEPINFO PTR, BYVAL puArgErr AS UINT PTR) AS HRESULT
   ' // IDictionary interface
   putref_Item AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL pRetItem AS VARIANT PTR) AS HRESULT
   put_Item AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL vNewItem AS VARIANT PTR) AS HRESULT
   get_Item AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL vRetItem AS VARIANT PTR) AS HRESULT
   Add AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL vItem AS VARIANT PTR) AS HRESULT
   get_Count AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL pCount AS long PTR) AS HRESULT
   Exists AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL pExists AS SHORT PTR) AS HRESULT
   Items AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL pItemsArray AS VARIANT PTR) AS HRESULT
   put_Key AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL vItem AS VARIANT PTR) AS HRESULT
   Keys AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL pKeysArray AS VARIANT PTR) AS HRESULT
   Remove AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR) AS HRESULT
   RemoveAll AS FUNCTION (BYVAL this AS IDictionary PTR) AS HRESULT
   put_CompareMode AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL pcomp AS COMPAREMETHOD) AS HRESULT
   get_CompareMode AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL pcomp AS COMPAREMETHOD PTR) AS HRESULT
   _NewEnum AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL ppunk AS IUnknown PTR PTR) AS HRESULT
   get_HashVal AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL HashVal AS VARIANT PTR) AS HRESULT
END TYPE

TYPE IDictionary_
   lpVtbl AS IDictionaryVtbl PTR
END TYPE

and use it as

Code: [Select]
DIM pDic AS IDictionary PTR
hr = CoCreateInstance(@CLSID_Dictionary, NULL, CLSCTX_INPROC_SERVER, @IID_IDictionary, @pDic)

DIM vKey AS VARIANT
VariantClear(@vKey)
V_VT(@vKey) = VT_BSTR
V_BSTR(@vKey) = SysAllocString("a")

DIM vItem AS VARIANT
VariantClear(@vItem)
V_VT(@vItem) = VT_BSTR
V_BSTR(@vItem) = SysAllocString("Athens")

pDic->lpVtbl->Add(pDic, @vKey, @vItem)

VariantClear(@vItem)
pDic->lpVtbl->get_Item(pDic, @vKey, @vItem)

VariantClear(@vKey)
VariantClear(@vItem)

IF pDic THEN pDic->lpVtbl->Release(pDic)

Continued in the next post.
Title: Re: CWindow RC06
Post by: José Roca on May 10, 2016, 08:33:05 PM
But by declaring the methods of the interfaces as ABSTRACT (the IUnknown interface inherits from OBJECT, a built-in type).

Code: [Select]
TYPE Afx_IUnknown as Afx_IUnknown_
TYPE Afx_IUnknown_ EXTENDS OBJECT
DECLARE ABSTRACT FUNCTION QueryInterface (BYVAL riid AS REFIID, BYVAL ppvObject AS LPVOID PTR) AS HRESULT
DECLARE ABSTRACT FUNCTION AddRef() AS ULONG
DECLARE ABSTRACT FUNCTION Release() AS ULONG
END TYPE
TYPE AFXLPUNKNOWN as Afx_IUnknown PTR

TYPE Afx_IDispatch AS Afx_IDispatch_
TYPE Afx_IDispatch_  EXTENDS Afx_Iunknown
   DECLARE ABSTRACT FUNCTION GetTypeInfoCount (BYVAL pctinfo AS UINT PTR) as HRESULT
   DECLARE ABSTRACT FUNCTION GetTypeInfo (BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION GetIDsOfNames (BYVAL riid AS CONST IID CONST PTR, BYVAL rgszNames AS LPOLESTR PTR, BYVAL cNames AS UINT, BYVAL lcid AS LCID, BYVAL rgDispId AS DISPID PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Invoke (BYVAL dispIdMember AS DISPID, BYVAL riid AS CONST IID CONST PTR, BYVAL lcid AS LCID, BYVAL wFlags AS WORD, BYVAL pDispParams AS DISPPARAMS PTR, BYVAL pVarResult AS VARIANT PTR, BYVAL pExcepInfo AS EXCEPINFO PTR, BYVAL puArgErr AS UINT PTR) AS HRESULT  
END TYPE
TYPE AFX_LPDISPATCH AS Afx_IDispatch PTR

TYPE Afx_IDictionary AS Afx_IDictionary_
TYPE Afx_IDictionary_ EXTENDS Afx_IDispatch
   DECLARE ABSTRACT FUNCTION putref_Item (BYVAL vKey AS VARIANT PTR, BYVAL pRetItem AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION put_Item (BYVAL vKey AS VARIANT PTR, BYVAL vNewItem AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION get_Item (BYVAL vKey AS VARIANT PTR, BYVAL vRetItem AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Add (BYVAL vKey AS VARIANT PTR, BYVAL vItem AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION get_Count (BYVAL pCount AS long PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Exists (BYVAL vKey AS VARIANT PTR, BYVAL pExists AS SHORT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Items (BYVAL pItemsArray AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION put_Key (BYVAL vKey AS VARIANT PTR, BYVAL vItem AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Keys (BYVAL pKeysArray AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Remove (BYVAL vKey AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION RemoveAll () AS HRESULT
   DECLARE ABSTRACT FUNCTION put_CompareMode (BYVAL pcomp AS COMPAREMETHOD) AS HRESULT
   DECLARE ABSTRACT FUNCTION get_CompareMode (BYVAL pcomp AS COMPAREMETHOD PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION _NewEnum (BYVAL ppunk AS IUnknown PTR PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION get_HashVal (BYVAL vKey AS VARIANT PTR, BYVAL HashVal AS VARIANT PTR) AS HRESULT
END TYPE
TYPE AFX_LPDICTIONARY AS Afx_IDictionary PTR

the calls to the interface methods can use a simplified syntax:

Code: [Select]
pDic->Add(@vKey, @vItem)
pDic->get_Item(@vKey, @vItem)
pDic->Release

That is, without having to add ->lpVtbl and having to always pass the this pointer as the first parameter.

Code: [Select]
pDic->lpVtbl->Add(pDic, @vKey, @vItem)
pDic->lpVtbl->get_Item(pDic, @vKey, @vItem)
pDic->lpVtbl->Release(pDic)
Title: Re: CWindow RC06
Post by: Paul Squires on May 10, 2016, 09:21:42 PM
Hi Paul,

If you want to report a bug to dkl....

He has changed

Code: [Select]
type WCHAR as wstring
type PWCHAR as wstring ptr
type LPWCH as wstring ptr
type PWCH as wstring ptr
type LPCWCH as const wstring ptr
type PCWCH as const wstring ptr

to

Code: [Select]
type WCHAR as wchar_t
type PWCHAR as WCHAR ptr
type LPWCH as WCHAR ptr
type PWCH as WCHAR ptr
type LPCWCH as const WCHAR ptr
type PCWCH as const WCHAR ptr

both in stddef.bi and winnt.bi.

As a result, if you use this test code

Code: [Select]
DIM pbstr AS BSTR
pbstr = SysAllocString("This is a test")
print *pbstr
SysFreeString(pbstr)

print "press esc"
sleep

It prints 84, that is the ASC code of the first character.

If I #undef BSTR and define it as WSTRING PTR, it works:

Code: [Select]
#undef BSTR
TYPE BSTR AS WSTRING PTR

DIM pbstr AS BSTR
pbstr = SysAllocString("This is a test")
print *pbstr
SysFreeString(pbstr)


Jose, which version of FB were you using prior to the one where you noticed the change? I looked at several of the latest FB versions and this is what I think the BSTR definition resolves to (it seems to match the C header files I saw as well):

Code: [Select]
wtypes.bi
Type BSTR As OLECHAR Ptr

wtypesbase.bi
type OLECHAR as WCHAR

winnt.bi
Type WCHAR As wchar_t

stddef.bi
#ifdef __FB_DOS__
type wchar_t as ubyte
#elseif defined( __FB_WIN32__ ) or defined( __FB_CYGWIN__ )
type wchar_t as ushort
#else
type wchar_t as long
#endif

So, it seems to resolve to wchar_t (which is a long or ushort depending on platform).

Then I saw this:  http://stackoverflow.com/questions/1607266/whats-the-meaning-of-bstr-lpcolestr-and-others

Does this mean that for every time you use a BSTR you would have to CAST it?

*cast(wstring ptr, pbstr)


Title: Re: CWindow RC06
Post by: José Roca on May 10, 2016, 10:07:31 PM
Quote
Does this mean that for every time you use a BSTR you would have to CAST it?
*cast(wstring ptr, pbstr)

Yes. I think that I'm going to define my own type. WCHAR can only contain a unicode character, therefore a BSTR can't be a WCHAR, but an array of WCHARs. What they have done is like if we defined a STRING as of type UBYTE.

In the file AfxCOM.inc that I'm currently writing, I already have defined the two base types that allow the use of abstract methods, simplifying the syntax.

Code: [Select]
#ifndef __Afx_IUnknown_INTERFACE_DEFINED__
#define __Afx_IUnknown_INTERFACE_DEFINED__
TYPE Afx_IUnknown AS Afx_IUnknown_
TYPE Afx_IUnknown_ EXTENDS OBJECT
DECLARE ABSTRACT FUNCTION QueryInterface (BYVAL riid AS REFIID, BYVAL ppvObject AS LPVOID PTR) AS HRESULT
DECLARE ABSTRACT FUNCTION AddRef() AS ULONG
DECLARE ABSTRACT FUNCTION Release() AS ULONG
END TYPE
TYPE AFXLPUNKNOWN AS Afx_IUnknown PTR
#endif

#ifndef __Afx_IDispatch_INTERFACE_DEFINED__
#define __Afx_IDispatch_INTERFACE_DEFINED__
TYPE Afx_IDispatch AS Afx_IDispatch_
TYPE Afx_IDispatch_  EXTENDS Afx_Iunknown
   DECLARE ABSTRACT FUNCTION GetTypeInfoCount (BYVAL pctinfo AS UINT PTR) as HRESULT
   DECLARE ABSTRACT FUNCTION GetTypeInfo (BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION GetIDsOfNames (BYVAL riid AS CONST IID CONST PTR, BYVAL rgszNames AS LPOLESTR PTR, BYVAL cNames AS UINT, BYVAL lcid AS LCID, BYVAL rgDispId AS DISPID PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Invoke (BYVAL dispIdMember AS DISPID, BYVAL riid AS CONST IID CONST PTR, BYVAL lcid AS LCID, BYVAL wFlags AS WORD, BYVAL pDispParams AS DISPPARAMS PTR, BYVAL pVarResult AS VARIANT PTR, BYVAL pExcepInfo AS EXCEPINFO PTR, BYVAL puArgErr AS UINT PTR) AS HRESULT
END TYPE
TYPE AFX_LPDISPATCH AS Afx_IDispatch PTR
#endif

BTW which name do you think would be more appropriate for the overloaded function AfxNewCom? Maybe AfxNewObj, AfxNewObject, AfxCreateObject?
Title: Re: CWindow RC06
Post by: José Roca on May 10, 2016, 10:18:04 PM
> Jose, which version of FB were you using prior to the one where you noticed the change?

I was using version 1.04, but I think that the headers were the ones of version 1.02.

FreeBASIC binding for mingw-w64-v4.0.1

The ones that I'm using now:

FreeBASIC binding for mingw-w64-v4.0.4
Title: Re: CWindow RC06
Post by: José Roca on May 11, 2016, 05:26:56 AM
@Hi Paul,

I have found a solution for the "A" and "W" functions.

Ihave written these two helper functions:

Code: [Select]
' ========================================================================================
' Translates ansi bytes into unicode bytes.
' ========================================================================================
FUNCTION AfxUCode (BYREF strIn AS STRING) AS STRING
   IF VARPTR(strIn) = 0 OR LEN(strIn) = 0 THEN EXIT FUNCTION
   IF IsTextUnicode(STRPTR(strIn), LEN(strIn), NULL) = 1 THEN FUNCTION = strIn : EXIT FUNCTION
   DIM buffer AS STRING = SPACE(LEN(strIn) * 2)
   DIM nLen AS LONG = MultiByteToWidechar(CP_ACP, MB_PRECOMPOSED, STRPTR(strIn), -1, CAST(WSTRING PTR, STRPTR(buffer)), LEN(buffer))
   FUNCTION = buffer
END FUNCTION
' ========================================================================================

' ========================================================================================
' Translates unicode bytes into ansi bytes.
' ========================================================================================
FUNCTION AfxACode (BYREF strIn AS STRING) AS STRING
   IF VARPTR(strIn) = 0 OR LEN(strIn) = 0 THEN EXIT FUNCTION
   IF IsTextUnicode(STRPTR(strIn), LEN(strIn), NULL) = 0 THEN FUNCTION = strIn : EXIT FUNCTION
   DIM buffer AS STRING = SPACE(LEN(strIn) \ 2)
   DIM nLen AS LONG = WidecharToMultiByte(CP_ACP, 0, CAST(WSTRING PTR, STRPTR(strIn)), -1, STRPTR(buffer), LEN(buffer), NULL, NULL)
   FUNCTION = buffer
END FUNCTION
' ========================================================================================

Now I can write this:

Code: [Select]
' ========================================================================================
' Returns the complete drive, path, file name, and extension of the program which is
' currently executing.
' ========================================================================================
FUNCTION AfxGetExePathNameA () AS STRING
   DIM buffer AS STRING * MAX_PATH + 1
   GetModuleFileNameA NULL, STRPTR(buffer), LEN(buffer)
   DIM p AS LONG = INSTRREV(buffer, ANY ":/\")
   FUNCTION = LEFT(buffer, p)
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION AfxGetExePathNameW () AS STRING
   DIM buffer AS WSTRING * MAX_PATH
   GetModuleFileNameW NULL, buffer, SIZEOF(buffer)
   DIM p AS LONG = INSTRREV(buffer, ANY ":/\")
   FUNCTION = AfxUcode(LEFT(buffer, p))
END FUNCTION
' ========================================================================================

AfxGetExePathNameW will return an ansi string with unicode contents. The trick is to use AfxUcode when returning the string to bypass the FB automatic conversion to ansi (in the above code, FUNCTION = AfxUcode(LEFT(buffer, p))). AfxUcode checks if the string is already in unicode format to no convert a unicode string to unicode again.

These ansi strings with unicode content can be used in place of BSTRs when calling API functions that require a BSTR, as we did with PowerBasic 9, passing the STRPTR of the variable.

This way, we don't need to worry about having to free the BSTRs.
Title: Re: CWindow RC06
Post by: José Roca on May 11, 2016, 07:05:43 AM
There is a problem. Like with PB 9, the parameter of the function must be declared as STRING instead of BSTR.

This is a show stopper because we aren't going to change the declares.
Title: Re: CWindow RC06
Post by: Paul Squires on May 11, 2016, 05:48:23 PM
There is a problem. Like with PB 9, the parameter of the function must be declared as STRING instead of BSTR.

This is a show stopper because we aren't going to change the declares.

Hi Jose,

Which function are you talking about here? Is there a possibility of overloading the function call and then call the string function?

Here is something that appears to work. I just simply picked SysAllocString as an example.

Code: [Select]
#Include Once "windows.bi"

Type BSTR As OLECHAR Ptr
Declare Function SysAllocString Overload ( ByVal myValue As Long ) As BSTR

#Include Once "win/ole2.bi"


Function SysAllocString( ByVal myValue As Long ) As BSTR
   Function = SysAllocString(Str(myValue))
End Function


Dim pbstr As BSTR
pbstr = SysAllocString("This is a test")
Print *cast(wstring ptr, pbstr)
SysFreeString(pbstr)

pbstr = SysAllocString(999)
Print *Cast(WString Ptr, pbstr)
SysFreeString(pbstr)

Print "press esc"
Sleep
Title: Re: CWindow RC06
Post by: José Roca on May 11, 2016, 09:16:25 PM
> Which function are you talking about here?

Any function that has a wide string parameter. If we pass to it an ansi string containing unicode characters, FB  only sees that the type of the passeed string is ansi and converts it to unicode again.

Example:

Code: [Select]
SUB foo (BYVAL b AS WSTRING PTR)
   print *b; "..."
END SUB

foo(AfxUcode("pepe"))

The only way that works is to return a pointer to a BSTR or a WSTRING and then free it.
Title: Re: CWindow RC06
Post by: Paul Squires on May 11, 2016, 09:33:17 PM
If you pass it BYVAL b AS CONST WSTRING PTR, will FB do any conversion?
..... it probably will. CONST only keeps the pointer from not being modified and not the string it points to (I assume).

Or,

FUNCTION AfxUCode (BYREF strIn AS CONST STRING) AS STRING
Title: Re: CWindow RC06
Post by: José Roca on May 11, 2016, 11:05:25 PM
It isn't worth the effort. With PB9 we could use strings in combination with UCODE$ and ACODE$ because they are BSTRs with ansi contents. This is the opposite, ASCIIZ strings with unicode content. Therefore, we can't use them with parameters that will receive a BSTR. And using one method when we want to pass a BSTR and another when we will receive a BSTR is not consistent.

We have tried, but if it can't be, it can't be. If FB does not implement native BSTR support, we will have to use the BSTR API and allocate and free the strings.
Title: Re: CWindow RC06
Post by: José Roca on May 11, 2016, 11:10:15 PM
I have tried the new way to declare interfaces and works fine. They should use it in the headers besides the already existing ones of VTable and macros.

Will do more testing when they fix the broken headers.
Title: Re: CWindow RC06
Post by: Paul Squires on May 11, 2016, 11:20:56 PM
Thanks Jose, I haven't followed all the cases where you need to pass a BSTR or receive a BSTR. However, I was thinking about your AfxUCode function and thought that maybe if you made it so you just passed it a pointer to the string and a length then it would be generic enough to handle any type of string passed to it?

Code: [Select]
' ========================================================================================
' Translates ansi bytes into unicode bytes.
' ========================================================================================
Function AfxUCode (ByVal strIn As Any Ptr, ByVal strLength As Long) As String
   If strIn = 0 Or strLength = 0 Then Exit Function
   Dim buffer As String = Space(strLength * 2)
   If IsTextUnicode(strIn, strLength, Null) = 1 Then
Print "already unicode"   
      ' String is already unicode
      memcpy(Strptr(buffer), strIn, strLength * 2)
   Else
      ' String is not unicode. Do the conversion.
Print "convert to unicode"
      Dim nLen As Long = MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, Cast(ZString Ptr, strIn), -1, Strptr(buffer), Len(buffer))
   End If
   Function = buffer
End Function


Dim As String st = "This is a test"
Print AfxUCode( Strptr(st), Len(st) )

Dim wst As WString * 10 = "Paul"
Print AfxUCode( Strptr(wst), Len(wst) )


Print "press esc"
Sleep
Title: Re: CWindow RC06
Post by: José Roca on May 12, 2016, 12:06:20 AM
The purpose of these functions was to try something as we did with PB9. Otherwise, it is not needed.

The more satisfactory method is the CBStr class that I wrote, although can't be used to create temporary BSTRs on the fly because of memory leaks.
Title: Re: CWindow RC06
Post by: José Roca on May 12, 2016, 12:51:25 AM
Another question are variants. We can use a class or procedures. Private procedures have the advantage of dead code removal and the disadvantage of not freeing the variant automatically.

Code: [Select]
'#define unicode
#INCLUDE ONCE "win/ole2.bi"

' ========================================================================================
' Initializes a variant from a string.
' ========================================================================================
PRIVATE FUNCTION VarFromStr OVERLOAD (BYVAL pwsz AS WSTRING PTR) AS VARIANT
   DIM v AS VARIANT
   VariantInit(@v)
   V_VT(@v) = VT_BSTR
   V_BSTR(@v) = SysAllocString(pwsz)
   FUNCTION = v
   VariantClear(@v)
END FUNCTION
' ========================================================================================

' ========================================================================================
PRIVATE SUB VarFromStr 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

' ========================================================================================
PRIVATE SUB VarFromStr OVERLOAD (BYREF v AS VARIANT, BYVAL pwsz AS WSTRING PTR)
   IF VARPTR(v) = NULL THEN EXIT SUB
   VariantClear(@v)
   V_VT(@v) = VT_BSTR
   V_BSTR(@v) = SysAllocString(pwsz)
END SUB
' ========================================================================================

DIM v AS VARIANT
v = VarFromStr("Athens")
print *CAST(WSTRING PTR, v.bstrVal)

VarFromStr(@v, "Paris")
print *CAST(WSTRING PTR, v.bstrVal)

VarFromStr(v, "Rome")
print *CAST(WSTRING PTR, v.bstrVal)

VariantClear(@v)

print
print "press esc"
Sleep
Title: Re: CWindow RC06 - Embedded Explorer Browser control
Post by: José Roca on May 12, 2016, 03:48:06 AM
Another COM example: Embedded Explorer Browser control.

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_ExplorerBrowser.fbtpl
' Contents: Resizable CWindow with an embedded Explorer Browser 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 "windows.bi"
#INCLUDE ONCE "win/shlobj.bi"
#INCLUDE ONCE "Afx/CWindow.inc"

USING Afx.CWindowClass

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)

' ========================================================================================
' 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, rc AS RECT
   STATIC peb AS IExplorerBrowser PTR

   SELECT CASE uMsg

      CASE WM_CREATE
         ' // Get a pointer to the CWindow class
         DIM pCreateStruct AS CREATESTRUCT PTR = CAST(CREATESTRUCT PTR, lParam)
         DIM pWindow AS CWindow PTR = CAST(CWindow PTR, pCreateStruct->lpCreateParams)
         ' // Add a button control
         IF pWindow THEN pWindow->AddControl("Button", hwnd, IDCANCEL, "&Close")
         ' // Create an instance of IExplorerBrowser
         CoCreateInstance(@CLSID_ExplorerBrowser, NULL, CLSCTX_INPROC_SERVER, @IID_IExplorerBrowser, @peb)
         IF peb = NULL THEN EXIT FUNCTION
         peb->lpVtbl->SetOptions(peb, EBO_SHOWFRAMES)
         DIM fs AS FOLDERSETTINGS
         fs.ViewMode = FVM_DETAILS
         DIM rc AS RECT
         GetClientRect hwnd, @rc
         peb->lpVtbl->Initialize(peb, hwnd, @rc, @fs)
         ' // Navigate to the Profile folder
         DIM pidlBrowse AS LPITEMIDLIST
         IF SUCCEEDED(SHGetFolderLocation(NULL, CSIDL_PROFILE, NULL, 0, @pidlBrowse)) THEN
            peb->lpVtbl->BrowseToIDList(peb, pidlBrowse, 0)
            ILFree(pidlBrowse)
         END IF
         EXIT FUNCTION

      CASE WM_COMMAND
         ' // If ESC key pressed, close the application sending an WM_CLOSE message
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Resize the controls
            pWindow = CAST(CWindow PTR, GetWindowLongPtr(hwnd, 0))
            pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 90, pWindow->ClientHeight - 35, 75, 23, CTRUE
            ' // Resize the Explorer control
            GetClientRect hwnd, @rc
            rc.Right -= 210
            IF peb THEN peb->lpVtbl->SetRect(peb, NULL, rc)
         END IF

    CASE WM_DESTROY
         IF peb THEN
            ' // Destroy the browser and release the interface
            peb->lpVtbl->Release(peb)
            peb->lpVtbl->Release(peb)
         END IF
         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

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   ' // Initialize the COM library
   CoInitialize NULL

   DIM pWindow AS CWindow
   pWindow.Create(NULL, "CWindow with an embedded Explorer Browser", @WndProc)
   pWindow.Brush = GetStockObject(WHITE_BRUSH)
   pWindow.SetClientSize(500, 320)
   pWindow.Center

   

   FUNCTION = pWindow.DoEvents(nCmdShow)

   ' // Uninitialize the COM library
   CoUninitialize

END FUNCTION
' ========================================================================================
Title: Re: CWindow RC06
Post by: Paul Squires on May 12, 2016, 08:19:04 AM
The more satisfactory method is the CBStr class that I wrote, although can't be used to create temporary BSTRs on the fly because of memory leaks.

Hi Jose, I am at work right now so I am only reading your posts and can't do much with them at the moment. Question: Couldn't the CBStr class simply clean up any allocated memory (from SysAllocString?) in the class's DESTRUCTOR. When the class goes out of scope the Destructor should be called and then the allocated memory freed?
Title: Re: CWindow RC06
Post by: James Fuller on May 12, 2016, 09:43:52 AM
I don't know if this is feasable but BCX,bc9 use a circular buffer for temporary strings:
Code: [Select]
#ifndef BCXTmpStrSize
#define BCXTmpStrSize  2048
#endif
char *BCX_TmpStr (size_t Bites, size_t  iPad, int iAlloc)
{
    static int   StrCnt;
    static char *StrFunc[BCXTmpStrSize];
    StrCnt = (StrCnt + 1) & (BCXTmpStrSize - 1);
    if(StrFunc[StrCnt]) {
        free (StrFunc[StrCnt]);
        StrFunc[StrCnt] = NULL;
    }
#if defined BCX_MAX_VAR_SIZE
    if(Bites * sizeof(char) > BCX_MAX_VAR_SIZE)
    {
        printf("Buffer Overflow caught in BCX_TmpStr - requested space of %d EXCEEDS %d\n", (int)(Bites * sizeof(char)), BCX_MAX_VAR_SIZE);
        abort();
    }
#endif
    if(iAlloc) StrFunc[StrCnt] = (char*)calloc(Bites + iPad + 1, sizeof(char));
    return StrFunc[StrCnt];
}


Called from the internal LEFT$ function like this:

Code: [Select]
char *left (const char *S, int length)
{
    register int tmplen = strlen(S);
    if(length < 1) return BCX_TmpStr(1, 0, 1);
    if(length < tmplen) tmplen = length;
    char *strtmp = BCX_TmpStr(tmplen, 1, 1);
    return (char*)memcpy(strtmp, S, tmplen);
}


James
Title: Re: CWindow RC06
Post by: aloberr on May 12, 2016, 10:38:39 AM
Speaking about COM code  with the abstract interfaces, I do what you do today of then more than Two years, your reputation will make perhaps change the things. 
So that that things goes more quickly , looks at what I did in FREEBASIC forum , inside COM with feebasic, other share I have tons of code for this purpose. 
Considering what you did with POWERBASIC, it is an honor which you makes it with FREEBASIC, I same already translated your comBrowsher into Freebasic.
Title: Re: CWindow RC06
Post by: aloberr on May 12, 2016, 11:43:48 AM
your web container don't work for me
look at this small api code:
Code: [Select]
#include Once "windows.bi"
#include Once "win/ole2.bi"
#Include Once "win/ExDisp.bi"

Extern "windows" lib "atl" 
 Declare Function AtlAxAttachControl(As IUnknown Ptr, As HWND,As IUnknown Ptr Ptr) As HRESULT
End Extern



Dim Shared As HWND hconteneur ' Déclaration du HWND de notre conteneur en global:


 Function WndProc(hWnd As HWND ,msg As UINT ,wParam As WPARAM ,lParam As LPARAM  )As LRESULT

Select Case(msg)

case WM_SIZE:
' Redimensionnement du conteneur quand la taille de la fenêtre change:
MoveWindow(hconteneur,0,0,LOWORD(lParam), HIWORD(lParam),1)


case WM_CLOSE:
DestroyWindow(hWnd)


case WM_DESTROY:
PostQuitMessage(0)
Return 0

Case Else:
return DefWindowProc(hWnd, msg, wParam, lParam)
End Select
return 0
End Function



Function WinMain(hInst As HINSTANCE ,hPreInst As HINSTANCE ,lpszCmdLine As LPSTR , nCmdShow As Integer )As Integer
 
' Déclarer notre classe de fenêtre et définir ses membres:
Dim As WNDCLASS wc
Dim As ZString ptr NomClasse     = @"Conteneur"
wc.lpszClassName = NomClasse
wc.hInstance = hInst
wc.lpfnWndProc = @WndProc
wc.hCursor = LoadCursor( 0, IDC_ARROW )
wc.hIcon = LoadIcon( 0, IDI_APPLICATION )
wc.lpszMenuName     = 0
wc.hbrBackground = 0
wc.style = 0
wc.cbClsExtra = 0
wc.cbWndExtra = 0
' Enregistrer la classe de notre fenêtre:
if (0=RegisterClass(@wc))Then return 0

' Créer notre fenêtre principale:
Dim As HWND hWnd = CreateWindow( NomClasse,"Conteneur Activex",WS_OVERLAPPEDWINDOW,0,0,800,575, 0, 0, hInst,0)
' Montrer la fenêtre:
ShowWindow(hWnd, nCmdShow )
UpdateWindow( hWnd )


' Obtenir les dimensions de notre fenêtre:
Dim As RECT rect
GetClientRect(hWnd,@rect)
' Créer l'EDIT qui servira de conteneur Activex:
hconteneur=CreateWindowEx(WS_EX_CLIENTEDGE,"EDIT","",WS_CHILD Or WS_VISIBLE,0,0,rect.right,rect.bottom,hWnd,0,0,0)
' Initialiser la librairie COM pour notre programme:
CoInitialize(0)
' Déclarer un pointeur sur l'interface IWebBrowser2:
Dim As IWebBrowser2   Ptr pIwb
' Créer une instance de l'objet WebBrowser et de l'interface IWebBrowser2:
CoCreateInstance(@CLSID_WebBrowser,0,CLSCTX_ALL,@IID_IWebBrowser2,cast(lpvoid Ptr,@pIwb))
' Attacher l'objet WebBrowser à notre EDIT conteneur:
AtlAxAttachControl(pIwb,hconteneur,0)
' Lancer la page de démarrage:
pIwb->lpvtbl->GoHome(pIwb)

' Boucle des messages:
Dim As MSG Msg
while( GetMessage(@Msg, 0, 0, 0))
TranslateMessage( @Msg )
DispatchMessage( @Msg )
Wend

' Libérer l'interface IWebBrowser2:
pIwb->lpvtbl->Release(pIwb)
' Fermer la librairie COM pour notre programme:
    CoUninitialize()

' Quitter le programme:
return  Msg.wParam
End Function
End WinMain(getmodulehandle(0),NULL,Command,SW_SHOW)
Title: Re: CWindow RC06
Post by: José Roca on May 12, 2016, 11:53:01 AM
If you did it more that two years ago, they should have used it in the translated headers and explained it in the help file.

Looking at the C++ headers, we can see that they have declaratons for C++, ansi C and macros:

Code: [Select]
EXTERN_C const IID IID_IMalloc;

#if defined(__cplusplus) && !defined(CINTERFACE)

    MIDL_INTERFACE("00000002-0000-0000-C000-000000000046")
    IMalloc : public IUnknown
    {
    public:
        virtual void *STDMETHODCALLTYPE Alloc(
            /* [annotation][in] */
            __in  SIZE_T cb) = 0;

        virtual void *STDMETHODCALLTYPE Realloc(
            /* [annotation][in] */
            __in_opt  void *pv,
            /* [annotation][in] */
            __in  SIZE_T cb) = 0;

        virtual void STDMETHODCALLTYPE Free(
            /* [annotation][in] */
            __in_opt  void *pv) = 0;

        virtual SIZE_T STDMETHODCALLTYPE GetSize(
            /* [annotation][in] */
            __in_opt  void *pv) = 0;

        virtual int STDMETHODCALLTYPE DidAlloc(
            /* [annotation][in] */
            __in_opt  void *pv) = 0;

        virtual void STDMETHODCALLTYPE HeapMinimize( void) = 0;

    };

#else /* C style interface */

    typedef struct IMallocVtbl
    {
        BEGIN_INTERFACE

        HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
            IMalloc * This,
            /* [in] */ REFIID riid,
            /* [annotation][iid_is][out] */
            __RPC__deref_out  void **ppvObject);

        ULONG ( STDMETHODCALLTYPE *AddRef )(
            IMalloc * This);

        ULONG ( STDMETHODCALLTYPE *Release )(
            IMalloc * This);

        void *( STDMETHODCALLTYPE *Alloc )(
            IMalloc * This,
            /* [annotation][in] */
            __in  SIZE_T cb);

        void *( STDMETHODCALLTYPE *Realloc )(
            IMalloc * This,
            /* [annotation][in] */
            __in_opt  void *pv,
            /* [annotation][in] */
            __in  SIZE_T cb);

        void ( STDMETHODCALLTYPE *Free )(
            IMalloc * This,
            /* [annotation][in] */
            __in_opt  void *pv);

        SIZE_T ( STDMETHODCALLTYPE *GetSize )(
            IMalloc * This,
            /* [annotation][in] */
            __in_opt  void *pv);

        int ( STDMETHODCALLTYPE *DidAlloc )(
            IMalloc * This,
            /* [annotation][in] */
            __in_opt  void *pv);

        void ( STDMETHODCALLTYPE *HeapMinimize )(
            IMalloc * This);

        END_INTERFACE
    } IMallocVtbl;

    interface IMalloc
    {
        CONST_VTBL struct IMallocVtbl *lpVtbl;
    };



#ifdef COBJMACROS


#define IMalloc_QueryInterface(This,riid,ppvObject) \
    ( (This)->lpVtbl -> QueryInterface(This,riid,ppvObject) )

#define IMalloc_AddRef(This) \
    ( (This)->lpVtbl -> AddRef(This) )

#define IMalloc_Release(This) \
    ( (This)->lpVtbl -> Release(This) )


#define IMalloc_Alloc(This,cb) \
    ( (This)->lpVtbl -> Alloc(This,cb) )

#define IMalloc_Realloc(This,pv,cb) \
    ( (This)->lpVtbl -> Realloc(This,pv,cb) )

#define IMalloc_Free(This,pv) \
    ( (This)->lpVtbl -> Free(This,pv) )

#define IMalloc_GetSize(This,pv) \
    ( (This)->lpVtbl -> GetSize(This,pv) )

#define IMalloc_DidAlloc(This,pv) \
    ( (This)->lpVtbl -> DidAlloc(This,pv) )

#define IMalloc_HeapMinimize(This) \
    ( (This)->lpVtbl -> HeapMinimize(This) )

#endif /* COBJMACROS */


#endif /* C style interface */

But in FB the headers, only the ansi C interface and the macros are translated, so I first thought that the C++ way was not possible. Then I saw a post in wich you were using DECLARE ABSTRACT FUNCTION and began to investigate and try...

Frankly, it does not make sense to translate the C interfaces and macros and skip the C++ way, which makes its use easier.
Title: Re: CWindow RC06
Post by: José Roca on May 12, 2016, 12:00:12 PM
> your web container don't work for me

If you mean the YouTube example, it works fine in my computer, but the old ATL.DLL that comes as a system DLL with Windows does not work very well. I plan to adapt my OLE container later...
Title: Re: CWindow RC06
Post by: José Roca on May 12, 2016, 12:53:38 PM
> Question: Couldn't the CBStr class simply clean up any allocated memory (from SysAllocString?) in the class's DESTRUCTOR. When the class goes out of scope the Destructor should be called and then the allocated memory freed?

It does it, of course. But there are situations which only native support from the compiler could solve.

If I have two BSTRs, a and b, and want to concatenate them with an overloaded & operator...

It will work if I assign the resulting new string to another instance of the CBStr class, e.g. cb = a & b.

It also will work if I assign the result to another new BSTR, e.g. c = a & b, and later I free c with SysFreeString, but if c already has contents, I will get a memory leak unless I first free it.

I will also get memory leaks if I intend to pass the new resulting string to a function without first assigning it to another BSTR and passing this third string, e.g.

c = a & b
Foo(c)

will work

but using Foo (a & b) will leak.

> I don't know if this is feasable but BCX,bc9 use a circular buffer for temporary strings:

The compiler can know if the resulting string is temporary, i.e. it is not assigned to another variable, or not and free it, but the class doesn't know how it is going to be used.

To call COM API functions and methods we only need SysAllocString and SysFreeString. Without support of the compiler, it will be not be a good choice for those that need unicode.
Title: Re: CWindow RC06
Post by: Paul Squires on May 12, 2016, 02:34:26 PM
I will also get memory leaks if I intend to pass the new resulting string to a function without first assigning it to another BSTR and passing this third string, e.g.

c = a & b
Foo(c)

will work

but using Foo (a & b) will leak.


I haven't created a test case yet but in my mind I am not seeing why that case described above would leak memory. Wouldn't the logic be something like this:

- Create "a" CBSTR.
- Create "b" CBSTR
- Pass "a + b" to function Foo. Foo accepts the concatenation and stores it in object "c". At this point, memory is being held for "a", "b" and "c".
- Foo() does whatever it needs to do and eventually returns from that function call. "c" goes out of scope at that point and is automatically destroyed/freed.
- "a" and "b" are now freed when they go out of scope (ie. the program ends or the function that "a" and "b" may be in is eventually exited.

Code: [Select]
Function MySub() As Long

   Dim a As CBStr = "A String"
   Dim b As CBStr = "B String"

   Foo( a & b ) 

   '<--- "a" and "b" are freed as MySub() ends
End Function


Function Foo( c As CBSTR ) As Long

   ' <--- "c" is freed when function returns
End Function





Title: Re: CWindow RC06
Post by: José Roca on May 12, 2016, 11:17:21 PM
> ' <--- "c" is freed when function returns

I don't think so, and much less if you are passing a & b to an API function.
Title: Re: CWindow RC06
Post by: José Roca on May 13, 2016, 06:54:49 AM
Attached is a version of CBStr.inc in which I have changed the BSTR type for AFX_BSTR; otherwise, it won't work with the latest FB headers.

This code demonstrates the leak problem.

Code: [Select]
SUB Foo (BYVAL b AS AFX_BSTR)
   PRINT *b
END SUB

If I assign the result of concatenating two BSTRs (in the example both bs1 and bs2 are of the type CBStr, but they can be other types or even literals)

Code: [Select]
DIM bs1 AS CBStr = "Text"
DIM bs2 AS CBStr = "string"
DIM bs3 AS CBStr = bs1 & bs2
Foo *bs3

then it works fine because the resulting new BSTR is assigned to a variable of the type CBStr that will free the memory when it goes out of scope.

But if I use

Code: [Select]
Foo bs1 & bs2

The resulting new BSTR is never freed.

Also, if I use

Code: [Select]
DIM bs1 AS CBStr = "Text"
DIM bs2 AS CBStr = "string"
DIM bs3 AS CBStr = bs1 & " " & bs2
Foo *bs3

there is also a leak because the operation generates two new temporary BSTRs, the first one by bs1 & " " and the second one by the result of bs1 & " " and <result> & bs2, but only the second is assigned to bs3 and, therefore, the temporary string generated by bs1 & " " will be never freed.

To avoid the leak, I will have to use
Code: [Select]
DIM bs1 AS CBStr = "Text"
DIM bs2 AS CBStr = "string"
DIM bs3 AS CBStr = bs1 & " "
DIM bs4 AS CBStr = bs3 & bs2
Foo *bs3


The other problem is to known if when you assign a pointer to a variable of type CBStr, this pointer if to a real BSTR or not. I'm using a trick.

Code: [Select]
' ========================================================================================
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 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 OPERATOR
' ========================================================================================

Title: Re: CWindow RC06
Post by: Paul Squires on May 13, 2016, 09:40:19 AM
Thanks Jose, I just downloaded the new class and I am now working through your code in your post above in order to understand the points of the memory leak. I will post again when I am fully knowledgeable.

Title: Re: CWindow RC06
Post by: José Roca on May 13, 2016, 09:56:39 AM
The ones that can generate memory leaks are these that return a BSTR, i.e. the & and + overloaded operators.
Title: Re: CWindow RC06
Post by: José Roca on May 13, 2016, 10:29:32 AM
The only way is to remove the Concat function and the & and + operators.

We can still do string concatenation this way:

Code: [Select]
SUB Foo (BYVAL b AS AFX_BSTR)
   PRINT *b
END SUB

DIM bs1 AS CBStr = "Text"
DIM bs2 AS CBStr = "string"
DIM bs3 AS CBStr = **bs1 & " " & **bs2
Foo *bs3
Title: Re: CWindow RC06
Post by: Paul Squires on May 13, 2016, 10:56:42 AM
The ones that can generate memory leaks are these that return a BSTR, i.e. the & and + overloaded operators.

Yes, it FINALLY clicked in for me once I wrote some test code and followed the logic through. :)

You are passing two OBJECTS to Foo and concatenating their strings via the & operator. The concatenation function returns an AFX_BSTR (basically a wstring ptr with manually allocated memory via SysAllocStringLen). The problem then is that the AFX_BSTR will never be freed because it is never tracked nor is it an object that can have a Destructor called).

It does seem like this is a situation where the compiler needs to handle the tracking of the creation and deleting of the BSTR. That is, the same way the compiler tracks allocated internal FBSTRING types. I doubt that will be added to the compiler anytime soon.

I can't think of a solution around this(?)


Title: Re: CWindow RC06
Post by: José Roca on May 13, 2016, 11:20:23 AM
We can do string concatenation without memory leaks using

DIM bs3 AS CBStr = **bs1 & " " & **bs2

A little weird syntax, but...

No wonder the CComBstr class of Microsoft Fundation Classes does not have string concatenation.

Only the compiler can deal with the intermediate temporary strings.
Title: Re: CWindow RC06
Post by: José Roca on May 13, 2016, 12:27:00 PM
I have added the operator @. It allows to pass the address of the BSTR pointer (m_bstr) to a function (OUT parameter). As the address is manipulated directly, we must first set it to empty if it has contents to avoid memory leaks. To set it to empty, just assign an empty string to it, i.e. bs = "".

Code: [Select]
' ========================================================================================
' Returns the address of the BSTR
' ========================================================================================
OPERATOR CBStr.@ () AS AFX_BSTR PTR
   OPERATOR = @m_bstr
END OPERATOR
' ========================================================================================

Usage example:

Code: [Select]
SUB Foo (BYVAL b AS AFX_BSTR PTR)
   *b = SysAllocString("xxxxx")
END SUB

DIM bs AS CBStr
Foo @bs
print **bs

Well, I think that now the class is fully usable. We still need to use double indirection to print the contents of the BSTR (**bs) because the current version of the compiler does not support the * operator as a member of the class. It is in the TODO list.
Title: Re: CWindow RC06
Post by: José Roca on May 13, 2016, 01:07:25 PM
We can declare "A" and "W" functions as follows:

Code: [Select]
' ========================================================================================
' Returns the path of the program that is currently executing.
' Contrarily to the Free Basic ExePath function, it includes a trailing "\".
' ========================================================================================
PRIVATE FUNCTION AfxGetExePathA () AS STRING
   DIM buffer AS STRING * MAX_PATH + 1
   GetModuleFileNameA NULL, STRPTR(buffer), LEN(buffer)
   DIM p AS LONG = INSTRREV(buffer, ANY ":/\")
   FUNCTION = LEFT(buffer, p)
END FUNCTION
' ========================================================================================
' ========================================================================================
PRIVATE FUNCTION AfxGetExePathW () AS AFX_BSTR
   DIM buffer AS WSTRING * MAX_PATH
   GetModuleFileNameW NULL, @buffer, SIZEOF(buffer)
   DIM p AS LONG = INSTRREV(buffer, ANY ":/\")
   DIM bs AS AFX_BSTR = SysAllocString(LEFT(buffer, p))
   FUNCTION = bs
END FUNCTION
' ========================================================================================

#ifndef UNICODE
   #define AfxGetExePath AfxGetExePathA
#else
   #define AfxGetExePath AfxGetExePathW
#endif

Usage of the "W" version:

Code: [Select]
DIM bs AS CBStr = AfxGetExePathW
print **bs

Usage example without assigning the returned handle to an instance of the class.

Code: [Select]
DIM b AS AFX_BSTR = AfxGetExePathW
print *b
SysFreeString b
Title: Re: CWindow RC06
Post by: Paul Squires on May 13, 2016, 03:45:26 PM
Will you consider adding some of these controls soon to the Firefly for FB interface, because I really suck at placing controls manually.
Some of the stuff you posted here really is starting to make Freebasic look like a good move, but many of us would love just to click and place.
PLEASE...

I think what I will do as an interim step will be to create a small utility that will read a FireFly frm file and create the necessary cWindow code. Allow that code to be copied to the clipboard so that you can paste it into your editor. This will allow us to use FireFly to visually create a form while still be able to have access to the underlying cWindow code that could be used to create that form.

EDIT: Added - this utility is just about complete. Just need to do some testing and then I will post it.

EDIT: Added - utility is now available at: http://www.planetsquires.com/protect/forum/index.php?topic=3834.msg28038



 
Title: Re: CWindow RC06
Post by: aloberr on May 14, 2016, 03:46:09 PM
josé
for CBSTR ,I have to add a constructor, operator let and cast for the BSTR
your method is not badly, but there is simpler with my method
to see widestring.bi and its test
Code: [Select]
#pragma once

#include once "windows.bi"
#include once "win/ole2.bi"
#Include once "win/shlwapi.bi"

#ifndef AFX_BSTR
   #define AFX_BSTR WSTRING PTR
#endif

NAMESPACE Afx.CBStrClass

' ========================================================================================
' CBStr - OLE strings class
' ========================================================================================
TYPE CBStr

   Private:
      m_bstr AS AFX_BSTR

   Public:
      DECLARE CONSTRUCTOR (BYREF wszStr AS CONST WSTRING = "")
      DECLARE CONSTRUCTOR (BYREF szStr AS STRING = "")
      DECLARE CONSTRUCTOR (BYREF pCBStr AS CBStr)
      DECLARE CONSTRUCTOR (BYREF bstrHandle AS AFX_BSTR = NULL)
      DECLARE CONSTRUCTOR (BYVAL pCBStr AS BSTR)
      DECLARE DESTRUCTOR
      DECLARE OPERATOR Let (BYREF szStr AS STRING)
      DECLARE OPERATOR Let (BYREF wszStr AS CONST WSTRING)
      DECLARE OPERATOR Let (BYREF pCBStr AS CBStr)
      DECLARE OPERATOR Let (BYREF bstrHandle AS AFX_BSTR)
      DECLARE OPERATOR Let (BYVAL pBStr AS BSTR)
      DECLARE OPERATOR += (BYREF wszStr AS CONST WSTRING)
      DECLARE OPERATOR += (BYREF pCBStr AS CBStr)
      DECLARE OPERATOR &= (BYREF wszStr AS CONST WSTRING)
      DECLARE OPERATOR &= (BYREF pCBStr AS CBStr)
      DECLARE PROPERTY Handle () AS AFX_BSTR
      DECLARE SUB Append (BYREF wszStr AS CONST WSTRING)
      DECLARE FUNCTION Concat (BYREF wszStr2 AS CONST WSTRING, BYREF wszStr2 AS CONST WSTRING) AS AFX_BSTR
      DECLARE OPERATOR cast() AS String
      DECLARE OPERATOR cast() AS BSTR
END TYPE
' ========================================================================================

' ========================================================================================
' CBStr class constructor
' ========================================================================================
CONSTRUCTOR CBStr (BYREF wszStr AS CONST WSTRING = "")
   m_bstr = SysAllocString(wszStr)
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
CONSTRUCTOR CBStr (BYREF szStr AS STRING = "")
   m_bstr = SysAllocString(WSTR(szStr))
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
CONSTRUCTOR CBStr (BYREF pCBStr AS CBStr)
   m_bstr = SysAllocString(*pCBStr.Handle)
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
         ' Free the current OLE string and 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

CONSTRUCTOR CBStr(BYVAL pCBStr AS BSTR)
    m_bstr =Cast(WString Ptr,pCBStr)
End Constructor

' ========================================================================================
' CBStr class destructor
' ========================================================================================
DESTRUCTOR CBStr
   IF m_bstr THEN SysFreeString m_bstr
END DESTRUCTOR
' ========================================================================================

' ========================================================================================
' Assigns new text to the BSTR
' Note: We can also pass a FB ansi string (the conversion to Unicode is automatic)
' ========================================================================================
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 szStr AS STRING)
   IF m_bstr THEN SysFreeString(m_bstr)
   m_bstr = SysAllocString(WSTR(szStr))
END OPERATOR
' ========================================================================================
' ========================================================================================
OPERATOR CBStr.Let (BYREF pCBStr AS CBStr)
   IF m_bstr THEN SysFreeString(m_bstr)
   m_bstr = SysAllocString(*pCBStr.Handle)
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 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 OPERATOR

OPERATOR CBStr.Let (BYVAL szStr AS BSTR)
   IF m_bstr THEN SysFreeString(m_bstr)
   m_bstr = Cast(WString Ptr,szStr)
END Operator


  OPERATOR CBStr.cast() AS String
    Return *m_bstr
  End Operator

  OPERATOR CBStr.cast() AS BSTR
    Return  Cast(BSTR,m_bstr)
  End Operator
 
' ========================================================================================
' Returns the handle of the BSTR
' ========================================================================================
PROPERTY CBStr.Handle () AS AFX_BSTR
   PROPERTY = m_bstr
END PROPERTY
' ========================================================================================

' ========================================================================================
' 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.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))
   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
Title: Re: CWindow RC06
Post by: aloberr on May 14, 2016, 03:47:13 PM
test.bas
Code: [Select]
#Include Once "cbstr.bi"

Using  Afx.CBStrClass

Dim cs As CBStr=CBStr("Une string dans Com String")
Dim cs2 As CBStr

Dim bs As BSTR =cs
Print cs
Print *Cast(WString Ptr,bs)
Print

cs2=cs
Print  cs2

Print
Print

Dim wz As WString*45="Une BSTR dans CCOMBSTR"
cs2=sysallocstring(@wz)
Print  cs2



' To append another BSTR:
 DIM b1 AS CBStr = "1st string"
 DIM b2 AS CBStr = " 2nd string"
 b1.Append *b2.Handle
 '-or-
 'b1.Append **b2
 Print **b1

 DIM bss AS CBStr = "Test string"
 PRINT **bss '(notice the double indirection)


 DIM bs1 AS CBStr = "Test string 1"
 DIM wsz AS WSTRING * 250 = " - concatenated string"
 DIM bs2 AS CBStr
 bs2 = bs1 & wsz
 Print **bs2
Sleep
Title: Re: CWindow RC06
Post by: aloberr on May 14, 2016, 03:49:06 PM
widestring.bi
Code: [Select]
#Include Once "windows.bi"
#Include Once "win/ole2.bi"



type WideString
 Private:
    Public:
      m_bstr As BSTR
      m_str  As ZString Ptr 
  Public:
   Declare Constructor() 
   Declare Constructor(mbstr As BSTR )
   Declare Constructor(mstr As String )
   Declare Constructor(byref mwstr As WideString )
   Declare Operator Let(mbstr As BSTR )
   Declare Operator Let(mstr As String )
   Declare Operator Let(ByRef mstr As WideString )
   Declare Operator +=(byref s  as  WideString ) 
Declare Operator &=(byref s  as  WideString ) 
   Declare Operator +=(byref s  as  String ) 
Declare Operator &=(byref s  as  String ) 
   Declare Operator +=(byref s  as  BSTR ) 
Declare Operator &=(byref s  as  BSTR )
   
   Declare Operator Cast() As BSTR
   Declare Operator Cast() As String
   Declare Operator Cast() As BSTR Ptr
   Declare Operator Cast() As String Ptr
   Declare Destructor()
End Type

Constructor WideString()
   m_str=NULL
   m_bstr=NULL
End Constructor


Constructor WideString(mbstr As BSTR )
    if (0=mbstr) Then
    m_str = NULL
    Else
    Dim s As String=*Cast(WString Ptr,mbstr)
      m_str=New Byte[Len(s)+1]
      *m_str= s
    End If
    m_bstr=mbstr
End Constructor

Constructor WideString(mstr As String )
    if Len(mstr)=NULL Then
    m_str = NULL
    m_bstr=NULL
    Else
      m_str=New Byte[Len(mstr)+1]
      *m_str= mstr
      m_bstr=SysAllocString(WStr(mstr))
    End if
End Constructor

Constructor WideString(byref mwstr As WideString )
  'if mwstr.m_str  Then  m_str  = mwstr.m_str       ' erratique  m_str non instancié
  'if mwstr.m_bstr Then  m_bstr = mwstr.m_bstr
 
  if mwstr.m_str  Then 
    this.constructor(*mwstr.m_str)
    Exit Constructor
  Else
  if mwstr.m_bstr Then  this.constructor(mwstr.m_bstr)
 
  EndIf
   
End Constructor

Operator WideString.let(mbstr As BSTR )
    if m_str  Then  Delete [] m_str :m_str = NULL
    if m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
    this.constructor(mbstr)
End Operator

Operator WideString.let(mstr As String )
   if m_str  Then  Delete [] m_str :m_str = NULL
   if m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
    this.constructor(mstr)
End Operator

Operator WideString.let(byref mwstr As WideString )
   if m_str  Then  Delete [] m_str :m_str = NULL
   if m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
    this.constructor(mwstr)
End Operator

Operator WideString.Cast() As BSTR
if m_bstr=NULL  Then
   Return SysAllocString(WStr(*m_str)) 
Else
   Return m_bstr
End If   
End Operator

 Operator WideString.Cast() As String
  if m_str=NULL  Then
     '*m_str=*Cast(WString Ptr,m_bstr) ' mauvais car m_str non initialisé
     this.constructor(m_bstr)
     Return *m_str
  Else
     Return  *m_str
  End If
 End Operator
   
Operator WideString.Cast() As BSTR Ptr
if m_bstr=NULL  Then
    m_bstr=SysAllocString(WStr(*m_str))
    Return cptr(BSTR Ptr,m_bstr)
Else
    Return cptr(BSTR Ptr,m_bstr)
End If
End Operator

 Operator WideString.Cast() As String Ptr
  if m_str=NULL  Then
       this.constructor(m_bstr)
       Return  Cast(String Ptr,m_str)
  Else
      Return  Cast(String Ptr,m_str)
  End If   
 End Operator
 
  Destructor WideString()
    If m_str Then Delete [] m_str : m_str=NULL
    if m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
 End Destructor     



Operator WideString.+=(byref s As  WideString ) 
'If Len(*m_str) And Len(*s.m_str) Then    ' on ne peut pas ajouter un " " /
     Dim temp As String =*m_str
  temp=temp & *s.m_str
  if m_str  Then  Delete [] m_str :m_str = NULL
           If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
           this.constructor(temp)   
     
'Else

'End If
End Operator

Operator WideString.&=(byref s  as  WideString ) 
'If Len(*m_str) And Len(*s.m_str) Then
  Dim temp As String =*m_str
  temp=temp & *s.m_str
  if m_str  Then  Delete [] m_str :m_str = NULL
           If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
           this.constructor(temp)
'Else
     
'End If
End Operator

   Operator WideString.+=(byref s  as  String ) 
    'If m_str<>NULL And Len(s)<>NULL Then
  Dim temp As String =*m_str
  temp=temp & s
  if m_str  Then  Delete [] m_str :m_str = NULL
           If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
           this.constructor(temp)
  ' Else
     
  ' End If
   End Operator
   
Operator WideString.&=(byref s As  String )
'If  m_str<>NULL And  Len(s)<>NULL Then
    Dim temp As String =*m_str
    temp=temp & s
    If m_str  Then  Delete [] m_str :m_str = NULL
             If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
             this.constructor(temp)
     ' Else
     
   '   End If
End Operator

   

   Operator WideString.+=(byref s  as  BSTR )
   ' If sysstringLen(m_bstr) Then
         Dim As BSTR mbstr
     VarBstrCat(m_bstr,s,@mbstr)
     if m_str  Then  Delete [] m_str :m_str = NULL
              If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
              this.constructor(mbstr)
'  Else
     
'  End If

   End Operator
   
  Operator WideString.&=(byref s  as  BSTR )
  ' If sysstringLen(m_bstr) Then
     Dim As BSTR mbstr
     VarBstrCat(m_bstr,s,@mbstr)
     if m_str  Then  Delete [] m_str :m_str = NULL
              If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
              this.constructor(mbstr)
' Else
     
' End If
 
  End Operator


 Operator + OverLoad ( byref s1 As  ZString Ptr , byref  s2 As  WideString ) As WideString
    Dim As String s =  *s1 + Cast(String,s2)
Operator= (s)
  End Operator

  Operator +( byref  s2 As  WideString, byref s1 As  ZString Ptr  ) As WideString
     Dim s As String= Cast(String,s2) + *s1
  Return s
  End Operator
 
 
  Operator +( byref s1 As  BSTR , byref  s2 As  WideString ) As WideString
Dim s As BStr
VarBstrCat(s1,Cast(BSTR,s2),@s)
Operator= s
  End Operator

  Operator +( byref  s2 As  WideString, byref s1 As  BSTR  ) As WideString
Dim s As BStr
VarBstrCat(Cast(BSTR,s2),s1,@s)
Operator= s
  End Operator
 
 
   
 
  Operator & OverLoad ( byref s1 As  ZString Ptr , byref  s2 As  WideString ) As WideString
Dim As String s =  *s1 & Cast(String,s2)
Return (s)
  End Operator

  Operator &( byref  s2 As  WideString, byref s1 As ZString Ptr  ) As WideString
  Dim s As String= Cast(String,s2) & *s1
  Return (s)
  End Operator
 
   
 Operator &( byref s1 As  BSTR , byref  s2 As  WideString ) As WideString
Dim s As BStr
VarBstrCat(s1,Cast(BSTR,s2),@s)
Return s
  End Operator

  Operator &( byref  s2 As  WideString, byref s1 As  BSTR  ) As WideString
Dim s As BStr
VarBstrCat(Cast(BSTR,s2),s1,@s)
Return s
  End Operator
 
 
 
 
Operator Not OverLoad ( ByRef lhs As WideString)  As  boolean
  Return (Cast(String,lhs) = "") And (Cast(BSTR,lhs) = NULL)
End Operator

 Operator = OverLoad  ( ByRef lhs As WideString, ByRef rhs As  ZString Ptr )  As  boolean
  Return (Cast(String,lhs) = *rhs)
 End Operator

Operator = OverLoad  (ByRef rhs As  ZString Ptr, ByRef lhs As WideString)  As  boolean
  Return (Cast(String,lhs) = *rhs)
End Operator

 Operator <> OverLoad ( ByRef lhs As WideString, ByRef rhs As  ZString Ptr ) As  boolean
  Return (Cast(String,lhs) <> *rhs)
 End Operator
 
 Operator <> OverLoad (ByRef rhs As  ZString Ptr , ByRef lhs As WideString) As  boolean
  Return (Cast(String,lhs) <> *rhs)
 End Operator
 
 Operator = ( ByRef lhs As WideString, ByRef rhs As  BSTR )  As  boolean
  Return (Cast(BSTR,lhs) = rhs)
 End Operator

Operator = (  ByRef rhs As  BSTR,ByRef lhs As WideString )  As  boolean
  Return (Cast(BSTR,lhs) = rhs)
End Operator

 Operator <> ( ByRef lhs As WideString, ByRef rhs As  BSTR ) As  boolean
  Return (Cast(BSTR,lhs) <> rhs)
 End Operator

Operator <> (ByRef rhs As  BSTR, ByRef lhs As WideString ) As  boolean
  Return (Cast(BSTR,lhs) <> rhs)
End Operator
testw.bas
Code: [Select]
#Define UNICODE   ' OR NOT
   
#Include Once "widestring.bi"

'Using  Afx.CBStrClass

#Define CBStr WideString

Dim cs As CBStr=CBStr("Une string dans Com String")
Dim cs2 As CBStr

Dim bs As BSTR =cs
Print cs
Print *Cast(WString Ptr,bs)
Print

cs2=cs
Print  cs2

Print
Print

Dim wz As WString*45="Une BSTR dans CCOMBSTR"
cs2=sysallocstring(@wz)
Print  cs2



' To append another BSTR:
 DIM b1 AS CBStr = "1st string"
 DIM b2 AS CBStr = " 2nd string"
 b1 +=b2
 '-or-
 'b1.Append **b2
 Print b1

 DIM bss AS CBStr = "Test string"
 PRINT bss '(notice the double indirection)


 DIM bs1 AS CBStr = "Test string 1"
 DIM wsz AS WSTRING * 250 = " - concatenated string"
 DIM bs2 AS CBStr
 bs2 = bs1 & wsz
 Print bs2
Sleep
Title: Re: CWindow RC06
Post by: José Roca on May 14, 2016, 05:12:46 PM
But with

Code: [Select]
Dim cs As CBStr=CBStr("Une string dans Com String")
Print cs

You're printing an ansi string, not an unicode one.

When you use Print cs, it calls this casting operator

Code: [Select]
Operator WideString.Cast() As String
  if m_str=NULL  Then
     '*m_str=*Cast(WString Ptr,m_bstr) ' mauvais car m_str non initialisé
     this.constructor(m_bstr)
     Return *m_str
  Else
     Return  *m_str
  End If
 End Operator
Title: Re: CWindow RC06
Post by: José Roca on May 15, 2016, 05:32:19 AM
Unicode is not just converting ansi to utf-16 adding a CHR(0) to any character. This will work with languages that use the ANSI Latin 1; Western European (Windows), but not for Russian, for example.

Using this code, where 1251 is the code page for ANSI Cyrillic; Cyrillic (Windows):

Code: [Select]
#define unicode
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CBStr.inc"

using Afx.CBStrClass

DIM s AS STRING = CHR(209, 229, 236, 229, 237)
DIM wsz AS WSTRING * 260
MultiByteToWidechar(1251, MB_PRECOMPOSED,STRPTR(s), -1, @wsz, SIZEOF(wsz))
DIM bs AS CBStr = wsz
MessageBoxW 0, **bs, "", MB_OK

print
print "press esc"
sleep

The message box correctly displays семен

Using your class:

Code: [Select]
#define unicode
#INCLUDE ONCE "windows.bi"
#Include Once "Afx/widestring.bi"

DIM s AS STRING = CHR(209, 229, 236, 229, 237)
DIM wsz AS WSTRING * 260
MultiByteToWidechar(1251, MB_PRECOMPOSED,STRPTR(s), -1, @wsz, SIZEOF(wsz))
DIM bs AS WideString = wsz
MessageBoxW 0, bs, "", MB_OK

print
print "press esc"
sleep

It displays ?????
Title: Re: CWindow RC06
Post by: José Roca on May 15, 2016, 08:14:25 AM
New version of CbStr.inc. I have removed the leaky concatenation operators and added support to set the code page, as the FreeBasic WSTR function has not a parameter to especify the code page to be used (it should).

We can use:

Code: [Select]
DIM bs AS CBStr = 1251  ' Sets the Russian code page
bs = CHR(209, 229, 236, 229, 237)
MessageBoxW 0, **bs, "", MB_OK

or

Code: [Select]
DIM bs AS CBStr = CBStr(CHR(209, 229, 236, 229, 237), 1251)
MessageBoxW 0, **bs, "", MB_OK

this one uses the Russian code page to do the translation but does not set it permanenty.

You can also use the CodePage property:

Code: [Select]
dim bs AS CBStr
bs.CodePage = 1251   ' Sets the Russian code page
bs = CHR(209, 229, 236, 229, 237)
MessageBoxW 0, **bs, "", MB_OK

We may need to set the code page because we can't use an additional parameter to sepecify it when using the Let operator to assign an ansi string.
Title: Re: CWindow RC06
Post by: aloberr on May 15, 2016, 09:56:08 AM
you are right but this is resolved by puting operator cast() byref as wstring
update one
widestring.bi
Code: [Select]
#Include Once "windows.bi"
#Include Once "win/ole2.bi"



type WideString
 Private:
    Public:
      m_bstr As BSTR
      m_str  As ZString Ptr 
  Public:
   Declare Constructor() 
   Declare Constructor(mbstr As BSTR )
   Declare Constructor(mstr As String )
   Declare Constructor(mstr As WString Ptr )
   Declare Constructor(byref mwstr As WideString )
   Declare Operator Let(mbstr As BSTR )
   Declare Operator Let(mstr As String )
   Declare Operator Let(mstr As WString Ptr )
   Declare Operator Let(ByRef mstr As WideString )
   Declare Operator +=(byref s  as  WideString ) 
Declare Operator &=(byref s  as  WideString ) 
   Declare Operator +=(byref s  as  String ) 
Declare Operator &=(byref s  as  String ) 
   Declare Operator +=(byref s  as  BSTR ) 
Declare Operator &=(byref s  as  BSTR )
   
   Declare Operator Cast() As BSTR
   Declare Operator Cast() As String
   Declare Operator Cast() ByRef As WString 
   Declare Destructor()
End Type

Constructor WideString()
   m_str=NULL
   m_bstr=NULL
End Constructor


Constructor WideString(mbstr As BSTR )
    if (0=mbstr) Then
    m_str = NULL
    Else
    Dim s As String=*Cast(WString Ptr,mbstr)
      m_str=New Byte[Len(s)+1]
      *m_str= s
    End If
    m_bstr=mbstr
End Constructor

Constructor WideString(mstr As String )
    if Len(mstr)=NULL Then
    m_str = NULL
    m_bstr=NULL
    Else
      m_str=New Byte[Len(mstr)+1]
      *m_str= mstr
      m_bstr=SysAllocString(WStr(mstr))
    End if
End Constructor

 Constructor WideString(mstr As WString Ptr )
     this.constructor(Cast(BSTR,mstr))
 End Constructor

Constructor WideString(byref mwstr As WideString )
  'if mwstr.m_str  Then  m_str  = mwstr.m_str       ' erratique  m_str non instancié
  'if mwstr.m_bstr Then  m_bstr = mwstr.m_bstr
 
  if mwstr.m_str  Then 
    this.constructor(*mwstr.m_str)
    Exit Constructor
  Else
  if mwstr.m_bstr Then  this.constructor(mwstr.m_bstr)
 
  EndIf
   
End Constructor

Operator WideString.let(mbstr As BSTR )
    if m_str  Then  Delete [] m_str :m_str = NULL
    if m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
    this.constructor(mbstr)
End Operator

Operator WideString.let(mstr As String )
   if m_str  Then  Delete [] m_str :m_str = NULL
   if m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
    this.constructor(mstr)
End Operator

Operator WideString.Let(mstr As WString Ptr )
this=(Cast(BSTR,mstr))
End Operator

Operator WideString.let(byref mwstr As WideString )
   if m_str  Then  Delete [] m_str :m_str = NULL
   if m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
    this.constructor(mwstr)
End Operator

Operator WideString.Cast() As BSTR
if m_bstr=NULL  Then
   Return SysAllocString(WStr(*m_str)) 
Else
   Return m_bstr
End If   
End Operator

 Operator WideString.Cast() As String
  if m_str=NULL  Then
     '*m_str=*Cast(WString Ptr,m_bstr) ' pas bon car m_str non initialisé
     this.constructor(m_bstr)
     Return *m_str
  Else
     Return  *m_str
  End If
 End Operator
   
 
 Operator WideString.Cast() ByRef As WString 
  if m_str=NULL  Then
       this.constructor(m_bstr)
       Return  peek(WString,m_str)
  Else
      Return  peek(WString,m_str)
  End If   
 End Operator
 
  Destructor WideString()
    If m_str Then Delete [] m_str : m_str=NULL
    if m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
 End Destructor     



Operator WideString.+=(byref s As  WideString ) 
'If Len(*m_str) And Len(*s.m_str) Then    ' on ne peut pas ajouter un " " /
     Dim temp As String =*m_str
  temp=temp & *s.m_str
  if m_str  Then  Delete [] m_str :m_str = NULL
           If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
           this.constructor(temp)   
     
'Else

'End If
End Operator

Operator WideString.&=(byref s  as  WideString ) 
'If Len(*m_str) And Len(*s.m_str) Then
  Dim temp As String =*m_str
  temp=temp & *s.m_str
  if m_str  Then  Delete [] m_str :m_str = NULL
           If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
           this.constructor(temp)
'Else
     
'End If
End Operator

   Operator WideString.+=(byref s  as  String ) 
    'If m_str<>NULL And Len(s)<>NULL Then
  Dim temp As String =*m_str
  temp=temp & s
  if m_str  Then  Delete [] m_str :m_str = NULL
           If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
           this.constructor(temp)
  ' Else
     
  ' End If
   End Operator
   
Operator WideString.&=(byref s As  String )
'If  m_str<>NULL And  Len(s)<>NULL Then
    Dim temp As String =*m_str
    temp=temp & s
    If m_str  Then  Delete [] m_str :m_str = NULL
             If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
             this.constructor(temp)
     ' Else
     
   '   End If
End Operator

   

   Operator WideString.+=(byref s  as  BSTR )
   ' If sysstringLen(m_bstr) Then
         Dim As BSTR mbstr
     VarBstrCat(m_bstr,s,@mbstr)
     if m_str  Then  Delete [] m_str :m_str = NULL
              If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
              this.constructor(mbstr)
'  Else
     
'  End If

   End Operator
   
  Operator WideString.&=(byref s  as  BSTR )
  ' If sysstringLen(m_bstr) Then
     Dim As BSTR mbstr
     VarBstrCat(m_bstr,s,@mbstr)
     if m_str  Then  Delete [] m_str :m_str = NULL
              If m_bstr  Then  sysfreestring(m_bstr) :m_bstr = NULL
              this.constructor(mbstr)
' Else
     
' End If
 
  End Operator


 Operator + OverLoad ( byref s1 As  ZString Ptr , byref  s2 As  WideString ) As WideString
    Dim As String s =  *s1 + Cast(String,s2)
Operator= (s)
  End Operator

  Operator +( byref  s2 As  WideString, byref s1 As  ZString Ptr  ) As WideString
     Dim s As String= Cast(String,s2) + *s1
  Return s
  End Operator
 
 
  Operator +( byref s1 As  BSTR , byref  s2 As  WideString ) As WideString
Dim s As BStr
VarBstrCat(s1,Cast(BSTR,s2),@s)
Operator= s
  End Operator

  Operator +( byref  s2 As  WideString, byref s1 As  BSTR  ) As WideString
Dim s As BStr
VarBstrCat(Cast(BSTR,s2),s1,@s)
Operator= s
  End Operator
 
 
   
 
  Operator & OverLoad ( byref s1 As  ZString Ptr , byref  s2 As  WideString ) As WideString
Dim As String s =  *s1 & Cast(String,s2)
Return (s)
  End Operator

  Operator &( byref  s2 As  WideString, byref s1 As ZString Ptr  ) As WideString
  Dim s As String= Cast(String,s2) & *s1
  Return (s)
  End Operator
 
   
 Operator &( byref s1 As  BSTR , byref  s2 As  WideString ) As WideString
Dim s As BStr
VarBstrCat(s1,Cast(BSTR,s2),@s)
Return s
  End Operator

  Operator &( byref  s2 As  WideString, byref s1 As  BSTR  ) As WideString
Dim s As BStr
VarBstrCat(Cast(BSTR,s2),s1,@s)
Return s
  End Operator
 
 
 
 
Operator Not OverLoad ( ByRef lhs As WideString)  As  boolean
  Return (Cast(String,lhs) = "") And (Cast(BSTR,lhs) = NULL)
End Operator

 Operator = OverLoad  ( ByRef lhs As WideString, ByRef rhs As  ZString Ptr )  As  boolean
  Return (Cast(String,lhs) = *rhs)
 End Operator

Operator = OverLoad  (ByRef rhs As  ZString Ptr, ByRef lhs As WideString)  As  boolean
  Return (Cast(String,lhs) = *rhs)
End Operator

 Operator <> OverLoad ( ByRef lhs As WideString, ByRef rhs As  ZString Ptr ) As  boolean
  Return (Cast(String,lhs) <> *rhs)
 End Operator
 
 Operator <> OverLoad (ByRef rhs As  ZString Ptr , ByRef lhs As WideString) As  boolean
  Return (Cast(String,lhs) <> *rhs)
 End Operator
 
 Operator = ( ByRef lhs As WideString, ByRef rhs As  BSTR )  As  boolean
  Return (Cast(BSTR,lhs) = rhs)
 End Operator

Operator = (  ByRef rhs As  BSTR,ByRef lhs As WideString )  As  boolean
  Return (Cast(BSTR,lhs) = rhs)
End Operator

 Operator <> ( ByRef lhs As WideString, ByRef rhs As  BSTR ) As  boolean
  Return (Cast(BSTR,lhs) <> rhs)
 End Operator

Operator <> (ByRef rhs As  BSTR, ByRef lhs As WideString ) As  boolean
  Return (Cast(BSTR,lhs) <> rhs)
End Operator
Title: Re: CWindow RC06
Post by: José Roca on May 15, 2016, 10:07:04 AM
If I use that change, the program GPFs when it ends.

Code: [Select]
#define unicode
#INCLUDE ONCE "windows.bi"
#Include Once "Afx/widestring.bi"

DIM s AS STRING = CHR(209, 229, 236, 229, 237)
DIM wsz AS WSTRING * 260
MultiByteToWidechar(1251, MB_PRECOMPOSED, STRPTR(s), -1, @wsz, SIZEOF(wsz))
DIM bs AS WideString = wsz
MessageBoxW 0, bs, "", MB_OK
Title: Re: CWindow RC06
Post by: José Roca on May 15, 2016, 10:12:49 AM
I have rewritten the AfxUcode/Acode functions:

Code: [Select]
' ========================================================================================
' Translates ansi bytes to unicode bytes
' ========================================================================================
FUNCTION AfxUcode (BYREF ansiStr AS CONST STRING, BYVAL nCodePage AS LONG = 0) AS BSTR
   DIM pbstr AS BSTR = SysAllocString(WSTR(ansiStr))
   IF nCodePage <> 0 THEN MultiByteToWideChar(nCodePage, MB_PRECOMPOSED, STRPTR(ansiStr), -1, pbstr, LEN(ansiStr) * 2)
   FUNCTION = pbstr
END FUNCTION
' ========================================================================================

' ========================================================================================
' Translates unicode bytes to ansi bytes
' ========================================================================================
FUNCTION AfxAcode (BYVAL pbstr AS BSTR, BYVAL nCodePage AS LONG = 0) AS STRING
   DIM ansiStr AS STRING = SPACE(SysStringLen(pbstr))
   DIM hr AS LONG = WideCharToMultiByte(nCodePage, 0, pbstr, SysStringLen(pbstr), STRPTR(ansiStr), LEN(ansiStr), NULL, NULL)
   FUNCTION = ansiStr
END FUNCTION
' ========================================================================================

this allows to use the assignment operator without setting the code page first:

Code: [Select]
Dim bs AS CBStr
bs = AfxUcode(CHR(209, 229, 236, 229, 237), 1251)
MessageBoxW 0, **bs, "", MB_OK

Of course, if WSTR had an optional CodePage parameter, we could do this: bs = WSTR(CHR(209, 229, 236, 229, 237), 1251). In PowerBASIC, that optional CodePage parameter was added by my suggestion.
Title: Re: CWindow RC06
Post by: aloberr on May 15, 2016, 10:34:42 AM
Quote
If I use that change, the program GPFs when it ends.
curious operator cast() byref as wstring was not the only change
Title: Re: CWindow RC06
Post by: José Roca on May 15, 2016, 10:40:45 AM
I have copied all the code you have posted in #55. It GPFs after I click "OK" in the message box. Test it by yourself.
Title: Re: CWindow RC06
Post by: José Roca on May 15, 2016, 11:05:51 AM
But when I use

Code: [Select]
#define unicode
#INCLUDE ONCE "windows.bi"
#Include Once "Afx/widestring.bi"

DIM s AS STRING = CHR(209, 229, 236, 229, 237)
DIM wsz AS WSTRING * 260
MultiByteToWidechar(1251, MB_PRECOMPOSED, STRPTR(s), -1, @wsz, SIZEOF(wsz))
DIM bs AS WideString = wsz
MessageBoxW 0, bs, "", MB_OK

the opeator that is being called is not the one with BYREF AS WSTRING, but

Code: [Select]
Operator WideString.Cast() As BSTR
if m_bstr=NULL  Then
   Return SysAllocString(WStr(*m_str))
Else
   Return m_bstr
End If
End Operator
Title: Re: CWindow RC06
Post by: José Roca on May 15, 2016, 11:26:52 AM
If I add this operator to my class, it works

Code: [Select]
' ========================================================================================
' Returns a pointer to the BSTR
' ========================================================================================
OPERATOR CBStr.CAST () BYREF AS WSTRING
'   OPERATOR =  PEEK(WSTRING, m_bstr)
   OPERATOR =  *CAST(WSTRING PTR, m_bstr)
END OPERATOR
' ========================================================================================
Title: Re: CWindow RC06
Post by: José Roca on May 15, 2016, 11:36:07 AM
I'm very interested in that BYREF thing, because

Code: [Select]
FUNCTION Foo () AS BSTR
   DIM bstrHandle AS BSTR
   bstrHandle = SysAllocString("Test string")
   FUNCTION = bstrHandle
END FUNCTION

DIM bs AS CBSTR
bs = Foo
' we can use
print bs
' instead of
'print *bs.Handle
'-or-
'print **bs
' that also work
Title: Re: CWindow RC06
Post by: José Roca on May 15, 2016, 12:23:22 PM
This is a version of CBStr.inc with the BYREF AS WSTRING cast operator added.
See attachment.
Title: Re: CWindow RC06
Post by: José Roca on May 15, 2016, 12:31:30 PM
Interesting test:

Code: [Select]
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/AfxWin.inc"
#INCLUDE ONCE "Afx/CBStr.inc"

using Afx.CBStrClass

DIM bs1 AS CBStr = "First"
DIM bs2 AS CBStr = "Second"
print bs1, bs2
print bs1 & bs2
print **bs1 & " --- " & **bs2   ' this works
'print bs1 & " --- " & bs2   ' this does not work; type mismatch error
print bs1 & " --- " & **bs2   ' this works
'print **bs1 & " --- " & bs2   ' this does not work; type mismatch error
dim s as string
s = bs1 & bs2
print s

print "press esc"
sleep
Title: Re: CWindow RC06
Post by: José Roca on May 17, 2016, 10:36:02 AM
I have modified the functions that load icons from file or resource to allow to pass a dimming percentage and/or gray escale conversion. This way, with only a set of icons we can buid both the normal imagelist and the disabled one, e.g.

Code: [Select]
   ' // Create an image list for the toolbar
   DIM hImageListNormal AS HIMAGELIST
   DIM cx AS LONG = 16 * pWindow->DPI \ 96
   hImageListNormal = ImageList_Create(cx, cx, ILC_COLOR32 OR ILC_MASK, 4, 0)
   IF hImageListNormal THEN
      ImageList_ReplaceIcon(hImageListNormal, -1, AfxGdipImageFromResEx(hInst, "IDI_NEW_32"))
      ImageList_ReplaceIcon(hImageListNormal, -1, AfxGdipImageFromResEx(hInst, "IDI_OPEN_32"))
      ImageList_ReplaceIcon(hImageListNormal, -1, AfxGdipImageFromResEx(hInst, "IDI_SAVE_32"))
   END IF
   SendMessageW hToolBar, TB_SETIMAGELIST, 0, CAST(LPARAM, hImageListNormal)

   ' // Create the disabled image list for the toolbar
   DIM hImageListDisabled AS HIMAGELIST
   hImageListDisabled = ImageList_Create(cx, cx, ILC_COLOR32 OR ILC_MASK, 4, 0)
   IF hImageListDisabled THEN
      ImageList_ReplaceIcon(hImageListNormal, -1, AfxGdipImageFromResEx(hInst, "IDI_NEW_32", 60, TRUE))
      ImageList_ReplaceIcon(hImageListNormal, -1, AfxGdipImageFromResEx(hInst, "IDI_OPEN_32", 60, TRUE))
      ImageList_ReplaceIcon(hImageListNormal, -1, AfxGdipImageFromResEx(hInst, "IDI_SAVE_32", 60, TRUE))
   END IF
   SendMessageW hToolBar, TB_SETDISABLEDIMAGELIST, 0, CAST(LPARAM, hImageListDisabled)

With only a set of icons we can display them with the appropriate size for the DPI chosen by the user, both in toolbars and in menus.

It's time to throw to the recycle bin these old bitmaps with a pink background and without alpha channel that we used in the past.
Title: Re: CWindow RC06
Post by: aloberr on May 17, 2016, 02:48:53 PM
your example CWindow with a rebar control don't work anymore
Title: Re: CWindow RC06
Post by: José Roca on May 17, 2016, 02:59:25 PM
This is because I have removed the auxiliary functions from CWindow.inc. What I'm posting is testing code.

Add the functions to the example and it will compile:

Code: [Select]
' ========================================================================================
' Adds a button to a toolbar.
' Minimum operating systems Windows NT 3.51, Windows 95
' ========================================================================================
PRIVATE FUNCTION AfxToolbarAddButtonW (BYVAL hToolBar AS HWND, BYVAL idxBitmap AS LONG, BYVAL idCommand AS LONG, _
BYVAL fsState AS UBYTE = 0, BYVAL fsStyle AS UBYTE = 0, BYVAL dwData AS DWORD_PTR = 0, BYVAL pwszText AS WSTRING PTR = NULL) AS LRESULT
   IF fsState = 0 THEN fsState = TBSTATE_ENABLED
   DIM idxString AS INT_PTR
   IF pwszText <> NULL THEN idxString = IIF(LEN(*pwszText) = 0, -1, CAST(INT_PTR, pwszText))
#ifdef __FB_64BIT__
   DIM tbb AS TBBUTTON = (idxBitmap, idCommand, fsState, fsStyle, {0, 0, 0, 0, 0, 0}, dwData, idxString)
#else
   DIM tbb AS TBBUTTON = (idxBitmap, idCommand, fsState, fsStyle, {0, 0}, dwData, idxString)
#endif
   FUNCTION = SendMessageW(hToolBar, TB_ADDBUTTONSW, 1, CAST(LPARAM, @tbb))
END FUNCTION
' ========================================================================================

' ========================================================================================
' Adds a separator to a toolbar.
' Minimum operating systems Windows NT 3.51, Windows 95
' ========================================================================================
PRIVATE FUNCTION AfxToolbarAddSeparatorW (BYVAL hToolBar AS HWND, BYVAL nWidth AS LONG = 0) AS LRESULT
#ifdef __FB_64BIT__
   DIM tbb AS TBBUTTON = (nWidth, 0, TBSTATE_ENABLED, TBSTYLE_SEP, {0, 0, 0, 0, 0, 0}, 0, -1)
#else
   DIM tbb AS TBBUTTON = (nWidth, 0, TBSTATE_ENABLED, TBSTYLE_SEP, {0, 0}, 0, -1)
#endif
   FUNCTION = SendMessageW(hToolBar, TB_ADDBUTTONSW, 1, CAST(LPARAM, @tbb))
END FUNCTION
' ========================================================================================
Title: Re: CWindow RC06
Post by: José Roca on May 17, 2016, 03:02:15 PM
BTW do you know why this compiles

Code: [Select]
DIM tbb AS TBBUTTON = (idxBitmap, idCommand, fsState, fsStyle, {0, 0, 0, 0, 0, 0}, dwData, idxString)

but this one don't

Code: [Select]
DIM tbb AS TBBUTTON
tbb = (idxBitmap, idCommand, fsState, fsStyle, {0, 0, 0, 0, 0, 0}, dwData, idxString)
Title: Re: CWindow RC06
Post by: aloberr on May 17, 2016, 03:19:24 PM
CWindow with a rebar control work with Cwindow_RC02 but don't wit  Cwindow_RC06
Title: Re: CWindow RC06
Post by: José Roca on May 17, 2016, 03:28:48 PM
This one will work:

Code: [Select]
' ########################################################################################
' Microsoft Windows
' File: CW_COMMCTRL_Rebar.fbtpl
' Contents: CWindow with a rebar 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 "windows.bi"
#INCLUDE ONCE "Afx/CWindow.inc"

USING Afx.CWindowClass

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)

CONST IDC_TOOLBAR = 1001
CONST IDC_CBBOX = 1002
CONST IDC_REBAR = 1003
enum
   IDM_CUT = 28000
   IDM_COPY, IDM_PASTE, IDM_UNDO, IDM_REDOW, IDM_DELETE, IDM_FILENEW, IDM_FILEOPEN
   IDM_FILESAVE, IDM_PRINTPRE, IDM_PROPERTIES, IDM_HELP, IDM_FIND, IDM_REPLACE, IDM_PRINT
end enum

' ========================================================================================
' Adds a button to a toolbar.
' Minimum operating systems Windows NT 3.51, Windows 95
' ========================================================================================
PRIVATE FUNCTION AfxToolbar_AddButton (BYVAL hToolBar AS HWND, BYVAL idxBitmap AS LONG, BYVAL idCommand AS LONG, _
BYVAL fsState AS UBYTE = 0, BYVAL fsStyle AS UBYTE = 0, BYVAL dwData AS DWORD_PTR = 0, BYVAL pwszText AS WSTRING PTR = NULL) AS LRESULT
   IF fsState = 0 THEN fsState = TBSTATE_ENABLED
   DIM idxString AS INT_PTR
   IF pwszText <> NULL THEN idxString = IIF(LEN(*pwszText) = 0, -1, CAST(INT_PTR, pwszText))
#ifdef __FB_64BIT__
   DIM tbb AS TBBUTTON = (idxBitmap, idCommand, fsState, fsStyle, {0, 0, 0, 0, 0, 0}, dwData, idxString)
#else
   DIM tbb AS TBBUTTON = (idxBitmap, idCommand, fsState, fsStyle, {0, 0}, dwData, idxString)
#endif
   FUNCTION = SendMessageW(hToolBar, TB_ADDBUTTONSW, 1, CAST(LPARAM, @tbb))
END FUNCTION
' ========================================================================================

' ========================================================================================
' Adds a separator to a toolbar.
' Minimum operating systems Windows NT 3.51, Windows 95
' ========================================================================================
PRIVATE FUNCTION AfxToolbar_AddSeparator (BYVAL hToolBar AS HWND, BYVAL nWidth AS LONG = 0) AS LRESULT
#ifdef __FB_64BIT__
   DIM tbb AS TBBUTTON = (nWidth, 0, TBSTATE_ENABLED, TBSTYLE_SEP, {0, 0, 0, 0, 0, 0}, 0, -1)
#else
   DIM tbb AS TBBUTTON = (nWidth, 0, TBSTATE_ENABLED, TBSTYLE_SEP, {0, 0}, 0, -1)
#endif
   FUNCTION = SendMessageW(hToolBar, TB_ADDBUTTONSW, 1, CAST(LPARAM, @tbb))
END FUNCTION
' ========================================================================================

' ========================================================================================
' Create the toolbar
' ========================================================================================
FUNCTION CreateToolbar (BYVAL pWindow AS CWindow PTR) AS HWND

   ' // Add a tooolbar
   DIM hToolBar AS HWND = pWindow->AddControl("Toolbar", pWindow->hWindow, IDC_TOOLBAR, "", 0, 0, 0, 0, _
      WS_CHILD OR WS_VISIBLE OR TBSTYLE_TOOLTIPS OR TBSTYLE_FLAT OR CCS_NODIVIDER OR CCS_NORESIZE OR CCS_NOPARENTALIGN)
   ' // Allow drop down arrows
   SendMessageW hToolBar, TB_SETEXTENDEDSTYLE, 0, TBSTYLE_EX_DRAWDDARROWS
   ' // Add a bitmap with the button images
   DIM ttbab AS TBADDBITMAP
   ttbab.hInst = HINST_COMMCTRL
   IF AfxIsProcessDPIAware THEN
      ttbab.nId = IDB_STD_LARGE_COLOR
   ELSE
      ttbab.nId = IDB_STD_SMALL_COLOR
   END IF
   SendMessageW(hToolBar, TB_ADDBITMAP, 0, CAST(LPARAM, @ttbab))
   ' // Add buttons to the toolbar
   AfxToolbar_AddButton hToolBar, STD_CUT, IDM_CUT
   AfxToolbar_AddButton hToolBar, STD_COPY, IDM_COPY
   AfxToolbar_AddButton hToolBar, STD_PASTE, IDM_PASTE
   AfxToolbar_AddButton hToolBar, STD_DELETE, IDM_DELETE
   AfxToolbar_AddSeparator hToolBar
   AfxToolbar_AddButton hToolBar, STD_UNDO, IDM_UNDO
   AfxToolbar_AddButton hToolBar, STD_REDOW, IDM_REDOW
   AfxToolbar_AddSeparator hToolBar
   AfxToolbar_AddButton hToolBar, STD_FILENEW, IDM_FILENEW, 0, BTNS_DROPDOWN
   AfxToolbar_AddButton hToolBar, STD_FILEOPEN, IDM_FILEOPEN
   AfxToolbar_AddButton hToolBar, STD_FILESAVE, IDM_FILESAVE
   AfxToolbar_AddButton hToolBar, STD_PRINTPRE, IDM_PRINTPRE
   AfxToolbar_AddSeparator hToolBar
   AfxToolbar_AddButton hToolBar, STD_FIND, IDM_FIND
   AfxToolbar_AddButton hToolBar, STD_REPLACE, IDM_REPLACE
   AfxToolbar_AddSeparator hToolBar
   AfxToolbar_AddButton hToolBar, STD_PROPERTIES, IDM_PROPERTIES
   AfxToolbar_AddButton hToolBar, STD_PRINT, IDM_PRINT
   AfxToolbar_AddSeparator hToolBar
   AfxToolbar_AddButton hToolBar, STD_HELP, IDM_HELP
   ' // Size the toolbar
   SendMessageW hToolBar, TB_AUTOSIZE, 0, 0
   ' // Return the toolbar handle
   FUNCTION = hToolbar

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

' ========================================================================================
' 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
   DIM rc AS RECT

   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 IDM_CUT   ' etc.
'               MessageBoxW hwnd, "You have clicked the Cut button", "Toolbar", MB_OK
'               EXIT FUNCTION
         END SELECT

      CASE WM_NOTIFY
         ' -------------------------------------------------------
         ' Notification messages are handled here.
         ' The TTN_GETDISPINFO message is sent by a ToolTip control
         ' to retrieve information needed to display a ToolTip window.
         ' ------------------------------------------------------
         DIM ptnmhdr AS NMHDR PTR              ' // Information about a notification message
         DIM ptttdi AS NMTTDISPINFOW PTR       ' // Tooltip notification message information
         DIM wszTooltipText AS WSTRING * 260   ' // Tooltip text

         ptnmhdr = CAST(NMHDR PTR, lParam)
         SELECT CASE ptnmhdr->code
            ' // The height of the rebar has changed
            CASE RBN_HEIGHTCHANGE
               ' // Get the coordinates of the client area
               GetClientRect hwnd, @rc
               ' // Send a WM_SIZE message to resize the controls
               SendMessageW hwnd, WM_SIZE, SIZE_RESTORED, MAKELONG(rc.Right - rc.Left, rc.Bottom - rc.Top)
            ' // Toolbar tooltips
            CASE TTN_GETDISPINFO
               ptttdi = CAST(NMTTDISPINFOW PTR, lParam)
               ptttdi->hinst = NULL
               wszTooltipText = ""
               SELECT CASE ptttdi->hdr.hwndFrom
                  CASE SendMessageW(GetDlgItem(GetDlgItem(hwnd, IDC_REBAR), IDC_TOOLBAR), TB_GETTOOLTIPS, 0, 0)
                     SELECT CASE ptttdi->hdr.idFrom
                        CASE IDM_CUT        : wszTooltipText = "Cut"
                        CASE IDM_COPY       : wszTooltipText = "Copy"
                        CASE IDM_PASTE      : wszTooltipText = "Paste"
                        CASE IDM_UNDO       : wszTooltipText = "Undo"
                        CASE IDM_REDOW      : wszTooltipText = "Redo"
                        CASE IDM_DELETE     : wszTooltipText = "Delete"
                        CASE IDM_FILENEW    : wszTooltipText = "File New"
                        CASE IDM_FILEOPEN   : wszTooltipText = "File Open"
                        CASE IDM_FILESAVE   : wszTooltipText = "File Save"
                        CASE IDM_PRINTPRE   : wszTooltipText = "Print Preview"
                        CASE IDM_PROPERTIES : wszTooltipText = "Properties"
                        CASE IDM_HELP       : wszTooltipText = "Help"
                        CASE IDM_FIND       : wszTooltipText = "Find"
                        CASE IDM_REPLACE    : wszTooltipText = "Replace"
                        CASE IDM_PRINT      : wszTooltipText = "Print"
                     END SELECT
                     IF LEN(wszTooltipText) THEN ptttdi->lpszText = @wszTooltipText
               END SELECT

         CASE TBN_DROPDOWN
            DIM ptbn AS TBNOTIFY PTR = CAST(TBNOTIFY PTR, lParam)
            SELECT CASE ptbn->iItem
               CASE IDM_FILENEW
                  DIM rc AS RECT
                  SendMessageW(ptbn->hdr.hwndFrom, TB_GETRECT, ptbn->iItem, CAST(LPARAM, @rc))
                  MapWindowPoints(ptbn->hdr.hwndFrom, HWND_DESKTOP, CAsT(LPPOINT, @rc), 2)
                  DIM hPopupMenu AS HMENU = CreatePopUpMenu
                  AppendMenuW hPopupMenu, MF_ENABLED, 10001, "Option 1"
                  AppendMenuW hPopupMenu, MF_ENABLED, 10002, "Option 2"
                  AppendMenuW hPopupMenu, MF_ENABLED, 10003, "Option 3"
                  AppendMenuW hPopupMenu, MF_ENABLED, 10004, "Option 4"
                  AppendMenuW hPopupMenu, MF_ENABLED, 10005, "Option 5"
                  TrackPopupMenu(hPopupMenu, 0, rc.Left, rc.Bottom, 0, hwnd, NULL)
                  DestroyMenu hPopupMenu
            END SELECT

         END SELECT

      CASE WM_SIZE
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Update the size and position of the Rebar control
            SendMessageW GetDlgItem(hwnd, IDC_REBAR), WM_SIZE, wParam, lParam
            ' // Resize the button
            pWindow = CAST(CWindow PTR, GetWindowLongPtr(hwnd, 0))
            pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 95, pWindow->ClientHeight - 35, 75, 23, CTRUE
            EXIT FUNCTION
         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

   ' // Set process DPI aware
   AfxSetProcessDPIAware

   DIM pWindow AS CWindow
   pWindow.Create(NULL, "CWindow with a rebar", @WndProc)
   ' // Disable background erasing
   pWindow.ClassStyle = CS_DBLCLKS
   ' // Set the client size
   pWindow.SetClientSize(600, 250)
   ' // Center the window
   pWindow.Center

   ' // Add a button
   DIM hButton AS HWND = pWindow.AddControl("Button", pWindow.hWindow, IDCANCEL, "&Close")

   ' // Create a rebar control
   DIM hRebar AS HWND = pWindow.AddControl("Rebar", pWindow.hWindow, IDC_REBAR)

   ' Create the toolbar
   DIM hToolbar AS HWND = CreateToolbar(@pWindow)

   ' // Add the band containing the toolbar control to the rebar
   ' // The size of the REBARBANDINFOW is different in Vista/Windows 7
   DIM rc AS RECT, wszText AS WSTRING * 260
   DIM rbbi AS REBARBANDINFOW
   IF AfxWindowsVersion >= 600 AND AfxComCtlVersion >= 600 THEN
      rbbi.cbSize  = REBARBANDINFO_V6_SIZE
   ELSE
      rbbi.cbSize  = REBARBANDINFO_V3_SIZE
   END IF

   ' // Insert the toolbar in the rebar control
   rbbi.fMask      = RBBIM_STYLE OR RBBIM_CHILD OR RBBIM_CHILDSIZE OR _
                     RBBIM_SIZE OR RBBIM_ID OR RBBIM_IDEALSIZE OR RBBIM_TEXT
   rbbi.fStyle     = RBBS_CHILDEDGE
   rbbi.hwndChild  = hToolbar
   rbbi.cxMinChild = 270 * pWindow.rxRatio
   rbbi.cyMinChild = HIWORD(SendMessageW(hToolBar, TB_GETBUTTONSIZE, 0, 0))
   rbbi.cx         = 270 * pWindow.rxRatio
   rbbi.cxIdeal    = 270 * pWindow.rxRatio
   wszText = "Toolbar"
   rbbi.lpText = @wszText
   '// Insert band into rebar
   SendMessageW hRebar, RB_INSERTBANDW, -1, CAST(LPARAM, @rbbi)

   ' // Insert a combobox in the rebar control
   DIM hCbBox AS HWND = pWindow.AddControl("ComboBox", pWindow.hWindow, IDC_CBBOX, "", 0, 0, 0, 50 * pWindow.rxRatio)
   GetWindowRect hCbBox, @rc
   rbbi.fMask      = RBBIM_STYLE OR RBBIM_CHILD OR RBBIM_CHILDSIZE OR _
                     RBBIM_SIZE OR RBBIM_ID OR RBBIM_IDEALSIZE OR RBBIM_TEXT
   rbbi.fStyle     = RBBS_FIXEDSIZE OR RBBS_CHILDEDGE
   rbbi.hwndChild  = hCbBox
   rbbi.cxMinChild = 200 * pWindow.rxRatio
   rbbi.cyMinChild = rc.Bottom - rc.Top
   rbbi.cx         = 200 * pWindow.rxRatio
   rbbi.cxIdeal    = 200 * pWindow.rxRatio
   wszText = "Combobox"
   rbbi.lpText = @wszText
   '// Insert band into rebar
   SendMessageW hRebar, RB_INSERTBANDW, -1, CAST(LPARAM, @rbbi)

   

   ' // Process event messages
   FUNCTION = pWindow.DoEvents(nCmdShow)

END FUNCTION
' ========================================================================================
Title: Re: CWindow RC06
Post by: José Roca on May 22, 2016, 06:03:32 PM
Hi Paul,

Good news. I have succesfully translated my graphic control to FreeBasic.
Title: Re: CWindow RC06
Post by: Paul Squires on May 22, 2016, 06:37:21 PM
That's awesome Jose!

I had also converted my version of the image control to FreeBasic: http://www.planetsquires.com/protect/forum/index.php?topic=3701.0