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

SpkToolbar: Add new property Style to Appearance.Element (esRounded, esRectangle). Refactoring of Button drawing. Lots of cosmetic changes.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5354 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-11-16 18:56:23 +00:00
parent 588166bb4c
commit 9e82f074d9
7 changed files with 1270 additions and 1872 deletions
Download Patch File Download Diff File Expand all files Collapse all files

115
components/spktoolbar/SpkGUITools/SpkGUITools.pas
View File

@ -2218,35 +2218,34 @@ class procedure TGUITools.DrawRoundRect(ACanvas: TCanvas; Rect: T2DIntRect;
Radius: integer; ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind; Radius: integer; ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind;
ClipRect: T2DIntRect; LeftTopRound, RightTopRound, LeftBottomRound, ClipRect: T2DIntRect; LeftTopRound, RightTopRound, LeftBottomRound,
RightBottomRound: boolean); RightBottomRound: boolean);
var
var UseOrgClipRgn : boolean; UseOrgClipRgn: boolean;
ClipRgn : HRGN; ClipRgn: HRGN;
OrgRgn : HRGN; OrgRgn: HRGN;
begin begin
// Zapamiêtywanie oryginalnego ClipRgn i ustawianie nowego // Zapamiêtywanie oryginalnego ClipRgn i ustawianie nowego
SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
ClipRgn:=CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1); ClipRgn := CreateRectRgn(ClipRect.left, ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom+1);
if UseOrgClipRgn then if UseOrgClipRgn then
CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND); CombineRgn(ClipRgn, ClipRgn, OrgRgn, RGN_AND);
SelectClipRgn(ACanvas.Handle, ClipRgn); SelectClipRgn(ACanvas.Handle, ClipRgn);
DrawRoundRect(ACanvas, Rect, Radius, ColorFrom, ColorTo, GradientKind, LeftTopRound, RightTopRound, LeftBottomRound, RightBottomRound); DrawRoundRect(ACanvas, Rect, Radius, ColorFrom, ColorTo, GradientKind, LeftTopRound, RightTopRound, LeftBottomRound, RightBottomRound);
// Przywracanie poprzedniego ClipRgn i usuwanie wykorzystanych regionów // Przywracanie poprzedniego ClipRgn i usuwanie wykorzystanych regionów
RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
DeleteObject(ClipRgn); DeleteObject(ClipRgn);
end; end;
class procedure TGUITools.DrawText(ACanvas: TCanvas; x, y: integer; class procedure TGUITools.DrawText(ACanvas: TCanvas; x, y: integer;
const AText: string; TextColor: TColor); const AText: string; TextColor: TColor);
begin begin
with Acanvas do with ACanvas do
begin begin
brush.style:=bsClear; Brush.Style := bsClear;
font.color:=TextColor; Font.Color := TextColor;
TextOut(x, y, AText); TextOut(x, y, AText);
end; end;
end; end;
@ -2269,81 +2268,89 @@ end;
class procedure TGUITools.DrawRoundRect(ACanvas: TCanvas; Rect: T2DIntRect; class procedure TGUITools.DrawRoundRect(ACanvas: TCanvas; Rect: T2DIntRect;
Radius: integer; ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind; Radius: integer; ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind;
LeftTopRound, RightTopRound, LeftBottomRound, RightBottomRound: boolean); LeftTopRound, RightTopRound, LeftBottomRound, RightBottomRound: boolean);
var
var RoundRgn : HRGN; RoundRgn: HRGN;
TmpRgn : HRGN; TmpRgn: HRGN;
OrgRgn : HRGN; OrgRgn: HRGN;
UseOrgClipRgn: Boolean; UseOrgClipRgn: Boolean;
begin begin
if Radius<1 then if Radius < 0 then
exit; exit;
//WriteLn('Radius: ', Radius, ' Rect.Width: ', Rect.Width, ' Rect.Height: ', Rect.Height); if Radius > 0 then
//there's a bug in fpc that evaluates the expression below erroneous when using inline
// Radius = 3 and Rect.Width >=128 and <= 261 will evaluate to true
{$ifdef FpcBugWorkAround}
if (CompareValue(Radius*2, Rect.width) > 0) and (CompareValue(Radius*2, Rect.Height) > 0) then
exit;
{$else}
if (Radius*2>Rect.width) or (Radius*2>Rect.height) then
exit;
{$endif}
// Zapamiêtywanie oryginalnego ClipRgn i ustawianie nowego
SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
if not(LeftTopRound) and not(RightTopRound) and not(LeftBottomRound) and not (RightBottomRound) then
begin begin
RoundRgn:=CreateRectRgn(Rect.Left, Rect.Top, Rect.Right + 1, Rect.Bottom + 1); //WriteLn('Radius: ', Radius, ' Rect.Width: ', Rect.Width, ' Rect.Height: ', Rect.Height);
// There's a bug in fpc that evaluates the expression below erroneous when using inline
// Radius = 3 and Rect.Width >= 128 and <= 261 will evaluate to true
{$ifdef FpcBugWorkAround}
if (CompareValue(Radius*2, Rect.width) > 0) and (CompareValue(Radius*2, Rect.Height) > 0) then
exit;
{$else}
if (Radius*2 > Rect.Width) or (Radius*2 > Rect.Height) then
exit;
{$endif}
// Zapamiêtywanie oryginalnego ClipRgn i ustawianie nowego
SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
if not(LeftTopRound) and
not(RightTopRound) and
not(LeftBottomRound) and
not (RightBottomRound) then
begin
RoundRgn := CreateRectRgn(Rect.Left, Rect.Top, Rect.Right + 1, Rect.Bottom + 1);
end end
else else
begin begin
RoundRgn:=CreateRoundRectRgn(Rect.Left, Rect.Top, Rect.Right +2, Rect.Bottom + 2, Radius*2, Radius*2); RoundRgn := CreateRoundRectRgn(Rect.Left, Rect.Top, Rect.Right +2, Rect.Bottom + 2, Radius*2, Radius*2);
if not(LeftTopRound) then if not(LeftTopRound) then
begin begin
TmpRgn:=CreateRectRgn(Rect.left, Rect.Top, Rect.left + Radius, Rect.Top + Radius); TmpRgn := CreateRectRgn(Rect.Left, Rect.Top, Rect.Left + Radius, Rect.Top + Radius);
CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR); CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR);
DeleteObject(TmpRgn); DeleteObject(TmpRgn);
end; end;
if not(RightTopRound) then if not(RightTopRound) then
begin begin
TmpRgn:=CreateRectRgn(Rect.right - Radius + 1, Rect.Top, Rect.Right + 1, Rect.Top + Radius); TmpRgn := CreateRectRgn(Rect.Right - Radius + 1, Rect.Top, Rect.Right + 1, Rect.Top + Radius);
CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR); CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR);
DeleteObject(TmpRgn); DeleteObject(TmpRgn);
end; end;
if not(LeftBottomRound) then if not(LeftBottomRound) then
begin begin
TmpRgn:=CreateRectRgn(Rect.left, Rect.Bottom - Radius + 1, Rect.Left + Radius, Rect.Bottom + 1); TmpRgn := CreateRectRgn(Rect.Left, Rect.Bottom - Radius + 1, Rect.Left + Radius, Rect.Bottom + 1);
CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR); CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR);
DeleteObject(TmpRgn); DeleteObject(TmpRgn);
end; end;
if not(RightBottomRound) then if not(RightBottomRound) then
begin begin
TmpRgn:=CreateRectRgn(Rect.right - Radius + 1, Rect.Bottom - Radius + 1, Rect.Right + 1, Rect.Bottom + 1); TmpRgn := CreateRectRgn(Rect.Right - Radius + 1, Rect.Bottom - Radius + 1, Rect.Right + 1, Rect.Bottom + 1);
CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR); CombineRgn(RoundRgn, RoundRgn, TmpRgn, RGN_OR);
DeleteObject(TmpRgn); DeleteObject(TmpRgn);
end; end;
end; end;
if UseOrgClipRgn then if UseOrgClipRgn then
CombineRgn(RoundRgn, RoundRgn, OrgRgn, RGN_AND); CombineRgn(RoundRgn, RoundRgn, OrgRgn, RGN_AND);
SelectClipRgn(ACanvas.Handle, RoundRgn); SelectClipRgn(ACanvas.Handle, RoundRgn);
end; // if Radius > 0
ColorFrom:=ColorToRGB(ColorFrom); ColorFrom := ColorToRGB(ColorFrom);
ColorTo:=ColorToRGB(ColorTo); ColorTo := ColorToRGB(ColorTo);
FillGradientRectangle(ACanvas, Rect, ColorFrom, ColorTo, GradientKind); FillGradientRectangle(ACanvas, Rect, ColorFrom, ColorTo, GradientKind);
// Przywracanie poprzedniego ClipRgn i usuwanie wykorzystanych regionów if Radius > 0 then
RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn); begin
DeleteObject(RoundRgn); // Przywracanie poprzedniego ClipRgn i usuwanie wykorzystanych regionów
RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
DeleteObject(RoundRgn);
end;
end; end;
class procedure TGUITools.DrawOutlinedText(ABitmap: TBitmap; x, y: integer; class procedure TGUITools.DrawOutlinedText(ABitmap: TBitmap; x, y: integer;

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

@ -22,6 +22,8 @@ type
TSpkPaneStyle = (psRectangleFlat, psRectangleEtched, psRectangleRaised, TSpkPaneStyle = (psRectangleFlat, psRectangleEtched, psRectangleRaised,
psDividerFlat, psDividerEtched, psDividerRaised); psDividerFlat, psDividerEtched, psDividerRaised);
TSpkElementStyle = (esRounded, esRectangle);
type TSpkTabAppearance = class(TPersistent) type TSpkTabAppearance = class(TPersistent)
private private
FDispatch: TSpkBaseAppearanceDispatch; FDispatch: TSpkBaseAppearanceDispatch;
@ -104,7 +106,6 @@ type TSpkPaneAppearance = class(TPersistent)
type TSpkElementAppearance = class(TPersistent) type TSpkElementAppearance = class(TPersistent)
private private
FDispatch: TSpkBaseAppearanceDispatch; FDispatch: TSpkBaseAppearanceDispatch;
protected
FCaptionFont: TFont; FCaptionFont: TFont;
FIdleFrameColor: TColor; FIdleFrameColor: TColor;
FIdleGradientFromColor: TColor; FIdleGradientFromColor: TColor;
@ -127,7 +128,7 @@ type TSpkElementAppearance = class(TPersistent)
FActiveInnerLightColor: TColor; FActiveInnerLightColor: TColor;
FActiveInnerDarkColor: TColor; FActiveInnerDarkColor: TColor;
FActiveCaptionColor: TColor; FActiveCaptionColor: TColor;
FStyle: TSpkElementStyle;
procedure SetActiveCaptionColor(const Value: TColor); procedure SetActiveCaptionColor(const Value: TColor);
procedure SetActiveFrameColor(const Value: TColor); procedure SetActiveFrameColor(const Value: TColor);
procedure SetActiveGradientFromColor(const Value: TColor); procedure SetActiveGradientFromColor(const Value: TColor);
@ -150,6 +151,7 @@ type TSpkElementAppearance = class(TPersistent)
procedure SetIdleGradientType(const Value: TBackgroundKind); procedure SetIdleGradientType(const Value: TBackgroundKind);
procedure SetIdleInnerDarkColor(const Value: TColor); procedure SetIdleInnerDarkColor(const Value: TColor);
procedure SetIdleInnerLightColor(const Value: TColor); procedure SetIdleInnerLightColor(const Value: TColor);
procedure SetStyle(const Value: TSpkElementStyle);
public public
constructor Create(ADispatch: TSpkBaseAppearanceDispatch); constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
destructor Destroy; override; destructor Destroy; override;
@ -181,6 +183,7 @@ type TSpkElementAppearance = class(TPersistent)
property ActiveInnerLightColor: TColor read FActiveInnerLightColor write SetActiveInnerLightColor; property ActiveInnerLightColor: TColor read FActiveInnerLightColor write SetActiveInnerLightColor;
property ActiveInnerDarkColor: TColor read FActiveInnerDarkColor write SetActiveInnerDarkColor; property ActiveInnerDarkColor: TColor read FActiveInnerDarkColor write SetActiveInnerDarkColor;
property ActiveCaptionColor: TColor read FActiveCaptionColor write SetActiveCaptionColor; property ActiveCaptionColor: TColor read FActiveCaptionColor write SetActiveCaptionColor;
property Style: TSpkElementStyle read FStyle write SetStyle;
end; end;
type TSpkToolbarAppearance = class; type TSpkToolbarAppearance = class;
@ -220,6 +223,7 @@ type TSpkToolbarAppearance = class;
property Element: TSpkElementAppearance read FElement write SetElementAppearance; property Element: TSpkElementAppearance read FElement write SetElementAppearance;
end; end;
procedure SetDefaultFont(AFont: TFont);
implementation implementation
@ -317,36 +321,8 @@ end;
procedure TSpkTabAppearance.Reset; procedure TSpkTabAppearance.Reset;
begin begin
if screen.fonts.IndexOf('Calibri') >= 0 then SetDefaultFont(FTabHeaderFont);
begin FTabHeaderFont.Size := FTabHeaderFont.Size + 1;
FTabHeaderFont.Charset := DEFAULT_CHARSET;
FTabHeaderFont.Color := rgb(21, 66, 139);
FTabHeaderFont.Name := 'Calibri';
FTabHeaderFont.Orientation := 0;
FTabHeaderFont.Pitch := fpDefault;
FTabHeaderFont.Size := 10;
FTabHeaderFont.Style := [];
end
else if screen.fonts.IndexOf('Verdana') >= 0 then
begin
FTabHeaderFont.Charset := DEFAULT_CHARSET;
FTabHeaderFont.Color := rgb(21, 66, 139);
FTabHeaderFont.Name := 'Verdana';
FTabHeaderFont.Orientation := 0;
FTabHeaderFont.Pitch := fpDefault;
FTabHeaderFont.Size := 10;
FTabHeaderFont.Style := [];
end
else
begin
FTabHeaderFont.Charset := DEFAULT_CHARSET;
FTabHeaderFont.Color := rgb(21, 66, 139);
FTabHeaderFont.Name := 'Arial';
FTabHeaderFont.Orientation := 0;
FTabHeaderFont.Pitch := fpDefault;
FTabHeaderFont.Size := 10;
FTabHeaderFont.Style := [];
end;
FBorderColor := rgb(141, 178, 227); FBorderColor := rgb(141, 178, 227);
FGradientFromColor := rgb(222, 232, 245); FGradientFromColor := rgb(222, 232, 245);
FGradientToColor := rgb(199, 216, 237); FGradientToColor := rgb(199, 216, 237);
@ -520,36 +496,7 @@ end;
procedure TSpkPaneAppearance.Reset; procedure TSpkPaneAppearance.Reset;
begin begin
if screen.fonts.IndexOf('Calibri') >= 0 then SetDefaultFont(FCaptionFont);
begin
FCaptionFont.Name := 'Calibri';
FCaptionFont.Size := 9;
FCaptionFont.color := rgb(62, 106, 170);
FCaptionFont.Style := [];
FCaptionFont.Charset := DEFAULT_CHARSET;
FCaptionFont.Orientation := 0;
FCaptionFont.Pitch := fpDefault;
end
else if screen.fonts.IndexOf('Verdana') >= 0 then
begin
FCaptionFont.Name := 'Verdana';
FCaptionFont.Size := 9;
FCaptionFont.color := rgb(62, 106, 170);
FCaptionFont.Style := [];
FCaptionFont.Charset := DEFAULT_CHARSET;
FCaptionFont.Orientation := 0;
FCaptionFont.Pitch := fpDefault;
end
else
begin
FCaptionFont.Name := 'Arial';
FCaptionFont.Size := 9;
FCaptionFont.color := rgb(62, 106, 170);
FCaptionFont.Style := [];
FCaptionFont.Charset := DEFAULT_CHARSET;
FCaptionFont.Orientation := 0;
FCaptionFont.Pitch := fpDefault;
end;
FBorderDarkColor := rgb(158, 190, 218); FBorderDarkColor := rgb(158, 190, 218);
FBorderLightColor := rgb(237, 242, 248); FBorderLightColor := rgb(237, 242, 248);
FCaptionBgColor := rgb(194, 217, 241); FCaptionBgColor := rgb(194, 217, 241);
@ -667,15 +614,14 @@ end;
{ TSpkElementAppearance } { TSpkElementAppearance }
procedure TSpkElementAppearance.Assign(Source: TPersistent); procedure TSpkElementAppearance.Assign(Source: TPersistent);
var
var SrcAppearance : TSpkElementAppearance; SrcAppearance: TSpkElementAppearance;
begin begin
if Source is TSpkElementAppearance then if Source is TSpkElementAppearance then
begin begin
SrcAppearance:=TSpkElementAppearance(Source); SrcAppearance := TSpkElementAppearance(Source);
FCaptionFont.assign(SrcAppearance.CaptionFont); FCaptionFont.Assign(SrcAppearance.CaptionFont);
FIdleFrameColor := SrcAppearance.IdleFrameColor; FIdleFrameColor := SrcAppearance.IdleFrameColor;
FIdleGradientFromColor := SrcAppearance.IdleGradientFromColor; FIdleGradientFromColor := SrcAppearance.IdleGradientFromColor;
FIdleGradientToColor := SrcAppearance.IdleGradientToColor; FIdleGradientToColor := SrcAppearance.IdleGradientToColor;
@ -697,8 +643,9 @@ begin
FActiveInnerLightColor := SrcAppearance.ActiveInnerLightColor; FActiveInnerLightColor := SrcAppearance.ActiveInnerLightColor;
FActiveInnerDarkColor := SrcAppearance.ActiveInnerDarkColor; FActiveInnerDarkColor := SrcAppearance.ActiveInnerDarkColor;
FActiveCaptionColor := SrcAppearance.ActiveCaptionColor; FActiveCaptionColor := SrcAppearance.ActiveCaptionColor;
FStyle := SrcAppearance.Style;
if FDispatch<>nil then if FDispatch <> nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end else end else
raise AssignException.create('TSpkElementAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkElementAppearance!'); raise AssignException.create('TSpkElementAppearance.Assign: Nie mogê przypisaæ obiektu '+Source.ClassName+' do TSpkElementAppearance!');
@ -707,11 +654,8 @@ end;
constructor TSpkElementAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch); constructor TSpkElementAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch);
begin begin
inherited Create; inherited Create;
FDispatch := ADispatch;
FDispatch:=ADispatch; FCaptionFont := TFont.Create;
FCaptionFont:=TFont.Create;
Reset; Reset;
end; end;
@ -722,141 +666,113 @@ begin
end; end;
procedure TSpkElementAppearance.LoadFromXML(Node: TSpkXMLNode); procedure TSpkElementAppearance.LoadFromXML(Node: TSpkXMLNode);
var
var Subnode : TSpkXMLNode; Subnode: TSpkXMLNode;
begin begin
if not(assigned(Node)) then if not Assigned(Node) then
exit; exit;
Subnode:=Node['CaptionFont',false]; Subnode := Node['CaptionFont', false];
if assigned(Subnode) then if Assigned(Subnode) then
TSpkXMLTools.Load(Subnode, FCaptionFont); TSpkXMLTools.Load(Subnode, FCaptionFont);
// *** Idle *** // Idle
Subnode := Node['IdleFrameColor', false];
if Assigned(Subnode) then
FIdleFrameColor := Subnode.TextAsColor;
Subnode:=Node['IdleFrameColor',false]; Subnode := Node['IdleGradientFromColor', false];
if assigned(Subnode) then if Assigned(Subnode) then
FIdleFrameColor:=Subnode.TextAsColor; FIdleGradientFromColor := Subnode.TextAsColor;
Subnode:=Node['IdleGradientFromColor',false]; Subnode := Node['IdleGradientToColor', false];
if assigned(Subnode) then if Assigned(Subnode) then
FIdleGradientFromColor:=Subnode.TextAsColor; FIdleGradientToColor := Subnode.TextAsColor;
Subnode:=Node['IdleGradientToColor',false]; Subnode := Node['IdleGradientType', false];
if assigned(Subnode) then if Assigned(Subnode) then
FIdleGradientToColor:=Subnode.TextAsColor; FIdleGradientType := TBackgroundKind(Subnode.TextAsInteger);
Subnode:=Node['IdleGradientType',false]; Subnode := Node['IdleInnerLightColor', false];
if assigned(Subnode) then if Assigned(Subnode) then
FIdleGradientType:=TBackgroundKind(Subnode.TextAsInteger); FIdleInnerLightColor := Subnode.TextAsColor;
Subnode:=Node['IdleInnerLightColor',false]; Subnode := Node['IdleInnerDarkColor', false];
if assigned(Subnode) then if Assigned(Subnode) then
FIdleInnerLightColor:=Subnode.TextAsColor; FIdleInnerDarkColor := Subnode.TextAsColor;
Subnode:=Node['IdleInnerDarkColor',false]; Subnode := Node['IdleCaptionColor', false];
if assigned(Subnode) then if Assigned(Subnode) then
FIdleInnerDarkColor:=Subnode.TextAsColor; FIdleCaptionColor := Subnode.TextAsColor;
Subnode:=Node['IdleCaptionColor',false]; // Hottrack
if assigned(Subnode) then Subnode := Node['HottrackFrameColor', false];
FIdleCaptionColor:=Subnode.TextAsColor; if Assigned(Subnode) then
FHottrackFrameColor := Subnode.TextAsColor;
// *** Hottrack *** Subnode := Node['HottrackGradientFromColor', false];
if Assigned(Subnode) then
FHottrackGradientFromColor := Subnode.TextAsColor;
Subnode:=Node['HottrackFrameColor',false]; Subnode := Node['HottrackGradientToColor', false];
if assigned(Subnode) then if Assigned(Subnode) then
FHottrackFrameColor:=Subnode.TextAsColor; FHottrackGradientToColor := Subnode.TextAsColor;
Subnode:=Node['HottrackGradientFromColor',false]; Subnode := Node['HottrackGradientType', false];
if assigned(Subnode) then if Assigned(Subnode) then
FHottrackGradientFromColor:=Subnode.TextAsColor; FHottrackGradientType := TBackgroundKind(Subnode.TextAsInteger);
Subnode:=Node['HottrackGradientToColor',false]; Subnode := Node['HottrackInnerLightColor', false];
if assigned(Subnode) then if Assigned(Subnode) then
FHottrackGradientToColor:=Subnode.TextAsColor; FHottrackInnerLightColor := Subnode.TextAsColor;
Subnode:=Node['HottrackGradientType',false]; Subnode := Node['HottrackInnerDarkColor', false];
if assigned(Subnode) then if Assigned(Subnode) then
FHottrackGradientType:=TBackgroundKind(Subnode.TextAsInteger); FHottrackInnerDarkColor := Subnode.TextAsColor;
Subnode:=Node['HottrackInnerLightColor',false]; Subnode := Node['HottrackCaptionColor', false];
if assigned(Subnode) then if Assigned(Subnode) then
FHottrackInnerLightColor:=Subnode.TextAsColor; FHottrackCaptionColor := Subnode.TextAsColor;
Subnode:=Node['HottrackInnerDarkColor',false]; // Active
if assigned(Subnode) then Subnode := Node['ActiveFrameColor', false];
FHottrackInnerDarkColor:=Subnode.TextAsColor; if Assigned(Subnode) then
FActiveFrameColor := Subnode.TextAsColor;
Subnode:=Node['HottrackCaptionColor',false]; Subnode := Node['ActiveGradientFromColor', false];
if assigned(Subnode) then if Assigned(Subnode) then
FHottrackCaptionColor:=Subnode.TextAsColor; FActiveGradientFromColor := Subnode.TextAsColor;
// *** Active *** Subnode := Node['ActiveGradientToColor', false];
if Assigned(Subnode) then
FActiveGradientToColor := Subnode.TextAsColor;
Subnode:=Node['ActiveFrameColor',false]; Subnode := Node['ActiveGradientType', false];
if assigned(Subnode) then if Assigned(Subnode) then
FActiveFrameColor:=Subnode.TextAsColor; FActiveGradientType := TBackgroundKind(Subnode.TextAsInteger);
Subnode:=Node['ActiveGradientFromColor',false]; Subnode := Node['ActiveInnerLightColor', false];
if assigned(Subnode) then if Assigned(Subnode) then
FActiveGradientFromColor:=Subnode.TextAsColor; FActiveInnerLightColor := Subnode.TextAsColor;
Subnode:=Node['ActiveGradientToColor',false]; Subnode := Node['ActiveInnerDarkColor', false];
if assigned(Subnode) then if Assigned(Subnode) then
FActiveGradientToColor:=Subnode.TextAsColor; FActiveInnerDarkColor := Subnode.TextAsColor;
Subnode:=Node['ActiveGradientType',false]; Subnode := Node['ActiveCaptionColor', false];
if assigned(Subnode) then if Assigned(Subnode) then
FActiveGradientType:=TBackgroundKind(Subnode.TextAsInteger); FActiveCaptionColor := Subnode.TextAsColor;
Subnode:=Node['ActiveInnerLightColor',false]; // Other
if assigned(Subnode) then Subnode := Node['Style', false];
FActiveInnerLightColor:=Subnode.TextAsColor; if Assigned(SubNode) then
FStyle := TSpkElementStyle(Subnode.TextAsInteger);
Subnode:=Node['ActiveInnerDarkColor',false];
if assigned(Subnode) then
FActiveInnerDarkColor:=Subnode.TextAsColor;
Subnode:=Node['ActiveCaptionColor',false];
if assigned(Subnode) then
FActiveCaptionColor:=Subnode.TextAsColor;
end; end;
procedure TSpkElementAppearance.Reset; procedure TSpkElementAppearance.Reset;
begin begin
if screen.fonts.IndexOf('Calibri') >= 0 then SetDefaultFont(FCaptionFont);
begin FCaptionFont.Size := FCaptionFont.Size - 1;
FCaptionFont.Name := 'Calibri';
FCaptionFont.Size := 9;
FCaptionFont.Style := [];
FCaptionFont.Charset := DEFAULT_CHARSET;
FCaptionFont.Orientation := 0;
FCaptionFont.Pitch := fpDefault;
FCaptionFont.Color := rgb(21, 66, 139);
end
else if screen.fonts.IndexOf('Verdana') >= 0 then
begin
FCaptionFont.Name := 'Verdana';
FCaptionFont.Size := 8;
FCaptionFont.Style := [];
FCaptionFont.Charset := DEFAULT_CHARSET;
FCaptionFont.Orientation := 0;
FCaptionFont.Pitch := fpDefault;
FCaptionFont.Color := rgb(21, 66, 139);
end
else
begin
FCaptionFont.Name := 'Arial';
FCaptionFont.Size := 8;
FCaptionFont.Style := [];
FCaptionFont.Charset := DEFAULT_CHARSET;
FCaptionFont.Orientation := 0;
FCaptionFont.Pitch := fpDefault;
FCaptionFont.Color := rgb(21, 66, 139);
end;
FIdleFrameColor := rgb(155, 183, 224); FIdleFrameColor := rgb(155, 183, 224);
FIdleGradientFromColor := rgb(200, 219, 238); FIdleGradientFromColor := rgb(200, 219, 238);
FIdleGradientToColor := rgb(188, 208, 233); FIdleGradientToColor := rgb(188, 208, 233);
@ -878,6 +794,7 @@ begin
FActiveInnerLightColor := rgb(252, 169, 14); FActiveInnerLightColor := rgb(252, 169, 14);
FActiveInnerDarkColor := rgb(252, 169, 14); FActiveInnerDarkColor := rgb(252, 169, 14);
FActiveCaptionColor := rgb(110, 66, 128); FActiveCaptionColor := rgb(110, 66, 128);
FStyle := esRounded;
end; end;
procedure TSpkElementAppearance.SaveToPascal(AList: TStrings); procedure TSpkElementAppearance.SaveToPascal(AList: TStrings);
@ -909,6 +826,8 @@ begin
Add(' ActiveInnerDarkColor := $' + IntToHex(FActiveInnerDarkColor, 8) + ';'); Add(' ActiveInnerDarkColor := $' + IntToHex(FActiveInnerDarkColor, 8) + ';');
Add(' ActiveInnerLightColor := $' + IntToHex(FActiveInnerLightColor, 8) + ';'); Add(' ActiveInnerLightColor := $' + IntToHex(FActiveInnerLightColor, 8) + ';');
Add(' ActiveCaptionColor := $' + IntToHex(FActiveCaptionColor, 8) + ';'); Add(' ActiveCaptionColor := $' + IntToHex(FActiveCaptionColor, 8) + ';');
Add(' Style := ' + GetEnumName(TypeInfo(TSpkElementStyle), ord(FStyle)) + ';');
Add(' end;'); Add(' end;');
end; end;
end; end;
@ -920,78 +839,80 @@ begin
if not Assigned(Node) then if not Assigned(Node) then
exit; exit;
Subnode := Node['CaptionFont',true]; Subnode := Node['CaptionFont', true];
TSpkXMLTools.Save(Subnode, FCaptionFont); TSpkXMLTools.Save(Subnode, FCaptionFont);
// *** Idle *** // *** Idle ***
Subnode := Node['IdleFrameColor',true]; Subnode := Node['IdleFrameColor', true];
Subnode.TextAsColor:=FIdleFrameColor; Subnode.TextAsColor := FIdleFrameColor;
Subnode := Node['IdleGradientFromColor',true]; Subnode := Node['IdleGradientFromColor', true];
Subnode.TextAsColor:=FIdleGradientFromColor; Subnode.TextAsColor := FIdleGradientFromColor;
Subnode := Node['IdleGradientToColor',true]; Subnode := Node['IdleGradientToColor', true];
Subnode.TextAsColor:=FIdleGradientToColor; Subnode.TextAsColor := FIdleGradientToColor;
Subnode := Node['IdleGradientType',true]; Subnode := Node['IdleGradientType', true];
Subnode.TextAsInteger:=integer(FIdleGradientType); Subnode.TextAsInteger := integer(FIdleGradientType);
Subnode := Node['IdleInnerLightColor',true]; Subnode := Node['IdleInnerLightColor', true];
Subnode.TextAsColor:=FIdleInnerLightColor; Subnode.TextAsColor := FIdleInnerLightColor;
Subnode := Node['IdleInnerDarkColor',true]; Subnode := Node['IdleInnerDarkColor', true];
Subnode.TextAsColor:=FIdleInnerDarkColor; Subnode.TextAsColor := FIdleInnerDarkColor;
Subnode := Node['IdleCaptionColor',true]; Subnode := Node['IdleCaptionColor', true];
Subnode.TextAsColor:=FIdleCaptionColor; Subnode.TextAsColor := FIdleCaptionColor;
// *** Hottrack *** // *** Hottrack ***
Subnode := Node['HottrackFrameColor',true]; Subnode := Node['HottrackFrameColor', true];
Subnode.TextAsColor:=FHottrackFrameColor; Subnode.TextAsColor := FHottrackFrameColor;
Subnode := Node['HottrackGradientFromColor',true]; Subnode := Node['HottrackGradientFromColor', true];
Subnode.TextAsColor:=FHottrackGradientFromColor; Subnode.TextAsColor := FHottrackGradientFromColor;
Subnode := Node['HottrackGradientToColor',true]; Subnode := Node['HottrackGradientToColor', true];
Subnode.TextAsColor:=FHottrackGradientToColor; Subnode.TextAsColor := FHottrackGradientToColor;
Subnode := Node['HottrackGradientType',true]; Subnode := Node['HottrackGradientType', true];
Subnode.TextAsInteger:=integer(FHottrackGradientType); Subnode.TextAsInteger := integer(FHottrackGradientType);
Subnode := Node['HottrackInnerLightColor',true]; Subnode := Node['HottrackInnerLightColor', true];
Subnode.TextAsColor:=FHottrackInnerLightColor; Subnode.TextAsColor := FHottrackInnerLightColor;
Subnode := Node['HottrackInnerDarkColor',true]; Subnode := Node['HottrackInnerDarkColor', true];
Subnode.TextAsColor:=FHottrackInnerDarkColor; Subnode.TextAsColor := FHottrackInnerDarkColor;
Subnode := Node['HottrackCaptionColor',true]; Subnode := Node['HottrackCaptionColor', true];
Subnode.TextAsColor:=FHottrackCaptionColor; Subnode.TextAsColor := FHottrackCaptionColor;
// *** Active *** // *** Active ***
Subnode := Node['ActiveFrameColor',true]; Subnode := Node['ActiveFrameColor', true];
Subnode.TextAsColor:=FActiveFrameColor; Subnode.TextAsColor := FActiveFrameColor;
Subnode := Node['ActiveGradientFromColor',true]; Subnode := Node['ActiveGradientFromColor', true];
Subnode.TextAsColor:=FActiveGradientFromColor; Subnode.TextAsColor := FActiveGradientFromColor;
Subnode := Node['ActiveGradientToColor',true]; Subnode := Node['ActiveGradientToColor', true];
Subnode.TextAsColor:=FActiveGradientToColor; Subnode.TextAsColor := FActiveGradientToColor;
Subnode := Node['ActiveGradientType',true]; Subnode := Node['ActiveGradientType', true];
Subnode.TextAsInteger:=integer(FActiveGradientType); Subnode.TextAsInteger := integer(FActiveGradientType);
Subnode := Node['ActiveInnerLightColor',true]; Subnode := Node['ActiveInnerLightColor', true];
Subnode.TextAsColor:=FActiveInnerLightColor; Subnode.TextAsColor := FActiveInnerLightColor;
Subnode := Node['ActiveInnerDarkColor',true]; Subnode := Node['ActiveInnerDarkColor', true];
Subnode.TextAsColor:=FActiveInnerDarkColor; Subnode.TextAsColor := FActiveInnerDarkColor;
Subnode := Node['ActiveCaptionColor',true]; Subnode := Node['ActiveCaptionColor', true];
Subnode.TextAsColor:=FActiveCaptionColor; Subnode.TextAsColor := FActiveCaptionColor;
Subnode := Node['Style', true];
Subnode.TextAsInteger := integer(FStyle);
end; end;
procedure TSpkElementAppearance.SetActiveCaptionColor( procedure TSpkElementAppearance.SetActiveCaptionColor(const Value: TColor);
const Value: TColor);
begin begin
FActiveCaptionColor := Value; FActiveCaptionColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
@ -1005,40 +926,35 @@ begin
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetActiveGradientFromColor( procedure TSpkElementAppearance.SetActiveGradientFromColor(const Value: TColor);
const Value: TColor);
begin begin
FActiveGradientFromColor := Value; FActiveGradientFromColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetActiveGradientToColor( procedure TSpkElementAppearance.SetActiveGradientToColor(const Value: TColor);
const Value: TColor);
begin begin
FActiveGradientToColor := Value; FActiveGradientToColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetActiveGradientType( procedure TSpkElementAppearance.SetActiveGradientType(const Value: TBackgroundKind);
const Value: TBackgroundKind);
begin begin
FActiveGradientType := Value; FActiveGradientType := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetActiveInnerDarkColor( procedure TSpkElementAppearance.SetActiveInnerDarkColor(const Value: TColor);
const Value: TColor);
begin begin
FActiveInnerDarkColor := Value; FActiveInnerDarkColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetActiveInnerLightColor( procedure TSpkElementAppearance.SetActiveInnerLightColor(const Value: TColor);
const Value: TColor);
begin begin
FActiveInnerLightColor := Value; FActiveInnerLightColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
@ -1052,56 +968,49 @@ begin
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetHotTrackCaptionColor( procedure TSpkElementAppearance.SetHotTrackCaptionColor(const Value: TColor);
const Value: TColor);
begin begin
FHotTrackCaptionColor := Value; FHotTrackCaptionColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetHotTrackFrameColor( procedure TSpkElementAppearance.SetHotTrackFrameColor(const Value: TColor);
const Value: TColor);
begin begin
FHotTrackFrameColor := Value; FHotTrackFrameColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetHotTrackGradientFromColor( procedure TSpkElementAppearance.SetHotTrackGradientFromColor(const Value: TColor);
const Value: TColor);
begin begin
FHotTrackGradientFromColor := Value; FHotTrackGradientFromColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetHotTrackGradientToColor( procedure TSpkElementAppearance.SetHotTrackGradientToColor(const Value: TColor);
const Value: TColor);
begin begin
FHotTrackGradientToColor := Value; FHotTrackGradientToColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetHotTrackGradientType( procedure TSpkElementAppearance.SetHotTrackGradientType(const Value: TBackgroundKind);
const Value: TBackgroundKind);
begin begin
FHotTrackGradientType := Value; FHotTrackGradientType := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetHotTrackInnerDarkColor( procedure TSpkElementAppearance.SetHotTrackInnerDarkColor(const Value: TColor);
const Value: TColor);
begin begin
FHotTrackInnerDarkColor := Value; FHotTrackInnerDarkColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetHotTrackInnerLightColor( procedure TSpkElementAppearance.SetHotTrackInnerLightColor(const Value: TColor);
const Value: TColor);
begin begin
FHotTrackInnerLightColor := Value; FHotTrackInnerLightColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
@ -1122,46 +1031,48 @@ begin
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetIdleGradientFromColor( procedure TSpkElementAppearance.SetIdleGradientFromColor(const Value: TColor);
const Value: TColor);
begin begin
FIdleGradientFromColor := Value; FIdleGradientFromColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetIdleGradientToColor( procedure TSpkElementAppearance.SetIdleGradientToColor(const Value: TColor);
const Value: TColor);
begin begin
FIdleGradientToColor := Value; FIdleGradientToColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetIdleGradientType( procedure TSpkElementAppearance.SetIdleGradientType(const Value: TBackgroundKind);
const Value: TBackgroundKind);
begin begin
FIdleGradientType := Value; FIdleGradientType := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetIdleInnerDarkColor( procedure TSpkElementAppearance.SetIdleInnerDarkColor(const Value: TColor);
const Value: TColor);
begin begin
FIdleInnerDarkColor := Value; FIdleInnerDarkColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetIdleInnerLightColor( procedure TSpkElementAppearance.SetIdleInnerLightColor(const Value: TColor);
const Value: TColor);
begin begin
FIdleInnerLightColor := Value; FIdleInnerLightColor := Value;
if FDispatch<>nil then if FDispatch<>nil then
FDispatch.NotifyAppearanceChanged; FDispatch.NotifyAppearanceChanged;
end; end;
procedure TSpkElementAppearance.SetStyle(const Value: TSpkElementStyle);
begin
FStyle := Value;
if FDispatch <> nil then
FDispatch.NotifyAppearanceChanged;
end;
{ TSpkToolbarAppearanceDispatch } { TSpkToolbarAppearanceDispatch }
constructor TSpkToolbarAppearanceDispatch.Create( constructor TSpkToolbarAppearanceDispatch.Create(
@ -1296,4 +1207,30 @@ begin
FTab.assign(Value); FTab.assign(Value);
end; end;
procedure SetDefaultFont(AFont: TFont);
begin
AFont.Assign(Screen.MenuFont);
{
if Screen.Fonts.IndexOf('Calibri') >= 0 then
begin
AFont.Name := 'Calibri';
AFont.Size := 9;
end
else if Screen.Fonts.IndexOf('Verdana') >= 0 then
begin
AFont.Name := 'Verdana';
AFont.Size := 8;
end else
begin
AFont.Name := 'Arial';
AFont.Size := 8;
end;
AFont.Style := [];
AFont.Charset := DEFAULT_CHARSET;
AFont.Orientation := 0;
AFont.Pitch := fpDefault;
}
AFont.Color := rgb(21, 66, 139);
end;
end. end.

1654
components/spktoolbar/SpkToolbar/spkt_Buttons.pas
View File

File diff suppressed because it is too large Load Diff

4
components/spktoolbar/SpkToolbar/spkt_Const.pas
View File

@ -355,7 +355,7 @@ begin
if ToDPI = 0 then if ToDPI = 0 then
ToDPI := ScreenInfo.PixelsPerInchX; ToDPI := ScreenInfo.PixelsPerInchX;
if not(DPI_AWARE) or (ToDPI = FromDPI) then if (not DPI_AWARE) or (ToDPI = FromDPI) then
Result := Size Result := Size
else else
begin begin
@ -372,7 +372,7 @@ begin
if ToDPI = 0 then if ToDPI = 0 then
ToDPI := ScreenInfo.PixelsPerInchY; ToDPI := ScreenInfo.PixelsPerInchY;
if not(DPI_AWARE) or (ToDPI = FromDPI) then if (not DPI_AWARE) or (ToDPI = FromDPI) then
Result := Size Result := Size
else else
begin begin

212
components/spktoolbar/SpkToolbar/spkt_Tools.pas
View File

@ -22,20 +22,20 @@ type TButtonTools = class sealed(TObject)
private private
protected protected
public public
class procedure DrawButton(Bitmap : TBitmap; class procedure DrawButton(Bitmap: TBitmap;
Rect : T2DIntRect; Rect: T2DIntRect;
FrameColor, FrameColor,
InnerLightColor, InnerLightColor,
InnerDarkColor, InnerDarkColor,
GradientFrom, GradientFrom,
GradientTo : TColor; GradientTo: TColor;
GradientKind : TBackgroundKind; GradientKind: TBackgroundKind;
LeftEdgeOpen, LeftEdgeOpen,
RightEdgeOpen, RightEdgeOpen,
TopEdgeOpen, TopEdgeOpen,
BottomEdgeOpen : boolean; BottomEdgeOpen: boolean;
Radius : integer; Radius: integer;
ClipRect : T2DIntRect); ClipRect: T2DIntRect);
end; end;
implementation implementation
@ -48,63 +48,67 @@ class procedure TButtonTools.DrawButton(Bitmap: TBitmap;
RightEdgeOpen, TopEdgeOpen, BottomEdgeOpen: boolean; Radius: integer; RightEdgeOpen, TopEdgeOpen, BottomEdgeOpen: boolean; Radius: integer;
ClipRect : T2DIntRect); ClipRect : T2DIntRect);
var x1, x2, y1, y2 : integer; var
LeftClosed, TopClosed, RightClosed, BottomClosed : byte; x1, x2, y1, y2: integer;
LeftClosed, TopClosed, RightClosed, BottomClosed: byte;
begin begin
if (Rect.Width<6) or (Rect.Height<6) or if (Rect.Width <6 ) or (Rect.Height < 6) or
(Rect.Width < 2*radius) or (Rect.Height < 2*Radius) then (Rect.Width < 2*Radius) or (Rect.Height < 2*Radius) then exit;
exit;
if LeftEdgeOpen then LeftClosed:=0 else LeftClosed:=1; if LeftEdgeOpen then LeftClosed := 0 else LeftClosed := 1;
if RightEdgeOpen then RightClosed:=0 else RightClosed:=1; if RightEdgeOpen then RightClosed := 0 else RightClosed := 1;
if TopEdgeOpen then TopClosed:=0 else TopClosed:=1; if TopEdgeOpen then TopClosed := 0 else TopClosed := 1;
if BottomEdgeOpen then BottomClosed:=0 else BottomClosed:=1; if BottomEdgeOpen then BottomClosed := 0 else BottomClosed := 1;
TGuiTools.DrawRoundRect(Bitmap.Canvas, TGuiTools.DrawRoundRect(
Bitmap.Canvas,
Rect, Rect,
Radius, Radius,
GradientFrom, GradientFrom,
GradientTo, GradientTo,
GradientKind, GradientKind,
ClipRect, ClipRect,
not(LeftEdgeOpen or TopEdgeOpen), not (LeftEdgeOpen or TopEdgeOpen),
not(RightEdgeOpen or TopEdgeOpen), not (RightEdgeOpen or TopEdgeOpen),
not(LeftEdgeOpen or BottomEdgeOpen), not (LeftEdgeOpen or BottomEdgeOpen),
not(RightEdgeOpen or BottomEdgeOpen)); not (RightEdgeOpen or BottomEdgeOpen)
);
// Wewnêtrzna krawêdŸ // Wewnêtrzna krawêdŸ
// *** Góra *** // *** Góra ***
x1:=Rect.Left + radius * TopClosed * LeftClosed + LeftClosed; x1 := Rect.Left + radius * TopClosed * LeftClosed + LeftClosed;
x2:=Rect.Right - radius * TopClosed * RightClosed - RightClosed; x2 := Rect.Right - radius * TopClosed * RightClosed - RightClosed;
y1:=Rect.Top + TopClosed; y1 := Rect.Top + TopClosed;
TGuiTools.DrawHLine(Bitmap, x1, x2, y1, InnerLightColor, ClipRect);
// *** Dó³ ***
x1:=Rect.Left + radius * BottomClosed * LeftClosed + LeftClosed;
x2:=Rect.Right - radius * BottomClosed * RightClosed - RightClosed;
y1:=Rect.Bottom - BottomClosed;
if BottomEdgeOpen then
TGuiTools.DrawHLine(Bitmap, x1, x2, y1, InnerDarkColor, ClipRect) else
TGuiTools.DrawHLine(Bitmap, x1, x2, y1, InnerLightColor, ClipRect); TGuiTools.DrawHLine(Bitmap, x1, x2, y1, InnerLightColor, ClipRect);
// *** Lewo *** // *** Dó³ ***
y1:=Rect.Top + Radius * LeftClosed * TopClosed + TopClosed; x1 := Rect.Left + radius * BottomClosed * LeftClosed + LeftClosed;
y2:=Rect.Bottom - Radius * LeftClosed * BottomClosed - BottomClosed; x2 := Rect.Right - radius * BottomClosed * RightClosed - RightClosed;
x1:=Rect.Left + LeftClosed; y1 := Rect.Bottom - BottomClosed;
TGuiTools.DrawVLine(Bitmap, x1, y1, y2, InnerLightColor, ClipRect); if BottomEdgeOpen then
TGuiTools.DrawHLine(Bitmap, x1, x2, y1, InnerDarkColor, ClipRect)
else
TGuiTools.DrawHLine(Bitmap, x1, x2, y1, InnerLightColor, ClipRect);
// *** Prawo *** // *** Lewo ***
y1:=Rect.Top + Radius * RightClosed * TopClosed + TopClosed; y1 := Rect.Top + Radius * LeftClosed * TopClosed + TopClosed;
y2:=Rect.Bottom - Radius * RightClosed * BottomClosed - BottomClosed; y2 := Rect.Bottom - Radius * LeftClosed * BottomClosed - BottomClosed;
x1:=Rect.Right - RightClosed; x1 := Rect.Left + LeftClosed;
if RightEdgeOpen then
TGuiTools.DrawVLine(Bitmap, x1, y1, y2, InnerDarkColor, ClipRect) else
TGuiTools.DrawVLine(Bitmap, x1, y1, y2, InnerLightColor, ClipRect); TGuiTools.DrawVLine(Bitmap, x1, y1, y2, InnerLightColor, ClipRect);
// Zaokr¹glone naro¿niki // *** Prawo ***
if not(LeftEdgeOpen or TopEdgeOpen) then y1 := Rect.Top + Radius * RightClosed * TopClosed + TopClosed;
TGuiTools.DrawAARoundCorner(Bitmap, y2 := Rect.Bottom - Radius * RightClosed * BottomClosed - BottomClosed;
x1 := Rect.Right - RightClosed;
if RightEdgeOpen then
TGuiTools.DrawVLine(Bitmap, x1, y1, y2, InnerDarkColor, ClipRect)
else
TGuiTools.DrawVLine(Bitmap, x1, y1, y2, InnerLightColor, ClipRect);
// Zaokr¹glone naro¿niki
if not(LeftEdgeOpen or TopEdgeOpen) then
TGuiTools.DrawAARoundCorner(
Bitmap,
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
T2DIntPoint.create(Rect.left + 1, Rect.Top + 1), T2DIntPoint.create(Rect.left + 1, Rect.Top + 1),
{$ELSE} {$ELSE}
@ -113,77 +117,85 @@ if not(LeftEdgeOpen or TopEdgeOpen) then
Radius, Radius,
cpLeftTop, cpLeftTop,
InnerLightColor, InnerLightColor,
ClipRect); ClipRect
if not(RightEdgeOpen or TopEdgeOpen) then );
TGuiTools.DrawAARoundCorner(Bitmap, if not(RightEdgeOpen or TopEdgeOpen) then
TGuiTools.DrawAARoundCorner(
Bitmap,
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
T2DIntPoint.create(Rect.right - radius, Rect.Top + 1), T2DIntPoint.Create(Rect.right - radius, Rect.Top + 1),
{$ELSE} {$ELSE}
Create2DIntPoint(Rect.right - radius, Rect.Top + 1), Create2DIntPoint(Rect.right - radius, Rect.Top + 1),
{$ENDIF} {$ENDIF}
Radius, Radius,
cpRightTop, cpRightTop,
InnerLightColor, InnerLightColor,
ClipRect); ClipRect
if not(LeftEdgeOpen or BottomEdgeOpen) then );
TGuiTools.DrawAARoundCorner(Bitmap, if not(LeftEdgeOpen or BottomEdgeOpen) then
TGuiTools.DrawAARoundCorner(
Bitmap,
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
T2DIntPoint.create(Rect.left + 1, Rect.bottom - radius), T2DIntPoint.create(Rect.left + 1, Rect.bottom - Radius),
{$ELSE} {$ELSE}
Create2DIntPoint(Rect.left + 1, Rect.bottom - radius), Create2DIntPoint(Rect.left + 1, Rect.bottom - Radius),
{$ENDIF} {$ENDIF}
Radius, Radius,
cpLeftBottom, cpLeftBottom,
InnerLightColor, InnerLightColor,
ClipRect); ClipRect
if not(RightEdgeOpen or BottomEdgeOpen) then );
TGuiTools.DrawAARoundCorner(Bitmap, if not(RightEdgeOpen or BottomEdgeOpen) then
TGuiTools.DrawAARoundCorner(
Bitmap,
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
T2DIntPoint.create(Rect.right - radius, Rect.bottom - radius), T2DIntPoint.create(Rect.right - Radius, Rect.bottom - Radius),
{$ELSE} {$ELSE}
Create2DIntPoint(Rect.right - radius, Rect.bottom - radius), Create2DIntPoint(Rect.right - Radius, Rect.bottom - Radius),
{$ENDIF} {$ENDIF}
Radius, Radius,
cpRightBottom, cpRightBottom,
InnerLightColor, InnerLightColor,
ClipRect); ClipRect
);
// Zewnêtrzna krawêdŸ // Zewnêtrzna krawêdŸ
// Zaokr¹glone naro¿niki // Zaokr¹glone naro¿niki
if not(TopEdgeOpen) then if not TopEdgeOpen then
begin begin
x1:=Rect.Left + Radius * LeftClosed; x1 := Rect.Left + Radius * LeftClosed;
x2:=Rect.Right - Radius * RightClosed; x2 := Rect.Right - Radius * RightClosed;
y1:=Rect.Top; y1 := Rect.Top;
TGuiTools.DrawHLine(Bitmap, x1, x2, y1, FrameColor, ClipRect); TGuiTools.DrawHLine(Bitmap, x1, x2, y1, FrameColor, ClipRect);
end; end;
if not(BottomEdgeOpen) then if not BottomEdgeOpen then
begin begin
x1:=Rect.Left + Radius * LeftClosed; x1 := Rect.Left + Radius * LeftClosed;
x2:=Rect.Right - Radius * RightClosed; x2 := Rect.Right - Radius * RightClosed;
y1:=Rect.Bottom; y1 := Rect.Bottom;
TGuiTools.DrawHLine(Bitmap, x1, x2, y1, FrameColor, ClipRect); TGuiTools.DrawHLine(Bitmap, x1, x2, y1, FrameColor, ClipRect);
end; end;
if not(LeftEdgeOpen) then if not LeftEdgeOpen then
begin begin
y1:=Rect.Top + Radius * TopClosed; y1 := Rect.Top + Radius * TopClosed;
y2:=Rect.Bottom - Radius * BottomClosed; y2 := Rect.Bottom - Radius * BottomClosed;
x1:=Rect.Left; x1 := Rect.Left;
TGuiTools.DrawVLine(Bitmap, x1, y1, y2, FrameColor, ClipRect); TGuiTools.DrawVLine(Bitmap, x1, y1, y2, FrameColor, ClipRect);
end; end;
if not(RightEdgeOpen) then if not(RightEdgeOpen) then
begin begin
y1:=Rect.Top + Radius * TopClosed; y1 := Rect.Top + Radius * TopClosed;
y2:=Rect.Bottom - Radius * BottomClosed; y2 := Rect.Bottom - Radius * BottomClosed;
x1:=Rect.Right; x1 := Rect.Right;
TGuiTools.DrawVLine(Bitmap, x1, y1, y2, FrameColor, ClipRect); TGuiTools.DrawVLine(Bitmap, x1, y1, y2, FrameColor, ClipRect);
end; end;
if not(LeftEdgeOpen or TopEdgeOpen) then if not(LeftEdgeOpen or TopEdgeOpen) then
TGuiTools.DrawAARoundCorner(Bitmap, TGuiTools.DrawAARoundCorner(
Bitmap,
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
T2DIntPoint.create(Rect.left, Rect.Top), T2DIntPoint.create(Rect.left, Rect.Top),
{$ELSE} {$ELSE}
@ -192,9 +204,12 @@ if not(LeftEdgeOpen or TopEdgeOpen) then
Radius, Radius,
cpLeftTop, cpLeftTop,
FrameColor, FrameColor,
ClipRect); ClipRect
if not(RightEdgeOpen or TopEdgeOpen) then );
TGuiTools.DrawAARoundCorner(Bitmap,
if not(RightEdgeOpen or TopEdgeOpen) then
TGuiTools.DrawAARoundCorner(
Bitmap,
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
T2DIntPoint.create(Rect.right - radius + 1, Rect.Top), T2DIntPoint.create(Rect.right - radius + 1, Rect.Top),
{$ELSE} {$ELSE}
@ -203,9 +218,12 @@ if not(RightEdgeOpen or TopEdgeOpen) then
Radius, Radius,
cpRightTop, cpRightTop,
FrameColor, FrameColor,
ClipRect); ClipRect
if not(LeftEdgeOpen or BottomEdgeOpen) then );
TGuiTools.DrawAARoundCorner(Bitmap,
if not(LeftEdgeOpen or BottomEdgeOpen) then
TGuiTools.DrawAARoundCorner(
Bitmap,
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
T2DIntPoint.create(Rect.left, Rect.bottom - radius + 1), T2DIntPoint.create(Rect.left, Rect.bottom - radius + 1),
{$ELSE} {$ELSE}
@ -214,18 +232,22 @@ if not(LeftEdgeOpen or BottomEdgeOpen) then
Radius, Radius,
cpLeftBottom, cpLeftBottom,
FrameColor, FrameColor,
ClipRect); ClipRect
if not(RightEdgeOpen or BottomEdgeOpen) then );
TGuiTools.DrawAARoundCorner(Bitmap,
if not(RightEdgeOpen or BottomEdgeOpen) then
TGuiTools.DrawAARoundCorner(
Bitmap,
{$IFDEF EnhancedRecordSupport} {$IFDEF EnhancedRecordSupport}
T2DIntPoint.create(Rect.right - radius + 1, Rect.bottom - radius + 1), T2DIntPoint.create(Rect.right - radius + 1, Rect.bottom - radius + 1),
{$ELSE} {$ELSE}
Create2DIntPoint(Rect.right - radius + 1, Rect.bottom - radius + 1), Create2DIntPoint(Rect.right - Radius + 1, Rect.bottom - radius + 1),
{$ENDIF} {$ENDIF}
Radius, Radius,
cpRightBottom, cpRightBottom,
FrameColor, FrameColor,
ClipRect); ClipRect
);
end; end;
end. end.

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

@ -1,10 +1,10 @@
object frmAppearanceEditWindow: TfrmAppearanceEditWindow object frmAppearanceEditWindow: TfrmAppearanceEditWindow
Left = 617 Left = 617
Height = 540 Height = 561
Top = 138 Top = 138
Width = 562 Width = 562
Caption = 'Toolbar appearance editor' Caption = 'Toolbar appearance editor'
ClientHeight = 540 ClientHeight = 561
ClientWidth = 562 ClientWidth = 562
Color = clBtnFace Color = clBtnFace
Font.Color = clWindowText Font.Color = clWindowText
@ -318,7 +318,7 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
end end
object PageControl1: TPageControl object PageControl1: TPageControl
Left = 0 Left = 0
Height = 368 Height = 389
Top = 132 Top = 132
Width = 562 Width = 562
ActivePage = TabSheet3 ActivePage = TabSheet3
@ -1096,7 +1096,7 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
end end
object TabSheet3: TTabSheet object TabSheet3: TTabSheet
Caption = 'Item' Caption = 'Item'
ClientHeight = 340 ClientHeight = 361
ClientWidth = 554 ClientWidth = 554
ImageIndex = 2 ImageIndex = 2
object sItemRectangle: TShape object sItemRectangle: TShape
@ -1254,10 +1254,13 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
AnchorSideLeft.Control = pItemIdleInnerLight AnchorSideLeft.Control = pItemIdleInnerLight
AnchorSideTop.Control = pItemIdleInnerLight AnchorSideTop.Control = pItemIdleInnerLight
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = pItemIdleInnerLight
AnchorSideRight.Side = asrBottom
Left = 116 Left = 116
Height = 25 Height = 25
Top = 279 Top = 279
Width = 121 Width = 100
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 20 BorderSpacing.Top = 20
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
BevelInner = bvRaised BevelInner = bvRaised
@ -1982,6 +1985,42 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
GroupIndex = 1 GroupIndex = 1
OnClick = bItemActiveInnerLightColorClick OnClick = bItemActiveInnerLightColorClick
end end
object cbItemStyle: TComboBox
AnchorSideLeft.Control = pItemIdleGradientFrom
AnchorSideTop.Control = pItemFont
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = pItemIdleGradientTo
AnchorSideRight.Side = asrBottom
Left = 116
Height = 23
Top = 310
Width = 100
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 6
ItemHeight = 15
ItemIndex = 0
Items.Strings = (
'Rounded'
'Rectangle'
)
OnChange = cbItemStyleChange
Style = csDropDownList
TabOrder = 23
Text = 'Rounded'
end
object Label27: TLabel
AnchorSideTop.Control = cbItemStyle
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = LblInnerLightColor
AnchorSideRight.Side = asrBottom
Left = 71
Height = 15
Top = 314
Width = 25
Anchors = [akTop, akRight]
Caption = 'Style'
ParentColor = False
end
end end
object TabSheet4: TTabSheet object TabSheet4: TTabSheet
Caption = 'Import / export' Caption = 'Import / export'
@ -2105,7 +2144,7 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
object ButtonPanel: TPanel object ButtonPanel: TPanel
Left = 8 Left = 8
Height = 24 Height = 24
Top = 508 Top = 529
Width = 546 Width = 546
Align = alBottom Align = alBottom
BorderSpacing.Around = 8 BorderSpacing.Around = 8
@ -2191,8 +2230,8 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
'ColorS=F0FBFF' 'ColorS=F0FBFF'
'ColorT=A4A0A0' 'ColorT=A4A0A0'
) )
left = 216 left = 280
top = 464 top = 512
end end
object fdFontDialog: TFontDialog object fdFontDialog: TFontDialog
Font.Color = clWindowText Font.Color = clWindowText
@ -2200,18 +2239,18 @@ object frmAppearanceEditWindow: TfrmAppearanceEditWindow
Font.Name = 'Tahoma' Font.Name = 'Tahoma'
MinFontSize = 0 MinFontSize = 0
MaxFontSize = 0 MaxFontSize = 0
left = 312 left = 376
top = 464 top = 512
end end
object LargeImages: TImageList object LargeImages: TImageList
Height = 32 Height = 32
Width = 32 Width = 32
left = 48 left = 112
top = 464 top = 512
end end
object SmallImages: TImageList object SmallImages: TImageList
left = 128 left = 192
top = 464 top = 512
Bitmap = { Bitmap = {
4C69010000001000000010000000000000000000000000000000000000000000 4C69010000001000000010000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000000000005BA36C7380C4 00000000000000000000000000000000000000000000000000005BA36C7380C4

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

@ -46,10 +46,12 @@ type
bActiveTabHeaderFontColor: TSpeedButton; bActiveTabHeaderFontColor: TSpeedButton;
bExportToPascal: TButton; bExportToPascal: TButton;
bCopyToClipboard: TButton; bCopyToClipboard: TButton;
cbItemStyle: TComboBox;
cbPaneStyle: TComboBox; cbPaneStyle: TComboBox;
ColorView: TShape; ColorView: TShape;
gbPreview: TGroupBox; gbPreview: TGroupBox;
Label12: TLabel; Label12: TLabel;
Label27: TLabel;
LblCaptionBackground1: TLabel; LblCaptionBackground1: TLabel;
LblRGB: TLabel; LblRGB: TLabel;
SmallImages: TImageList; SmallImages: TImageList;
@ -195,6 +197,7 @@ type
procedure cbItemActiveGradientKindChange(Sender: TObject); procedure cbItemActiveGradientKindChange(Sender: TObject);
procedure cbItemHottrackGradientKindChange(Sender: TObject); procedure cbItemHottrackGradientKindChange(Sender: TObject);
procedure cbItemIdleGradientKindChange(Sender: TObject); procedure cbItemIdleGradientKindChange(Sender: TObject);
procedure cbItemStyleChange(Sender: TObject);
procedure cbPaneGradientKindChange(Sender: TObject); procedure cbPaneGradientKindChange(Sender: TObject);
procedure cbPaneStyleChange(Sender: TObject); procedure cbPaneStyleChange(Sender: TObject);
procedure cbTabGradientKindChange(Sender: TObject); procedure cbTabGradientKindChange(Sender: TObject);
@ -736,6 +739,12 @@ begin
SetLinkedGradientKind((Sender as TComboBox).ItemIndex); SetLinkedGradientKind((Sender as TComboBox).ItemIndex);
end; end;
procedure TfrmAppearanceEditWindow.cbItemStyleChange(Sender: TObject);
begin
with tbPreview.Appearance.Element do
Style := TSpkElementStyle((Sender as TCombobox).ItemIndex);
end;
procedure TfrmAppearanceEditWindow.cbLinkItemClick(Sender: TObject); procedure TfrmAppearanceEditWindow.cbLinkItemClick(Sender: TObject);
begin begin
SwitchAttributesLink(cbLinkItem.Checked); SwitchAttributesLink(cbLinkItem.Checked);
@ -899,6 +908,8 @@ begin
SetPanelColor(pItemActiveCaptionColor, ActiveCaptionColor); SetPanelColor(pItemActiveCaptionColor, ActiveCaptionColor);
SetPanelColor(pItemActiveInnerDark, ActiveInnerDarkColor); SetPanelColor(pItemActiveInnerDark, ActiveInnerDarkColor);
SetPanelColor(pItemActiveInnerLight, ActiveInnerLightColor); SetPanelColor(pItemActiveInnerLight, ActiveInnerLightColor);
cbItemStyle.ItemIndex := ord(Style);
end; end;
end; end;
end; end;