summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/corelib/canvastest/fpgcanvas.lpi7
-rw-r--r--examples/gui/tabtest/tabtest.lpi53
-rw-r--r--examples/gui/tabtest/tabtest.lpr77
-rw-r--r--prototypes/fpgui2/tests/edittest.dpr9
-rw-r--r--prototypes/fpgui2/tests/themetest.lpi8
-rw-r--r--prototypes/fpgui2/tests/themetest.lpr8
-rw-r--r--src/corelib/gfx_widget.pas2
-rw-r--r--src/corelib/keys.inc2
-rw-r--r--src/corelib/predefinedcolors.inc2
-rw-r--r--src/gui/gui_tab.pas406
-rw-r--r--src/gui/gui_trackbar.pas2
11 files changed, 546 insertions, 30 deletions
diff --git a/examples/corelib/canvastest/fpgcanvas.lpi b/examples/corelib/canvastest/fpgcanvas.lpi
index 7f1c6c21..71f908fb 100644
--- a/examples/corelib/canvastest/fpgcanvas.lpi
+++ b/examples/corelib/canvastest/fpgcanvas.lpi
@@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
- <PathDelim Value="\"/>
+ <PathDelim Value="/"/>
<Version Value="5"/>
<General>
<Flags>
@@ -9,7 +9,7 @@
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
- <IconPath Value=".\"/>
+ <IconPath Value="./"/>
<TargetFileExt Value=""/>
<Title Value="fpcanvas"/>
</General>
@@ -24,7 +24,7 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
- <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
@@ -43,7 +43,6 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
- <PathDelim Value="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
diff --git a/examples/gui/tabtest/tabtest.lpi b/examples/gui/tabtest/tabtest.lpi
new file mode 100644
index 00000000..836169e0
--- /dev/null
+++ b/examples/gui/tabtest/tabtest.lpi
@@ -0,0 +1,53 @@
+<?xml version="1.0"?>
+<CONFIG>
+ <ProjectOptions>
+ <PathDelim Value="/"/>
+ <Version Value="5"/>
+ <General>
+ <Flags>
+ <SaveOnlyProjectUnits Value="True"/>
+ </Flags>
+ <SessionStorage Value="InProjectDir"/>
+ <MainUnit Value="0"/>
+ <TargetFileExt Value=""/>
+ </General>
+ <VersionInfo>
+ <ProjectVersion Value=""/>
+ </VersionInfo>
+ <PublishOptions>
+ <Version Value="2"/>
+ <IgnoreBinaries Value="False"/>
+ <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+ <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+ </PublishOptions>
+ <RunParams>
+ <local>
+ <FormatVersion Value="1"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+ </local>
+ </RunParams>
+ <RequiredPackages Count="1">
+ <Item1>
+ <PackageName Value="fpgui_package"/>
+ <MinVersion Minor="5" Valid="True"/>
+ </Item1>
+ </RequiredPackages>
+ <Units Count="1">
+ <Unit0>
+ <Filename Value="tabtest.lpr"/>
+ <IsPartOfProject Value="True"/>
+ <UnitName Value="tabtest"/>
+ </Unit0>
+ </Units>
+ </ProjectOptions>
+ <CompilerOptions>
+ <Version Value="5"/>
+ <CodeGeneration>
+ <Generate Value="Faster"/>
+ </CodeGeneration>
+ <Other>
+ <CustomOptions Value="-FUunits"/>
+ <CompilerPath Value="$(CompPath)"/>
+ </Other>
+ </CompilerOptions>
+</CONFIG>
diff --git a/examples/gui/tabtest/tabtest.lpr b/examples/gui/tabtest/tabtest.lpr
new file mode 100644
index 00000000..ab3381cc
--- /dev/null
+++ b/examples/gui/tabtest/tabtest.lpr
@@ -0,0 +1,77 @@
+program tabtest;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, fpgfx, gfx_widget, gfxbase, gui_form, gui_tab, gui_button,
+ fpgui_package;
+
+type
+ TMainForm = class(TfpgForm)
+ private
+ btnQuit: TfpgButton;
+ pcMain: TfpgPageControl;
+ tsOne: TfpgTabSheet;
+ tsTwo: TfpgTabSheet;
+ tsThree: TfpgTabSheet;
+ procedure btnQuitClick(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ end;
+
+{ TMainForm }
+
+procedure TMainForm.btnQuitClick(Sender: TObject);
+begin
+ Close;
+end;
+
+constructor TMainForm.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ WindowTitle := 'Tab control test';
+ SetPosition(100, 100, 566, 350);
+
+ btnQuit := CreateButton(self, 476, 320, 80, 'Quit', @btnQuitClick);
+ btnQuit.ImageName := 'stdimg.Quit';
+ btnQuit.ShowImage := True;
+ btnQuit.Anchors := [anRight, anBottom];
+
+ pcMain := TfpgPageControl.Create(self);
+ pcMain.Top := 10;
+ pcMain.Left := 10;
+ pcMain.Width := Width - 20;
+ pcMain.Height := 300;
+ pcMain.Anchors := [anLeft, anTop, anRight, anBottom];
+
+ tsOne := TfpgTabSheet.Create(pcMain);
+ tsOne.Text := 'Tab One';
+ tsOne.Top := 50;
+
+ tsTwo := TfpgTabSheet.Create(pcMain);
+ tsTwo.Text := 'Tab Two';
+ tsTwo.Top := 50;
+
+ tsThree := TfpgTabSheet.Create(pcMain);
+ tsThree.Text := 'Tab Three';
+ tsThree.Top := 50;
+
+end;
+
+procedure MainProc;
+var
+ frm: TMainForm;
+begin
+ fpgApplication.Initialize;
+ frm := TMainForm.Create(nil);
+ frm.Show;
+ fpgApplication.Run;
+end;
+
+begin
+ MainProc;
+end.
+
diff --git a/prototypes/fpgui2/tests/edittest.dpr b/prototypes/fpgui2/tests/edittest.dpr
index cdeed6ff..511cd404 100644
--- a/prototypes/fpgui2/tests/edittest.dpr
+++ b/prototypes/fpgui2/tests/edittest.dpr
@@ -56,9 +56,11 @@ type
procedure btnDisplayBMP(Sender: TObject);
procedure btn3Click(Sender: TObject);
procedure checkbox1Changed(Sender: TObject);
+ procedure TrackBarChanged(Sender: TObject; APosition: integer);
public
label1: TfpgLabel;
label2: TfpgLabel;
+ lblTrackBarPos: TfpgLabel;
edit1: TfpgEdit;
edit2: TfpgEdit;
btn: TfpgButton;
@@ -307,6 +309,11 @@ begin
edit1.Enabled := not checkbox1.Checked;
end;
+procedure TMainForm.TrackBarChanged(Sender: TObject; APosition: integer);
+begin
+ lblTrackBarPos.Text := IntToStr(APosition);
+end;
+
procedure TMainForm.AfterCreate;
var
i: integer;
@@ -401,11 +408,13 @@ begin
radiobtn3 := CreateRadioButton(self, 180, 305, 'Radio Three');
radiobtn1.Checked := True;
+ lblTrackBarPos := CreateLabel(self, 420, 200, '0');
trackbar1 := TfpgTrackBar.Create(self);
trackbar1.Top := 230;
trackbar1.Left := 335;
trackbar1.Width := 100;
trackbar1.Height := 25;
+ trackbar1.OnChange := @TrackBarChanged;
trackbar2 := TfpgTrackBar.Create(self);
trackbar2.Top := 230;
diff --git a/prototypes/fpgui2/tests/themetest.lpi b/prototypes/fpgui2/tests/themetest.lpi
index b10d0483..2e9f7080 100644
--- a/prototypes/fpgui2/tests/themetest.lpi
+++ b/prototypes/fpgui2/tests/themetest.lpi
@@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
- <PathDelim Value="\"/>
+ <PathDelim Value="/"/>
<Version Value="5"/>
<General>
<Flags>
@@ -9,7 +9,7 @@
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
- <IconPath Value=".\"/>
+ <IconPath Value="./"/>
<TargetFileExt Value=""/>
</General>
<VersionInfo>
@@ -17,14 +17,13 @@
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
- <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
- <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+ <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
@@ -43,7 +42,6 @@
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
- <PathDelim Value="\"/>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
diff --git a/prototypes/fpgui2/tests/themetest.lpr b/prototypes/fpgui2/tests/themetest.lpr
index 7a99a55b..da310996 100644
--- a/prototypes/fpgui2/tests/themetest.lpr
+++ b/prototypes/fpgui2/tests/themetest.lpr
@@ -224,7 +224,7 @@ end;
procedure TThemeButton.HandlePaint;
var
x, i: integer;
- r: TfpgRect;
+ r: TRect;
iy, y: integer;
w: integer;
pofs: integer;
@@ -233,6 +233,7 @@ begin
// inherited HandlePaint;
Canvas.ClearClipRect;
Canvas.Clear(clButtonFace);
+ r := Rect(0, 0, Width-1, Height-1);
if State <> 1 then
begin
@@ -270,10 +271,7 @@ begin
if not Enabled then
Canvas.SetTextColor(clShadow1);
- r.left := 2;
- r.top := 2;
- r.Width := Width - 4;
- r.Height := Height - 4;
+ InflateRect(r, 2, 2);
Canvas.SetClipRect(r);
Canvas.SetFont(Font);
diff --git a/src/corelib/gfx_widget.pas b/src/corelib/gfx_widget.pas
index 24f05244..98755402 100644
--- a/src/corelib/gfx_widget.pas
+++ b/src/corelib/gfx_widget.pas
@@ -76,7 +76,6 @@ type
procedure HandleHide; virtual;
procedure MoveAndResize(aleft, atop, awidth, aheight: TfpgCoord);
procedure MoveAndResizeBy(dx, dy, dw, dh: TfpgCoord);
- procedure SetPosition(aleft, atop, awidth, aheight: TfpgCoord);
procedure RePaint;
{ property events }
property OnPaint: TPaintEvent read FOnPaint write FOnPaint;
@@ -91,6 +90,7 @@ type
destructor Destroy; override;
procedure SetFocus;
procedure KillFocus;
+ procedure SetPosition(aleft, atop, awidth, aheight: TfpgCoord);
property Parent: TfpgWidget read GetParent write SetParent;
property ActiveWidget: TfpgWidget read FActiveWidget write SetActiveWidget;
property Visible: boolean read FVisible write SetVisible;
diff --git a/src/corelib/keys.inc b/src/corelib/keys.inc
index 756ea4aa..f8b24b34 100644
--- a/src/corelib/keys.inc
+++ b/src/corelib/keys.inc
@@ -5,6 +5,8 @@
GII info at <http://www.ggi-project.org/packages/libgii.html>
}
+{%mainunit gfxbase.pas}
+
const
// ASCII keys
diff --git a/src/corelib/predefinedcolors.inc b/src/corelib/predefinedcolors.inc
index 5162a58e..cba6d620 100644
--- a/src/corelib/predefinedcolors.inc
+++ b/src/corelib/predefinedcolors.inc
@@ -1,4 +1,4 @@
-
+{%mainunit gfxbase.pas}
// The following colors match the predefined Delphi Colors
// NOTE:
diff --git a/src/gui/gui_tab.pas b/src/gui/gui_tab.pas
index 04edc05a..d1a5ee49 100644
--- a/src/gui/gui_tab.pas
+++ b/src/gui/gui_tab.pas
@@ -11,6 +11,7 @@ interface
uses
Classes,
SysUtils,
+ gfxbase,
fpgfx,
gfx_widget,
gui_button;
@@ -18,21 +19,27 @@ uses
type
// forward declaration
TfpgPageControl = class;
+
+ TfpgTabStyle = (tsTabs, tsButtons, tsFlatButtons);
+ TfpgTabPosition = (tpTop, tpBottom{, tpLeft, tpRight});
TfpgTabSheet = class(TfpgWidget)
private
+ FText: string;
function GetPageControl: TfpgPageControl;
function GetPageIndex: Integer;
function GetText: string;
- procedure SetPageControl(const AValue: TfpgPageControl);
+// procedure SetPageControl(const AValue: TfpgPageControl);
procedure SetPageIndex(const AValue: Integer);
procedure SetText(const AValue: string);
+ protected
+ procedure HandlePaint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Text: string read GetText write SetText;
property PageIndex: Integer read GetPageIndex write SetPageIndex stored False;
- property PageControl: TfpgPageControl read GetPageControl write SetPageControl;
+ property PageControl: TfpgPageControl read GetPageControl; //write SetPageControl;
end;
@@ -41,26 +48,65 @@ type
TfpgPageControl = class(TfpgWidget)
private
+ FBackgroundColor: TfpgColor;
+ FFont: TfpgFont;
+ FActiveSheet: TfpgTabSheet;
+ FMargin: integer;
+ FFixedTabWidth: integer;
FPages: TList;
FActivePageIndex: integer;
FOnChange: TTabSheetChange;
+ FRightButton: TfpgButton;
+ FLeftButton: TfpgButton;
+ FFirstTabSheet: TfpgTabSheet;
+ FFirstTabButton: TfpgTabSheet;
+ FStyle: TfpgTabStyle;
+ FTabPosition: TfpgTabPosition;
function GetActivePageIndex: integer;
function GetPageCount: Integer;
procedure InsertPage(const APage: TfpgTabSheet);
procedure RemovePage(const APage: TfpgTabSheet);
+ procedure SetActiveSheet(const AValue: TfpgTabSheet);
+ function MaxButtonWidthSum: integer;
+ function MaxButtonHeight: integer;
+ function MaxButtonWidth: integer;
+ function ButtonHeight: integer;
+ function ButtonWidth(AText: string): integer;
+ procedure SetBackgroundColor(const AValue: TfpgColor);
+ procedure SetFixedTabWidth(const AValue: integer);
+ function GetTabText(AText: string): string;
+ procedure LeftButtonClick(Sender: TObject);
+ procedure RightButtonClick(Sender: TObject);
+ function FindNextPage(ACurrent: TfpgTabSheet; AForward: boolean): TfpgTabSheet;
+ procedure SetStyle(const AValue: TfpgTabStyle);
+ procedure SetTabPosition(const AValue: TfpgTabPosition);
protected
- procedure UnregisterTabSheet(ATabSheet: TfpgTabSheet);
- procedure RegisterTabSheet(ATabSheet: TfpgTabSheet);
+// procedure UnregisterTabSheet(ATabSheet: TfpgTabSheet);
+// procedure RegisterTabSheet(ATabSheet: TfpgTabSheet);
+ procedure OrderSheets; // currently using bubblesort
+ procedure RePaintTitles; virtual;
+ procedure HandlePaint; override;
+ procedure HandleResize(awidth, aheight: TfpgCoord); override;
public
constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function AppendTabSheet(ATitle: string): TfpgTabSheet;
+ property BackgroundColor: TfpgColor read FBackgroundColor write SetBackgroundColor;
property PageCount: Integer read GetPageCount;
property ActivePageIndex: integer read GetActivePageIndex write FActivePageIndex;
+ property ActivePage: TfpgTabSheet read FActiveSheet write SetActiveSheet;
+ property FixedTabWidth: integer read FFixedTabWidth write SetFixedTabWidth;
+ property Style: TfpgTabStyle read FStyle write SetStyle;
+ property TabPosition: TfpgTabPosition read FTabPosition write SetTabPosition;
property OnChange: TTabSheetChange read FOnChange write FOnChange;
end;
implementation
+uses
+ gfx_UTF8utils;
+
{ TfpgTabSheet }
function TfpgTabSheet.GetPageControl: TfpgPageControl;
@@ -81,9 +127,9 @@ end;
function TfpgTabSheet.GetText: string;
begin
-
+ Result := FText;
end;
-
+{
procedure TfpgTabSheet.SetPageControl(const AValue: TfpgPageControl);
begin
if PageControl <> AValue then
@@ -95,7 +141,7 @@ begin
AValue.InsertPage(self);
end;
end;
-
+}
procedure TfpgTabSheet.SetPageIndex(const AValue: Integer);
begin
@@ -103,7 +149,19 @@ end;
procedure TfpgTabSheet.SetText(const AValue: string);
begin
+ if FText = AValue then
+ Exit; //==>
+ FText := AValue;
+ if PageControl <> nil then
+ PageControl.RePaintTitles;
+end;
+procedure TfpgTabSheet.HandlePaint;
+begin
+ Canvas.BeginDraw;
+// inherited HandlePaint;
+ Canvas.Clear(clWindowBackground);
+ Canvas.EndDraw;
end;
constructor TfpgTabSheet.Create(AOwner: TComponent);
@@ -112,7 +170,8 @@ begin
FFocusable := True;
if Owner is TfpgPageControl then
begin
- TfpgPageControl(Owner).RegisterTabSheet(self);
+ TfpgPageControl(Owner).InsertPage(self);
+// TfpgPageControl(Owner).RegisterTabSheet(self);
// FPageIndex := TfpgPageControl(Owner).PageCount + 1;
end;
end;
@@ -120,7 +179,8 @@ end;
destructor TfpgTabSheet.Destroy;
begin
if Owner is TfpgPageControl then
- TfpgPageControl(Owner).UnregisterTabSheet(self);
+ TfpgPageControl(Owner).RemovePage(self);
+// TfpgPageControl(Owner).UnregisterTabSheet(self);
inherited Destroy;
end;
@@ -128,7 +188,7 @@ end;
function TfpgPageControl.GetActivePageIndex: integer;
begin
-
+ Result := FActivePageIndex;
end;
function TfpgPageControl.GetPageCount: Integer;
@@ -137,30 +197,350 @@ begin
end;
procedure TfpgPageControl.InsertPage(const APage: TfpgTabSheet);
+var
+ i: integer;
begin
-
+ if FPages.IndexOf(APage) <> -1 then
+ Exit; //==> The page has already been added.
+ i := FPages.Add(APage);
+ ActivePageIndex := i;
+ FActiveSheet := APage;
+ RePaint;
end;
procedure TfpgPageControl.RemovePage(const APage: TfpgTabSheet);
begin
+ FPages.Remove(APage);
+ {$Note This still needs to be fixed.}
+ if APage = FActiveSheet then
+// FActiveSheet := FindNextPage(APage, True);
+ FActiveSheet := TfpgTabSheet(FPages.First);
+end;
+
+procedure TfpgPageControl.SetActiveSheet(const AValue: TfpgTabSheet);
+begin
+ if FActiveSheet = AValue then
+ Exit; //==>
+ FActiveSheet := AValue;
+ ActiveWidget := AValue;
+ RePaint;
+end;
+
+function TfpgPageControl.MaxButtonWidthSum: integer;
+begin
+ Result := 0;
+end;
+
+function TfpgPageControl.MaxButtonHeight: integer;
+begin
+
+end;
+
+function TfpgPageControl.MaxButtonWidth: integer;
+begin
end;
-procedure TfpgPageControl.UnregisterTabSheet(ATabSheet: TfpgTabSheet);
+function TfpgPageControl.ButtonHeight: integer;
begin
+ Result := FRightButton.Height;
+end;
+function TfpgPageControl.ButtonWidth(AText: string): integer;
+begin
+ if FFixedTabWidth > 0 then
+ result := FFixedTabWidth
+ else
+ result := FFont.TextWidth(AText) + 10;
end;
-procedure TfpgPageControl.RegisterTabSheet(ATabSheet: TfpgTabSheet);
+procedure TfpgPageControl.SetBackgroundColor(const AValue: TfpgColor);
begin
+ if FBackgroundColor = AValue then
+ Exit; //==>
+ FBackgroundColor := AValue;
+ RePaint;
+end;
+procedure TfpgPageControl.SetFixedTabWidth(const AValue: integer);
+begin
+ if FFixedTabWidth = AValue then
+ Exit; //==>
+ if AValue > 5 then
+ begin
+ FFixedTabWidth := AValue;
+ RePaint;
+ end;
+end;
+
+function TfpgPageControl.GetTabText(AText: string): string;
+var
+ s, s1: string;
+ i: integer;
+begin
+ {$IFDEF DEBUG}writeln(Classname + '.GetTabText');{$ENDIF}
+ Result := AText;
+ s := AText;
+ s1 := '';
+ i := 1;
+ if FFixedTabWidth > 0 then
+ begin
+ while FFont.TextWidth(s1) < (FFixedTabWidth-10) do
+ begin
+ if Length(s1) = Length(s) then
+ Break;
+ s1 := UTF8Copy(s, 1, i);
+ inc(i);
+ end;
+ if FFont.TextWidth(s1) > (FFixedTabWidth-10) then
+ Delete(s1, length(s1), 1); {$Note This must become a UTF8 function}
+ if Length(s1) > 0 then
+ s1 := Trim(s1);
+ Result := s1;
+ end;
+end;
+
+procedure TfpgPageControl.LeftButtonClick(Sender: TObject);
+begin
+ {$IFDEF DEBUG}writeln(Classname + '.LeftButtonClick');{$ENDIF}
+ if FFirstTabButton <> nil then
+ begin
+ if TfpgTabSheet(FPages.First) <> FFirstTabButton then
+// if FPages.IndexOf(FFirstTabButton) <> 0 then
+ begin
+ FFirstTabButton := TfpgTabSheet(FPages[FPages.IndexOf(FFirstTabButton)-1]);
+ RePaint;
+ end;
+ end;
+end;
+
+procedure TfpgPageControl.RightButtonClick(Sender: TObject);
+begin
+ {$IFDEF DEBUG}writeln(Classname + '.RightButtonClick');{$ENDIF}
+ if FFirstTabButton <> nil then
+ begin
+ if TfpgTabSheet(FPages.Last) <> FFirstTabButton then
+// if FPages.IndexOf(FFirstTabButton) <> (FPages.Count-1) then
+ begin
+ FFirstTabButton := TfpgTabSheet(FPages[FPages.IndexOf(FFirstTabButton)+1]);
+ RePaint;
+ end;
+ end;
+end;
+
+function TfpgPageControl.FindNextPage(ACurrent: TfpgTabSheet; AForward: boolean
+ ): TfpgTabSheet;
+begin
+ // To be completed
+ result := nil;
+end;
+
+procedure TfpgPageControl.SetStyle(const AValue: TfpgTabStyle);
+begin
+ if FStyle = AValue then
+ Exit; //==>
+ FStyle := AValue;
+ RePaintTitles;
+end;
+
+procedure TfpgPageControl.SetTabPosition(const AValue: TfpgTabPosition);
+begin
+ if FTabPosition = AValue then
+ Exit; //==>
+ FTabPosition := AValue;
+ RePaint;
+end;
+
+procedure TfpgPageControl.OrderSheets;
+begin
+
+end;
+
+procedure TfpgPageControl.RePaintTitles;
+var
+ i: integer;
+ r: TRect;
+ h: TfpgTabSheet;
+ lp: integer;
+begin
+ if not HasHandle then
+ Exit; //==>
+
+ if PageCount = 0 then
+ Exit; //==>
+
+ h := TfpgTabSheet(FPages.First);
+ Canvas.BeginDraw;
+ Canvas.SetTextColor(clText1);
+
+ case TabPosition of
+ tpTop:
+ begin
+ if MaxButtonWidthSum > (Width-(FMargin*2)) then
+ begin
+ if FFirstTabButton = nil then
+ FFirstTabButton := h
+ else
+ h := FFirstTabButton;
+ r := Rect(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;
+ end
+ else
+ begin
+ r := Rect(FMargin, FMargin, Width - (FMargin*2), ButtonHeight);
+ FLeftButton.Visible := False;
+ FRightButton.Visible := False;
+ end;
+ Canvas.SetColor(clHilite1);
+ Canvas.DrawLine(FMargin,ButtonHeight, FMargin, Height - FMargin * 2);
+ Canvas.SetColor(clHilite2);
+ Canvas.DrawLine(FMargin+1,ButtonHeight+1, FMargin+1, Height - FMargin * 2 - 1);
+ Canvas.SetColor(clShadow2);
+ Canvas.DrawLine(FMargin, Height - FMargin * 2, Width - FMargin * 2, Height - FMargin * 2);
+ Canvas.DrawLine(Width - FMargin - 1, FMargin + ButtonHeight - 1, Width - FMargin - 1, Height - FMargin);
+ Canvas.SetColor(clShadow1);
+ Canvas.DrawLine(FMargin + 1, Height - FMargin * 2 - 1, Width - FMargin * 2 - 1, Height - FMargin * 2 - 1);
+ Canvas.DrawLine(Width - FMargin - 2, FMargin + ButtonHeight - 1, Width - FMargin - 2, Height - FMargin - 2);
+ Canvas.SetClipRect(r);
+ lp := 0;
+ while h <> nil do
+ begin
+ if h <> ActivePage then
+ begin
+ Canvas.SetColor(clHilite1);
+ Canvas.DrawLine(FMargin + lp, FMargin + ButtonHeight - 2, FMargin + lp + ButtonWidth(h.Text), FMargin + ButtonHeight - 2);
+ Canvas.SetColor(clHilite2);
+ Canvas.DrawLine(FMargin + lp, FMargin + ButtonHeight - 1, FMargin + lp + ButtonWidth(h.Text) + 1, FMargin + ButtonHeight - 1);
+ Canvas.SetColor(clShadow1);
+ Canvas.DrawLine(lp + FMargin + ButtonWidth(h.Text), FMargin, lp + FMargin + ButtonWidth(h.Text), FMargin + ButtonHeight - 3);
+ h.Visible := False;
+ end
+ else
+ begin
+ h.Visible := True;
+ h.SetPosition(FMargin+2, FMargin + ButtonHeight, Width - FMargin * 2 - 4, Height - FMargin * 2 - ButtonHeight - 2);
+ Canvas.SetColor(clHilite1);
+ Canvas.DrawLine(lp + FMargin, FMargin, lp + FMargin + ButtonWidth(h.Text)-1, FMargin);
+ Canvas.DrawLine(lp + FMargin, FMargin, lp + FMargin, FMargin + ButtonHeight - 2);
+ Canvas.SetColor(clHilite2);
+ Canvas.DrawLine(lp + FMargin + 1, FMargin + 1, lp + FMargin + ButtonWidth(h.Text) - 2, FMargin + 1);
+ Canvas.DrawLine(lp + FMargin + 1, FMargin + 1, lp + FMargin + 1, FMargin + ButtonHeight - 1);
+ Canvas.SetColor(clShadow1);
+ Canvas.DrawLine(lp + FMargin + ButtonWidth(h.Text) - 2,FMargin + 1, lp + FMargin + ButtonWidth(h.Text) - 2, FMargin + ButtonHeight-1);
+ Canvas.SetColor(clShadow2);
+ Canvas.DrawLine(lp + FMargin + ButtonWidth(h.Text) - 1,FMargin + 1, lp + FMargin + ButtonWidth(h.Text) - 1, FMargin + ButtonHeight - 2);
+ end;
+ Canvas.DrawString(lp + (ButtonWidth(h.Text) div 2) - FFont.TextWidth(GetTabText(h.Text)) div 2, FMargin, 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 }
+ Canvas.SetColor(clHilite1);
+ Canvas.Drawline(lp + 1, FMargin + ButtonHeight - 2, Width, FMargin + ButtonHeight - 2);
+ Canvas.SetColor(clHilite2);
+ Canvas.Drawline(lp + 1, FMargin + ButtonHeight - 1, Width, FMargin + ButtonHeight - 1);
+ end;
+
+ tpBottom:
+ begin
+ end;
+ end;
+
+ Canvas.EndDraw;
+end;
+
+procedure TfpgPageControl.HandlePaint;
+begin
+ Canvas.BeginDraw;
+// inherited HandlePaint;
+
+ OrderSheets;
+ Canvas.ClearClipRect;
+ Canvas.Clear(FBackgroundColor);
+ if Focused then
+ Canvas.SetColor(clWidgetFrame)
+ else
+ Canvas.SetColor(clInactiveWgFrame);
+ Canvas.DrawRectangle(0, 0, Width-1, Height-1);
+ RePaintTitles;
+
+ Canvas.EndDraw;
+end;
+
+procedure TfpgPageControl.HandleResize(awidth, aheight: TfpgCoord);
+begin
+ inherited HandleResize(awidth, aheight);
+ RePaint;
end;
constructor TfpgPageControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
+ FBackgroundColor := clWindowBackground;
+ FFocusable := True;
FPages := TList.Create;
FOnChange := nil;
+ FFixedTabWidth := 0;
+ FFont := fpgStyle.DefaultFont;
+ FFirstTabButton := nil;
+ FStyle := tsTabs;
+ FTabPosition := tpTop;
+ FMargin := 1;
+
+ FLeftButton := TfpgButton.Create(self);
+ FLeftButton.Text := '<';
+ FLeftButton.Width := FLeftButton.Height;
+ FLeftButton.Visible := False;
+ FLeftButton.OnClick := @LeftButtonClick;
+
+ FRightButton := TfpgButton.Create(self);
+ FRightButton.Text := '>';
+ FRightButton.Width := FRightButton.Height;
+ FRightButton.Visible := False;
+ FRightButton.OnClick := @RightButtonClick;
+
+end;
+
+destructor TfpgPageControl.Destroy;
+var
+ ts: TfpgTabSheet;
+begin
+ while FPages.Count > 0 do
+ begin
+ ts := TfpgTabSheet(FPages.Last);
+ FPages.Remove(ts);
+ ts.Free;
+ end;
+ FPages.Free;
+
+ FFirstTabButton := nil;
+ FOnChange := nil;
+ inherited Destroy;
+end;
+
+function TfpgPageControl.AppendTabSheet(ATitle: string): TfpgTabSheet;
+var
+// h: PTabSheetList;
+ nt: TfpgTabSheet;
+begin
+// h := FFirstTabSheet;
+ nt := TfpgTabSheet.Create(self);
+ nt.Text := ATitle;
+ //if h = nil then
+ //FFirstTabSheet := nl
+ //else
+ //begin
+ //while h^.next <> nil do
+ //h := h^.next;
+ //h^.next := nl;
+ //nl^.prev := h;
+ //end;
+ result := nt;
end;
end.
diff --git a/src/gui/gui_trackbar.pas b/src/gui/gui_trackbar.pas
index b97650a7..7cc49bb2 100644
--- a/src/gui/gui_trackbar.pas
+++ b/src/gui/gui_trackbar.pas
@@ -98,7 +98,7 @@ begin
Exit; //==>
FPosition := AValue;
RePaint;
- // OnChange only fired on keyboard or mouse input.
+ DoChange;
end;
procedure TfpgTrackBar.SetSliderSize(const AValue: integer);
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-28 00:51:30 +0000