Unit uSelectFolder;
{$MODE OBJFPC}{$H+}
Interface
USES
Classes, SysUtils, Forms, Controls,
StdCtrls, Graphics, LCLType, ShellCtrls;
TYPE
SelectFolder = Class
Class Procedure OnKeyDownDIR (Sender: TObject; Var Key: Word;
Shift: TShiftState);
PRIVATE
Class Var strResult: String;
Class Var stvDIR : TShellTreeView;
PUBLIC
Class Function Show: String;
End;
Implementation
Class Function SelectFolder.Show: String;
Var
wndDIR: TForm;
Begin
Result:= '';
wndDIR:= TForm.Create(Nil);
Try
wndDIR.BorderStyle := bsSizeable;
wndDIR.BorderIcons := [biSystemMenu, biMaximize];
wndDIR.Caption := Application.Title;
wndDIR.Constraints.MinHeight:= 300;
wndDIR.Constraints.MinWidth := 400;
wndDIR.Height := 500;
wndDIR.Width := 700;
wndDIR.AutoScroll := False;
wndDIR.Position := poDesktopCenter;
wndDIR.FormStyle := fsNormal;
wndDIR.KeyPreview := True;
wndDIR.DoubleBuffered := True;
wndDIR.OnKeyDown := @OnKeyDownDIR;
stvDIR := TShellTreeView.Create(wndDIR);
stvDIR.DoubleBuffered := True;
stvDIR.BorderStyle := bsSingle;
stvDIR.Font.Size := 20;
stvDIR.Font.Quality := fqAntialiased;
stvDIR.Font.Style := [fsBold];
stvDIR.Align := alClient;
stvDIR.AutoExpand := True;
stvDIR.BackgroundColor := clBtnFace;
stvDIR.Root := ExtractFileDrive(ParamStr(0));
stvDIR.Root := '';
stvDIR.ObjectTypes := [otFolders];
stvDIR.ReadOnly := True;
stvDIR.ShowButtons := True;
stvDIR.ShowRoot := True;
stvDIR.HideSelection := True;
stvDIR.ScrollBars := ssAutoBoth;
stvDIR.TreeLinePenStyle:= psSolid;
stvDIR.TreeLineColor := clLime;
stvDIR.ExpandSignColor := clLime;
stvDIR.Parent := wndDIR;
wndDIR.ShowModal;
Result:= strResult;
Finally
wndDIR.Release;
wndDIR:= Nil;
End;
End;
Class Procedure SelectFolder.OnKeyDownDIR(Sender: TObject; Var Key: Word;
Shift: TShiftState);
Begin
If Key = VK_RETURN
Then
Begin
strResult:= stvDIR.Path;
TForm(Sender).Close;
End;
If Key = VK_ESCAPE
Then TForm(Sender).Close;
End;
End.
// =================
// can be used like this:
Implementation
USES uSelectFolder;
{$R *.LFM}
Procedure TForm1.Button1Click(Sender: TObject);
Begin
Edit1.Text:= SelectFolder.Show;
End;