2003-11-18 20:01

'=======================================================
' Type Objet
' Classe QFileListView version 1.0
'=======================================================
     $IFNDEF TRUE
      $DEFINE True 1
     $ENDIF

     $IFNDEF FALSE
      $DEFINE False 0
     $ENDIF

     $IFNDEF boolean
      $DEFINE boolean INTEGER
     $ENDIF

     DECLARE FUNCTION SetFocusFileListView LIB "USER32" ALIAS "SetFocus" (Handle AS LONG) AS LONG

     DECLARE SUB FileSelect_EventTemplate(File AS STRING)
     DECLARE SUB FileChange_EventTemplate(File AS STRING)

     TYPE QFileListView EXTENDS QLISTVIEW
Private:
      ColumnsInitialized AS boolean
Public:
      Filename AS STRING PROPERTY SET SetFileName
      LargeImageList AS QIMAGELIST
      SmallImageList AS QIMAGELIST
      ExtensionsList AS QSTRINGLIST
      ColumnCaption(4) AS STRING
      Directory AS STRING PROPERTY SET SetDirectory
      Mask AS STRING PROPERTY SET SetMask
      COLOR AS LONG PROPERTY SET SetColor
      OnFileSelect AS EVENT (FileSelect_EventTemplate)
      OnFileChange AS EVENT (FileChange_EventTemplate)

Private:

  '========================================
  ' Méthode affectation icone
  '========================================
      SUB SetItemImage (Extension AS STRING)
       DIM i AS INTEGER

       this.Item(this.ItemCount-1).ImageIndex=0
       FOR i=0 TO this.ExtensionsList.ItemCount-1
        IF LCASE$(Extension)=this.ExtensionsList.Item(i) THEN
         this.Item(this.ItemCount-1).ImageIndex=i+1
         EXIT FOR
        END IF
       NEXT i
      END SUB

  '========================================
  ' Méthode ajout détails de fichier
  '========================================
      SUB AddFileProperties (Extension AS STRING)
       DIM SizeString AS STRING
       DIM Month AS STRING
       DIM Day AS STRING
       DIM Year AS STRING
       DIM Hours AS STRING
       DIM Minute AS STRING

       IF FileRec.Size/1024>=1 THEN
        SizeString=STR$(INT(FileRec.Size/1024))+" KB"
       ELSE
        SizeString="1 KB"
       END IF
       this.AddSubItem(this.ItemCount-1,SizeString)
       this.AddSubItem(this.ItemCount-1,UCASE$(Extension))
       Month=FIELD$(FileRec.Date,"-",1)
       IF LEN(Month)=1 THEN Month="0"+Month
       Day=FIELD$(FileRec.Date,"-",2)
       IF LEN(Day)=1 THEN Day="0"+Day
       Year=FIELD$(FileRec.Date,"-",3)
       Hours=FIELD$(FileRec.Time,":",1)
       IF LEN(Hours)=1 THEN Hours="0"+Hours
       Minute=FIELD$(FileRec.Time,":",2)
       IF LEN(Minute)=1 THEN Minute="0"+Minute
       this.AddSubItem (this.ItemCount-1,Day+"/"+Month+"/"+Year+SPACE$(2)+Hours+":"+Minute)
      END SUB

  '========================================
  ' Méthode retourne le nombre d'extension
  '========================================
      FUNCTION ExtCount(Extension AS STRING) AS INTEGER
       DIM count AS INTEGER
       DIM flag AS boolean

       flag=false
       count=0
       WHILE flag=false
        count++
        IF FIELD$(Extension,";",count)="" THEN flag=true
       WEND
       result=count-1
      END FUNCTION

  '================================================
  ' Méthode affichage des fichiers type du masque
  '================================================
      SUB LoadFiles(Mask AS STRING)
       DIM File AS STRING
       DIM i AS INTEGER
       DIM Extension AS STRING

       File=DIR$(this.Directory+"\"+Mask,0)
       IF File<>"" THEN
        Extension=""
        this.AddItems File
        IF INSTR(File,".",0)>0 THEN
         Extension=RIGHT$(File,INSTR(reverse$(File),".",0)-1)
         this.SetItemImage(Extension)
        ELSE
         this.Item(this.ItemCount-1).ImageIndex=0
        END IF
        this.AddFileProperties (Extension)
        WHILE File<>""
         File=DIR$
         IF File<>"" THEN
          Extension=""
          this.AddItems File
          IF INSTR(File,".",0)>0 THEN
           Extension=RIGHT$(File,INSTR(reverse$(File),".",0)-1)
           this.SetItemImage (Extension)
          ELSE
           this.Item(this.ItemCount-1).ImageIndex=0
          END IF
          this.AddFileProperties (Extension)
         END IF
        WEND
       END IF
      END SUB

  '========================================
  ' Méthode affichage fichier
  '========================================
      SUB Load
       DIM count AS INTEGER
       DIM i AS INTEGER
       DIM mask AS STRING

       count=this.ExtCount(this.mask)
       IF count>0 THEN
        FOR i=1 TO count
         mask=FIELD$(this.mask,";",i)
         this.LoadFiles(mask)
        NEXT i
       ELSE
        this.LoadFiles(this.mask)
       END IF
      END SUB

Public:

  '========================================
  ' Méthode actualisation de la liste
  '========================================
      SUB Refresh
       this.Clear
       this.Load
       IF this.ColumnsInitialized=false THEN
        this.ClearColumns
        this.AddColumns this.ColumnCaption(1),this.ColumnCaption(2),this.ColumnCaption(3),this.ColumnCaption(4)
        this.Column(0).Width=150
        this.Column(1).Width=60
        this.Column(2).Width=60
        this.Column(3).Width=120
        this.ColumnsInitialized=true
       END IF
      END SUB

  '========================================
  ' Méthode focus sur controle
  '========================================
      SUB SetFocus
       SetFocusFileListView(this.Handle)
      END SUB

  '========================================
  ' Evenement double click
  '========================================
      EVENT OnDblClick
       IF this.OnFileSelect<>0 THEN CALLFUNC(this.OnFileSelect,this.FileName)
      END EVENT

  '========================================
  ' Evenement pression touche clavier
  '========================================
      EVENT OnKeyPress(Key AS BYTE)
       IF Key=13 AND this.FileName<>"" THEN
        IF this.OnFileSelect<>0 THEN CALLFUNC(this.OnFileSelect,this.FileName)
       END IF
      END EVENT

  '========================================
  ' Evenement changement selection
  '========================================
      EVENT OnChange
       IF this.ItemIndex>=0 THEN
        this.FileName=this.Directory+"\"+this.Item(this.ItemIndex).CAPTION
        IF this.OnFileChange<>0 THEN CALLFUNC(this.OnFileChange,this.FileName)
       ELSE
        this.FileName=""
       END IF
      END EVENT

  '========================================
  ' Proprieté couleur
  '========================================
      PROPERTY SET SetColor(COLOR AS LONG)
       super.COLOR=COLOR
       this.COLOR=COLOR
       this.LargeImageList.bkcolor=COLOR
       this.SmallImageList.bkcolor=COLOR
      END PROPERTY

  '========================================
  ' Proprieté repertoire
  '========================================
      PROPERTY SET SetDirectory (Dir AS STRING)
       IF DIREXISTS(Dir) THEN
        this.Directory=Dir
        this.Refresh
       END IF
      END PROPERTY

  '========================================
  ' Proprieté masque extension fichier
  '========================================
      PROPERTY SET SetMask(MaskSet AS STRING)
       this.Mask=MaskSet
       this.Refresh
      END PROPERTY

  '========================================
  ' Proprieté nom fichier
  '========================================
      PROPERTY SET SetFileName(filename AS STRING)
    'read only
      END PROPERTY

      CONSTRUCTOR
       Width=400
       Height=200
       Directory=CURDIR$
       Filename=""
       Mask="*.*"
       ReadOnly=true
       ColumnsInitialized=false
       ColumnCaption(1)="Name"
       ColumnCaption(2)="Size"
       ColumnCaption(3)="Type"
       ColumnCaption(4)="Modified"
       LargeImageList.Width=32
       LargeImageList.Height=32
       LargeImageList.bkcolor=super.COLOR
       SmallImageList.bkcolor=super.COLOR
       LargeImageList.masked=false
       SmallImageList.masked=false
       LargeImages=This.LargeImageList
       SmallImages=this.SmallImageList
      END CONSTRUCTOR
     END TYPE

2003-11-18 20:01