REBAR problem with XP

[Peter Weis]

The Rebar in the code example below works fine with Windows 7.
It does NOT work with Windows XP.

Here is an compilable example:
In Windows 7, it works.
In Windows XP I can not see any REBAR.

I know this is an very advanced topic. Does anybody here know about this stuff?

Code Select Expand


#PBFORMS CREATED V2.01
'------------------------------------------------------------------------------
' The first line in this file is a PB/Forms metastatement.
' It should ALWAYS be the first line of the file. Other
' PB/Forms metastatements are placed at the beginning and
' end of "Named Blocks" of code that should be edited
' with PBForms only. Do not manually edit or delete these
' metastatements or PB/Forms will not be able to reread
' the file correctly.  See the PB/Forms documentation for
' more information.
' Named blocks begin like this:    #PBFORMS BEGIN ...
' Named blocks end like this:      #PBFORMS END ...
' Other PB/Forms metastatements such as:
'     #PBFORMS DECLARATIONS
' are used by PB/Forms to insert additional code.
' Feel free to make changes anywhere else in the file.
'------------------------------------------------------------------------------


#COMPILE EXE
#DIM ALL

%Unicode = 1


'------------------------------------------------------------------------------
'   ** Includes **
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#RESOURCE "test8.pbr"
#INCLUDE ONCE "WIN32API.INC"
#INCLUDE ONCE "COMMCTRL.INC"
#INCLUDE ONCE "PBForms.INC"
#PBFORMS END INCLUDES



%ID_REBAR = 200
%IDC_COMBOBOX_DRIVE_SELECT  = 500
%ID_TOOLBAR  = 501

TYPE AppParametersTYPE
  sAppPath     AS STRING * %MAX_PATH      '= Applications Path.
  sAppIniPath  AS STRING * %MAX_PATH      '= Applications INI File Path.
  sAppDbPath   AS STRING * %MAX_PATH      '= Applications Database Path.
  sAppIdxPath  AS STRING * %MAX_PATH      '= Applications Database Index Path.
  sbDateFmt    AS LONG                    '= StatusBar Date Format.
  sbTimeFmt    AS LONG                    '= StatusBar Time Format.
  rbRowCount   AS LONG                    '= Rebar Number Of Rows.
  rbBandCount  AS LONG                    '= Rebar Number Of Bands.
  rbBand0      AS LONG                    '= Rebar Band 0 If Moved.
  rbBand1      AS LONG                    '= Rebar Band 1 If Moved.
  sbTimePart   AS LONG                    '= Statusbar Time Part (Panel) Number.
  sbDatePart   AS LONG                    '= StatusBar Date Part (Panel) Number.
END TYPE


GLOBAL hRebar AS DWORD
GLOBAL udtAp AS AppParametersTYPE
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Constants **
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%Unicode                   =   1    '*
%ID_REBAR                  = 200    '*
%IDC_COMBOBOX_DRIVE_SELECT = 500    '*
%ID_TOOLBAR                = 501    '*
%IDD_DIALOG1               = 101
#PBFORMS END CONSTANTS
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Declarations **
'------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Main Application Entry Point **
'------------------------------------------------------------------------------
FUNCTION PBMAIN()
    '= Initialize the common control library.


    PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR _
        %ICC_INTERNET_CLASSES)

    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** CallBacks **
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()

    SELECT CASE AS LONG CB.MSG
        CASE %WM_INITDIALOG
            ' Initialization handler

        CASE %WM_NCACTIVATE
            STATIC hWndSaveFocus AS DWORD
            IF ISFALSE CB.WPARAM THEN
                ' Save control focus
                hWndSaveFocus = GetFocus()
            ELSEIF hWndSaveFocus THEN
                ' Restore control focus
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            END IF

        CASE %WM_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CB.CTL

            END SELECT
    END SELECT
END FUNCTION
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
'   ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG

#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
    LOCAL hDlg  AS DWORD

    DIALOG NEW hParent, "Dialog1", 268, 247, 500, 203, %WS_POPUP OR _
        %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR _
        %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
        %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _
        %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
#PBFORMS END DIALOG
    CreateRebar hdlg

    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP

    FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------



FUNCTION CreateRebar (BYVAL hParent AS DWORD) AS LONG

  LOCAL rbi       AS REBARINFO
  LOCAL rbBand    AS REBARBANDINFO
  LOCAL rc        AS RECT
  LOCAL hCbBox    AS DWORD
  LOCAL szCbText  AS WSTRINGZ * 255
  LOCAL hTbBar    AS DWORD
  LOCAL szTbText  AS WSTRINGZ * 255
  LOCAL dwBtnSize AS DWORD

  CONTROL ADD "ReBarWindow32", hParent, %ID_REBAR, "", 0, 0, 0, 0, _
      %WS_BORDER OR %WS_CHILD OR %WS_VISIBLE OR %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN OR _
      %RBS_VARHEIGHT OR %RBS_BANDBORDERS OR %RBBS_FIXEDSIZE'OR %CCS_NODIVIDER

  CONTROL HANDLE hParent, %ID_REBAR TO hRebar

  'g_hRbBack = LoadImage(GetModuleHandle(""), "RBBACK", %IMAGE_BITMAP, 0, 0, _
   '                     %LR_LOADTRANSPARENT OR %LR_LOADMAP3DCOLORS OR %LR_DEFAULTSIZE)

  '= Initialize and send the REBARINFO structure
  rbi.cbSize = SIZEOF(rbi)
  rbi.fMask  = 0
  rbi.himl   = 0

  CONTROL SEND hParent, %ID_REBAR, %RB_SETBARINFO, 0, VARPTR(rbi)

  '= Initialize REBARBANDINFO for all rebar bands
  rbBand.cbSize     = SIZEOF(rbBand)
  rbBand.fMask      = %RBBIM_COLORS    OR _    '= clrFore and clrBack are valid
                      %RBBIM_CHILD     OR _    '= hwndChild is valid
                      %RBBIM_CHILDSIZE OR _    '= cxMinChild and cyMinChild are valid
                      %RBBIM_STYLE     OR _    '= fStyle is valid
                      %RBBIM_ID        OR _    '= wID is valid
                      %RBBIM_SIZE      OR _    '= cx is valid
                      %RBBIM_TEXT      OR _    '= lpText is valid
                      %RBBIM_BACKGROUND        '= hbmBack is valid
  rbBand.clrFore    = GetSysColor(%COLOR_BTNTEXT)
  rbBand.clrBack    = GetSysColor(%COLOR_BTNFACE)

  rbBand.fStyle = %RBBS_NOVERT     OR _    '= do not display in vertical orientation
                  %RBBS_CHILDEDGE  OR _
                  %RBBS_FIXEDBMP   OR _
                  %RBBS_GRIPPERALWAYS

  'rbBand.hbmBack    = g_hRbBack

  '= Create The Rebar ToolBar Band.
  'hTbBar            = CreateToolBar(hDlg)
  dwBtnSize         = SendMessage(hTbBar, %TB_GETBUTTONSIZE, 0, 0)
  'szTbText          = "ToolBar"
  'rbBand.lpText     = VARPTR(szTbText)
  rbBand.hwndChild  = hTbBar
  rbBand.wID        = %ID_TOOLBAR
  rbBand.cxMinChild = 230
  rbBand.cyMinChild = HIWRD(dwBtnSize)
  MSGBOX STR$(rbBand.cyMinChild)
  rbBand.cx         = 280

  '= Break the Band to a New Row is more then one.
  IF udtAp.rbRowCount > 1 THEN
    rbBand.fStyle = rbBand.fStyle OR %RBBS_BREAK
  END IF
  '= Insert band into rebar
  CONTROL SEND hParent, %ID_REBAR, %RB_INSERTBAND, 0&, VARPTR(rbBand)

  '= Create The Rebar ComboBox Band.
  hCbBox = libOF_DrivesToComboEx(hParent, %IDC_COMBOBOX_DRIVE_SELECT)

  szCbText          = " ComboBox: "
  rbBand.lpText     = VARPTR(szCbText)
  rbBand.hwndChild  = hCbBox
  rbBand.wID        = %IDC_COMBOBOX_DRIVE_SELECT
  GetWindowRect hCbBox, rc
  rbBand.cxMinChild = 150
  rbBand.cyMinChild = rc.nBottom - rc.nTop
  MSGBOX  STR$(rbBand.cyMinChild)
  rbBand.cx         = 460

  '= Insert band into rebar
  CONTROL SEND hParent, %ID_REBAR, %RB_INSERTBAND, 1&, VARPTR(rbBand)

  '= Move Rebar Bands that were Saved!
  IF udtAp.rbBand0 <> %ID_TOOLBAR THEN SendMessage hRebar, %RB_MOVEBAND, 1&, 0&

END FUNCTION

FUNCTION libOF_DrivesToComboEx(BYVAL hDlg AS DWORD, BYVAL CID AS DWORD) PRIVATE AS DWORD
', BYVAL Path AS STRING)
'
    LOCAL PPATH AS WSTRING, PROOT AS WSTRING
    LOCAL II AS LONG, CC AS LONG
    LOCAL curdrv AS LONG, seldrv AS LONG
    LOCAL ppos AS LONG, dwRes AS DWORD
    LOCAL idxImage AS LONG
    LOCAL hIco AS DWORD
    LOCAL sTxt AS WSTRING
    LOCAL x AS LONG
    LOCAL y AS LONG
    LOCAL pwide AS LONG
    LOCAL high AS LONG
    LOCAL chdlg AS DWORD
    LOCAL ghImgList AS DWORD
    DIM lpshfi AS SHFILEINFO
    DIM cbI AS COMBOBOXEXITEMW
'
    CONTROL ADD "ComboBoxEx32", hDlg, CID,"", 0, 0, 0, 200, _        '"ComboBoxEx32"
        %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR _
        %CBS_DROPDOWNLIST OR %CBS_SORT, %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
        %WS_EX_RIGHTSCROLLBAR

    ghImgList = SHGETFILEINFO( "C:\", 0, lpshfi, SIZEOF(lpshfi), %SHGFI_USEFILEATTRIBUTES OR %SHGFI_SMALLICON OR %SHGFI_SYSICONINDEX )   ' Holle imagelist von shell32
    CONTROL SEND hDlg, CID, %CBEM_SETIMAGELIST, 0, ghImgList                                                                             ' setze imigelist von Combobox auf imagelist von shell32
    '
    ' curdrv = ASC(UCASE$(Path))
    curdrv = ASC(UCASE$(CURDIR$))
    dwRes = GetLogicalDriveStrings(0, BYVAL %NULL)
    PROOT = SPACE$(dwRes + 2)
    dwRes = GetLogicalDriveStrings(dwRes, BYVAL STRPTR(PROOT))
    '
    IF LEN(TRIM$(PROOT)) THEN
        '
        CONTROL SEND hDlg, CID, %CB_GETCOUNT, 0, 0 TO CC
        '
        FOR II = 0 TO CC -1
            cbI.mask = %CBEIF_TEXT OR %CBEIF_IMAGE OR %CBEIF_SELECTEDIMAGE
            cbI.iItem = II
            CONTROL SEND hDlg, CID, %CBEM_GETITEM, 0, VARPTR(cbI) TO lpshfi.hIcon
            IF lpshfi.hIcon THEN DestroyIcon lpshfi.hIcon
            lpshfi.hIcon = 0
        NEXT II
        '
        '  CONTROL SEND hDlg, CID, %CB_RESETCONTENT, 0, 0
        '
        FOR II = 1 TO TALLY(PROOT, CHR$(0)) - 1
            PPATH = PARSE$(PROOT, CHR$(0), II)
            IF LEN(PPATH) THEN
                SHGetFileInfo BYVAL STRPTR(PPATH), 0, lpshfi, LEN(lpshfi), _
                    %SHGFI_SYSICONINDEX OR %SHGFI_ICON OR _
                    %SHGFI_SMALLICON OR %SHGFI_DISPLAYNAME
                '
                PPATH = UCASE$(LEFT$(PPATH, 2))
                ppos = INSTR(lpshfi.szDisplayName, "(")
                '
                IF ppos THEN
                    lpshfi.szDisplayName = TRIM$(LEFT$(lpshfi.szDisplayName, ppos- 1))
                    IF LEN(lpshfi.szDisplayName) THEN
                        PPATH = PPATH + "  (" + lpshfi.szDisplayName + ")"
                    END IF
                END IF
                '
                '
                sTxt = PPATH
                cbI.mask = %CBEIF_TEXT OR %CBEIF_IMAGE OR %CBEIF_SELECTEDIMAGE
                cbI.iItem          = II - 1
                cbI.pszText        = STRPTR(sTxt)
                cbI.cchTextMax     = LEN(sTxt)
                cbI.iImage         = lpshfi.iIcon
                cbI.iSelectedImage = lpshfi.iIcon
                '
                IF CC -1 < 0 THEN
                    CONTROL SEND hDlg, CID, %CBEM_INSERTITEM, 0, VARPTR(cbI)
                ELSE
                    CONTROL SEND hDlg, CID, %CBEM_SETITEM, 0, VARPTR(cbI)
                END IF
                IF curdrv = ASC(PPATH) THEN seldrv = II - 1
            END IF
        NEXT II
        '
        CONTROL SEND hDlg, CID, %CB_SETCURSEL, seldrv, 0
        'gstruct_libOF_Settings.driveselect = seldrv
        '
        CONTROL HANDLE hdlg, CID TO hdlg
        FUNCTION = hdlg
    END IF
END FUNCTION


[José Roca]

See this post about the size of the REBARBANDIFO structure: http://www.jose.it-berater.org/smfforum/index.php?topic=4528.msg16875;topicseen#msg16875

[Peter Weis]

Hello Jose
Thanks for the information
regards Peter