pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

SpkToolbar: Add new pane property "Style". Update appearance editor. Minor refactoring of pane drawing code.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5350 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-11-14 16:13:10 +00:00
parent 812b1db7f8
commit b4cb2a0de2
4 changed files with 333 additions and 173 deletions
Download Patch File Download Diff File Expand all files Collapse all files

108
components/spktoolbar/SpkToolbar/spkt_Appearance.pas
View File

@ -18,6 +18,10 @@ uses Graphics, Classes, Forms, SysUtils,
SpkGUITools, SpkXMLParser, SpkXMLTools,
spkt_Dispatch, spkt_Exceptions, spkt_Const;
type
TSpkPaneStyle = (psRectangleFlat, psRectangleEtched, psRectangleRaised,
psDividerFlat, psDividerEtched, psDividerRaised);
type TSpkTabAppearance = class(TPersistent)
private
FDispatch : TSpkBaseAppearanceDispatch;
@ -67,14 +71,16 @@ type TSpkPaneAppearance = class(TPersistent)
FGradientFromColor : TColor;
FGradientToColor : TColor;
FGradientType : TBackgroundKind;
FStyle: TSpkPaneStyle;
procedure SetCaptionBgColor(const Value: TColor);
procedure SetCaptionFont(const Value: TFont);
procedure SetBorderDarkColor(const Value: TColor);
procedure SetBorderLightColor(const Value: TColor);
procedure SetGradientFromColor(const Value: TColor);
procedure SetGradientToColor(const Value: TColor);
procedure SetGradientType(const Value: TBackgroundKind);
procedure SetCaptionBgColor(const Value: TColor);
procedure SetStyle(const Value: TSpkPaneStyle);
public
procedure Assign(Source: TPersistent); override;
constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
@ -90,6 +96,7 @@ type TSpkPaneAppearance = class(TPersistent)
property GradientFromColor: TColor read FGradientFromColor write SetGradientFromColor;
property GradientToColor: TColor read FGradientToColor write SetGradientToColor;
property GradientType: TBackgroundKind read FGradientType write SetGradientType;
property Style: TSpkPaneStyle read FStyle write SetStyle default psRectangleEtched;
end;
type TSpkElementAppearance = class(TPersistent)
@ -414,6 +421,7 @@ begin
FGradientFromColor := SrcAppearance.GradientFromColor;
FGradientToColor := SrcAppearance.GradientToColor;
FGradientType := SrcAppearance.GradientType;
FStyle := SrcAppearance.Style;
if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged;
@ -426,6 +434,7 @@ begin
inherited Create;
FDispatch:=ADispatch;
FCaptionFont:=TFont.Create;
FStyle := psRectangleEtched;
Reset;
end;
@ -436,40 +445,43 @@ begin
end;
procedure TSpkPaneAppearance.LoadFromXML(Node: TSpkXMLNode);
var Subnode : TSpkXMLNode;
var
Subnode: TSpkXMLNode;
begin
if not(assigned(Node)) then
if not(Assigned(Node)) then
exit;
Subnode:=Node['CaptionFont',false];
if assigned(Subnode) then
Subnode := Node['CaptionFont', false];
if Assigned(Subnode) then
TSpkXMLTools.Load(Subnode, FCaptionFont);
Subnode:=Node['BorderDarkColor',false];
if assigned(Subnode) then
FBorderDarkColor:=Subnode.TextAsColor;
Subnode := Node['BorderDarkColor', false];
if Assigned(Subnode) then
FBorderDarkColor := Subnode.TextAsColor;
Subnode:=Node['BorderLightColor',false];
if assigned(Subnode) then
FBorderLightColor:=Subnode.TextAsColor;
Subnode := Node['BorderLightColor', false];
if Assigned(Subnode) then
FBorderLightColor := Subnode.TextAsColor;
Subnode:=Node['CaptionBgColor',false];
if assigned(Subnode) then
FCaptionBgColor:=Subnode.TextAsColor;
Subnode := Node['CaptionBgColor', false];
if Assigned(Subnode) then
FCaptionBgColor := Subnode.TextAsColor;
Subnode:=Node['GradientFromColor',false];
if assigned(Subnode) then
FGradientFromColor:=Subnode.TextAsColor;
Subnode := Node['GradientFromColor', false];
if Assigned(Subnode) then
FGradientFromColor := Subnode.TextAsColor;
Subnode:=Node['GradientToColor',false];
if assigned(Subnode) then
FGradientToColor:=Subnode.TextAsColor;
Subnode := Node['GradientToColor', false];
if Assigned(Subnode) then
FGradientToColor := Subnode.TextAsColor;
Subnode:=Node['GradientType',false];
if assigned(Subnode) then
FGradientType:=TBackgroundKind(Subnode.TextAsInteger);
Subnode := Node['GradientType', false];
if assigned(Subnode) then
FGradientType := TBackgroundKind(Subnode.TextAsInteger);
Subnode := Node['Style', false];
if Assigned(Subnode) then
FStyle := TSpkPaneStyle(SubNode.TextAsInteger);
end;
procedure TSpkPaneAppearance.Reset;
@ -510,36 +522,39 @@ begin
FGradientFromColor := rgb(222, 232, 245);
FGradientToColor := rgb(199, 216, 237);
FGradientType := bkConcave;
FStyle := psRectangleEtched;
end;
procedure TSpkPaneAppearance.SaveToXML(Node: TSpkXMLNode);
var Subnode : TSpkXMLNode;
var
Subnode: TSpkXMLNode;
begin
if not(assigned(Node)) then
if not(Assigned(Node)) then
exit;
Subnode:=Node['CaptionFont',true];
TSpkXMLTools.Save(Subnode, FCaptionFont);
Subnode := Node['CaptionFont',true];
TSpkXMLTools.Save(Subnode, FCaptionFont);
Subnode:=Node['BorderDarkColor',true];
Subnode.TextAsColor:=FBorderDarkColor;
Subnode := Node['BorderDarkColor',true];
Subnode.TextAsColor := FBorderDarkColor;
Subnode:=Node['BorderLightColor',true];
Subnode.TextAsColor:=FBorderLightColor;
Subnode := Node['BorderLightColor',true];
Subnode.TextAsColor := FBorderLightColor;
Subnode:=Node['CaptionBgColor',true];
Subnode.TextAsColor:=FCaptionBgColor;
Subnode := Node['CaptionBgColor',true];
Subnode.TextAsColor := FCaptionBgColor;
Subnode:=Node['GradientFromColor',true];
Subnode.TextAsColor:=FGradientFromColor;
Subnode := Node['GradientFromColor',true];
Subnode.TextAsColor := FGradientFromColor;
Subnode:=Node['GradientToColor',true];
Subnode.TextAsColor:=FGradientToColor;
Subnode := Node['GradientToColor',true];
Subnode.TextAsColor := FGradientToColor;
Subnode:=Node['GradientType',true];
Subnode.TextAsInteger:=integer(FGradientType);
Subnode := Node['GradientType',true];
Subnode.TextAsInteger := integer(FGradientType);
Subnode := Node['Style', true];
Subnode.TextAsInteger := integer(FStyle);
end;
procedure TSpkPaneAppearance.SetBorderDarkColor(const Value: TColor);
@ -591,6 +606,13 @@ begin
FDispatch.NotifyAppearanceChanged;
end;
procedure TSpkPaneAppearance.SetStyle(const Value: TSpkPaneStyle);
begin
FStyle := Value;
if FDispatch <> nil then
FDispatch.NotifyAppearanceChanged;
end;
{ TSpkElementAppearance }

209
components/spktoolbar/SpkToolbar/spkt_Pane.pas
View File

@ -224,23 +224,23 @@ begin
end;
procedure TSpkPane.Draw(ABuffer: TBitmap; ClipRect: T2DIntRect);
var x: Integer;
var
x: Integer;
y: Integer;
BgFromColor, BgToColor, CaptionColor, FontColor, BorderLightColor,
BorderDarkColor : TColor;
BgFromColor, BgToColor, CaptionColor: TColor;
FontColor, BorderLightColor, BorderDarkColor, c: TColor;
i: Integer;
R: T2DIntRect;
begin
// W niektórych warunkach nie jesteœmy w stanie rysowaæ:
// * Brak dyspozytora
if FToolbarDispatch=nil then
// W niektórych warunkach nie jesteœmy w stanie rysowaæ:
// * Brak dyspozytora
if FToolbarDispatch = nil then
exit;
// * Brak appearance
if FAppearance=nil then
// * Brak appearance
if FAppearance = nil then
exit;
if FPaneState = psIdle then
if FPaneState = psIdle then
begin
// psIdle
BgFromColor:=FAppearance.Pane.GradientFromColor;
@ -260,38 +260,41 @@ if FPaneState = psIdle then
BorderDarkColor:=TColorTools.Brighten(FAppearance.Pane.BorderDarkColor,20);
end;
// T³o
TGuiTools.DrawRoundRect(ABuffer.Canvas,
// T³o
{$IFDEF EnhancedRecordSupport}
T2DIntRect.Create(FRect.left,
FRect.top,
FRect.right - PaneBorderHalfSize,
FRect.Bottom - PaneBorderHalfSize),
R := T2DIntRect.Create(
{$ELSE}
Create2DIntRect(FRect.left,
FRect.top,
FRect.right - PaneBorderHalfSize,
FRect.Bottom - PaneBorderHalfSize),
R := Create2DIntRect(
{$ENDIF}
FRect.Left,
FRect.Top,
FRect.Right - PaneBorderHalfSize,
FRect.Bottom - PaneBorderHalfSize
);
TGuiTools.DrawRoundRect(
ABuffer.Canvas,
R,
PaneCornerRadius,
BgFromColor,
BgToColor,
FAppearance.Pane.GradientType,
ClipRect);
ClipRect
);
// T³o etykiety tafli
TGuiTools.DrawRoundRect(ABuffer.Canvas,
// T³o etykiety tafli
{$IFDEF EnhancedRecordSupport}
T2DIntRect.Create(FRect.Left,
FRect.Bottom - PaneCaptionHeight - PaneBorderHalfSize,
FRect.right - PaneBorderHalfSize,
FRect.bottom - PaneBorderHalfSize),
R := T2DIntRect.Create(
{$ELSE}
Create2DIntRect(FRect.Left,
R := Create2DIntRect(
{$ENDIF}
FRect.Left,
FRect.Bottom - PaneCaptionHeight - PaneBorderHalfSize,
FRect.Right - PaneBorderHalfSize,
FRect.Bottom - PaneBorderHalfSize),
{$ENDIF}
FRect.Bottom - PaneBorderHalfSize
);
TGuiTools.DrawRoundRect(
ABuffer.Canvas,
R,
PaneCornerRadius,
CaptionColor,
clNone,
@ -300,60 +303,130 @@ TGuiTools.DrawRoundRect(ABuffer.Canvas,
false,
false,
true,
true);
true
);
// Etykieta tafli
ABuffer.Canvas.Font.assign(FAppearance.Pane.CaptionFont);
x:=FRect.left + (FRect.width - ABuffer.Canvas.TextWidth(FCaption)) div 2;
y:=FRect.Bottom - PaneBorderSize - PaneCaptionHeight + 1 +
// Etykieta tafli
ABuffer.Canvas.Font.Assign(FAppearance.Pane.CaptionFont);
x := FRect.Left + (FRect.Width - ABuffer.Canvas.TextWidth(FCaption)) div 2;
y := FRect.Bottom - PaneBorderSize - PaneCaptionHeight + 1 +
(PaneCaptionHeight - ABuffer.Canvas.TextHeight('Wy')) div 2;
TGUITools.DrawText(ABuffer.Canvas,
TGUITools.DrawText(
ABuffer.Canvas,
x,
y,
FCaption,
FontColor,
ClipRect);
ClipRect
);
// Ramki
TGUITools.DrawAARoundFrame(ABuffer,
// Frames
case FAppearance.Pane.Style of
psRectangleFlat:
begin
{$IFDEF EnhancedRecordSupport}
T2DIntRect.create(FRect.left+1,
FRect.top+1,
FRect.Right,
FRect.bottom),
R := T2DIntRect.Create(
{$ELSE}
Create2DIntRect(FRect.left+1,
FRect.top+1,
R := Create2DIntRect(
{$ENDIF}
FRect.Left,
FRect.Top,
FRect.Right,
FRect.bottom),
{$ENDIF}
PaneCornerRadius,
BorderLightColor,
ClipRect);
TGUITools.DrawAARoundFrame(ABuffer,
{$IFDEF EnhancedRecordSupport}
T2DIntRect.create(FRect.left,
FRect.top,
FRect.Right-1,
FRect.bottom-1),
{$ELSE}
Create2DIntRect(FRect.left,
FRect.top,
FRect.Right-1,
FRect.bottom-1),
{$ENDIF}
FRect.bottom
);
TGUITools.DrawAARoundFrame(
ABuffer,
R,
PaneCornerRadius,
BorderDarkColor,
ClipRect);
ClipRect
);
end;
// Elementy
if FItems.Count>0 then
for i := 0 to FItems.Count - 1 do
psRectangleEtched, psRectangleRaised:
begin
{$IFDEF EnhancedRecordSupport}
R := T2DIntRect.Create(
{$ELSE}
R := Create2DIntRect(
{$ENDIF}
FRect.Left + 1,
FRect.Top + 1,
FRect.Right,
FRect.bottom
);
if FAppearance.Pane.Style = psRectangleEtched then
c := BorderLightColor else
c := BorderDarkColor;
TGUITools.DrawAARoundFrame(
ABuffer,
R,
PaneCornerRadius,
c,
ClipRect
);
{$IFDEF EnhancedRecordSupport}
R := T2DIntRect.Create(
{$ELSE}
R := Create2DIntRect(
{$ENDIF}
FRect.Left,
FRect.Top,
FRect.Right-1,
FRect.Bottom-1
);
if FAppearance.Pane.Style = psRectangleEtched then
c := BorderDarkColor else
c := BorderLightColor;
TGUITools.DrawAARoundFrame(
ABuffer,
R,
PaneCornerRadius,
c,
ClipRect
);
end;
psDividerRaised, psDividerEtched:
begin
if FAppearance.Pane.Style = psDividerRaised then
c := BorderLightColor else
c := BorderDarkColor;
TGUITools.DrawVLine(
ABuffer,
FRect.Right + PaneBorderHalfSize - 1,
FRect.Top,
FRect.Bottom,
c
);
if FAppearance.Pane.Style = psDividerRaised then
c := BorderDarkColor else
c := BorderLightColor;
TGUITools.DrawVLine(
ABuffer,
FRect.Right + PaneBorderHalfSize,
FRect.Top,
FRect.Bottom,
c
);
end;
psDividerFlat:
TGUITools.DrawVLine(
ABuffer,
FRect.Right + PaneBorderHalfSize,
FRect.Top,
FRect.Bottom,
BorderDarkColor
);
end;
// Elementy
for i := 0 to FItems.Count - 1 do
if FItems[i].Visible then
Fitems[i].Draw(ABuffer, ClipRect);
end;
end;
function TSpkPane.FindItemAt(x, y : integer) : integer;

51
components/spktoolbar/designtime/spkte_AppearanceEditor.lfm
View File

@ -9,8 +9,10 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
Color = clBtnFace
Font.Color = clWindowText
Font.Height = -12
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnShow = FormShow
ShowHint = True
LCLVersion = '1.7'
object gbPreview: TGroupBox
Left = 0
@ -319,14 +321,14 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
Height = 347
Top = 132
Width = 536
ActivePage = TabSheet3
ActivePage = TabSheet2
Align = alClient
TabIndex = 2
TabIndex = 1
TabOrder = 1
object TabSheet1: TTabSheet
Caption = 'Tab'
ClientHeight = 326
ClientWidth = 549
ClientHeight = 319
ClientWidth = 528
object Label2: TLabel
AnchorSideTop.Control = pTabFrame
AnchorSideTop.Side = asrCenter
@ -677,6 +679,7 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
Width = 137
BorderSpacing.Left = 12
BorderSpacing.Top = 4
Visible = False
end
object pPaneBorderDark: TPanel
AnchorSideLeft.Control = cbLinkPane
@ -821,6 +824,46 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
OnClick = cbLinkPaneClick
TabOrder = 8
end
object cbPaneStyle: TComboBox
AnchorSideLeft.Control = pPaneCaptionFont
AnchorSideTop.Control = pPaneCaptionFont
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = pPaneCaptionFontColor
AnchorSideRight.Side = asrBottom
Left = 141
Height = 23
Top = 265
Width = 121
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 6
ItemHeight = 15
ItemIndex = 1
Items.Strings = (
'Rectangle flat'
'Rectangle etched'
'Rectangle raised'
'Divider flat'
'Divider etched'
'Divider raised'
)
OnChange = cbPaneStyleChange
Style = csDropDownList
TabOrder = 9
Text = 'Rectangle etched'
end
object Label12: TLabel
AnchorSideTop.Control = cbPaneStyle
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = LblCaptionBackground
AnchorSideRight.Side = asrBottom
Left = 68
Height = 15
Top = 269
Width = 53
Anchors = [akTop, akRight]
Caption = 'Pane style'
ParentColor = False
end
end
object TabSheet3: TTabSheet
Caption = 'Item'

24
components/spktoolbar/designtime/spkte_AppearanceEditor.pas
View File

@ -16,7 +16,9 @@ type
{ TfrmAppearanceEditWindow }
TfrmAppearanceEditWindow = class(TForm)
cbPaneStyle: TComboBox;
gbPreview: TGroupBox;
Label12: TLabel;
SmallImages: TImageList;
LargeImages: TImageList;
Label18: TLabel;
@ -128,9 +130,11 @@ type
procedure cbItemActiveGradientKindChange(Sender: TObject);
procedure cbItemHottrackGradientKindChange(Sender: TObject);
procedure cbItemIdleGradientKindChange(Sender: TObject);
procedure cbTabGradientKindChange(Sender: TObject);
procedure cbPaneGradientKindChange(Sender: TObject);
procedure cbPaneStyleChange(Sender: TObject);
procedure cbTabGradientKindChange(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
@ -207,6 +211,9 @@ implementation
{$R *.lfm}
var
CurrPageIndex: Integer = 0;
{ TForm3 }
procedure TfrmAppearanceEditWindow.SetAppearance(const Value: TSpkToolbarAppearance);
@ -362,6 +369,12 @@ begin
Result := false;
end;
procedure TfrmAppearanceEditWindow.FormCloseQuery(Sender: TObject;
var CanClose: boolean);
begin
if CanClose then CurrPageIndex := PageControl1.PageIndex;
end;
procedure TfrmAppearanceEditWindow.FormCreate(Sender: TObject);
begin
bOK.AutoSize := false;
@ -369,6 +382,8 @@ begin
LargeImages.AddIcon(Application.Icon);
SmallImages.AddIcon(Application.Icon);
PageControl1.PageIndex := CurrPageIndex;
end;
procedure TfrmAppearanceEditWindow.FormShow(Sender: TObject);
@ -406,6 +421,7 @@ begin
SetPanelColor(pPaneCaptionBackground, CaptionBgColor);
SetPanelFont(pPaneCaptionFont, CaptionFont);
SetPanelColor(pPaneCaptionFontColor, CaptionFont.Color);
cbPaneStyle.ItemIndex := ord(Style);
end;
with Element do
@ -671,6 +687,12 @@ begin
SetLinkedGradientKind((Sender as TComboBox).ItemIndex);
end;
procedure TfrmAppearanceEditWindow.cbPaneStyleChange(Sender: TObject);
begin
with tbPreview.Appearance.Pane do
Style := TSpkPaneStyle((Sender as TCombobox).ItemIndex);
end;
procedure TfrmAppearanceEditWindow.pPaneGradientToClick(Sender: TObject);
begin
if ChangeColor(Sender as TPanel) then