Print

Please login or register.
1 Hour 1 Day 1 Week 1 Month Forever
Login with username, password and session length

[José Roca]

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


[José Roca]

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
' ========================================================================================


[José Roca]

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


[José Roca]

This is a version of CBStr.inc with the BYREF AS WSTRING cast operator added.
See attachment.

[José Roca]

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


[José Roca]

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.

[aloberr]

your example CWindow with a rebar control don't work anymore

[José Roca]

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
' ========================================================================================


[José Roca]

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)


[aloberr]

CWindow with a rebar control work with Cwindow_RC02 but don't wit  Cwindow_RC06

[José Roca]

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
' ========================================================================================


[José Roca]

Hi Paul,

Good news. I have succesfully translated my graphic control to FreeBasic.

[Paul Squires]

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