You've already forked lazarus-ccr
spktoolbar: Initial commit of TSpkPopupMenu.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8725 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -18,7 +18,7 @@ interface
|
||||
{$MESSAGE HINT 'Every rect in this module are exact rectanges (not like in WINAPI without right and bottom)'}
|
||||
|
||||
uses
|
||||
LCLType, LCLVersion, Graphics, SysUtils, Classes, Controls, StdCtrls,
|
||||
LCLType, LCLVersion, Graphics, SysUtils, Classes, Controls, StdCtrls, ImgList,
|
||||
SpkGraphTools, SpkMath;
|
||||
|
||||
type
|
||||
@ -36,7 +36,7 @@ type
|
||||
TGUITools = class(TObject)
|
||||
protected
|
||||
class procedure FillGradientRectangle(ACanvas: TCanvas; Rect: T2DIntRect;
|
||||
ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind);
|
||||
ColorFrom, ColorTo: TColor; GradientKind: TBackgroundKind; ReflectionEdgePercent: Integer = 25);
|
||||
class procedure SaveClipRgn(DC: HDC; out OrgRgnExists: boolean; out OrgRgn: HRGN);
|
||||
class procedure RestoreClipRgn(DC: HDC; OrgRgnExists: boolean; var OrgRgn: HRGN);
|
||||
public
|
||||
@ -247,6 +247,12 @@ type
|
||||
LeftBottomRound : boolean = true;
|
||||
RightBottomRound : boolean = true); overload;
|
||||
|
||||
class procedure DrawPopupItemRect(ACanvas: TCanvas;
|
||||
ARect: T2DIntRect;
|
||||
ARadius: Integer;
|
||||
AGradientColorFrom, AGradientColorTo: TColor;
|
||||
AGradientKind: TBackgroundKind);
|
||||
|
||||
class procedure DrawRegion(ACanvas : TCanvas;
|
||||
Region : HRGN;
|
||||
Rect : T2DIntRect;
|
||||
@ -263,46 +269,47 @@ type
|
||||
|
||||
// Imagelist tools
|
||||
class procedure DrawImage(ABitmap : TBitmap;
|
||||
Imagelist : TImageList;
|
||||
Imagelist : TCustomImageList;
|
||||
ImageIndex : integer;
|
||||
Point : T2DIntVector); overload; inline;
|
||||
class procedure DrawImage(ABitmap : TBitmap;
|
||||
Imagelist : TImageList;
|
||||
Imagelist : TCustomImageList;
|
||||
ImageIndex : integer;
|
||||
Point : T2DIntVector;
|
||||
ClipRect : T2DIntRect); overload; inline;
|
||||
class procedure DrawImage(ACanvas : TCanvas;
|
||||
Imagelist : TImageList;
|
||||
Imagelist : TCustomImageList;
|
||||
ImageIndex : integer;
|
||||
Point : T2DIntVector); overload; inline;
|
||||
class procedure DrawImage(ACanvas : TCanvas;
|
||||
Imagelist : TImageList;
|
||||
Imagelist : TCustomImageList;
|
||||
ImageIndex : integer;
|
||||
Point : T2DIntVector;
|
||||
ClipRect : T2DIntRect); overload;
|
||||
class procedure DrawImage(ACanvas: TCanvas;
|
||||
Imagelist: TImageList;
|
||||
Imagelist: TCustomImageList;
|
||||
ImageIndex: integer;
|
||||
Point : T2DIntVector;
|
||||
ClipRect: T2DIntRect;
|
||||
AImageWidthAt96PPI, ATargetPPI: Integer;
|
||||
ACanvasFactor: Double); overload;
|
||||
ACanvasFactor: Double;
|
||||
AEnabled: Boolean); overload;
|
||||
|
||||
class procedure DrawDisabledImage(ABitmap : TBitmap;
|
||||
Imagelist : TImageList;
|
||||
Imagelist : TCustomImageList;
|
||||
ImageIndex : integer;
|
||||
Point : T2DIntVector); overload; inline;
|
||||
class procedure DrawDisabledImage(ABitmap : TBitmap;
|
||||
Imagelist : TImageList;
|
||||
Imagelist : TCustomImageList;
|
||||
ImageIndex : integer;
|
||||
Point : T2DIntVector;
|
||||
ClipRect : T2DIntRect); overload; inline;
|
||||
class procedure DrawDisabledImage(ACanvas : TCanvas;
|
||||
Imagelist : TImageList;
|
||||
Imagelist : TCustomImageList;
|
||||
ImageIndex : integer;
|
||||
Point : T2DIntVector); overload;
|
||||
class procedure DrawDisabledImage(ACanvas : TCanvas;
|
||||
Imagelist : TImageList;
|
||||
Imagelist : TCustomImageList;
|
||||
ImageIndex : integer;
|
||||
Point : T2DIntVector;
|
||||
ClipRect : T2DIntRect); overload; inline;
|
||||
@ -1857,19 +1864,19 @@ begin
|
||||
DeleteObject(ClipRgn);
|
||||
end;
|
||||
|
||||
class procedure TGUITools.DrawImage(ABitmap: TBitmap; Imagelist: TImageList;
|
||||
class procedure TGUITools.DrawImage(ABitmap: TBitmap; Imagelist: TCustomImageList;
|
||||
ImageIndex: integer; Point : T2DIntVector; ClipRect: T2DIntRect);
|
||||
begin
|
||||
DrawImage(ABitmap.Canvas, ImageList, ImageIndex, Point, ClipRect);
|
||||
end;
|
||||
|
||||
class procedure TGUITools.DrawImage(ABitmap: TBitmap; Imagelist: TImageList;
|
||||
class procedure TGUITools.DrawImage(ABitmap: TBitmap; Imagelist: TCustomImageList;
|
||||
ImageIndex: integer; Point: T2DIntVector);
|
||||
begin
|
||||
DrawImage(ABitmap.Canvas, ImageList, ImageIndex, Point);
|
||||
end;
|
||||
|
||||
class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TImageList;
|
||||
class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TCustomImageList;
|
||||
ImageIndex: integer; Point : T2DIntVector; ClipRect: T2DIntRect);
|
||||
var
|
||||
UseOrgClipRgn: Boolean;
|
||||
@ -1919,9 +1926,9 @@ begin
|
||||
DeleteObject(ClipRgn);
|
||||
end;
|
||||
|
||||
class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TImageList;
|
||||
class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TCustomImageList;
|
||||
ImageIndex: integer; Point : T2DIntVector; ClipRect: T2DIntRect;
|
||||
AImageWidthAt96PPI, ATargetPPI: Integer; ACanvasFactor: Double);
|
||||
AImageWidthAt96PPI, ATargetPPI: Integer; ACanvasFactor: Double; AEnabled: Boolean);
|
||||
var
|
||||
UseOrgClipRgn: Boolean;
|
||||
OrgRgn: HRGN;
|
||||
@ -1940,9 +1947,9 @@ begin
|
||||
|
||||
{$IF LCL_FULLVERSION >= 1090000}
|
||||
ImageList.DrawForPPI(ACanvas, Point.X, Point.Y, ImageIndex,
|
||||
AImageWidthAt96PPI, ATargetPPI, ACanvasFactor);
|
||||
AImageWidthAt96PPI, ATargetPPI, ACanvasFactor, AEnabled);
|
||||
{$ELSE}
|
||||
ImageList.Draw(ACanvas, Point.X, Point.Y, ImageIndex);
|
||||
ImageList.Draw(ACanvas, Point.X, Point.Y, ImageIndex, AEnabled);
|
||||
{$ENDIF}
|
||||
|
||||
(*
|
||||
@ -2063,7 +2070,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TImageList;
|
||||
class procedure TGUITools.DrawImage(ACanvas: TCanvas; Imagelist: TCustomImageList;
|
||||
ImageIndex: integer; Point: T2DIntVector);
|
||||
begin
|
||||
ImageList.Draw(ACanvas, Point.x, Point.y, ImageIndex);
|
||||
@ -2473,7 +2480,7 @@ end;
|
||||
|
||||
class procedure TGUITools.FillGradientRectangle(ACanvas: TCanvas;
|
||||
Rect: T2DIntRect; ColorFrom: TColor; ColorTo: TColor;
|
||||
GradientKind: TBackgroundKind);
|
||||
GradientKind: TBackgroundKind; ReflectionEdgePercent: Integer = 25);
|
||||
var
|
||||
Mesh: array of GRADIENTRECT = nil;
|
||||
GradientVertice: array of TRIVERTEX = nil;
|
||||
@ -2531,7 +2538,7 @@ begin
|
||||
with GradientVertice[1] do
|
||||
begin
|
||||
x := Rect.Right + 1;
|
||||
y := Rect.Top + (Rect.height) div 4;
|
||||
y := Rect.Top + Rect.height * ReflectionEdgePercent div 100;
|
||||
Red := GetRValue(ConcaveColor) shl 8;
|
||||
Green := GetGValue(ConcaveColor) shl 8;
|
||||
Blue := GetBValue(ConcaveColor) shl 8;
|
||||
@ -2540,7 +2547,7 @@ begin
|
||||
with GradientVertice[2] do
|
||||
begin
|
||||
x := Rect.left;
|
||||
y := Rect.Top + (Rect.height) div 4;
|
||||
y := Rect.Top + Rect.Height * ReflectionEdgePercent div 100;
|
||||
Red := GetRValue(ColorTo) shl 8;
|
||||
Green := GetGValue(ColorTo) shl 8;
|
||||
Blue := GetBValue(ColorTo) shl 8;
|
||||
@ -2809,20 +2816,20 @@ begin
|
||||
end;
|
||||
|
||||
class procedure TGUITools.DrawDisabledImage(ABitmap: TBitmap;
|
||||
Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector;
|
||||
Imagelist: TCustomImageList; ImageIndex: integer; Point: T2DIntVector;
|
||||
ClipRect: T2DIntRect);
|
||||
begin
|
||||
DrawDisabledImage(ABitmap.Canvas, ImageList, ImageIndex, Point, ClipRect);
|
||||
end;
|
||||
|
||||
class procedure TGUITools.DrawDisabledImage(ABitmap: TBitmap;
|
||||
Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector);
|
||||
Imagelist: TCustomImageList; ImageIndex: integer; Point: T2DIntVector);
|
||||
begin
|
||||
DrawDisabledImage(ABitmap.Canvas, ImageList, ImageIndex, Point);
|
||||
end;
|
||||
|
||||
class procedure TGUITools.DrawDisabledImage(ACanvas: TCanvas;
|
||||
Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector;
|
||||
Imagelist: TCustomImageList; ImageIndex: integer; Point: T2DIntVector;
|
||||
ClipRect: T2DIntRect);
|
||||
var
|
||||
UseOrgClipRgn: Boolean;
|
||||
@ -2851,7 +2858,7 @@ begin
|
||||
end;
|
||||
|
||||
class procedure TGUITools.DrawDisabledImage(ACanvas: TCanvas;
|
||||
Imagelist: TImageList; ImageIndex: integer; Point: T2DIntVector);
|
||||
Imagelist: TCustomImageList; ImageIndex: integer; Point: T2DIntVector);
|
||||
var
|
||||
DCStackPos : integer;
|
||||
begin
|
||||
@ -2919,4 +2926,42 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
class procedure TGUITools.DrawPopupItemRect(ACanvas: TCanvas; ARect: T2DIntRect;
|
||||
ARadius: Integer; AGradientColorFrom, AGradientColorTo: TColor;
|
||||
AGradientKind: TBackgroundKind);
|
||||
var
|
||||
RoundRgn: HRGN;
|
||||
TmpRgn: HRGN;
|
||||
OrgRgn: HRGN;
|
||||
UseOrgClipRgn: Boolean;
|
||||
begin
|
||||
if ARadius < 0 then
|
||||
exit;
|
||||
|
||||
if ARadius > 0 then
|
||||
begin
|
||||
if (ARadius*2 > ARect.Width) or (ARadius*2 > ARect.Height) then
|
||||
exit;
|
||||
|
||||
SaveClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
|
||||
RoundRgn := CreateRoundRectRgn(ARect.Left, ARect.Top, ARect.Right + 2, ARect.Bottom + 2, ARadius*2, ARadius*2);
|
||||
|
||||
if UseOrgClipRgn then
|
||||
CombineRgn(RoundRgn, RoundRgn, OrgRgn, RGN_AND);
|
||||
|
||||
SelectClipRgn(ACanvas.Handle, RoundRgn);
|
||||
end; // if Radius > 0
|
||||
|
||||
AGradientColorFrom := ColorToRGB(AGradientColorFrom);
|
||||
AGradientColorTo := ColorToRGB(AGradientColorTo);
|
||||
FillGradientRectangle(ACanvas, ARect, AGradientColorFrom, AGradientColorTo, AGradientKind, 40);
|
||||
|
||||
if ARadius > 0 then
|
||||
begin
|
||||
// Restores previous ClipRgn and removes used regions
|
||||
RestoreClipRgn(ACanvas.Handle, UseOrgClipRgn, OrgRgn);
|
||||
DeleteObject(RoundRgn);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
214
components/spktoolbar/SpkPopupMenu/spkpopup.pas
Normal file
214
components/spktoolbar/SpkPopupMenu/spkpopup.pas
Normal file
@ -0,0 +1,214 @@
|
||||
unit SpkPopup;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
LCLType, Types, Classes, Controls, SysUtils, Graphics, Menus,
|
||||
spkt_Const, SpkGUITools, SpkMath, SpkGraphTools, spkt_Appearance;
|
||||
|
||||
type
|
||||
TSpkPopupMenu = class(TPopupMenu)
|
||||
private
|
||||
FAppearance: TSpkToolbarAppearance;
|
||||
procedure SetAppearance(AValue: TSpkToolbarAppearance);
|
||||
function GetIconSize: TSize;
|
||||
function GetPPI: Integer;
|
||||
|
||||
protected
|
||||
procedure DrawItemHandler(Sender: TObject; ACanvas: TCanvas;
|
||||
ARect: TRect; AState: TOwnerDrawState); virtual;
|
||||
procedure MeasureItemHandler(Sender: TObject; ACanvas: TCanvas;
|
||||
var AWidth, AHeight: Integer); virtual;
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
|
||||
public
|
||||
//constructor Create(AOwner: TComponent); override;
|
||||
property Appearance: TSpkToolbarAppearance read FAppearance write SetAppearance;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure TSpkPopupMenu.DrawItemHandler(Sender: TObject; ACanvas: TCanvas;
|
||||
ARect: TRect; AState: TOwnerDrawState);
|
||||
var
|
||||
menuItem: TMenuItem;
|
||||
FrameColor: TColor = clNone;
|
||||
ColorFrom: TColor;
|
||||
ColorTo: TColor;
|
||||
TextColor: TColor;
|
||||
GradientType: TBackgroundKind;
|
||||
P: T2DIntPoint;
|
||||
R, Rgutter: T2DIntRect;
|
||||
Radius: Integer;
|
||||
x, y, wGutter, hText: Integer;
|
||||
iconSize: TSize;
|
||||
isHot: Boolean;
|
||||
begin
|
||||
if FAppearance = nil then
|
||||
exit;
|
||||
|
||||
if (Sender is TMenuItem) then
|
||||
begin
|
||||
menuItem := TMenuItem(Sender);
|
||||
|
||||
{$IFDEF EnhancedRecordSupport}
|
||||
R := T2DIntRect.Create(
|
||||
{$ELSE}
|
||||
R := Create2DIntRect(
|
||||
{$ENDIF}
|
||||
ARect.Left,
|
||||
ARect.Top,
|
||||
ARect.Right,
|
||||
ARect.Bottom
|
||||
);
|
||||
isHot := AState * [odSelected, odHotLight] <>[];
|
||||
if not menuItem.Enabled then isHot := false;
|
||||
|
||||
// Draw background
|
||||
if isHot then
|
||||
begin
|
||||
FrameColor := FAppearance.Popup.HotTrackFrameColor;
|
||||
ColorFrom := FAppearance.Popup.HotTrackGradientFromColor;
|
||||
ColorTo := FAppearance.Popup.HotTrackGradientToColor;
|
||||
GradientType := FAppearance.Popup.HotTrackGradientType;
|
||||
Radius := 0; // maybe to be changed...
|
||||
end else
|
||||
begin
|
||||
ColorFrom := FAppearance.Popup.IdleGradientFromColor;
|
||||
ColorTo := FAppearance.Popup.IdleGradientToColor;
|
||||
GradientType := FAppearance.Popup.IdleGradientType;
|
||||
Radius := 0;
|
||||
end;
|
||||
TGUITools.DrawPopupItemRect(ACanvas, R, Radius, ColorFrom, ColorTo, GradientType);
|
||||
if isHot and (FrameColor <> clNone) then
|
||||
begin
|
||||
TGUITools.DrawHLine(ACanvas, R.Left, R.Right-1, R.Top, FrameColor);
|
||||
TGUITools.DrawHLine(ACanvas, R.Left, R.Right-1, R.Bottom-1, FrameColor);
|
||||
TGUITools.DrawVLine(ACanvas, R.Left, R.Top, R.Bottom-1, FrameColor);
|
||||
TGUITools.DrawVLine(ACanvas, R.Right-1, R.Top, R.Bottom-1, FrameColor);
|
||||
end;
|
||||
|
||||
iconSize := GetIconSize;
|
||||
wGutter := iconSize.CX + 2*DropdownMenuMargin;
|
||||
{$IFDEF EnhancedRecordSupport}
|
||||
Rgutter := T2DIntRect.Create(
|
||||
{$ELSE}
|
||||
Rgutter := Create2DIntRect(
|
||||
{$ENDIF}
|
||||
ARect.Left,
|
||||
ARect.Top,
|
||||
ARect.Left + wGutter - 1,
|
||||
ARect.Bottom
|
||||
);
|
||||
|
||||
if not IsHot and (FAppearance.Popup.Style = psGutter) then
|
||||
begin
|
||||
ColorFrom := FAppearance.Popup.GutterGradientFromColor;
|
||||
ColorTo := FAppearance.Popup.GutterGradientToColor;
|
||||
GradientType := FAppearance.Popup.GutterGradientType;
|
||||
TGUITools.DrawPopupItemRect(ACanvas, Rgutter, 0, ColorFrom, ColorTo, GradientType);
|
||||
FrameColor := FAppearance.Popup.GutterLineColor;
|
||||
if FrameColor <> clNone then
|
||||
TGUITools.DrawVLine(ACanvas, Rgutter.Right+1, R.Top, R.Bottom, FrameColor);
|
||||
end;
|
||||
|
||||
// Draw icon
|
||||
if Assigned(Images) and (menuItem.ImageIndex > -1) then
|
||||
begin
|
||||
P := {$IFDEF EnhancedRecordSupport}T2DIntPoint.Create{$ELSE}Create2DIntPoint{$ENDIF}(
|
||||
ARect.Left + DropdownMenuMargin,
|
||||
(ARect.Top + ARect.Bottom - iconSize.CY) div 2
|
||||
);
|
||||
TGUITools.DrawImage(ACanvas, Images, menuItem.ImageIndex, P, RGutter, ImagesWidth, GetPPI, 1.0, menuItem.Enabled);
|
||||
end;
|
||||
|
||||
// Draw text
|
||||
if menuItem.Enabled then
|
||||
begin
|
||||
if isHot then
|
||||
TextColor := FAppearance.Popup.HotTrackCaptionColor
|
||||
else
|
||||
TextColor := FAppearance.Popup.IdleCaptionColor;
|
||||
end else
|
||||
TextColor := FAppearance.Popup.DisabledCaptionColor;
|
||||
|
||||
ACanvas.Font.Assign(FAppearance.Popup.CaptionFont);
|
||||
ACanvas.Font.Color := TextColor;
|
||||
hText := ACanvas.TextHeight('Tg');
|
||||
|
||||
x := wGutter;
|
||||
inc(x, DropdownMenuMargin*2);
|
||||
|
||||
if (menuItem.Caption = '-') or (menuItem.Caption = '|') then
|
||||
begin
|
||||
if FAppearance.Popup.Style <> psGutter then
|
||||
x := DropDownMenuMargin;
|
||||
y := (ARect.Top + ARect.Bottom) div 2;
|
||||
TGUITools.DrawHLine(ACanvas, x, ARect.Right-DropdownMenuMargin, y, TextColor);
|
||||
end else
|
||||
begin
|
||||
y := (ARect.Top + ARect.Bottom - hText) div 2;
|
||||
TGUITools.DrawText(ACanvas, x, y, menuItem.Caption, TextColor);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSpkPopupMenu.GetIconSize: TSize;
|
||||
begin
|
||||
if Assigned(Images) then
|
||||
Result := Images.SizeForPPI[ImagesWidth, GetPPI]
|
||||
else
|
||||
begin
|
||||
Result.CX := ScaleX(16, 96);
|
||||
Result.CY := Result.CY;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSpkPopupMenu.GetPPI: Integer;
|
||||
begin
|
||||
if Parent is TControl then
|
||||
Result := TControl(Parent).Font.PixelsPerInch
|
||||
else
|
||||
Result := ScreenInfo.PixelsPerInchX;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenu.MeasureItemHandler(Sender: TObject; ACanvas: TCanvas;
|
||||
var AWidth, AHeight: Integer);
|
||||
begin
|
||||
//
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenu.Notification(AComponent: TComponent; Operation: TOperation);
|
||||
begin
|
||||
inherited Notification(AComponent, Operation);
|
||||
if Operation = opRemove then
|
||||
begin
|
||||
(* FAppearance does not inherit from TComponent !!!!!!!!!!!
|
||||
if AComponent = FAppearance then
|
||||
FAppearance := nil;
|
||||
*)
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenu.SetAppearance(AValue: TSpkToolbarAppearance);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if FAppearance = AValue then
|
||||
exit;
|
||||
FAppearance := AValue;
|
||||
OwnerDraw := FAppearance <> nil;
|
||||
OnDrawItem := @DrawItemHandler;
|
||||
//OnMeasureItem := @MeasureItemHandler;
|
||||
|
||||
for i := 0 to Items.Count-1 do
|
||||
begin
|
||||
Items[i].OnDrawItem := @DrawItemHandler;
|
||||
//Items[i].OnMeasureItem := @MeasureItemHandler;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -2418,6 +2418,8 @@ begin
|
||||
SmallButtonSeparatorTopMargin := round(SMALLBUTTON_SEPARATOR_TOP_MARGIN * AYProportion);
|
||||
SmallButtonSeparatorBottomMargin := round(SMALLBUTTON_SEPARATOR_BOTTOM_MARGIN * AYProportion);
|
||||
|
||||
DropdownMenuMargin := round(DROPDOWN_MENU_MARGIN * AYProportion);
|
||||
|
||||
MaxElementHeight := round(MAX_ELEMENT_HEIGHT * AYProportion);
|
||||
PaneRowHeight := round(PANE_ROW_HEIGHT * AYProportion);
|
||||
PaneFullRowHeight := 3 * PaneRowHeight;
|
||||
|
||||
@ -28,6 +28,8 @@ type
|
||||
|
||||
TSpkElementStyle = (esRounded, esRectangle);
|
||||
|
||||
TSpkPopupStyle = (psDefault, psGutter);
|
||||
|
||||
TSpkMenuButtonShapeStyle = (mbssRounded, mbssRectangle);
|
||||
|
||||
TSpkStyle = (
|
||||
@ -336,6 +338,70 @@ type
|
||||
property Style: TSpkElementStyle read FStyle write SetStyle;
|
||||
end;
|
||||
|
||||
TSpkPopupMenuAppearance = class(TPersistent)
|
||||
private
|
||||
FDispatch: TSpkBaseAppearanceDispatch;
|
||||
FCaptionFont: TFont;
|
||||
FDisabledCaptionColor : TColor;
|
||||
FGutterGradientFromColor: TColor;
|
||||
FGutterGradientToColor: TColor;
|
||||
FGutterGradientType: TBackgroundKind;
|
||||
FGutterLineColor: TColor;
|
||||
FHotTrackCaptionColor: TColor;
|
||||
FHotTrackFrameColor: TColor;
|
||||
FHotTrackGradientFromColor: TColor;
|
||||
FHotTrackGradientToColor: TColor;
|
||||
FHotTrackGradientType: TBackgroundKind;
|
||||
FIdleCaptionColor: TColor;
|
||||
FIdleGradientFromColor: TColor;
|
||||
FIdleGradientToColor: TColor;
|
||||
FIdleGradientType: TBackgroundKind;
|
||||
FStyle: TSpkPopupStyle;
|
||||
procedure SetCaptionFont(const Value: TFont);
|
||||
procedure SetDisabledCaptionColor(const Value: TColor);
|
||||
procedure SetGutterGradientFromColor(const Value: TColor);
|
||||
procedure SetGutterGradientToColor(const Value: TColor);
|
||||
procedure SetGutterGradientType(const Value: TBackgroundKind);
|
||||
procedure SetGutterLineColor(const Value: TColor);
|
||||
procedure SetHotTrackCaptionColor(const Value: TColor);
|
||||
procedure SetHotTrackFrameColor(const Value: TColor);
|
||||
procedure SetHotTrackGradientFromColor(const Value: TColor);
|
||||
procedure SetHotTrackGradientToColor(const Value: TColor);
|
||||
procedure SetHotTrackGradientType(const Value: TBackgroundKind);
|
||||
procedure SetIdleCaptionColor(const Value: TColor);
|
||||
procedure SetIdleGradientFromColor(const Value: TColor);
|
||||
procedure SetIdleGradientToColor(const Value: TColor);
|
||||
procedure SetIdleGradientType(const Value: TBackgroundKind);
|
||||
procedure SetStyle(const Value: TSpkPopupStyle);
|
||||
protected
|
||||
procedure CaptionFontChange(Sender: TObject);
|
||||
public
|
||||
constructor Create(ADispatch: TSpkBaseAppearanceDispatch);
|
||||
destructor Destroy; override;
|
||||
procedure Assign(Source: TPersistent); override;
|
||||
procedure LoadFromXML(Node: TSpkXMLNode);
|
||||
procedure SaveToPascal(AList: TStrings);
|
||||
procedure SaveToXML(Node: TSpkXMLNode);
|
||||
procedure Reset(AStyle: TSpkStyle = spkOffice2007Blue);
|
||||
published
|
||||
property CaptionFont: TFont read FCaptionFont write SetCaptionFont;
|
||||
property DisabledCaptionColor: TColor read FDisabledCaptionColor write SetDisabledCaptionColor;
|
||||
property GutterGradientFromColor: TColor read FGutterGradientFromColor write SetGutterGradientFromColor;
|
||||
property GutterGradientToColor: TColor read FGutterGradientToColor write SetGutterGradientToColor;
|
||||
property GutterGradientType: TBackgroundKind read FGutterGradientType write SetGutterGradientType;
|
||||
property GutterLineColor: TColor read FGutterLineColor write SetGutterLineColor;
|
||||
property HotTrackCaptionColor: TColor read FHotTrackCaptionColor write SetHotTrackCaptionColor;
|
||||
property HotTrackFrameColor: TColor read FHotTrackFrameColor write SetHotTrackFrameColor;
|
||||
property HotTrackGradientFromColor: TColor read FHotTrackGradientFromColor write SetHotTrackGradientFromColor;
|
||||
property HotTrackGradientToColor: TColor read FHotTrackGradientToColor write SetHotTrackGradientToColor;
|
||||
property HotTrackGradientType: TBackgroundKind read FHotTrackGradientType write SetHotTrackGradientType;
|
||||
property IdleCaptionColor: TColor read FIdleCaptionColor write SetIdleCaptionColor;
|
||||
property IdleGradientFromColor: TColor read FIdleGradientFromColor write SetIdleGradientFromColor;
|
||||
property IdleGradientToColor: TColor read FIdleGradientToColor write SetIdleGradientToColor;
|
||||
property IdleGradientType: TBackgroundKind read FHotTrackGradientType write SetHotTrackGradientType;
|
||||
property Style: TSpkPopupStyle read FStyle write SetStyle;
|
||||
end;
|
||||
|
||||
|
||||
{ TSpkToolbarAppearance }
|
||||
|
||||
@ -356,10 +422,12 @@ type
|
||||
FMenuButton: TSpkMenuButtonAppearance;
|
||||
FPane: TSpkPaneAppearance;
|
||||
FElement: TSpkElementAppearance;
|
||||
FPopup: TSpkPopupMenuAppearance;
|
||||
FDispatch: TSpkBaseAppearanceDispatch;
|
||||
procedure SetElementAppearance(const Value: TSpkElementAppearance);
|
||||
procedure SetPaneAppearance(const Value: TSpkPaneAppearance);
|
||||
procedure SetTabAppearance(const Value: TSpkTabAppearance);
|
||||
procedure SetPopupAppearance(const Value: TSpkPopupMenuAppearance);
|
||||
procedure SetMenuButtonAppearance(const Value: TSpkMenuButtonAppearance);
|
||||
public
|
||||
constructor Create(ADispatch: TSpkBaseAppearanceDispatch); reintroduce;
|
||||
@ -375,6 +443,7 @@ type
|
||||
property MenuButton: TSpkMenuButtonAppearance read FMenuButton write SetMenuButtonAppearance;
|
||||
property Pane: TSpkPaneAppearance read FPane write SetPaneAppearance;
|
||||
property Element: TSpkElementAppearance read FElement write SetElementAppearance;
|
||||
property Popup: TSpkPopupMenuAppearance read FPopup write SetPopupAppearance;
|
||||
end;
|
||||
|
||||
procedure SetDefaultFont({%H-}AFont: TFont);
|
||||
@ -1658,6 +1727,555 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ TSpkPopupMenuAppearance }
|
||||
|
||||
constructor TSpkPopupMenuAppearance.Create(ADispatch: TSpkBaseAppearanceDispatch);
|
||||
begin
|
||||
inherited Create;
|
||||
FDispatch := ADispatch;
|
||||
FCaptionFont := TFont.Create;
|
||||
FCaptionFont.OnChange := CaptionFontChange;
|
||||
Reset;
|
||||
end;
|
||||
|
||||
destructor TSpkPopupMenuAppearance.Destroy;
|
||||
begin
|
||||
FCaptionFont.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.Assign(Source: TPersistent);
|
||||
var
|
||||
SrcAppearance: TSpkPopupMenuAppearance;
|
||||
begin
|
||||
if Source is TSpkPopupMenuAppearance then
|
||||
begin
|
||||
SrcAppearance := TSpkPopupMenuAppearance(Source);
|
||||
|
||||
FCaptionFont.Assign(SrcAppearance.CaptionFont);
|
||||
FDisabledCaptionColor := SrcAppearance.DisabledCaptionColor;
|
||||
{
|
||||
FIdleFrameColor := SrcAppearance.IdleFrameColor;
|
||||
}
|
||||
FIdleCaptionColor := SrcAppearance.IdleCaptionColor;
|
||||
FIdleGradientFromColor := SrcAppearance.IdleGradientFromColor;
|
||||
FIdleGradientToColor := SrcAppearance.IdleGradientToColor;
|
||||
FIdleGradientType := SrcAppearance.IdleGradientType;
|
||||
{
|
||||
FIdleInnerLightColor := SrcAppearance.IdleInnerLightColor;
|
||||
FIdleInnerDarkColor := SrcAppearance.IdleInnerDarkColor;
|
||||
}
|
||||
FHotTrackCaptionColor := SrcAppearance.HotTrackCaptionColor;
|
||||
FHotTrackFrameColor := SrcAppearance.HotTrackFrameColor;
|
||||
FHotTrackGradientFromColor := SrcAppearance.HotTrackGradientFromColor;
|
||||
FHotTrackGradientToColor := SrcAppearance.HotTrackGradientToColor;
|
||||
FHotTrackGradientType := SrcAppearance.HotTrackGradientType;
|
||||
{
|
||||
FHotTrackInnerLightColor := SrcAppearance.HotTrackInnerLightColor;
|
||||
FHotTrackInnerDarkColor := SrcAppearance.HotTrackInnerDarkColor;
|
||||
FHotTrackBrightnessChange := SrcAppearance.HotTrackBrightnessChange;
|
||||
FActiveFrameColor := SrcAppearance.ActiveFrameColor;
|
||||
FActiveGradientFromColor := SrcAppearance.ActiveGradientFromColor;
|
||||
FActiveGradientToColor := SrcAppearance.ActiveGradientToColor;
|
||||
FActiveGradientType := SrcAppearance.ActiveGradientType;
|
||||
FActiveInnerLightColor := SrcAppearance.ActiveInnerLightColor;
|
||||
FActiveInnerDarkColor := SrcAppearance.ActiveInnerDarkColor;
|
||||
FActiveCaptionColor := SrcAppearance.ActiveCaptionColor;
|
||||
}
|
||||
FStyle := SrcAppearance.Style;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end else
|
||||
raise AssignException.Create('TSpkPopupMenuAppearance.Assign: Cannot assign the objecct '+Source.ClassName+' to TSpkPopuMenuAppearance!');
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.CaptionFontChange(Sender: TObject);
|
||||
begin
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.LoadFromXML(Node: TSpkXMLNode);
|
||||
var
|
||||
Subnode: TSpkXMLNode;
|
||||
begin
|
||||
if not Assigned(Node) then
|
||||
exit;
|
||||
|
||||
Subnode := Node['CaptionFont', false];
|
||||
if Assigned(Subnode) then
|
||||
TSpkXMLTools.Load(Subnode, FCaptionFont);
|
||||
|
||||
// Disabled text
|
||||
Subnode := Node['DisabledCaptionColor', false];
|
||||
if Assigned(SubNode) then
|
||||
FDisabledCaptionColor := Subnode.TextAsColor;
|
||||
|
||||
// Idle
|
||||
Subnode := Node['IdleCaptionColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FIdleCaptionColor := Subnode.TextAsColor;
|
||||
{
|
||||
Subnode := Node['IdleFrameColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FIdleFrameColor := Subnode.TextAsColor;
|
||||
}
|
||||
Subnode := Node['IdleGradientFromColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FIdleGradientFromColor := Subnode.TextAsColor;
|
||||
|
||||
Subnode := Node['IdleGradientToColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FIdleGradientToColor := Subnode.TextAsColor;
|
||||
|
||||
Subnode := Node['IdleGradientType', false];
|
||||
if Assigned(Subnode) then
|
||||
FIdleGradientType := TBackgroundKind(Subnode.TextAsInteger);
|
||||
|
||||
{
|
||||
Subnode := Node['IdleInnerLightColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FIdleInnerLightColor := Subnode.TextAsColor;
|
||||
|
||||
Subnode := Node['IdleInnerDarkColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FIdleInnerDarkColor := Subnode.TextAsColor;
|
||||
}
|
||||
|
||||
// Gutter
|
||||
Subnode := Node['GutterGradientFromColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FGutterGradientFromColor := Subnode.TextAsColor;
|
||||
|
||||
Subnode := Node['GutterGradientToColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FGutterGradientToColor := Subnode.TextAsColor;
|
||||
|
||||
Subnode := Node['GuttereGradientType', false];
|
||||
if Assigned(Subnode) then
|
||||
FGutterGradientType := TBackgroundKind(Subnode.TextAsInteger);
|
||||
|
||||
Subnode := Node['GutterLineColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FGutterLineColor := Subnode.TextAsColor;
|
||||
|
||||
|
||||
// HotTrack
|
||||
Subnode := Node['HottrackCaptionColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FHottrackCaptionColor := Subnode.TextAsColor;
|
||||
|
||||
Subnode := Node['HottrackFrameColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FHottrackFrameColor := Subnode.TextAsColor;
|
||||
|
||||
Subnode := Node['HottrackGradientFromColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FHottrackGradientFromColor := Subnode.TextAsColor;
|
||||
|
||||
Subnode := Node['HottrackGradientToColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FHottrackGradientToColor := Subnode.TextAsColor;
|
||||
|
||||
Subnode := Node['HottrackGradientType', false];
|
||||
if Assigned(Subnode) then
|
||||
FHottrackGradientType := TBackgroundKind(Subnode.TextAsInteger);
|
||||
{
|
||||
Subnode := Node['HottrackInnerLightColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FHottrackInnerLightColor := Subnode.TextAsColor;
|
||||
|
||||
Subnode := Node['HottrackInnerDarkColor', false];
|
||||
if Assigned(Subnode) then
|
||||
FHottrackInnerDarkColor := Subnode.TextAsColor;
|
||||
|
||||
Subnode := Node['HottrackBrightnessChange', false];
|
||||
if Assigned(Subnode) then
|
||||
FHottrackBrightnessChange := Subnode.TextAsInteger;
|
||||
}
|
||||
|
||||
// Other
|
||||
Subnode := Node['Style', false];
|
||||
if Assigned(SubNode) then
|
||||
FStyle := TSpkPopupStyle(Subnode.TextAsInteger);
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.Reset(AStyle: TSpkStyle = spkOffice2007Blue);
|
||||
begin
|
||||
SetDefaultFont(FCaptionFont);
|
||||
case AStyle of
|
||||
spkOffice2007Blue:
|
||||
begin
|
||||
FCaptionFont.Style := [];
|
||||
FDisabledCaptionColor := rgb(192, 192, 192);
|
||||
{
|
||||
FIdleFrameColor := rgb(155, 183, 224);
|
||||
}
|
||||
FGutterGradientFromColor := rgb(233, 238, 238);
|
||||
FGutterGradientToColor := rgb(233, 238, 238);
|
||||
FGutterGradientType := bkSolid;
|
||||
FGutterLineColor := rgb(197, 197, 197);
|
||||
{
|
||||
FIdleInnerLightColor := rgb(213, 227, 241);
|
||||
FIdleInnerDarkColor := rgb(190, 211, 236);
|
||||
}
|
||||
FHotTrackCaptionColor := rgb(111, 66, 135);
|
||||
FHotTrackFrameColor := rgb(219, 206, 153);
|
||||
FHotTrackGradientFromColor := rgb(255, 252, 218);
|
||||
FHotTrackGradientToColor := rgb(255, 215, 77);
|
||||
FHotTrackGradientType := bkConcave;
|
||||
{
|
||||
FHotTrackInnerLightColor := rgb(255, 241, 197);
|
||||
FHotTrackInnerDarkColor := rgb(216, 194, 122);
|
||||
FHotTrackBrightnessChange := 40;
|
||||
}
|
||||
FIdleCaptionColor := rgb(86, 125, 177);
|
||||
FIdleGradientFromColor := rgb(250, 250, 250);
|
||||
FIdleGradientToColor := rgb(250, 250, 250);
|
||||
FIdleGradientType := bkSolid;
|
||||
FStyle := psGutter;
|
||||
end;
|
||||
|
||||
spkOffice2007Silver,
|
||||
spkOffice2007SilverTurquoise:
|
||||
begin
|
||||
FCaptionFont.Style := [];
|
||||
FCaptionFont.Color := $008B4215;
|
||||
FDisabledCaptionColor := rgb(192, 192, 192);
|
||||
{
|
||||
FIdleFrameColor := $00B8B1A9;
|
||||
}
|
||||
FIdleCaptionColor := $0060655F;
|
||||
FIdleGradientFromColor := rgb(250, 250, 250);
|
||||
FIdleGradientToColor := rgb(250, 250, 250);
|
||||
FIdleGradientType := bkSolid;
|
||||
FGutterGradientFromColor := rgb(239, 239, 239);
|
||||
FGutterGradientToColor := rgb(239, 239, 239);
|
||||
FGutterGradientType := bkSolid;
|
||||
FGutterLineColor := rgb(197, 197, 197);
|
||||
{
|
||||
FIdleInnerDarkColor := $00C7C0BA;
|
||||
FIdleInnerLightColor := $00F6F2F0;
|
||||
FHotTrackBrightnessChange := 40;
|
||||
}
|
||||
FHotTrackCaptionColor := $0087426F;
|
||||
FHotTrackGradientType := bkConcave;
|
||||
{
|
||||
FHotTrackInnerDarkColor := $007AC2D8;
|
||||
FHotTrackInnerLightColor := $00C5F1FF;
|
||||
}
|
||||
if AStyle = spkOffice2007SilverTurquoise then
|
||||
begin
|
||||
FHotTrackFrameColor := $009E7D0E;
|
||||
FHotTrackGradientFromColor := $00FBF1D0;
|
||||
FHotTrackGradientToColor := $00F4DD8A;
|
||||
// FHotTrackInnerDarkColor := $00C19A11;
|
||||
// FHotTrackInnerLightColor := $00FAEFC9;
|
||||
end else
|
||||
begin
|
||||
FHotTrackFrameColor := rgb(219, 206, 153); //$009BCFDD;
|
||||
FHotTrackGradientFromColor := $00DAFCFF;
|
||||
FHotTrackGradientToColor := $004DD7FF;
|
||||
end;
|
||||
FStyle := psGutter;
|
||||
end;
|
||||
|
||||
spkMetroLight:
|
||||
begin
|
||||
FCaptionFont.Style := [];
|
||||
FCaptionFont.Color := $003F3F3F;
|
||||
FDisabledCaptionColor := rgb(192, 192, 192);
|
||||
FGutterGradientFromColor := rgb(239, 239, 239);
|
||||
FGutterGradientToColor := rgb(239, 239, 239);
|
||||
FGutterGradientType := bkSolid;
|
||||
FGutterLineColor := rgb(197, 197, 197);
|
||||
FHotTrackCaptionColor := $003F3F3F;
|
||||
FHotTrackFrameColor := $00F9CEA4;
|
||||
FHotTrackGradientFromColor := $00F7EFE8;
|
||||
FHotTrackGradientToColor := $00F7EFE8;
|
||||
FHotTrackGradientType := bkSolid;
|
||||
{
|
||||
FHotTrackInnerDarkColor := $00F7EFE8;
|
||||
FHotTrackInnerLightColor := $00F7EFE8;
|
||||
FHotTrackBrightnessChange := 20;
|
||||
}
|
||||
{
|
||||
FIdleFrameColor := $00CDCDCD;
|
||||
}
|
||||
FIdleCaptionColor := $00696969;
|
||||
FIdleGradientFromColor := $00F1F1F1;
|
||||
FIdleGradientToColor := $00F1F1F1;
|
||||
FIdleGradientType := bkSolid;
|
||||
{
|
||||
FIdleInnerDarkColor := $00CDCDCD;
|
||||
FIdleInnerLightColor := $00EBEBEB;
|
||||
FHotTrackInnerDarkColor := $00F7EFE8;
|
||||
FHotTrackInnerLightColor := $00F7EFE8;
|
||||
FHotTrackBrightnessChange := 20;
|
||||
}
|
||||
|
||||
FStyle := psDefault;
|
||||
end;
|
||||
|
||||
spkMetroDark:
|
||||
begin
|
||||
FCaptionFont.Style := [];
|
||||
FCaptionFont.Color := $003F3F3F;
|
||||
FDisabledCaptionColor := $787878;
|
||||
FGutterGradientFromColor := clBlack;
|
||||
FGutterGradientToColor := clBlack;
|
||||
FGutterGradientType := bkSolid;
|
||||
FGutterLineColor := rgb(32, 32, 32);
|
||||
FHotTrackCaptionColor := $00F2F2F2;
|
||||
FHotTrackFrameColor := $00C4793C;
|
||||
FHotTrackGradientFromColor := $00805B3D;
|
||||
FHotTrackGradientToColor := $00805B3D;
|
||||
FHotTrackGradientType := bkSolid;
|
||||
{
|
||||
FHotTrackInnerDarkColor := $00805B3D;
|
||||
FHotTrackInnerLightColor := $00805B3D;
|
||||
FHotTrackBrightnessChange := 10;
|
||||
}
|
||||
{
|
||||
FIdleFrameColor := $008C8482;
|
||||
}
|
||||
FIdleCaptionColor := $00B6B6B6;
|
||||
FIdleGradientFromColor := $00444444;
|
||||
FIdleGradientToColor := $00444444;
|
||||
FIdleGradientType := bkSolid;
|
||||
{
|
||||
FIdleInnerDarkColor := $008C8482;
|
||||
FIdleInnerLightColor := $00444444;
|
||||
}
|
||||
FStyle := psDefault;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SaveToPascal(AList: TStrings);
|
||||
begin
|
||||
with AList do begin
|
||||
Add(' with Popup do begin');
|
||||
SaveFontToPascal(AList, FCaptionFont, ' CaptionFont');
|
||||
|
||||
Add(' IdleCaptionColor := $' + IntToHex(FIdleCaptionColor, 8) + ';');
|
||||
// Add(' IdleFrameColor := $' + IntToHex(FIdleFrameColor, 8) + ';');
|
||||
Add(' IdleGradientFromColor := $' + IntToHex(FIdleGradientFromColor, 8) + ';');
|
||||
Add(' IdleGradientToColor := $' + IntToHex(FIdleGradientToColor, 8) + ';');
|
||||
Add(' IdleGradientType := ' + GetEnumName(TypeInfo(TBackgroundKind), ord(FIdleGradientType)) + ';');
|
||||
// Add(' IdleInnerDarkColor := $' + IntToHex(FIdleInnerDarkColor, 8) + ';');
|
||||
// Add(' IdleInnerLightColor := $' + IntToHex(FIdleInnerLightColor, 8) + ';');
|
||||
|
||||
Add(' GutterGradientFromColor := $' + IntToHex(FGutterGradientFromColor, 8) + ';');
|
||||
Add(' GutterGradientToColor := $' + IntToHex(FGutterGradientToColor, 8) + ';');
|
||||
Add(' GutterGradientType := ' + GetEnumName(TypeInfo(TBackgroundKind), ord(FGutterGradientType)) + ';');
|
||||
Add(' GutterLineColor := $' + IntToHex(FGutterLineColor, 8) + ';');
|
||||
|
||||
Add(' HotTrackCaptionColor := $' + IntToHex(FHotTrackCaptionColor, 8) + ';');
|
||||
Add(' HotTrackFrameColor := $' + IntToHex(FHotTrackFrameColor, 8) + ';');
|
||||
Add(' HotTrackGradientFromColor := $' + IntToHex(FHotTrackGradientFromColor, 8) + ';');
|
||||
Add(' HotTrackGradientToColor := $' + IntToHex(FHotTrackGradientToColor, 8) + ';');
|
||||
Add(' HotTrackGradientType := ' + GetEnumName(TypeInfo(TBackgroundKind), ord(FHotTrackGradientType)) + ';');
|
||||
// Add(' HotTrackInnerDarkColor := $' + IntToHex(FHotTrackInnerDarkColor, 8) + ';');
|
||||
// Add(' HotTrackInnerLightColor := $' + IntToHex(FHotTrackInnerLightColor, 8) + ';');
|
||||
// Add(' HotTrackBrightnessChange := ' + IntToStr(FHotTrackBrightnessChange) + ';');
|
||||
|
||||
Add(' Style := ' + GetEnumName(TypeInfo(TSpkPopupStyle), ord(FStyle)) + ';');
|
||||
Add(' end;');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SaveToXML(Node: TSpkXMLNode);
|
||||
var
|
||||
Subnode: TSpkXMLNode;
|
||||
begin
|
||||
if not Assigned(Node) then
|
||||
exit;
|
||||
|
||||
Subnode := Node['CaptionFont', true];
|
||||
TSpkXMLTools.Save(Subnode, FCaptionFont);
|
||||
|
||||
// Idle
|
||||
Subnode := Node['IdleCaptionColor', true];
|
||||
Subnode.TextAsColor := FIdleCaptionColor;
|
||||
|
||||
// Subnode := Node['IdleFrameColor', true];
|
||||
// Subnode.TextAsColor := FIdleFrameColor;
|
||||
|
||||
Subnode := Node['IdleGradientFromColor', true];
|
||||
Subnode.TextAsColor := FIdleGradientFromColor;
|
||||
|
||||
Subnode := Node['IdleGradientToColor', true];
|
||||
Subnode.TextAsColor := FIdleGradientToColor;
|
||||
|
||||
Subnode := Node['IdleGradientType', true];
|
||||
Subnode.TextAsInteger := integer(FIdleGradientType);
|
||||
{
|
||||
Subnode := Node['IdleInnerLightColor', true];
|
||||
Subnode.TextAsColor := FIdleInnerLightColor;
|
||||
|
||||
Subnode := Node['IdleInnerDarkColor', true];
|
||||
Subnode.TextAsColor := FIdleInnerDarkColor;
|
||||
}
|
||||
|
||||
// Gutter
|
||||
Subnode := Node['ButterGradientFromColor', true];
|
||||
Subnode.TextAsColor := FGutterGradientFromColor;
|
||||
|
||||
Subnode := Node['GutterGradientToColor', true];
|
||||
Subnode.TextAsColor := FGutterGradientToColor;
|
||||
|
||||
Subnode := Node['GutterGradientType', true];
|
||||
Subnode.TextAsInteger := integer(FGutterGradientType);
|
||||
|
||||
Subnode := Node['GutterLineColor', true];
|
||||
Subnode.TextAsColor := FGutterLineColor;
|
||||
|
||||
|
||||
// HotTrack
|
||||
Subnode := Node['HottrackCaptionColor', true];
|
||||
Subnode.TextAsColor := FHottrackCaptionColor;
|
||||
|
||||
Subnode := Node['HottrackFrameColor', true];
|
||||
Subnode.TextAsColor := FHottrackFrameColor;
|
||||
|
||||
Subnode := Node['HottrackGradientFromColor', true];
|
||||
Subnode.TextAsColor := FHottrackGradientFromColor;
|
||||
|
||||
Subnode := Node['HottrackGradientToColor', true];
|
||||
Subnode.TextAsColor := FHottrackGradientToColor;
|
||||
|
||||
Subnode := Node['HottrackGradientType', true];
|
||||
Subnode.TextAsInteger := integer(FHottrackGradientType);
|
||||
{
|
||||
Subnode := Node['HottrackInnerLightColor', true];
|
||||
Subnode.TextAsColor := FHottrackInnerLightColor;
|
||||
|
||||
Subnode := Node['HottrackInnerDarkColor', true];
|
||||
Subnode.TextAsColor := FHottrackInnerDarkColor;
|
||||
|
||||
Subnode := Node['HottrackBrightnessChange', true];
|
||||
Subnode.TextAsInteger := FHotTrackBrightnessChange;
|
||||
}
|
||||
|
||||
// Other
|
||||
Subnode := Node['Style', true];
|
||||
Subnode.TextAsInteger := integer(FStyle);
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetCaptionFont(const Value: TFont);
|
||||
begin
|
||||
FCaptionFont.Assign(Value);
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetDisabledCaptionColor(const Value: TColor);
|
||||
begin
|
||||
FDisabledCaptionColor := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetGutterGradientFromColor(const Value: TColor);
|
||||
begin
|
||||
FGutterGradientFromColor := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetGutterGradientToColor(const Value: TColor);
|
||||
begin
|
||||
FGutterGradientToColor := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetGutterGradientType(const Value: TBackgroundKind);
|
||||
begin
|
||||
FGutterGradientType := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetGutterLineColor(const Value: TColor);
|
||||
begin
|
||||
FGutterLineColor := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetHotTrackCaptionColor(const Value: TColor);
|
||||
begin
|
||||
FHotTrackCaptionColor := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetHotTrackFrameColor(const Value: TColor);
|
||||
begin
|
||||
FHotTrackFrameColor := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetHotTrackGradientFromColor(const Value: TColor);
|
||||
begin
|
||||
FHotTrackGradientFromColor := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetHotTrackGradientToColor(const Value: TColor);
|
||||
begin
|
||||
FHotTrackGradientToColor := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetHotTrackGradientType(const Value: TBackgroundKind);
|
||||
begin
|
||||
FHotTrackGradientType := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetIdleGradientFromColor(const Value: TColor);
|
||||
begin
|
||||
FIdleGradientFromColor := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetIdleCaptionColor(const Value: TColor);
|
||||
begin
|
||||
FIdleCaptionColor := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetIdleGradientToColor(const Value: TColor);
|
||||
begin
|
||||
FIdleGradientToColor := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetIdleGradientType(const Value: TBackgroundKind);
|
||||
begin
|
||||
FIdleGradientType := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
procedure TSpkPopupMenuAppearance.SetStyle(const Value: TSpkPopupStyle);
|
||||
begin
|
||||
FStyle := Value;
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
|
||||
{ TSpkToolbarAppearanceDispatch }
|
||||
|
||||
constructor TSpkToolbarAppearanceDispatch.Create(
|
||||
@ -1685,10 +2303,12 @@ begin
|
||||
FMenuButton := TSpkMenuButtonAppearance.Create(FAppearanceDispatch);
|
||||
FPane := TSpkPaneAppearance.create(FAppearanceDispatch);
|
||||
FElement := TSpkElementAppearance.create(FAppearanceDispatch);
|
||||
FPopup := TSpkPopupMenuAppearance.Create(FAppearanceDispatch);
|
||||
end;
|
||||
|
||||
destructor TSpkToolbarAppearance.Destroy;
|
||||
begin
|
||||
FPopup.Free;
|
||||
FElement.Free;
|
||||
FPane.Free;
|
||||
FMenuButton.Free;
|
||||
@ -1709,6 +2329,7 @@ begin
|
||||
self.FMenuButton.Assign(Src.MenuButton);
|
||||
self.FPane.Assign(Src.Pane);
|
||||
self.FElement.Assign(Src.Element);
|
||||
self.FPopup.Assign(Src.Popup);
|
||||
|
||||
if FDispatch <> nil then
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
@ -1724,6 +2345,7 @@ begin
|
||||
MenuButton.Reset;
|
||||
Pane.Reset;
|
||||
Element.Reset;
|
||||
Popup.Reset;
|
||||
|
||||
if not Assigned(Node) then
|
||||
exit;
|
||||
@ -1757,6 +2379,7 @@ begin
|
||||
FMenuButton.Reset(AStyle);
|
||||
FPane.Reset(AStyle);
|
||||
FElement.Reset(AStyle);
|
||||
FPopup.Reset(AStyle);
|
||||
if Assigned(FAppearanceDispatch) then
|
||||
FAppearanceDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
@ -1799,6 +2422,11 @@ begin
|
||||
FPane.Assign(Value);
|
||||
end;
|
||||
|
||||
procedure TSpkToolbarAppearance.SetPopupAppearance(const Value: TSpkPopupMenuAppearance);
|
||||
begin
|
||||
FPopup.Assign(Value);
|
||||
end;
|
||||
|
||||
procedure TSpkToolbarAppearance.SetTabAppearance(const Value: TSpkTabAppearance);
|
||||
begin
|
||||
FTab.Assign(Value);
|
||||
@ -2375,4 +3003,5 @@ begin
|
||||
FDispatch.NotifyAppearanceChanged;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
@ -213,7 +213,7 @@ implementation
|
||||
|
||||
uses
|
||||
LCLType, LCLIntf, LCLProc, LCLVersion, SysUtils,
|
||||
spkt_Pane, spkt_Appearance;
|
||||
spkt_Pane, spkt_Appearance, SpkPopup;
|
||||
|
||||
|
||||
{ TSpkButtonActionLink }
|
||||
@ -894,6 +894,8 @@ begin
|
||||
exit;
|
||||
|
||||
FDropdownMenu := Value;
|
||||
if (FDropdownMenu is TSpkPopupMenu) then
|
||||
TSpkPopupMenu(FDropdownMenu).Appearance := Self.Appearance;
|
||||
if Assigned(FToolbarDispatch) then
|
||||
FToolbarDispatch.NotifyMetricsChanged;
|
||||
end;
|
||||
@ -1055,6 +1057,7 @@ var
|
||||
R: TRect;
|
||||
SeparatorRect: TRect;
|
||||
SeparatorLineColor: TColor;
|
||||
drawImgEnabled: Boolean = true;
|
||||
begin
|
||||
if FToolbarDispatch = nil then
|
||||
exit;
|
||||
@ -1226,7 +1229,10 @@ begin
|
||||
if not FEnabled and (FDisabledLargeImages <> nil) then
|
||||
imgList := FDisabledLargeImages
|
||||
else
|
||||
begin
|
||||
imgList := FLargeImages;
|
||||
if not FEnabled then drawImgEnabled := false;
|
||||
end;
|
||||
|
||||
if (imgList <> nil) and (FLargeImageIndex >= 0) and (FLargeImageIndex < imgList.Count) then
|
||||
begin
|
||||
@ -1242,7 +1248,7 @@ begin
|
||||
FButtonRect.Top + LargeButtonBorderSize + LargeButtonGlyphMargin
|
||||
);
|
||||
TGUITools.DrawImage(ABuffer.Canvas, imgList, FLargeImageIndex, P, ClipRect,
|
||||
FLargeImagesWidth, ppi, 1.0);
|
||||
FLargeImagesWidth, ppi, 1.0, drawImgEnabled);
|
||||
end;
|
||||
|
||||
// Text
|
||||
@ -1610,6 +1616,7 @@ var
|
||||
ppi: Integer;
|
||||
SeparatorRect: TRect;
|
||||
SeparatorLineColor: TColor;
|
||||
drawImgEnabled: Boolean = true;
|
||||
begin
|
||||
if (FToolbarDispatch = nil) or (FAppearance = nil) then
|
||||
exit;
|
||||
@ -1698,7 +1705,10 @@ begin
|
||||
if not FEnabled and (FDisabledImages <> nil) then
|
||||
imgList := FDisabledImages
|
||||
else
|
||||
begin
|
||||
imgList := FImages;
|
||||
if not FEnabled then drawImgEnabled := false;
|
||||
end;
|
||||
|
||||
if (imgList <> nil) and (FImageIndex >= 0) and (FImageIndex < imgList.Count) then
|
||||
begin
|
||||
@ -1722,7 +1732,8 @@ begin
|
||||
P,
|
||||
ClipRect,
|
||||
FImagesWidth,
|
||||
ppi, 1.0
|
||||
ppi, 1.0,
|
||||
drawImgEnabled
|
||||
);
|
||||
end;
|
||||
|
||||
|
||||
@ -156,6 +156,13 @@ const
|
||||
/// <summary>Min tab caption width</summary>
|
||||
TOOLBAR_MIN_TAB_CAPTION_WIDTH = 32;
|
||||
|
||||
|
||||
// *********************
|
||||
// *** Dropdown menu ***
|
||||
// *********************
|
||||
|
||||
DROPDOWN_MENU_MARGIN = 3;
|
||||
|
||||
var
|
||||
// ****************
|
||||
// *** Elements ***
|
||||
@ -188,6 +195,13 @@ var
|
||||
DropdownArrowHeight: Integer;
|
||||
|
||||
|
||||
// *********************
|
||||
// *** Dropdown menu ***
|
||||
// *********************
|
||||
|
||||
DropDownMenuMargin: Integer;
|
||||
|
||||
|
||||
// ***********************
|
||||
// *** Tab page layout ***
|
||||
// ***********************
|
||||
@ -343,6 +357,8 @@ begin
|
||||
DropdownArrowWidth := SpkScaleX(DROPDOWN_ARROW_WIDTH, FromDPI, ToDPI);
|
||||
DropdownArrowHeight := SpkScaleY(DROPDOWN_ARROW_HEIGHT, FromDPI, ToDPI);
|
||||
|
||||
DropdownMenuMargin := SpkScaleX(DROPDOWN_MENU_MARGIN, FromDPI, ToDpi);
|
||||
|
||||
MaxElementHeight := SpkScaleY(MAX_ELEMENT_HEIGHT, FromDPI, ToDPI);
|
||||
PaneRowHeight := SpkScaleY(PANE_ROW_HEIGHT, FromDPI, ToDPI);
|
||||
PaneFullRowHeight := 3 * PaneRowHeight;
|
||||
|
||||
@ -109,8 +109,8 @@ type
|
||||
// *** Geometry and drawing ***
|
||||
function GetWidth: integer;
|
||||
procedure Draw(ABuffer: TBitmap; ClipRect: T2DIntRect);
|
||||
function FindItemAt(x, y: integer): integer;
|
||||
procedure DrawMoreOptionsButton(ABuffer: TBitmap; ClipRect: T2DIntRect);
|
||||
function FindItemAt(x, y: integer): integer;
|
||||
|
||||
// *** Support for elements ***
|
||||
procedure FreeingItem(AItem: TSpkBaseItem);
|
||||
|
||||
@ -1,16 +1,16 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="11"/>
|
||||
<Version Value="12"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasUsesSectionForAllUnits Value="False"/>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<CompatibilityMode Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<Icon Value="0"/>
|
||||
@ -69,6 +69,9 @@
|
||||
</Optimizations>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
</Debugging>
|
||||
<LinkSmart Value="True"/>
|
||||
<Options>
|
||||
<Win32>
|
||||
|
||||
@ -6,7 +6,8 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LazarusPackageIntf, SpkToolbar, PropEdits, ComponentEditors,
|
||||
SpkToolbarEditor, spkt_Buttons, spkt_Checkboxes, spkt_Pane, spkt_Tab, spkt_Appearance,
|
||||
SpkToolbarEditor, SpkPopup, spkt_Buttons, spkt_Checkboxes, spkt_Pane, spkt_Tab,
|
||||
spkt_Appearance,
|
||||
LResources;
|
||||
|
||||
procedure Register;
|
||||
@ -18,7 +19,7 @@ uses
|
||||
|
||||
procedure RegisterUnitSpkToolbar;
|
||||
begin
|
||||
RegisterComponents('SpkToolbar', [TSpkToolbar]);
|
||||
RegisterComponents('SpkToolbar', [TSpkToolbar, TSpkPopupMenu]);
|
||||
end;
|
||||
|
||||
procedure RegisterUnitSpkt_Buttons;
|
||||
|
||||
@ -10,14 +10,14 @@
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="SpkToolbar;designtime"/>
|
||||
<OtherUnitFiles Value="SpkToolbar;SpkMath;SpkGUITools;SpkGraphTools;SpkXML;designtime"/>
|
||||
<OtherUnitFiles Value="SpkToolbar;SpkMath;SpkGUITools;SpkGraphTools;SpkXML;SpkPopupMenu;designtime"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Description Value="Ribbon-like toolbar"/>
|
||||
<License Value="Modified LGPL (like Lazarus)"/>
|
||||
<Version Minor="1" Release="8"/>
|
||||
<Files Count="26">
|
||||
<Files Count="27">
|
||||
<Item1>
|
||||
<Filename Value="SpkToolbar\spkt_Appearance.pas"/>
|
||||
<UnitName Value="spkt_Appearance"/>
|
||||
@ -123,6 +123,10 @@
|
||||
<Filename Value="designtime\SpkToolbar.lrs"/>
|
||||
<Type Value="LRS"/>
|
||||
</Item26>
|
||||
<Item27>
|
||||
<Filename Value="SpkPopupMenu\spkpopup.pas"/>
|
||||
<UnitName Value="SpkPopup"/>
|
||||
</Item27>
|
||||
</Files>
|
||||
<CompatibilityMode Value="True"/>
|
||||
<RequiredPkgs Count="2">
|
||||
|
||||
@ -4,6 +4,7 @@
|
||||
|
||||
unit SpkToolbarPackage;
|
||||
|
||||
{$warn 5023 off : no warning about unused units}
|
||||
interface
|
||||
|
||||
uses
|
||||
@ -11,7 +12,7 @@ uses
|
||||
spkt_Exceptions, spkt_Items, spkt_Pane, spkt_Tab, spkt_Tools, spkt_Types,
|
||||
SpkToolbar, SpkMath, SpkGUITools, SpkGraphTools, SpkXMLIni, SpkXMLParser,
|
||||
SpkXMLTools, RegisterSpkToolbar, SpkToolbarEditor, spkte_AppearanceEditor,
|
||||
spkte_EditWindow, spkt_Checkboxes, LazarusPackageIntf;
|
||||
spkte_EditWindow, spkt_Checkboxes, SpkPopup, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
Reference in New Issue
Block a user