2003-04-13 19:29

'-----------------------------------------------------------------
'
'  QDirListView
'
'  An Customized QListView For Displaing Files and Folders
'
'  by Rene Saarsoo
'
'-----------------------------------------------------------------
' not well-commented and needs some work, but is fully-functional :)
' All Suggestions and Bug-Reports are welcome to  nene@hot.ee
'
' Long live the Rapid-Q!
'

' Icons for folders and unidentified files
     $RESOURCE ICO_DIR_SMALL AS "dir_XP_small.ico"
     $RESOURCE ICO_DIR_LARGE AS "dir_XP_large.ico"
     $RESOURCE ICO_DEFAULTFILE_SMALL AS "default_small.ico"
     $RESOURCE ICO_DEFAULTFILE_LARGE AS "default_large.ico"

' exclude it, if you have already declared this API-function
     DECLARE FUNCTION SetFocus LIB "USER32" ALIAS "SetFocus" (Handle AS LONG) AS LONG

     DECLARE SUB FileSelect_EventTemplate(Tag AS INTEGER)

     TYPE QDirListView EXTENDS QLISTVIEW
      Directory AS STRING PROPERTY SET Set_Directory
      Filename AS STRING
      Mask AS STRING PROPERTY SET Set_Mask
      ShowRoot AS INTEGER PROPERTY SET Set_ShowRoot
      LargeImageList AS QIMAGELIST
      SmallImageList AS QIMAGELIST
      ExtensionsList AS QSTRINGLIST
      dlw_PopupMenu AS QPOPUPMENU
      dlw_Enter AS QMENUITEM
      dlw_BackSpace AS QMENUITEM
      OnFileSelect AS EVENT (FileSelect_EventTemplate)
      ColumnsInitialized AS INTEGER

      SUB SetItemImage (Extension AS STRING)
       QDirListView.Item(QDirListView.ItemCount - 1).ImageIndex = 1
       FOR i = 2 TO QDirListView.ExtensionsList.ItemCount - 1
        IF LCASE$(Extension) = QDirListView.ExtensionsList.Item(i) THEN
         QDirListView.Item(QDirListView.ItemCount - 1).ImageIndex = i
         EXIT FOR
        END IF
       NEXT i
      END SUB

      SUB AddFileProperties (Extension AS STRING)
       DIM SizeString AS STRING
       IF FileRec.Size/1024 >= 1 THEN
        SizeString = STR$(INT(FileRec.Size / 1024)) + " KB"
       ELSE
        SizeString = "1 KB"
       END IF
       QDirListView.AddSubItem (QDirListView.ItemCount - 1, SizeString )
       QDirListView.AddSubItem (QDirListView.ItemCount - 1, UCASE$(Extension) + " File")
       DIM FirstSplitter AS INTEGER
       DIM Month AS STRING
       FirstSplitter = INSTR(FileRec.Date, "-", 0)
       Month = LEFT$(FileRec.Date, FirstSplitter - 1)
       IF LEN(Month) = 1 THEN Month = "0" + Month
       DIM Day AS STRING
       Day = LEFT$(RIGHT$(FileRec.Date, LEN(FileRec.Date) - FirstSplitter), _
        INSTR(RIGHT$(FileRec.Date, LEN(FileRec.Date) - FirstSplitter), "-", 0) - 1)
       DIM Year AS STRING
       Year = RIGHT$(FileRec.Date, 4)
       QDirListView.AddSubItem (QDirListView.ItemCount - 1, Day+"."+Month+"."+Year + " " +FileRec.Time)
      END SUB

      SUB LoadDirectories
       DIM File AS STRING
       File = ""
       File = DIR$(QDirListView.Directory + "*.*", faDirectory)
       DO
        File = DIR$
        IF File = "" THEN
         EXIT DO
        ELSE
         IF File = ".." AND QDirListView.ShowRoot = FALSE THEN
         ELSE
          IF DIREXISTS(QDirListView.Directory + File) THEN
           QDirListView.AddItems File
          END IF
         END IF
        END IF
       LOOP
      END SUB

      SUB LoadFiles
       DIM File AS STRING
       DIM i AS INTEGER
       File = ""
       i = 0

       DO
        i = i + 1
        IF i = 1 THEN
         File = DIR$(QDirListView.Directory + QDirListView.Mask, 0)
        ELSE
         File = DIR$
        END IF

        IF File = "" THEN
         EXIT DO
        ELSE
         DIM Extension AS STRING
         Extension = ""
         DIM PontPlace AS INTEGER

         QDirListView.AddItems File

         PointPlace = INSTR(File, ".", 0)
         IF PointPlace > 0 THEN
          Extension = RIGHT$( File, INSTR(reverse$(File), ".", 0) - 1 )
          QDirListView.SetItemImage (Extension)
         ELSE
          QDirListView.Item(QDirListView.ItemCount - 1).ImageIndex = 1
         END IF
         QDirListView.AddFileProperties (Extension)
        END IF
       LOOP
      END SUB

      SUB Refresh
       QDirListView.Clear
       QDirListView.LoadDirectories
       QDirListView.LoadFiles
       QDirListView.ViewStyle = QDirListView.ViewStyle + 1   ' SomeHow we manage with
       QDirListView.ViewStyle = QDirListView.ViewStyle - 1   ' changing the style
                                                          ' to make items fully wisible
                                                          ' ( without "..." at the end )
       IF ColumnsInitialized = FALSE THEN
        QDirListView.ClearColumns
        QDirListView.AddColumns "Name", "Size", "Type", "Date Modified"
        QDirListView.Column(0).Width = 150
        QDirListView.Column(1).Width = 60
        QDirListView.Column(2).Width = 60
        QDirListView.Column(3).Width = 100
        ColumnsInitialized = TRUE
       END IF
       QDirListView.Visible = false     ' Whith this we manage to repaint the control.
       QDirListView.Visible = true      ' Otherwise it would stay messed-up ( You can Try :) )
       SetFocus(QDirListView.Handle)    ' Focus was lost on hiding, so we set it back.
      END SUB

      SUB ChangeDirUp
       QDirListView.Directory = LEFT$(QDirListView.Directory, _
        LEN(QDirListView.Directory) - _
        INSTR(MID$(reverse$(QDirListView.Directory), 2), "\", 0)  )
       QDirListView.refresh
      END SUB

      SUB ChangeDir
       IF QDirListView.Item(QDirListView.ItemIndex).CAPTION = ".." THEN
        QDirListView.ChangeDirUp
       ELSE
        QDirListView.Directory = QDirListView.FileName + "\"
        QDirListView.refresh
       END IF
      END SUB

      SUB TryToChangeDirOrMakeEvent
       IF QDirListView.FileName > "" THEN
        IF DIREXISTS(QDirListView.FileName) THEN
         QDirListView.ChangeDir
        ELSE
         CALLFUNC(QDirListView.OnFileSelect, 0)
        END IF
       END IF
      END SUB



      EVENT OnChange
       IF QDirListView.ItemIndex >= 0 THEN
        QDirListView.FileName = QDirListView.Directory + QDirListView.Item(QDirListView.ItemIndex).CAPTION
       ELSE
        QDirListView.FileName = ""
       END IF
      END EVENT

      EVENT OnDblClick
       QDirListView.TryToChangeDirOrMakeEvent
      END EVENT

      EVENT dlw_Enter.OnClick
       QDirListView.TryToChangeDirOrMakeEvent
      END EVENT

      EVENT dlw_BackSpace.OnClick
       QDirListView.ChangeDirUp
      END EVENT


      PROPERTY SET Set_Directory (Dir AS STRING)
       IF RIGHT$(Dir, 1) = "\" THEN
        QDirListView.Directory = Dir
       ELSE
        QDirListView.Directory = Dir + "\"
       END IF
       QDirListView.Refresh
      END PROPERTY

      PROPERTY SET Set_ShowRoot (RootSet AS INTEGER)
       QDirListView.ShowRoot = RootSet
       QDirListView.Refresh
      END PROPERTY

      PROPERTY SET Set_Mask (MaskSet AS STRING)
       QDirListView.Mask = MaskSet
       QDirListView.Refresh
      END PROPERTY

      CONSTRUCTOR
       Width = 400
       Height = 138
       Directory = LEFT$(COMMAND$(0), LEN(COMMAND$(0)) - LEN(APPLICATION.ExeName) )
       Filename = ""
       Mask = "*.*"
       ShowRoot = FALSE
       ReadOnly = TRUE
       ColumnsInitialized = FALSE
       LargeImageList.Width = 32
       LargeImageList.Height = 32
       ExtensionsList.AddItems "<dir>"
       SmallImageList.AddICOHandle ICO_DIR_SMALL
       LargeImageList.AddICOHandle ICO_DIR_LARGE
       ExtensionsList.AddItems "<dir>"
       SmallImageList.AddICOHandle ICO_DEFAULTFILE_SMALL
       LargeImageList.AddICOHandle ICO_DEFAULTFILE_LARGE
       LargeImages = QDirListView.LargeImageList
       SmallImages = QDirListView.SmallImageList
       dlw_Enter.ShortCut = "Enter"
       dlw_Enter.Visible = FALSE
       dlw_BackSpace.ShortCut = "BkSp"
       dlw_BackSpace.Visible = FALSE
       dlw_PopupMenu.AddItems(QDirListView.dlw_Enter, QDirListView.dlw_BackSpace)
       PopUpMenu = QDirListView.dlw_PopUpMenu
      END CONSTRUCTOR
     END TYPE

2003-04-13 19:29