You've already forked lazarus-ccr
b4fadb7ad8
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2658 8e941d3f-bd1b-0410-a28a-d453659cc2b4
463 lines
13 KiB
ObjectPascal
463 lines
13 KiB
ObjectPascal
unit gradtabstyle;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
{.$DEFINE DEBUGTAB}
|
|
|
|
{-------------------------------------
|
|
Style-Class for TGradTabControl
|
|
--------------------------------------}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Controls, Graphics, Buttons, ComCtrls, ExtCtrls, ugradbtn
|
|
{$IFDEF DEBUGTAB}
|
|
, sharedloggerlcl
|
|
{$ELSE}
|
|
, DummyLogger
|
|
{$ENDIF};
|
|
|
|
type
|
|
TStylePaintEvent = procedure(Sender: TCustomControl; AIndex: Integer;
|
|
Button: TGradButton; TargetCanvas: TCanvas; R: TRect;
|
|
BState : TButtonState) of object;
|
|
|
|
{ TGradTabStyleBase }
|
|
|
|
TStyleBaseOptions = set of (sbTabButton, sbLeftRightButton, sbBorderButton, sbCloseButton);
|
|
|
|
TGradTabStyleBase = class
|
|
private
|
|
FRoundedCorners: Boolean;
|
|
function GetHasCloseButtonPaint: Boolean;
|
|
function GetHasTabButtonPaint: Boolean;
|
|
function GetHasLeftRightButtonPaint: Boolean;
|
|
function GetHasBorderButtonPaint: Boolean;
|
|
protected
|
|
FTheTabControl: TCustomControl;
|
|
FOptions : TStyleBaseOptions;
|
|
public
|
|
constructor Create; virtual;
|
|
procedure TabControl(Sender: TCustomControl;
|
|
TargetCanvas: TCanvas); virtual; abstract;
|
|
procedure TabButton(Sender: TCustomControl; AIndex: Integer;
|
|
Button: TGradButton; TargetCanvas: TCanvas; R: TRect; BState : TButtonState); virtual; abstract;
|
|
procedure TabCloseButton(Sender: TCustomControl; AIndex: Integer;
|
|
Button: TGradButton; TargetCanvas: TCanvas; R: TRect; BState : TButtonState); virtual; abstract;
|
|
procedure TabButtonBorder(Sender: TCustomControl; AIndex: Integer;
|
|
Button: TGradButton; TargetCanvas: TCanvas; R: TRect; BState : TButtonState); virtual; abstract;
|
|
procedure TabLeftRightButton(Sender: TGradButton; TargetCanvas: TCanvas; R: TRect; BState : TButtonState); virtual; abstract;
|
|
procedure TabLeftRightBorderButton(Sender: TGradButton; TargetCanvas: TCanvas; R: TRect; BState : TButtonState); virtual; abstract;
|
|
procedure PrepareButton(Button: TGradButton); virtual;
|
|
property TheTabControl : TCustomControl read FTheTabControl write FTheTabControl;
|
|
property HasTabButtonPaint : Boolean read GetHasTabButtonPaint;
|
|
property HasLeftRightButtonPaint : Boolean read GetHasLeftRightButtonPaint;
|
|
property HasBorderButtonPaint : Boolean read GetHasBorderButtonPaint;
|
|
property HasCloseButtonPaint : Boolean read GetHasCloseButtonPaint;
|
|
property RoundedCorners : Boolean read FRoundedCorners write FRoundedCorners;
|
|
end;
|
|
|
|
{ TGradTabStandardStyle }
|
|
|
|
TGradTabStandardStyle = class(TGradTabStyleBase)
|
|
public
|
|
procedure TabControl(Sender: TCustomControl; TargetCanvas: TCanvas);
|
|
override;
|
|
end;
|
|
|
|
{ TGradTabVistaStyle }
|
|
|
|
TButtonVistaStyle = record
|
|
BorderColor : TColor;
|
|
InnerBorderColor : TColor;
|
|
TopStartColor : TColor;
|
|
TopStopColor : TColor;
|
|
BottomStartColor : TColor;
|
|
BottomStopColor : TColor;
|
|
end;
|
|
|
|
TGradTabVistaStyle = class(TGradTabStyleBase)
|
|
protected
|
|
Normal : TButtonVistaStyle;
|
|
Hover : TButtonVistaStyle;
|
|
ActiveButton : TButtonVistaStyle;
|
|
public
|
|
constructor Create; override;
|
|
procedure TabControl(Sender: TCustomControl; TargetCanvas: TCanvas);
|
|
override;
|
|
procedure TabButton(Sender: TCustomControl; AIndex: Integer;
|
|
Button: TGradButton; TargetCanvas: TCanvas; R: TRect; BState : TButtonState); override;
|
|
procedure TabCloseButton(Sender: TCustomControl; AIndex: Integer;
|
|
Button: TGradButton; TargetCanvas: TCanvas; R: TRect; BState: TButtonState); override;
|
|
procedure TabButtonBorder(Sender: TCustomControl; AIndex: Integer;
|
|
Button: TGradButton; TargetCanvas: TCanvas; R: TRect; BState : TButtonState); override;
|
|
procedure TabLeftRightButton(Sender: TGradButton; TargetCanvas: TCanvas;
|
|
R: TRect; BState: TButtonState); override;
|
|
procedure TabLeftRightBorderButton(Sender: TGradButton; TargetCanvas: TCanvas;
|
|
R: TRect; BState: TButtonState); override;
|
|
procedure PrepareButton(Button: TGradButton); override;
|
|
end;
|
|
|
|
{ TGradTabVistaBlueStyle }
|
|
|
|
TGradTabVistaBlueStyle = class(TGradTabVistaStyle)
|
|
public
|
|
constructor Create; override;
|
|
end;
|
|
|
|
procedure LoggerButtonVistaStyle(Self: TButtonVistaStyle; Name: String);
|
|
|
|
implementation
|
|
|
|
uses
|
|
ugradtabcontrol, LCLProc;
|
|
|
|
procedure LoggerButtonVistaStyle(Self: TButtonVistaStyle; Name: String);
|
|
procedure C(aName: String; aColor: TColor);
|
|
begin
|
|
Logger.Send(aName, ColorToString(aColor));
|
|
end;
|
|
|
|
begin
|
|
Logger.EnterMethod('Style: '+ Name);
|
|
|
|
C('BorderColor', Self.BorderColor);
|
|
C('InnerBorderColor', Self.InnerBorderColor);
|
|
C('TopStartColor', Self.TopStartColor);
|
|
C('TopStopColor', Self.TopStopColor);
|
|
C('BottomStartColor', Self.BottomStartColor);
|
|
C('BottomStopColor', Self.BottomStopColor);
|
|
|
|
Logger.ExitMethod('Style');
|
|
end;
|
|
|
|
{ TGradTabStyleBase }
|
|
|
|
function TGradTabStyleBase.GetHasCloseButtonPaint: Boolean;
|
|
begin
|
|
Result := sbCloseButton in FOptions;
|
|
end;
|
|
|
|
function TGradTabStyleBase.GetHasTabButtonPaint: Boolean;
|
|
begin
|
|
Result := sbTabButton in FOptions;
|
|
end;
|
|
|
|
function TGradTabStyleBase.GetHasLeftRightButtonPaint: Boolean;
|
|
begin
|
|
Result := sbLeftRightButton in FOptions;
|
|
end;
|
|
|
|
function TGradTabStyleBase.GetHasBorderButtonPaint: Boolean;
|
|
begin
|
|
Result := sbBorderButton in FOptions;
|
|
end;
|
|
|
|
constructor TGradTabStyleBase.Create;
|
|
begin
|
|
FOptions:= [];
|
|
|
|
FRoundedCorners := true;
|
|
end;
|
|
|
|
procedure TGradTabStyleBase.PrepareButton(Button: TGradButton);
|
|
begin
|
|
// nothing
|
|
end;
|
|
|
|
{ TGradTabStandardStyle }
|
|
|
|
procedure TGradTabStandardStyle.TabControl(Sender: TCustomControl;
|
|
TargetCanvas: TCanvas);
|
|
var
|
|
AClientRect : TRect;
|
|
begin
|
|
TargetCanvas.Brush.Color:=Sender.Color;
|
|
TargetCanvas.FillRect(0,0,Sender.Width, Sender.Height);
|
|
|
|
TargetCanvas.Pen.Color:=clBlack;
|
|
|
|
AClientRect := (Sender as TGradTabControl).GetClientRect;
|
|
|
|
TargetCanvas.Rectangle(AClientRect.Left-2, AClientRect.Top-2,
|
|
AClientRect.Right+2, AClientRect.Bottom+2);
|
|
end;
|
|
|
|
{ TGradTabVistaStyle }
|
|
|
|
constructor TGradTabVistaStyle.Create;
|
|
begin
|
|
inherited Create;
|
|
|
|
FOptions:=[sbTabButton, sbBorderButton, sbCloseButton, sbLeftRightButton];
|
|
|
|
with Normal do
|
|
begin
|
|
BorderColor:=TColor($8b8c90);
|
|
InnerBorderColor:= TColor($fbfcff);
|
|
TopStartColor := TColor($f2f2f2);
|
|
TopStopColor := TColor($ebebeb);
|
|
BottomStartColor := TColor($dddddb);
|
|
BottomStopColor := TColor($cfcfcf);
|
|
end;
|
|
|
|
with Hover do
|
|
begin
|
|
BorderColor:=RGBToColor(85, 121, 145);
|
|
InnerBorderColor:= RGBToColor(224, 255, 255);
|
|
TopStartColor := RGBToColor(233, 246, 254);
|
|
TopStopColor := RGBToColor(219, 238, 252);
|
|
BottomStartColor := RGBToColor(190, 231, 253);
|
|
BottomStopColor := RGBToColor(167, 217, 244);
|
|
end;
|
|
|
|
with ActiveButton do
|
|
begin
|
|
BorderColor:=TColor($8b8c91);
|
|
InnerBorderColor:= TColor($FFFFFF);
|
|
TopStartColor := TColor($FFFFFF);
|
|
TopStopColor := TColor($FFFFFF);
|
|
BottomStartColor := TColor($FFFFFF);
|
|
BottomStopColor := TColor($FFFFFF);
|
|
end;
|
|
end;
|
|
|
|
procedure TGradTabVistaStyle.TabControl(Sender: TCustomControl;
|
|
TargetCanvas: TCanvas);
|
|
var
|
|
AClientRect : TRect;
|
|
begin
|
|
TargetCanvas.Brush.Color:=clWhite;
|
|
TargetCanvas.FillRect(0,0,Sender.Width, Sender.Height);
|
|
|
|
TargetCanvas.Pen.Color:=Normal.BorderColor;
|
|
|
|
AClientRect := (Sender as TGradTabControl).GetClientRect;
|
|
|
|
TargetCanvas.Rectangle(AClientRect.Left-2, AClientRect.Top-2,
|
|
AClientRect.Right+2, AClientRect.Bottom+2);
|
|
end;
|
|
|
|
procedure TGradTabVistaStyle.TabButton(Sender: TCustomControl; AIndex: Integer;
|
|
Button: TGradButton; TargetCanvas: TCanvas; R: TRect; BState : TButtonState);
|
|
var
|
|
ColorSet: TButtonVistaStyle;
|
|
UpperRect, LowerRect : TRect;
|
|
FGradTabControl : TGradTabControl;
|
|
FGradientDirection : TGradientDirection;
|
|
begin
|
|
FGradTabControl := nil;
|
|
|
|
if Sender <> nil then
|
|
FGradTabControl := Sender as TGradTabControl;
|
|
|
|
if (FGradTabControl <> nil)
|
|
and (AIndex = FGradTabControl.PageIndex) then
|
|
BState := bsDown;
|
|
|
|
case BState of
|
|
bsDown: ColorSet := ActiveButton;
|
|
bsHot: ColorSet := Hover;
|
|
else ColorSet := Normal;
|
|
end;
|
|
|
|
UpperRect := R;
|
|
UpperRect.Bottom:= UpperRect.Bottom div 2;
|
|
|
|
LowerRect := R;
|
|
LowerRect.Top := UpperRect.Bottom;
|
|
|
|
case FGradTabControl.TabPosition of
|
|
tpTop, tpBottom: FGradientDirection := gdVertical;
|
|
tpLeft, tpRight:
|
|
if FGradTabControl.LongTabs then
|
|
FGradientDirection := gdVertical
|
|
else
|
|
FGradientDirection := gdHorizontal;
|
|
end;
|
|
|
|
with TargetCanvas do
|
|
begin
|
|
GradientFill(UpperRect, ColorSet.TopStartColor,
|
|
ColorSet.TopStopColor, FGradientDirection);
|
|
GradientFill(LowerRect, ColorSet.BottomStartColor,
|
|
ColorSet.BottomStopColor, FGradientDirection);
|
|
end;
|
|
end;
|
|
|
|
procedure TGradTabVistaStyle.TabCloseButton(Sender: TCustomControl;
|
|
AIndex: Integer; Button: TGradButton; TargetCanvas: TCanvas; R: TRect;
|
|
BState: TButtonState);
|
|
var
|
|
FGradTabControl : TGradTabControl;
|
|
begin
|
|
FGradTabControl := nil;
|
|
|
|
if Sender <> nil then
|
|
FGradTabControl := Sender as TGradTabControl;
|
|
|
|
if (FGradTabControl <> nil)
|
|
and (AIndex <> FGradTabControl.PageIndex) then
|
|
BState := bsUp;
|
|
|
|
TabButton(Sender, AIndex, Button, TargetCanvas, R, BState);
|
|
end;
|
|
|
|
procedure TGradTabVistaStyle.TabButtonBorder(Sender: TCustomControl; AIndex: Integer;
|
|
Button: TGradButton; TargetCanvas: TCanvas; R: TRect; BState : TButtonState);
|
|
var
|
|
ColorSet: TButtonVistaStyle;
|
|
Temp : Integer;
|
|
begin
|
|
//DebugLn('Border R: ',DbgS(R));
|
|
|
|
case BState of
|
|
bsDown: ColorSet := ActiveButton;
|
|
bsHot: ColorSet := Hover;
|
|
else ColorSet := Normal;
|
|
end;
|
|
|
|
Temp := 0;
|
|
|
|
if not RoundedCorners then
|
|
begin
|
|
if R.Left > 0 then
|
|
R.Left := R.Left -1;
|
|
|
|
if R.Right < Button.Width then
|
|
R.Right := R.Right + 1;
|
|
|
|
if R.Top > 0 then
|
|
R.Top := R.Top - 1;
|
|
|
|
if R.Bottom < Button.Height then
|
|
R.Bottom := R.Bottom + 1;
|
|
|
|
Temp := 1;
|
|
end;
|
|
|
|
with Button do
|
|
begin
|
|
//Top
|
|
if (bsTopLine in BorderSides) then
|
|
begin
|
|
TargetCanvas.Pen.Color:=ColorSet.BorderColor;
|
|
TargetCanvas.Line(R.Left,0,R.Right,0);
|
|
TargetCanvas.Pen.Color:=ColorSet.InnerBorderColor;
|
|
TargetCanvas.Line(R.Left,1,R.Right,1);
|
|
end;
|
|
|
|
//Left
|
|
if (bsLeftLine in BorderSides) then
|
|
begin
|
|
TargetCanvas.Pen.Color:=ColorSet.BorderColor;
|
|
TargetCanvas.Line(0,R.Top,0,R.Bottom);
|
|
TargetCanvas.Pen.Color:=ColorSet.InnerBorderColor;
|
|
TargetCanvas.Line(1,R.Top,1,R.Bottom);
|
|
end;
|
|
|
|
//Right
|
|
if (bsRightLine in BorderSides) then
|
|
begin
|
|
TargetCanvas.Pen.Color:=ColorSet.BorderColor;
|
|
TargetCanvas.Line(Width-1,R.Top,Width-1,R.Bottom);
|
|
TargetCanvas.Pen.Color:=ColorSet.InnerBorderColor;
|
|
TargetCanvas.Line(Width-2,R.Top,Width-2,R.Bottom);
|
|
end;
|
|
|
|
//Bottom
|
|
if (bsBottomLine in BorderSides) then
|
|
begin
|
|
TargetCanvas.Pen.Color:=ColorSet.BorderColor;
|
|
TargetCanvas.Line(R.Left,Height-1,R.Right,Height-1);
|
|
TargetCanvas.Pen.Color:=ColorSet.InnerBorderColor;
|
|
TargetCanvas.Line(R.Left,Height-2,R.Right,Height-2);
|
|
end;
|
|
|
|
//TopLeft
|
|
if (bsTopLine in BorderSides) AND (bsLeftLine in BorderSides) then
|
|
TargetCanvas.Pixels[1-Temp,1-Temp]:=ColorSet.BorderColor;
|
|
|
|
//TopRight
|
|
if (bsTopLine in BorderSides) AND (bsRightLine in BorderSides) then
|
|
TargetCanvas.Pixels[Width-2+Temp,1-Temp] := ColorSet.BorderColor;
|
|
|
|
//BottomLeft
|
|
if (bsBottomLine in BorderSides) AND (bsLeftLine in BorderSides) then
|
|
TargetCanvas.Pixels[1-Temp, Height-2+Temp]:=ColorSet.BorderColor;
|
|
|
|
//BottomRight
|
|
if (bsBottomLine in BorderSides) AND (bsRightLine in BorderSides) then
|
|
TargetCanvas.Pixels[Width-2+Temp,Height-2+Temp]:=ColorSet.BorderColor;
|
|
end;
|
|
end;
|
|
|
|
procedure TGradTabVistaStyle.TabLeftRightButton(Sender: TGradButton;
|
|
TargetCanvas: TCanvas; R: TRect; BState: TButtonState);
|
|
begin
|
|
if BState = bsDown then
|
|
BState := bsHot;
|
|
|
|
if Sender.Font.Color = clWhite then
|
|
Sender.Font.Color := clBlack;
|
|
|
|
TabButton(Sender.Owner as TCustomControl, 0, Sender, TargetCanvas, R, BState);
|
|
end;
|
|
|
|
procedure TGradTabVistaStyle.TabLeftRightBorderButton(Sender: TGradButton;
|
|
TargetCanvas: TCanvas; R: TRect; BState: TButtonState);
|
|
begin
|
|
if BState = bsDown then
|
|
BState := bsHot;
|
|
|
|
TabButtonBorder(Sender.Owner as TCustomControl, 0, Sender, TargetCanvas, R, BState);
|
|
end;
|
|
|
|
procedure TGradTabVistaStyle.PrepareButton(Button: TGradButton);
|
|
begin
|
|
Button.Font.Color:=clBlack;
|
|
end;
|
|
|
|
{ TGradTabVistaBlueStyle }
|
|
|
|
constructor TGradTabVistaBlueStyle.Create;
|
|
begin
|
|
inherited Create;
|
|
|
|
with Normal do
|
|
begin
|
|
BorderColor:=RGBToColor(145, 150, 162); //#9196A2
|
|
InnerBorderColor:= RGBToColor(224, 255, 255);
|
|
TopStartColor := RGBToColor(252, 253, 254);
|
|
TopStopColor := RGBToColor(231, 235, 255);
|
|
BottomStartColor := RGBToColor(207, 215, 235);
|
|
BottomStopColor := RGBToColor(221, 227, 243);
|
|
end;
|
|
|
|
with Hover do
|
|
begin
|
|
BorderColor:=RGBToColor(145, 150, 162); //#9196A2
|
|
InnerBorderColor:= RGBToColor(224, 255, 255);
|
|
TopStartColor := RGBToColor(232, 240, 251);
|
|
TopStopColor := RGBToColor(184, 212, 244);
|
|
BottomStartColor := RGBToColor(115, 176, 232);
|
|
BottomStopColor := RGBToColor(173, 208, 241);
|
|
end;
|
|
|
|
with ActiveButton do
|
|
begin
|
|
BorderColor:=RGBToColor(145, 150, 162); //#9196A2
|
|
InnerBorderColor:= TColor($FFFFFF);
|
|
TopStartColor := RGBToColor(255, 245, 224); //#FFF5E0
|
|
TopStopColor := RGBToColor(255, 222, 147); //#FFDE93
|
|
BottomStartColor := RGBToColor(255, 184, 17); //#FFB811
|
|
BottomStopColor := RGBToColor(255, 213, 114);
|
|
end;
|
|
|
|
LoggerButtonVistaStyle(ActiveButton, 'ActiveButton');
|
|
end;
|
|
|
|
end.
|
|
|