2000-10-04 18:07

     DECLARE FUNCTION GetDriveType LIB "kernel32" ALIAS "GetDriveTypeA" _
      (nDrive AS STRING)AS LONG
     DECLARE FUNCTION GetVolumeInformation LIB "Kernel32" ALIAS "GetVolumeInformationA" _
      (lpRootPathName AS LONG, lpVolumeNameBuffer AS LONG, BYVAL nVolumeNameSize AS LONG, BYVAL lpVolumeSerialNumber AS LONG, BYVAL lpMaximumComponentLength AS LONG, BYVAL lpFileSystemFlags AS LONG, lpFileSystemNameBuffer AS LONG, nFileSystemNameSize AS LONG)AS LONG
     DECLARE FUNCTION GetLogicalDriveStrings LIB "kernel32" ALIAS "GetLogicalDriveStringsA" _
      (BYVAL nBufferLength AS LONG, pBuffer AS LONG)AS LONG
     DECLARE FUNCTION GetLastError LIB "kernel32" ALIAS "GetLastError"()AS LONG

     $APPTYPE GUI
     $TYPECHECK ON
     $INCLUDE "RapidQ.inc"

     TYPE QDriveComboBox EXTENDS QCOMBOBOX
      imglst AS QIMAGELIST

      SUB GetDrives
       QDriveComboBox.Font.Size = 9
       QDriveComboBox.clear
       DIM Drives$ AS STRING
       DIM i AS WORD
       DIM s AS WORD
       DIM a$ AS STRING
       DIM Serial AS LONG:DIM VName$ AS STRING:DIM FSName$ AS STRING
       DIM retval AS LONG

       Drives$ = SPACE$(255)
       retval = GetLogicalDriveStrings(255,VARPTR(Drives$))
       Drives$ = LEFT$(Drives$, retval)
       s = TALLY(Drives$, CHR$(0))

       FOR i = 1 TO s
        a$ = FIELD$(Drives$, CHR$(0), i)
           'Create buffers
        VName$ = SPACE$(255)
        FSName$ = SPACE$(255)
           'Get the volume information
        retval = GetVolumeInformation(VARPTR(a$), VARPTR(VName$), 255, Serial, 0, 0, VARPTR(FSName$), 255)
           'Strip the extra chr$(0)'s
        VName$ = LEFT$(VName$, INSTR(VName$, CHR$(0))- 1)
        FSName$ = LEFT$(FSName$, INSTR(FSName$, CHR$(0))- 1)
        IF LEN(VName$)THEN
        VName$ = LEFT$(VName$,1)+ LCASE$(MID$(VName$,2,LEN(VName$)))
        VName$ = "[" + VName$ + "]"
       END IF
       QDriveComboBox.AddItems UCASE$(a$)- "\" + "    " + VName$

       SELECT CASE GetDriveType(a$)
       CASE 2   '[Removable]
        QDriveComboBox.imglst.AddBMPFile "fd1.bmp",&HFF00FF
       CASE 3   '[Drive Fixed]
        QDriveComboBox.imglst.AddBMPFile "hd.bmp",&HFF00FF
       CASE IS = 4   '[Remote]
        QDriveComboBox.imglst.AddBMPFile "net.bmp",&HFF00FF
       CASE IS = 5   '[Cd - Rom]
        QDriveComboBox.imglst.AddBMPFile "cd.bmp",&HFF00FF
       CASE IS = 6   '[Ram disk]
        QDriveComboBox.imglst.AddBMPFile "ram.bmp",&HFF00FF
       CASE ELSE   '[Unrecognized]
        QDriveComboBox.imglst.AddBMPFile "folder.bmp",&HFF00FF
       END SELECT
      NEXT i
      QDriveComboBox.ItemIndex = 0
     END SUB

     EVENT OnMeasureItem(Index AS INTEGER, Height AS INTEGER)
      Height = 18
     END EVENT

     EVENT OnDrawItem(Index AS INTEGER, State AS BYTE, Rect AS QRECT)
      WITH QDriveComboBox
       IF State = 0 THEN
        ' -  - Selected
        '       .FillRect(Rect.Left, Rect.Top - 2, Rect.Right, Rect.Bottom + 2, &HFFFFFF)
        .FillRect(Rect.Left + 22, Rect.Top, Rect.Right, Rect.Bottom, &H8C0000)
        .TextOut(25, Rect.Top + 2, .Item(index), &HFFFFFF, - 1)
       ELSE
        .FillRect(Rect.Left, Rect.Top - 1, Rect.Right, Rect.Bottom + 1, &HFFFFFF)
        .TextOut(25, Rect.Top + 2, .Item(index), 0, - 1)
       END IF
       .Draw(Rect.Left + 2, Rect.Top, .imglst.GetBMP(index))
      END EVENT

  ' -  - Default values
      CONSTRUCTOR
       left = 80
       top = 80
       Width = 160
       Style = csOwnerDrawVariable
      END CONSTRUCTOR
     END TYPE

  'Test Source
     DECLARE SUB ItemChanged
     DIM Form AS QFORM
     form.center
     DIM DrvCombo AS QDriveComboBox
     SUB ItemChanged
      SHOWMESSAGE(DrvCombo.Item(DrvCombo.ItemIndex))
     END SUB
     DrvCombo.PARENT = Form
     DrvCombo.GetDrives
     DrvCombo.OnChange = ItemChanged
     Form.SHOWMODAL
     END

2000-10-04 18:07