Unit uSelectFolder;
{$MODE OBJFPC}{$H+}
Interface
USES
Classes, SysUtils, Forms, Controls,
StdCtrls, LCLType, Buttons, Graphics, ShellCtrls;
TYPE
SelectFolder = Class
Class Procedure wndDIRShow (Sender: TObject);
Class Procedure wndDIRResize (Sender: TObject);
Class Procedure wndDIRKeyDown (Sender: TObject;
Var Key: Word; Shift: TShiftState);
Class Procedure wndDIRWheelDown (Sender: TObject; Shift: TShiftState;
MousePos: TPoint; Var Handled: Boolean);
Class Procedure wndDIRWheelUp (Sender: TObject; Shift: TShiftState;
MousePos: TPoint; Var Handled: Boolean);
Class Procedure btnOKClick (Sender: TObject);
Class Procedure btnDriveClick (Sender: TObject);
Class Procedure DrivesScrollLeft;
Class Procedure DrivesScrollRight;
PRIVATE
Class Var wndDIR : TForm;
Class Var slvList : TShellListView;
Class Var stvDIR : TShellTreeView;
Class Var btnOK : TSpeedButton;
Class Var btnSelDrive : TButton;
Class Var lBtnDrives : TList;
Class Var strResult : String;
Class Var iLengthBtnDrives: Integer;
PUBLIC
Class Function Show: String;
End;
Implementation
Class Function SelectFolder.Show: String;
Var
iWidth, iHeight: Integer;
strDrive, strAZ: String;
btnDrive : TButton;
I, iSpace : Integer;
slDrives : TStringlist;
Begin
Result:= '';
If Screen.Width < 1024
Then iWidth:= Screen.WorkAreaWidth
Else iWidth:= 1024;
If Screen.Height < 768
Then iHeight:= Screen.WorkAreaHeight
Else iHeight:= 768;
wndDIR:= TForm.Create(Nil);
Try
wndDIR.DoubleBuffered := True;
wndDIR.KeyPreview := True;
wndDIR.Position := poDesktopCenter;
wndDIR.Width := iWidth;
wndDIR.Height := iHeight;
wndDIR.BorderStyle := bsSizeable;
wndDIR.BorderIcons := [biMaximize, biSystemMenu];
wndDIR.FormStyle := fsStayOnTop;
wndDIR.OnKeyDown := @wndDIRKeyDown;
wndDIR.OnShow := @wndDIRShow;
wndDIR.OnResize := @wndDIRResize;
wndDIR.OnMouseWheelDown:= @wndDIRWheelDown;
wndDIR.OnMouseWheelUp := @wndDIRWheelUp;
btnOK := TSpeedButton.Create(wndDIR);
btnOK.Align := alBottom;
btnOK.Height := 50;
btnOK.Font.Size := 20;
btnOK.Font.Quality:= fqAntialiased;
btnOK.Font.Style := [fsBold];
btnOK.Parent := wndDIR;
btnOK.Caption := 'OK';
btnOK.OnClick := @btnOKClick;
strAZ := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
slDrives:= TStringlist.Create;
Try
For I:= 1 To Length(strAZ)
Do
Begin
If DirectoryExists(strAZ[I]+':')
Then slDrives.Add (strAZ[I]+':');
End;
If Not slDrives.Count > 0
Then strDrive:= ''
Else
Begin
iSpace:= -100;
lBtnDrives := TList.Create;
lBtnDrives.Capacity:= slDrives.Count;
For I:= 0 To slDrives.Count-1
Do
Begin
iSpace:= iSpace +100;
btnDrive := TButton.Create(wndDIR);
btnDrive.Parent := wndDIR;
btnDrive.Caption := slDrives[I];
btnDrive.Font.Size := 20;
btnDrive.Font.Quality := fqAntialiased;
btnDrive.Name := 'btnDrive'+InTtoStr(I);
btnDrive.SetBounds (iSpace, 0, 100, 50);
btnDrive.OnClick := @btnDriveClick;
btnDrive.OnMouseWheelDown:= @wndDIRWheelDown;
btnDrive.OnMouseWheelUp := @wndDIRWheelUp;
lBtnDrives.Add(btnDrive);
End;
strDrive:= slDrives[0]+'\';
TButton(lBtnDrives[0]).Font.Style:= [fsItalic, fsUnderline, fsBold];
btnSelDrive:= TButton(lBtnDrives[0]);
iLengthBtnDrives:= 100 *lBtnDrives.Count;
End;
Finally
slDrives.Free;
End;
slvList := TShellListView.Create(wndDIR);
slvList.Parent:= wndDIR;
slvList.Root := strDrive;
slvList.Hide;
stvDIR := TShellTreeView.Create(wndDIR);
stvDIR.AutoExpand := True;
stvDIR.DoubleBuffered := True;
stvDIR.Parent := wndDIR;
stvDIR.Font.Color := clBlack;
stvDIR.BackgroundColor:= clBtnFace;
stvDIR.Font.Size := 15;
stvDIR.Font.Quality := fqAntialiased;
stvDIR.Root := strDrive;
stvDIR.ShellListView := slvList;
stvDIR.ScrollBars := ssAutoBoth;
stvDIR.SetBounds (0, 50, wndDIR.ClientWidth, (wndDIR.ClientHeight-100));
stvDIR.Hint := '"T": Tree'+sLineBreak+'"D": Drives';
stvDIR.ShowHint := True;
If iLengthBtnDrives > wndDIR.ClientWidth
Then
Begin
wndDIR.Caption:= 'CHOOSE A FOLDER Ctrl+ArrowKeys: Scroll Drives';
stvDIR.Hint := '"T": Tree'+sLineBreak+'"D": Drives'+sLineBreak+'MouseWheel Up/Down: Scroll Drives';
End
Else
Begin
wndDIR.Caption:= 'CHOOSE A FOLDER';
stvDIR.Hint := '"T": Tree'+sLineBreak+'"D": Drives';
End;
wndDIR.ShowModal;
Result:= strResult;
Finally
lBtnDrives.Free;
wndDIR.Release;
wndDIR:= Nil;
End;
End;
Class Procedure SelectFolder.wndDIRShow(Sender: TObject);
Begin
stvDIR.SetFocus;
stvDIR.Select(stvDIR.Items[0]);
End;
Class Procedure SelectFolder.wndDIRResize(Sender: TObject);
Var
I, iSpace: Integer;
Begin
If iLengthBtnDrives > wndDIR.ClientWidth
Then
Begin
wndDIR.Caption:= 'CHOOSE A FOLDER Ctrl+ArrowKeys: Scroll Drives';
stvDIR.Hint := '"T": Tree'+sLineBreak+'"D": Drives'+sLineBreak+'MouseWheel Up/Down: Scroll Drives';
End
Else
Begin
wndDIR.Caption:= 'CHOOSE A FOLDER';
stvDIR.Hint := '"T": Tree'+sLineBreak+'"D": Drives';
End;
iSpace:= -100;
For I:= 0 To lBtnDrives.Count-1
Do
Begin
iSpace:= iSpace +100;
TButton(lBtnDrives[I]).Left:= iSpace;
End;
stvDIR.SetBounds(0, 50, wndDIR.ClientWidth, (wndDIR.ClientHeight-100));
End;
Class Procedure SelectFolder.btnOKClick(Sender: TObject);
Begin
strResult:= stvDIR.Path;
wndDIR.Close;
End;
Class Procedure SelectFolder.wndDIRKeyDown(Sender: TObject; Var Key: Word; Shift: TShiftState);
Var
I: Integer;
Begin
If Key = VK_ESCAPE Then wndDIR.Close;
If Key = Ord('T') Then stvDIR.SetFocus;
If Key = Ord('D')
Then
Begin
For I:= 0 To lBtnDrives.Count-1
Do
Begin
If TButton(lBtnDrives[I]).Left = 0
Then
Begin
TButton(lBtnDrives[I]).SetFocus;
Break;
End;
End;
End;
If Key = VK_TAB
Then
If stvDIR.Focused
Then
Begin
For I:= 0 To lBtnDrives.Count-1
Do
Begin
If TButton(lBtnDrives[I]).Left = 0
Then
Begin
TButton(lBtnDrives[I]).SetFocus;
Break;
End;
End;
End;
If Key = VK_RETURN
Then
If stvDIR.Focused
Then
Begin
strResult:= stvDIR.Path;
wndDIR.Close;
End;
If (Key = VK_RIGHT) And (ssCtrl In Shift)
Then DrivesScrollRight;
If (Key = VK_LEFT) And (ssCtrl In Shift)
Then DrivesScrollLeft;
End;
Class Procedure SelectFolder.btnDriveClick(Sender: TObject);
Begin
If Sender Is TButton
Then
Begin
If Assigned(btnSelDrive)
Then btnSelDrive.Font.Style:= [];
TButton(Sender).Font.Style:= [fsItalic, fsUnderline, fsBold];
btnSelDrive:= TButton(Sender);
stvDIR.Root:= TButton(Sender).Caption+'\';
stvDIR.SetFocus;
stvDIR.Select(stvDIR.Items[0]);
End;
End;
Class Procedure SelectFolder.DrivesScrollLeft;
Var
I: Integer;
Begin
If (TButton(lBtnDrives[0]).Left < 0)
Then
Begin
TButton(lBtnDrives[0]).SetFocus;
For I:= 0 To lBtnDrives.Count-1
Do TButton(lBtnDrives[I]).Left:= TButton(lBtnDrives[I]).Left +100;
End;
End;
Class Procedure SelectFolder.DrivesScrollRight;
Var
I: Integer;
Begin
If (TButton(lBtnDrives[lBtnDrives.Count-1]).Left > wndDIR.ClientWidth -100)
Then
Begin
TButton(lBtnDrives[0]).SetFocus;
For I:= 0 To lBtnDrives.Count-1
Do TButton(lBtnDrives[I]).Left:= TButton(lBtnDrives[I]).Left -100;
End;
End;
Class Procedure SelectFolder.wndDIRWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; Var Handled: Boolean);
Begin
DrivesScrollRight;
End;
Class Procedure SelectFolder.wndDIRWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; Var Handled: Boolean);
Begin
DrivesScrollLeft;
End;
End.