summaryrefslogtreecommitdiff
path: root/src/gui/fpg_tab.pas
diff options
context:
space:
mode:
Diffstat (limited to 'src/gui/fpg_tab.pas')
-rw-r--r--src/gui/fpg_tab.pas843
1 files changed, 580 insertions, 263 deletions
diff --git a/src/gui/fpg_tab.pas b/src/gui/fpg_tab.pas
index d656ad3a..9999fa83 100644
--- a/src/gui/fpg_tab.pas
+++ b/src/gui/fpg_tab.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2010 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -22,10 +22,10 @@ unit fpg_tab;
{
TODO:
* Tab Styles (tab, button, flat button, angled)
- * Tab Position (top, bottom, left, right)
* Better keyboard support
* Focus rectangle drawn on tabs itself
* FindNextPage() must be implemented
+ * Popup menu for tab selection. Should occur with RClick on tabs.
}
interface
@@ -36,38 +36,48 @@ uses
fpg_base,
fpg_main,
fpg_widget,
- fpg_button;
+ fpg_button,
+ fpg_menu;
type
// forward declaration
TfpgPageControl = class;
TfpgTabStyle = (tsTabs, tsButtons, tsFlatButtons);
- TfpgTabPosition = (tpTop, tpBottom{, tpLeft, tpRight});
+ TfpgTabPosition = (tpTop, tpBottom, tpLeft, tpRight, tpNone);
+ TfpgTabOption = (to_PMenuClose, to_PMenuShowAvailTabs);
+
+ TfpgTabOptions = set of TfpgTabOption;
TfpgTabSheet = class(TfpgWidget)
private
+ FPageControl: TfpgPageControl;
FText: string;
+ FTabVisible: boolean;
function GetPageControl: TfpgPageControl;
function GetPageIndex: Integer;
function GetText: string;
procedure SetPageIndex(const AValue: Integer);
procedure SetText(const AValue: string);
+ procedure SetPageControl(APageControl: TfpgPageControl);
protected
procedure HandlePaint; override;
+ procedure SetName(const NewName: TComponentName); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
- procedure AfterConstruction; override;
property PageIndex: Integer read GetPageIndex write SetPageIndex;
- property PageControl: TfpgPageControl read GetPageControl;
+ property PageControl: TfpgPageControl read FPageControl write SetPageControl;
+ property TabVisible: boolean read FTabVisible write FTabVisible;
published
property Text: string read GetText write SetText;
+ property OnPaint;
end;
TTabSheetChange = procedure(Sender: TObject; NewActiveSheet: TfpgTabSheet) of object;
+ TTabSheetClosing = procedure(Sender: TObject; ATabSheet: TfpgTabSheet) of object;
TfpgPageControl = class(TfpgWidget)
@@ -76,28 +86,33 @@ type
FActivePage: TfpgTabSheet;
FMargin: integer;
FFixedTabWidth: integer;
+ FFixedTabHeight: Integer;
+ FOnClosingTabSheet: TTabSheetClosing;
FPages: TList;
FActivePageIndex: integer;
FOnChange: TTabSheetChange;
- FRightButton: TfpgButton;
- FLeftButton: TfpgButton;
- FFirstTabButton: TfpgTabSheet;
+ FRightButton: TfpgButton; // bottom/right
+ FLeftButton: TfpgButton; // left/top
+ FFirstTabButton: TfpgTabSheet; // when tabs don't fit in screen this is the first button on screen when tabs are scrolled
FSortPages: boolean;
FStyle: TfpgTabStyle;
FTabPosition: TfpgTabPosition;
+ FPopupMenu: TfpgPopupMenu;
+ FTabOptions: TfpgTabOptions;
function GetActivePageIndex: integer;
function GetPage(AIndex: integer): TfpgTabSheet;
function GetPageCount: Integer;
- procedure InsertPage(const APage: TfpgTabSheet);
+ procedure InsertPage(const APage: TfpgTabSheet; SuppressOnChangeEvent: boolean = False);
procedure RemovePage(const APage: TfpgTabSheet);
procedure SetActivePageIndex(const AValue: integer);
procedure SetActivePage(const AValue: TfpgTabSheet);
function MaxButtonWidthSum: integer;
- function MaxButtonHeight: integer;
+ function MaxButtonHeightSum: integer;
function MaxButtonWidth: integer;
function ButtonHeight: integer;
function ButtonWidth(AText: string): integer;
procedure SetFixedTabWidth(const AValue: integer);
+ procedure SetFixedTabHeight(const AValue: integer);
function GetTabText(AText: string): string;
procedure LeftButtonClick(Sender: TObject);
procedure RightButtonClick(Sender: TObject);
@@ -105,14 +120,17 @@ type
procedure SetSortPages(const AValue: boolean);
procedure SetStyle(const AValue: TfpgTabStyle);
procedure SetTabPosition(const AValue: TfpgTabPosition);
- procedure DoChange(ATabSheet: TfpgTabSheet);
+ procedure DoPageChange(ATabSheet: TfpgTabSheet);
+ procedure DoTabSheetClosing(ATabSheet: TfpgTabSheet);
function DrawTab(const rect: TfpgRect; const Selected: Boolean = False; const Mode: Integer = 1): TfpgRect;
+ procedure pmCloseTab(Sender: TObject);
protected
procedure OrderSheets; // currently using bubblesort
procedure RePaintTitles; virtual;
procedure HandlePaint; override;
procedure HandleShow; override;
procedure HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
+ procedure HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override;
procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
public
constructor Create(AOwner: TComponent); override;
@@ -123,10 +141,14 @@ type
property ActivePage: TfpgTabSheet read FActivePage write SetActivePage;
property Pages[AIndex: integer]: TfpgTabSheet read GetPage;
property OnChange: TTabSheetChange read FOnChange write FOnChange;
+ property OnClosingTabSheet: TTabSheetClosing read FOnClosingTabSheet write FOnClosingTabSheet;
published
property ActivePageIndex: integer read GetActivePageIndex write SetActivePageIndex;
property BackgroundColor;
property FixedTabWidth: integer read FFixedTabWidth write SetFixedTabWidth default 0;
+ property FixedTabHeight: integer read FFixedTabHeight write SetFixedTabHeight default 21;
+ property Hint;
+ property Options: TfpgTabOptions read FTabOptions write FTabOptions;
property ParentShowHint;
property ShowHint;
property SortPages: boolean read FSortPages write SetSortPages default False;
@@ -134,6 +156,7 @@ type
property TabOrder;
property TabPosition: TfpgTabPosition read FTabPosition write SetTabPosition default tpTop;
property TextColor;
+ property OnShowHint;
end;
@@ -197,30 +220,50 @@ begin
Canvas.Clear(FBackgroundColor);
end;
+procedure TfpgTabSheet.SetName(const NewName: TComponentName);
+var
+ old: String;
+begin
+ old := NewName;
+ inherited SetName(NewName);
+ if (csDesigning in ComponentState) then
+ begin
+ if (Text = '') or (Text = old) then
+ Text := NewName;
+ end;
+end;
+
constructor TfpgTabSheet.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FText := '';
+ FTabVisible:= True;
FFocusable := True;
FBackgroundColor := Parent.BackgroundColor;
FTextColor := Parent.TextColor;
FIsContainer := True;
+ if (AOwner <> nil) and (AOwner is TfpgPageControl) then
+ begin
+ FPageControl:=TfpgPageControl(AOwner);
+ FPageControl.InsertPage(self, True);
+ end;
end;
destructor TfpgTabSheet.Destroy;
begin
- if Owner is TfpgPageControl then
- TfpgPageControl(Owner).RemovePage(self);
+ if FPageControl <> nil then
+ FPageControl.RemovePage(self);
inherited Destroy;
end;
-procedure TfpgTabSheet.AfterConstruction;
+procedure TfpgTabSheet.SetPageControl(APageControl: TfpgPageControl);
begin
- inherited AfterConstruction;
- if Owner is TfpgPageControl then
- TfpgPageControl(Owner).InsertPage(self);
+ FPageControl := APageControl;
+ if APageControl <> nil then
+ FPageControl.InsertPage(Self);
end;
+
{ TfpgPageControl }
function TfpgPageControl.GetActivePageIndex: integer;
@@ -240,27 +283,55 @@ begin
Result := FPages.Count;
end;
-procedure TfpgPageControl.InsertPage(const APage: TfpgTabSheet);
+procedure TfpgPageControl.InsertPage(const APage: TfpgTabSheet; SuppressOnChangeEvent: boolean = False);
begin
if FPages.IndexOf(APage) <> -1 then
Exit; //==> The page has already been added.
FPages.Add(APage);
- ActivePage := APage;
+ { TODO: This behaviour could maybe be controlled by a Options property }
+ if FPages.Count=1 then
+ begin
+ if SuppressOnChangeEvent then
+ Loading;
+ ActivePage := APage;
+ if SuppressOnChangeEvent then
+ Loaded;
+ end;
end;
procedure TfpgPageControl.RemovePage(const APage: TfpgTabSheet);
+var
+ i: integer;
begin
if APage = nil then
- Exit;
- FPages.Remove(APage);
- {$Note This still needs to be fixed.}
- if APage = FActivePage then
+ Exit; // ==>
+ if FPages.Count =0 then
+ Exit; // ==>
+
+ if FPages.Count > 1 then
+ begin
+ i:=FPages.IndexOf(APage);
+ FPages.Remove(APage);
+ APage.PageControl:=nil;
+ APage.Visible:=false;
+ if i = ActivePageIndex then
+ begin
+ if i > FPages.Count-1 then
+ ActivePage:=TfpgTabSheet(FPages.Last)
+ else if i = 0 then
+ ActivePage:= TfpgTabSheet(FPages.First)
+ else
+ ActivePage:=TfpgTabSheet(FPages[i]);
+ end
+ else if i < ActivePageIndex then
+ ActivePage:=TfpgTabSheet(Pages[i-1]);
+ end
+ else
begin
-// FActivePage := FindNextPage(APage, True);
-// if FPages.Count > 0 then
- ActivePage := TfpgTabSheet(FPages.First);
-// else
-// ActivePage := nil;
+ FPages.Remove(APage);
+ APage.PageControl := nil;
+ APage.Visible := False;
+ ActivePage := nil;
end;
end;
@@ -278,8 +349,10 @@ begin
Exit; //==>
FActivePage := AValue;
ActiveWidget := AValue;
- FActivePageIndex := FPages.IndexOf(AValue);
+ if AValue <> nil then
+ FActivePageIndex := FPages.IndexOf(AValue);
RePaint;
+ DoPageChange(FActivePage);
end;
function TfpgPageControl.MaxButtonWidthSum: integer;
@@ -297,28 +370,38 @@ begin
end;
end;
-function TfpgPageControl.MaxButtonHeight: integer;
+function TfpgPageControl.MaxButtonHeightSum: integer;
begin
result := PageCount * ButtonHeight;
end;
function TfpgPageControl.MaxButtonWidth: integer;
var
- t: TfpgTabSheet;
- i: integer;
+ t: TfpgTabSheet;
+ i: integer;
begin
Result := 0;
- for i := 0 to FPages.Count-1 do
+ if FixedTabWidth > 0 then
begin
- t := TfpgTabSheet(FPages[i]);
- if ButtonWidth(t.Text) > Result then
- Result := ButtonWidth(t.Text);
+ Result := FixedTabWidth;
+ end
+ else
+ begin
+ for i := 0 to FPages.Count-1 do
+ begin
+ t := TfpgTabSheet(FPages[i]);
+ if ButtonWidth(t.Text) > Result then
+ Result := ButtonWidth(t.Text);
+ end;
end;
end;
function TfpgPageControl.ButtonHeight: integer;
begin
- Result := FRightButton.Height;
+ if FFixedTabHeight > 0 then
+ result := FFixedTabHeight
+ else
+ result := FFont.Height + 10; { TODO: correct this }
end;
function TfpgPageControl.ButtonWidth(AText: string): integer;
@@ -340,6 +423,17 @@ begin
end;
end;
+procedure TfpgPageControl.SetFixedTabHeight(const AValue: integer);
+begin
+ if FFixedTabHeight = AValue then
+ Exit; //==>
+ if AValue > 5 then
+ begin
+ FFixedTabHeight := AValue;
+ RePaint;
+ end;
+end;
+
function TfpgPageControl.GetTabText(AText: string): string;
var
s, s1: string;
@@ -360,7 +454,7 @@ begin
inc(i);
end;
if FFont.TextWidth(s1) > (FFixedTabWidth-10) then
- Delete(s1, length(s1), 1); {$Note This must become a UTF8 function}
+ UTF8Delete(s1, UTF8Length(s1), 1);
if Length(s1) > 0 then
s1 := Trim(s1);
Result := s1;
@@ -424,12 +518,26 @@ begin
RePaint;
end;
-procedure TfpgPageControl.DoChange(ATabSheet: TfpgTabSheet);
+procedure TfpgPageControl.DoPageChange(ATabSheet: TfpgTabSheet);
begin
+ if (csLoading in ComponentState) then
+ Exit;
+ if (csDesigning in ComponentState) then
+ Exit;
if Assigned(FOnChange) then
FOnChange(self, ATabSheet);
end;
+procedure TfpgPageControl.DoTabSheetClosing(ATabSheet: TfpgTabSheet);
+begin
+ if (csLoading in ComponentState) then
+ Exit;
+ if (csDesigning in ComponentState) then
+ Exit;
+ if Assigned(FOnClosingTabSheet) then
+ FOnClosingTabSheet(self, ATabSheet);
+end;
+
function TfpgPageControl.DrawTab(const rect: TfpgRect; const Selected: Boolean = False; const Mode: Integer = 1): TfpgRect;
var
r: TfpgRect;
@@ -443,36 +551,119 @@ begin
end;
if Mode = 2 then
- r.Height := r.Height - 1;
+ r.Height -= 1;
Canvas.SetColor(clWindowBackground);
- Canvas.FillRectangle(r.Left, r.Top, r.Width, r.Height-2);
- Canvas.SetColor(clHilite2);
- Canvas.DrawLine(r.Left, r.Bottom-2, r.Left, r.Top+2);
- Canvas.DrawLine(r.Left, r.Top+2, r.Left+2, r.Top);
- Canvas.DrawLine(r.Left+2, r.Top, r.Right-1, r.Top);
- Canvas.SetColor(clShadow1);
- Canvas.DrawLine(r.Right-1, r.Top+1, r.Right-1, r.Bottom-1);
- Canvas.SetColor(clShadow2);
- Canvas.DrawLine(r.Right-1, r.Top+1, r.Right, r.Top+2);
- Canvas.DrawLine(r.Right, r.Top+2, r.Right, r.Bottom-1);
+ case TabPosition of
+ tpTop:
+ begin
+ Canvas.FillRectangle(r.Left, r.Top, r.Width, r.Height-2); // fill tab background
+ Canvas.SetColor(clHilite2);
+ Canvas.DrawLine(r.Left, r.Bottom-2 , r.Left, r.Top+2); // left edge
+ Canvas.DrawLine(r.Left, r.Top+2 , r.Left+2, r.Top); // left rounder edge
+ Canvas.DrawLine(r.Left+2, r.Top, r.Right-1, r.Top); // top edge
+ Canvas.SetColor(clShadow1);
+ Canvas.DrawLine(r.Right-1, r.Top+1, r.Right-1, r.Bottom-1); // right inner edge
+ Canvas.SetColor(clShadow2);
+ Canvas.DrawLine(r.Right-1, r.Top+1, r.Right, r.Top+2); // right rounded edge (1px)
+ Canvas.DrawLine(r.Right, r.Top+2, r.Right, r.Bottom-1); // right outer edge
+ end;
+
+ tpBottom:
+ begin
+ Canvas.FillRectangle(r.Left, r.Top, r.Width-2, r.Height-2); // fill tab background
+ Canvas.SetColor(clHilite2);
+ Canvas.DrawLine(r.Left, r.Top, r.Left, r.Bottom-1); // left edge
+ Canvas.SetColor(clShadow2);
+ Canvas.DrawLine(r.Left+2, r.Bottom, r.Right-1, r.Bottom); // bottom outer edge
+ Canvas.SetColor(clShadow1);
+ Canvas.DrawLine(r.Right-1, r.Bottom-1, r.Right-1, r.Top+1); // right inner edge
+ Canvas.DrawLine(r.Left+1, r.Bottom-1, r.Right-1, r.Bottom-1);// bottom inner edge
+ Canvas.SetColor(clShadow2);
+ Canvas.DrawLine(r.Right-1, r.Bottom-1, r.Right, r.Bottom-2); // right rounded edge (1px)
+ Canvas.DrawLine(r.Right, r.Bottom-2, r.Right, r.Top+1); // right outer edge
+ end;
+
+ tpLeft:
+ begin
+ if Mode = 2 then
+ begin
+ r.Width := r.Width - 1;
+ r.Height := r.Height + 2;
+ end;
+ with Canvas do
+ begin
+ FillRectangle(r.Left, r.Top, r.Width, r.Height-2);
+ SetColor(clHilite2);
+ DrawLine(r.Left, r.Bottom-2, r.Left, r.Top+2);
+ DrawLine(r.Left, r.Top+2, r.Left+2, r.Top);
+ DrawLine(r.Left+2, r.Top, r.Right-1, r.Top);
+ SetColor(clShadow1);
+ DrawLine(r.Left+2, r.Bottom-1, r.Right-1, r.Bottom-1);
+ SetColor(clShadow2);
+ DrawLine(r.Left+1, r.Bottom-1, r.Left+3, r.Bottom);
+ DrawLine(r.Left+2, r.Bottom, r.Right, r.Bottom);
+ end;
+ end;
+
+ tpRight:
+ begin
+ if Mode = 2 then
+ begin
+ r.Width := r.Width + 1;
+ r.Height := r.Height + 2;
+ end;
+ with Canvas do
+ begin
+ FillRectangle(r.Left, r.Top, r.Width, r.Height-2);
+ SetColor(clHilite2);
+ DrawLine(r.Left+1, r.Top, r.Right-2, r.Top);
+ SetColor(clShadow1);
+ DrawLine(r.Right-2,r.Top,r.Right-1,r.Top+1);
+ DrawLine(r.Left+2, r.Bottom-1, r.Right-2, r.Bottom-1);
+ DrawLine(r.Right-3, r.Bottom-1, r.Right-1, r.Bottom-3);
+ DrawLine(r.Right-1, r.Bottom-3, r.Right-1, r.Top);
+ SetColor(clShadow2);
+ DrawLine(r.Left+2,r.Bottom,r.Right-3, r.Bottom);
+ DrawLine(r.Right-3, r.Bottom, r.Right, r.Bottom-3);
+ DrawLine(r.Right, r.Top+2, r.Right, r.Bottom-2);
+ end;
+ end;
+ end; { case }
+end;
+
+procedure TfpgPageControl.pmCloseTab(Sender: TObject);
+var
+ ts: TfpgTabSheet;
+begin
+ ts := ActivePage;
+ if ts = nil then
+ Exit;
+ RemovePage(ts);
+ DoTabSheetClosing(ts);
+ ts.Free;
end;
procedure TfpgPageControl.OrderSheets;
begin
FPages.Sort(@SortCompare);
+ FActivePageIndex := FPages.IndexOf(ActivePage);
end;
procedure TfpgPageControl.RePaintTitles;
+const
+ TabHeight = 21;
var
- r: TfpgRect;
+ TabW, TabH: Integer;
r2: TfpgRect;
r3: TfpgRect;
h: TfpgTabSheet;
lp: integer;
toffset: integer;
+ TextLeft, TextTop: Integer;
dx: integer;
lTxtFlags: TFTextFlags;
+ ActivePageVisible: Boolean;
begin
if not HasHandle then
Exit; //==>
@@ -480,179 +671,285 @@ begin
if PageCount = 0 then
Exit; //==>
+ TabW:=FixedTabWidth;
+ TabH:=FixedTabHeight;
+ ActivePageVisible := false;
+ If TabH = 0 then
+ TabH := TabHeight;
h := TfpgTabSheet(FPages.First);
if h = nil then
- Exit;
+ Exit; //==>
+
Canvas.BeginDraw;
Canvas.SetTextColor(TextColor);
- lTxtFlags := TextFlagsDflt;
+ lTxtFlags := [];
if not Enabled then
Include(lTxtFlags, txtDisabled);
+
+ if TabPosition in [tpTop, tpBottom] then
+ begin
+ if MaxButtonWidthSum > (Width-(FMargin*2)) then
+ begin
+ if FFirstTabButton = nil then
+ FFirstTabButton := h
+ else
+ h := FFirstTabButton;
+ if TabPosition = tpTop then
+ begin
+ FLeftButton.SetPosition(Width - (FRightButton.Width * 2), FMargin, FRightButton.Height, FRightButton.Height);
+ FRightButton.SetPosition(Width - FRightButton.Width, FMargin, FRightButton.Height, FRightButton.Height);
+ end
+ else
+ begin
+ FLeftButton.SetPosition(Width - (FRightButton.Width * 2), Height - ButtonHeight - FMargin, FRightButton.Height, FRightButton.Height);
+ FRightButton.SetPosition(Width - FRightButton.Width, Height - ButtonHeight - FMargin, FRightButton.Height, FRightButton.Height);
+ end;
+ FLeftButton.Visible := True;
+ FRightButton.Visible := True;
+ end
+ else
+ begin
+ FLeftButton.Visible := False;
+ FRightButton.Visible := False;
+ end;
+ end;
+
+ if TabPosition in [tpLeft, tpRight] then
+ begin
+ if MaxButtonHeightSum > (Height-(FMargin*2)) then
+ begin
+ if FFirstTabButton = nil then
+ FFirstTabButton := h
+ else
+ h := FFirstTabButton;
+ if TabPosition = tpLeft then
+ begin
+ FLeftButton.SetPosition(MaxButtonWidth - (FRightButton.Width * 2), Height - ButtonHeight - FMargin, FRightButton.Height, FRightButton.Height);
+ FRightButton.SetPosition(MaxButtonWidth - FRightButton.Width, Height - ButtonHeight - FMargin, FRightButton.Height, FRightButton.Height);
+ end
+ else
+ begin
+ FLeftButton.SetPosition(Width - MaxButtonWidth, Height - ButtonHeight - FMargin, FRightButton.Height, FRightButton.Height);
+ FRightButton.SetPosition(Width - MaxButtonWidth + FRightButton.Width, Height - ButtonHeight - FMargin, FRightButton.Height, FRightButton.Height);
+ end;
+ FLeftButton.Visible := True;
+ FRightButton.Visible := True;
+ end
+ else
+ begin
+ FLeftButton.Visible := False;
+ FRightButton.Visible := False;
+ end;
+ end;
+
case TabPosition of
+ tpNone:
+ begin
+ while h <> nil do
+ begin
+ if h <> ActivePage then
+ h.Visible:=false
+ else
+ h.Visible:=True;
+ h.SetPosition(FMargin+2, FMargin+2 , Width - (FMargin*2) - 4, Height - ((FMargin+2)*2));
+ if h <> TfpgTabSheet(FPages.Last) then
+ h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1])
+ else
+ h := nil;
+ end;
+ r2.Left := 0;
+ r2.Top := 0;
+ r2.Width := Width;
+ r2.Height := Height;
+ Canvas.DrawButtonFace(r2, []);
+ end;
+
tpBottom:
+ begin
+ lTxtFlags += TextFlagsDflt;
+ lp := 0;
+ r2.SetRect(2, Height - ButtonHeight-3, 50, 21);
+ while h <> nil do
begin
-(*
- if MaxButtonWidthSum > (Width-(FMargin*2)) then
+ if h <> ActivePage then
begin
- if FFirstTabButton = nil then
- FFirstTabButton := h
- else
- h := FFirstTabButton;
- r.SetRect(FMargin, FMargin, Width-(FMargin*2)-(FRightButton.Width*2)-1, FRightButton.Height);
- FLeftButton.SetPosition(Width - FMargin * 2 - FRightButton.Width * 2, FMargin, FRightButton.Height, FRightButton.Height);
- FRightButton.SetPosition(Width - FMargin * 2 - FrightButton.Width, FMargin, FRightButton.Height, FRightButton.Height);
- FLeftButton.Visible := True;
- FRightButton.Visible := True;
+ toffset := 2;
+ h.Visible := False;
end
else
begin
- r.SetRect(FMargin, FMargin, Width-(FMargin*2), ButtonHeight);
- FLeftButton.Visible := False;
- FRightButton.Visible := False;
+ toffset := 4;
+ h.Visible := True;
+ h.SetPosition(FMargin+2, FMargin+2 , Width - (FMargin*2) - 4, Height - r2.Height - (FMargin+2)*2);
end;
- // tabsheet area - left outer line
- Canvas.SetColor(clHilite1);
- Canvas.DrawLine(FMargin, ButtonHeight, FMargin, Height-(FMargin*2));
- // tabsheet area - left inner line
- Canvas.SetColor(clHilite2);
- Canvas.DrawLine(FMargin+1, ButtonHeight+1, FMargin+1, Height - (FMargin*2) - 1);
- // tabsheet area - outer bottom & right line
- Canvas.SetColor(clShadow2);
- Canvas.DrawLine(FMargin, Height - (FMargin*2), Width - (FMargin*2), Height - (FMargin*2));
- Canvas.DrawLine(Width - (FMargin*2), Height - (FMargin*2), Width - (FMargin*2), FMargin + ButtonHeight - 3);
- // tabsheet area - inner bottom & right line
- Canvas.SetColor(clShadow1);
- Canvas.DrawLine(FMargin + 1, Height - (FMargin*2) - 1, Width - (FMargin*2) - 1, Height - (FMargin*2) - 1);
- Canvas.DrawLine(Width - FMargin - 2, Height - FMargin - 2, Width - FMargin - 2, FMargin + ButtonHeight - 2);
- Canvas.SetClipRect(r);
- lp := 0;
- while h <> nil do
- begin
- if h <> ActivePage then
- begin
- toffset := 4;
- // tabsheet area - top lines under inactive tabs
- Canvas.SetColor(clHilite1);
- Canvas.DrawLine(FMargin + lp, FMargin + ButtonHeight - 2, FMargin + lp + ButtonWidth(h.Text), FMargin + ButtonHeight - 2);
- Canvas.SetColor(clHilite2);
- if TfpgTabSheet(FPages.First) = h then
- dx := 1
- else
- dx := -1;
- Canvas.DrawLine(FMargin + lp+dx, FMargin + ButtonHeight - 1, FMargin + lp + ButtonWidth(h.Text) + 1, FMargin + ButtonHeight - 1);
- // vertical divider line between inactive tabs
- Canvas.SetColor(clShadow1);
- Canvas.DrawLine(lp + FMargin + ButtonWidth(h.Text), FMargin, lp + FMargin + ButtonWidth(h.Text), FMargin + ButtonHeight - 2);
- h.Visible := False;
- end
- else
- begin
- toffset := 2;
- h.Visible := True;
- h.SetPosition(FMargin+2, FMargin + ButtonHeight, Width - (FMargin*2) - 4, Height - (FMargin*2) - ButtonHeight - 2);
- // tab outer left & top line
- Canvas.SetColor(clHilite1);
- Canvas.DrawLine(lp + FMargin, FMargin + ButtonHeight - 2, lp + FMargin, FMargin);
- Canvas.DrawLine(lp + FMargin, FMargin, lp + FMargin + ButtonWidth(h.Text)-1, FMargin);
- // tab inner left & top line
- Canvas.SetColor(clHilite2);
- Canvas.DrawLine(lp + FMargin + 1, FMargin + ButtonHeight - 1, lp + FMargin + 1, FMargin + 1);
- Canvas.DrawLine(lp + FMargin + 1, FMargin + 1, lp + FMargin + ButtonWidth(h.Text) - 2, FMargin + 1);
- // tab inner right line
- Canvas.SetColor(clShadow1);
- Canvas.DrawLine(lp + FMargin + ButtonWidth(h.Text) - 2, FMargin + 1, lp + FMargin + ButtonWidth(h.Text) - 2, FMargin + ButtonHeight);
- // tab outer right line
- Canvas.SetColor(clShadow2);
- Canvas.DrawLine(lp + FMargin + ButtonWidth(h.Text) - 1, FMargin, lp + FMargin + ButtonWidth(h.Text) - 1, FMargin + ButtonHeight-1);
- end;
- // paint text
- Canvas.DrawString(lp + (ButtonWidth(h.Text) div 2) - FFont.TextWidth(GetTabText(h.Text)) div 2, FMargin+toffset, GetTabText(h.Text));
-
- lp := lp + ButtonWidth(h.Text);
- if h <> TfpgTabSheet(FPages.Last) then
- h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1])
- else
- h := nil;
- end; { while }
- // tabsheet area - top lines on right of tabs
- Canvas.SetColor(clHilite1);
- Canvas.Drawline(lp + 1, FMargin + ButtonHeight - 2, Width - (FMargin*2), FMargin + ButtonHeight - 2);
- Canvas.SetColor(clHilite2);
- Canvas.Drawline(lp , FMargin + ButtonHeight - 1, Width - (FMargin*2)-1, FMargin + ButtonHeight - 1);
-*)
+ // paint tab button
+ r2.Width := ButtonWidth(h.Text);
+ r3 := DrawTab(r2, h = ActivePage);
+ // paint text on non-active tabs
+ if h <> ActivePage then
+ Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - FFont.TextWidth(GetTabText(h.Text)) div 2,
+ Height-r2.Height-toffset, GetTabText(h.Text), lTxtFlags);
+
+ r2.Left := r2.Left + r2.Width;
+ lp := lp + ButtonWidth(h.Text);
+ if h <> TfpgTabSheet(FPages.Last) then
+ h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1])
+ else
+ h := nil;
end;
+ // Draw Page Control body rectangle (client area)
+ r2.Left := 0;
+ r2.Top := 0;
+ r2.Width := Width;
+ r2.Height := Height - r2.Height;
+ Canvas.DrawButtonFace(r2, []);
+ // Draw text of ActivePage, because we didn't before.
+ DrawTab(r3, false, 2);
+ Canvas.DrawText(r3.Left+4, r3.Top+5, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
+ end;
tpTop:
+ begin
+ lTxtFlags += TextFlagsDflt;
+ lp := 0;
+ r2.SetRect(2, 2, 50, 21);
+ while h <> nil do
begin
- if MaxButtonWidthSum > (Width-(FMargin*2)) then
+ if h <> ActivePage then
begin
- if FFirstTabButton = nil then
- FFirstTabButton := h
- else
- h := FFirstTabButton;
- r.SetRect(FMargin, FMargin, Width-(FMargin*2)-(FRightButton.Width*2)-1, FRightButton.Height);
- FLeftButton.SetPosition(Width - FRightButton.Width * 2, FMargin, FRightButton.Height, FRightButton.Height);
- FRightButton.SetPosition(Width - FrightButton.Width, FMargin, FRightButton.Height, FRightButton.Height);
- FLeftButton.Visible := True;
- FRightButton.Visible := True;
+ toffset := 4;
+ h.Visible := False;
end
else
begin
- r.SetRect(FMargin, FMargin, Width-(FMargin*2), ButtonHeight);
- FLeftButton.Visible := False;
- FRightButton.Visible := False;
+ toffset := 2;
+ h.Visible := True;
+ h.SetPosition(FMargin+2, FMargin+2 + r2.Height, Width - (FMargin*2) - 4, Height - r2.Height - ((FMargin+2)*2));
end;
-
- lp := 0;
- r2.SetRect(2, 2, 50, 21);
- while h <> nil do
+ // paint tab button
+ r2.Width := ButtonWidth(h.Text);
+ r3 := DrawTab(r2, h = ActivePage);
+
+ // paint text on non-active tabs
+ if h <> ActivePage then
+ Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - FFont.TextWidth(GetTabText(h.Text)) div 2,
+ FMargin+toffset, GetTabText(h.Text), lTxtFlags);
+ r2.Left := r2.Left + r2.Width;
+ lp := lp + ButtonWidth(h.Text);
+ if h <> TfpgTabSheet(FPages.Last) then
+ h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1])
+ else
+ h := nil;
+ end;
+ // Draw Page Control body rectangle (client area)
+ r2.Left := 0;
+ r2.Top := r2.Top + r2.Height-2;
+ r2.Width := Width;
+ r2.Height := Height - r2.Height;
+ Canvas.DrawButtonFace(r2, []);
+
+ // Draw text of ActivePage, because we didn't before.
+ DrawTab(r3, false, 2);
+ Canvas.DrawText(r3.Left+4, r3.Top+3, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
+ end;
+
+ tpRight:
+ begin
+ lTxtFlags += [txtVCenter, txtLeft];
+ lp := 0;
+ TabW := MaxButtonWidth;
+ r2.SetRect(Width - 2 - TabW, 2, TabW, 21);
+ while h <> nil do
+ begin
+ if h <> ActivePage then
begin
- if h <> ActivePage then
- begin
- toffset := 4;
- h.Visible := False;
- end
- else
- begin
- toffset := 2;
- h.Visible := True;
- h.SetPosition(FMargin+2, FMargin+2 + r2.Height, Width - (FMargin*2) - 4, Height - r2.Height - ((FMargin+2)*2));
- end;
- // paint tab button
- r2.Width := ButtonWidth(h.Text);
- r3 := DrawTab(r2, h = ActivePage);
-
- // paint text on non-active tabs
- if h <> ActivePage then
- Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - FFont.TextWidth(GetTabText(h.Text)) div 2, FMargin+toffset, GetTabText(h.Text), lTxtFlags);
-
- r2.Left := r2.Left + r2.Width;
- lp := lp + ButtonWidth(h.Text);
- if h <> TfpgTabSheet(FPages.Last) then
- h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1])
- else
- h := nil;
+ toffset := 4;
+ h.Visible := False;
+ end
+ else
+ begin
+ toffset := 2;
+ h.Visible := True;
+ { set tab content page (client area) size }
+ h.SetPosition(FMargin+2, FMargin+2, Width - ((FMargin+2)*2) - TabW, Height - ((FMargin+2)*2));
end;
- // Draw Page Control body rectangle (client area)
- r2.Left := 0;
- r2.Top := r2.Top + r2.Height-2;
- r2.Width := Width;
- r2.Height := Height - r2.Height;
- Canvas.DrawButtonFace(r2, []);
-
- // Draw text of ActivePage, because we didn't before.
- DrawTab(r3, false, 2);
- Canvas.DrawText(r3.Left+4, r3.Top+3, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
+ // paint tab button
+ r3 := DrawTab(r2, h = ActivePage);
+
+ // paint text on non-active tabs
+ if h <> ActivePage then
+ Canvas.DrawText(r2.left+toffset, r2.Top, r2.Width, r2.Height, GetTabText(h.Text), lTxtFlags);
+ r2.Top += r2.Height;
+ lp := r2.Top;
+ if h <> TfpgTabSheet(FPages.Last) then
+ h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1])
+ else
+ h := nil;
end;
- end;
-
+ // Draw Page Control body rectangle (client area)
+ r2.Left := 0;
+ r2.Top := 0;
+ r2.Width := Width - TabW;
+ r2.Height := Height;
+ Canvas.DrawButtonFace(r2, []);
+
+ // Draw text of ActivePage, because we didn't before.
+ DrawTab(r3, false, 2);
+ Canvas.DrawText(r3.left+toffset, r3.Top, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
+ end;
+
+ tpLeft:
+ begin
+ lTxtFlags += [txtVCenter, txtLeft];
+ lp := 0;
+ TabW := MaxButtonWidth;
+ r2.SetRect(2, 2, TabW, 21);
+ while h <> nil do
+ begin
+ if h <> ActivePage then
+ begin
+ toffset := 4;
+ h.Visible := False;
+ end
+ else
+ begin
+ toffset := 2;
+ h.Visible := True;
+ { set tab content page (client area) size }
+ h.SetPosition(FMargin+2+TabW, FMargin+2, Width - ((FMargin+2)*2) - TabW, Height - ((FMargin+2)*2));
+ end;
+ // paint tab button
+ r3 := DrawTab(r2, h = ActivePage);
+
+ // paint text on non-active tabs
+ if h <> ActivePage then
+ Canvas.DrawText(r2.left+toffset, r2.Top, r2.Width, r2.Height, GetTabText(h.Text), lTxtFlags);
+ r2.Top += r2.Height;
+ lp := r2.Top;
+ if h <> TfpgTabSheet(FPages.Last) then
+ h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1])
+ else
+ h := nil;
+ end;
+ // Draw Page Control body rectangle (client area)
+ r2.Left := TabW;
+ r2.Top := 0;
+ r2.Width := Width - TabW;
+ r2.Height := Height;
+ Canvas.DrawButtonFace(r2, []);
+
+ // Draw text of ActivePage, because we didn't before.
+ DrawTab(r3, false, 2);
+ Canvas.DrawText(r3.left+toffset, r3.Top, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
+ end;
+ end; { case }
+
Canvas.EndDraw;
end;
procedure TfpgPageControl.HandlePaint;
begin
-// inherited HandlePaint;
if SortPages then
OrderSheets;
Canvas.ClearClipRect;
@@ -669,15 +966,6 @@ begin
Canvas.DrawString(2, 2, Name + ': ' + Classname);
end;
end;
-
- if TabPosition = tpBottom then
- begin
- if Focused then
- Canvas.SetColor(clWidgetFrame)
- else
- Canvas.SetColor(clInactiveWgFrame);
- Canvas.DrawRectangle(0, 0, Width, Height);
- end;
RePaintTitles;
end;
@@ -693,8 +981,10 @@ var
h: TfpgTabSheet;
lp: integer; // left position
bw: integer; // button width
+ bh: integer; // button height
+ p1, p2: integer; // tab boundaries for mouse click to take affect
begin
-// writeln('>> TfpgPageControl.HandleLMouseUp');
+// debugln('>> TfpgPageControl.HandleLMouseUp');
h := TfpgTabSheet(FPages.First);
if h = nil then
Exit; //==>
@@ -705,58 +995,92 @@ begin
case TabPosition of
tpTop:
- begin
-// writeln(' TabPosition = tpTop');
- if (y > FMargin) and (y < ButtonHeight) then
- begin
- while h <> nil do
- begin
- bw := ButtonWidth(h.Text); // initialize button width
- if (x > lp) and (x < lp + bw) then
- begin
- if h <> ActivePage then
- begin
- ActivePage := h;
- DoChange(ActivePage);
- end;
- exit;
- end; { if }
- lp := lp + bw;
- if h <> TfpgTabSheet(FPages.Last) then
- h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1])
- else
- h := nil;
- end; { while }
- end; { if }
- end;
-
+ begin
+ p1 := FMargin;
+ p2 := ButtonHeight;
+ end;
+
tpBottom:
- begin
-(*
- if (y > Height - FMargin - buttonheight) and (y < height - FMargin) then
+ begin
+ p1 := Height - FMargin - ButtonHeight;
+ p2 := Height - FMargin;
+ end;
+
+ tpRight:
+ begin
+ p1 := Width - MaxButtonWidth;
+ p2 := Width;
+ end;
+
+ tpLeft:
+ begin
+ p1 := FMargin;
+ p2 := FMargin + MaxButtonWidth;
+ end;
+ end;
+
+ if TabPosition in [tpTop, tpBottom] then
+ begin
+ if (y > p1) and (y < p2) then
+ begin
+ while h <> nil do
+ begin
+ bw := ButtonWidth(h.Text); // initialize button width
+ if (x > lp) and (x < lp + bw) then
begin
- while h <> nil do
- begin
- bw := ButtonWidth(h^.TabSheet.Text); // initialize button width
- if (x > lp) and (x < lp + bw) then
- begin
- if h^.TabSheet <> ActiveTabSheet then
- begin
- ActiveTabSheet := h^.TabSheet;
- DoChange(ActiveTabSheet);
- end;
- exit;
- end;
- lp := lp + bw;
- h := h^.next;
- end; { while }
+ if h <> ActivePage then
+ ActivePage := h;
+ exit;
end; { if }
-*)
- end;
- end; { case }
+ lp := lp + bw;
+ if h <> TfpgTabSheet(FPages.Last) then
+ h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1])
+ else
+ h := nil;
+ end; { while }
+ end; { if }
+ end;
+
+ if TabPosition in [tpLeft, tpRight] then
+ begin
+ if (x > p1) and (x < p2) then
+ begin
+ while h <> nil do
+ begin
+ bh := ButtonHeight; // initialize button height
+ if (y > lp) and (y < lp + bh) then
+ begin
+ if h <> ActivePage then
+ ActivePage := h;
+ exit;
+ end; { if }
+ lp := lp + bh;
+ if h <> TfpgTabSheet(FPages.Last) then
+ h := TfpgTabSheet(FPages[FPages.IndexOf(h)+1])
+ else
+ h := nil;
+ end; { while }
+ end; { if }
+ end;
+
inherited HandleLMouseUp(x, y, shiftstate);
end;
+procedure TfpgPageControl.HandleRMouseUp(x, y: integer; shiftstate: TShiftState);
+begin
+ inherited HandleRMouseUp(x, y, shiftstate);
+// ShowDefaultPopupMenu(x, y, ShiftState);
+ if to_PMenuClose in FTabOptions then
+ begin
+ if not Assigned(FPopupMenu) then
+ begin
+ FPopupMenu := TfpgPopupMenu.Create(self);
+ FPopupMenu.AddMenuItem('Close Tab', '', @pmCloseTab);
+ end;
+ FPopupMenu.ShowAt(self, x, y);
+ end;
+end;
+
procedure TfpgPageControl.HandleKeyPress(var keycode: word;
var shiftstate: TShiftState; var consumed: boolean);
var
@@ -765,14 +1089,13 @@ begin
// writeln(Classname, '.Keypress');
consumed := True;
i := ActivePageIndex;
-
+ if ssAlt in shiftstate then
case keycode of
keyLeft:
begin
if ActivePage <> TfpgTabSheet(FPages.First) then
begin
ActivePage := TfpgTabSheet(FPages[i-1]);
- DoChange(ActivePage);
end;
end;
@@ -781,7 +1104,6 @@ begin
if ActivePage <> TfpgTabSheet(FPages.Last) then
begin
ActivePage := TfpgTabSheet(FPages[i+1]);
- DoChange(ActivePage);
end;
end;
@@ -799,12 +1121,14 @@ begin
FWidth := 150;
FHeight := 100;
FIsContainer := True;
+ FTabOptions := [];
FTextColor := Parent.TextColor;
FBackgroundColor := Parent.BackgroundColor;
FFocusable := True;
FOnChange := nil;
FFixedTabWidth := 0;
+ FFixedTabHeight := 21;
FFirstTabButton := nil;
FStyle := tsTabs;
FTabPosition := tpTop;
@@ -825,20 +1149,13 @@ begin
end;
destructor TfpgPageControl.Destroy;
-var
- ts: TfpgTabSheet;
+var i: integer;
begin
FOnChange := nil;
- if FPages.Count > 0 then
- FActivePage := TfpgTabSheet(FPages[0]);
- ActiveWidget := nil;
- while FPages.Count > 0 do
- begin
- ts := TfpgTabSheet(FPages.Last);
- FPages.Remove(ts);
- ts.Free;
- end;
+ for i:=0 to FPages.Count-1 do
+ TfpgTabSheet(FPages[i]).PageControl:=nil;
FPages.Free;
+ ActiveWidget := nil;
FFirstTabButton := nil;
inherited Destroy;
end;
generated by cgit v1.2.3-70-g09d2 (git 2.48.0) at 2025-01-17 08:38:58 +0000