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

ADD: Save and load tabs

Browse source
This commit is contained in:
Alexander Koblov 2007-08-13 21:16:28 +00:00
commit 131e1147d4
8 changed files with 651 additions and 550 deletions
Download patch file Download diff file Expand all files Collapse all files

952
components/KASToolBar/kastoolbar.pas
View file

@ -1,480 +1,472 @@
{
Double Commander components
-------------------------------------------------------------------------
Toolbar panel class
Copyright (C) 2006-2007 Koblov Alexander (Alexx2000@mail.ru)
contributors:
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
in a file called COPYING along with this program; if not, write to
the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
02139, USA.
}
unit KAStoolBar;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls,
Graphics, Dialogs, ExtCtrls, Buttons, IniFiles, FileUtil, comCtrls;
type
TOnToolButtonClick = procedure (NumberOfButton : Integer) of object;
TChangeLineCount = procedure (AddSize : Integer) of object;
{ TKAStoolBar }
TKAStoolBar = class(TPanel)
private
FButtonsList: TList;
FCmdList,
FIconList : TStringList;
FPositionX : Integer;
FPositionY : Integer;
FMaxBtnCount : Integer;
FLineBtnCount : Integer;
FButtonSize : Integer;
FNeedMore : Boolean;
FOnToolButtonClick : TOnToolButtonClick;
FChangeLineCount : TChangeLineCount;
FTotalBevelWidth : Integer;
FCheckToolButton : Boolean;
FFlatButtons: Boolean;
FDiskPanel: Boolean;
FChangePath : String;
FEnvVar : String;
FOldWidth : Integer;
FMustResize : Boolean;
function LoadBtnIcon(IconPath : String) : TBitMap;
function GetButton(Index: Integer): TSpeedButton;
function GetButtonCount: Integer;
function GetCommand(Index: Integer): String;
function GetIconPath(Index: Integer): String;
procedure SetButton(Index : Integer; Value : TSpeedButton);
procedure SetCommand(Index: Integer; const AValue: String);
procedure SetIconPath(Index: Integer; const AValue: String);
procedure ToolButtonClick(Sender: TObject);
procedure UpdateButtonsTag;
protected
{ Protected declarations }
procedure CreateWnd; override;
procedure Resize; override;
function GetCmdDirFromEnvVar(sPath: String): String;
function SetCmdDirAsEnvVar(sPath: String): String;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure InitBounds;
procedure LoadFromFile(FileName : String);
procedure SaveToFile(FileName : String);
function AddButton(sCaption, Cmd, BtnHint, IconPath : String) : Integer;
procedure RemoveButton(Index: Integer);
procedure DeleteAllToolButtons;
property ButtonCount: Integer read GetButtonCount;
property Buttons[Index: Integer]: TSpeedButton read GetButton write SetButton;
property Commands[Index: Integer]: String read GetCommand write SetCommand;
property Icons[Index: Integer]: String read GetIconPath write SetIconPath;
property ButtonList: TList read FButtonsList;
published
{ Published declarations }
property OnToolButtonClick: TOnToolButtonClick read FOnToolButtonClick write FOnToolButtonClick;
property OnChangeLineCount : TChangeLineCount read FChangeLineCount write FChangeLineCount;
property CheckToolButton : Boolean read FCheckToolButton write FCheckToolButton default False;
property FlatButtons : Boolean read FFlatButtons write FFlatButtons default False;
property IsDiskPanel : Boolean read FDiskPanel write FDiskPanel default False;
property ChangePath : String read FChangePath write FChangePath;
property EnvVar : String read FEnvVar write FEnvVar;
end;
procedure Register;
implementation
uses GraphType;
function TKAStoolBar.GetCmdDirFromEnvVar(sPath: String): String;
begin
DoDirSeparators(sPath);
if Pos(FEnvVar, sPath) <> 0 then
Result := StringReplace(sPath, FEnvVar, ExcludeTrailingPathDelimiter(FChangePath), [rfIgnoreCase])
else
Result := sPath;
end;
function TKAStoolBar.SetCmdDirAsEnvVar(sPath: String): String;
begin
DoDirSeparators(sPath);
if Pos(FChangePath, sPath) <> 0 then
Result := StringReplace(sPath, ExcludeTrailingPathDelimiter(FChangePath), FEnvVar, [rfIgnoreCase])
else
Result := sPath;
end;
procedure Register;
begin
RegisterComponents('KASComponents',[TKAStoolBar]);
end;
procedure TKAStoolBar.InitBounds;
begin
Caption := '';
if (BevelInner <> bvNone) and (BevelOuter <> bvNone) then
FTotalBevelWidth := BevelWidth * 2
else
FTotalBevelWidth := BevelWidth;
FButtonSize := Height - FTotalBevelWidth * 2;
//writeln('FButtonSize = ' + IntToStr(FButtonSize));
if Width < Height then
Width := Height;
FMaxBtnCount := (Width - FTotalBevelWidth * 2) div FButtonSize;
if not FDiskPanel then
Width := (FButtonSize * FMaxBtnCount) + FTotalBevelWidth * 2;
FPositionX := FTotalBevelWidth;
FPositionY := FTotalBevelWidth;
end;
procedure TKAStoolBar.Resize;
var
I, Count, NewHeight : Integer;
ToolButton : TSpeedButton;
begin
inherited Resize;
if FOldWidth = 0 then
FOldWidth := Width;
if ((FOldWidth <> Width) or FMustResize) and (FButtonsList.Count > 0) then
begin
NewHeight := FButtonSize + FTotalBevelWidth * 2;
if (BevelInner <> bvNone) and (BevelOuter <> bvNone) then
FTotalBevelWidth := BevelWidth * 2
else
FTotalBevelWidth := BevelWidth;
FButtonSize := NewHeight - FTotalBevelWidth * 2;
if Width < NewHeight then
Self.SetBounds(Left, Top, NewHeight, NewHeight);
FPositionX := FTotalBevelWidth;
FPositionY := FTotalBevelWidth;
//*****************
FNeedMore := False;
Count := FButtonsList.Count - 1;
for I := 0 to Count do
begin
ToolButton := TSpeedButton(FButtonsList.Items[I]);
ToolButton.SetBounds(FPositionX, FPositionY, ToolButton.Width, ToolButton.Height );
//ToolButton.Left:=FPositionX;
//ToolButton.Top := FPositionY;
ToolButton.Height := FButtonSize;
FPositionX:= FPositionX + ToolButton.Width;
if FNeedMore then
begin
NewHeight := NewHeight + FButtonSize;
FNeedMore := False;
end;
if (I <> Count) and ((FPositionX + TSpeedButton(FButtonsList.Items[I + 1]).Width) > Width) then
begin
FPositionY:= FPositionY + ToolButton.Height;
FPositionX := FTotalBevelWidth;
FNeedMore := True;
end;
end;
FOldWidth := Width;
FMustResize := False;
if Assigned(FChangeLineCount) then
FChangeLineCount(NewHeight - Height);
Self.SetBounds(Left, Top, Width, NewHeight);
end;
end;
function TKAStoolBar.LoadBtnIcon(IconPath: String): TBitMap;
var
PNG : TPortableNetworkGraphic;
begin
if IconPath <> '' then
if FileExists(IconPath) then
begin
if CompareFileExt(IconPath, 'png', false) = 0 then
begin
PNG := TPortableNetworkGraphic.Create;
PNG.LoadFromFile(IconPath);
Result := TBitMap(PNG);
end
else
begin
Result := TBitMap.Create;
Result.LoadFromFile(IconPath);
end;
end;
end;
function TKAStoolBar.GetButton(Index: Integer): TSpeedButton;
begin
Result := TSpeedButton(FButtonsList.Items[Index]);
end;
procedure TKAStoolBar.SetButton(Index : Integer; Value : TSpeedButton);
begin
TSpeedButton(FButtonsList.Items[Index]) := Value;
end;
procedure TKAStoolBar.SetCommand(Index: Integer; const AValue: String);
begin
FCmdList[Index] := AValue;
end;
procedure TKAStoolBar.SetIconPath(Index: Integer; const AValue: String);
var
PNG : TPortableNetworkGraphic;
begin
FIconList[Index] := AValue;
if FileExists(AValue) then
TSpeedButton(FButtonsList.Items[Index]).Glyph := LoadBtnIcon(AValue)
else
ShowMessage('File "' + AValue + '" not found!' );
end;
procedure TKAStoolBar.ToolButtonClick(Sender: TObject);
begin
inherited Click;
if Assigned(FOnToolButtonClick) then
FOnToolButtonClick((Sender as TSpeedButton).Tag);
end;
procedure TKAStoolBar.UpdateButtonsTag;
var
I :Integer;
begin
for I := 0 to FButtonsList.Count - 1 do
TSpeedButton(FButtonsList.Items[I]).Tag := I;
end;
procedure TKAStoolBar.DeleteAllToolButtons;
var
BtnCount,
I: Integer;
begin
BtnCount := FButtonsList.Count - 1;
for I := 0 to BtnCount do
begin
TSpeedButton(FButtonsList.Items[0]).Free;
FButtonsList.Delete(0);
FCmdList.Delete(0);
FIconList.Delete(0);
end;
// Assign to BtnCount new toolbar height
BtnCount := FButtonSize + FTotalBevelWidth * 2;
if Assigned(FChangeLineCount) then
FChangeLineCount(BtnCount - Height);
Height := BtnCount;
FNeedMore := False;
InitBounds;
end;
function TKAStoolBar.GetButtonCount: Integer;
begin
Result := FButtonsList.Count;
end;
function TKAStoolBar.GetCommand(Index: Integer): String;
begin
Result := FCmdList[Index];
end;
function TKAStoolBar.GetIconPath(Index: Integer): String;
begin
Result := FIconList[Index];
end;
constructor TKAStoolBar.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FButtonsList := TList.Create;
FCmdList := TStringList.Create;
FIconList := TStringList.Create;
FNeedMore := False;
FOldWidth := Width;
FMustResize := False;
end;
destructor TKAStoolBar.Destroy;
var
I: Integer;
begin
for I := 0 to FButtonsList.Count - 1 do
if TControl(FButtonsList[I]) is TSpeedButton then
TSpeedButton(FButtonsList.Items[I]).Free;
FreeAndNil(FButtonsList);
FreeAndNil(FCmdList);
FreeAndNil(FIconList);
inherited Destroy;
end;
procedure TKAStoolBar.CreateWnd;
begin
inherited CreateWnd;
InitBounds;
end;
procedure TKAStoolBar.LoadFromFile(FileName: String);
var
IniFile : Tinifile;
BtnCount, I : Integer;
begin
DeleteAllToolButtons;
FPositionX := FTotalBevelWidth;
FPositionY := FTotalBevelWidth;
FMaxBtnCount := Width div FButtonSize;
IniFile := Tinifile.Create(FileName);
BtnCount := IniFile.ReadInteger('Buttonbar', 'Buttoncount', 0);
for I := 1 to BtnCount do
AddButton('', GetCmdDirFromEnvVar(IniFile.ReadString('Buttonbar', 'cmd' + IntToStr(I), '')),
IniFile.ReadString('Buttonbar', 'menu' + IntToStr(I), ''),
GetCmdDirFromEnvVar(IniFile.ReadString('Buttonbar', 'button' + IntToStr(I), '')));
IniFile.Free;
end;
procedure TKAStoolBar.SaveToFile(FileName: String);
var
IniFile : Tinifile;
I : Integer;
begin
IniFile := Tinifile.Create(FileName);
IniFile.WriteInteger('Buttonbar', 'Buttoncount', FButtonsList.Count);
for I := 0 to FButtonsList.Count - 1 do
begin
IniFile.WriteString('Buttonbar', 'button' + IntToStr(I + 1), SetCmdDirAsEnvVar(FIconList[I]));
IniFile.WriteString('Buttonbar', 'cmd' + IntToStr(I + 1), SetCmdDirAsEnvVar(FCmdList[I]));
IniFile.WriteString('Buttonbar', 'menu' + IntToStr(I + 1), TSpeedButton(FButtonsList.Items[I]).Hint);
end;
IniFile.Free;
end;
function TKAStoolBar.AddButton(sCaption, Cmd, BtnHint, IconPath : String) : Integer;
var
ToolButton: TSpeedButton;
begin
ToolButton:= TSpeedButton.Create(Self);
//Include(ToolButton.ComponentStyle, csSubComponent);
ToolButton.Parent:=Self;
ToolButton.Visible := True;
ToolButton.Height := FButtonSize;
ToolButton.ParentShowHint := False;
ToolButton.Caption := sCaption;
ToolButton.ShowHint := True;
ToolButton.Hint := BtnHint;
if FDiskPanel then
begin
ToolButton.Width := Self.Canvas.TextWidth(sCaption) + ToolButton.Glyph.Width + 32;
end
else
ToolButton.Width := FButtonSize;
if ((FPositionX + ToolButton.Width) > Width) then
begin
FPositionY:= FPositionY + ToolButton.Height;
FPositionX := FTotalBevelWidth;
if Assigned(FChangeLineCount) then
FChangeLineCount(FButtonSize);
Height := Height + FButtonSize;
end;
ToolButton.Left:= FPositionX;
ToolButton.Top := FPositionY;
if Assigned(OnMouseDown) then
ToolButton.OnMouseDown := OnMouseDown;
if FCheckToolButton then
ToolButton.GroupIndex := 1;
ToolButton.Flat := FFlatButtons;
if FileExists(IconPath) then
ToolButton.Glyph := LoadBtnIcon(IconPath);
ToolButton.OnClick:=TNotifyEvent(@ToolButtonClick);
FPositionX:= FPositionX + ToolButton.Width;
ToolButton.Tag := FButtonsList.Add(ToolButton);
FCmdList.Add(Cmd);
FIconList.Add(IconPath);
Result := ToolButton.Tag;
end;
procedure TKAStoolBar.RemoveButton(Index: Integer);
var
I, OldLeft, PrevLeft,
OldTop, PrevTop : integer;
begin
try
TSpeedButton(FButtonsList.Items[Index]).Visible := False;
TSpeedButton(FButtonsList.Items[Index]).Free;
FButtonsList.Delete(Index);
UpdateButtonsTag;
FCmdList.Delete(Index);
FIconList.Delete(Index);
FMustResize := True;
Resize;
finally
Repaint;
end;
end;
end.
{
Double Commander components
-------------------------------------------------------------------------
Toolbar panel class
Copyright (C) 2006-2007 Koblov Alexander (Alexx2000@mail.ru)
contributors:
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
in a file called COPYING along with this program; if not, write to
the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
02139, USA.
}
unit KAStoolBar;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls,
Graphics, Dialogs, ExtCtrls, Buttons, IniFiles, FileUtil;
type
TOnToolButtonClick = procedure (NumberOfButton : Integer) of object;
TChangeLineCount = procedure (AddSize : Integer) of object;
{ TKAStoolBar }
TKAStoolBar = class(TPanel)
private
FButtonsList: TList;
FCmdList,
FIconList : TStringList;
FPositionX : Integer;
FPositionY : Integer;
FButtonSize : Integer;
FNeedMore : Boolean;
FOnToolButtonClick : TOnToolButtonClick;
FChangeLineCount : TChangeLineCount;
FTotalBevelWidth : Integer;
FCheckToolButton : Boolean;
FFlatButtons: Boolean;
FDiskPanel: Boolean;
FChangePath : String;
FEnvVar : String;
FOldWidth : Integer;
FMustResize : Boolean;
function LoadBtnIcon(IconPath : String) : TBitMap;
function GetButton(Index: Integer): TSpeedButton;
function GetButtonCount: Integer;
function GetCommand(Index: Integer): String;
function GetIconPath(Index: Integer): String;
procedure SetButton(Index : Integer; Value : TSpeedButton);
procedure SetCommand(Index: Integer; const AValue: String);
procedure SetIconPath(Index: Integer; const AValue: String);
procedure ToolButtonClick(Sender: TObject);
procedure UpdateButtonsTag;
protected
{ Protected declarations }
procedure CreateWnd; override;
procedure Resize; override;
function GetCmdDirFromEnvVar(sPath: String): String;
function SetCmdDirAsEnvVar(sPath: String): String;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure InitBounds;
procedure LoadFromFile(FileName : String);
procedure SaveToFile(FileName : String);
function AddButton(sCaption, Cmd, BtnHint, IconPath : String) : Integer;
procedure RemoveButton(Index: Integer);
procedure DeleteAllToolButtons;
property ButtonCount: Integer read GetButtonCount;
property Buttons[Index: Integer]: TSpeedButton read GetButton write SetButton;
property Commands[Index: Integer]: String read GetCommand write SetCommand;
property Icons[Index: Integer]: String read GetIconPath write SetIconPath;
property ButtonList: TList read FButtonsList;
published
{ Published declarations }
property OnToolButtonClick: TOnToolButtonClick read FOnToolButtonClick write FOnToolButtonClick;
property OnChangeLineCount : TChangeLineCount read FChangeLineCount write FChangeLineCount;
property CheckToolButton : Boolean read FCheckToolButton write FCheckToolButton default False;
property FlatButtons : Boolean read FFlatButtons write FFlatButtons default False;
property IsDiskPanel : Boolean read FDiskPanel write FDiskPanel default False;
property ChangePath : String read FChangePath write FChangePath;
property EnvVar : String read FEnvVar write FEnvVar;
end;
procedure Register;
implementation
uses GraphType;
function TKAStoolBar.GetCmdDirFromEnvVar(sPath: String): String;
begin
DoDirSeparators(sPath);
if Pos(FEnvVar, sPath) <> 0 then
Result := StringReplace(sPath, FEnvVar, ExcludeTrailingPathDelimiter(FChangePath), [rfIgnoreCase])
else
Result := sPath;
end;
function TKAStoolBar.SetCmdDirAsEnvVar(sPath: String): String;
begin
DoDirSeparators(sPath);
if Pos(FChangePath, sPath) <> 0 then
Result := StringReplace(sPath, ExcludeTrailingPathDelimiter(FChangePath), FEnvVar, [rfIgnoreCase])
else
Result := sPath;
end;
procedure Register;
begin
RegisterComponents('KASComponents',[TKAStoolBar]);
end;
procedure TKAStoolBar.InitBounds;
begin
Caption := '';
if (BevelInner <> bvNone) and (BevelOuter <> bvNone) then
FTotalBevelWidth := BevelWidth * 2
else
FTotalBevelWidth := BevelWidth;
FButtonSize := Height - FTotalBevelWidth * 2;
//writeln('FButtonSize = ' + IntToStr(FButtonSize));
if Width < Height then
Width := Height;
FPositionX := FTotalBevelWidth;
FPositionY := FTotalBevelWidth;
end;
procedure TKAStoolBar.Resize;
var
I, Count, NewHeight : Integer;
ToolButton : TSpeedButton;
begin
inherited Resize;
if FOldWidth = 0 then
FOldWidth := Width;
if ((FOldWidth <> Width) or FMustResize) and (FButtonsList.Count > 0) then
begin
NewHeight := FButtonSize + FTotalBevelWidth * 2;
if (BevelInner <> bvNone) and (BevelOuter <> bvNone) then
FTotalBevelWidth := BevelWidth * 2
else
FTotalBevelWidth := BevelWidth;
FButtonSize := NewHeight - FTotalBevelWidth * 2;
if Width < NewHeight then
Self.SetBounds(Left, Top, NewHeight, NewHeight);
FPositionX := FTotalBevelWidth;
FPositionY := FTotalBevelWidth;
//*****************
FNeedMore := False;
Count := FButtonsList.Count - 1;
for I := 0 to Count do
begin
ToolButton := TSpeedButton(FButtonsList.Items[I]);
ToolButton.SetBounds(FPositionX, FPositionY, ToolButton.Width, ToolButton.Height );
//ToolButton.Left:=FPositionX;
//ToolButton.Top := FPositionY;
ToolButton.Height := FButtonSize;
FPositionX:= FPositionX + ToolButton.Width;
if FNeedMore then
begin
NewHeight := NewHeight + FButtonSize;
FNeedMore := False;
end;
if (I <> Count) and ((FPositionX + TSpeedButton(FButtonsList.Items[I + 1]).Width) > Width) then
begin
FPositionY:= FPositionY + ToolButton.Height;
FPositionX := FTotalBevelWidth;
FNeedMore := True;
end;
end;
FOldWidth := Width;
FMustResize := False;
if Assigned(FChangeLineCount) then
FChangeLineCount(NewHeight - Height);
Self.SetBounds(Left, Top, Width, NewHeight);
end;
end;
function TKAStoolBar.LoadBtnIcon(IconPath: String): TBitMap;
var
PNG : TPortableNetworkGraphic;
begin
if IconPath <> '' then
if FileExists(IconPath) then
begin
if CompareFileExt(IconPath, 'png', false) = 0 then
begin
PNG := TPortableNetworkGraphic.Create;
PNG.LoadFromFile(IconPath);
Result := TBitMap(PNG);
end
else
begin
Result := TBitMap.Create;
Result.LoadFromFile(IconPath);
end;
end;
end;
function TKAStoolBar.GetButton(Index: Integer): TSpeedButton;
begin
Result := TSpeedButton(FButtonsList.Items[Index]);
end;
procedure TKAStoolBar.SetButton(Index : Integer; Value : TSpeedButton);
begin
TSpeedButton(FButtonsList.Items[Index]) := Value;
end;
procedure TKAStoolBar.SetCommand(Index: Integer; const AValue: String);
begin
FCmdList[Index] := AValue;
end;
procedure TKAStoolBar.SetIconPath(Index: Integer; const AValue: String);
var
PNG : TPortableNetworkGraphic;
begin
FIconList[Index] := AValue;
if FileExists(AValue) then
TSpeedButton(FButtonsList.Items[Index]).Glyph := LoadBtnIcon(AValue)
else
ShowMessage('File "' + AValue + '" not found!' );
end;
procedure TKAStoolBar.ToolButtonClick(Sender: TObject);
begin
inherited Click;
if Assigned(FOnToolButtonClick) then
FOnToolButtonClick((Sender as TSpeedButton).Tag);
end;
procedure TKAStoolBar.UpdateButtonsTag;
var
I :Integer;
begin
for I := 0 to FButtonsList.Count - 1 do
TSpeedButton(FButtonsList.Items[I]).Tag := I;
end;
procedure TKAStoolBar.DeleteAllToolButtons;
var
BtnCount,
I: Integer;
begin
BtnCount := FButtonsList.Count - 1;
for I := 0 to BtnCount do
begin
TSpeedButton(FButtonsList.Items[0]).Free;
FButtonsList.Delete(0);
FCmdList.Delete(0);
FIconList.Delete(0);
end;
// Assign to BtnCount new toolbar height
BtnCount := FButtonSize + FTotalBevelWidth * 2;
if Assigned(FChangeLineCount) then
FChangeLineCount(BtnCount - Height);
Height := BtnCount;
FNeedMore := False;
InitBounds;
end;
function TKAStoolBar.GetButtonCount: Integer;
begin
Result := FButtonsList.Count;
end;
function TKAStoolBar.GetCommand(Index: Integer): String;
begin
Result := FCmdList[Index];
end;
function TKAStoolBar.GetIconPath(Index: Integer): String;
begin
Result := FIconList[Index];
end;
constructor TKAStoolBar.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FButtonsList := TList.Create;
FCmdList := TStringList.Create;
FIconList := TStringList.Create;
FNeedMore := False;
FOldWidth := Width;
FMustResize := False;
end;
destructor TKAStoolBar.Destroy;
var
I: Integer;
begin
for I := 0 to FButtonsList.Count - 1 do
if TControl(FButtonsList[I]) is TSpeedButton then
TSpeedButton(FButtonsList.Items[I]).Free;
FreeAndNil(FButtonsList);
FreeAndNil(FCmdList);
FreeAndNil(FIconList);
inherited Destroy;
end;
procedure TKAStoolBar.CreateWnd;
begin
inherited CreateWnd;
InitBounds;
end;
procedure TKAStoolBar.LoadFromFile(FileName: String);
var
IniFile : Tinifile;
BtnCount, I : Integer;
begin
DeleteAllToolButtons;
FPositionX := FTotalBevelWidth;
FPositionY := FTotalBevelWidth;
IniFile := Tinifile.Create(FileName);
BtnCount := IniFile.ReadInteger('Buttonbar', 'Buttoncount', 0);
for I := 1 to BtnCount do
AddButton('', GetCmdDirFromEnvVar(IniFile.ReadString('Buttonbar', 'cmd' + IntToStr(I), '')),
IniFile.ReadString('Buttonbar', 'menu' + IntToStr(I), ''),
GetCmdDirFromEnvVar(IniFile.ReadString('Buttonbar', 'button' + IntToStr(I), '')));
IniFile.Free;
end;
procedure TKAStoolBar.SaveToFile(FileName: String);
var
IniFile : Tinifile;
I : Integer;
begin
IniFile := Tinifile.Create(FileName);
IniFile.WriteInteger('Buttonbar', 'Buttoncount', FButtonsList.Count);
for I := 0 to FButtonsList.Count - 1 do
begin
IniFile.WriteString('Buttonbar', 'button' + IntToStr(I + 1), SetCmdDirAsEnvVar(FIconList[I]));
IniFile.WriteString('Buttonbar', 'cmd' + IntToStr(I + 1), SetCmdDirAsEnvVar(FCmdList[I]));
IniFile.WriteString('Buttonbar', 'menu' + IntToStr(I + 1), TSpeedButton(FButtonsList.Items[I]).Hint);
end;
IniFile.Free;
end;
function TKAStoolBar.AddButton(sCaption, Cmd, BtnHint, IconPath : String) : Integer;
var
ToolButton: TSpeedButton;
begin
ToolButton:= TSpeedButton.Create(Self);
//Include(ToolButton.ComponentStyle, csSubComponent);
ToolButton.Parent:=Self;
ToolButton.Visible := True;
ToolButton.Height := FButtonSize;
ToolButton.ParentShowHint := False;
ToolButton.Caption := sCaption;
ToolButton.ShowHint := True;
ToolButton.Hint := BtnHint;
if FDiskPanel then
begin
ToolButton.Width := ToolButton.Canvas.TextWidth(sCaption) + ToolButton.Glyph.Width + 32;
end
else
ToolButton.Width := FButtonSize;
if ((FPositionX + ToolButton.Width) > Width) then
begin
FPositionY:= FPositionY + ToolButton.Height;
FPositionX := FTotalBevelWidth;
if Assigned(FChangeLineCount) then
FChangeLineCount(FButtonSize);
Height := Height + FButtonSize;
end;
ToolButton.Left:= FPositionX;
ToolButton.Top := FPositionY;
if Assigned(OnMouseDown) then
ToolButton.OnMouseDown := OnMouseDown;
if FCheckToolButton then
ToolButton.GroupIndex := 1;
ToolButton.Flat := FFlatButtons;
if FileExists(IconPath) then
ToolButton.Glyph := LoadBtnIcon(IconPath);
ToolButton.OnClick:=TNotifyEvent(@ToolButtonClick);
FPositionX:= FPositionX + ToolButton.Width;
ToolButton.Tag := FButtonsList.Add(ToolButton);
FCmdList.Add(Cmd);
FIconList.Add(IconPath);
Result := ToolButton.Tag;
end;
procedure TKAStoolBar.RemoveButton(Index: Integer);
var
I, OldLeft, PrevLeft,
OldTop, PrevTop : integer;
begin
try
TSpeedButton(FButtonsList.Items[Index]).Visible := False;
TSpeedButton(FButtonsList.Items[Index]).Free;
FButtonsList.Delete(Index);
UpdateButtonsTag;
FCmdList.Delete(Index);
FIconList.Delete(Index);
FMustResize := True;
Resize;
finally
Repaint;
end;
end;
end.

1
doc/fmain.txt
View file

@ -4,3 +4,4 @@
где показывается размер диска и средней кнопкой мыши по панельке где
указана текущая директория
17.07.2007 ADD: Добавил просмотр файлов в VFS, для внутреннего листера
13.08.2007 ADD: Сохранение и загрузку табов

6
fmain.lfm
View file

@ -1,7 +1,7 @@
inherited frmMain: TfrmMain
Left = 263
Left = 273
Height = 336
Top = 144
Top = 148
Width = 525
HorzScrollBar.Page = 524
VertScrollBar.Page = 316
@ -227,7 +227,7 @@ inherited frmMain: TfrmMain
Options = [nboShowCloseButtons]
TabOrder = 0
end
object Splitter1: TSplitter
object MainSplitter: TSplitter
Left = 392
Height = 184
Top = 1

204
fmain.pas
View file

@ -174,11 +174,9 @@ type
actFileLinker: TAction;
actFileSpliter: TAction;
pmToolBar: TPopupMenu;
Splitter1: TSplitter;
MainSplitter: TSplitter;
procedure actExtractFilesExecute(Sender: TObject);
procedure actPackFilesExecute(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure DeleteClick(Sender: TObject);
procedure dskRightChangeLineCount(AddSize: Integer);
procedure dskLeftToolButtonClick(NumberOfButton: Integer);
@ -252,6 +250,7 @@ type
procedure FrameHeaderDblClick(Sender: TObject);
procedure FramelblLPathMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FramepnlFileChangeDirectory(Sender: TObject; const NewDir : String);
procedure edtCommandKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure actFileLinkerExecute(Sender: TObject);
@ -292,9 +291,11 @@ type
procedure SetNotActFrmByActFrm;
procedure SetActiveFrame(panel: TFilePanelSelect);
procedure CreateDiskPanel(dskPanel : TKASToolBar);
procedure CreatePanel(AOwner:TWinControl; APanel:TFilePanelSelect);
procedure CreatePanel(AOwner:TWinControl; APanel:TFilePanelSelect; sPath : String);
function AddPage(ANoteBook:TNoteBook):TPage;
procedure RemovePage(ANoteBook:TNoteBook; iPageIndex:Integer);
procedure LoadTabs(ANoteBook:TNoteBook);
procedure SaveTabs(ANoteBook:TNoteBook);
function ExecCmd(Cmd : String) : Boolean;
procedure SaveShortCuts;
procedure LoadShortCuts;
@ -327,11 +328,6 @@ begin
IsPanelsCreated := False;
end;
procedure TfrmMain.Button1Click(Sender: TObject);
begin
CreatePanel(AddPage(nbLeft), fpLeft);
end;
(* Pack files in archive *)
procedure TfrmMain.actPackFilesExecute(Sender: TObject);
@ -376,11 +372,6 @@ begin
end;
procedure TfrmMain.Button2Click(Sender: TObject);
begin
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
DebugLn('frmMain.Destroy');
@ -513,9 +504,9 @@ procedure TfrmMain.actNewTabExecute(Sender: TObject);
begin
case PanelSelected of
fpLeft:
CreatePanel(AddPage(nbLeft), fpLeft);
CreatePanel(AddPage(nbLeft), fpLeft, ActiveFrame.ActiveDir);
fpRight:
CreatePanel(AddPage(nbRight), fpRight);
CreatePanel(AddPage(nbRight), fpRight, ActiveFrame.ActiveDir);
end;
end;
@ -535,10 +526,10 @@ var
begin
for x:=0 to 4 do
gColumnSize[x]:=FrameLeft.dgPanel.ColWidths[x];
(* Save Paths *)
gIni.WriteString('left', 'path', FrameLeft.pnlFile.ActiveDir);
gIni.WriteString('right', 'path', FrameRight.pnlFile.ActiveDir);
(* /Save Paths *)
(* Save all tabs *)
SaveTabs(nbLeft);
SaveTabs(nbRight);
gIni.WriteInteger('Configuration', 'Main.Left', Left);
gIni.WriteInteger('Configuration', 'Main.Top', Top);
@ -571,37 +562,25 @@ begin
Width := gIni.ReadInteger('Configuration', 'Main.Width', Width);
Height := gIni.ReadInteger('Configuration', 'Main.Height', Height);
CreatePanel(AddPage(nbLeft), fpLeft );
CreatePanel(AddPage(nbRight), fpRight);
{LastDir := gIni.ReadString('left', 'path', '');
CreatePanel(AddPage(nbLeft), fpLeft, LastDir);
LastDir := gIni.ReadString('right', 'path', '');
CreatePanel(AddPage(nbRight), fpRight, LastDir); }
LoadTabs(nbLeft);
LoadTabs(nbRight);
nbLeft.Options:=[nboShowCloseButtons];
nbRight.Options:=[nboShowCloseButtons];
actShowSysFiles.Checked:=uGlobs.gShowSystemFiles;
(* Restore Paths *)
{Left panel}
LastDir := gIni.ReadString('left', 'path', '');
if (LastDir <> '') and (DirectoryExists(LastDir)) then
begin
FrameLeft.pnlFile.ActiveDir := LastDir;
FrameLeft.pnlFile.LoadPanel;
end;
{Right panel}
LastDir := gIni.ReadString('right', 'path', '');
if (LastDir <> '') and (DirectoryExists(LastDir)) then
begin
FrameRight.pnlFile.ActiveDir := LastDir;
FrameRight.pnlFile.LoadPanel;
end;
(* /Restore Paths *)
PanelSelected:=fpLeft;
SetActiveFrame(fpLeft);
pnlNotebooks.Width:=Width div 2;
// dskLeft.Width := Width div 2;
(*Create Disk Panels*)
@ -860,9 +839,9 @@ end;
procedure TfrmMain.FormResize(Sender: TObject);
begin
nbLeft.Width:=frmMain.Width div 2;
nbLeft.Width:= (frmMain.Width div 2) - (MainSplitter.Width div 2);
dskLeft.Width := pnlDisk.Width div 2;
// pnlLeftdskRes.Width := nbLeft.Width + 2;
dskLeft.Repaint;
dskRight.Repaint;
End;
@ -2163,6 +2142,17 @@ begin
end;
end;
procedure TfrmMain.FramepnlFileChangeDirectory(Sender: TObject; const NewDir: String);
var
ANoteBook : TNoteBook;
begin
if Sender is TPage then
begin
ANoteBook := (Sender as TPage).Parent as TNoteBook;
ANoteBook.Page[ANoteBook.PageIndex].Caption := NewDir;
end;
end;
procedure TfrmMain.SetActiveFrame(panel: TFilePanelSelect);
begin
PanelSelected:=panel;
@ -2244,7 +2234,7 @@ begin
end;
procedure TfrmMain.CreatePanel(AOwner: TWinControl; APanel:TFilePanelSelect);
procedure TfrmMain.CreatePanel(AOwner: TWinControl; APanel:TFilePanelSelect; sPath : String);
begin
with TFrameFilePanel.Create(AOwner, lblCommandPath, edtCommand) do
begin
@ -2252,6 +2242,8 @@ begin
PanelSelect:=APanel;
Init;
ReAlign;
pnlFile.OnChangeDirectory := @FramepnlFileChangeDirectory;
pnlFile.ActiveDir := sPath;
pnlFile.LoadPanel;
UpDatelblInfo;
dgPanel.Color := gBackColor;
@ -2272,26 +2264,16 @@ end;
function TfrmMain.AddPage(ANoteBook: TNoteBook):TPage;
var
x:Integer;
PageName : String;
begin
x:=ANotebook.PageCount;
if x = 0 then // First page
begin
if ANoteBook.Align = alLeft then
PageName := GetLastDir(gIni.ReadString('left', 'path', ''))
else
PageName := GetLastDir(gIni.ReadString('right', 'path', ''));
if PageName = '' then
PageName := ExtractFileDrive(gpExePath);
end
else
PageName := GetLastDir(ActiveFrame.ActiveDir);
ANoteBook.Pages.Add(PageName);
ANoteBook.ActivePage:= PageName;
ANoteBook.Pages.Add(IntToStr(x));
ANoteBook.ActivePage:= IntToStr(x);
Result:=ANoteBook.Page[x];
{ DebugLn(Result.ClassName);
DebugLn(Result.Name);}
ANoteBook.ShowTabs:= (ANoteBook.PageCount > 1);
ANoteBook.ShowTabs:= (ANoteBook.PageCount > 1) or Boolean(gDirTabOptions and tb_always_visible);
if Boolean(gDirTabOptions and tb_multiple_lines) then
ANoteBook.Options := ANoteBook.Options + [nboMultiLine];
end;
procedure TfrmMain.RemovePage(ANoteBook: TNoteBook; iPageIndex:Integer);
@ -2306,7 +2288,105 @@ begin
end;}
ANoteBook.Pages.Delete(iPageIndex);
end;
ANoteBook.ShowTabs:= (ANoteBook.PageCount > 1);
ANoteBook.ShowTabs:= (ANoteBook.PageCount > 1) or Boolean(gDirTabOptions and tb_always_visible);
end;
procedure TfrmMain.LoadTabs(ANoteBook: TNoteBook);
var
I : Integer;
sIndex,
TabsSection, Section: String;
fpsPanel : TFilePanelSelect;
sPath,
sCaption, sActiveCaption : String;
iActiveTab : Integer;
begin
if ANoteBook.Align = alLeft then
begin
TabsSection := 'lefttabs';
Section := 'left';
fpsPanel := fpLeft;
end
else
begin
TabsSection := 'righttabs';
Section := 'right';
fpsPanel := fpRight;
end;
I := 0;
sIndex := '0';
{ Read active tab index and caption }
iActiveTab := gIni.ReadInteger(TabsSection, 'activetab', 0);
sActiveCaption := gIni.ReadString(Section, 'activecaption', '');
while True do
begin
if I = iActiveTab then
begin
sPath := gIni.ReadString(Section, 'path', '');
CreatePanel(AddPage(ANoteBook), fpsPanel, sPath);
if sActiveCaption <> '' then
ANoteBook.Page[ANoteBook.PageCount - 1].Caption := sActiveCaption;
end;
sPath := gIni.ReadString(TabsSection, sIndex + '_path', '');
if sPath = '' then Break;
sCaption := gIni.ReadString(TabsSection, sIndex + '_caption', '');
CreatePanel(AddPage(ANoteBook), fpsPanel, sPath);
if sCaption <> '' then
ANoteBook.Page[ANoteBook.PageCount - 1].Caption := sCaption;
inc(I);
sIndex := IntToStr(I);
end;
// set active tab
ANoteBook.PageIndex := iActiveTab;
end;
procedure TfrmMain.SaveTabs(ANoteBook: TNoteBook);
var
I, Count, J : Integer;
sIndex,
TabsSection, Section : String;
sPath : String;
begin
if ANoteBook.Align = alLeft then
begin
TabsSection := 'lefttabs';
Section := 'left';
end
else
begin
TabsSection := 'righttabs';
Section := 'right';
end;
gIni.EraseSection(TabsSection);
I := 0;
J := 0;
Count := ANoteBook.PageCount - 1;
repeat
sIndex := IntToStr(I - J);
if I = ANoteBook.PageIndex then
begin
gIni.WriteInteger(TabsSection, 'activetab', I);
gIni.WriteString(TabsSection, 'activecaption', ANoteBook.ActivePage);
if I < Count then
begin
inc(I);
J := 1;
end
else
Break;
end;
sPath := TFrameFilePanel(ANoteBook.Page[I].Components[0]).ActiveDir;
gIni.WriteString(TabsSection, sIndex + '_path', sPath);
gIni.WriteString(TabsSection, sIndex + '_caption', ANoteBook.Page[I].Caption);
inc(I);
until (I > Count);
sPath := TFrameFilePanel(ANoteBook.ActivePageComponent.Components[0]).ActiveDir;
gIni.WriteString(Section, 'path', sPath);
end;
(* Execute internal or external command *)

2
framepanel.lfm
View file

@ -22,7 +22,6 @@ inherited FrameFilePanel: TFrameFilePanel
Height = 14
Width = 36
Caption = 'lblLInfo'
Color = clNone
ParentColor = False
end
object pnlHeader: TPanel
@ -84,7 +83,6 @@ inherited FrameFilePanel: TFrameFilePanel
Width = 33
Align = alLeft
Caption = 'lblFree'
Color = clNone
ParentColor = False
end
end

2
framepanel.pas
View file

@ -773,7 +773,7 @@ begin
lblLPath.OnMouseLeave:=@lblLPathMouseLeave;
pnlFile:=TFilePanel.Create(dgPanel,lblLPath,lblCommandPath, lblFree, cmbCommand);
pnlFile:=TFilePanel.Create(AOwner, dgPanel,lblLPath,lblCommandPath, lblFree, cmbCommand);
// setup column widths
for x:=0 to 4 do

14
ufilepanel.pas
View file

@ -21,8 +21,11 @@ uses
StdCtrls, Grids, uFileList, uTypes, uPathHistory, Classes, uVFS;
type
TOnChangeDirectory = procedure (Sender: TObject; const NewDir : String) of object;
TFilePanel=Class
private
fOwner : TObject;
fFileList:TFileList;
fVFS : TVFS;
flblPath:TLabel;
@ -43,10 +46,11 @@ type
flblCurPath:TLabel; // label before Command line
flblFree:TLabel;
fedtCommand:TComboBox; // only for place correction after Chdir
FOnChangeDirectory : TOnChangeDirectory;
public
// iLastDrawnIndex :Integer; // fucking dirty hack (OnDrawItem
constructor Create(APanel:TDrawGrid; AlblPath: TLabel; AlblCurPath, AlblFree:TLabel; AedtCommand:TComboBox);
constructor Create(AOwner : TObject; APanel:TDrawGrid; AlblPath: TLabel; AlblCurPath, AlblFree:TLabel; AedtCommand:TComboBox);
Destructor Destroy; override;
procedure LoadPanel;
procedure LoadPanelVFS(frp:PFileRecItem);
@ -74,6 +78,7 @@ type
procedure ReplaceExtCommand(var sCmd:String; pfr:PFileRecItem);
procedure SetActiveDir(const AValue:String);
function GetActiveDir:String;
property OnChangeDirectory : TOnChangeDirectory read FOnChangeDirectory write FOnChangeDirectory;
published
property SortDirection:Boolean read fSortDirect write fSortDirect; // maybe write method
@ -96,8 +101,9 @@ uses
uShowMsg, Controls, uLng, uShowForm, uDCUtils,
uOSUtils;
constructor TFilePanel.Create(APanel:TDrawGrid; AlblPath: TLabel; AlblCurPath, AlblFree:TLabel; AedtCommand:TComboBox);
constructor TFilePanel.Create(AOwner : TObject; APanel:TDrawGrid; AlblPath: TLabel; AlblCurPath, AlblFree:TLabel; AedtCommand:TComboBox);
begin
fOwner := AOwner;
fPanel:=APanel;
fRefList:=TList.Create;
fVFS := TVFS.Create;
@ -204,6 +210,8 @@ begin
fPanelMode := pmDirectory;
fActiveDir := ExtractFilePath(fVFS.ArcFullName);
ChDir(fActiveDir);
if Assigned(FOnChangeDirectory) then
FOnChangeDirectory(fOwner, fActiveDir);
LoadFilesbyDir(fActiveDir, fFileList);
end;
end
@ -250,6 +258,8 @@ begin
fActiveDir:=fActiveDir+DirectorySeparator;
Exit; // chdir failed
end;
if Assigned(FOnChangeDirectory) then
FOnChangeDirectory(fOwner, fActiveDir);
LoadFilesbyDir(fActiveDir, fFileList);
end;
end; // case

20
uglobs.pas
View file

@ -78,6 +78,21 @@ var
gCursorText : TColor; //text color under cursor
gIconsSize : Integer;
gDirTabOptions,
gDirTabLimit : Integer;
const
{ Tabs options }
tb_always_visible = 1;
tb_multiple_lines = 2;
tb_same_width = 4;
tb_text_length_limit = 8;
tb_confirm_close_all = 16;
tb_close_on_dbl_click = 32;
tb_open_new_in_foreground = 64;
tb_open_new_near_current = 128;
tb_show_asterisk_for_locked = 256;
tb_activate_panel_on_click = 512;
function LoadGlobs : Boolean;
procedure SaveGlobs;
@ -181,6 +196,9 @@ begin
glsHotDir.CommaText := gIni.ReadString('Configuration', 'HotDir', '');
gShortFileSizeFormat := gIni.ReadBool('Configuration', 'ShortFileSizeFormat', True);
gDirTabOptions := gIni.ReadInteger('Configuration', 'DirTabOptions', 0);
gDirTabLimit := gIni.ReadInteger('Configuration', 'DirTabLimit', 32);
gUseExtEdit := gIni.ReadBool('Configuration', 'UseExtEdit', False);
gUseExtView := gIni.ReadBool('Configuration', 'UseExtView', False);
gUseExtDiff := gIni.ReadBool('Configuration', 'UseExtDiff', False);
@ -278,6 +296,8 @@ begin
gIni.WriteString('Configuration', 'HotDir', glsHotDir.CommaText);
gIni.WriteBool('Configuration', 'ShortFileSizeFormat', gShortFileSizeFormat);
gIni.WriteInteger('Configuration', 'DirTabOptions', gDirTabOptions);
gIni.WriteInteger('Configuration', 'DirTabLimit', gDirTabLimit);
gIni.WriteBool('Configuration', 'UseExtEdit', gUseExtEdit);
gIni.WriteBool('Configuration', 'UseExtView', gUseExtView);