I need to combine my incredimail cataloguer with some file management aspects of WIndows Explorer so I have been fiddling for weeks.
The below is the skeleton of a file manager. It:
1. Enumerates all the drives on your system
2. Builds a tree of all your drives and their directories
3. Shows files and attributes for a highlighted directory
4. Launches a file when left double clicked
5. Shows a popup menu on right mouse click in the file list
It has:
1. Pretty blue background for both gadgets
2. Form resizing and gadget resizing with minimum size
3. Custom bubble tooltip
4. Recent filename list
All of this is just a skeleton that I am playing with and many people helped me. Do what you want with it but don't complain to me if it doesn't work as I won't be listening. I am developing it for use in my own applications.
Code: Select all
;============================================================================================================================
; All program constants
;============================================================================================================================
#TV_FIRST = $1100 ; API constants for tree and list gadget colouring
#TVM_SETBKCOLOR = #TV_FIRST + 29
#TVM_SETTEXTCOLOR = #TV_FIRST + 30
#TTS_BALLOON = $40 ; Colourful speech bubble tips
#filepointer = 99 ; Filepointer
#MenuRecentFiles = 100 ; Start where Entrys are beginning in Menu for Recent files
#ProgramVersion = "File Manager"
Global WindowIndex = 0 ; Init all starting gadget type values
Global GadgetIndex = 0
Global ImageIndex = 0
Global StatusBarIndex = 0
Global MenuBarIndex = 0
Global Window_fileman = WindowIndex : WindowIndex = WindowIndex + 1 ; Main program window starting number
Global MenuBar_fileman = MenuBarIndex : MenuBarIndex = MenuBarIndex + 1 ; Main window menu bar
Global Gadget_fileman_fileman = GadgetIndex : GadgetIndex = GadgetIndex + 1 ; Main window gadgets
Global Gadget_fileman_dirtree = GadgetIndex : GadgetIndex = GadgetIndex + 1
Global Gadget_fileman_filelist = GadgetIndex : GadgetIndex = GadgetIndex + 1
Global StatusBar_fileman = StatusBarIndex : StatusBarIndex = StatusBarIndex + 1 ; Main window status bar
Global StatusBar_fileman_Field1 = 0
Global StatusBar_fileman_Field2 = 1
Global StatusBar_fileman_Field3 = 2
Global StatusBar_fileman_Field4 = 3
Global Icons_folder = ImageIndex : ImageIndex = ImageIndex + 1 ; Program incons
Global Icons_drive = ImageIndex : ImageIndex = ImageIndex + 1
;============================================================================================================================
; Any needed data structures
;============================================================================================================================
Structure FileInformation
path.s ; Full path name
name.s ; File name
size.s ; File size
attr.s ; File attributes
EndStructure
;============================================================================================================================
; ALl procedures pre-declared
;============================================================================================================================
Declare FindAllDrives() ; Find all local drives attached to system
Declare ShowAllDrives() ; Show all drive directories in the tree
Declare FlushEvents() ; Flush any waiting window events to prevent form timeout
Declare DirScan(DirectoryID.l, DirectoryName.s) ; Do the actual recursive tre find routine
Declare FileScan(FilePath.s) ; Show the contents of a directory selected from the tree
Declare.s GetAttribMask(fattribute.s) ; Get the attributes of all files in the filelist for immediate display
Declare CustomToolTip(ToolHandle, ToolText.s) ; Colourful speech bubble tips
Declare.l ResizeCallback(WindowID.l, Message.l, wParam.l, lParam.l) ; Form resizing and object colouring
Declare Recent(NewFilename.s) ; Create and add to the recent list of files
Declare MakeMenu() ; Make the system menu and insert the recent files into it
Declare.l Window_fileman() ; Main program window
;============================================================================================================================
; Any needed lists
;============================================================================================================================
Global NewList AllDrives.s() ; Linked List to hold all drive letters
Global NewList FullPaths.s() ; Linked List to hold all diretory paths
Global NewList Finfo.FileInformation() ; Linked List to hold temporary file details
Global NewList Files.s() ; Linked List to hold RecentFiles
;============================================================================================================================
; Any global variables that the program needs
;============================================================================================================================
Global OriginalWidth, OriginalHeight, hStatusBar, OldStatusBarWidth, NewStatusBarWidth, recentfilename.s
;============================================================================================================================
; Initialise the list of recent files
;============================================================================================================================
recentfilename.s = "MyRecentFiles.RFN" ; This holds the filename for the recentlist
;============================================================================================================================
; Dimension the number of fields in the status bar that we are going to resize
;============================================================================================================================
Global Dim StatusBarFields.l(3) ; Needed for resize, must be the number of Fields -1 (since it begins at 0)
;============================================================================================================================
; Main program event code
;============================================================================================================================
FindAllDrives()
If Window_fileman()
SetWindowCallback(@ResizeCallback()) ; Set form resizing and gadget colouring callback
Recent("") ; Initialise the RecentFiles list
MakeMenu() ; And generate a menu for it
ShowAllDrives()
Repeat
EventID = WaitWindowEvent()
;----------------------------------------------------------------------------------------------
If EventID = #PB_Event_Menu
;--------------------------------------------------------------------------------------------
If EventMenu() > #MenuRecentFiles And EventMenu() < #MenuRecentFiles + 11
SelectElement(Files(), EventMenu() - #MenuRecentFiles - 1)
filenametoopen.s = Files()
openrecentflag = 1
; Gosub filenametoopen
EndIf
;------------------------------------------------------------------------------------------
; Select EventMenuID()
; Case
; EndSelect
;------------------------------------------------------------------------------------------
EndIf
;--------------------------------------------------------------------------------------------
If EventID = #PB_Event_Gadget
Select EventGadget()
Case Gadget_fileman_dirtree : Gosub TreeClicked ; An item has been highlighted in the tree
Case Gadget_fileman_filelist : Gosub ListClicked ; An item has been highlighted or double clicked in the filelist
EndSelect
EndIf
;----------------------------------------------------------------------------------------------
Until EventID = #PB_Event_CloseWindow And EventWindow() = Window_fileman
CloseWindow(Window_fileman)
EndIf
End
;============================================================================================================================
; An item has been highlighted in the tree
;============================================================================================================================
TreeClicked:
If EventType() = #PB_EventType_LeftClick And GetGadgetState(Gadget_fileman_dirtree) <> -1
ClearGadgetItemList(Gadget_fileman_filelist)
CurrentTreeLine = GetGadgetState(Gadget_fileman_dirtree)
SelectElement(FullPaths(), CurrentTreeLine)
FileScan(FullPaths())
EndIf
Return
;============================================================================================================================
; An item has been highlighted or double clicked in the filelist
;============================================================================================================================
ListClicked:
If EventType() = #PB_EventType_LeftDoubleClick And GetGadgetState(Gadget_fileman_filelist) <> -1
CurrentListLine = GetGadgetState(Gadget_fileman_filelist)
SelectElement(Finfo(), CurrentListLine)
RunProgram(Finfo()\Name, "", Finfo()\Path, 0)
EndIf
If EventType() = #PB_EventType_RightClick And GetGadgetState(Gadget_fileman_filelist) <> -1
DisplayPopupMenu(0, WindowID(Window_fileman))
EndIf
Return
;============================================================================================================================
; All of my procedures
;============================================================================================================================
Procedure.l Window_fileman()
If OpenWindow(Window_fileman,177,20,800,600, #ProgramVersion,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget|#PB_Window_Invisible)
;----------------------------------------------------------------------------------------------
OriginalWidth = WindowWidth(Window_fileman) ; Original non-client width.
OriginalHeight = WindowHeight(Window_fileman) ; Original non-client height.
OldStatusBarWidth = WindowWidth(Window_fileman) ; Needed for resizing
;----------------------------------------------------------------------------------------------
MakeMenu()
;----------------------------------------------------------------------------------------------
If CreatePopupMenu(1)
MenuItem(2, "Sort")
MenuItem(3, "Sort All")
MenuItem(4, "Insert")
MenuItem(5, "Delete")
MenuItem(6, "Expand All")
MenuBar()
EndIf
Frame3DGadget(Gadget_fileman_fileman,0,0,800,560,"")
TreeGadget(Gadget_fileman_dirtree,5,10,170,545)
SendMessage_(GadgetID(Gadget_fileman_dirtree),#TVM_SETBKCOLOR,0,16744448)
CustomToolTip(GadgetID(Gadget_fileman_dirtree), "Click on any member of the tree to show the corresponding files in the list view")
ListIconGadget(Gadget_fileman_filelist,178,10,617,545,"FileName",130,#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
SendMessage_(GadgetID(Gadget_fileman_filelist),#LVM_SETBKCOLOR,0,16744448)
SendMessage_(GadgetID(Gadget_fileman_filelist),#LVM_SETTEXTBKCOLOR,0,16744448)
CustomToolTip(GadgetID(Gadget_fileman_filelist), "Click on any file in this list to view information about it or perform certain actions on it")
AddGadgetColumn(Gadget_fileman_filelist,1,"Size",80)
AddGadgetColumn(Gadget_fileman_filelist,2,"Attrib",80)
AddGadgetColumn(Gadget_fileman_filelist,3,"Type",80)
AddGadgetColumn(Gadget_fileman_filelist,4,"Category",80)
AddGadgetColumn(Gadget_fileman_filelist,5,"Collection",80)
AddGadgetColumn(Gadget_fileman_filelist,6,"Display",80)
hStatusBar = CreateStatusBar(StatusBar_fileman,WindowID(Window_fileman))
AddStatusBarField(470)
AddStatusBarField(110)
AddStatusBarField(110)
AddStatusBarField(110)
HideWindow(Window_fileman,0)
ProcedureReturn WindowID(Window_fileman)
EndIf
EndProcedure
;============================================================================================================================
; Find all drives attached to the local computer
;============================================================================================================================
Procedure FindAllDrives()
nBufferLength = (4 * 26) + 1 ; Calculate memory buffer.
*npBuffer = AllocateMemory(nBufferLength ) ; Get the buffer and startaddress.
If *npBuffer <> 0 ; Check if memory allocation succeeded.
stringlength = GetLogicalDriveStrings_(nBufferLength,*npBuffer) ; Get drives and put the returned stringlength on a var.
NumberOfDrives = stringlength / 4 ; The number of drives in this system.
For i = 0 To NumberOfDrives - 1 ; Step through the drive string.
AddElement(AllDrives())
AllDrives() = PeekS(*npBuffer + (i * 4)) ; Get the drives names on intervals of 4 bytes.
Next i
Else
MessageRequester("Error","Cannot get drive list because there is no memory to figure that out", 0) ; Something went wrong.
EndIf
EndProcedure
;============================================================================================================================
; Form resizing and gadget colouring routines (Most of this is Pupil's help)
;============================================================================================================================
Procedure.l ResizeCallback(WindowID.l, Message.l, wParam.l, lParam.l)
Result = #PB_ProcessPureBasicEvents
If WindowID = WindowID(Window_fileman)
Select message
Case #WM_GETMINMAXINFO ; Restrict the minimum size to 640x(480 + MenuHeight()), borders included
Result = 0
*ptr.MINMAXINFO = lParam
*ptr\ptMinTrackSize\x = 648
*ptr\ptMinTrackSize\y = 488 + MenuHeight()
Case #WM_SIZE ; Form's size has changed.
; Use the right window
winwidth.l = WindowWidth(Window_fileman) ; Get the new width of the window
winheight.l = WindowHeight(Window_fileman) ; Get the new height of the window
widthchange = winwidth - OriginalWidth ; Get the width difference
heightchange = winheight - OriginalHeight ; Get the height difference
;------------------------------------------------------------------------------------------
ResizeGadget(Gadget_fileman_fileman, 0, 0, 800 + widthchange, 560 + heightchange)
ResizeGadget(Gadget_fileman_dirtree, 5, 10, 170 , 545 + heightchange)
ResizeGadget(Gadget_fileman_filelist, 178, 10, 617 + widthchange, 545 + heightchange)
;------------------------------------------------------------------------------------------
NewStatusBarWidth = WindowWidth(Window_fileman) ; Get new width
SendMessage_(hStatusBar, #SB_GETPARTS, 4, @StatusBarFields()) ; 4 is the number of Fields in the StatusBar
For i = 0 To 3 ; 3 is number of Fields-1, because Array goes from 0 to 3
StatusBarFields(i) = StatusBarFields(i) + (NewStatusBarWidth - OldStatusBarWidth)
Next i
SendMessage_(hStatusBar, #SB_SETPARTS, 4, @StatusBarFields())
OldStatusBarWidth = NewStatusBarWidth ; New Width will be old next time
RedrawWindow_(WindowID(Window_fileman), 0, 0, #RDW_INVALIDATE)
EndSelect
EndIf
ProcedureReturn Result
EndProcedure
;============================================================================================================================
; Show all found drives in the treegadget
;============================================================================================================================
Procedure ShowAllDrives()
ResetList(AllDrives())
While NextElement(AllDrives())
FlushEvents()
AddGadgetItem(Gadget_fileman_dirtree, -1, AllDrives(), CatchImage(Icons_drive,?drive))
DirScan(0, AllDrives())
Wend
EndProcedure
;============================================================================================================================
; Find all directories for a given drive
;============================================================================================================================
Procedure DirScan(DirectoryID.l, DirectoryName.s)
AddElement(FullPaths())
FullPaths() = DirectoryName
If ExamineDirectory(DirectoryID, DirectoryName, "*.*")
Repeat
entry.l = NextDirectoryEntry(DirectoryID)
If entry = 1 ; AddGadgetItem(#Gadget_fileman_dirtree, -1, DirectoryEntryName()) (Filename found)
ElseIf entry = 2
name.s = DirectoryEntryName(DirectoryID)
If name <> "." And name <> ".."
FlushEvents()
AddGadgetItem(Gadget_fileman_dirtree, -1, name, CatchImage(Icons_folder, ?folder))
DirScan(DirectoryID + 1, DirectoryName + name + "\")
EndIf
EndIf
Until entry = 0
EndIf
EndProcedure
;============================================================================================================================
; Show the contents of a directory selected from the tree (FangBeast)
;============================================================================================================================
Procedure FileScan(FilePath.s)
ClearList(Finfo())
If ExamineDirectory(1024, FilePath.s, "*.*")
Repeat
FileType = NextDirectoryEntry(1024)
FileName.s = DirectoryEntryName(1024)
FileSize = FileSize(FilePath.s + "\" + DirectoryEntryName(1024))
Attributes.s = GetAttribMask(FilePath.s + "\" + DirectoryEntryName(1024))
If FileType = 1
AddElement(Finfo())
Finfo()\path = FilePath.s ; Full path name
Finfo()\name = FileName.s ; File name
Finfo()\size = Str(FileSize) ; File size
Finfo()\attr = Attributes.s ; File attributes
FlushEvents()
AddGadgetItem(Gadget_fileman_filelist, -1, FileName.s + Chr(10) + Str(FileSize) + Chr(10) + Attributes)
EndIf
Until FileType = 0
EndIf
EndProcedure
;============================================================================================================================
; Get the attributes of all files in the filelist for immediate display (PB helped me figure this out properly)
;============================================================================================================================
Procedure.s GetAttribMask(fattribute.s)
mask.s = "-----" : r = GetFileAttributes_(fattribute.s)
If r & #FILE_ATTRIBUTE_ARCHIVE : mask.s = "A" + Mid(mask.s, 2, 5) : EndIf
If r & #FILE_ATTRIBUTE_COMPRESSED : mask.s = Left(mask.s, 1) + "C" + Mid(mask.s, 3, 3) : EndIf
If r & #FILE_ATTRIBUTE_HIDDEN : mask.s = Left(mask.s, 2) + "H" + Mid(mask.s, 4, 2) : EndIf
If r & #FILE_ATTRIBUTE_READONLY : mask.s = Left(mask.s, 3) + "R" + Mid(mask.s, 5, 1) : EndIf
If r & #FILE_ATTRIBUTE_SYSTEM : mask.s = Left(mask.s, 4) + "S" : EndIf
ProcedureReturn mask.s
EndProcedure
;============================================================================================================================
; Flush any waiting window events to prevent form timeout (FangBeast)
;============================================================================================================================
Procedure FlushEvents()
While WindowEvent()
Wend
EndProcedure
;============================================================================================================================
; Colourful speech bubble tips (Terry Hough I think)
;============================================================================================================================
Procedure CustomToolTip(ToolHandle, ToolText.s)
ToolTipControl = CreateWindowEx_(0, "tooltips_class32", "", $D0000000 | #TTS_BALLOON, 0, 0, 0, 0, WindowID(window_fileman), 0, GetModuleHandle_(0), 0)
SendMessage_(ToolTipControl, 1044, 0 ,0) ; ForeColor Tooltip
SendMessage_(ToolTipControl, 1043, $F68E09, 0) ; BackColor Tooltip
SendMessage_(ToolTipControl, 1048, 0, 180) ; Maximum Width of tooltip
Button.TOOLINFO\cbSize = SizeOf(TOOLINFO)
Button\uFlags = $11
Button\hWnd = ToolHandle
Button\uId = ToolHandle
Button\lpszText = @ToolText.s
SendMessage_(ToolTipControl, $0404, 0, Button)
ProcedureReturn result
EndProcedure
;============================================================================================================================
; Add a new file name to the list of recent files
;============================================================================================================================
Procedure Recent(newfilename.s) ; (Routine by Sigfried Rings)
If FileSize(recentfilename) > 0
If OpenFile(#filepointer, recentfilename) <> 0
ClearList(Files())
If newfilename <> ""
AddElement(Files())
Files() = newfilename ; Set as first element
EndIf
While Eof(#filepointer) = 0
sDummy.s = ReadString(#filepointer)
If sdummy <> newfilename ; is already here ?
If CountList(Files()) < 10 ; we allow only 10 Files in the Recentlist
If sdummy <> "" ; No NULL-STRING
AddElement(Files())
Files() = sDummy
EndIf
EndIf
EndIf
Wend
CloseFile(#filepointer)
ResetList(Files())
If OpenFile(#filepointer, recentfilename) <> 0
While NextElement(Files()) ; Process all the elements...
WriteStringN(#filepointer,Files())
Wend
CloseFile(#filepointer)
EndIf
EndIf
Else
If newfilename <> "" ; New one
If CreateFile(#filepointer, recentfilename) > 0
WriteStringN(#filepointer,newfilename)
CloseFile(#filepointer)
EndIf
AddElement(Files())
Files() = newfilename
EndIf
EndIf
EndProcedure
;============================================================================================================================
; Create and re-create the system menu every time you need it
;============================================================================================================================
Procedure MakeMenu()
*MenuWindow = WindowID(Window_fileman)
SendMessage_(*MenuWindow, #WM_SETREDRAW, 0, 0) ; Needed to remove any flickering when recreating the menu on runtime
If CreateMenu(MenuBar_fileman, WindowID(Window_fileman))
MenuTitle("Files")
MenuItem(1, "Open a File")
MenuBar()
ResetList(Files())
While NextElement(Files()) ; Process all the elements...
MenuItem(MenuRecentFiles + ListIndex(Files()), Files())
Wend
MenuBar()
EndIf
SendMessage_(*MenuWindow, #WM_SETREDRAW, 1, 0)
InvalidateRect_(*MenuWindow, 0 ,0)
EndProcedure
;============================================================================================================================
; Application icons and any files to be included in the exe file
;============================================================================================================================
DataSection
folder:
IncludeBinary "C:\Development\My Code\iCat\Icons\Folder.ico"
drive:
IncludeBinary "C:\Development\My Code\iCat\Icons\Drive.ico"
EndDataSection
