' Grötsch Erwin
' Drive List -> ComboBoxEx 32 mit Icon's

#PBFORMS CREATED V1.51
'----------------------------------------
' 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.
'----------------------------------------
' PB/WIN 8.01
' 16.12.2005 von StSn
' ComboBoxEx32 Drive List
'
#COMPILE EXE
#DIM ALL
'
'----------------------------------------
'   ** Includes **
'----------------------------------------
'%USEMACROS = 1
#PBFORMS BEGIN INCLUDES
#IF NOT %DEF(%WINAPI)
 #INCLUDE "WIN32API.INC"
#ENDIF
#IF NOT %DEF(%COMMCTRL_INC)
' #INCLUDE "COMMCTRL.INC"
#ENDIF
'#INCLUDE "PBForms.INC"
#PBFORMS END INCLUDES
#INCLUDE "InitCtrl.inc"
'----------------------------------------
'
'----------------------------------------
'   ** Constants **
'----------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1     =  101
%IDC_LABEL1      = 1001
%IDC_COMBOBOXEX1 = 1002
%IDC_BUTTON1     = 1003
%IDC_TEXTBOX1    = 1004
#PBFORMS END CONSTANTS
'----------------------------------------
'
GLOBAL ghImgList AS DWORD
'
'----------------------------------------
'   ** Declarations **
'----------------------------------------
DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
#PBFORMS DECLARATIONS
'----------------------------------------
'
DECLARE SUB DrivesToComboEx(BYVAL hDlg AS DWORD, BYVAL CID AS DWORD)
'
'----------------------------------------
'   ** Main Application Entry Point **
'----------------------------------------
FUNCTION PBMAIN()
' PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES _
'  OR %ICC_INTERNET_CLASSES)
'
 IF InitComCtl32(%ICC_USEREX_CLASSES) < 4.71@ THEN
  MSGBOX _
    "Sorry, this program needs a later version of COMCTL32.DLL." + $CRLF + _
    "Please install MSIE version 4 or higher, or get the file directly from: " + _
    $CRLF + $CRLF + _
    "http://www.microsoft.com/msdownload/ieplatform/ie/comctrlx86.asp", _
    %MB_ICONWARNING OR %MB_SYSTEMMODAL, "ComboBoxEx Error"
    EXIT FUNCTION
 END IF
'
 ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'----------------------------------------
'
'----------------------------------------
'   ** CallBacks **
'----------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
'
 LOCAL TCBDRIVE AS STRING
'
 SELECT CASE AS LONG CBMSG
  CASE %WM_INITDIALOG
   ' Initialization handler
'
  CASE %WM_NCACTIVATE
   STATIC hWndSaveFocus AS DWORD
   IF ISFALSE CBWPARAM 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 CBCTL
    CASE %IDC_LABEL1
'
    CASE %IDC_COMBOBOXEX1
'
     IF CBCTLMSG = %CBN_SELENDOK THEN
      COMBOBOX GET TEXT CBHNDL, %IDC_COMBOBOXEX1 TO TCBDRIVE
      CONTROL SET TEXT CBHNDL, %IDC_TEXTBOX1, TCBDRIVE
      IF MID$(TCBDRIVE,2,1)=":" THEN
'       CHDRIVE LEFT$(TCBDRIVE,1)
      END IF
     END IF
'
    CASE %IDC_BUTTON1
     IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
      DIALOG END CBHNDL
     END IF
'
    CASE %IDC_TEXTBOX1
'
   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, " ComboBoxEx32 Drive List", 177, 111, 166, 121, %WS_POPUP OR _
  %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR _
  %WS_VISIBLE OR %DS_MODALFRAME OR %DS_SETFOREGROUND OR %DS_CENTER 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
 CONTROL ADD LABEL,   hDlg, %IDC_LABEL1, " ComboBoxEx32 Drive List ", 10, 10, 100, 10, _
  %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER OR %SS_CENTERIMAGE, %WS_EX_STATICEDGE OR _
  %WS_EX_LEFT OR %WS_EX_LTRREADING
 CONTROL SET COLOR    hDlg, %IDC_LABEL1, -1, %WHITE
 CONTROL ADD "ComboBoxEx32", hDlg, %IDC_COMBOBOXEX1, "", 10, 25, 100, 75, %WS_CHILD _
  OR %WS_VISIBLE, %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
 CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON1, " Ende ", 120, 95, 35, 15
 CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "", 10, 100, 100, 10, %WS_CHILD OR %WS_VISIBLE _
  OR %WS_TABSTOP OR %ES_LEFT OR %ES_AUTOHSCROLL OR %ES_READONLY, %WS_EX_STATICEDGE OR _
  %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
 CONTROL SET COLOR    hDlg, %IDC_TEXTBOX1, -1, %WHITE
#PBFORMS END DIALOG
'
 DrivesToComboEx hDlg, %IDC_COMBOBOXEX1
'
 DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
'
#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
#PBFORMS END CLEANUP
'
 FUNCTION = lRslt
END FUNCTION
'----------------------------------------
'
SUB DrivesToComboEx(BYVAL hDlg AS DWORD, BYVAL CID AS DWORD)
 ', BYVAL Path AS STRING)
'
 LOCAL Path AS STRING, Root AS STRING
 LOCAL II AS LONG, CC AS LONG
 LOCAL curdrv AS LONG, seldrv AS LONG
 LOCAL ppos AS LONG, dwRes AS DWORD
 DIM lpshfi AS SHFILEINFO
 DIM cbI AS COMBOBOXEXITEM
 LOCAL idxImage AS LONG
 LOCAL hIco AS DWORD
 LOCAL sTxt AS STRING
 LOCAL x AS LONG
 LOCAL y AS LONG
 LOCAL wide AS LONG
 LOCAL high AS LONG
'
 CONTROL GET LOC hDlg, CID TO x, y
 CONTROL GET SIZE hDlg, CID TO wide, high
 CONTROL KILL hDlg, CID
 CONTROL ADD "ComboBoxEx32", hDlg, CID, "", x, y, wide, high, _
  %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 = ImageList_Create(16, 15, %ILC_COLORDDB OR %ILC_MASK, 26, 0)
 CONTROL SEND hDlg, CID, %CBEM_SETIMAGELIST, 0, ghImgList
'
' curdrv = ASC(UCASE$(Path))
 curdrv = ASC(UCASE$(CURDIR$))
 dwRes = GetLogicalDriveStrings(0, BYVAL %NULL)
 Root = SPACE$(dwRes + 2)
 dwRes = GetLogicalDriveStrings(dwRes, BYVAL STRPTR(Root))
'
 IF LEN(TRIM$(Root)) 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(Root, CHR$(0)) - 1
   Path = PARSE$(Root, CHR$(0), II)
   IF LEN(Path) THEN
    SHGetFileInfo BYVAL STRPTR(Path), 0, lpshfi, LEN(lpshfi), _
                        %SHGFI_SYSICONINDEX OR %SHGFI_ICON OR _
                        %SHGFI_SMALLICON OR %SHGFI_DISPLAYNAME
'
    Path = UCASE$(LEFT$(Path, 2))
    ppos = INSTR(lpshfi.szDisplayName, "(")
'
    IF ppos THEN
     lpshfi.szDisplayName = TRIM$(LEFT$(lpshfi.szDisplayName, ppos - 1))
     IF LEN(lpshfi.szDisplayName) THEN
      Path = Path + "  (" + lpshfi.szDisplayName + ")"
     END IF
    END IF
'
    hIco = lpshfi.hIcon
    idxImage = ImageList_AddIcon(ghImgList, hIco)
    DeleteObject hIco
'
    sTxt = Path
    cbI.mask = %CBEIF_TEXT OR %CBEIF_IMAGE OR %CBEIF_SELECTEDIMAGE
    cbI.iItem          = II - 1
    cbI.pszText        = STRPTR(sTxt)
    cbI.cchTextMax     = LEN(sTxt)
    cbI.iImage         = idxImage
    cbI.iSelectedImage = idxImage
'
    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(Path) THEN seldrv = II - 1
   END IF
  NEXT II
'
  CONTROL SEND hDlg, CID, %CB_SETCURSEL, seldrv, 0
'
 END IF
END SUB
'