diff --git a/components/spktoolbar/SpkGUITools/SpkGUITools.pas b/components/spktoolbar/SpkGUITools/SpkGUITools.pas
index 08586900f..8d889a1bd 100644
--- a/components/spktoolbar/SpkGUITools/SpkGUITools.pas
+++ b/components/spktoolbar/SpkGUITools/SpkGUITools.pas
@@ -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.
diff --git a/components/spktoolbar/SpkPopupMenu/spkpopup.pas b/components/spktoolbar/SpkPopupMenu/spkpopup.pas
new file mode 100644
index 000000000..c182908bb
--- /dev/null
+++ b/components/spktoolbar/SpkPopupMenu/spkpopup.pas
@@ -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.
+
diff --git a/components/spktoolbar/SpkToolbar/SpkToolbar.pas b/components/spktoolbar/SpkToolbar/SpkToolbar.pas
index 08f3c9ef2..ec8cf76e5 100644
--- a/components/spktoolbar/SpkToolbar/SpkToolbar.pas
+++ b/components/spktoolbar/SpkToolbar/SpkToolbar.pas
@@ -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;
diff --git a/components/spktoolbar/SpkToolbar/spkt_Appearance.pas b/components/spktoolbar/SpkToolbar/spkt_Appearance.pas
index d7102d700..d9aa2a2f6 100644
--- a/components/spktoolbar/SpkToolbar/spkt_Appearance.pas
+++ b/components/spktoolbar/SpkToolbar/spkt_Appearance.pas
@@ -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.
diff --git a/components/spktoolbar/SpkToolbar/spkt_Buttons.pas b/components/spktoolbar/SpkToolbar/spkt_Buttons.pas
index 6f516c545..2ba348bba 100644
--- a/components/spktoolbar/SpkToolbar/spkt_Buttons.pas
+++ b/components/spktoolbar/SpkToolbar/spkt_Buttons.pas
@@ -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;
diff --git a/components/spktoolbar/SpkToolbar/spkt_Const.pas b/components/spktoolbar/SpkToolbar/spkt_Const.pas
index c6ad32a00..7eba5e783 100644
--- a/components/spktoolbar/SpkToolbar/spkt_Const.pas
+++ b/components/spktoolbar/SpkToolbar/spkt_Const.pas
@@ -156,6 +156,13 @@ const
/// Min tab caption width
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;
diff --git a/components/spktoolbar/SpkToolbar/spkt_Pane.pas b/components/spktoolbar/SpkToolbar/spkt_Pane.pas
index 1f3d34f4d..1f86cc7e7 100644
--- a/components/spktoolbar/SpkToolbar/spkt_Pane.pas
+++ b/components/spktoolbar/SpkToolbar/spkt_Pane.pas
@@ -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);
diff --git a/components/spktoolbar/demos/basic/Project1.lpi b/components/spktoolbar/demos/basic/Project1.lpi
index 5da8ea145..06f76662b 100644
--- a/components/spktoolbar/demos/basic/Project1.lpi
+++ b/components/spktoolbar/demos/basic/Project1.lpi
@@ -1,16 +1,16 @@
-
+
+
-
@@ -69,6 +69,9 @@
+
+
+
diff --git a/components/spktoolbar/registerspktoolbar.pas b/components/spktoolbar/registerspktoolbar.pas
index e56c1ad1d..9dea84e3f 100644
--- a/components/spktoolbar/registerspktoolbar.pas
+++ b/components/spktoolbar/registerspktoolbar.pas
@@ -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;
diff --git a/components/spktoolbar/spktoolbarpackage.lpk b/components/spktoolbar/spktoolbarpackage.lpk
index c54ef99d7..474bfccd9 100644
--- a/components/spktoolbar/spktoolbarpackage.lpk
+++ b/components/spktoolbar/spktoolbarpackage.lpk
@@ -10,14 +10,14 @@
-
+
-
+
@@ -123,6 +123,10 @@
+
+
+
+
diff --git a/components/spktoolbar/spktoolbarpackage.pas b/components/spktoolbar/spktoolbarpackage.pas
index 6d8c66cd1..fe4cc14ec 100644
--- a/components/spktoolbar/spktoolbarpackage.pas
+++ b/components/spktoolbar/spktoolbarpackage.pas
@@ -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