mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

UPD: Start to implement new design

Browse source
This commit is contained in:
Alexander Koblov 2009-07-15 19:35:20 +00:00
commit f02605feec
32 changed files with 9139 additions and 3960 deletions
Download patch file Download diff file Expand all files Collapse all files

185
src/doublecmd.lpi
View file

@ -59,7 +59,7 @@
<PackageName Value="viewerpackage"/>
</Item5>
</RequiredPackages>
<Units Count="51">
<Units Count="61">
<Unit0>
<Filename Value="doublecmd.lpr"/>
<IsPartOfProject Value="True"/>
@ -67,16 +67,16 @@
</Unit0>
<Unit1>
<Filename Value="fconfigtoolbar.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmConfigToolBar"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fConfigToolBar"/>
</Unit1>
<Unit2>
<Filename Value="fmain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmMain"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fMain"/>
</Unit2>
@ -87,178 +87,180 @@
</Unit3>
<Unit4>
<Filename Value="fviewer.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmViewer"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fViewer"/>
</Unit4>
<Unit5>
<Filename Value="feditor.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmEditor"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fEditor"/>
</Unit5>
<Unit6>
<Filename Value="fMsg.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmMsg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fMsg"/>
</Unit6>
<Unit7>
<Filename Value="dmcommondata.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="dmComData"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="DataModule"/>
<UnitName Value="dmCommonData"/>
</Unit7>
<Unit8>
<Filename Value="dmhigh.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="dmHighl"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="dmHigh"/>
</Unit8>
<Unit9>
<Filename Value="feditorconf.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmEditorConf"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fEditorConf"/>
</Unit9>
<Unit10>
<Filename Value="ffindview.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmFindView"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fFindView"/>
</Unit10>
<Unit11>
<Filename Value="fAbout.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmAbout"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fAbout"/>
</Unit11>
<Unit12>
<Filename Value="foptions.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmOptions"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fOptions"/>
</Unit12>
<Unit13>
<Filename Value="fFileOpDlg.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmFileOp"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fFileOpDlg"/>
</Unit13>
<Unit14>
<Filename Value="fmkdir.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmMkDir"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fMkDir"/>
</Unit14>
<Unit15>
<Filename Value="fCopyDlg.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmCopyDlg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fCopyDlg"/>
</Unit15>
<Unit16>
<Filename Value="fcomparefiles.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmCompareFiles"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fCompareFiles"/>
</Unit16>
<Unit17>
<Filename Value="fmovedlg.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmMoveDlg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fMoveDlg"/>
</Unit17>
<Unit18>
<Filename Value="fFindDlg.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmFindDlg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fFindDlg"/>
</Unit18>
<Unit19>
<Filename Value="fhotdir.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmHotDir"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fHotDir"/>
</Unit19>
<Unit20>
<Filename Value="fsymlink.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmSymLink"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fSymLink"/>
</Unit20>
<Unit21>
<Filename Value="fhardlink.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmHardLink"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fHardLink"/>
</Unit21>
<Unit22>
<Filename Value="fmultirename.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmMultiRename"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fMultiRename"/>
</Unit22>
<Unit23>
<Filename Value="fpackdlg.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmPackDlg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fPackDlg"/>
</Unit23>
<Unit24>
<Filename Value="flinker.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmLinker"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fLinker"/>
</Unit24>
<Unit25>
<Filename Value="fsplitter.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmSplitter"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fSplitter"/>
</Unit25>
<Unit26>
<Filename Value="ffileproperties.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmFileProperties"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fFileProperties"/>
</Unit26>
<Unit27>
<Filename Value="fextractdlg.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmExtractDlg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fExtractDlg"/>
</Unit27>
<Unit28>
@ -268,38 +270,38 @@
</Unit28>
<Unit29>
<Filename Value="ffileassoc.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmFileAssoc"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fFileAssoc"/>
</Unit29>
<Unit30>
<Filename Value="fcolumnssetconf.pas"/>
<ComponentName Value="fColumnsSetConf"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="fColumnsSetConf"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fColumnsSetConf"/>
</Unit30>
<Unit31>
<Filename Value="fhackform.pas"/>
<ComponentName Value="frmHackForm"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmHackForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fHackForm"/>
</Unit31>
<Unit32>
<Filename Value="fpackinfodlg.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmPackInfoDlg"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fPackInfoDlg"/>
</Unit32>
<Unit33>
<Filename Value="ftweakplugin.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmTweakPlugin"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fTweakPlugin"/>
</Unit33>
@ -310,8 +312,8 @@
</Unit34>
<Unit35>
<Filename Value="fdescredit.pas"/>
<ComponentName Value="frmDescrEdit"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmDescrEdit"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fDescrEdit"/>
</Unit35>
@ -332,78 +334,125 @@
</Unit38>
<Unit39>
<Filename Value="dmhelpmanager.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="dmHelpManager"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="DataModule"/>
<UnitName Value="dmHelpManager"/>
</Unit39>
<Unit40>
<Filename Value="framepanel.pas"/>
<ComponentName Value="FrameFilePanel"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Frame"/>
<UnitName Value="framePanel"/>
</Unit40>
<Unit41>
<Filename Value="feditsearch.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmEditSearchReplace"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fEditSearch"/>
</Unit41>
<Unit42>
</Unit40>
<Unit41>
<Filename Value="platform\udragdropex.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uDragDropEx"/>
</Unit42>
<Unit43>
</Unit41>
<Unit42>
<Filename Value="ushellexecute.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uShellExecute"/>
</Unit43>
<Unit44>
</Unit42>
<Unit43>
<Filename Value="platform\uClipboard.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uClipboard"/>
</Unit44>
<Unit45>
</Unit43>
<Unit44>
<Filename Value="platform\udragdropgtk.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uDragDropGtk"/>
</Unit45>
<Unit46>
</Unit44>
<Unit45>
<Filename Value="usearchtemplate.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uSearchTemplate"/>
</Unit46>
<Unit47>
</Unit45>
<Unit46>
<Filename Value="platform\ukeyboard.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uKeyboard"/>
</Unit47>
<Unit48>
</Unit46>
<Unit47>
<Filename Value="platform\udragdropqt.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uDragDropQt"/>
</Unit48>
<Unit49>
</Unit47>
<Unit48>
<Filename Value="fchecksumverify.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmCheckSumVerify"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fCheckSumVerify"/>
</Unit49>
<Unit50>
</Unit48>
<Unit49>
<Filename Value="fchecksumcalc.pas"/>
<ComponentName Value="frmCheckSumCalc"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmCheckSumCalc"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fCheckSumCalc"/>
</Unit49>
<Unit50>
<Filename Value="newdesign\ulocalfilesource.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uLocalFileSource"/>
</Unit50>
<Unit51>
<Filename Value="newdesign\ufilesystemfilesource.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uFileSystemFileSource"/>
</Unit51>
<Unit52>
<Filename Value="newdesign\ufilesystemlistoperation.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uFileSystemListOperation"/>
</Unit52>
<Unit53>
<Filename Value="newdesign\ufactory.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ufactory"/>
</Unit53>
<Unit54>
<Filename Value="newdesign\ufilesourcelistoperation.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uFileSourceListOperation"/>
</Unit54>
<Unit55>
<Filename Value="newdesign\ufilesourceoperationtypes.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uFileSourceOperationTypes"/>
</Unit55>
<Unit56>
<Filename Value="newdesign\ufilesourceproperty.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uFileSourceProperty"/>
</Unit56>
<Unit57>
<Filename Value="newdesign\udefaultfilepropertyformatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uDefaultFilePropertyFormatter"/>
</Unit57>
<Unit58>
<Filename Value="newdesign\ulocalfile.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uLocalFile"/>
</Unit58>
<Unit59>
<Filename Value="newdesign\ufilesystemfile.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uFileSystemFile"/>
</Unit59>
<Unit60>
<Filename Value="newdesign\ufilepanelselect.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="uFilePanelSelect"/>
</Unit60>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -414,7 +463,7 @@
</Target>
<SearchPaths>
<IncludeFiles Value="$(LazarusDir)\ide\;$(ProjOutDir)\"/>
<OtherUnitFiles Value="$(ProjPath)\platform\;$(ProjPath)\platform\$(SrcOS)\;..\sdk\"/>
<OtherUnitFiles Value="$(ProjPath)\platform\;$(ProjPath)\platform\$(SrcOS)\;..\sdk\;$(ProjPath)\newdesign\;$(ProjPath)\newdesign\fileproperties\;newdesign\columnsview\"/>
<UnitOutputDirectory Value="..\units\$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)"/>
<SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\;$(fpcsrcdir)\packages\fcl-base\src\"/>
</SearchPaths>
@ -426,8 +475,14 @@
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<Optimizations>
<OptimizationLevel Value="2"/>
<OptimizationLevel Value="0"/>
</Optimizations>
</CodeGeneration>
<Linking>

356
src/fCopyDlg.pas
View file

@ -1,178 +1,178 @@
unit fCopyDlg;
interface
uses
LResources,
SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;
type
{ TfrmCopyDlg }
TfrmCopyDlg = class(TForm)
btnCancel: TBitBtn;
btnOK: TBitBtn;
cbDropReadOnlyFlag: TCheckBox;
cmbFileType: TComboBox;
edtDst: TEdit;
lblCopySrc: TLabel;
lblFileType: TLabel;
pnlSelector: TPanel;
procedure btnCancelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure btnOKMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure frmCopyDlgKeyPress(Sender: TObject; var Key: Char);
procedure frmCopyDlgShow(Sender: TObject);
private
function ShowTabsSelector: integer;
procedure TabsSelector(Sender: TObject);
procedure TabsSelectorMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
{ Private declarations }
public
{ Public declarations }
end;
implementation
uses
fMain, framePanel, LCLType, uGlobs;
var noteb:TNotebook;
procedure TfrmCopyDlg.TabsSelector(Sender: TObject);
begin
edtDst.Text:=TFrameFilePanel(noteb.Page[(sender as TBitBtn).tag].Components[0]).ActiveDir;
end;
procedure TfrmCopyDlg.TabsSelectorMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
edtDst.Text:=TFrameFilePanel(noteb.Page[(sender as TBitBtn).tag].Components[0]).ActiveDir;
end;
function TfrmCopyDlg.ShowTabsSelector: integer;
var btnS,btnL:TBitBtn; i,tc:integer; st:TStringList; s:string;
begin
if frmmain.SelectedPanel=fpRight
then noteb:=frmmain.nbLeft
else noteb:=frmmain.nbRight;
if noteb.PageCount=1 then
begin
Result:=0;
exit;
end;
tc:=noteb.PageCount;
st:=TStringList.Create;
try
for i:=0 to tc-1 do
if TFrameFilePanel(noteb.Page[i].Components[0]).Visible=true then
begin
s:=TFrameFilePanel(noteb.Page[i].Components[0]).ActiveDir;
if st.IndexOf(s)=-1 then
begin
st.Add(s);
st.Objects[st.Count-1]:=TObject(i);
end;
end;
tc:=st.Count;
btnL := nil;
if tc>10 then tc:=10;
for i:=0 to tc-1 do
begin
btnS:=TBitBtn.Create(Self);
btns.Parent:=pnlSelector;
btns.Tag:=PtrInt(st.Objects[i]);
if i<9 then
btns.Caption:=inttostr(i+1)+' - '+noteb.Page[PtrInt(st.Objects[i])].Caption
else
btns.Caption:='0 - '+noteb.Page[PtrInt(st.Objects[i])].Caption;
btnS.OnClick:=TabsSelector;
btnS.OnMouseDown:=TabsSelectorMouseDown;
btns.AutoSize:=True;
btns.Left := 2;
btns.Anchors :=[akLeft,akBottom];
btns.Visible:=true;
if btnL <> nil then
begin
btns.AnchorSideLeft.Control := btnL;
btns.AnchorSideLeft.Side := asrRight;
end;
btnL := btnS;
if (Self.Width < (btnL.Left+btnL.Width+200)) then // 200 = Ok + Cancel
Self.Width := (btnL.Left+btnL.Width+200);
end;
finally
st.Free;
end;
end;
procedure TfrmCopyDlg.frmCopyDlgShow(Sender: TObject);
begin
if gShowCopyTabSelectPanel then
begin
ShowTabsSelector;
pnlSelector.SetFocus;
end
else
begin
edtDst.SelectAll;
edtDst.SetFocus;
end;
end;
procedure TfrmCopyDlg.frmCopyDlgKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#27 then
begin
ModalResult:=mrCancel;
Key := #0;
end
else if Key=#13 then
begin
ModalResult:=mrOK;
Key:=#0;
end;
end;
procedure TfrmCopyDlg.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if gShowCopyTabSelectPanel and (edtDst.Focused=false) and (key-49<pnlSelector.ControlCount) then
begin
if (key>=VK_1) and (Key<=VK_9) then
TBitBtn(pnlSelector.Controls[key-49]).Click;
if key=vk_0 then
TBitBtn(pnlSelector.Controls[9]).Click;
end;
end;
procedure TfrmCopyDlg.btnCancelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ModalResult := btnCancel.ModalResult;
end;
procedure TfrmCopyDlg.btnOKMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ModalResult := btnOk.ModalResult;
end;
initialization
{$I fCopyDlg.lrs}
end.
unit fCopyDlg;
interface
uses
LResources,
SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;
type
{ TfrmCopyDlg }
TfrmCopyDlg = class(TForm)
btnCancel: TBitBtn;
btnOK: TBitBtn;
cbDropReadOnlyFlag: TCheckBox;
cmbFileType: TComboBox;
edtDst: TEdit;
lblCopySrc: TLabel;
lblFileType: TLabel;
pnlSelector: TPanel;
procedure btnCancelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure btnOKMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure frmCopyDlgKeyPress(Sender: TObject; var Key: Char);
procedure frmCopyDlgShow(Sender: TObject);
private
function ShowTabsSelector: integer;
procedure TabsSelector(Sender: TObject);
procedure TabsSelectorMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
{ Private declarations }
public
{ Public declarations }
end;
implementation
uses
fMain, LCLType, uGlobs, uFilePanelSelect, uFileView;
var noteb:TNotebook;
procedure TfrmCopyDlg.TabsSelector(Sender: TObject);
begin
edtDst.Text:=TFileView(noteb.Page[(sender as TBitBtn).tag].Components[0]).CurrentPath;
end;
procedure TfrmCopyDlg.TabsSelectorMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
edtDst.Text:=TFileView(noteb.Page[(sender as TBitBtn).tag].Components[0]).CurrentPath;
end;
function TfrmCopyDlg.ShowTabsSelector: integer;
var btnS,btnL:TBitBtn; i,tc:integer; st:TStringList; s:string;
begin
if frmmain.SelectedPanel=fpRight
then noteb:=frmmain.nbLeft
else noteb:=frmmain.nbRight;
if noteb.PageCount=1 then
begin
Result:=0;
exit;
end;
tc:=noteb.PageCount;
st:=TStringList.Create;
try
for i:=0 to tc-1 do
if TFileView(noteb.Page[i].Components[0]).Visible=true then
begin
s:=TFileView(noteb.Page[i].Components[0]).CurrentPath;
if st.IndexOf(s)=-1 then
begin
st.Add(s);
st.Objects[st.Count-1]:=TObject(i);
end;
end;
tc:=st.Count;
btnL := nil;
if tc>10 then tc:=10;
for i:=0 to tc-1 do
begin
btnS:=TBitBtn.Create(Self);
btns.Parent:=pnlSelector;
btns.Tag:=PtrInt(st.Objects[i]);
if i<9 then
btns.Caption:=inttostr(i+1)+' - '+noteb.Page[PtrInt(st.Objects[i])].Caption
else
btns.Caption:='0 - '+noteb.Page[PtrInt(st.Objects[i])].Caption;
btnS.OnClick:=TabsSelector;
btnS.OnMouseDown:=TabsSelectorMouseDown;
btns.AutoSize:=True;
btns.Left := 2;
btns.Anchors :=[akLeft,akBottom];
btns.Visible:=true;
if btnL <> nil then
begin
btns.AnchorSideLeft.Control := btnL;
btns.AnchorSideLeft.Side := asrRight;
end;
btnL := btnS;
if (Self.Width < (btnL.Left+btnL.Width+200)) then // 200 = Ok + Cancel
Self.Width := (btnL.Left+btnL.Width+200);
end;
finally
st.Free;
end;
end;
procedure TfrmCopyDlg.frmCopyDlgShow(Sender: TObject);
begin
if gShowCopyTabSelectPanel then
begin
ShowTabsSelector;
pnlSelector.SetFocus;
end
else
begin
edtDst.SelectAll;
edtDst.SetFocus;
end;
end;
procedure TfrmCopyDlg.frmCopyDlgKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#27 then
begin
ModalResult:=mrCancel;
Key := #0;
end
else if Key=#13 then
begin
ModalResult:=mrOK;
Key:=#0;
end;
end;
procedure TfrmCopyDlg.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if gShowCopyTabSelectPanel and (edtDst.Focused=false) and (key-49<pnlSelector.ControlCount) then
begin
if (key>=VK_1) and (Key<=VK_9) then
TBitBtn(pnlSelector.Controls[key-49]).Click;
if key=vk_0 then
TBitBtn(pnlSelector.Controls[9]).Click;
end;
end;
procedure TfrmCopyDlg.btnCancelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ModalResult := btnCancel.ModalResult;
end;
procedure TfrmCopyDlg.btnOKMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ModalResult := btnOk.ModalResult;
end;
initialization
{$I fCopyDlg.lrs}
end.

402
src/fFileOpDlg.pas
View file

@ -1,201 +1,201 @@
{
Seksi Commander
----------------------------
Implementing of progress dialog for file operation
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
contributors:
Copyright (C) 2008-2009 Koblov Alexander (Alexx2000@mail.ru)
}
unit fFileOpDlg;
{$mode objfpc}{$H+}
interface
uses
LResources,
SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Buttons;
type
{ TfrmFileOp }
TfrmFileOp = class(TForm)
btnPauseStart: TBitBtn;
lblFrom: TLabel;
lblTo: TLabel;
lblFileNameTo: TLabel;
pbSecond: TProgressBar;
pbFirst: TProgressBar;
lblFileNameFrom: TLabel;
lblEstimated: TLabel;
btnCancel: TBitBtn;
procedure btnCancelClick(Sender: TObject);
procedure btnPauseStartClick(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
iProgress1Max: Integer;
iProgress1Pos: Integer;
iProgress2Max: Integer;
iProgress2Pos: Integer;
sEstimated: ShortString; // bugbug, must be short string
sFileNameFrom,
sFileNameTo: String;
Thread: TThread;
procedure ToggleProgressBarStyle;
procedure UpdateDlg;
end;
implementation
uses
fMain, dmCommonData, uFileOpThread;
procedure TfrmFileOp.btnCancelClick(Sender: TObject);
begin
if Assigned(Thread) then
begin
Thread.Terminate;
if Thread is TFileOpThread then
with Thread as TFileOpThread do
if Paused then Paused:= False;
end;
ModalResult:= mrCancel;
end;
procedure TfrmFileOp.btnPauseStartClick(Sender: TObject);
begin
if Assigned(Thread) then
begin
if Thread is TFileOpThread then
with Thread as TFileOpThread do
begin
Paused:= not Paused;
dmComData.ImageList.GetBitmap(Integer(not Paused), btnPauseStart.Glyph);
end;
end;
end;
procedure TfrmFileOp.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
CloseAction:= caFree;
frmMain.frameLeft.RefreshPanel;
frmMain.frameRight.RefreshPanel;
frmMain.ActiveFrame.SetFocus;
end;
procedure TfrmFileOp.FormCreate(Sender: TObject);
begin
Thread:= nil;
pbFirst.Position:= 0;
pbSecond.Position:= 0;
pbFirst.Max:= 1;
pbSecond.Max:= 1;
iProgress1Max:= 0;
iProgress2Max:= 0;
iProgress1Pos:= 0;
iProgress2Pos:= 0;
pbFirst.DoubleBuffered:= True;
pbSecond.DoubleBuffered:= True;
Self.DoubleBuffered:= True;
end;
procedure TfrmFileOp.FormShow(Sender: TObject);
begin
sEstimated:= '';
sFileNameFrom:= '';
sFileNameTo:= '';
Hint:= Caption;
if btnPauseStart.Visible then
dmComData.ImageList.GetBitmap(1, btnPauseStart.Glyph);
end;
procedure TfrmFileOp.ToggleProgressBarStyle;
begin
if (pbFirst.Style = pbstMarquee) and (pbSecond.Style = pbstMarquee) then
begin
pbFirst.Style:= pbstNormal;
pbSecond.Style:= pbstNormal;
end
else
begin
pbFirst.Style:= pbstMarquee;
pbSecond.Style:= pbstMarquee;
end;
end;
procedure TfrmFileOp.UpdateDlg;
var
bP1, bP2: Boolean; // repaint if needed
begin
// in processor intensive task we force repaint immedially
bP1:= False;
bP2:= False;
if pbFirst.Max<> iProgress1Max then
begin
if iProgress1Max > 0 then
pbFirst.Max:= iProgress1Max;
bP1:= True;
end;
if pbFirst.Position <> iProgress1Pos then
begin
if iProgress1Pos >= 0 then
pbFirst.Position:= iProgress1Pos;
bP1:= True;
end;
if pbSecond.Max <> iProgress2Max then
begin
if iProgress2Max > 0 then
pbSecond.Max:= iProgress2Max;
bP2:= True;
end;
if pbSecond.Position <> iProgress2Pos then
begin
if iProgress2Pos > 0 then
pbSecond.Position:= iProgress2Pos;
bP2:= True;
end;
if bp1 then
pbFirst.Invalidate;
if bp2 then
pbSecond.Invalidate;
if bp2 then
Caption:= IntToStr(iProgress2Pos) + '% ' + Hint;
if sEstimated <> lblEstimated.Caption then
begin
lblEstimated.Caption:= sEstimated;
lblEstimated.Invalidate;
end;
if sFileNameFrom <> lblFileNameFrom.Caption then
begin
lblFileNameFrom.Caption:= sFileNameFrom;
lblFileNameFrom.Invalidate;
end;
if sFileNameTo <> lblFileNameTo.Caption then
begin
lblFileNameTo.Caption:= sFileNameTo;
lblFileNameTo.Invalidate;
end;
end;
initialization
{$I fFileOpDlg.lrs}
end.
{
Seksi Commander
----------------------------
Implementing of progress dialog for file operation
Licence : GNU GPL v 2.0
Author : radek.cervinka@centrum.cz
contributors:
Copyright (C) 2008-2009 Koblov Alexander (Alexx2000@mail.ru)
}
unit fFileOpDlg;
{$mode objfpc}{$H+}
interface
uses
LResources,
SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Buttons;
type
{ TfrmFileOp }
TfrmFileOp = class(TForm)
btnPauseStart: TBitBtn;
lblFrom: TLabel;
lblTo: TLabel;
lblFileNameTo: TLabel;
pbSecond: TProgressBar;
pbFirst: TProgressBar;
lblFileNameFrom: TLabel;
lblEstimated: TLabel;
btnCancel: TBitBtn;
procedure btnCancelClick(Sender: TObject);
procedure btnPauseStartClick(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
iProgress1Max: Integer;
iProgress1Pos: Integer;
iProgress2Max: Integer;
iProgress2Pos: Integer;
sEstimated: ShortString; // bugbug, must be short string
sFileNameFrom,
sFileNameTo: String;
Thread: TThread;
procedure ToggleProgressBarStyle;
procedure UpdateDlg;
end;
implementation
uses
fMain, dmCommonData, uFileOpThread;
procedure TfrmFileOp.btnCancelClick(Sender: TObject);
begin
if Assigned(Thread) then
begin
Thread.Terminate;
if Thread is TFileOpThread then
with Thread as TFileOpThread do
if Paused then Paused:= False;
end;
ModalResult:= mrCancel;
end;
procedure TfrmFileOp.btnPauseStartClick(Sender: TObject);
begin
if Assigned(Thread) then
begin
if Thread is TFileOpThread then
with Thread as TFileOpThread do
begin
Paused:= not Paused;
dmComData.ImageList.GetBitmap(Integer(not Paused), btnPauseStart.Glyph);
end;
end;
end;
procedure TfrmFileOp.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
CloseAction:= caFree;
frmMain.frameLeft.Reload;
frmMain.frameRight.Reload;
frmMain.ActiveFrame.SetFocus;
end;
procedure TfrmFileOp.FormCreate(Sender: TObject);
begin
Thread:= nil;
pbFirst.Position:= 0;
pbSecond.Position:= 0;
pbFirst.Max:= 1;
pbSecond.Max:= 1;
iProgress1Max:= 0;
iProgress2Max:= 0;
iProgress1Pos:= 0;
iProgress2Pos:= 0;
pbFirst.DoubleBuffered:= True;
pbSecond.DoubleBuffered:= True;
Self.DoubleBuffered:= True;
end;
procedure TfrmFileOp.FormShow(Sender: TObject);
begin
sEstimated:= '';
sFileNameFrom:= '';
sFileNameTo:= '';
Hint:= Caption;
if btnPauseStart.Visible then
dmComData.ImageList.GetBitmap(1, btnPauseStart.Glyph);
end;
procedure TfrmFileOp.ToggleProgressBarStyle;
begin
if (pbFirst.Style = pbstMarquee) and (pbSecond.Style = pbstMarquee) then
begin
pbFirst.Style:= pbstNormal;
pbSecond.Style:= pbstNormal;
end
else
begin
pbFirst.Style:= pbstMarquee;
pbSecond.Style:= pbstMarquee;
end;
end;
procedure TfrmFileOp.UpdateDlg;
var
bP1, bP2: Boolean; // repaint if needed
begin
// in processor intensive task we force repaint immedially
bP1:= False;
bP2:= False;
if pbFirst.Max<> iProgress1Max then
begin
if iProgress1Max > 0 then
pbFirst.Max:= iProgress1Max;
bP1:= True;
end;
if pbFirst.Position <> iProgress1Pos then
begin
if iProgress1Pos >= 0 then
pbFirst.Position:= iProgress1Pos;
bP1:= True;
end;
if pbSecond.Max <> iProgress2Max then
begin
if iProgress2Max > 0 then
pbSecond.Max:= iProgress2Max;
bP2:= True;
end;
if pbSecond.Position <> iProgress2Pos then
begin
if iProgress2Pos > 0 then
pbSecond.Position:= iProgress2Pos;
bP2:= True;
end;
if bp1 then
pbFirst.Invalidate;
if bp2 then
pbSecond.Invalidate;
if bp2 then
Caption:= IntToStr(iProgress2Pos) + '% ' + Hint;
if sEstimated <> lblEstimated.Caption then
begin
lblEstimated.Caption:= sEstimated;
lblEstimated.Invalidate;
end;
if sFileNameFrom <> lblFileNameFrom.Caption then
begin
lblFileNameFrom.Caption:= sFileNameFrom;
lblFileNameFrom.Invalidate;
end;
if sFileNameTo <> lblFileNameTo.Caption then
begin
lblFileNameTo.Caption:= sFileNameTo;
lblFileNameTo.Invalidate;
end;
end;
initialization
{$I fFileOpDlg.lrs}
end.

1905
src/fFindDlg.pas
View file

File diff suppressed because it is too large Load diff

16
src/fcolumnssetconf.pas
View file

@ -33,7 +33,8 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, Buttons, Grids, ComCtrls, Menus, LCLType, uColumns,uGlobs, Spin,framePanel,
ExtCtrls, Buttons, Grids, ComCtrls, Menus, LCLType, uColumns,uGlobs, Spin,
uColumnsFileView,
ColorBox;
type
@ -198,7 +199,8 @@ type
updMove: TUpDown;
btnCfg: TButton;
PreviewPan: TFrameFilePanel;
// Make a custom TColumnsFileViewPreview = class(TColumnsFileView).
PreviewPan: TColumnsFileView;
IndexRaw: Integer;
Showed: boolean;
@ -207,7 +209,8 @@ type
implementation
uses uLng, uOSUtils;
uses
uLng, uOSUtils, uFileSystemFileSource;
const
pnlCustHeight: Integer = 130;
@ -462,7 +465,7 @@ begin
// Initialize property storage
InitPropStorage(Self);
PreviewPan:=TFrameFilePanel.Create(pnlPreview, Label1, Label2, ComboBox1);
PreviewPan := TColumnsFileView.Create(pnlPreview, TFileSystemFileSource.Create);
CreateEditingControls;
end;
@ -577,8 +580,7 @@ begin
ActiveColmSlave:=ColumnClass;
isSlave:=true;
dgPanel.OnHeaderSized:=@DGHeaderSized;
pnlFile.ActiveDir := mbGetCurrentDir;
//dgPanel.OnHeaderSized:=@DGHeaderSized;
end;
if ColumnClass.ColumnsCount>0 then
@ -698,8 +700,10 @@ end;
procedure TfColumnsSetConf.DGHeaderSized(Sender: TObject; IsColumn: Boolean;
Index: Integer);
begin
{
stgColumns.Cells[2,Index+1]:=inttostr(PreviewPan.dgPanel.ColWidths[index]);
ColumnClass.SetColumnWidth(Index,PreviewPan.dgPanel.ColWidths[index])
}
end;
procedure TfColumnsSetConf.btnOkClick(Sender: TObject);

6
src/fextractdlg.pas
View file

@ -28,7 +28,7 @@ unit fExtractDlg;
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, uVFS, uFileList, framePanel,
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, uVFS, uFileList,
EditBtn;
type
@ -53,7 +53,7 @@ TfrmExtractDlg = class(TForm)
end;
// Frees fl.
function ShowExtractDlg(ActiveFrame:TFrameFilePanel; var fl : TFileList; sDestPath:String): Boolean;
//function ShowExtractDlg(ActiveFrame:TFrameFilePanel; var fl : TFileList; sDestPath:String): Boolean;
implementation
uses
@ -62,6 +62,7 @@ uses
var
CurrentVFS : TVFS;
{
function ShowExtractDlg(ActiveFrame:TFrameFilePanel; var fl: TFileList; sDestPath: String): Boolean;
var
I : Integer;
@ -120,6 +121,7 @@ begin
Free;
end;
end;
}
initialization
{$I fextractdlg.lrs}

840
src/fmain.pas
View file

File diff suppressed because it is too large Load diff

353
src/fmovedlg.pas
View file

@ -1,177 +1,176 @@
unit fMoveDlg;
{$mode objfpc}{$H+}
interface
uses
LResources,
SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;
type
{ TfrmMoveDlg }
TfrmMoveDlg = class(TForm)
btnCancel: TBitBtn;
btnOK: TBitBtn;
cmbFileType: TComboBox;
edtDst: TEdit;
lblFileType: TLabel;
lblMoveSrc: TLabel;
pnlSelector: TPanel;
procedure btnCancelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure btnOKMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure frmMoveDlgKeyPress(Sender: TObject; var Key: Char);
procedure frmMoveDlgShow(Sender: TObject);
private
function ShowTabsSelector: integer;
procedure TabsSelector(Sender: TObject);
procedure TabsSelectorMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
{ Private declarations }
public
{ Public declarations }
end;
implementation
uses
fMain, framePanel, LCLType, uGlobs;
var noteb:TNotebook;
procedure TfrmMoveDlg.TabsSelector(Sender: TObject);
begin
edtDst.Text:=TFrameFilePanel(noteb.Page[(sender as TBitBtn).tag].Components[0]).ActiveDir;
end;
procedure TfrmMoveDlg.TabsSelectorMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
edtDst.Text:=TFrameFilePanel(noteb.Page[(sender as TBitBtn).tag].Components[0]).ActiveDir;
end;
function TfrmMoveDlg.ShowTabsSelector: integer;
var btnS,btnL:TBitBtn; i,tc:integer; st:TStringList; s:string;
begin
if frmmain.SelectedPanel=fpRight
then noteb:=frmmain.nbLeft
else noteb:=frmmain.nbRight;
if noteb.PageCount=1 then
begin
Result:=0;
exit;
end;
tc:=noteb.PageCount;
st:=TStringList.Create;
try
for i:=0 to tc-1 do
if TFrameFilePanel(noteb.Page[i].Components[0]).Visible=true then
begin
s:=TFrameFilePanel(noteb.Page[i].Components[0]).ActiveDir;
if st.IndexOf(s)=-1 then
begin
st.Add(s);
st.Objects[st.Count-1]:=TObject(ptrint(i));
end;
end;
btnL := nil;
tc:=st.Count;
if tc>10 then tc:=10;
for i:=0 to tc-1 do
begin
btnS:=TBitBtn.Create(Self);
btns.Parent:=pnlSelector;
btns.Tag:=PtrInt(st.Objects[i]);
if i<9 then
btns.Caption:=inttostr(i+1)+' - '+noteb.Page[PtrInt(st.Objects[i])].Caption
else
btns.Caption:='0 - '+noteb.Page[PtrInt(st.Objects[i])].Caption;
btnS.OnClick:=@TabsSelector;
btnS.OnMouseDown:=@TabsSelectorMouseDown;
btns.AutoSize:=True;
btns.Left := 2;
btns.Anchors :=[akLeft,akBottom];
btns.Visible:=true;
if btnL <> nil then
begin
btns.AnchorSideLeft.Control := btnL;
btns.AnchorSideLeft.Side := asrRight;
end;
btnL := btnS;
if (Self.Width < (btnL.Left+btnL.Width+200)) then // 200 = Ok + Cancel
Self.Width := (btnL.Left+btnL.Width+200);
end;
finally
st.Free;
end;
end;
procedure TfrmMoveDlg.frmMoveDlgShow(Sender: TObject);
begin
if gShowCopyTabSelectPanel then
begin
ShowTabsSelector;
pnlSelector.SetFocus;
end
else
begin
edtDst.SelectAll;
edtDst.SetFocus;
end;
end;
procedure TfrmMoveDlg.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if gShowCopyTabSelectPanel and (edtDst.Focused=false) and (key-49<pnlSelector.ControlCount) then
begin
if (key>=VK_1) and (Key<=VK_9) then
TBitBtn(pnlSelector.Controls[key-49]).Click;
if key=vk_0 then
TBitBtn(pnlSelector.Controls[9]).Click;
end;
end;
procedure TfrmMoveDlg.btnOKMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ModalResult := btnOK.ModalResult;
end;
procedure TfrmMoveDlg.btnCancelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ModalResult := btnCancel.ModalResult;
end;
procedure TfrmMoveDlg.frmMoveDlgKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#27 then
begin
ModalResult:=mrCancel;
Key := #0;
end
else if Key=#13 then
begin
ModalResult:=mrOK;
Key:=#0;
end;
end;
initialization
{$I fmovedlg.lrs}
end.
unit fMoveDlg;
{$mode objfpc}{$H+}
interface
uses
LResources,
SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;
type
{ TfrmMoveDlg }
TfrmMoveDlg = class(TForm)
btnCancel: TBitBtn;
btnOK: TBitBtn;
cmbFileType: TComboBox;
edtDst: TEdit;
lblFileType: TLabel;
lblMoveSrc: TLabel;
pnlSelector: TPanel;
procedure btnCancelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure btnOKMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure frmMoveDlgKeyPress(Sender: TObject; var Key: Char);
procedure frmMoveDlgShow(Sender: TObject);
private
function ShowTabsSelector: integer;
procedure TabsSelector(Sender: TObject);
procedure TabsSelectorMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
{ Private declarations }
public
{ Public declarations }
end;
implementation
uses
fMain, LCLType, uGlobs, uFilePanelSelect, uFileView;
var noteb:TNotebook;
procedure TfrmMoveDlg.TabsSelector(Sender: TObject);
begin
edtDst.Text:=TFileView(noteb.Page[(sender as TBitBtn).tag].Components[0]).CurrentPath;
end;
procedure TfrmMoveDlg.TabsSelectorMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
edtDst.Text:=TFileView(noteb.Page[(sender as TBitBtn).tag].Components[0]).CurrentPath;
end;
function TfrmMoveDlg.ShowTabsSelector: integer;
var btnS,btnL:TBitBtn; i,tc:integer; st:TStringList; s:string;
begin
if frmmain.SelectedPanel=fpRight
then noteb:=frmmain.nbLeft
else noteb:=frmmain.nbRight;
if noteb.PageCount=1 then
begin
Result:=0;
exit;
end;
tc:=noteb.PageCount;
st:=TStringList.Create;
try
for i:=0 to tc-1 do
if TFileView(noteb.Page[i].Components[0]).Visible=true then
begin
s:=TFileView(noteb.Page[i].Components[0]).CurrentPath;
if st.IndexOf(s)=-1 then
begin
st.Add(s);
st.Objects[st.Count-1]:=TObject(ptrint(i));
end;
end;
btnL := nil;
tc:=st.Count;
if tc>10 then tc:=10;
for i:=0 to tc-1 do
begin
btnS:=TBitBtn.Create(Self);
btns.Parent:=pnlSelector;
btns.Tag:=PtrInt(st.Objects[i]);
if i<9 then
btns.Caption:=inttostr(i+1)+' - '+noteb.Page[PtrInt(st.Objects[i])].Caption
else
btns.Caption:='0 - '+noteb.Page[PtrInt(st.Objects[i])].Caption;
btnS.OnClick:=@TabsSelector;
btnS.OnMouseDown:=@TabsSelectorMouseDown;
btns.AutoSize:=True;
btns.Left := 2;
btns.Anchors :=[akLeft,akBottom];
btns.Visible:=true;
if btnL <> nil then
begin
btns.AnchorSideLeft.Control := btnL;
btns.AnchorSideLeft.Side := asrRight;
end;
btnL := btnS;
if (Self.Width < (btnL.Left+btnL.Width+200)) then // 200 = Ok + Cancel
Self.Width := (btnL.Left+btnL.Width+200);
end;
finally
st.Free;
end;
end;
procedure TfrmMoveDlg.frmMoveDlgShow(Sender: TObject);
begin
if gShowCopyTabSelectPanel then
begin
ShowTabsSelector;
pnlSelector.SetFocus;
end
else
begin
edtDst.SelectAll;
edtDst.SetFocus;
end;
end;
procedure TfrmMoveDlg.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if gShowCopyTabSelectPanel and (edtDst.Focused=false) and (key-49<pnlSelector.ControlCount) then
begin
if (key>=VK_1) and (Key<=VK_9) then
TBitBtn(pnlSelector.Controls[key-49]).Click;
if key=vk_0 then
TBitBtn(pnlSelector.Controls[9]).Click;
end;
end;
procedure TfrmMoveDlg.btnOKMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ModalResult := btnOK.ModalResult;
end;
procedure TfrmMoveDlg.btnCancelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ModalResult := btnCancel.ModalResult;
end;
procedure TfrmMoveDlg.frmMoveDlgKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#27 then
begin
ModalResult:=mrCancel;
Key := #0;
end
else if Key=#13 then
begin
ModalResult:=mrOK;
Key:=#0;
end;
end;
initialization
{$I fmovedlg.lrs}
end.

134
src/newdesign/columnsview/ucolumnsfileviewfiles.pas Normal file
View file

@ -0,0 +1,134 @@
unit uColumnsFileViewFiles;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFile;
type
{en
Describes the displayed file (for example when viewed in columns view).
}
TColumnsViewFile = class
private
FFile: TFile; // reference to file source's file
// Other properties.
FSelected: Boolean; //<en If is selected
FIconID: Integer; //<en Icon ID for PixmapManager
public
{en
A reference TFile must be passed as a parameter.
TColumnsViewFile object is invalid without a reference file.
The reference file is not a copy but a pointer
(should it be a copy?).
}
constructor Create(ReferenceFile: TFile); virtual reintroduce;
property TheFile: TFile read FFile write FFile;
property Selected: Boolean read FSelected write FSelected;
property IconID: Integer read FIconID write FIconID;
end;
TColumnsViewFiles = class//(TFiles)
private
FList: TFPList;
protected
function GetCount: Integer;
procedure SetCount(Count: Integer);
function Get(Index: Integer): TColumnsViewFile;
procedure Put(Index: Integer; AFile: TColumnsViewFile);
public
constructor Create;
destructor Destroy; override;
function Add(AFile: TColumnsViewFile): Integer;
procedure Clear;
property Count: Integer read GetCount write SetCount;
property Items[Index: Integer]: TColumnsViewFile read Get write Put; default;
property List: TFPList read FList;
end;
implementation
constructor TColumnsViewFile.Create(ReferenceFile: TFile);
begin
if not Assigned(ReferenceFile) then
raise Exception.Create('Reference file cannot be nil');
FSelected := False;
FIconID := 0;
TheFile := ReferenceFile;
end;
// ----------------------------------------------------------------------------
constructor TColumnsViewFiles.Create;
begin
inherited;
FList := TFPList.Create;
end;
destructor TColumnsViewFiles.Destroy;
begin
Clear;
FreeAndNil(FList);
inherited;
end;
function TColumnsViewFiles.GetCount: Integer;
begin
Result := FList.Count;
end;
procedure TColumnsViewFiles.SetCount(Count: Integer);
begin
FList.Count := Count;
end;
function TColumnsViewFiles.Add(AFile: TColumnsViewFile): Integer;
begin
Result := FList.Add(AFile);
end;
procedure TColumnsViewFiles.Clear;
var
i: Integer;
p: Pointer;
begin
for i := 0 to FList.Count - 1 do
begin
p := FList.Items[i];
if Assigned(p) then
TColumnsViewFile(p).Free;
end;
FList.Clear;
end;
function TColumnsViewFiles.Get(Index: Integer): TColumnsViewFile;
begin
Result := TColumnsViewFile(FList.Items[Index]);
end;
procedure TColumnsViewFiles.Put(Index: Integer; AFile: TColumnsViewFile);
begin
FList.Items[Index] := AFile;
end;
end.

368
src/newdesign/fileproperties/ufileproperty.pas Normal file
View file

@ -0,0 +1,368 @@
unit uFileProperty;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
// Forward declarations.
IFilePropertyFormatter = interface;
{ TFileProperty }
TFileProperty = class
private
public
constructor Create; virtual;
// Text description of the property.
// Don't know if it will be really needed.
class function GetDescription: String; virtual abstract;
// Formats the property value as a string using some formatter object.
function Format(Formatter: IFilePropertyFormatter): String; virtual abstract;
end;
TFilePropertyType = (
//fpName,
//fpPath,
fpSize, // = fpUncompressedSize?
fpCompressedSize,
fpAttributes,
fpDateTime, // non-specific - should be used?
// maybe it should be a default time
fpModificationTime,
fpCreationTime,
fpLastAccessTime // Last write?
);
TFilePropertiesTypes = set of TFilePropertyType;
TFilePropertiesDescriptions = array of String;//TFileProperty;
TFileProperties = array [TFilePropertyType] of TFileProperty//class(TList)
{
A list of TFileProperty. It would allow to query properties by index and name
and by TFilePropertyType.
}
//end
;
// -- Concrete properties ---------------------------------------------------
TFileSizeProperty = class(TFileProperty)
private
FSize: Int64; // Cardinal;
public
constructor Create; override;
constructor Create(Size: Int64); virtual; overload;
class function GetDescription: String; override;
// Retrieve possible values for the property.
function GetMinimumValue: Int64; //Cardinal;
function GetMaximumValue: Int64; //Cardinal;
function Format(Formatter: IFilePropertyFormatter): String; override;
property Value: Int64 read FSize write FSize;
end;
TFileDateTimeProperty = class(TFileProperty)
private
FDateTime: TDateTime;
public
constructor Create; override;
constructor Create(DateTime: TDateTime); virtual; overload;
class function GetDescription: String; override;
// Retrieve possible values for the property.
function GetMinimumValue: TDateTime;
function GetMaximumValue: TDateTime;
function Format(Formatter: IFilePropertyFormatter): String; override;
property Value: TDateTime read FDateTime write FDateTime;
end;
TFileModificationDateTimeProperty = class(TFileDateTimeProperty)
public
class function GetDescription: String; override;
function Format(Formatter: IFilePropertyFormatter): String; override;
end;
{en
File system attributes.
}
TFileAttributesProperty = class(TFileProperty)
private
// I don't know if there would be a file source with attributes of some other type
// than an integer number, but if there would we couldn't use Cardinal.
FAttributes: Cardinal;
public
constructor Create; override;
constructor Create(Attr: Cardinal); virtual; overload;
// Is the file a directory.
function IsDirectory: Boolean; virtual;
// Is this a system file.
function IsSysFile: boolean; virtual abstract;
// Is it a symbolic link.
function IsLink: Boolean; virtual;
// Retrieves raw attributes.
function GetAttributes: Cardinal; virtual;
// Sets raw attributes.
procedure SetAttributes(Attributes: Cardinal); virtual;
property Value: Cardinal read GetAttributes write SetAttributes;
end;
TNtfsFileAttributesProperty = class(TFileAttributesProperty)
public
// Is this a system file.
function IsSysFile: boolean; override;
function IsReadOnly: Boolean;
function IsHidden: Boolean;
class function GetDescription: String; override;
function Format(Formatter: IFilePropertyFormatter): String; override;
end;
TUnixFileAttributesProperty = class(TFileAttributesProperty)
public
// Is this a system file.
function IsSysFile: boolean; override;
function IsOwnerRead: Boolean;
function IsOwnerWrite: Boolean;
function IsOwnerExecute: Boolean;
// ...
class function GetDescription: String; override;
function Format(Formatter: IFilePropertyFormatter): String; override;
end;
// -- Property formatter interface ------------------------------------------
IFilePropertyFormatter = interface(IInterface)
['{18EF8E34-1010-45CD-8DC9-678C7C2DC89F}']
function FormatFileSize(FileProperty: TFileSizeProperty): String;
function FormatDateTime(FileProperty: TFileDateTimeProperty): String;
function FormatModificationDateTime(FileProperty: TFileModificationDateTimeProperty): String;
function FormatAttributes(FileProperty: TFileAttributesProperty): String;
end;
implementation
uses
uOSUtils;
resourcestring
rsSizeDescription = 'Size';
rsDateTimeDescription = 'DateTime';
rsModificationDateTimeDescription = 'Modification date/time';
// ----------------------------------------------------------------------------
constructor TFileProperty.Create;
begin
inherited;
end;
// ----------------------------------------------------------------------------
constructor TFileSizeProperty.Create;
begin
Self.Create(0);
end;
constructor TFileSizeProperty.Create(Size: Int64);
begin
inherited Create;
Value := Size;
end;
class function TFileSizeProperty.GetDescription: String;
begin
Result := rsSizeDescription;
end;
function TFileSizeProperty.GetMinimumValue: Int64;
begin
Result := 0;
end;
function TFileSizeProperty.GetMaximumValue: Int64;
begin
Result := 0; // maximum file size
end;
function TFileSizeProperty.Format(Formatter: IFilePropertyFormatter): String;
begin
Result := Formatter.FormatFileSize(Self);
end;
// ----------------------------------------------------------------------------
constructor TFileDateTimeProperty.Create;
begin
Self.Create(0);
end;
constructor TFileDateTimeProperty.Create(DateTime: TDateTime);
begin
inherited Create;
Value := DateTime;
end;
class function TFileDateTimeProperty.GetDescription: String;
begin
Result := rsDateTimeDescription;
end;
function TFileDateTimeProperty.GetMinimumValue: TDateTime;
begin
Result := 0;
end;
function TFileDateTimeProperty.GetMaximumValue: TDateTime;
begin
Result := 0; // maximum file size
end;
function TFileDateTimeProperty.Format(Formatter: IFilePropertyFormatter): String;
begin
Result := Formatter.FormatDateTime(Self);
end;
// ----------------------------------------------------------------------------
class function TFileModificationDateTimeProperty.GetDescription: String;
begin
Result := rsModificationDateTimeDescription;
end;
function TFileModificationDateTimeProperty.Format(Formatter: IFilePropertyFormatter): String;
begin
Result := Formatter.FormatModificationDateTime(Self);
end;
// ----------------------------------------------------------------------------
constructor TFileAttributesProperty.Create;
begin
Create(0);
end;
constructor TFileAttributesProperty.Create(Attr: Cardinal);
begin
inherited Create;
FAttributes := Attr;
end;
function TFileAttributesProperty.GetAttributes: Cardinal;
begin
Result := FAttributes;
end;
procedure TFileAttributesProperty.SetAttributes(Attributes: Cardinal);
begin
FAttributes := Attributes;
end;
function TFileAttributesProperty.IsDirectory: Boolean;
begin
Result := fpS_ISDIR(FAttributes);
end;
function TFileAttributesProperty.IsLink: Boolean;
begin
Result := fpS_ISLNK(FAttributes);
end;
// ----------------------------------------------------------------------------
function TNtfsFileAttributesProperty.IsSysFile: boolean;
begin
Result := ((FAttributes and faSysFile) <> 0) or
((FAttributes and faHidden) <> 0);
end;
function TNtfsFileAttributesProperty.IsReadOnly: Boolean;
begin
Result := (FAttributes and faReadOnly) <> 0;
end;
function TNtfsFileAttributesProperty.IsHidden: Boolean;
begin
Result := (FAttributes and faHidden) <> 0;
end;
class function TNtfsFileAttributesProperty.GetDescription: String;
begin
end;
function TNtfsFileAttributesProperty.Format(Formatter: IFilePropertyFormatter): String;
begin
Result := Formatter.FormatAttributes(Self)
end;
// ----------------------------------------------------------------------------
function TUnixFileAttributesProperty.IsSysFile: Boolean;
begin
Result := False;
end;
function TUnixFileAttributesProperty.IsOwnerRead: Boolean;
begin
end;
function TUnixFileAttributesProperty.IsOwnerWrite: Boolean;
begin
end;
function TUnixFileAttributesProperty.IsOwnerExecute: Boolean;
begin
end;
class function TUnixFileAttributesProperty.GetDescription: String;
begin
end;
function TUnixFileAttributesProperty.Format(Formatter: IFilePropertyFormatter): String;
begin
Result := Formatter.FormatAttributes(Self);
end;
end.

3552
src/newdesign/ucolumnsfileview.pas Normal file
View file

File diff suppressed because it is too large Load diff

119
src/newdesign/udefaultfilepropertyformatter.pas Normal file
View file

@ -0,0 +1,119 @@
unit uDefaultFilePropertyFormatter;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileProperty;
type
TDefaultFilePropertyFormatter = class(TInterfacedObject, IFilePropertyFormatter)
public
function FormatFileSize(FileProperty: TFileSizeProperty): String;
function FormatDateTime(FileProperty: TFileDateTimeProperty): String;
function FormatModificationDateTime(FileProperty: TFileModificationDateTimeProperty): String;
function FormatAttributes(FileProperty: TFileAttributesProperty): String;
end;
var
DefaultFilePropertyFormatter: IFilePropertyFormatter = nil;
implementation
uses
uGlobs, uDCUtils, LCLProc, uOSUtils
{$IFDEF MSWINDOWS}
, Windows
{$ENDIF}
{$IFDEF UNIX}
, BaseUnix, Unix
{$ENDIF}
;
function TDefaultFilePropertyFormatter.FormatFileSize(
FileProperty: TFileSizeProperty): String;
begin
Result := cnvFormatFileSize(FileProperty.Value);
end;
function TDefaultFilePropertyFormatter.FormatDateTime(
FileProperty: TFileDateTimeProperty): String;
begin
Result := SysUtils.FormatDateTime(gDateTimeFormat, FileProperty.Value);
end;
function TDefaultFilePropertyFormatter.FormatModificationDateTime(
FileProperty: TFileModificationDateTimeProperty): String;
begin
Result := FormatDateTime(FileProperty);
end;
function TDefaultFilePropertyFormatter.FormatAttributes(FileProperty: TFileAttributesProperty): String;
{
Format as decimal:
begin
Result := IntToStr(FileProperty.Value);
end;
}
var
iAttr: Cardinal;
begin
iAttr := FileProperty.Value;
{$IFDEF MSWINDOWS}
Result:= '--------';
if FPS_ISDIR(iAttr) then Result[1]:='d';
if FPS_ISLNK(iAttr) then Result[1]:='l';
if (iAttr and FILE_ATTRIBUTE_READONLY ) <> 0 then Result[2] := 'r';
if (iAttr and FILE_ATTRIBUTE_ARCHIVE ) <> 0 then Result[3] := 'a';
if (iAttr and FILE_ATTRIBUTE_HIDDEN ) <> 0 then Result[4] := 'h';
if (iAttr and FILE_ATTRIBUTE_SYSTEM ) <> 0 then Result[5] := 's';
// These two are exclusive on NTFS.
if (iAttr and FILE_ATTRIBUTE_COMPRESSED ) <> 0 then Result[6] := 'c';
if (iAttr and FILE_ATTRIBUTE_ENCRYPTED ) <> 0 then Result[6] := 'e';
if (iAttr and FILE_ATTRIBUTE_TEMPORARY ) <> 0 then Result[7] := 't';
if (iAttr and FILE_ATTRIBUTE_SPARSE_FILE) <> 0 then Result[8] := 'p';
{$ELSE}
Result:= '----------';
if FPS_ISDIR(iAttr) then Result[1]:='d';
if FPS_ISLNK(iAttr) then Result[1]:='l';
if FPS_ISSOCK(iAttr) then Result[1]:='s';
if FPS_ISFIFO(iAttr) then Result[1]:='f';
if FPS_ISBLK(iAttr) then Result[1]:='b';
if FPS_ISCHR(iAttr) then Result[1]:='c';
if ((iAttr AND S_IRUSR) = S_IRUSR) then Result[2] := 'r';
if ((iAttr AND S_IWUSR) = S_IWUSR) then Result[3] := 'w';
if ((iAttr AND S_IXUSR) = S_IXUSR) then Result[4] := 'x';
if ((iAttr AND S_IRGRP) = S_IRGRP) then Result[5] := 'r';
if ((iAttr AND S_IWGRP) = S_IWGRP) then Result[6] := 'w';
if ((iAttr AND S_IXGRP) = S_IXGRP) then Result[7] := 'x';
if ((iAttr AND S_IROTH) = S_IROTH) then Result[8] := 'r';
if ((iAttr AND S_IWOTH) = S_IWOTH) then Result[9] := 'w';
if ((iAttr AND S_IXOTH) = S_IXOTH) then Result[10] := 'x';
if ((iAttr AND S_ISUID) = S_ISUID) then Result[4] := 's';
if ((iAttr AND S_ISGID) = S_ISGID) then Result[7] := 's';
{$ENDIF}
end;
initialization
DefaultFilePropertyFormatter := TDefaultFilePropertyFormatter.Create as IFilePropertyFormatter;
finalization
DefaultFilePropertyFormatter := nil; // frees the interface
end.

37
src/newdesign/ufactory.pas Normal file
View file

@ -0,0 +1,37 @@
unit ufactory;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperationTypes,
uFileSourceListOperation,
uFileSource;
type
TFactory = class//(IFactory)
// Creates an operation object specific to the file source.
class function GetListOperationObject(FileSource: TFileSource)
: TFileSourceListOperation;
end;
implementation
class function TFactory.GetListOperationObject(FileSource: TFileSource)
: TFileSourceListOperation;
var
Operation: TObject;
begin
Result := nil;
Operation := FileSource.GetOperation(fsoList);
if Operation is TFileSourceListOperation then
Result := (Operation as TFileSourceListOperation)
else
raise Exception.Create('Incorrect operation type created');
end;
end.

274
src/newdesign/ufile.pas Normal file
View file

@ -0,0 +1,274 @@
unit uFile;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileProperty;
type
TFile = class
private
FName: String;
FPath: String; // Should this always include trailing path delimiter,
// or never include it?
// Cached values for extension and name.
// Automatically set when name changes.
FExtension: String; //<en Extension.
FNameNoExt: String; //<en Name without extension.
protected
FProperties: TFileProperties;
function GetProperties: TFileProperties; virtual;
function GetName: String;
procedure SetName(Name: String);
function GetExtension: String;
{en
Retrieves name without extension.
}
function GetNameNoExt: String;
public
constructor Create; virtual;
class function GetSupportedProperties: TFilePropertiesTypes; virtual abstract;
{en
This list only contains pointers to TFileProperty objects.
Never free element from this list!
Choices for implementing retrieval of file properties:
1. array [TFilePropertyType] of TFileProperty (current implementation)
Upside: it should be the fastest method.
Downside: uses more memory as the array size includes properties
not supported by the given file type
2. hash table indexed by TFilePropertyType key.
It _may_ be a bit slower than the table.
It _may_ use less memory though.
3. a simple list
Slowest, but the least memory usage.
}
//property Properties[Index: Integer];
//property Properties[Name: String];
//property Properties[Type: TFilePropertiesType]
property Properties: TFileProperties read GetProperties;
{en
All supported properties should have an assigned Properties[propertyType].
}
property SupportedProperties: TFilePropertiesTypes read GetSupportedProperties;
property Path: String read FPath write FPath;
property Name: String read GetName write SetName;
property NameNoExt: String read GetNameNoExt;
property Extension: String read GetExtension;
// Convenience functions.
// We assume here that when the file has no attributes
// the result is false for all these functions.
// These functions should probably be moved from here and should not be methods.
function IsDirectory: Boolean;
function IsSysFile: Boolean;
function IsLink: Boolean;
end;
// --------------------------------------------------------------------------
TFiles = class { A list of TFile }
private
FList: TFPList;
FPath: String; //<en path of all files
protected
function GetCount: Integer;
procedure SetCount(Count: Integer);
function Get(Index: Integer): TFile;
procedure Put(Index: Integer; AFile: TFile);
public
constructor Create;
destructor Destroy; override;
function Add(AFile: TFile): Integer;
procedure Clear;
property Count: Integer read GetCount write SetCount;
property Items[Index: Integer]: TFile read Get write Put; default;
property List: TFPList read FList;
property Path: String read FPath write FPath;
end;
implementation
uses
uOSUtils;
constructor TFile.Create;
begin
end;
function TFile.GetProperties: TFileProperties;
begin
Result := FProperties;
end;
function TFile.GetExtension: String;
begin
Result := FExtension;
end;
function TFile.GetNameNoExt: String;
begin
Result := FNameNoExt;
end;
function TFile.GetName: String;
begin
Result := FName;
end;
procedure TFile.SetName(Name: String);
begin
FName := Name;
// Cache Extension and NameNoExt.
if ((fpAttributes in SupportedProperties) and IsDirectory) or
(Name[1] = '.')
then
begin
// For directories and files beginning with '.' there is no extension.
FExtension := '';
FNameNoExt := FName;
end
else
begin
FExtension := ExtractFileExt(FName);
FNameNoExt := Copy(FName, 1, Length(FName) - Length(FExtension));
end;
end;
function TFile.IsDirectory: Boolean;
var
FileAttributes: TFileAttributesProperty;
begin
if fpAttributes in SupportedProperties then
begin
FileAttributes := Properties[fpAttributes] as TFileAttributesProperty;
Result := FileAttributes.IsDirectory
{$IFDEF MSWINDOWS}
//Because symbolic link works on Windows 2k/XP for directories only
or FileAttributes.IsLink
{$ENDIF}
;
end
else
Result := False;
end;
function TFile.IsLink: Boolean;
var
FileAttributes: TFileAttributesProperty;
begin
if fpAttributes in SupportedProperties then
begin
FileAttributes := Properties[fpAttributes] as TFileAttributesProperty;
Result := FileAttributes.IsLink;
end
else
Result := False;
end;
function TFile.IsSysFile: Boolean;
var
FileAttributes: TFileAttributesProperty;
begin
{$IFDEF MSWINDOWS}
if fpAttributes in SupportedProperties then
begin
FileAttributes := Properties[fpAttributes] as TFileAttributesProperty;
Result := FileAttributes.IsSysFile;
end
else
Result := False;
{$ELSE}
// Files beginning with '.' are treated as system/hidden files on Unix.
Result := (Name <> '') and
(Name <> '..') and
(Name[1] = '.');
{$ENDIF}
end;
// ----------------------------------------------------------------------------
constructor TFiles.Create;
begin
inherited;
FList := TFPList.Create;
end;
destructor TFiles.Destroy;
begin
Clear;
FreeAndNil(FList);
inherited;
end;
function TFiles.GetCount: Integer;
begin
Result := FList.Count;
end;
procedure TFiles.SetCount(Count: Integer);
begin
FList.Count := Count;
end;
function TFiles.Add(AFile: TFile): Integer;
begin
Result := FList.Add(AFile);
end;
procedure TFiles.Clear;
var
i: Integer;
p: Pointer;
begin
for i := 0 to FList.Count - 1 do
begin
p := FList.Items[i];
if Assigned(p) then
TFile(p).Free;
end;
FList.Clear;
end;
function TFiles.Get(Index: Integer): TFile;
begin
Result := TFile(FList.Items[Index]);
end;
procedure TFiles.Put(Index: Integer; AFile: TFile);
begin
FList.Items[Index] := AFile;
end;
end.

17
src/newdesign/ufilepanelselect.pas Normal file
View file

@ -0,0 +1,17 @@
unit uFilePanelSelect;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
TFilePanelSelect = (fpLeft, fpRight);
implementation
end.

88
src/newdesign/ufilesource.pas Normal file
View file

@ -0,0 +1,88 @@
unit uFileSource;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperation,
uFileSourceOperationTypes,
uFileSourceProperty,
uFileProperty,
uFile
;
type
TFileSource = class(TObject)
private
protected
FCurrentPath: String;
function GetCurrentPath: String; virtual;
procedure SetCurrentPath(NewPath: String); virtual;
{en
Returns all the properties supported by the file type of the given file source.
}
class function GetSupportedFileProperties: TFilePropertiesTypes; virtual abstract;
public
constructor Create; virtual;
// Retrieve operations permitted on the source. = capabilities?
class function GetOperationsTypes: TFileSourceOperationTypes; virtual abstract;
// Returns a list of property types supported by this source for each file.
class function GetFilePropertiesDescriptions: TFilePropertiesDescriptions; virtual abstract;
// Retrieve some properties of the file source.
class function GetProperties: TFileSourceProperties; virtual abstract;
// Retrieves the full address of the file source
// (the CurrentPath is relative to this).
// This may be used for specifying address:
// - archive : path to archive
// - network : address of server
// etc.
function GetSourceAddress: string; virtual abstract;
// Creates an operation object specific to the file source.
function GetOperation(OperationType: TFileSourceOperationType): TFileSourceOperation; virtual abstract;
// Retrieves a list of files.
// This is the same as GetOperation(fsoList), executing it
// and returning the result of Operation.ReleaseFiles.
// Caller is responsible for freeing the result list.
function GetFiles: TFiles; virtual abstract;
property CurrentPath: String read GetCurrentPath write SetCurrentPath;
property Properties: TFileSourceProperties read GetProperties;
property SupportedFileProperties: TFilePropertiesTypes read GetSupportedFileProperties;
end;
implementation
constructor TFileSource.Create;
begin
if ClassType = TFileSource then
raise Exception.Create('Cannot construct abstract class');
inherited Create;
end;
function TFileSource.GetCurrentPath: String;
begin
Result := FCurrentPath;
end;
procedure TFileSource.SetCurrentPath(NewPath: String);
begin
FCurrentPath := NewPath;
end;
end.

58
src/newdesign/ufilesourcelistoperation.pas Normal file
View file

@ -0,0 +1,58 @@
unit uFileSourceListOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperation,
uFile;
type
TFileSourceListOperation = class(TFileSourceOperation)
protected
FFiles: TFiles;
function GetFiles: TFiles;
public
constructor Create; virtual;
destructor Destroy; override;
// Retrieves files and revokes ownership of TFiles list.
// The result of this function should be freed by the caller.
function ReleaseFiles: TFiles;
property Files: TFiles read GetFiles;
end;
implementation
constructor TFileSourceListOperation.Create;
begin
FFiles := TFiles.Create;
end;
destructor TFileSourceListOperation.Destroy;
begin
if Assigned(FFiles) then
FreeAndNil(FFiles);
end;
function TFileSourceListOperation.GetFiles: TFiles;
begin
Result := FFiles;
end;
function TFileSourceListOperation.ReleaseFiles: TFiles;
begin
Result := FFiles;
FFiles := nil; // revoke ownership
end;
end.

31
src/newdesign/ufilesourceoperation.pas Normal file
View file

@ -0,0 +1,31 @@
unit uFileSourceOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils{,
uFileSource};
type
TFileSourceOperation = class
// private
// FFileSource: TFileSource;
public
// constructor Create(FileSource: TFileSource); virtual; reintroduce;
procedure Execute; virtual abstract;
end;
implementation
{constructor TFileSourceOperation.Create(FileSource: TFileSource);
begin
FFileSource := FileSource;
inherited Create;
end;}
end.

30
src/newdesign/ufilesourceoperationtypes.pas Normal file
View file

@ -0,0 +1,30 @@
unit uFileSourceOperationTypes;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
// Capabilities.
// (or make a separate type TFileSourceCapability with fsc... ?)
TFileSourceOperationType = (
fsoList,
fsoCopyIn,
fsoCopyOut,
fsoDelete,
fsoSetName,
fsoSetAttribute,
fsoExecute
//fsoSetPath / fsoChangePath
);
TFileSourceOperationTypes = set of TFileSourceOperationType;
implementation
end.

40
src/newdesign/ufilesourceproperty.pas Normal file
View file

@ -0,0 +1,40 @@
unit uFileSourceProperty;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
TFileSourceProperty = (
{en
Set, if the files are available directly (for example: real file system).
Not sure what it would do yet, but I'll leave it for now.
}
fspDirectAccess,
{en
Set, if filenames are case sensitive.
}
fspCaseSensitive,
{en
Set, if the file source has virtual files
(like a VFS list, or results from searching, etc.).
Non-virtual files are all files that are physical
(regardless if they are directly accessible).
}
fspVirtual
);
TFileSourceProperties = set of TFileSourceProperty;
implementation
end.

246
src/newdesign/ufilesystemfile.pas Normal file
View file

@ -0,0 +1,246 @@
unit uFileSystemFile;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uLocalFile,
uFile,
uFileProperty,
uOSUtils;
type
TFileSystemFile = class(TLocalFile)
private
FSize: TFileSizeProperty;
FAttributes: TFileAttributesProperty;
FModificationTime: TFileModificationDateTimeProperty;
procedure AssignProperties;
protected
function GetAttributes: Cardinal; virtual;
procedure SetAttributes(NewAttributes: Cardinal); virtual;
function GetSize: Int64; virtual;
procedure SetSize(NewSize: Int64); virtual;
function GetModificationTime: TDateTime; virtual;
procedure SetModificationTime(NewTime: TDateTime); virtual;
public
constructor Create; override;
constructor Create(SearchRecord: TSearchRec); overload;
{en
Creates a file using an existing file as a template.
All the properties will reflect the existing file.
@param(FilePath denotes absolute path to a file to use as a template.)
}
constructor Create(FilePath: String); overload;
destructor Destroy; override;
class function GetSupportedProperties: TFilePropertiesTypes; override;
property Size: Int64 read GetSize write SetSize;
property Attributes: Cardinal read GetAttributes write SetAttributes;
property ModificationTime: TDateTime read GetModificationTime write SetModificationTime;
end;
TFileSystemFiles = class(TFiles)
public
{en
Fills a files list from filenames list.
@param(FileNamesList
A list of absolute paths to files.)
}
procedure LoadFromFileNames(const FileNamesList: TStringList);
end;
implementation
uses
uFindEx;
constructor TFileSystemFile.Create;
begin
inherited Create;
Name := '';
FSize := TFileSizeProperty.Create;
FAttributes := TNtfsFileAttributesProperty.Create;
FModificationTime := TFileModificationDateTimeProperty.Create;
AssignProperties;
end;
constructor TFileSystemFile.Create(SearchRecord: TSearchRec);
{$IFDEF MSWINDOWS}
begin
inherited Create;
FAttributes := TNtfsFileAttributesProperty.Create(SearchRecord.Attr);
FSize := TFileSizeProperty.Create(SearchRecord.Size);
FModificationTime := TFileModificationDateTimeProperty.Create(
FileDateToDateTime(SearchRecord.Time));
//Other times: SearchRecord.FindData.ftCreationTime ...?
AssignProperties;
// Set name after assigning Attributes property, because it is used to get extension.
Name := SearchRecord.Name;
{
if IsLink then
begin
sLinkTo:= ReadSymLink(SearchRec.Name);
end;
bExecutable:= not FPS_ISDIR(iMode); // for ShellExecute
}
end;
{$ENDIF}
{$IFDEF UNIX} // Unix not working yet
var
sb: BaseUnix.Stat; //buffer for stat info
begin
with Result do
begin
sb:= PUnixFindData(SearchRec.FindHandle)^.StatRec;
iSize:=sb.st_size;
iOwner:=sb.st_uid; //UID
iGroup:=sb.st_gid; //GID
sOwner:=UIDToStr(iOwner);
sGroup:=GIDToStr(iGroup);
{/mate}
iMode:=sb.st_mode;
bSysFile := (SearchRec.Name[1] = '.') and (SearchRec.Name <> '..');
fTimeI:= FileDateToDateTime(sb.st_mtime); // EncodeDate (1970, 1, 1) + (SearchRec.Time / 86400.0);
if FPS_ISDIR(iMode) or (SearchRec.Name[1]='.') then //!!!!!
sExt:= ''
else
sExt:= ExtractFileExt(SearchRec.Name);
sNameNoExt:= Copy(SearchRec.Name,1,Length(SearchRec.Name)-Length(sExt));
sName:= SearchRec.Name;
sTime:= FormatDateTime(gDateTimeFormat, fTimeI);
bIsLink:= FPS_ISLNK(iMode);
sLinkTo:= '';
iDirSize:= 0;
if bIsLink then
begin
sLinkTo:= ReadSymLink(SearchRec.Name);
end;
if bIsLink then
bLinkIsDir:= IsDirByName(sLinkTo)
else
bLinkIsDir:= False;
bExecutable:= (not FPS_ISDIR(iMode)) and (iMode AND (S_IXUSR OR S_IXGRP OR S_IXOTH)>0);
bSelected:= False;
sModeStr:= AttrToStr(iMode);
sPath:= Path;
end; // with
AssignProperties;
end;
{$ENDIF}
constructor TFileSystemFile.Create(FilePath: String);
var
SearchRecord: TSearchRec;
begin
if FindFirstEx(FilePath, faAnyFile, SearchRecord) <> 0 then
begin
FindCloseEx(SearchRecord);
raise Exception.Create('File ' + FilePath + ' does not exist.');
end
else
Create(SearchRecord);
Path := ExtractFilePath(FilePath);
FindCloseEx(SearchRecord);
end;
destructor TFileSystemFile.Destroy;
begin
if Assigned(FAttributes) then
FreeAndNil(FAttributes);
if Assigned(FSize) then
FreeAndNil(FSize);
if Assigned(FModificationTime) then
FreeAndNil(FModificationTime);
end;
procedure TFileSystemFile.AssignProperties;
begin
FProperties[fpSize] := FSize;
FProperties[fpAttributes] := FAttributes;
FProperties[fpModificationTime] := FModificationTime;
end;
class function TFileSystemFile.GetSupportedProperties: TFilePropertiesTypes;
begin
Result := [{fpName, }fpSize, fpAttributes, fpModificationTime];
end;
function TFileSystemFile.GetAttributes: Cardinal;
begin
Result := FAttributes.Value;
end;
procedure TFileSystemFile.SetAttributes(NewAttributes: Cardinal);
begin
FAttributes.Value := NewAttributes;
end;
function TFileSystemFile.GetSize: Int64;
begin
Result := FSize.Value;
end;
procedure TFileSystemFile.SetSize(NewSize: Int64);
begin
FSize.Value := NewSize;
end;
function TFileSystemFile.GetModificationTime: TDateTime;
begin
Result := FModificationTime.Value;
end;
procedure TFileSystemFile.SetModificationTime(NewTime: TDateTime);
begin
FModificationTime.Value := NewTime;
end;
// ----------------------------------------------------------------------------
procedure TFileSystemFiles.LoadFromFileNames(const FileNamesList: TStringList);
var
AFile: TFileSystemFile;
i: Integer;
begin
Clear;
if not Assigned(FileNamesList) or (FileNamesList.Count <= 0) then Exit;
Path := ExtractFilePath(FileNamesList[0]);
for i := 0 to FileNamesList.Count - 1 do
begin
AFile := TFileSystemFile.Create(FileNamesList[i]);
Add(AFile);
end;
end;
end.

132
src/newdesign/ufilesystemfilesource.pas Normal file
View file

@ -0,0 +1,132 @@
unit uFileSystemFileSource;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperation,
uFileSourceOperationTypes,
uLocalFileSource,
uFileSourceProperty,
uFileProperty,
uFile
;
type
{en
Real file system.
}
TFileSystemFileSource = class(TLocalFileSource)
protected
procedure SetCurrentPath(NewPath: String); override;
public
constructor Create; override;
constructor Create(Path: String); overload;
class function GetSupportedFileProperties: TFilePropertiesTypes; override;
class function GetOperationsTypes: TFileSourceOperationTypes; override;
class function GetFilePropertiesDescriptions: TFilePropertiesDescriptions; override;
class function GetProperties: TFileSourceProperties; override;
function GetSourceAddress: string; override;
function GetOperation(OperationType: TFileSourceOperationType): TFileSourceOperation; override;
function GetFiles: TFiles; override;
// ------------------------------------------------------
end;
implementation
uses
uFileSystemListOperation, uOSUtils, uFileSystemFile;
constructor TFileSystemFileSource.Create;
begin
Create(mbGetCurrentDir);
end;
constructor TFileSystemFileSource.Create(Path: String);
begin
inherited Create;
FCurrentPath := Path;
end;
class function TFileSystemFileSource.GetOperationsTypes: TFileSourceOperationTypes;
begin
Result := [fsoList,
fsoCopyIn,
fsoCopyOut,
fsoDelete,
fsoSetName,
fsoSetAttribute,
fsoExecute];
//fsoSetPath / fsoChangePath
end;
class function TFileSystemFileSource.GetFilePropertiesDescriptions: TFilePropertiesDescriptions;
begin
SetLength(Result, 2);
Result[0] := TFileSizeProperty.GetDescription;
Result[1] := TFileModificationDateTimeProperty.GetDescription;
end;
class function TFileSystemFileSource.GetProperties: TFileSourceProperties;
begin
Result := [
fspDirectAccess
{$IFDEF UNIX}
, fspCaseSensitive
{$ENDIF}
];
end;
procedure TFileSystemFileSource.SetCurrentPath(NewPath: String);
begin
if not mbDirectoryExists(NewPath) then
NewPath := mbGetCurrentDir;
FCurrentPath := NewPath;
end;
class function TFileSystemFileSource.GetSupportedFileProperties: TFilePropertiesTypes;
begin
Result := TFileSystemFile.GetSupportedProperties;
end;
function TFileSystemFileSource.GetSourceAddress: string;
begin
Result := '';
end;
function TFileSystemFileSource.GetOperation(OperationType: TFileSourceOperationType): TFileSourceOperation;
begin
Result := nil;
case OperationType of
fsoList:
Result := TFileSystemListOperation.Create(Self);
end;
end;
function TFileSystemFileSource.GetFiles: TFiles;
var
ListOperation: TFileSystemListOperation;
begin
ListOperation := TFileSystemListOperation.Create(Self);
try
ListOperation.Execute;
Result := ListOperation.ReleaseFiles;
finally
FreeAndNil(ListOperation);
end;
end;
end.

84
src/newdesign/ufilesystemlistoperation.pas Normal file
View file

@ -0,0 +1,84 @@
unit uFileSystemListOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceListOperation,
uFileSystemFileSource
;
type
TFileSystemListOperation = class(TFileSourceListOperation)
private
FFileSource: TFileSystemFileSource;
public
constructor Create(FileSource: TFileSystemFileSource); reintroduce;
procedure Execute; override;
end;
implementation
uses
LCLProc, uFileSystemFile, uFindEx, uDCUtils;
constructor TFileSystemListOperation.Create(FileSource: TFileSystemFileSource);
begin
FFileSource := FileSource;
inherited Create;
end;
procedure TFileSystemListOperation.Execute;
var
AFile: TFileSystemFile;
sr: TSearchRec;
sParentDir: UTF8String;
sDir: UTF8String;
IsRootPath: Boolean;
begin
FFiles.Clear;
FFiles.Path := IncludeTrailingPathDelimiter(FFileSource.CurrentPath);
if FindFirstEx(FFiles.Path + '*', faAnyFile, sr) <> 0 then
begin
{ No files have been found. }
FindCloseEx(sr);
sParentDir := GetParentDir(FFileSource.CurrentPath);
{
if sParentDir <> EmptyStr then // if parent dir exists then add up level item
AddUpLevel(sParentDir, fl);
}
Exit;
end;
sDir := IncludeTrailingPathDelimiter(FFileSource.CurrentPath);
FFiles.Path := sDir;
if (sDir = PathDelim) or
(sDir = ExtractFileDrive(FFileSource.CurrentPath){+PathDelim})
then
IsRootPath := True
else
IsRootPath := False;
repeat
if sr.Name='.' then Continue;
// if sr.Name='' then Continue;
// Don't include '..' in the root directory.
if (sr.Name='..') and IsRootPath then
Continue;
AFile := TFileSystemFile.Create(sr);
AFile.Path := sDir;
FFiles.Add(AFile);
until FindNextEx(sr)<>0;
FindCloseEx(sr);
end;
end.

86
src/newdesign/ufileview.pas Normal file
View file

@ -0,0 +1,86 @@
unit uFileView;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls,
uFile, uFileSource, uFilePanelSelect;
type
{en
Base class for any view of the files.
}
TFileView = class(TWinControl)
private
{en
The file source associated with this view.
For now it lives as long as TFileView lives (it is freed in destructor).
Don't know if this should be changed or not.
}
FFileSource: TFileSource;
// It should be independent of left/right side in the future.
FPanelSelect: TFilePanelSelect;
protected
function GetCurrentPath: String; virtual;
procedure SetCurrentPath(NewPath: String); virtual;
public
constructor Create(AOwner: TWinControl;
FileSource: TFileSource); virtual reintroduce;
destructor Destroy; override;
// Retrieves files from file source again and displays the new list of files.
procedure Reload; virtual abstract;
// For now we use here the knowledge that there are tabs.
// Config should be independent of that in the future.
procedure LoadConfiguration(Section: String; TabIndex: Integer); virtual abstract;
procedure SaveConfiguration(Section: String; TabIndex: Integer); virtual abstract;
procedure UpdateView; virtual abstract;
// I'm not sure CurrentPath property should be allowed for abstract TFileView.
// We have no guarantee that the FileSource associated with this view even
// has something like a current path?
property CurrentPath: String read GetCurrentPath write SetCurrentPath;
property FileSource: TFileSource read FFileSource write FFileSource;
property PanelSelect: TFilePanelSelect read FPanelSelect write FPanelSelect;
end;
implementation
uses
uOSUtils;
constructor TFileView.Create(AOwner: TWinControl; FileSource: TFileSource);
begin
FFileSource := FileSource;
inherited Create(AOwner);
end;
destructor TFileView.Destroy;
begin
FreeAndNil(FFileSource);
end;
function TFileView.GetCurrentPath: String;
begin
Result := IncludeTrailingPathDelimiter( // trailing path delim needed?
FFileSource.CurrentPath);
end;
procedure TFileView.SetCurrentPath(NewPath: String);
begin
FFileSource.CurrentPath := NewPath;
end;
end.

19
src/newdesign/ulocalfile.pas Normal file
View file

@ -0,0 +1,19 @@
unit uLocalFile;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFile;
type
TLocalFile = class(TFile)
end;
implementation
end.

24
src/newdesign/ulocalfilesource.pas Normal file
View file

@ -0,0 +1,24 @@
unit uLocalFileSource;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSource;
type
{en
Base for classes of local file sources.
Empty placeholder for now, allows to check
whether a certain file source is local.
}
TLocalFileSource = class(TFileSource)
end;
implementation
end.

19
src/platform/uosforms.pas
View file

@ -312,7 +312,7 @@ begin
begin
sCmd:=sl.Strings[i];
if pos('VIEW=',sCmd)>0 then Continue; // view command is only for viewer
ReplaceExtCommand(sCmd, @fri, frmMain.ActiveFrame.pnlFile.ActiveDir);
ReplaceExtCommand(sCmd, @fri, frmMain.ActiveFrame.CurrentPath);
sCmd:= RemoveQuotation(sCmd);
InsertMenuItemEx(hActionsSubMenu,0, PWChar(UTF8Decode(sCmd)), 0, I + $1000, MFT_STRING);
@ -388,10 +388,14 @@ begin
begin
if FPS_ISDIR(iMode) or (bLinkIsDir) then
begin
{
Do this via Actions not by directly using ActiveFrame.
if sName = '..' then
frmMain.ActiveFrame.pnlFile.cdUpLevel
else
frmMain.ActiveFrame.pnlFile.cdDownLevel(FileList.GetItem(0));
}
bHandled := True;
end; // is dir
end; // with
@ -426,24 +430,29 @@ begin
end;
if SameText(sVerb, sCmdVerbDelete) or SameText(sVerb, sCmdVerbPaste) then
frmMain.ActiveFrame.RefreshPanel;
frmMain.ActiveFrame.Reload;
end // if cmd > 0
else if (cmd >= $1000) then // actions sub menu
begin
sCmd:= sl.Strings[cmd - $1000];
ReplaceExtCommand(sCmd, @fri, frmMain.ActiveFrame.pnlFile.ActiveDir);
ReplaceExtCommand(sCmd, @fri, frmMain.ActiveFrame.CurrentPath);
sCmd:= Copy(sCmd, pos('=',sCmd)+1, length(sCmd));
try
with frmMain.ActiveFrame do
begin
if (Pos('{!VFS}',sCmd)>0) and pnlFile.VFS.FindModule(ActiveDir + fri.sName) then
(*
VFS via another file source
if (Pos('{!VFS}',sCmd)>0) and pnlFile.VFS.FindModule(CurrentPath + fri.sName) then
begin
pnlFile.LoadPanelVFS(@fri);
Exit;
end;
if not ProcessExtCommand(sCmd, pnlFile.ActiveDir) then
if not ProcessExtCommand(sCmd, CurrentPath) then
frmMain.ExecCmd(sCmd);
*)
end;
finally
bHandled:= True;

95
src/platform/upixmapmanager.pas
View file

@ -34,7 +34,8 @@ unit uPixMapManager;
interface
uses
Classes, SysUtils, uTypes, Graphics, uOSUtils, uFileSorting
Classes, SysUtils, uTypes, Graphics, uOSUtils, uFileSorting,
uFile
{$IF DEFINED(UNIX) and DEFINED(LCLGTK2)}
, uClassesEx
{$ENDIF};
@ -88,7 +89,7 @@ type
// function GetStretchBitmap(iIndex: Integer; BkColor : TColor; iSize : Integer): TBitmap;
function DrawBitmap(iIndex: Integer; Canvas : TCanvas; Rect : TRect) : Boolean;
function GetIconBySortingDirection(SortingDirection: TSortDirection): PtrInt;
function GetIconByFile(fi:PFileRecItem; PanelMode: TPanelMode):PtrInt;
function GetIconByFile(AFile: TFile; DirectAccess: Boolean):PtrInt;
function GetDriveIcon(Drive : PDrive; IconSize : Integer; clBackColor : TColor) : Graphics.TBitmap;
function GetDefaultDriveIcon(IconSize : Integer; clBackColor : TColor) : Graphics.TBitmap;
end;
@ -106,7 +107,7 @@ procedure LoadPixMapManager;
implementation
uses
GraphType, LCLIntf, LCLType, LCLProc, Forms, FileUtil, uGlobsPaths, uWCXhead,
uGlobs, uDCUtils
uGlobs, uDCUtils, uFileSystemFile
{$IFDEF LCLGTK2}
, StrUtils
, gtkdef, gtk2, gdk2pixbuf, gdk2, glib2
@ -184,7 +185,7 @@ var
phiconSmall : HIcon;
IntfImage: TLazIntfImage = nil;
{$ENDIF}
pfri : PFileRecItem;
AFile: TFileSystemFile;
iIndex : Integer;
sExtFilter,
sGraphicFilter : String;
@ -312,17 +313,10 @@ begin
begin
if mbFileExists(sFileName) or mbDirectoryExists(sFileName) then
begin
New(pfri);
with pfri^ do
begin
sName:= sFileName;
sExt := ExtractFileExt(sFileName);
iMode := mbFileGetAttr(sFileName);
bLinkIsDir := (FPS_ISLNK(iMode) and FPS_ISDIR(iMode));
end;
iIndex := PixMapManager.GetIconByFile(pfri, pmDirectory);
AFile := TFileSystemFile.Create(sFileName);
iIndex := PixMapManager.GetIconByFile(AFile, True);
bmStandartBitmap := PixMapManager.GetBitmap(iIndex, clBackColor);
Dispose(pfri);
FreeAndNil(AFile);
end
else // file not found
begin
@ -884,74 +878,78 @@ begin
end;
end;
function TPixMapManager.GetIconByFile(fi: PFileRecItem; PanelMode: TPanelMode): PtrInt;
function TPixMapManager.GetIconByFile(AFile: TFile; DirectAccess: Boolean): PtrInt;
var
Ext: String;
{$IFDEF MSWINDOWS}
FileInfo: TSHFileInfoW;
_para2: DWORD;
_para5: UINT;
sFileName: String;
{$IFDEF MSWINDOWS}
FileInfo: TSHFileInfoW;
_para2: DWORD;
_para5: UINT;
{$ENDIF}
begin
Result:= -1;
if not Assigned(fi) then Exit;
Result := -1;
if not Assigned(AFile) then Exit;
with fi^ do
with AFile do
begin
// writeln(sExt);
if sName = '..' then
if Name = '..' then
begin
Result:= FiUpDirIconID;
Result := FiUpDirIconID;
Exit;
end;
if bLinkIsDir then
if IsLink and IsDirectory then
begin
Result:= FiDirLinkIconID;
Result := FiDirLinkIconID;
Exit;
end;
if FPS_ISDIR(iMode) then
if IsDirectory then
{$IFDEF MSWINDOWS}
if not mbFileExists(sPath + sName + '\desktop.ini') and (GetDeviceCaps(Application.MainForm.Canvas.Handle, BITSPIXEL) > 16) then
if not mbFileExists(Path + Name + '\desktop.ini') and
(GetDeviceCaps(Application.MainForm.Canvas.Handle, BITSPIXEL) > 16) then
{$ENDIF}
begin
Result:= FiDirIconID;
Result := FiDirIconID;
Exit;
end;
if FPS_ISLNK(iMode) then
if IsLink then
begin
Result:= FiLinkIconID;
Result := FiLinkIconID;
Exit;
end;
if (sExt = '') and (not FPS_ISDIR(iMode)) then
if (Extension = '') and (not IsDirectory) then
begin
Result:= FiDefaultIconID;
Result := FiDefaultIconID;
Exit;
end;
Ext:= LowerCase(copy(sExt, 2, Length(sExt)));
Ext := LowerCase(Copy(Extension, 2, Length(Extension)));
Result:= FExtList.IndexOf(Ext); // ignore .
if Result < 0 then
begin
{$IFDEF MSWINDOWS}
if PanelMode = pmDirectory then
if DirectAccess then
begin
_para2:= 0;
_para5:= SHGFI_SYSICONINDEX;
sFileName:= sPath + sName;
_para2 := 0;
_para5 := SHGFI_SYSICONINDEX;
sFileName := Path + Name;
end
else
begin
_para2:= FILE_ATTRIBUTE_NORMAL;
_para5:= SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES;
sFileName:= sName;
_para2 := FILE_ATTRIBUTE_NORMAL;
_para5 := SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES;
sFileName := Name;
end;
if gIconsSize = 16 then
_para5:= _para5 or SHGFI_SMALLICON
_para5 := _para5 or SHGFI_SMALLICON
else
_para5:= _para5 or SHGFI_LARGEICON;
_para5 := _para5 or SHGFI_LARGEICON;
//WriteLN('Icon for file == ' + sName);
@ -960,18 +958,19 @@ begin
FileInfo,
SizeOf(FileInfo),
_para5);
Result:= FileInfo.iIcon + $1000;
Result := FileInfo.iIcon + $1000;
//WriteLN('FileInfo.iIcon == ' + IntToStr(FileInfo.iIcon));
if (FExtList.IndexOf(Ext) < 0) and (Ext <> 'exe') and (Ext <> 'ico') and (Ext <> 'lnk') and (not FPS_ISDIR(iMode)) then
if (FExtList.IndexOf(Ext) < 0) and (Ext <> 'exe') and
(Ext <> 'ico') and (Ext <> 'lnk') and (not IsDirectory) then
FExtList.AddObject(Ext, TObject(Result));
{$ELSE}
Result:= FiDefaultIconID;
Result := FiDefaultIconID;
{$ENDIF}
Exit;
end;
Result:= PtrInt(FExtList.Objects[Result]);
Result := PtrInt(FExtList.Objects[Result]);
// writeln(Result);
end;
end;

256
src/uacts.pas
View file

File diff suppressed because it is too large Load diff

2349
src/ucolumns.pas
View file

File diff suppressed because it is too large Load diff

6
src/ufilelist.pas
View file

@ -352,12 +352,12 @@ begin
end;
// Sort.
FileListSorter := TListSorter.Create(fList, FileSortings);
{ FileListSorter := TListSorter.Create(fList, FileSortings);
try
FileListSorter.Sort;
finally
FreeAndNil(FileListSorter);
end;
end;}
end;
function TFileList.GetCount:Integer;
@ -373,7 +373,7 @@ begin
for i:=0 to fList.Count-1 do
begin
frp:=PFileRecItem(Flist.Items[i]);
frp^.iIconID:=PixMapManager.GetIconByFile(frp, PanelMode);
//frp^.iIconID:=PixMapManager.GetIconByFile(frp, PanelMode);
end;
end;

972
src/ufilesorting.pas
View file

@ -1,477 +1,495 @@
unit uFileSorting;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, uTypes, uColumns;
type
TSortDirection = (sdNone, sdAscending, sdDescending);
TFileSorting = record
SortFunctions: TFileFunctions;
SortDirection: TSortDirection;
end;
TFileSortings = array of TFileSorting;
{ TListSorter }
TListSorter = class
private
FSortList: TList;
FSortings: TFileSortings;
function MultiCompare(item1, item2:Pointer):Integer;
{en
Compares two file records using file functions.
@param(ptr1
First file)
@param(ptr2
Second file)
@returns(-1 lesser
@br 0 equal
@br 1 greater)
}
function Compare(FileSorting: TFileSorting; ptr1, ptr2: PFileRecItem): Integer;
Procedure QuickSort(FList: PPointerList; L, R : Longint);
public
{en
Creates the sorter.
@param(List
List to be sorted.)
@param(FileSorting
Sorting which will be used to sort file records.)
}
constructor Create(List: TList; Sortings: TFileSortings);
procedure Sort;
end;
{en
Returns true if the file functions will sort by the given sort function.
}
function HasSortFunction(FileFunctions: TFileFunctions;
SortFunction: TFileFunction): Boolean;
{en
Adds a function to the given list of functions.
}
procedure AddSortFunction(var FileFunctions: TFileFunctions;
SortFunction: TFileFunction);
{en
Adds sorting by a function with a given sorting direction to a file sortings.
}
procedure AddSorting(var FileSortings: TFileSortings;
SortFunction: TFileFunction; SortDirection: TSortDirection);
function ICompareByDirectory(item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
function ICompareByName(item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
function ICompareByNameNoExt(item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
function ICompareByExt (item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
function ICompareBySize(item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
function ICompareByDate(item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
function ICompareByAttr(item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
function ReverseSortDirection(SortDirection: TSortDirection): TSortDirection;
implementation
uses
uOSUtils, uGlobs, uDCUtils;
function HasSortFunction(FileFunctions: TFileFunctions;
SortFunction: TFileFunction): Boolean;
var
i: Integer;
begin
for i := 0 to Length(FileFunctions) - 1 do
begin
if SortFunction = FileFunctions[i] then
Exit(True);
end;
Result := False;
end;
procedure AddSortFunction(var FileFunctions: TFileFunctions;
SortFunction: TFileFunction);
begin
SetLength(FileFunctions, Length(FileFunctions) + 1);
FileFunctions[Length(FileFunctions) - 1] := SortFunction;
end;
procedure AddSorting(var FileSortings: TFileSortings;
SortFunction: TFileFunction; SortDirection: TSortDirection);
begin
SetLength(FileSortings, Length(FileSortings) + 1);
SetLength(FileSortings[Length(FileSortings) - 1].SortFunctions, 0);
AddSortFunction(FileSortings[Length(FileSortings) - 1].SortFunctions, SortFunction);
FileSortings[Length(FileSortings) - 1].SortDirection := SortDirection;
end;
function ICompareByDirectory(item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result:=0;
if (not (FPS_ISDIR(item1^.iMode) or item1^.bLinkIsDir)) and (not (FPS_ISDIR(item2^.iMode) or item2^.bLinkIsDir)) then Exit;
if (not (FPS_ISDIR(item1^.iMode) or item1^.bLinkIsDir)) and (FPS_ISDIR(item2^.iMode) or item2^.bLinkIsDir) then
begin
Result:=+1;
Exit;
end;
if (FPS_ISDIR(item1^.iMode) or item1^.bLinkIsDir) and (not (FPS_ISDIR(item2^.iMode) or item2^.bLinkIsDir)) then
begin
Result:=-1;
Exit;
end;
// both is directory, compare it
// if item1.fName=item2.fName then Exit;
// handle .. first
if item1^.sName='..' then
begin
Result:=-1;
Exit;
end;
if item2^.sName='..' then
begin
Result:=+1;
Exit;
end;
end;
function ICompareByName(item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result := 0;
if gCaseSensitiveSort then
Result := StrComp(PChar(item1^.sName), PChar(item2^.sName))
else
Result := mbCompareText(item1^.sName, item2^.sName);
if bSortNegative then
Result := -Result;
end;
function ICompareByNameNoExt(item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
var
name1, name2: string;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result := 0;
// Don't sort directories only by name.
if FPS_ISDIR(item1^.iMode) or (FPS_ISLNK(item1^.iMode) and item1^.bLinkIsDir) or
FPS_ISDIR(item2^.iMode) or (FPS_ISLNK(item2^.iMode) and item1^.bLinkIsDir) then
begin
// Sort by full name.
Result := ICompareByName(item1, item2, bSortNegative);
end
else
begin
name1 := ExtractOnlyFileName(item1^.sName);
name2 := ExtractOnlyFileName(item2^.sName);
if gCaseSensitiveSort then
Result := StrComp(PChar(name1), PChar(name2))
else
Result := mbCompareText(name1, name2);
if bSortNegative then
Result := -Result;
end;
end;
function ICompareByExt(item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result:=0;
if item1^.sExt = item2^.sExt then
Exit;
if gCaseSensitiveSort then
Result := StrComp(PChar(item1^.sExt), PChar(item2^.sExt))
else
Result := mbCompareText(item1^.sExt, item2^.sExt);
if bSortNegative then
Result := -Result;
end;
function ICompareByDate(item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result:=0;
if item1^.fTimeI = item2^.fTimeI then
Exit;
if item1^.fTimeI < item2^.fTimeI then
Result := -1
else
Result := +1;
if bSortNegative then
Result := -Result;
end;
function ICompareByAttr(item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result:=0;
if item1^.iMode = item2^.iMode then
Exit;
if item1^.iMode > item2^.iMode then
Result := -1
else
Result := +1;
if bSortNegative then
Result := -Result;
end;
function ICompareBySize(item1, item2:PFileRecItem; bSortNegative: Boolean):Integer;
function GetSize(pFile: PFileRecItem): Cardinal;
begin
if FPS_ISDIR(pFile^.iMode) or pFile^.bLinkIsDir then
begin
if pFile^.iDirSize <> 0 then
Result := pFile^.iDirSize
else
Result := 0;
end
else
Result := pFile^.iSize;
end;
var
iSize1 : Cardinal;
iSize2 : Cardinal;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result := 0;
iSize1 := GetSize(item1);
iSize2 := GetSize(item2);
if iSize1 = iSize2 then
Exit;
if iSize1 < iSize2 then
Result := -1
else
Result := +1;
if bSortNegative then
Result := -Result;
end;
function ReverseSortDirection(SortDirection: TSortDirection): TSortDirection;
begin
case SortDirection of
sdAscending:
Result := sdDescending;
sdDescending:
Result := sdAscending;
end;
end;
{ TListSorter }
constructor TListSorter.Create(List: TList; Sortings: TFileSortings);
begin
FSortList := List;
FSortings := Sortings;
inherited Create;
end;
procedure TListSorter.Sort;
begin
if Assigned(FSortList) and Assigned(FSortList.List) and
(FSortList.Count > 1) then
begin
QuickSort(FSortList.List, 0, FSortList.Count-1);
end;
end;
{ Return Values for ICompareByxxxx function
> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2
}
{
This function is simples support of sorting
directory (handle uglobs.gDirSortFirst)
Result is 0 if both parametres is directory and equal
or not a directory (both).
Else return +/- as ICompare****
> 0 (positive) Item1 is less than Item2
< 0 (negative) Item1 is greater than Item2
}
function TListSorter.MultiCompare(item1, item2:Pointer):Integer;
var
i : Integer;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result := 0;
if item1 = item2 then Exit;
// Put directories first.
if gDirSortFirst then
begin
Result := ICompareByDirectory(item1, item2, False); // Ascending
if Result <> 0 then Exit;
end;
for i := 0 to Length(FSortings) - 1 do
begin
Result := Compare(FSortings[i], item1, item2);
if Result <> 0 then Exit;
end;
end;
function TListSorter.Compare(FileSorting: TFileSorting; ptr1, ptr2: PFileRecItem): Integer;
var
i: Integer;
bNegative: Boolean;
begin
case FileSorting.SortDirection of
sdAscending:
bNegative := False;
sdDescending:
bNegative := True;
else
Exit;
end;
if Length(FileSorting.SortFunctions) > 0 then
begin
Result := 0;
for i := 0 to Length(FileSorting.SortFunctions) - 1 do
begin
//------------------------------------------------------
// Only DC internal functions supported.
case FileSorting.SortFunctions[i] of
fsfName:
Result := ICompareByName(ptr1, ptr2, bNegative);
fsfExtension:
Result := ICompareByExt(ptr1, ptr2, bNegative);
fsfSize:
Result := ICompareBySize(ptr1, ptr2, bNegative);
fsfAttr:
Result := ICompareByAttr(ptr1, ptr2, bNegative);
fsfPath:
begin
Result := mbCompareText(ptr1^.sPath, ptr2^.sPath);
if bNegative then
Result := -Result;
end;
fsfGroup:
begin
Result := mbCompareText(ptr1^.sGroup, ptr2^.sGroup);
if bNegative then
Result := -Result;
end;
fsfOwner:
begin
Result := mbCompareText(ptr1^.sOwner, ptr2^.sOwner);
if bNegative then
Result := -Result;
end;
fsfTime:
Result := ICompareByDate(ptr1, ptr2, bNegative);
fsfLinkTo:
begin
Result := mbCompareText(ptr1^.sLinkTo, ptr2^.sLinkTo);
if bNegative then
Result := -Result;
end;
fsfNameNoExtension:
Result := ICompareByNameNoExt(ptr1, ptr2, bNegative);
end;
if Result <> 0 then
Exit;
end;
end
else
Result := -1;
end;
// From FPC: lists.inc.
Procedure TListSorter.QuickSort(FList: PPointerList; L, R : Longint);
var
I, J : Longint;
P, Q : Pointer;
begin
repeat
I := L;
J := R;
P := FList^[ (L + R) div 2 ];
repeat
while MultiCompare(P, FList^[i]) > 0 do
I := I + 1;
while MultiCompare(P, FList^[J]) < 0 do
J := J - 1;
If I <= J then
begin
Q := FList^[I];
Flist^[I] := FList^[J];
FList^[J] := Q;
I := I + 1;
J := J - 1;
end;
until I > J;
if L < J then
QuickSort(FList, L, J);
L := I;
until I >= R;
end;
end.
unit uFileSorting;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, uColumns, uFile;
type
TSortDirection = (sdNone, sdAscending, sdDescending);
TFileSorting = record
SortFunctions: TFileFunctions;
SortDirection: TSortDirection;
end;
TFileSortings = array of TFileSorting;
{ TListSorter }
TListSorter = class
private
FSortList: TFPList;
FSortings: TFileSortings;
function MultiCompare(item1, item2: Pointer):Integer;
{en
Compares two file records using file functions.
@param(ptr1
First file)
@param(ptr2
Second file)
@returns(-1 lesser
@br 0 equal
@br 1 greater)
}
function Compare(FileSorting: TFileSorting; File1, File2: TFile): Integer;
Procedure QuickSort(FList: PPointerList; L, R : Longint);
public
{en
Creates the sorter.
@param(List
List to be sorted.)
@param(FileSorting
Sorting which will be used to sort file records.)
}
constructor Create(List: TFPList; Sortings: TFileSortings);
procedure Sort;
end;
{en
Returns true if the file functions will sort by the given sort function.
}
function HasSortFunction(FileFunctions: TFileFunctions;
SortFunction: TFileFunction): Boolean;
{en
Adds a function to the given list of functions.
}
procedure AddSortFunction(var FileFunctions: TFileFunctions;
SortFunction: TFileFunction);
{en
Adds sorting by a function with a given sorting direction to a file sortings.
}
procedure AddSorting(var FileSortings: TFileSortings;
SortFunction: TFileFunction; SortDirection: TSortDirection);
function ICompareByDirectory(item1, item2: TFile; bSortNegative: Boolean):Integer;
function ICompareByName(item1, item2: TFile; bSortNegative: Boolean):Integer;
function ICompareByNameNoExt(item1, item2: TFile; bSortNegative: Boolean):Integer;
function ICompareByExt (item1, item2: TFile; bSortNegative: Boolean):Integer;
function ICompareBySize(item1, item2: TFile; bSortNegative: Boolean):Integer;
function ICompareByDate(item1, item2: TFile; bSortNegative: Boolean):Integer;
function ICompareByAttr(item1, item2: TFile; bSortNegative: Boolean):Integer;
function ReverseSortDirection(SortDirection: TSortDirection): TSortDirection;
implementation
uses
uOSUtils, uGlobs, uDCUtils, uFileProperty, lclproc;
function HasSortFunction(FileFunctions: TFileFunctions;
SortFunction: TFileFunction): Boolean;
var
i: Integer;
begin
for i := 0 to Length(FileFunctions) - 1 do
begin
if SortFunction = FileFunctions[i] then
Exit(True);
end;
Result := False;
end;
procedure AddSortFunction(var FileFunctions: TFileFunctions;
SortFunction: TFileFunction);
begin
SetLength(FileFunctions, Length(FileFunctions) + 1);
FileFunctions[Length(FileFunctions) - 1] := SortFunction;
end;
procedure AddSorting(var FileSortings: TFileSortings;
SortFunction: TFileFunction; SortDirection: TSortDirection);
begin
SetLength(FileSortings, Length(FileSortings) + 1);
SetLength(FileSortings[Length(FileSortings) - 1].SortFunctions, 0);
AddSortFunction(FileSortings[Length(FileSortings) - 1].SortFunctions, SortFunction);
FileSortings[Length(FileSortings) - 1].SortDirection := SortDirection;
end;
function ICompareByDirectory(item1, item2: TFile; bSortNegative: Boolean):Integer;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result:=0;
{
if (not (FPS_ISDIR(item1^.iMode) or item1^.bLinkIsDir)) and
(not (FPS_ISDIR(item2^.iMode) or item2^.bLinkIsDir)) then Exit;
}
if (not item1.IsDirectory) and (not item2.IsDirectory) then
Exit;
{
if (not (FPS_ISDIR(item1^.iMode) or item1^.bLinkIsDir)) and
(FPS_ISDIR(item2^.iMode) or item2^.bLinkIsDir) then
}
if (not item1.IsDirectory) and item2.IsDirectory then
begin
Result:=+1;
end
else if item1.IsDirectory and (not item2.IsDirectory) then
{
if (FPS_ISDIR(item1^.iMode) or item1^.bLinkIsDir) and
(not (FPS_ISDIR(item2^.iMode) or item2^.bLinkIsDir)) then
}
begin
Result:=-1;
end
// both is directory, compare it
// if item1.fName=item2.fName then Exit;
// handle .. first
else if item1.Name='..' then
begin
Result:=-1;
end
else if item2.Name='..' then
begin
Result:=+1;
end;
end;
function ICompareByName(item1, item2: TFile; bSortNegative: Boolean):Integer;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result := 0;
if gCaseSensitiveSort then
Result := StrComp(PChar(item1.Name), PChar(item2.Name))
else
Result := mbCompareText(item1.Name, item2.Name);
if bSortNegative then
Result := -Result;
end;
function ICompareByNameNoExt(item1, item2: TFile; bSortNegative: Boolean):Integer;
var
name1, name2: string;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result := 0;
// Don't sort directories only by name.
if item1.IsDirectory or item2.IsDirectory then
begin
// Sort by full name.
Result := ICompareByName(item1, item2, bSortNegative);
end
else
begin
name1 := item1.NameNoExt;// ExtractOnlyFileName(item1.Name);
name2 := item2.NameNoExt;// ExtractOnlyFileName(item2.Name);
if gCaseSensitiveSort then
Result := StrComp(PChar(name1), PChar(name2))
else
Result := mbCompareText(name1, name2);
if bSortNegative then
Result := -Result;
end;
end;
function ICompareByExt(item1, item2: TFile; bSortNegative: Boolean):Integer;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result:=0;
if item1.Extension = item2.Extension then
Exit;
if gCaseSensitiveSort then
Result := StrComp(PChar(item1.Extension), PChar(item2.Extension))
else
Result := mbCompareText(item1.Extension, item2.Extension);
if bSortNegative then
Result := -Result;
end;
function ICompareByDate(item1, item2: TFile; bSortNegative: Boolean):Integer;
var
Time1, Time2: TDateTime;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result:=0;
// move this check before sorting starts?
// then don't add sorting by date if not supported.
if (not (fpDateTime in item1.SupportedProperties)) or
(not (fpDateTime in item2.SupportedProperties)) then Exit;
Time1 := (item1.Properties[fpDateTime] as TFileDateTimeProperty).Value;
Time2 := (item2.Properties[fpDateTime] as TFileDateTimeProperty).Value;
if Time1 = Time2 then Exit;
if Time1 < Time2 then
Result := -1
else
Result := +1;
if bSortNegative then
Result := -Result;
end;
function ICompareByAttr(item1, item2: TFile; bSortNegative: Boolean):Integer;
var
Attr1, Attr2: Cardinal;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result:=0;
if (not (fpAttributes in item1.SupportedProperties)) or
(not (fpAttributes in item2.SupportedProperties)) then Exit;
Attr1 := (item1.Properties[fpAttributes] as TFileAttributesProperty).Value;
Attr2 := (item2.Properties[fpAttributes] as TFileAttributesProperty).Value;
if Attr1 = Attr2 then
Exit;
if Attr1 > Attr2 then
Result := -1
else
Result := +1;
if bSortNegative then
Result := -Result;
end;
function ICompareBySize(item1, item2: TFile; bSortNegative: Boolean):Integer;
var
iSize1 : Cardinal;
iSize2 : Cardinal;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result := 0;
if (not (fpSize in item1.SupportedProperties)) or
(not (fpSize in item2.SupportedProperties)) then Exit;
iSize1 := (item1.Properties[fpSize] as TFileSizeProperty).Value;
iSize2 := (item2.Properties[fpSize] as TFileSizeProperty).Value;
if iSize1 = iSize2 then
Exit;
if iSize1 < iSize2 then
Result := -1
else
Result := +1;
if bSortNegative then
Result := -Result;
end;
function ReverseSortDirection(SortDirection: TSortDirection): TSortDirection;
begin
case SortDirection of
sdAscending:
Result := sdDescending;
sdDescending:
Result := sdAscending;
end;
end;
{ TListSorter }
constructor TListSorter.Create(List: TFPList; Sortings: TFileSortings);
begin
FSortList := List;
FSortings := Sortings;
inherited Create;
end;
procedure TListSorter.Sort;
begin
if Assigned(FSortList) and Assigned(FSortList.List) and
(FSortList.Count > 1) then
begin
QuickSort(FSortList.List, 0, FSortList.Count-1);
end;
end;
{ Return Values for ICompareByxxxx function
> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2
}
{
This function is simples support of sorting
directory (handle uglobs.gDirSortFirst)
Result is 0 if both parametres is directory and equal
or not a directory (both).
Else return +/- as ICompare****
> 0 (positive) Item1 is less than Item2
< 0 (negative) Item1 is greater than Item2
}
function TListSorter.MultiCompare(item1, item2: Pointer):Integer;
var
i : Integer;
begin
{> 0 (positive) Item1 is less than Item2
0 Item1 is equal to Item2
< 0 (negative) Item1 is greater than Item2}
Result := 0;
if item1 = item2 then Exit;
// Put directories first.
if gDirSortFirst then
begin
Result := ICompareByDirectory(TFile(item1), TFile(item2), False); // Ascending
if Result <> 0 then Exit;
end;
for i := 0 to Length(FSortings) - 1 do
begin
Result := Compare(FSortings[i], TFile(item1), TFile(item2));
if Result <> 0 then Exit;
end;
end;
function TListSorter.Compare(FileSorting: TFileSorting; File1, File2: TFile): Integer;
var
i: Integer;
bNegative: Boolean;
begin
case FileSorting.SortDirection of
sdAscending:
bNegative := False;
sdDescending:
bNegative := True;
else
Exit;
end;
if Length(FileSorting.SortFunctions) > 0 then
begin
Result := 0;
for i := 0 to Length(FileSorting.SortFunctions) - 1 do
begin
//------------------------------------------------------
// Only DC internal functions supported.
case FileSorting.SortFunctions[i] of
fsfName:
Result := ICompareByName(File1, File2, bNegative);
fsfExtension:
Result := ICompareByExt(File1, File2, bNegative);
fsfSize:
Result := ICompareBySize(File1, File2, bNegative);
fsfAttr:
Result := ICompareByAttr(File1, File2, bNegative);
fsfPath:
begin
Result := mbCompareText(File1.Path, File2.Path);
if bNegative then
Result := -Result;
end;
{
fsfGroup:
begin
Result := mbCompareText(ptr1^.sGroup, ptr2^.sGroup);
if bNegative then
Result := -Result;
end;
fsfOwner:
begin
Result := mbCompareText(ptr1^.sOwner, ptr2^.sOwner);
if bNegative then
Result := -Result;
end;
}
fsfTime:
Result := ICompareByDate(File1, File2, bNegative);
{
fsfLinkTo:
begin
Result := mbCompareText(ptr1^.sLinkTo, ptr2^.sLinkTo);
if bNegative then
Result := -Result;
end;
}
fsfNameNoExtension:
Result := ICompareByNameNoExt(File1, File2, bNegative);
end;
if Result <> 0 then
Exit;
end;
end
else
Result := -1;
end;
// From FPC: lists.inc.
Procedure TListSorter.QuickSort(FList: PPointerList; L, R : Longint);
var
I, J : Longint;
P, Q : Pointer;
begin
repeat
I := L;
J := R;
P := FList^[ (L + R) div 2 ];
repeat
while MultiCompare(P, FList^[i]) > 0 do
I := I + 1;
while MultiCompare(P, FList^[J]) < 0 do
J := J - 1;
If I <= J then
begin
Q := FList^[I];
Flist^[I] := FList^[J];
FList^[J] := Q;
I := I + 1;
J := J - 1;
end;
until I > J;
if L < J then
QuickSort(FList, L, J);
L := I;
until I >= R;
end;
end.