summaryrefslogtreecommitdiff
path: root/src/gui
diff options
context:
space:
mode:
Diffstat (limited to 'src/gui')
-rw-r--r--src/gui/fpg_basegrid.pas4
-rw-r--r--src/gui/fpg_checkbox.pas1
-rw-r--r--src/gui/fpg_colormapping.pas2
-rw-r--r--src/gui/fpg_dialogs.pas25
-rw-r--r--src/gui/fpg_edit.pas5
-rw-r--r--src/gui/fpg_editcombo.pas6
-rw-r--r--src/gui/fpg_iniutils.pas4
-rw-r--r--src/gui/fpg_listbox.pas2
-rw-r--r--src/gui/fpg_memo.pas14
-rw-r--r--src/gui/fpg_menu.pas1
-rw-r--r--src/gui/fpg_scrollbar.pas2
-rw-r--r--src/gui/fpg_scrollframe.pas3
-rw-r--r--src/gui/fpg_spinedit.pas103
-rw-r--r--src/gui/fpg_tab.pas150
-rw-r--r--src/gui/fpg_trackbar.pas4
-rw-r--r--src/gui/messagedialog.inc1
-rw-r--r--src/gui/selectdirdialog.inc1
17 files changed, 199 insertions, 129 deletions
diff --git a/src/gui/fpg_basegrid.pas b/src/gui/fpg_basegrid.pas
index 2df7b414..0524adac 100644
--- a/src/gui/fpg_basegrid.pas
+++ b/src/gui/fpg_basegrid.pas
@@ -696,7 +696,6 @@ var
cw: integer;
vl: integer;
i: integer;
- x: integer;
hmax: integer;
vmax: integer;
Hfits, showH : boolean;
@@ -929,7 +928,6 @@ var
rTop: integer;
firstcol, lastcol, firstrow, lastrow : integer;
cWidths: array of integer;
- rect: TRect;
begin
Canvas.ClearClipRect;
r.SetRect(0, 0, Width, Height);
@@ -1446,7 +1444,6 @@ end;
procedure TfpgBaseGrid.HandleLMouseUp(x, y: integer; shiftstate: TShiftState);
var
- lColumn: integer;
hh: integer; { header height }
cLeft: integer; { column left }
c: integer;
@@ -1512,7 +1509,6 @@ var
hh: integer;
n: Integer;
cw: integer;
- nw: integer;
prow: Integer;
pcol: Integer;
c: integer;
diff --git a/src/gui/fpg_checkbox.pas b/src/gui/fpg_checkbox.pas
index a2946c3c..d428ad55 100644
--- a/src/gui/fpg_checkbox.pas
+++ b/src/gui/fpg_checkbox.pas
@@ -189,7 +189,6 @@ procedure TfpgBaseCheckBox.HandlePaint;
var
r: TfpgRect;
ix: integer;
- img: TfpgImage;
LFlags: TfpgTextFlags;
begin
inherited HandlePaint;
diff --git a/src/gui/fpg_colormapping.pas b/src/gui/fpg_colormapping.pas
index a22b949e..9e736e4b 100644
--- a/src/gui/fpg_colormapping.pas
+++ b/src/gui/fpg_colormapping.pas
@@ -54,7 +54,7 @@ begin
hi := max(max(r, g), b);
lo := min(min(r, g), b);
d := hi - lo;
- Value := hi / 256;
+ Value := hi / 255;
if d > 0 then
begin
if r = hi then
diff --git a/src/gui/fpg_dialogs.pas b/src/gui/fpg_dialogs.pas
index 42f4752c..0ceeaa13 100644
--- a/src/gui/fpg_dialogs.pas
+++ b/src/gui/fpg_dialogs.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -118,6 +118,7 @@ type
procedure SetupCaptions; virtual;
public
constructor Create(AOwner: TComponent); override;
+ procedure AfterCreate; override;
end;
@@ -202,6 +203,7 @@ type
procedure HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
procedure btnOKClick(Sender: TObject); override;
procedure SetCurrentDirectory(const ADir: string);
+ procedure SetupCaptions; override;
public
FileName: string;
constructor Create(AOwner: TComponent); override;
@@ -250,7 +252,7 @@ uses
fpg_widget,
fpg_utils,
fpg_stringutils
- {$IFDEF MSWINDOWS}
+ {$IFDEF WINDOWS}
,Windows // used by File Dialog & Select Dir Dialog
{$ENDIF}
,DateUtils
@@ -605,6 +607,12 @@ begin
btnOK.TabOrder := 1;
end;
+procedure TfpgBaseDialog.AfterCreate;
+begin
+ inherited AfterCreate;
+ SetupCaptions;
+end;
+
{ TfpgFontSelectDialog }
@@ -1101,6 +1109,8 @@ end;
procedure TfpgFileDialog.InitializeComponents;
begin
+ self.ShowHint := True;
+
chlDir := TfpgComboBox.Create(self);
with chlDir do
begin
@@ -1450,6 +1460,16 @@ begin
edFilename.Clear;
end;
+procedure TfpgFileDialog.SetupCaptions;
+begin
+ inherited SetupCaptions;
+ btnUpDir.Hint := rsGoToParentDirectory;
+ btnDirNew.Hint := rsCreateDirectory;
+ btnShowHidden.Hint := rsShowHidden;
+ btnGoHome.Hint := rsGoToHomeDirectory;
+ btnBookmark.Hint := rsBookmarks;
+end;
+
function TfpgFileDialog.HighlightFile(const AFilename: string): boolean;
var
n: integer;
@@ -1469,7 +1489,6 @@ end;
function TfpgFileDialog.CreatePopupMenu: TfpgPopupMenu;
var
i: integer;
- s: TfpgString;
lst: TStringList;
mi: TfpgMenuItem;
begin
diff --git a/src/gui/fpg_edit.pas b/src/gui/fpg_edit.pas
index 6bc3cc7c..1ddce281 100644
--- a/src/gui/fpg_edit.pas
+++ b/src/gui/fpg_edit.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -933,8 +933,7 @@ begin
end;
end; { if }
- if not consumed then
- inherited HandleKeyPress(keycode, shiftstate, consumed);
+ inherited HandleKeyPress(keycode, shiftstate, consumed);
if hasChanged then
DoOnChange;
diff --git a/src/gui/fpg_editcombo.pas b/src/gui/fpg_editcombo.pas
index 12773d9b..a8bd30ed 100644
--- a/src/gui/fpg_editcombo.pas
+++ b/src/gui/fpg_editcombo.pas
@@ -441,9 +441,9 @@ begin
end;
procedure TfpgBaseEditCombo.SetDefaultPopupMenuItemsState;
-var
- i: integer;
- itm: TfpgMenuItem;
+//var
+ //i: integer;
+ //itm: TfpgMenuItem;
begin
//for i := 0 to FDefaultPopupMenu.ComponentCount-1 do
//begin
diff --git a/src/gui/fpg_iniutils.pas b/src/gui/fpg_iniutils.pas
index 6bbe83bd..144b007e 100644
--- a/src/gui/fpg_iniutils.pas
+++ b/src/gui/fpg_iniutils.pas
@@ -203,7 +203,7 @@ begin
// If the form is off screen (positioned outside all monitor screens) then
// center the form on screen.
- //{$IFDEF MSWINDOWS}
+ //{$IFDEF WINDOWS}
//if (AForm.FormStyle <> fsMDIChild) {$IFNDEF FPC} and tiFormOffScreen(AForm) {$ENDIF} then
//begin
//if Assigned(Application.MainForm) and (Application.MainForm <> AForm) then
@@ -211,7 +211,7 @@ begin
//else
//AForm.Position:= poScreenCenter;
//end;
- //{$ENDIF MSWINDOWS}
+ //{$ENDIF WINDOWS}
end;
// Do NOT localize
diff --git a/src/gui/fpg_listbox.pas b/src/gui/fpg_listbox.pas
index d876a222..80c836a0 100644
--- a/src/gui/fpg_listbox.pas
+++ b/src/gui/fpg_listbox.pas
@@ -236,6 +236,8 @@ type
property Items;
property ParentShowHint;
property PopupFrame;
+ property ScrollBarPage;
+ property ScrollBarWidth;
property ShowColorNames;
property ShowHint;
property TabOrder;
diff --git a/src/gui/fpg_memo.pas b/src/gui/fpg_memo.pas
index d02e6ec4..0e5079c1 100644
--- a/src/gui/fpg_memo.pas
+++ b/src/gui/fpg_memo.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2013 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -1108,8 +1108,7 @@ begin
RePaint;
end;
-procedure TfpgMemo.HandleKeyPress(var keycode: word;
- var shiftstate: TShiftState; var consumed: boolean);
+procedure TfpgMemo.HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean);
var
cx: integer;
ls: string;
@@ -1347,14 +1346,14 @@ begin
end;
end;
- if Consumed then
- RePaint
- else
- inherited;
+ inherited HandleKeyPress(keycode, shiftstate, consumed);
if hasChanged then
if Assigned(FOnChange) then
FOnChange(self);
+
+ if Consumed then
+ RePaint;
end;
procedure TfpgMemo.HandleLMouseDown(x, y: integer; shiftstate: TShiftState);
@@ -1706,7 +1705,6 @@ end;
procedure TfpgMemo.SetText(const AValue: TfpgString);
var
n: integer;
- c: TfpgChar;
s: TfpgString;
begin
FLines.Clear;
diff --git a/src/gui/fpg_menu.pas b/src/gui/fpg_menu.pas
index 4779fe40..f1966759 100644
--- a/src/gui/fpg_menu.pas
+++ b/src/gui/fpg_menu.pas
@@ -1070,7 +1070,6 @@ procedure TfpgPopupMenu.DrawItem(mi: TfpgMenuItem; rect: TfpgRect; AFlags: TfpgM
var
s: string;
x: integer;
- img: TfpgImage;
lFlags: TfpgMenuItemFlags;
begin
lFlags := AFlags;
diff --git a/src/gui/fpg_scrollbar.pas b/src/gui/fpg_scrollbar.pas
index fbe20006..69a85097 100644
--- a/src/gui/fpg_scrollbar.pas
+++ b/src/gui/fpg_scrollbar.pas
@@ -434,8 +434,6 @@ begin
end;
procedure TfpgScrollBar.HandleLMouseDown(x, y: integer; shiftstate: TShiftState);
-var
- lPos: TfpgCoord;
begin
inherited;
CaptureMouse;
diff --git a/src/gui/fpg_scrollframe.pas b/src/gui/fpg_scrollframe.pas
index 008832ce..2355929e 100644
--- a/src/gui/fpg_scrollframe.pas
+++ b/src/gui/fpg_scrollframe.pas
@@ -161,7 +161,6 @@ var
c : TComponent;
max_w, max_h : integer;
this_need : integer;
- par : TfpgWidget;
begin
if ComponentCount=0 then
Exit;
@@ -217,8 +216,6 @@ end;
procedure TfpgScrollFrame.HandleMouseScroll(x, y: integer;
shiftstate: TShiftState; delta: smallint);
-var
- old_val, new_val : integer;
begin
inherited HandleMouseScroll(x, y, shiftstate, delta);
with FVScrollBar do
diff --git a/src/gui/fpg_spinedit.pas b/src/gui/fpg_spinedit.pas
index 6061eb3b..97de1027 100644
--- a/src/gui/fpg_spinedit.pas
+++ b/src/gui/fpg_spinedit.pas
@@ -1,7 +1,7 @@
{
fpGUI - Free Pascal GUI Toolkit
- Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -175,53 +175,53 @@ type
FValue: integer;
procedure EnableButtons;
protected
- function IsMinLimitReached: Boolean; override;
- function IsMaxLimitReached: Boolean; override;
- function GetEditBackgroundColor: TfpgColor;
- function GetTextColor: TfpgColor;
- function GetNegativeColor: TfpgColor;
- function GetFontDesc: string;
- procedure ResizeChildren; override;
- procedure SetEditBackgroundColor(const AValue: Tfpgcolor);
- procedure SetTextColor(const AValue: Tfpgcolor); override;
- procedure SetNegativeColor(const AValue: Tfpgcolor);
- procedure SetFontDesc(const AValue: string);
- procedure SetMaxValue(const AValue: integer);
- procedure SetMinValue(const AValue: integer);
- procedure SetIncrement(const AValue: integer);
- procedure SetLargeIncrement(const AValue: integer);
- procedure SetValue(const AValue: integer);
- procedure SetHint(const AValue: TfpgString); override;
- procedure ButtonUpClick(Sender: TObject);
- procedure ButtonDownClick(Sender: TObject);
- procedure ButtonUpMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
- procedure ButtonUpMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
- procedure ButtonDownMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
- procedure ButtonDownMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
- procedure EditKeyPress(Sender: TObject; var keycode: word; var shiftstate: TShiftState; var consumed: Boolean);
- procedure EditExit(Sender: TObject);
- procedure MouseEnter(Sender: TObject);
- procedure MouseMove(Sender: TObject; AShift: TShiftState; const AMousePos: TPoint);
- procedure MouseExit(Sender: TObject);
- procedure TimerStep(Sender: TObject);
+ function IsMinLimitReached: Boolean; override;
+ function IsMaxLimitReached: Boolean; override;
+ function GetEditBackgroundColor: TfpgColor;
+ function GetTextColor: TfpgColor;
+ function GetNegativeColor: TfpgColor;
+ function GetFontDesc: string;
+ procedure ResizeChildren; override;
+ procedure SetEditBackgroundColor(const AValue: Tfpgcolor);
+ procedure SetTextColor(const AValue: Tfpgcolor); override;
+ procedure SetNegativeColor(const AValue: Tfpgcolor);
+ procedure SetFontDesc(const AValue: string);
+ procedure SetMaxValue(const AValue: integer);
+ procedure SetMinValue(const AValue: integer);
+ procedure SetIncrement(const AValue: integer);
+ procedure SetLargeIncrement(const AValue: integer);
+ procedure SetValue(const AValue: integer);
+ procedure SetHint(const AValue: TfpgString); override;
+ procedure ButtonUpClick(Sender: TObject);
+ procedure ButtonDownClick(Sender: TObject);
+ procedure ButtonUpMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+ procedure ButtonUpMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+ procedure ButtonDownMouseDown(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+ procedure ButtonDownMouseUp(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+ procedure EditKeyPress(Sender: TObject; var keycode: word; var shiftstate: TShiftState; var consumed: Boolean);
+ procedure EditExit(Sender: TObject);
+ procedure MouseEnter(Sender: TObject);
+ procedure MouseMove(Sender: TObject; AShift: TShiftState; const AMousePos: TPoint);
+ procedure MouseExit(Sender: TObject);
+ procedure TimerStep(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
published
- property EditBackgroundColor: Tfpgcolor read GetEditBackgroundColor write SetEditBackgroundColor default clBoxColor;
- property ButtonsBackgroundColor;
- property ButtonWidth;
- property TextColor: Tfpgcolor read GetTextColor write SetTextColor;
- property NegativeColor: TfpgColor read GetNegativeColor write SetNegativeColor;
- property ArrowUpColor;
- property ArrowDownColor;
- property FontDesc: string read GetFontDesc write SetFontDesc;
- property MaxValue: integer read FMaxValue write SetMaxValue default 100;
- property MinValue: integer read FMinValue write SetMinValue default 0;
- property Increment: integer read FIncrement write SetIncrement default 1;
- property LargeIncrement: integer read FLargeIncrement write SetLargeIncrement default 10;
- property Value: integer read FValue write SetValue default 0;
- property Hint;
- property TabOrder;
+ property EditBackgroundColor: Tfpgcolor read GetEditBackgroundColor write SetEditBackgroundColor default clBoxColor;
+ property ButtonsBackgroundColor;
+ property ButtonWidth;
+ property TextColor: Tfpgcolor read GetTextColor write SetTextColor;
+ property NegativeColor: TfpgColor read GetNegativeColor write SetNegativeColor;
+ property ArrowUpColor;
+ property ArrowDownColor;
+ property FontDesc: string read GetFontDesc write SetFontDesc;
+ property MaxValue: integer read FMaxValue write SetMaxValue default 100;
+ property MinValue: integer read FMinValue write SetMinValue default 0;
+ property Increment: integer read FIncrement write SetIncrement default 1;
+ property LargeIncrement: integer read FLargeIncrement write SetLargeIncrement default 10;
+ property Value: integer read FValue write SetValue default 0;
+ property Hint;
+ property TabOrder;
property OnChange;
property OnEnter;
property OnExit;
@@ -238,7 +238,8 @@ function CreateSpinEditFloat(AOwner: TComponent; x, y, w, h: TfpgCoord;
AFixedDecimals: integer = 1; AValue: extended = 0; ADecimals: integer = -1): TfpgSpinEditFloat;
function CreateSpinEdit(AOwner: TComponent; x, y, w, h: TfpgCoord; AMinValue: integer = 0;
AMaxValue: integer = 100; AIncrement: integer = 1; ALargeIncrement: integer = 10;
- AValue: integer = 0): TfpgSpinEdit;
+ AValue: integer = 0): TfpgSpinEdit; overload;
+function CreateSpinEdit(AOwner: TComponent; x, y, w: TfpgCoord; AOnChangeEvent: TNotifyEvent = nil): TfpgSpinEdit; overload;
implementation
@@ -299,6 +300,15 @@ begin
Result.Value := AValue;
end;
+function CreateSpinEdit(AOwner: TComponent; x, y, w: TfpgCoord; AOnChangeEvent: TNotifyEvent): TfpgSpinEdit;
+begin
+ Result := TfpgSpinEdit.Create(AOwner);
+ Result.SetPosition(x, y, w, Result.Height);
+ if Assigned(AOnChangeEvent) then
+ Result.OnChange := AOnChangeEvent;
+ Result.UpdateWindowPosition;
+end;
+
{ TfpgAbstractSpinEdit }
@@ -427,6 +437,7 @@ end;
constructor TfpgAbstractSpinEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
+ FHeight := 24;
FButtonWidth := 13; // width of spin buttons
Shape := bsSpacer;
diff --git a/src/gui/fpg_tab.pas b/src/gui/fpg_tab.pas
index 8846a7e1..5f0e7fbf 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 - 2014 See the file AUTHORS.txt, included in this
+ Copyright (C) 2006 - 2015 See the file AUTHORS.txt, included in this
distribution, for details of the copyright.
See the file COPYING.modifiedLGPL, included in this distribution,
@@ -55,6 +55,8 @@ type
FPageControl: TfpgPageControl;
FText: string;
FTabVisible: boolean;
+ FTabColor: TfpgColor;
+ FTabTextColor: TfpgColor;
function GetPageControl: TfpgPageControl;
function GetPageIndex: Integer;
function GetText: string;
@@ -72,6 +74,8 @@ type
property PageIndex: Integer read GetPageIndex write SetPageIndex;
property PageControl: TfpgPageControl read FPageControl write SetPageControl;
property TabVisible: boolean read FTabVisible write FTabVisible;
+ property TabColor: Tfpgcolor read FTabColor write FTabColor;
+ property TabTextColor: TfpgColor read FTabTextColor write FTabTextColor;
published
property BackgroundColor;
property Enabled;
@@ -105,6 +109,7 @@ type
FLastRClickPos: TfpgPoint;
FUpdateCount: Integer;
FActiveTabColor: TfpgColor;
+ FActiveTabTextColor: TfpgColor;
function GetActivePageIndex: integer;
function GetPage(AIndex: integer): TfpgTabSheet;
function GetPageCount: Integer;
@@ -130,10 +135,12 @@ type
procedure SetTabPosition(const AValue: TfpgTabPosition);
procedure DoPageChange(ATabSheet: TfpgTabSheet);
procedure DoTabSheetClosing(ATabSheet: TfpgTabSheet);
- function DrawTab(const rect: TfpgRect; const Selected: Boolean = False; const Mode: Integer = 1): TfpgRect;
+ function DrawTab(const ATabSheet: TfpgTabSheet; const rect: TfpgRect; const Selected: Boolean = False; const Mode: Integer = 1): TfpgRect;
procedure pmCloseTab(Sender: TObject);
function GetActiveTabColor: TfpgColor;
procedure SetActiveTabColor(AValue: TfpgColor);
+ function GetActiveTabTextColor: TfpgColor;
+ procedure SetActiveTabTextColor(AValue: TfpgColor);
protected
procedure SetBackgroundColor(const AValue: TfpgColor); override;
procedure OrderSheets; // currently using bubblesort
@@ -159,7 +166,8 @@ type
property OnClosingTabSheet: TTabSheetClosing read FOnClosingTabSheet write FOnClosingTabSheet;
published
property ActivePageIndex: integer read GetActivePageIndex write SetActivePageIndex default 0;
- property ActiveTabColor: TfpgColor read GetActiveTabColor write SetActiveTabColor default clWindowBackground;
+ property ActiveTabColor: TfpgColor read GetActiveTabColor write SetActiveTabColor default clDefault;
+ property ActiveTabTextColor: TfpgColor read GetActiveTabTextColor write SetActiveTabTextColor default clDefault;
property Align;
property BackgroundColor;
property Enabled;
@@ -183,11 +191,6 @@ implementation
uses
fpg_stringutils;
-const
- DFL_TAB_HEIGHT = 21;
- DFL_TAB_WIDTH = 0;
-
-
// compare function used by FPages.Sort
function SortCompare(Item1, Item2: Pointer): integer;
@@ -262,6 +265,7 @@ begin
FTabVisible:= True;
FFocusable := True;
FBackgroundColor := Parent.BackgroundColor;
+ FTabColor := Parent.BackgroundColor;
FTextColor := Parent.TextColor;
FIsContainer := True;
end;
@@ -409,7 +413,6 @@ var
wd: integer; { width delta }
h: integer;
hd: integer; { height delta }
- msg: TfpgMessageParams;
begin
// PageControl has bevelled edges in some themes
r := fpgStyle.GetControlFrameBorders;
@@ -662,10 +665,22 @@ begin
end;
{ Mode = 1 means the background tabs. Mode = 2 means the Active Tab }
-function TfpgPageControl.DrawTab(const rect: TfpgRect; const Selected: Boolean = False; const Mode: Integer = 1): TfpgRect;
+function TfpgPageControl.DrawTab(const ATabSheet: TfpgTabSheet; const rect: TfpgRect; const Selected: Boolean = False;
+ const Mode: Integer = 1): TfpgRect;
var
r: TfpgRect;
+
+ procedure ApplyCorrectTabColorToCanvas;
+ begin
+ if ActiveTabColor = clDefault then
+ Canvas.SetColor(ATabSheet.TabColor)
+ else
+ Canvas.SetColor(ActiveTabColor);
+ end;
+
begin
+ if not Assigned(ATabSheet) then
+ raise Exception.Create('DrawTab parameter error. ATabSheet may not be nil.');
r := rect;
if Selected then
begin
@@ -679,10 +694,10 @@ begin
r.Height -= 1;
if TabPosition = tpBottom then
r.Top += 1;
- Canvas.SetColor(ActiveTabColor);
+ ApplyCorrectTabColorToCanvas;
end
else
- Canvas.SetColor(BackgroundColor);
+ Canvas.SetColor(ATabSheet.TabColor);
case TabPosition of
tpTop:
@@ -714,7 +729,7 @@ begin
Canvas.DrawLine(r.Right, r.Bottom-2, r.Right, r.Top-1); // right outer edge
if Mode = 2 then { selected tab }
begin
- Canvas.SetColor(ActiveTabColor);
+ ApplyCorrectTabColorToCanvas;
Canvas.DrawLine(r.Left+1, r.Top-1, r.Right-1, r.Top-1);
end;
end;
@@ -794,6 +809,20 @@ begin
end;
end;
+function TfpgPageControl.GetActiveTabTextColor: TfpgColor;
+begin
+ Result := FActiveTabTextColor;
+end;
+
+procedure TfpgPageControl.SetActiveTabTextColor(AValue: TfpgColor);
+begin
+ if FActiveTabTextColor <> AValue then
+ begin
+ FActiveTabTextColor := AValue;
+ RePaint;
+ end;
+end;
+
procedure TfpgPageControl.SetBackgroundColor(const AValue: TfpgColor);
var
lWasMatch: boolean;
@@ -820,10 +849,17 @@ var
h: TfpgTabSheet;
lp: integer;
toffset: integer;
- TextLeft, TextTop: Integer;
- dx: integer;
lTxtFlags: TfpgTextFlags;
ActivePageVisible: Boolean;
+
+ procedure ApplyCorrectTabTextColorToCanvas(ATab: TfpgTabSheet);
+ begin
+ if ActiveTabTextColor = clDefault then
+ Canvas.SetTextColor(ATab.TabTextColor)
+ else
+ Canvas.SetTextColor(ActiveTabTextColor);
+ end;
+
begin
if not HasHandle then
Exit; //==>
@@ -831,10 +867,10 @@ begin
if PageCount = 0 then
Exit; //==>
- TabW:=FixedTabWidth;
- TabH:=FixedTabHeight;
+ TabW := FixedTabWidth;
+ TabH := FixedTabHeight;
ActivePageVisible := false;
- If TabH = 0 then
+ if TabH <= 1 then
TabH := TAB_HEIGHT;
h := TfpgTabSheet(FPages.First);
if h = nil then
@@ -845,7 +881,6 @@ begin
if not Enabled then
Include(lTxtFlags, txtDisabled);
-
if TabPosition in [tpTop, tpBottom] then
begin
if MaxButtonWidthSum > (Width-(FMargin*2)) then
@@ -944,12 +979,14 @@ begin
end;
// paint tab button
r2.Width := ButtonWidth(h.Text);
- r3 := DrawTab(r2, h = ActivePage);
+ r3 := DrawTab(h, r2, h = ActivePage);
// paint text on non-active tabs
if h <> ActivePage then
+ begin
+ Canvas.SetTextColor(h.TabTextColor);
Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - fpgStyle.DefaultFont.TextWidth(GetTabText(h.Text)) div 2,
Height-TabH+toffset, GetTabText(h.Text), lTxtFlags);
-
+ end;
r2.Left := r2.Left + r2.Width;
lp := lp + ButtonWidth(h.Text);
if h <> TfpgTabSheet(FPages.Last) then
@@ -963,8 +1000,11 @@ begin
r2.Width := Width;
r2.Height := Height - TabH;
Canvas.DrawButtonFace(r2, []);
+
// Draw text of ActivePage, because we didn't before.
- DrawTab(r3, false, 2);
+ h := self.ActivePage;
+ DrawTab(h, r3, false, 2);
+ ApplyCorrectTabTextColorToCanvas(h);
Canvas.DrawText(r3.Left+4, r3.Top+5, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
end;
@@ -988,11 +1028,14 @@ begin
end;
// paint tab button
r2.Width := ButtonWidth(h.Text);
- r3 := DrawTab(r2, h = ActivePage);
+ r3 := DrawTab(h, r2, h = ActivePage);
// paint text on non-active tabs
if h <> ActivePage then
+ begin
+ Canvas.SetTextColor(h.TabTextColor);
Canvas.DrawText(lp + (ButtonWidth(h.Text) div 2) - fpgStyle.DefaultFont.TextWidth(GetTabText(h.Text)) div 2,
FMargin+toffset, GetTabText(h.Text), lTxtFlags);
+ end;
r2.Left := r2.Left + r2.Width;
lp := lp + ButtonWidth(h.Text);
if h <> TfpgTabSheet(FPages.Last) then
@@ -1008,7 +1051,9 @@ begin
Canvas.DrawButtonFace(r2, []);
// Draw text of ActivePage, because we didn't before.
- DrawTab(r3, false, 2);
+ h := self.ActivePage;
+ DrawTab(h, r3, false, 2);
+ ApplyCorrectTabTextColorToCanvas(h);
Canvas.DrawText(r3.Left+4, r3.Top+3, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
end;
@@ -1033,11 +1078,14 @@ begin
h.SetPosition(FMargin+2, FMargin+2, Width - ((FMargin+2)*2) - TabW, Height - ((FMargin+2)*2));
end;
// paint tab button
- r3 := DrawTab(r2, h = ActivePage);
+ r3 := DrawTab(h, r2, h = ActivePage);
// paint text on non-active tabs
if h <> ActivePage then
+ begin
+ Canvas.SetTextColor(h.TabTextColor);
Canvas.DrawText(r2.left+toffset, r2.Top, r2.Width, r2.Height, GetTabText(h.Text), lTxtFlags);
+ end;
r2.Top += r2.Height;
lp := r2.Top;
if h <> TfpgTabSheet(FPages.Last) then
@@ -1053,7 +1101,9 @@ begin
Canvas.DrawButtonFace(r2, []);
// Draw text of ActivePage, because we didn't before.
- DrawTab(r3, false, 2);
+ h := self.ActivePage;
+ DrawTab(h, r3, false, 2);
+ ApplyCorrectTabTextColorToCanvas(h);
Canvas.DrawText(r3.left+toffset, r3.Top, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
end;
@@ -1078,11 +1128,14 @@ begin
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);
+ r3 := DrawTab(h, r2, h = ActivePage);
// paint text on non-active tabs
if h <> ActivePage then
+ begin
+ Canvas.SetTextColor(h.TabTextColor);
Canvas.DrawText(r2.left+toffset, r2.Top, r2.Width, r2.Height, GetTabText(h.Text), lTxtFlags);
+ end;
r2.Top += r2.Height;
lp := r2.Top;
if h <> TfpgTabSheet(FPages.Last) then
@@ -1098,7 +1151,9 @@ begin
Canvas.DrawButtonFace(r2, []);
// Draw text of ActivePage, because we didn't before.
- DrawTab(r3, false, 2);
+ h := self.ActivePage;
+ DrawTab(h, r3, false, 2);
+ ApplyCorrectTabTextColorToCanvas(h);
Canvas.DrawText(r3.left+toffset, r3.Top, r3.Width, r3.Height, ActivePage.Text, lTxtFlags);
end;
end; { case }
@@ -1188,26 +1243,24 @@ var
i: integer;
begin
i := ActivePageIndex;
- if ssAlt in shiftstate then
- case keycode of
- keyLeft:
- begin
- if ActivePage <> TfpgTabSheet(FPages.First) then
- begin
- ActivePage := TfpgTabSheet(FPages[i-1]);
- consumed := True;
- end;
- end;
- keyRight:
- begin
- if ActivePage <> TfpgTabSheet(FPages.Last) then
- begin
- ActivePage := TfpgTabSheet(FPages[i+1]);
- consumed := True;
- end;
- end;
- end; { case/else }
+ if (shiftstate = [ssCtrl]) and (keycode = keyTab) then
+ begin
+ consumed := True;
+ if ActivePage <> TfpgTabSheet(FPages.Last) then
+ ActivePage := TfpgTabSheet(FPages[i+1])
+ else
+ ActivePage := TfpgTabSheet(FPages.First); // loop back to the front
+ end
+ else if (shiftstate = [ssCtrl, ssShift]) and (keycode = keyTab) then
+ begin
+ consumed := True;
+ if ActivePage <> TfpgTabSheet(FPages.First) then
+ ActivePage := TfpgTabSheet(FPages[i-1])
+ else
+ ActivePage := TfpgTabSheet(FPages.Last); // loop back to the end
+ end;
+
if not consumed then
inherited HandleKeyPress(keycode, shiftstate, consumed);
end;
@@ -1231,7 +1284,8 @@ begin
FTextColor := Parent.TextColor;
FBackgroundColor := Parent.BackgroundColor;
- FActiveTabColor := FBackgroundColor;
+ FActiveTabColor := clDefault;
+ FActiveTabTextColor := clDefault;
FFocusable := True;
FOnChange := nil;
FFixedTabWidth := 0;
diff --git a/src/gui/fpg_trackbar.pas b/src/gui/fpg_trackbar.pas
index 32da0b99..752ae132 100644
--- a/src/gui/fpg_trackbar.pas
+++ b/src/gui/fpg_trackbar.pas
@@ -480,7 +480,7 @@ var
d: integer;
area: integer;
newp: integer;
- ppos: integer;
+ //ppos: integer;
tw: TfpgCoord;
begin
inherited HandleMouseMove(x, y, btnstate, shiftstate);
@@ -506,7 +506,7 @@ begin
area := Width - FSliderLength-4-tw;
end;
- ppos := FSliderPos;
+ //ppos := FSliderPos;
FSliderPos := FSliderDragStart + d;
if FSliderPos < 0 then
diff --git a/src/gui/messagedialog.inc b/src/gui/messagedialog.inc
index db894f6d..7fea78e8 100644
--- a/src/gui/messagedialog.inc
+++ b/src/gui/messagedialog.inc
@@ -260,7 +260,6 @@ var
logo: TfpgImage;
i: integer;
y: integer;
- tw: integer;
begin
inherited HandlePaint;
case FDialogType of
diff --git a/src/gui/selectdirdialog.inc b/src/gui/selectdirdialog.inc
index 063c7972..857fb0a2 100644
--- a/src/gui/selectdirdialog.inc
+++ b/src/gui/selectdirdialog.inc
@@ -197,7 +197,6 @@ var
s: TfpgString;
dir: TfpgString;
i: integer;
- p: integer;
prevn, nextn: TfpgTreeNode;
begin
if AValue = '' then
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-26 05:49:21 +0000