mirror of https://gitlab.com/basile.b/dexed.git
381 lines
9.1 KiB
Plaintext
381 lines
9.1 KiB
Plaintext
unit ce_controls;
|
|
|
|
{$I ce_defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Forms, Controls, ComCtrls, ExtCtrls, buttons;
|
|
|
|
type
|
|
TCEPageControlButton = (pbClose, pbMoveLeft, pbMoveRight, pbAdd);
|
|
TCEPageControlButtons = set of TCEPageControlButton;
|
|
|
|
const
|
|
CEPageControlDefaultButtons = [pbClose, pbMoveLeft, pbMoveRight, pbAdd];
|
|
|
|
type
|
|
|
|
// Used instead of a TTabSheet since only the caption is interesting
|
|
TCEPage = class(TCustomControl)
|
|
private
|
|
function getIndex: integer;
|
|
protected
|
|
procedure realSetText(const Value: TCaption); override;
|
|
public
|
|
property index: integer read getIndex;
|
|
end;
|
|
|
|
(**
|
|
* Minimalist page-control dedicated to Coedit
|
|
*
|
|
* - get rid of the framed aspect of the default LCL one
|
|
* - no published props, since CE has to be compilable w/o extra IDE comps
|
|
* - add/close/move left and right speed buttons
|
|
*)
|
|
TCEPageControl = class(TWinControl)
|
|
private
|
|
fHeader: TWinControl;
|
|
fTabs: TTabControl;
|
|
fCloseBtn: TSpeedButton;
|
|
fMoveLeftBtn: TSpeedButton;
|
|
fMoveRightBtn: TSpeedButton;
|
|
fAddBtn: TSpeedButton;
|
|
fContent: TPanel;
|
|
fPages: TFPList;
|
|
fPageIndex: integer;
|
|
fButtons: TCEPageControlButtons;
|
|
fOnChanged: TNotifyEvent;
|
|
fOnChanging: TTabChangingEvent;
|
|
|
|
procedure btnCloseClick(sender: TObject);
|
|
procedure btnMoveLeftClick(sender: TObject);
|
|
procedure btnMoveRightClick(sender: TObject);
|
|
procedure btnAddClick(sender: TObject);
|
|
|
|
procedure tabsChanging(Sender: TObject; var AllowChange: Boolean);
|
|
procedure tabsChanged(sender: TObject);
|
|
procedure hidePage(index: integer);
|
|
procedure showPage(index: integer);
|
|
procedure setPageIndex(index: integer);
|
|
procedure setButtons(value: TCEPageControlButtons);
|
|
procedure setCurrentPage(value: TCEPage);
|
|
function getCurrentPage: TCEPage;
|
|
function getPageCount: integer;
|
|
function getPage(index: integer): TCEPage;
|
|
|
|
procedure changedNotify;
|
|
procedure updateButtonsState;
|
|
|
|
public
|
|
constructor Create(aowner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
function addPage: TCEPage;
|
|
procedure deletePage(index: integer);
|
|
function getPageIndex(page: TCEPage): integer;
|
|
procedure movePageRight;
|
|
procedure movePageLeft;
|
|
|
|
property currentPage: TCEPage read getCurrentPage write setCurrentPage;
|
|
property pageIndex: integer read fPageIndex write setPageIndex;
|
|
property pageCount: integer read getPageCount;
|
|
property pages[index: integer]: TCEPage read getPage; default;
|
|
|
|
property buttons: TCEPageControlButtons read fButtons write setButtons;
|
|
property closeButton: TSpeedButton read fCloseBtn;
|
|
property moveLeftButton: TSpeedButton read fMoveLeftBtn;
|
|
property moveRightButton: TSpeedButton read fMoveRightBtn;
|
|
property addButton: TSpeedButton read fAddBtn;
|
|
|
|
property onChanged: TNotifyEvent read fOnChanged write fOnChanged;
|
|
property onChanging: TTabChangingEvent read fOnChanging write fOnChanging;
|
|
end;
|
|
|
|
implementation
|
|
|
|
function TCEPage.getIndex: integer;
|
|
var
|
|
ctrl: TCEPageControl;
|
|
i: integer;
|
|
begin
|
|
ctrl := TCEPageControl(owner);
|
|
for i := 0 to ctrl.pageCount-1 do
|
|
if ctrl.pages[i] = self then
|
|
exit(i);
|
|
exit(-1);
|
|
end;
|
|
|
|
procedure TCEPage.RealSetText(const Value: TCaption);
|
|
var
|
|
i: integer;
|
|
ctrl: TCEPageControl;
|
|
begin
|
|
inherited;
|
|
ctrl := TCEPageControl(owner);
|
|
i := ctrl.getPageIndex(self);
|
|
if i <> -1 then ctrl.fTabs.Tabs.Strings[i] := caption;
|
|
end;
|
|
|
|
constructor TCEPageControl.Create(aowner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
fHeader := TWinControl.Create(self);
|
|
fHeader.Parent:= self;
|
|
fHeader.Align := alTop;
|
|
fHeader.Height:= 32;
|
|
|
|
fTabs := TTabControl.Create(self);
|
|
fTabs.Parent:= fHeader;
|
|
fTabs.Align := alClient;
|
|
fTabs.Options:=[];
|
|
fTabs.OnChange:=@tabsChanged;
|
|
fTabs.OnChanging:=@tabsChanging;
|
|
|
|
fMoveLeftBtn:= TSpeedButton.Create(self);
|
|
fMoveLeftBtn.Parent := fHeader;
|
|
fMoveLeftBtn.Align:= alRight;
|
|
fMoveLeftBtn.Width:= 28;
|
|
fMoveLeftBtn.BorderSpacing.Around:= 2;
|
|
fMoveLeftBtn.ShowCaption:=false;
|
|
fMoveLeftBtn.OnClick:=@btnMoveLeftClick;
|
|
fMoveLeftBtn.Hint:='move current page to the left';
|
|
|
|
fMoveRightBtn:= TSpeedButton.Create(self);
|
|
fMoveRightBtn.Parent := fHeader;
|
|
fMoveRightBtn.Align:= alRight;
|
|
fMoveRightBtn.Width:= 28;
|
|
fMoveRightBtn.BorderSpacing.Around:= 2;
|
|
fMoveRightBtn.ShowCaption:=false;
|
|
fMoveRightBtn.OnClick:=@btnMoveRightClick;
|
|
fMoveRightBtn.Hint:='move current page to the right';
|
|
|
|
fAddBtn:= TSpeedButton.Create(self);
|
|
fAddBtn.Parent := fHeader;
|
|
fAddBtn.Align:= alRight;
|
|
fAddBtn.Width:= 28;
|
|
fAddBtn.BorderSpacing.Around:= 2;
|
|
fAddBtn.ShowCaption:=false;
|
|
fAddBtn.OnClick:=@btnAddClick;
|
|
fAddBtn.Hint:='add a new page';
|
|
|
|
fCloseBtn := TSpeedButton.Create(self);
|
|
fCloseBtn.Parent := fHeader;
|
|
fCloseBtn.Align:= alRight;
|
|
fCloseBtn.Width:= 28;
|
|
fCloseBtn.BorderSpacing.Around:= 2;
|
|
fCloseBtn.ShowCaption:=false;
|
|
fCloseBtn.OnClick:=@btnCloseClick;
|
|
fCloseBtn.Hint:='close current page';
|
|
|
|
fContent := TPanel.Create(self);
|
|
fContent.Parent := self;
|
|
fContent.Align := alClient;
|
|
fContent.BevelInner:= bvNone;
|
|
fContent.BevelOuter:= bvNone;
|
|
fContent.BorderStyle:=bsNone;
|
|
fContent.BorderSpacing.Top:=3;
|
|
|
|
fPages := TFPList.Create;
|
|
fPageIndex := -1;
|
|
|
|
fButtons:= CEPageControlDefaultButtons;
|
|
updateButtonsState;
|
|
end;
|
|
|
|
destructor TCEPageControl.Destroy;
|
|
begin
|
|
while fPages.Count > 0 do
|
|
deletePage(fPages.Count-1);
|
|
fPages.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCEPageControl.changedNotify;
|
|
begin
|
|
updateButtonsState;
|
|
if assigned(fOnChanged) then
|
|
fOnChanged(self);
|
|
end;
|
|
|
|
procedure TCEPageControl.tabsChanged(sender: TObject);
|
|
begin
|
|
setPageIndex(fTabs.TabIndex);
|
|
end;
|
|
|
|
procedure TCEPageControl.tabsChanging(Sender: TObject; var AllowChange: Boolean);
|
|
begin
|
|
if assigned(fOnChanging) then fOnChanging(self, AllowChange);
|
|
end;
|
|
|
|
procedure TCEPageControl.hidePage(index: integer);
|
|
var
|
|
pge: TCEPage;
|
|
begin
|
|
if (index < 0) or (index > fPages.Count-1) then
|
|
exit;
|
|
|
|
pge := TCEPage(fPages.Items[index]);
|
|
pge.Visible:=false;
|
|
end;
|
|
|
|
procedure TCEPageControl.showPage(index: integer);
|
|
var
|
|
pge: TCEPage;
|
|
ctl: TControl;
|
|
begin
|
|
if (index < 0) or (index > fPages.Count-1) then
|
|
exit;
|
|
|
|
pge := TCEPage(fPages.Items[index]);
|
|
pge.Visible:=true;
|
|
pge.Repaint;
|
|
for ctl in pge.GetEnumeratorControls do
|
|
ctl.Visible:=true;
|
|
end;
|
|
|
|
procedure TCEPageControl.setPageIndex(index: integer);
|
|
begin
|
|
if (index > fPages.Count-1) then
|
|
index := fPages.Count-1;
|
|
if (index < 0) then
|
|
exit;
|
|
|
|
hidePage(fPageIndex);
|
|
fPageIndex := index;
|
|
showPage(fPageIndex);
|
|
|
|
if fTabs.TabIndex <> fPageIndex then
|
|
fTabs.TabIndex:= fPageIndex;
|
|
|
|
changedNotify;
|
|
end;
|
|
|
|
function TCEPageControl.addPage: TCEPage;
|
|
var
|
|
pge: TCEPage;
|
|
begin
|
|
pge := TCEPage.Create(self);
|
|
pge.Parent := fContent;
|
|
pge.Align:= alClient;
|
|
|
|
fPages.Add(pge);
|
|
fTabs.Tabs.Add(format('', [fPages.Count]));
|
|
setPageIndex(fTabs.Tabs.Count-1);
|
|
|
|
result := pge;
|
|
end;
|
|
|
|
procedure TCEPageControl.deletePage(index: integer);
|
|
begin
|
|
if (index > fPages.Count-1) or (index < 0) then
|
|
exit;
|
|
|
|
TCEPage(fPages.Items[index]).Free;
|
|
fPages.Delete(index);
|
|
fTabs.Tabs.Delete(index);
|
|
|
|
if fPageIndex >= fPages.Count then
|
|
fPageIndex -= 1;
|
|
updateButtonsState;
|
|
if fPages.Count = 0 then
|
|
exit;
|
|
|
|
setPageIndex(fPageIndex);
|
|
end;
|
|
|
|
function TCEPageControl.getPageIndex(page: TCEPage): integer;
|
|
begin
|
|
exit(fPages.IndexOf(page));
|
|
end;
|
|
|
|
function TCEPageControl.getCurrentPage: TCEPage;
|
|
begin
|
|
if (fPageIndex < 0) or (fPageIndex > fPages.Count-1) then
|
|
exit(nil)
|
|
else
|
|
exit(TCEPage(fPages.Items[fPageIndex]));
|
|
end;
|
|
|
|
procedure TCEPageControl.setCurrentPage(value: TCEPage);
|
|
begin
|
|
setPageIndex(getPageIndex(value));
|
|
end;
|
|
|
|
function TCEPageControl.getPageCount: integer;
|
|
begin
|
|
exit(fPages.Count);
|
|
end;
|
|
|
|
function TCEPageControl.getPage(index: integer): TCEPage;
|
|
begin
|
|
exit(TCEPage(fPages.Items[index]));
|
|
end;
|
|
|
|
procedure TCEPageControl.movePageRight;
|
|
begin
|
|
if fPageIndex = fPages.Count-1 then
|
|
exit;
|
|
|
|
fPages.Exchange(fPageIndex, fPageIndex + 1);
|
|
fTabs.Tabs.Exchange(fPageIndex, fPageIndex + 1);
|
|
setPageIndex(fPageIndex+1);
|
|
end;
|
|
|
|
procedure TCEPageControl.movePageLeft;
|
|
begin
|
|
if fPageIndex <= 0 then
|
|
exit;
|
|
|
|
fPages.Exchange(fPageIndex, fPageIndex - 1);
|
|
fTabs.Tabs.Exchange(fPageIndex, fPageIndex - 1);
|
|
setPageIndex(fPageIndex-1);
|
|
end;
|
|
|
|
procedure TCEPageControl.btnCloseClick(sender: TObject);
|
|
begin
|
|
deletePage(fPageIndex);
|
|
end;
|
|
|
|
procedure TCEPageControl.btnMoveLeftClick(sender: TObject);
|
|
begin
|
|
movePageLeft;
|
|
end;
|
|
|
|
procedure TCEPageControl.btnMoveRightClick(sender: TObject);
|
|
begin
|
|
movePageRight;
|
|
end;
|
|
|
|
procedure TCEPageControl.btnAddClick(sender: TObject);
|
|
begin
|
|
addPage;
|
|
end;
|
|
|
|
procedure TCEPageControl.setButtons(value: TCEPageControlButtons);
|
|
begin
|
|
if fButtons = value then
|
|
exit;
|
|
|
|
fButtons := value;
|
|
updateButtonsState;
|
|
fHeader.ReAlign;
|
|
end;
|
|
|
|
procedure TCEPageControl.updateButtonsState;
|
|
begin
|
|
fHeader.DisableAlign;
|
|
fCloseBtn.Visible:= pbClose in fButtons;
|
|
fMoveLeftBtn.Visible:= pbMoveLeft in fButtons;
|
|
fCloseBtn.Visible:= pbMoveRight in fButtons;
|
|
fAddBtn.Visible:= pbAdd in fButtons;
|
|
fHeader.EnableAlign;
|
|
fCloseBtn.Enabled := fPageIndex <> -1;
|
|
fMoveLeftBtn.Enabled := fPageIndex > 0;
|
|
fMoveRightBtn.Enabled := fPageIndex < fPages.Count-1;
|
|
end;
|
|
|
|
end.
|
|
|