2013-08-20 12:34

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

     $IFNDEF FALSE
      $DEFINE False 0
     $ENDIF

     $IFNDEF boolean
      $DEFINE boolean INTEGER
     $ENDIF

     $IFNDEF __WIN32API				   'windows 32 definitions
      TYPE SHFILEINFO
       hIcon AS LONG                      '  out: icon
       iIcon AS INTEGER                   '  out: icon index
       dwAttributes AS DWORD              '  out: SFGAO_ flags
       szDisplayName AS STRING * 260      '  out: display name (or path)
       szTypeName AS STRING * 80          '  out: type name
      END TYPE


      CONST SHGFI_DISPLAYNAME    = &H200
      CONST SHGFI_TYPENAME       = &H400
      CONST SHGFI_SYSICONINDEX   = &H4000
      CONST SHGFI_LARGEICON      = &H0
      CONST SHGFI_SMALLICON      = &H1
      CONST SHGFI_ICON           = &H100

      CONST LVM_FIRST            = &H1000
      CONST LVM_SETIMAGELIST     = (LVM_FIRST + 3)
      CONST LVM_GETBKIMAGEA      = (LVM_FIRST + 69)
      CONST LVM_SETITEMPOSITION  = (LVM_FIRST + 15)
      CONST LVM_SETBKIMAGEA      = (LVM_FIRST + 68)
      CONST LVBKIF_SOURCE_URL    = 2
      CONST LVBKIF_STYLE_NORMAL  = &H0
      CONST LVSIL_NORMAL         = 0
      CONST LVSIL_SMALL          = 1


      DECLARE FUNCTION SHGetFileInfoFileListView LIB "shell32.dll" ALIAS "SHGetFileInfoA" (pszPath AS STRING,dwFileAttributes AS LONG,psfi AS SHFILEINFO,cbFileInfo AS LONG,uFlags AS LONG) AS DWORD
      DECLARE FUNCTION DestroyIconFileListView LIB "user32" ALIAS "DestroyIcon" (BYVAL hIcon AS LONG) AS LONG
      DECLARE FUNCTION SetFocusFileListView LIB "user32" ALIAS "SetFocus" (Handle AS LONG) AS LONG
     $ENDIF

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

     TYPE QFileListView EXTENDS QLISTVIEW
Private:
      ColumnsInitialized AS boolean
      FI AS SHFILEINFO
Public:
      Filename AS STRING PROPERTY SET SetFileName
      ColumnCaption(4) AS STRING
      Directory AS STRING PROPERTY SET SetDirectory
      Mask AS STRING PROPERTY SET SetMask
      OnFileSelect AS EVENT (FileSelect_EventTemplate)
      OnFileChange AS EVENT (FileChange_EventTemplate)

Private:

  '=================================================
  ' Méthode retourne le repertoire formaté
  '=================================================
      FUNCTION GetFormatDir(directory AS STRING) AS STRING
       IF rinstr(directory,"\")=LEN(directory) THEN
        result=directory
       ELSE
        result=directory+"\"
       END IF
      END FUNCTION

  '========================================
  ' 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 ajout détails de fichier
  '========================================
      SUB AddFileProperties
       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,this.FI.szTypeName)
       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 affichage des fichiers type du masque
  '================================================
      SUB LoadFiles(Mask AS STRING)
       DIM File AS STRING
       DIM i AS INTEGER

       File=DIR$(This.GetFormatDir(this.Directory)+Mask,0)
       IF File<>"" THEN
        this.AddItems File
        IF INSTR(File,".",0)>0 THEN
         SHGetFileInfoFileListView(This.GetFormatDir(This.Directory)+File,0,this.FI,SIZEOF(this.FI),SHGFI_DISPLAYNAME OR SHGFI_TYPENAME OR SHGFI_ICON)
         this.Item(this.ItemCount-1).ImageIndex=this.FI.iIcon
         DestroyIconFileListView this.FI.hIcon
        END IF
        this.AddFileProperties
        WHILE File<>""
         File=DIR$
         IF File<>"" THEN
          this.AddItems File
          IF INSTR(File,".",0)>0 THEN
           SHGetFileInfoFileListView(This.GetFormatDir(This.Directory)+File,0,this.FI,SIZEOF(this.FI),SHGFI_DISPLAYNAME OR SHGFI_TYPENAME OR SHGFI_ICON)
           this.Item(this.ItemCount-1).ImageIndex=this.FI.iIcon
           DestroyIconFileListView this.FI.hIcon
          END IF
          this.AddFileProperties
         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
       DIM himlLarge AS DWORD
       DIM himlSmall AS DWORD

       this.Clear
       this.SortType=0
       himlLarge=SHGetFileInfoFileListView("c:\",0,this.FI,SIZEOF(this.FI),SHGFI_SYSICONINDEX OR SHGFI_LARGEICON)
       himlSmall=SHGetFileInfoFileListView("c:\",0,this.FI,SIZEOF(this.FI),SHGFI_SYSICONINDEX OR SHGFI_SMALLICON)
       sendmessage This.handle,LVM_SETIMAGELIST,LVSIL_NORMAL,himlLarge
       sendmessage This.handle,LVM_SETIMAGELIST,LVSIL_SMALL,himlSmall
       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=80
        this.Column(2).Width=80
        this.Column(3).Width=120
        this.ColumnsInitialized=true
       END IF
       this.SortType=2
      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.GetFormatDir(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é 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"
      END CONSTRUCTOR
     END TYPE

2013-08-20 12:34