ExplorerListGadget selbstgemacht

[hjbremer]

Das ExplorerListGadget ist ja eine feine Sache, was aber nervt ist das Geflacker beim aktualisieren, wenn man Daten ins aktuelle Verzeichnis kopiert hat. Tritt leider nur auf wenn rechts der vertikale Scrollbalken da ist.

Darum selbstgemacht, hier das Ergebnis incl. Beispiel für Windows x86 32Bit

Code: Alles auswählen

;XIncludeFile "\Bremer\PureBasicPbi\debugmacros.pbi"

EnableExplicit

Structure ExplorerGadgetCallback    ;um mehr als einen Wert an Callback zu übergeben, erspart Shared oder globale Variablen
   lpPrevFunc.i                     ;subclassing 
   flag.i                           ;
   ;...   
EndStructure
   
Structure LVHITPOSITION
   StructureUnion       ;für Callback Hitinfo
      lparam.i          ;teilt lparam in LoWord und Hiword
      pt.points         ;points besteht aus 2 Word
   EndStructureUnion
EndStructure

#my_Explorer_Dir  = 2     
#my_Explorer_File = 4 
#my_Explorer_Root = 1 
#my_Explorer_Drive = 8 

#my_Explorer_Run = 1          ;ExplorerFileGadget(10, 5, 5, 490, 590, "c:\", #my_Explorer_Run) = startet Anwendungen etc
#my_Explorer_Dirmax = 30000   ;max Anzahl Einträge pro Dir 
#my_Explorer_ReadIcon = 1000  ;wenn Dir mehr Einträge hat, wird ein Standardicon benutzt, dauert mir sonst zulange

Procedure.i ExplorerFileGetGadgetItemState(nr, item)
   
   Protected state = 0
   
   If IsGadget(nr)
      state = GetGadgetItemData(nr, item)  
      Select state
         Case #my_Explorer_File: state = #PB_Explorer_File
         Case #my_Explorer_Dir:  state = #PB_Explorer_Directory
         Default: state = #PB_Explorer_None    
      EndSelect
      If GetGadgetItemState(nr, item) = #PB_ListIcon_Selected
         state | #PB_Explorer_Selected
      EndIf
   EndIf
   
   ProcedureReturn state
   
EndProcedure

Procedure.s ExplorerFileGetGadgetText(nr)
  
   If IsGadget(nr)
      Protected mem = GetGadgetData(nr)  
      If mem
         ProcedureReturn Trim(PeekS(mem, #MAX_PATH))
      EndIf
   EndIf
   
   ProcedureReturn ""
   
EndProcedure

Procedure.i ExplorerFileGadgetDrives(Array drives.s(1))
   
   ;wird von ExplorerFileGadgetUpdate() aufgerufen
   
   Protected drive$ = Space(#MAX_PATH)
   Protected memory = @drive$   
   Protected anzahl = GetLogicalDriveStrings_(#MAX_PATH, memory) / 4
   Protected state.s = "3"    ;drei für Laufwerk  
   Protected j, lw.s, typ.s = "unbekannt", name.s
   
   ReDim drives(anzahl)
   
   For j = 1 To anzahl
      lw = PeekS(memory)
      memory + 4
      
      Select GetDriveType_(lw)
         Case 2: typ = "Diskettenlaufwerk"
         Case 3: typ = "Festplatte"
         Case 4: typ = "Netzwerk"
         Case 5: typ = "CD-Rom"
         Case 6: typ = "Ram-Disk"
      EndSelect
            
      name = Space(#MAX_PATH)
      GetVolumeInformation_(lw, @name, #MAX_PATH, 0,0,0,0,0)
      
      drives(j) = state + lw + #LF$ + #LF$ + Trim(name) + " " + Trim(typ)
      
   Next
   
   ProcedureReturn anzahl
EndProcedure

Procedure.i ExplorerFileGadgetRead(Array entry.s(1), path.s)
   
   ;schreibt alle Einträge von path ins entry Feld (ohne die Inhalte aus Unterverzeichnissen)
   
   ;und setzt eine Zahl (state) davor, welche die Art des Eintrages kennzeichnet, Dir File etc
   ;diese Zahl wird dann in den Data Bereich einer Zeile des LV geschrieben und dient zum Sortieren
   ;und kann mit ExplorerFileGetGadgetItemState abgefragt werden.
   
   Protected j 
   Protected name.s
   Protected groesse.s, typ.s, datum.s
   
   ;Wert für GetGadgetItemData um Files und Ordner zu unterscheiden, wird in Update der Lv-Zeile zugewiesen
   Protected state
         
   If ExamineDirectory(0, path, "*.*")  
      While NextDirectoryEntry(0)
         
         name = DirectoryEntryName(0)
         
         ;folgende Einträge überspringen
         If name = ".":  Continue: EndIf
         If DirectoryEntryAttributes(0) & #PB_FileSystem_System: Continue: EndIf 
         If DirectoryEntryAttributes(0) & #PB_FileSystem_Hidden: Continue: EndIf
         
         ;es geht weiter
         groesse = Str(Round(DirectoryEntrySize(0) / 1024, #PB_Round_Up)) + " Kb"
         If groesse = "0 Kb": groesse = "": EndIf
         
         If DirectoryEntryType(0) = #PB_DirectoryEntry_Directory
            state = #my_Explorer_Dir         
            typ = "Ordner"
            If name = "..": state = #my_Explorer_Root: typ = path: EndIf
         Else
            state = #my_Explorer_File
            typ = UCase(GetExtensionPart(name)) 
            
            Select typ
               Case "PB":     typ = "PureBasic"
               Case "PBI":    typ = "PB Include"
               Case "JPG":    typ = "Bild"
               Case "JPEG":   typ = "Bild"
               Case "EXE":    typ = "Anwendung"
               Case "DLL":    typ = "Bibliothek"
               Case "CHM":    typ = "Hilfe Datei"
               ;case usw.   
               Default:       typ + " Datei" 
            EndSelect
            
         EndIf
         
         datum = FormatDate("%dd.%mm.%yyyy - %hh:%ii:%ss", DirectoryEntryDate(0, #PB_Date_Modified)) 
         
         j + 1
         If j > #my_Explorer_Dirmax: Break: EndIf
         entry(j) = Str(state) + name + #LF$ + groesse + #LF$  + typ + #LF$ + datum
         
      Wend
      FinishDirectory(0)
      
   EndIf
     
   ReDim entry(j)   
   SortArray(entry(), #PB_Sort_NoCase)

ProcedureReturn j   
EndProcedure

Procedure.i ExplorerFileGadgetIcon(entry.s)
   
   Protected info.SHFILEINFO, flags = #SHGFI_ICON | #SHGFI_USEFILEATTRIBUTES | #SHGFI_SMALLICON
   
   Protected p = FindString(entry, #LF$, 1)
   
   entry = Left(entry, p - 1) ;:Debug entry
  
   SHGetFileInfo_(entry, #FILE_ATTRIBUTE_NORMAL, info, SizeOf(SHFILEINFO), flags)
  
ProcedureReturn info\hIcon   
EndProcedure

Procedure.i ExplorerFileGadgetUpdate(nr, path.s = "")
   
   ;hängt immer ein \ an wenn nicht vorhanden !!!
   ;liest Ordner ins entry Feld ein
   ;zeigt Daten an
   ;schreibt Pfad in LV-Data Bereich !
   
   If Not IsGadget(nr): ProcedureReturn: EndIf
   
   path = Trim(path)
   If Not path
      ;falls ExplorerFileGadgetUpdate() ohne Path aufgerufen wird
      path = ExplorerFileGetGadgetText(nr)   ;wenn ""
      If Not path: path = "C:\": EndIf       ;dann c:\
   EndIf
   
   If Right(path, 1) <> "\": path + "\": EndIf
   If Mid(path, 2, 1) <> ":": path = Left(GetCurrentDirectory(), 2) + path: EndIf

   Static diricon, rooticon, driveicon, fileicon, icon, cursor_ori, cursor_app
   
   If Not diricon
      diricon = ExtractIcon_(0,"Shell32.dll", 3)
      fileicon = ExtractIcon_(0,"Shell32.dll", 0)
      rooticon = ExtractIcon_(0,"Shell32.dll", 146)
      driveicon = ExtractIcon_(0,"Shell32.dll", 7)
      cursor_ori = GetClassLongPtr_(GetParent_(GadgetID(nr)), #GCL_HCURSOR) 
      cursor_app = LoadCursor_(0, #IDC_APPSTARTING)           
   EndIf
   
   SetCursor_(cursor_app) 
   ShowCursor_(#True)
   
   Protected Dim entry.s(#my_Explorer_Dirmax), anz, j , state, item = 0
   
   anz = ExplorerFileGadgetRead(entry(), path)                    ;:Debug path: Debug anz
   
   SendMessage_(GadgetID(nr), #WM_SETREDRAW, #False, 0)           ;oder HideGadget(nr, 1) für schnelles anzeigen

   ClearGadgetItems(nr)
   
   If anz
      state = Val(Left(entry(1), 1))
      ;wenn es kein Root Eintrag gibt
      If state <> #my_Explorer_Root
         AddGadgetItem(nr, item, "..", rooticon)
         SetGadgetItemColor(nr, item, #PB_Gadget_FrontColor, #Red, 0)
         SetGadgetItemText(nr, item, path, 2)
         SetGadgetItemData(nr, item, #my_Explorer_Root)
         item + 1
      EndIf
      For j = 1 To anz
         state = Val(Left(entry(j), 1))   
         If state = #my_Explorer_Root
            AddGadgetItem(nr, item, Mid(entry(j), 2), rooticon)   ;state im String überspringen
            SetGadgetItemColor(nr, item, #PB_Gadget_FrontColor, #Red, 0)
            SetGadgetItemData(nr, item, state)
            item + 1
         ElseIf state = #my_Explorer_Dir
            AddGadgetItem(nr, item, Mid(entry(j), 2), diricon)
            SetGadgetItemColor(nr, item, #PB_Gadget_FrontColor, #Blue, 0)
            SetGadgetItemData(nr, item, state)
            item + 1
         Else
            icon = fileicon
            If anz < #my_Explorer_ReadIcon
               icon = ExplorerFileGadgetIcon(path + Mid(entry(j), 2))
            EndIf
            AddGadgetItem(nr, item, Mid(entry(j), 2), icon)
            SetGadgetItemData(nr, item, state)
            item + 1
         EndIf   
      Next
   Else
      ;wenn anz null, dann falsches Lw im Path !
      ;ist Absicht, wenn vom Root Verzeichnis zurück gegangen wird
      ;oder Fehler beim Aufruf vom ExplorerFileGadget() mit falschem Lw im Path
      anz = ExplorerFileGadgetDrives(entry())
      For j = 1 To anz
         AddGadgetItem(nr, -1, Mid(entry(j), 2), driveicon)
         state = Val(Left(entry(j), 1))
         SetGadgetItemData(nr, j - 1, #my_Explorer_Drive)
      Next 
   EndIf
      
   Protected mem = GetGadgetData(nr)  
   PokeS(mem, path, #MAX_PATH)
   
   ;Spaltenbreite
   SendMessage_(GadgetID(nr), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE_USEHEADER)
   SendMessage_(GadgetID(nr), #LVM_SETCOLUMNWIDTH, 2, #LVSCW_AUTOSIZE_USEHEADER)
   If GetGadgetItemAttribute(nr, 0, #PB_ListIcon_ColumnWidth, 2) > 120
      SetGadgetItemAttribute(nr, 0, #PB_ListIcon_ColumnWidth, 120, 2)
   EndIf
   SendMessage_(GadgetID(nr), #LVM_SETCOLUMNWIDTH, 3, #LVSCW_AUTOSIZE_USEHEADER)
      
   SendMessage_(GadgetID(nr), #WM_SETREDRAW, #True, 0)         ;oder HideGadget(nr, 0)

   SetCursor_(cursor_ori) 
   ShowCursor_(#True)

EndProcedure

Procedure.i ExplorerFileGadgetCallback(hWnd, msg, wParam, lParam)

   Protected *p.ExplorerGadgetCallback = GetWindowLongPtr_(hWnd, #GWL_USERDATA) 
      
   If msg = #WM_LBUTTONDBLCLK        ;515
 
      Protected HitPosi.LVHITPOSITION
      Protected HitInfo.LVHITTESTINFO 
      
      HitPosi\lparam = lParam         
      Hitinfo\pt\x = HitPosi\pt\x
      HitInfo\pt\y = HitPosi\pt\y
      SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, HitInfo)
      
      Protected nr, mem, path.s, anz, j, endg.s, state
      
      ;pbnr holen, path + state lesen
      nr = GetDlgCtrlID_(hwnd)
      mem = GetGadgetData(nr)
      path = PeekS(mem)         
      state = GetGadgetItemData(nr, hitinfo\iitem)
      
      ;Debugl(hitinfo\iitem)
      ;Debugl(hitinfo\isubitem) 
      ;Debugs(path)   
      ;Debugl(state)
      
      If state = #my_Explorer_Drive             
         ;Laufwerk angeklickt oder ".." im Root Verzeichnis
         path = GetGadgetItemText(nr, hitinfo\iitem)
         ExplorerFileGadgetUpdate(nr, path)
         
      ElseIf state = #my_Explorer_Root
         ;zurück ".." angeklickt
         anz = CountString(path, "\")
         If anz > 1               
            For j = Len(path) - 1 To 1 Step -1
               If  Mid(path, j, 1) = "\": Break: EndIf
            Next                              
            path = Left(path, j) 
            ExplorerFileGadgetUpdate(nr, path)  
         Else
           ;wenn ".." im Root Verzeichnis angeklickt, dann falsches Lw zuweisen damit Drives gelesen werden
            path = "1" 
            ExplorerFileGadgetUpdate(nr, path)
         EndIf
         
      ElseIf state = #my_Explorer_Dir
         path + GetGadgetItemText(nr, hitinfo\iitem)
         ExplorerFileGadgetUpdate(nr, path)
         
      ElseIf state = #my_Explorer_File    
         If *p\flag & #my_Explorer_Run
            path + GetGadgetItemText(nr, hitinfo\iitem)
            endg = LCase(GetExtensionPart(path))
            Select endg
               Case "txt"
                  RunProgram("Notepad", path, "")
               Case "jpg", "jpeg", "pb", "pbi"     ;usw
                  RunProgram(path)
            EndSelect
         EndIf   
      EndIf

   EndIf

ProcedureReturn CallWindowProc_(*p\lpPrevFunc, hWnd, msg, wParam, lParam)
EndProcedure

Procedure.i ExplorerFileGadget(nr, x, y, br, hh, path.s, flag = 0)
         
   Protected *p.ExplorerGadgetCallback    ;um mehr als einen Wert an den Callback zu übergeben
   *p = AllocateMemory(SizeOf(ExplorerGadgetCallback))
   *p\flag = flag
   
   Protected id 
   Protected lvflags = #PB_ListIcon_MultiSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect
   
   If nr = #PB_Any
      nr = ListIconGadget(#PB_Any, x, y, br, hh, "Name", 150, lvflags)   
   Else
      id = ListIconGadget(nr, x, y, br, hh, "Name", 150, lvflags)   
   EndIf
   
   AddGadgetColumn(nr, 1, "Größe", 80)
   AddGadgetColumn(nr, 2, "Typ", 120)
   AddGadgetColumn(nr, 3, "Datum", 120)
   
   ;subclassing
   *p\lpPrevFunc = SetWindowLongPtr_(GadgetID(nr), #GWL_WNDPROC, @ExplorerFileGadgetCallback())
   SetWindowLongPtr_(GadgetID(nr), #GWL_USERDATA, *p)
   
   ;Format: fmt = #LVCFMT_CENTER, #LVCFMT_LEFT, #LVCFMT_RIGHT

   Protected lv.LV_COLUMN 
   lv\mask = #LVCF_FMT 
   lv\fmt  = #LVCFMT_RIGHT 
   SendMessage_(GadgetID(nr), #LVM_SETCOLUMN, 1, lv) 
   
   lv\fmt  = #LVCFMT_CENTER 
   SendMessage_(GadgetID(nr), #LVM_SETCOLUMN, 2, lv)
   
   Protected exstyle = SendMessage_(GadgetID(nr), #LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
   SendMessage_(GadgetID(nr), #LVM_SETEXTENDEDLISTVIEWSTYLE, 0, exstyle | #LVS_EX_LABELTIP)
   
   ;Platz für Path und mem merken im LV
   Protected mem = AllocateMemory(#MAX_PATH + 2)
   SetGadgetData(nr, mem)  
   
   ;Directory lesen
   ExplorerFileGadgetUpdate(nr, path)
   
   If id
      ProcedureReturn id
   Else
      ProcedureReturn nr   
   EndIf
   
EndProcedure

Code: Alles auswählen

Define event, nr, item, state
   
OpenWindow(0, 100, 100, 500, 600, "ListIcon Example", #PB_Window_SystemMenu)
nr = ExplorerFileGadget(#PB_Any, 5, 5, 490, 590, "c:\")
       
Repeat
   Event = WaitWindowEvent()
   
   If event = #PB_Event_Gadget
      If EventGadget() = nr 
         Select EventType()
            Case #PB_EventType_LeftClick
               Debug ExplorerFileGetGadgetText(nr) 
               item = GetGadgetState(nr)
               state = ExplorerFileGetGadgetItemState(nr, item)
               If state & #PB_Explorer_Directory
                  Debug GetGadgetItemText(nr, item) + " ist ein Dir"
               ElseIf state & #PB_Explorer_File
                  Debug GetGadgetItemText(nr, item) + " ist ein File"
               EndIf
               If ExplorerFileGetGadgetItemState(nr, 3) & #PB_Explorer_Selected
                  Debug "item 3 ist selected"
               EndIf   
         EndSelect         
      EndIf
   EndIf
   
Until Event = #PB_Event_CloseWindow
   

Edit: Default in ExplorerFileGetGadgetItemState hinzugefügt

[RSBasic]

@hjbremer

[hjbremer]

damit es jeder, den es interressiert mitbekommt

Edit: Default in ExplorerFileGetGadgetItemState hinzugefügt

kann wichtig sein, wenn man das Root selected hat.

[ts-soft]

Läuft auch unter x64 ohne Probleme!

Mir fehlen noch die Datei-Attribute und der Pfad in Type sollte gekürzt werden,
z.B. mit dieser API:

Code: Alles auswählen

Procedure.s SetCompactPath(gadget.i, path.s)
  Protected hdc.i

  hdc = GetDC_(GadgetID(gadget))
  PathCompactPath_(hdc, path, GadgetWidth(gadget))
  ProcedureReturn path
EndProcedure 

Muss aber angepasst werden!

Gruß
Thomas

[hjbremer]

Für alle die es gebrauchen können.
Hier ein weiteres Update, welches etwas mehr kann.
Jedes ExplorerFileGadget hat ein allgemeines PopUpMenu, welches man erweitern kann. Kleine Hilfe. Gibt die selektierten Files in einem Array zurück. etc

Die Demo zeigt alle Icons in einem File an und kann diese speichern, als PNG Bilder. Ist einfacher als Icons. Mit Strg A alles markieren, im Menu Icon speichern wählen und diese werden im aktuellen Verzeichnis im Ordner Icon von allen Files eines Verzeichnisses abgelegt.
Aber Achtung, im System32 Ordner sind über 3000 Icons enthalten.

hier die Include Datei, danach das Demo Programm

Code: Alles auswählen

XIncludeFile "\Bremer\PureBasicPbi\debugmacros.pbi"
XIncludeFile "\Bremer\PureBasicPbi\translateLvMsg.pbi"

;ExplorerFileGadget, ersetzt ExplorerListGadget
; ab PB 4.41, getestet unter Windows Vista x86 32 Bit - 15.02.2011

; ExplorerFileGadget(#explorer, 5, 5, 490, 590, path, [flags, @Menuaddproc(), #statusbar, statusfeld])
;    bis path die gleichen Parameter wie ExplorerListGadget(), incl. #PB_Any
;    es gibt 2 Flags
;    #efg_Run = startet Eintrag durch Doppelclick mittels RunProgram()
;    #efg_Path = weiter zurück als der Startpath geht es nicht.  
;    
;    @Menuaddproc() = Adresse einer Prozedur für eigene Menueinträge, siehe Demo
;    statusbar = pbnr der Statusbar, wenn es eine gibt und diese benutzt werden soll
;    statusfeld = nummer des Feldes in welches die Infos sollen
;
; am Ende des MainProgramms sollte ExplorerFileGadgetFree(tree) für jedes Gadget aufgerufen werden, 
; um die internen Icons zu löschen. Sonst ist der Speicher irgendwann voll (ca 500 Gadgetaufrufe)
;
; Da ich mit RegEx auf Kriegsfuß stehe, funktioniert * und ? nur als enthalten Kriterium im Filter.
;
; ExplorerFileGadgetUpdate() kann/muß auch vom Programm aus aufgerufen werden, 
; wenn das aktuelle Verzeichnis verändert wurde.
; -------------------------------------------------------------------------------------------------
;
; Die folgenden Befehle sind Macros, wer die ProzedurNamen nicht mag, kann diese ändern
;
; ExplorerFile_GetFirstSelect(tree)
;    gibt den ersten markierten Eintrag zurück, ist gleich GetGadgetState(tree)
; 
; ExplorerFile_GetFilename(tree, item)
;    gibt den durch item bezeichneten Eintrag incl. Pfad zurück
; 
; ExplorerFile_GetPath(tree)
;    gibt den Pfad zurück, inclusive "\" am Ende
; 
; ExplorerFile_GetFileState(tree, item)
;    gibt folgende Werte zurück
;       #PB_Explorer_File      : Der Eintrag ist eine Datei.
;       oder
;       #PB_Explorer_Directory : Der Eintrag ist ein Verzeichnis
;       zusätzlich, wenn markiert
;       #PB_Explorer_Selected  : Der Eintrag ist ausgewählt.
;       oder null, wenn obiges nicht zutrifft   
;       
; ExplorerFile_GetSelectedItems(tree, items()) 
;    gibt ein Array zurück mit den markierten Items
;    das Array muß vorher mit Dim xyz(0) definiert werden
;    die markierten Items finden sich ab Index 1 im Array
;    Rückgabewert ist die Anzahl, diese steht ebenfalls im Index 0
;    es wird hier auch die oberste Zeile im Tree mit berücksichtigt !!
; 
; ExplorerFile_GetSelectedFiles(tree, items(), withpath = 0, withdir = 0) 
;    im Gegensatz zu GetSelectedItems werden die Inhalte ausgelesen.
;    die markierten Items finden sich ab Index 1 im Array
;    Rückgabewert ist die Anzahl, diese steht ebenfalls im Index 0 
;    Es werden nur Files und/oder Ordner berücksichtigt !! keine Laufwerke !
;    mit Path, wenn Parameter withpath 1 ist. Ordner nur wenn withdir 1 ist.
;    es wird hier NICHT die oberste Zeile im Tree berücksichtigt !!
;    
;    Dim xyz.s(0)
;    item = ExplorerFile_GetSelectedFiles(#explorer, xyz(), 1, 1)
;    For j = 1 To item
;       Debug xyz(j)
;    Next
;    
; ExplorerFile_SetUncPath(tree, path) 
;    auf besonderen Wunsch kann man einen sogenannten UNC Path angeben
;    obs funktioniert ? keine Ahnung ! mit "\\127.0.0.1\c$" geht es scheinbar.
;    allerdings um ca Faktor 2 langsamer. Liegt wohl an Windows.
;    Dieser Befehl muß nach dem Erstellen aufgerufen werden.
; -------------------------------------------------------------------------------------------------

;Declare muß sein, da ich die Reihenfolge der Prozeduren nicht ändern will
Declare.i ExplorerSHOperation(operation, qtree, ztree = 0, new.s = "", flag = 0)
Declare.i ExplorerSHProperties(tree)
Declare.s ExplorerSHSpecialFolder(CSIDL)
Declare.i ExplorerSHGetImage(endg.s)

UsePNGImageDecoder()

EnableExplicit

Structure ExplorerFileGadgetMemory  ;jedes ExplorerFileGadget() hat sein eigenes Memory, für Callback, UpDate etc
   lpPrevFunc.i                     ;subclassing Returnwert
   tree.i                           ;pbnr vom LV, die Anweisung GetDlgCtrlId(hwnd) im Callback ergäbe den gleichen Wert.
   popup.i                          ;PopUp 
   menuproc.i                       ;Funktionszeiger auf externe MenuProzedur
   progflags.i                      ;es gibt 2 flags, #efg_run + #efg_path
   statusbar.i                      ;
   statusfeld.i                     ;
   filterregex.i                    ;Rückgabewert von Regex
   hicon.i[21]                      ;Standard Icons 0 - 20
   hcursorOri.i                     ;Cursor 
   hcursorWait.i                    ;Cursor 
   path.s{#MAX_PATH + 2}            ; + 2 zur Sicherheit
   pathstart.s{#MAX_PATH + 2}       ;Startpath
   *anzahl.size                     ;Sternchen muß sein, da von ReadDir ein Zeiger zugewiesen wird 
   path_unc.s{#MAX_PATH + 2}        ;
EndStructure

Structure HiLoWord
   loword.w
   hiword.w
EndStructure

Structure CBHITPOSITION
   StructureUnion       ;für Callback Hitinfo um lParam oder wParam aufzuteilen
      param.i           ;für lParam oder wParam
      pt.PointS         ;points besteht aus 2 Word, für LoWord und Hiword
      pa.HiLoWord       ;teilt lparam/wparam ebenfalls in LoWord und Hiword
   EndStructureUnion
EndStructure

#efg_Root = 1           ;interne Kennzeichnungen, nicht benutzen     
#efg_Dir  = 2           
#efg_File = 3 
#efg_Drive = 4 
#efg_Special = 5 
#efg_UncPath = 6 

#efg_Run = 16           ;RunProgram starten bei Doppelclick auf File
#efg_Path = 32          ;es geht es nicht weiter zurück als bis zum Startpath
#efg_Dirmax = 30000     ;max Anzahl Einträge pro Dir 

Enumeration 
   #efg_MenuNewDir
   #efg_MenuCopy
   #efg_MenuMove
   #efg_MenuDelete
   #efg_MenuRename
   #efg_MenuFilter
   #efg_MenuSHinfo
   #efg_MenuListe
   #efg_MenuLarge
EndEnumeration 

Enumeration 
   #efg_IconBack   
   #efg_IconRoot     ;Liste
   #efg_IconDir      ;Liste + Popup
   #efg_IconSpec     ;Liste
   #efg_IconUnc      ;Liste
   #efg_IconFile     ;Liste
   #efg_IconPic      ;File
   #efg_IconText     ;File
   #efg_IconDll      ;File
   #efg_IconHlp      ;File
   #efg_IconPB       ;File
   #efg_IconDelete   ;Popup
EndEnumeration

Macro ExplorerFile_GetFirstSelect(tree)
   GetGadgetState(tree) 
EndMacro

Macro ExplorerFile_GetFilename(tree, item)
   ExplorerFileGadgetGetPath(tree) + GetGadgetItemText(tree, item) 
EndMacro

Macro ExplorerFile_GetPath(tree)
   ExplorerFileGadgetGetPath(tree)
EndMacro

Macro ExplorerFile_GetFileState(tree, item)
   ExplorerFileGadgetGetItemState(tree, item)
EndMacro

Macro ExplorerFile_GetSelectedItems(tree, items) 
   ExplorerFileGadgetGetSelectedItems(tree, items)
EndMacro

Macro ExplorerFile_GetSelectedFiles(tree, items, withpath = 0, withdir = 0) 
   ExplorerFileGadgetGetSelectedFiles(tree, items, withpath, withdir)
EndMacro

Macro ExplorerFile_SetUncPath(tree, path) 
   ExplorerFileGadgetSetUncPath(tree, path)  
EndMacro

Procedure.i ExplorerFileGadgetSetUncPath(tree, path.s = "")
   
   Protected *p.ExplorerFileGadgetMemory = GetWindowLongPtr_(GadgetID(tree), #GWL_USERDATA)
   
   If Not path: path = "\\127.0.0.1\c$": EndIf
   
   *p\path_unc = path
   
EndProcedure

Procedure.i ExplorerFileGadgetGetItemState(tree, item)
   
   Protected state = 0
   
   If IsGadget(tree)
      state = GetGadgetItemData(tree, item) 
      Select state
         Case #efg_File: state = #PB_Explorer_File
         Case #efg_Dir:  state = #PB_Explorer_Directory
         Default: state = #PB_Explorer_None
      EndSelect
      If GetGadgetItemState(tree, item) = #PB_ListIcon_Selected
         state | #PB_Explorer_Selected
      EndIf
   EndIf
   
   ProcedureReturn state   
EndProcedure

Procedure.s ExplorerFileGadgetGetPath(tree)
   
   Protected *p.ExplorerFileGadgetMemory = GetWindowLongPtr_(GadgetID(tree), #GWL_USERDATA)
   
   ProcedureReturn  *p\path   
EndProcedure

Procedure.i ExplorerFileGadgetGetSelectedItems(tree, Array items(1))   
   
   Protected j, p = -1
   Protected anz = SendMessage_(GadgetID(tree), #LVM_GETSELECTEDCOUNT, 0, 0)
   ReDim items(anz)
   
   For j = 1 To anz      
      p = SendMessage_(GadgetID(tree), #LVM_GETNEXTITEM, p, #LVNI_SELECTED)
      items(j) = p
   Next    
   items(0) = anz
   
   ProcedureReturn anz
EndProcedure

Procedure.i ExplorerFileGadgetGetSelectedFiles(tree, Array items.s(1), withpath = 0, withdir = 0)   

   Protected *p.ExplorerFileGadgetMemory = GetWindowLongPtr_(GadgetID(tree), #GWL_USERDATA)
   
   Protected j, nr = 0, item = -1, state
   Protected anz = SendMessage_(GadgetID(tree), #LVM_GETSELECTEDCOUNT, 0, 0)
   ReDim items(anz)
   
   For j = 1 To anz      
      item = SendMessage_(GadgetID(tree), #LVM_GETNEXTITEM, item, #LVNI_SELECTED)
      state = ExplorerFile_GetFileState(tree, item)
      If state & #PB_Explorer_Directory And withdir
         state = #PB_Explorer_File
      EndIf   
      If state & #PB_Explorer_File
         nr + 1
         If withpath
            items(nr) = *p\path + GetGadgetItemText(tree, item)
         Else
            items(nr) = GetGadgetItemText(tree, item)
         EndIf   
      EndIf      
   Next    
   items(0) = Str(nr)
   
   ProcedureReturn nr
EndProcedure

Procedure.i ExplorerFileGadgetHelp(tree)
   
   Protected info.s
   
   info = "Rechtsclick" + #TAB$ + "= PopUpMenu" + #LF$ 
   info + "Doppelclick 1.Zeile" + #TAB$ + "= im Verzeichnisbaum zurück" + #LF$
   info + "Doppelclick auf File" + #TAB$ + "= Anzeigen/starten (wenn erlaubt)" + #LF$
   info + "Einträge markieren" + #TAB$ + "= Shift bzw. Strg drücken und Einträge wählen" + #LF$ 
   info + #LF$
   info + "Backspace" + #TAB$ + "= ein Verzeichnis zurück, wie Doppelclick auf .. " + #LF$
   info + "F12" + #TAB$ + "= zurück zur Laufwerksauswahl springen" + #LF$
   info + "F5" + #TAB$ + "= Anzeige aktualisieren + Drive Memory anzeigen" + #LF$
   info + "Entf" + #TAB$ + "= markierte Einträge löschen" + #LF$
   info + "Einfg" + #TAB$ + "= neuen Ordner erstellen" + #LF$
   info + "F2" + #TAB$ + "= markierte Einträge umbenennen" + #LF$
   info + "Strg + A" + #TAB$ + "= alles markieren" + #LF$
   info + "Strg + C" + #TAB$ + "= Path ins Clipboard kopieren" + #LF$
   info + #LF$
   info + "Pos1" + #TAB$ + "= zum Listenanfang" + #LF$
   info + "Ende" + #TAB$ + "= zum Listenende" + #LF$
   info + "Bild" + #TAB$ + "= Seite vor/zurück blättern" + #LF$
   info + "A-Z" + #TAB$ + "= zum ersten Eintrag der mit dem Zeichen beginnt" + #LF$   
   info + #LF$   
   MessageRequester(ExplorerFile_GetPath(tree), info)
   
EndProcedure

Procedure.i ExplorerFileGadgetReadDrives(Array drives.s(1))
   
   ;wird von ExplorerFileGadgetUpdate() aufgerufen   
   Protected drive$ = Space(#MAX_PATH)
   Protected memory = @drive$   
   Protected anzahl = GetLogicalDriveStrings_(#MAX_PATH, memory) / 4
   Protected state  = #efg_Drive
   Protected j, lw.s, typ.s, name.s
   
   ReDim drives(anzahl)
   
   For j = 1 To anzahl
      lw = PeekS(memory)
      memory + 4      
      Select GetDriveType_(lw)
         Case #DRIVE_REMOVABLE:  typ = "Diskettenlaufwerk"  ;2
         Case #DRIVE_FIXED:      typ = "Festplatte"         ;3
         Case #DRIVE_REMOTE:     typ = "Netzwerk"           ;4
         Case #DRIVE_CDROM:      typ = "CD-Rom"             ;5
         Case #DRIVE_RAMDISK:    typ = "Ram-Disk"           ;6
                     Default:    typ = "unbekannt"          ;0 + 1
      EndSelect            
      name = Space(#MAX_PATH)
      GetVolumeInformation_(lw, @name, #MAX_PATH, 0,0,0,0,0)      
      drives(j) = Str(state) + lw + #LF$ + #LF$ + Trim(name) + " " + Trim(typ)      
   Next
   
   ;Special Ordner, siehe auch Callback bei "state = #efg_Special"
   ;die Namen wie APPDATA, DOCUMENTS etc müssen hier und da gleich sein !! 
   Protected special = 3   
   ReDim drives(anzahl + special)
   drives(anzahl + 1) = Str(#efg_Special) + "APPDATA" + #LF$ + #LF$ + "Special" 
   drives(anzahl + 2) = Str(#efg_Special) + "DOCUMENTS" + #LF$ + #LF$ + "Special" 
   drives(anzahl + 3) = Str(#efg_Special) + "PUREBASIC" + #LF$ + #LF$ + "Special" 

   ProcedureReturn anzahl + special
EndProcedure

Procedure.i ExplorerFileGadgetReadDir(Array entry.s(1), path.s, tree = 0)
   
   ;schreibt alle Einträge von path ins entry Feld (ohne die Inhalte aus Unterverzeichnissen)
   
   ;und setzt eine Zahl (state) davor, welche die Art des Eintrages kennzeichnet, Dir File etc
   ;diese Zahl wird dann in den Data Bereich einer Zeile des LV geschrieben und dient zum Sortieren
   ;und zum internen Unterscheiden der Einträge. Ein Eintrag kann nur einen statewert haben.
   
   ;ExplorerFile_GetGadgetItemState übersetzt diese Info in die PB Werte für File, Dir, Selected.
   
   ;ExplorerFileGadgetUpdate() benutzt diese Prozedur
   
   Protected j, count, state
   Protected typ.s, name.s, groesse.s, datum.s
   Protected attributtext.s, attribute
   
   Static anzahl.size
   anzahl\cx = 0: anzahl\cy = 0
   
   If ExamineDirectory(0, path, "*.*")  
      While NextDirectoryEntry(0)
         
         typ = ""
         name = DirectoryEntryName(0)
         
         ;folgende Einträge überspringen
         If name = ".":  Continue: EndIf
         If DirectoryEntryAttributes(0) & #PB_FileSystem_System: Continue: EndIf 
         If DirectoryEntryAttributes(0) & #PB_FileSystem_Hidden: Continue: EndIf
         
         ;es geht weiter
         groesse = Str(Round(DirectoryEntrySize(0) / 1024, #PB_Round_Up)) + " Kb"
         
         If DirectoryEntryType(0) = #PB_DirectoryEntry_Directory
            If groesse = "0 Kb": groesse = "": EndIf
            state = #efg_Dir         
            typ = "Ordner"
            If name = ".."
               state = #efg_Root
               count = CountString(path, "\")   ;:debugl(count):debugs(path)
               If count: typ = "..\" + StringField(path, count, "\"): EndIf
            EndIf
            anzahl\cx + 1            
         Else
            state = #efg_File
            typ = UCase(GetExtensionPart(name)) 
            Select typ
               Case "PB":     typ = "PureBasic"
               Case "PBI":    typ = "PB Include"
               Case "JPG":    typ = "Bild"
               Case "JPEG":   typ = "Bild"
               Case "EXE":    typ = "Anwendung"
               Case "DLL":    typ = "Bibliothek"
               Case "CHM":    typ = "Hilfe Datei"
                  ;case usw.   
               Default:       typ + " Datei" 
            EndSelect
            anzahl\cy + 1
         EndIf
         
         datum = FormatDate("%dd.%mm.%yyyy - %hh:%ii:%ss", DirectoryEntryDate(0, #PB_Date_Modified)) 
         
         ;attribute = DirectoryEntryAttributes(0)  ;:Debug attribute         
         ;attributtext = ""
         ;If attribute & #PB_FileSystem_ReadOnly   : attributtext + "Read ": EndIf
         ;If attribute & #PB_FileSystem_Archive    : attributtext + "Archiv ": EndIf
         ;If attribute & #PB_FileSystem_Compressed : attributtext + "Compr. ": EndIf
         ;If attribute & #PB_FileSystem_System     : attributtext + "System ": EndIf
         ;If attribute & #PB_FileSystem_Hidden     : attributtext + "Hidden ": EndIf
         ;If attribute & 8192                      : attributtext + "noIndex": EndIf
         
         j + 1
         If j > #efg_Dirmax: Break: EndIf
         entry(j) = Str(state) + name + #LF$ + groesse + #LF$  + typ + #LF$ + datum ;+ #LF$ + attributtext
         
      Wend
      FinishDirectory(0)
      
   EndIf
   
   ReDim entry(j)   
   SortArray(entry(), #PB_Sort_NoCase)
   
   ProcedureReturn anzahl   
EndProcedure

Procedure.i ExplorerFileGadgetFilter(entry.s, filterregex)
   
   Protected name.s, p
   
   p = FindString(entry, #LF$, 1)
   If p: name = Left(entry, p - 1): Else: name = entry: EndIf   
   
   If filterregex      
      If MatchRegularExpression(filterregex, LCase(name)) 
         ProcedureReturn #True          
      EndIf
   EndIf  
   
   ProcedureReturn #False   
EndProcedure

Procedure.i ExplorerFileGadgetFilterInput(tree)
   
   Protected *p.ExplorerFileGadgetMemory = GetWindowLongPtr_(GadgetID(tree), #GWL_USERDATA)
   
   Static oldpattern.s
   Protected pattern.s, regex
   
   Repeat
      
      pattern = InputRequester("Dateifilter: leer = alle Dateien", "z.B. *.dll, *.exe, 20*.txt, 200?hb.* durch Komma getrennt", oldpattern)
      oldpattern = pattern
      If Not pattern: regex = 0: Break: EndIf
      
      pattern = ReplaceString(pattern, " " , "" )
      pattern = ReplaceString(pattern, "," , "|" )
      pattern = ReplaceString(pattern, "." , "\." )
      pattern = ReplaceString(pattern, "*" , ".*" )
      pattern = ReplaceString(pattern, "?" , "." )
      
      regex = CreateRegularExpression(#PB_Any, pattern)     ;:Debug pattern
      If Not regex
         MessageRequester("Fehler", oldpattern + #LF$ + #LF$ + pattern + #LF$ + #LF$ + RegularExpressionError())
      EndIf
      
   Until regex
   
   ;falls es einen alten RegEx gibt, diesen löschen   
   If IsRegularExpression(*p\filterregex)
      FreeRegularExpression(*p\filterregex)
   EndIf
   
   *p\filterregex = regex    
   
EndProcedure

Procedure.i ExplorerFileGadgetReadDriveSpace(tree)
   
   Protected *p.ExplorerFileGadgetMemory = GetWindowLongPtr_(GadgetID(tree), #GWL_USERDATA)   
   
   Protected freeBytes.q, totalBytes.q, freeinfo.s
   
   If *p\statusbar > -1
      GetDiskFreeSpaceEx_(@*p\path, @freeBytes, @totalBytes, 0)   
      freeinfo = Left(*p\path, 2) + " "
      freeinfo + Str(freeBytes / (1024 * 1024)) + " MB frei von "
      freeinfo + Str(totalBytes  / (1024 * 1024))
      freeinfo + " - "
      freeinfo + "Ordner: " + Str(*p\anzahl\cx - 1) + " / "
      freeinfo + "Dateien: " + Str(*p\anzahl\cy) 
      StatusBarText(*p\statusbar, *p\statusfeld, freeinfo)
   EndIf
   
EndProcedure

Procedure.i ExplorerFileGadgetUpdate(tree, path.s = "", readflag = 1, filterregex = -1)
   
   ;hängt immer ein \ an wenn nicht vorhanden !!!
   ;liest Ordner ein und zeigt diesen an
   ;schreibt Pfad in LV-GWL_USERDATA Structur !!! und wenn vorhanden in Statusbar
   ;readflag = 0, Ordner wird nicht gelesen, erzwingt zurück zur LwAuswahl
   ;readflag = 1, Ordner wird gelesen
   ;readflag = 3, Ordner wird gelesen + Infos, nur intern bei F5
   ;filterregex nur angeben wenn ein externer regex übergeben werden soll 
   ;oder der interne regex von außen gelöscht werden soll, dann null angeben
   
   If Not IsGadget(tree): ProcedureReturn: EndIf
   
   Protected *p.ExplorerFileGadgetMemory = GetWindowLongPtr_(GadgetID(tree), #GWL_USERDATA)
   
   path = Trim(path)
   If Not path
      ;falls ExplorerFileGadgetUpdate(...) ohne Path aufgerufen wird
      path = *p\path                      ;wenn ""
      If Not path: path = "C:\": EndIf    ;wenn im Explorermemory kein path dann c:\
   EndIf
   
   If Right(path, 1) <> "\": path + "\": EndIf
   
   If Left(path, 2) = "\\"          ;tue nix da UNC Path
   ElseIf Mid(path, 2, 1) <> ":"    ;wenn Lw fehlt
      path = Left(GetCurrentDirectory(), 2) + path
   EndIf   
   
   ;Path zuweisen
   *p\path = path
   
   ;Filter ? 
   If filterregex > 0: *p\filterregex = filterregex   ;existiert externer Filter ? 
   ElseIf filterregex = 0: *p\filterregex = 0         ;internen Filter von außen löschen
   EndIf
   
   ;Start Update Anzeige
   Protected Dim entry.s(#efg_Dirmax), anz, zeile.s, j , state, icon, item = 0, endung.s, shname.s, filterflag
   
   SetCursor_(*p\hcursorWait) 
   ShowCursor_(#True)
   
   If readflag & 1
      *p\anzahl = ExplorerFileGadgetReadDir(entry(), path)  ;cx = Ordner, cy = Files      
      anz = *p\anzahl\cx + *p\anzahl\cy                     ;:Debug *p\anzahl\cx: Debug *p\anzahl\cy
   EndIf
   
   ;Path anzeigen 
   If *p\statusbar > -1
      StatusBarText(*p\statusbar, *p\statusfeld, Str(anz) + " " + path)   
   EndIf
   
   If readflag & 2   ;F5 gedrückt    
      ExplorerFileGadgetReadDriveSpace(tree)
   EndIf 
   
   SendMessage_(GadgetID(tree), #WM_SETREDRAW, #False, 0)   ;besser als HideGadget(tree, 1) für schnelles anzeigen
   
   ClearGadgetItems(tree)
   
   If anz
      state = Val(Left(entry(1), 1))
      ;wenn es als 1. Eintrag kein Root gibt, einen hinzufügen, passiert nur im Root eines Laufwerkes z.B. C:\
      If state <> #efg_Root
         AddGadgetItem(tree, item, "..", *p\hicon[#efg_IconBack ])
         SetGadgetItemColor(tree, item, #PB_Gadget_FrontColor, #Red, 0)
         SetGadgetItemText(tree, item, path, 2)
         SetGadgetItemData(tree, item, #efg_Root)
         item + 1
      EndIf
      For j = 1 To anz
         zeile = Mid(entry(j), 2)
         state = Val(Left(entry(j), 1))
         If state = #efg_Root
            AddGadgetItem(tree, item, zeile, *p\hicon[#efg_IconRoot])   ;state im String überspringen
            SetGadgetItemColor(tree, item, #PB_Gadget_FrontColor, #Red, 0)
            SetGadgetItemData(tree, item, state)
            item + 1
         ElseIf state = #efg_Dir
            AddGadgetItem(tree, item, zeile, *p\hicon[#efg_IconDir])
            SetGadgetItemColor(tree, item, #PB_Gadget_FrontColor, #Blue, 0)
            SetGadgetItemData(tree, item, state)
            item + 1
         ElseIf state = #efg_File
            filterflag = #True
            If *p\filterregex
               filterflag = ExplorerFileGadgetFilter(zeile, *p\filterregex)  
            EndIf   
            If filterflag = #True            
               shname = path + StringField(zeile, 1, #LF$)  
               endung = LCase(GetExtensionPart(shname))
               Select endung
                  Case "dll":          AddGadgetItem(tree, item, zeile, *p\hicon[#efg_IconDll])
                  Case "txt":          AddGadgetItem(tree, item, zeile, *p\hicon[#efg_IconText])
                  Case "bmp", "jpg":   AddGadgetItem(tree, item, zeile, *p\hicon[#efg_IconPic])
                  Case "pb",  "pbi":   AddGadgetItem(tree, item, zeile, *p\hicon[#efg_IconPB])
                  Case "hlp", "chm":   AddGadgetItem(tree, item, zeile, *p\hicon[#efg_IconHlp])
                  Case "exe", "ico":   icon = ExplorerSHGetImage(shname)
                     AddGadgetItem(tree, item, zeile, icon): DestroyIcon_(icon) 
                  Case "png"
                     icon = LoadImage(#PB_Any, shname)
                     If icon
                        AddGadgetItem(tree, item, zeile, ImageID(icon)): FreeImage(icon)
                     Else   
                        AddGadgetItem(tree, item, zeile, *p\hicon[#efg_IconPic])
                     EndIf
                  Default: AddGadgetItem(tree, item, zeile, *p\hicon[#efg_IconFile])
               EndSelect
               SetGadgetItemData(tree, item, state)
               item + 1
            EndIf
         EndIf   
      Next
      
   Else
      ;LwAuswahl
      ;weil anz null, dann keine Daten im Path !
      ;oder readflag wurde im Callback gelöscht,
      ;oder falscher Path beim Aufruf vom ExplorerFileGadget() 
      anz = ExplorerFileGadgetReadDrives(entry())
      For j = 1 To anz
         zeile = Mid(entry(j), 2)
         state = Val(Left(entry(j), 1))
         If state = #efg_Drive
            shname = StringField(zeile, 1, #LF$)
            icon = ExplorerSHGetImage(shname)                     
            AddGadgetItem(tree, -1, zeile, icon): DestroyIcon_(icon)
            SetGadgetItemData(tree, j - 1, state)
         ElseIf state = #efg_Special          ;welche Specialordner wird in ..Drives festgelegt
            AddGadgetItem(tree, -1, zeile, *p\hicon[#efg_IconSpec])
            SetGadgetItemData(tree, j - 1, state)
         EndIf
      Next 
      If *p\path_unc          
         AddGadgetItem(tree, -1, "UNC" + #LF$ + #LF$ + "Unc", *p\hicon[#efg_IconUnc])
         SetGadgetItemData(tree, j - 1, #efg_UncPath)
      EndIf      
   EndIf
   
   ;Spaltenbreite
   ;SendMessage_(GadgetID(tree), #LVM_SETCOLUMNWIDTH, 1, #LVSCW_AUTOSIZE_USEHEADER)
   SendMessage_(GadgetID(tree), #LVM_SETCOLUMNWIDTH, 2, #LVSCW_AUTOSIZE_USEHEADER)
   SendMessage_(GadgetID(tree), #LVM_SETCOLUMNWIDTH, 3, #LVSCW_AUTOSIZE_USEHEADER)
   SendMessage_(GadgetID(tree), #LVM_SETCOLUMNWIDTH, 4, #LVSCW_AUTOSIZE_USEHEADER)
   
   SendMessage_(GadgetID(tree), #WM_SETREDRAW, #True, 0) ;oder HideGadget(tree, 0)
   
   SetCursor_(*p\hcursorOri) 
   ShowCursor_(#True)
   
EndProcedure

Procedure.i ExplorerFileGadgetNewDir(tree)   
   
   Static dirname.s   ;static damit eine Vorgabe da ist   
   Protected pfad.s = ExplorerFile_GetPath(tree) 
   
   dirname = Trim(InputRequester("Neues Verzeichnis", "Name", dirname)) 
   If Not dirname: ProcedureReturn: EndIf
   If CreateDirectory(pfad + dirname)
      ExplorerFileGadgetUpdate(tree)
   EndIf
   
EndProcedure

Procedure.i ExplorerFileGadgetCallback(hWnd, msg, wParam, lParam)
   
   ;wird *p\path verändert, dann sollte anschließend ExplorerFileGadgetUpDate() aufgerufen werden
   ;sonst kann es passieren, das ExplorerFile_GetGadgetText() nicht mit den angezeigten Daten übereinstimmt.
   
   Static controlflag
   Protected item, anz, j, state
   
   Protected *p.ExplorerFileGadgetMemory = GetWindowLongPtr_(hWnd, #GWL_USERDATA) 
   
   If msg = #WM_RBUTTONDOWN
      If GetGadgetItemData(*p\tree, 0) = #efg_Drive   ;in der LwAuswahl nix PopUp 
      Else
         DisplayPopupMenu(*p\popup, hwnd)
      EndIf   
      ProcedureReturn 0           ;muß sein, sonst Käse beim InputRequester in NewDir/Filter
      
   ElseIf msg = #WM_COMMAND
      
      Protected MenuPosi.CBHITPOSITION
      MenuPosi\param = wParam      
      If menuPosi\pa\hiword = 0   ;msg ist vom menue          
         Select menuPosi\pa\loword               
            Case #efg_MenuNewDir :ExplorerFileGadgetNewDir(*p\tree)               
            Case #efg_MenuMove   :ExplorerSHOperation(#FO_MOVE, *p\tree)   
            Case #efg_MenuCopy   :ExplorerSHOperation(#FO_COPY, *p\tree)
            Case #efg_MenuDelete :ExplorerSHOperation(#FO_DELETE, *p\tree)
            Case #efg_MenuRename :ExplorerSHOperation(#FO_RENAME, *p\tree)
            Case #efg_MenuSHinfo :ExplorerSHProperties(*p\tree)
            Case #efg_MenuListe  :SetGadgetAttribute(*p\tree, #PB_ListIcon_DisplayMode, #PB_ListIcon_Report)
            Case #efg_MenuLarge  :SetGadgetAttribute(*p\tree, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon)   
            Case #efg_MenuFilter :ExplorerFileGadgetFilterInput(*p\tree)
                                  ExplorerFileGadgetUpdate(*p\tree)   
            Default: If *p\menuproc
               CallFunctionFast(*p\menuproc, *p\tree, 0, menuPosi\pa\loword)
            EndIf
         EndSelect                 
      EndIf  
      
      ;ElseIf msg = #WM_ENTERIDLE
      ;Hilfe PopUp in Statusbar
      
   ElseIf msg = #WM_KEYDOWN
      
      Select wParam
         Case #VK_F1:      ExplorerFileGadgetHelp(*p\tree)              : ProcedureReturn 0  ;Hilfe
         Case #VK_F2:      ExplorerSHOperation(#FO_RENAME, *p\tree)     : ProcedureReturn 0  ;Rename
         Case #VK_F5:      ExplorerFileGadgetUpdate(*p\tree, *p\path, 3): ProcedureReturn 0  ;aktualisieren + Freespace
         Case #VK_F12:     ExplorerFileGadgetUpdate(*p\tree, "", 0)     : ProcedureReturn 0  ;zur LwAuswahl
         Case #VK_DELETE:  ExplorerSHOperation(#FO_DELETE, *p\tree)     : ProcedureReturn 0  ;löschen
         Case #VK_INSERT:  ExplorerFileGadgetNewDir(*p\tree)            : ProcedureReturn 0  ;neuen Ordner
         Case #VK_CONTROL: controlflag = 1
         Case #VK_A:
            If controlflag: controlflag = 0
               Protected lvi.lvitem               
               lvi\stateMask = #LVIS_SELECTED
               lvi\state = #LVIS_SELECTED
               SendMessage_(hwnd, #LVM_SETITEMSTATE, -1, lvi)
            EndIf
            
         Case #VK_C:       
            If controlflag: controlflag = 0
               item = GetGadgetState(*p\tree)
               Select item
                  Case -1, 0: SetClipboardText(*p\path)
                  Default:    SetClipboardText(*p\path + GetGadgetItemText(*p\tree, item))
               EndSelect
            EndIf   
            
         Case #VK_BACK: 
            ;Backspace oder Doppelclick auf ".."
            If Right(*p\path, 1) = "\": *p\path = Left(*p\path, Len(*p\path)-1): EndIf
            *p\path = GetPathPart(*p\path) 
            If *p\progflags & #efg_Path
               If Left(*p\path, Len(*p\pathstart)) <> *p\pathstart
                  *p\path = *p\pathstart: ProcedureReturn 0
               EndIf
            EndIf
            If Len(*p\path) 
               ExplorerFileGadgetUpdate(*p\tree, *p\path)
            Else
               ;wenn im Root Verzeichnis, dann mit null aufrufen, zurück zur LwAuswahl
               ExplorerFileGadgetUpdate(*p\tree, "", 0)
            EndIf
            ProcedureReturn 0
            
      EndSelect       
      
   ElseIf msg = #WM_LBUTTONDBLCLK
      
      Protected HitPosi.CBHITPOSITION
      Protected HitInfo.LVHITTESTINFO 
      
      HitPosi\param = lParam 
      Hitinfo\pt\x = HitPosi\pt\x         ;LoWord
      HitInfo\pt\y = HitPosi\pt\y         ;HiWord
      SendMessage_(hwnd, #LVM_SUBITEMHITTEST, 0, HitInfo)
      
      state = GetGadgetItemData(*p\tree, hitinfo\iitem)
      
      If state = #efg_Drive             
         ;Laufwerk angeklickt oder im Root Verzeichnis ".." angeklickt
         *p\path = GetGadgetItemText(*p\tree, hitinfo\iitem)
         ExplorerFileGadgetUpdate(*p\tree, *p\path)
         
      ElseIf state = #efg_Root
         ;zurück ".." angeklickt
         PostMessage_(hwnd, #WM_KEYDOWN, #VK_BACK, 0)
         ProcedureReturn 0   
         
      ElseIf state = #efg_Dir
         *p\path + GetGadgetItemText(*p\tree, hitinfo\iitem) 
         ExplorerFileGadgetUpdate(*p\tree, *p\path)
         
      ElseIf state = #efg_File    
         If *p\progflags & #efg_Run
            RunProgram(*p\path + GetGadgetItemText(*p\tree, hitinfo\iitem)) 
         EndIf   
         
      ElseIf state = #efg_Special           
         Select GetGadgetItemText(*p\tree, hitinfo\iitem)
            Case "APPDATA":      *p\path = ExplorerSHSpecialFolder(#CSIDL_APPDATA)
            Case "DOCUMENTS":    *p\path = ExplorerSHSpecialFolder(#CSIDL_PERSONAL)
            Case "PUREBASIC":    *p\path = GetEnvironmentVariable("PUREBASIC_HOME")
         EndSelect
         ExplorerFileGadgetUpdate(*p\tree, *p\path)         
         
      ElseIf state = #efg_UncPath
         Select GetGadgetItemText(*p\tree, hitinfo\iitem)
            Case "UNC":          *p\path = *p\path_unc
         EndSelect
         ExplorerFileGadgetUpdate(*p\tree, *p\path)         
         
      EndIf
      
   EndIf
   
   ProcedureReturn CallWindowProc_(*p\lpPrevFunc, hWnd, msg, wParam, lParam)
EndProcedure

Procedure.i ExplorerFileGadgetFree(tree)
   
   Protected j, *p.ExplorerFileGadgetMemory = GetWindowLongPtr_(GadgetID(tree), #GWL_USERDATA)   
   For j = 0 To 20: DestroyIcon_(*p\hicon[j]): Next
   
EndProcedure

Procedure.i ExplorerFileGadget(tree, x, y, br, hh, path.s, flags = 0, *menuproc = 0, statusbar = -1, statusfeld = 0)
   
   ;path = Startverzeichnis
   ;flags = #efg_Run, um RunProgram bei Doppelclick auf File aufzurufen
   ;flags = #efg_Path
   ;*menuproc = Funktionszeiger auf eine externe Prozedur, welche Menuitems anhängt, siehe auch Callback/#WM_COMMAND
   ;statusbar = wenn es eine gibt, pbnr angeben, aktueller Pfad wird in statusfeld  geschrieben
   
   Protected *p.ExplorerFileGadgetMemory = AllocateMemory(SizeOf(ExplorerFileGadgetMemory))   ;GadgetMemory für Callback etc
   
   Protected lvflags = #PB_ListIcon_MultiSelect|#PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect
   Protected id, result 
   
   If tree = #PB_Any
      tree = ListIconGadget(#PB_Any, x, y, br, hh, "Name", 150, lvflags)
      id = GadgetID(tree)
      result = tree
   Else
      id = ListIconGadget(tree, x, y, br, hh, "Name", 150, lvflags)   
      result = id
   EndIf
   AddGadgetColumn(tree, 1, "Größe", 80)
   AddGadgetColumn(tree, 2, "Typ", 120)
   AddGadgetColumn(tree, 3, "Datum", 120)
   ;AddGadgetColumn(tree, 4, "Attribut", 120)   ;mit Attribut die Rems in ExplorerFileGadgetReadDir() entfernen
   
   *p\tree = tree                   ;erspart GetDlgCtrlId(hwnd) im Callback
   *p\progflags = flags             ;wenn #efg_Run, kann im Callback RunProgram() aufgerufen werden
   *p\pathstart = path              ;
   *p\statusbar = statusbar         ;pbnr der Statusbar
   *p\statusfeld = statusfeld       ;zugehöriges Feld
   
   *p\hicon[#efg_IconBack] = ExtractIcon_(0,"Shell32.dll", 53)  ;42
   *p\hicon[#efg_IconUnc ] = ExtractIcon_(0,"Shell32.dll", 148) ; 9
   *p\hicon[#efg_IconRoot] = ExtractIcon_(0,"Shell32.dll", 45)
   *p\hicon[#efg_IconDir ] = ExtractIcon_(0,"Imageres.dll", 3)
   *p\hicon[#efg_IconSpec] = ExtractIcon_(0,"Imageres.dll", 151)
   *p\hicon[#efg_IconFile] = ExplorerSHGetImage("")
   *p\hicon[#efg_IconPic ] = ExplorerSHGetImage(".bmp")
   *p\hicon[#efg_IconText] = ExplorerSHGetImage(".txt")
   *p\hicon[#efg_IconDll ] = ExplorerSHGetImage(".dll")
   *p\hicon[#efg_IconHlp ] = ExplorerSHGetImage(".hlp")
   *p\hicon[#efg_IconPB  ] = ImageID(CatchImage(#PB_Any, ?purebasicbmp))
   
   *p\hicon[#efg_IconDelete] = ExtractIcon_(0,"Shell32.dll", 62)
   
   *p\hcursorOri = GetClassLongPtr_(GadgetID(tree), #GCL_HCURSOR) 
   *p\hcursorWait = LoadCursorFromFile_(@"C:\Windows\Cursors\stopwtch.ani")   ;LoadCursor_(0, #IDC_APPSTARTING)
   
   ;falls C:\Windows nicht das WindowsVerzeichnis ist
   ;Protected cursorfile.s = ExplorerSHSpecialFolder(#CSIDL_WINDOWS) + "Cursors\stopwtch.ani" 
   ;Protected cursorfile.s = GetEnvironmentVariable("windir") + "\Cursors\stopwtch.ani"
   ;*p\hcursorWait = LoadCursorFromFile_(@cursorfile)
   
   *p\popup = CreatePopupImageMenu(#PB_Any, #PB_Menu_ModernLook)
   MenuItem(#efg_MenuNewDir, "neuen Ordner erstellen", *p\hicon[#efg_IconDir])
   MenuBar()
   MenuItem(#efg_MenuCopy,   "kopieren")
   MenuItem(#efg_MenuDelete, "löschen", *p\hicon[#efg_IconDelete])
   MenuItem(#efg_MenuRename, "umbenennen")
   MenuItem(#efg_MenuMove,   "verschieben")
   MenuBar()
   MenuItem(#efg_MenuFilter, "Filter")
   OpenSubMenu("Ansicht")
   MenuItem(#efg_MenuListe, "Liste")
   MenuItem(#efg_MenuLarge, "große Symbole")
   CloseSubMenu()
   MenuItem(#efg_MenuSHinfo, "Eigenschaften")
   If *menuproc
      *p\menuproc = *menuproc
      CallFunctionFast(*menuproc, *p\tree, *p\popup, 0)   ;hängt Menuitems an        
   EndIf      
   
   ;subclassing
   *p\lpPrevFunc = SetWindowLongPtr_(id, #GWL_WNDPROC, @ExplorerFileGadgetCallback())
   SetWindowLongPtr_(id, #GWL_USERDATA, *p)
   
   ;Format: fmt = #LVCFMT_CENTER, #LVCFMT_LEFT, #LVCFMT_RIGHT
   Protected lv.LV_COLUMN 
   lv\mask = #LVCF_FMT 
   lv\fmt  = #LVCFMT_RIGHT 
   SendMessage_(id, #LVM_SETCOLUMN, 1, lv) 
   
   lv\fmt  = #LVCFMT_CENTER 
   SendMessage_(id, #LVM_SETCOLUMN, 2, lv)
   
   Protected exstyle = SendMessage_(id, #LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
   SendMessage_(id, #LVM_SETEXTENDEDLISTVIEWSTYLE, 0, exstyle | #LVS_EX_LABELTIP)

   ;Directory lesen
   ExplorerFileGadgetUpdate(tree, path)
   
   ProcedureReturn result   
EndProcedure

;SHOPERATION ab PB 4.41 x86 32 Bit - HJBremer 27.01.2011

;http://msdn.microsoft.com/de-de/library/bb759795(en-us,VS.85).aspx
;http://msdn.microsoft.com/en-us/library/bb762164(VS.85).aspx
;http://support.microsoft.com/kb/q151799/
;http://www.winfixx.de/html/fehlermeldungen.html auf Deutsch

; #FOF_SILENT         = 4    ;keine Angabe über Fortschritt 
; #FOF_ALLOWUNDO      = 64   ;für Papierkorb erforderlich !!! 
; #FOF_NOERRORUI      = 1024 ;keine Fehler-UI 
; #FOF_NOCONFIRMATION = 16   ;keine Rückfrage
; #FOF_NOCONFIRMMKDIR = 512  ;keine Rückfrage bei Dirs
; #FOF_SIMPLEPROGRESS = 256  ;Progressbar, erscheint nicht immer
; #FOF_MULTIDESTFILES = 1    ;sehr wichtig, wenn in den Zielfeldern der komplette Name steht incl. Verzeichnisname

Procedure.i ExplorerSHOperationMem(Array files.s(1))
   
   ;es gilt ab Index 1 von files()
   ;die Daten befinden sich lückenlos hintereinander im Feld
   ;alles nach einem leeren Feld wird ignoriert, Feld kann größer sein als Anzahl Daten
   
   Protected anz, j, lg, size, item, mem, pmem
   
   ;ermittle Memorylaenge für Buffer
   anz = ArraySize(files())
   For j = 1 To anz
      lg = Len(files(j)) 
      If Not lg: Break: EndIf          ;wenn Feld leer, dann Ende
      size + lg + SizeOf(character)    ; + 1 character für null-terminated
      item + 1
   Next   
   size + SizeOf(character)            ;The List of names must be double null-terminated at the end
   mem = AllocateMemory(size)          ;Start des Buffers
   
   ;schreibe Namen ins Memory
   If mem
      pmem = mem                       ;Kopie für PokeS()      
      For j = 1 To item 
         PokeS(pmem, files(j))
         pmem + Len(files(j)) + SizeOf(character)    ; + 1 character für null-terminated
      Next
   EndIf
   
   ProcedureReturn mem   
EndProcedure

Procedure.i ExplorerSHOperation(operation, qtree, ztree = 0, newname.s = "", flag = 0)
   
   If Not IsGadget(qtree): ProcedureReturn : EndIf
   If Not GadgetType(qtree) = #PB_GadgetType_ListIcon: ProcedureReturn : EndIf
   
   Protected j, item
   Protected qpath.s = ExplorerFile_GetPath(qtree)
   Protected zpath.s, Dim q.s(0), Dim z.s(0)
   
   ;Quelle   
   ;die markierten Daten werden nacheinander ins qfeld ab Index 1 geschoben, item ist die Anzahl der markierten Daten   
   item = ExplorerFile_GetSelectedFiles(qtree, q(), 1, 1)   
   If Not item: ProcedureReturn: EndIf
   
   Static nr
   Protected pfrom, pto, shfile.SHFILEOPSTRUCT, zielupdateflag, ok = 0   
   
   shfile\hwnd = GetForegroundWindow_()
   
   Select operation
         
      Case #FO_DELETE         
         pfrom  = ExplorerSHOperationMem(q())            
         If pfrom
            shfile\pFrom  = pfrom
            shfile\wFunc  = #FO_DELETE
            shfile\fFlags = #FOF_ALLOWUNDO | #FOF_SILENT | #FOF_NOERRORUI
            If flag: shfile\fFlags | #FOF_NOCONFIRMATION: EndIf      
            ok = SHFileOperation_(shfile)    ;gibt null zurück, wenn ok, sonst Fehlercode 
            FreeMemory(pfrom) 
            ExplorerFileGadgetUpdate(qtree, qpath)
         EndIf
         
      Case #FO_COPY, #FO_MOVE         
         If IsGadget(ztree)
            If GadgetType(ztree) = #PB_GadgetType_ListIcon     ;es gibt ein 2. LV
               zpath = ExplorerFile_GetPath(ztree)                ;dann zpath von dort holen
               zielupdateflag = 1                              ;und dieses auch updaten
            Else
               zpath = ""
            EndIf   
         Else
            zpath = PathRequester("Wählen Sie den ZielOrdner", qpath)   ;Vorgabe ist qpath
         EndIf         
         If Not zpath: ProcedureReturn: EndIf
         Dim z(item)
         For j = 1 To item
            If q(j)
               If newname      ;neuer Name beim Kopieren mit laufender nr
                  nr + 1
                  z(j) = zpath + newname + RSet(Str(nr), 6, "0") + "." + GetExtensionPart(q(j))   
               Else
                  z(j) = zpath + GetFilePart(q(j))
               EndIf
            EndIf
         Next         
         pfrom  = ExplorerSHOperationMem(q())
         pto    = ExplorerSHOperationMem(z())
         If pfrom And pto
            shfile\pFrom  = pfrom
            shfile\pTo    = pto
            shfile\wFunc  = #FO_COPY
            If operation = #FO_MOVE: shfile\wFunc  = #FO_MOVE: EndIf
            shfile\fFlags = #FOF_NOERRORUI | #FOF_NOCONFIRMMKDIR | #FOF_MULTIDESTFILES | #FOF_SIMPLEPROGRESS    
            If flag: shfile\fFlags | #FOF_NOCONFIRMATION: EndIf      
            ok = SHFileOperation_(shfile)    
            FreeMemory(pfrom)
            FreeMemory(pto)
            If operation = #FO_MOVE: ExplorerFileGadgetUpdate(qtree, qpath): EndIf
            If zielupdateflag: ExplorerFileGadgetUpdate(ztree, zpath): EndIf
            zielupdateflag = 0
         EndIf
         
      Case #FO_RENAME          
         If Not newname
            Repeat
               newname = Trim(InputRequester("Neuer Name", "Name", GetFilePart(q(1))))
               If Not newname: Break: EndIf
               ok = CheckFilename(newname)
            Until ok
         EndIf
         If Not newname: ProcedureReturn: EndIf
         
         Protected Dim qtmp.s(1), Dim ztmp.s(1)
         
         For j = 1 To item
            qtmp(1) = q(j)
            ztmp(1) = GetPathPart(q(j))
            If GetExtensionPart(newname)
               ztmp(1) + newname
            Else
               ztmp(1) + newname + "." + GetExtensionPart(q(j))
            EndIf            
            pfrom = ExplorerSHOperationMem(qtmp())
            pto   = ExplorerSHOperationMem(ztmp())
            If pfrom And pto
               shfile\pFrom  = pfrom
               shfile\pTo    = pto
               shfile\wFunc  = #FO_RENAME
               shfile\fFlags = #FOF_NOERRORUI | #FOF_NOCONFIRMMKDIR | #FOF_MULTIDESTFILES | #FOF_SIMPLEPROGRESS | #FOF_RENAMEONCOLLISION	
               If flag: shfile\fFlags | #FOF_NOCONFIRMATION: EndIf      
               ok = SHFileOperation_(shfile)    
               FreeMemory(pfrom)
               FreeMemory(pto) 
            EndIf
         Next
         ExplorerFileGadgetUpdate(qtree, qpath)
         
   EndSelect 
   ;Debug shfile\fAnyOperationsAborted 
   
   ProcedureReturn ok
EndProcedure

Procedure.i ExplorerSHProperties(tree)
   
   Protected item = GetGadgetState(tree)
   Protected name.s = ExplorerFile_GetFilename(tree, item)
   Protected p.point    
   GetCursorPos_(p): p\x - 50: p\y - 100: SetCursorPos_(p\x, p\y)    ;Posi vom Eigenschaften Fenster bestimmen
   
   Protected shellinfo.SHELLEXECUTEINFO   
   shellinfo\cbSize = SizeOf(SHELLEXECUTEINFO) 
   shellinfo\fMask = #SEE_MASK_NOCLOSEPROCESS | #SEE_MASK_INVOKEIDLIST | #SEE_MASK_FLAG_NO_UI 
   shellinfo\lpVerb = @"properties"
   shellinfo\lpFile = @name
   ShellExecuteEx_(@shellinfo)
   
EndProcedure

Procedure.s ExplorerSHSpecialFolder(CSIDL)   
   ; aus dem Forum, Liste zu den Konstanten: http://msdn.microsoft.com/en-us/library/bb762494.aspx
   Protected *itemid.ITEMIDLIST
   Protected location.s = Space(#MAX_PATH)
   
   If SHGetSpecialFolderLocation_ (0, CSIDL, @*itemid) = #NOERROR    
      If SHGetPathFromIDList_(*itemid, location)
         CoTaskMemFree_(*itemid) 
         If Right(location, 1) <> "\" : location + "\" : EndIf
         ProcedureReturn location
      EndIf
   EndIf
   
EndProcedure

Procedure.i ExplorerSHGetImage(shname.s)   
   ;mit #SHGFI_SYSICONINDEX ist ok = himglist, sonst ist ok = 1, außer System ist im Eimer
   Protected shinfo.SHFILEINFO, shflags = #SHGFI_USEFILEATTRIBUTES|#SHGFI_ICON|#SHGFI_SMALLICON    
   Protected ok = SHGetFileInfo_(shname, #FILE_ATTRIBUTE_NORMAL, shinfo, SizeOf(SHFILEINFO), shflags)
   ProcedureReturn shinfo\hIcon   
EndProcedure

DataSection
   purebasicbmp:
   Data.q 17190210, 11258999076159488, 5066549581840384, 17179934720, 9437184, 4503599627370496, 0, -9223371487098961920
   Data.q 36029348922261504, -9187342690071609344, -4557642270987255808, -72056498821267264, 71777218556067840
   Data.q -280379743338496, -280375465148416, 1297036692682702847, -7349875557949959919, -432346004032218727
   Data.q -105992920917607, -97, -7, -3773722351, -4008634095, -414034847239, -393217, -1610612737, -100663297
   Data.q -416325496321, -439804624897, -105992914599937, -1, -1, 281474976710655
EndDataSection

Demo

Code: Alles auswählen

;11.02.2011
XIncludeFile "ExplorerFileGadget1.pbi"

Enumeration
   #window
   #listicon
   #explorer
   #statusbar
EndEnumeration

Procedure.i ExtractIcons(datname.s, save = 0, path.s = "")
   
   UsePNGImageEncoder()
   
   Protected anzahl = ExtractIcon_(0, datname, -1), nr, lfdnr
   Protected iconinfo.ICONINFO, icon, iconbr, iconhh, iconname.s, imgnr
   
   If Len(path)
      If Right(path,1) <> "\": path + "\": EndIf
   EndIf
   
   If save = 0
      ClearGadgetItems(#listicon)
   EndIf
      
   If anzahl = 0
      StatusBarText(#statusbar, 1, "keine icons")
   Else
      StatusBarText(#statusbar, 1, Str(anzahl) + " icons")
      nr = 0
      Repeat         
         icon = ExtractIcon_(0, datname, nr) 
         If icon
            iconname = GetFilePart(datname)
            iconname = ReplaceString(iconname, ".", "_")   
            iconname = path + iconname + RSet(Str(lfdnr), 4, "0")
            AddGadgetItem(#listicon, -1, GetFilePart(iconname), icon)  
            nr + 1
            If save
               GetIconInfo_(icon, iconinfo) 
               iconbr = IconInfo\xHotspot * 2 
               iconhh = IconInfo\yHotspot * 2 
               imgnr = CreateImage(#PB_Any, iconbr, iconhh)
               If IsImage(imgnr)
                  StartDrawing(ImageOutput(imgnr))
                     Box(0, 0, iconbr, iconhh, #White)
                     DrawImage(icon, 0, 0)   
                  StopDrawing()
                  SaveImage(imgnr, iconname + ".png", #PB_ImagePlugin_PNG)               
                  FreeImage(imgnr)               
                  StatusBarText(#statusbar, 1, iconname + " gespeichert")                
                  lfdnr + 1
               EndIf
            EndIf
         EndIf
         DestroyIcon_(icon)      ;sehr wichtig, sonst nix mehr mit Memory !!!
      Until icon = 0   
   EndIf 
   
   ProcedureReturn lfdnr
EndProcedure

Procedure.i Menuaddproc(tree, popupnr, menuitem)
   
   ;Diese Procedure hängt Menuitems an das PopUpMenu an, dazu dient item null
   ;es muß die Adresse dieser Prozedur dem ExplorerFileGadget übergeben werden.
   ;Der LvCallback ruft dann diese Prozedur auf und übergibt das Item
   ;und von welchem Lv der Aufruf kommt, es wird die PBnr übergeben.
   ;
   ;verfügbare menuitems ab 20, da die Ersten belegt/reserviert sind.
   
   Protected anz, j, name.s, path.s
   
   Select menuitem
      Case 0
         MenuBar()
         MenuItem(20, "Icons speichern")
         
         ;nur zur Demo
         ;DisableMenuItem(popupnr, #efg_MenuDelete, 1)
         
      Case 20
         Dim sel.s(0)
         anz = ExplorerFile_GetSelectedFiles(tree, sel(), 1)
         If anz
            name = GetPathPart(sel(1))   
            name = Left(name, Len(name) - 1)
            name = GetFilePart(name)
            path = GetCurrentDirectory() + "Icon"
            CreateDirectory(path)   
            path + "\" + name
            CreateDirectory(path)   
            ClearGadgetItems(#listicon)
            For j = 1 To anz
               ExtractIcons(sel(j), 1, path)
            Next         
         EndIf
   EndSelect
   
EndProcedure

Procedure.i Main()
   
   Protected fontnr1 = LoadFont(#PB_Any, "Arial", 8)
   Protected fontnr2 = LoadFont(#PB_Any, "Arial", 10)
   Protected j
   Protected path.s = "C:\Bremer\"
   Protected flags = #efg_Run ;| #efg_Path
   
   OpenWindow(#window, 0, 0, 1000, 620, "ListFile Example", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
   
   CreateStatusBar(#statusbar, WindowID(#window))
   AddStatusBarField(#PB_Ignore)
   AddStatusBarField(#PB_Ignore)
   SendMessage_(StatusBarID(#statusbar), #WM_SETFONT, FontID(fontnr1),#True)
   
   ExplorerFileGadget(#explorer, 5, 5, 490, 590, path, flags, @Menuaddproc(), #statusbar) 
   SetGadgetFont(#explorer, FontID(fontnr2))
   
   ExplorerFile_SetUncPath(#explorer, "\\127.0.0.1\c$") 
   
   ListIconGadget(#listicon, 500, 5, 490, 590, "", 0)
   SetGadgetAttribute(#listicon, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon)
   
   Protected event, item, state, name.s
   
   Repeat
      Event = WaitWindowEvent()
      
      Select event
            
         Case #PB_Event_Gadget
            
            If EventGadget() = #explorer 
               
               Select EventType()

                  Case #PB_EventType_Change
                     
                     item  = ExplorerFile_GetFirstSelect(#explorer)   
                     name  = ExplorerFile_GetFilename(#explorer, item) 
                     state = ExplorerFile_GetFileState(#explorer, item)
                     
                     If state & #PB_Explorer_File
                        ExtractIcons(name)
                     EndIf
                     
               EndSelect
               
            EndIf
            
      EndSelect
      
   Until Event = #PB_Event_CloseWindow
   
   ExplorerFileGadgetFree(#explorer)
   
EndProcedure

Main()

[dige]

@hjbremer: Klasse! Mir fehlt ja beim Original vor allem die UNC Unterstützung.
Wäre das noch ohne größeren Aufwand integrierbar?

[hjbremer]

Mir fehlt ja beim Original vor allem die UNC Unterstützung.
Wäre das noch ohne größeren Aufwand integrierbar?

was ist das ?

[bobobo]

ääää


Hat mal jemand probiert so ein ExplorerListGadget mit aktiviertem SmartWindowRefresh(..) des übergeordneten Fensters zu testen ?

[dige]

Mir fehlt ja beim Original vor allem die UNC Unterstützung.
Wäre das noch ohne größeren Aufwand integrierbar?

was ist das ?

Netzwerkpfade (Uniform Naming Convention)

Code: Alles auswählen

\\Servername\Freigabename\Pfad

[hjbremer]

habe ich nicht und kann es darum auch nicht testen etc

wenn Windows nicht direkt Zugriff auf F: G: etc hat, könnte man versuchen über einen SpecialOrdner Zugriff zu bekommen. CSIDL_NETHOOD bzw. CSIDL_NETWORK und über die da abgelegten LNK Dateien.

Aber wie gesagt, keine Möglichkeit das zu testen. und darum auch null Erfahrung damit.