Basic glyph

bgracolortheme.pas

@@ -7,7 +7,7 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, BGRATheme,
-  BGRABitmap, BGRABitmapTypes;
+  BGRABitmap, BGRABitmapTypes, BGRASVGImageList;
 
 type
 
@@ -32,7 +32,7 @@ type
 
   public
     procedure DrawButton(Caption: string; State: TBGRAThemeButtonState;
-      Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface); override;
+      Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface; AImageIndex: Integer = -1; AImageList: TBGRASVGImageList = nil); override;
     procedure DrawRadioButton(Caption: string; State: TBGRAThemeButtonState;
       {%H-}Focused: boolean; Checked: boolean; ARect: TRect; ASurface: TBGRAThemeSurface); override;
     procedure DrawCheckBox(Caption: string; State: TBGRAThemeButtonState;
@@ -99,8 +99,10 @@ begin
   FColorText := AValue;
 end;
 
-procedure TBGRAColorTheme.DrawButton(Caption: string; State: TBGRAThemeButtonState;
-  Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface);
+procedure TBGRAColorTheme.DrawButton(Caption: string;
+  State: TBGRAThemeButtonState; Focused: boolean; ARect: TRect;
+  ASurface: TBGRAThemeSurface; AImageIndex: Integer;
+  AImageList: TBGRASVGImageList);
 var
   Style: TTextStyle;
 begin

bgraimagetheme.pas

@@ -7,7 +7,7 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, BGRATheme,
-  BGRASliceScaling, BGRABitmap, BGRABitmapTypes;
+  BGRASliceScaling, BGRABitmap, BGRABitmapTypes, BGRASVGImageList;
 
 type
 
@@ -25,7 +25,7 @@ type
     destructor Destroy; override;
     procedure LoadResources(AFileName: string);
     procedure DrawButton(Caption: string; State: TBGRAThemeButtonState;
-      {%H-}Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface); override;
+      Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface; AImageIndex: Integer = -1; AImageList: TBGRASVGImageList = nil); override;
   published
     property BackgroundColor: TColor read FBackgroundColor
       write SetFBackgroundColor default clForm;
@@ -67,8 +67,10 @@ begin
   FSliceScalingButton := TBGRAMultiSliceScaling.Create(AFileName, 'Button');
 end;
 
-procedure TBGRAImageTheme.DrawButton(Caption: string; State: TBGRAThemeButtonState;
-  Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface);
+procedure TBGRAImageTheme.DrawButton(Caption: string;
+  State: TBGRAThemeButtonState; Focused: boolean; ARect: TRect;
+  ASurface: TBGRAThemeSurface; AImageIndex: Integer;
+  AImageList: TBGRASVGImageList);
 var
   Style: TTextStyle;
   ImageIndex: integer;

bgrasvgtheme.pas

@@ -7,7 +7,7 @@ interface
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
   BGRATheme, BGRABitmap, BGRABitmapTypes, BGRASVG, BGRASVGType, XMLConf,
-  ComponentEditors, PropEdits, Menus;
+  ComponentEditors, PropEdits, Menus, BGRASVGImageList, Math;
 
 const
   DEFAULT_CHECKBOX_TEXT_SPACING = 2;
@@ -72,7 +72,7 @@ type
     destructor Destroy; override;
   public
     procedure DrawButton(Caption: string; State: TBGRAThemeButtonState;
-      Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface); override;
+      Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface; AImageIndex: Integer = -1; AImageList: TBGRASVGImageList = nil); override;
     procedure DrawRadioButton(Caption: string; State: TBGRAThemeButtonState;
     {%H-}Focused: boolean; Checked: boolean; ARect: TRect;
       ASurface: TBGRAThemeSurface); override;
@@ -593,13 +593,19 @@ begin
   inherited Destroy;
 end;
 
-procedure TBGRASVGTheme.DrawButton(Caption: string; State: TBGRAThemeButtonState;
-  Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface);
+procedure TBGRASVGTheme.DrawButton(Caption: string;
+  State: TBGRAThemeButtonState; Focused: boolean; ARect: TRect;
+  ASurface: TBGRAThemeSurface; AImageIndex: Integer;
+  AImageList: TBGRASVGImageList);
 var
   Style: TTextStyle;
-  svg: TBGRASVG;
+  svg, glyph: TBGRASVG;
   r: TRect;
   svgCode: String;
+  gw: integer;
+  tw: integer;
+  x: integer;
+  drawText: boolean = True;
 begin
   with ASurface do
   begin
@@ -625,6 +631,21 @@ begin
       FButtonSliceScalingRight, FButtonSliceScalingBottom, ASurface.Bitmap,
       BitmapDPI);
     svg.Free;
+    gw := 0;
+    tw := DestCanvas.TextWidth(Caption);
+    if Assigned(AImageList) and (AImageIndex > -1) and (AImageIndex < AImageList.Count) then
+    begin
+      gw := AImageList.Width + 8;
+      x := (Bitmap.Width - tw - AImageList.Width) div 2;
+      if (x < 8) then
+      begin
+        x := (Bitmap.Width - AImageList.Width) div 2;
+        drawText := False;
+      end;
+      glyph := TBGRASVG.CreateFromString(AImageList.Get(AImageIndex));
+      glyph.StretchDraw(Bitmap.Canvas2D, x, (Bitmap.Height - AImageList.Height) div 2, AImageList.Width, AImageList.Height, True);
+      glyph.Free;
+    end;
     ColorizeSurface(ASurface, State);
     DrawBitmap;
 
@@ -642,7 +663,7 @@ begin
       DestCanvas.Pen.Style := psSolid;
     end;
 
-    if Caption <> '' then
+    if (Caption <> '') and drawText then
     begin
       Style.Alignment := taCenter;
       Style.Layout := tlCenter;
@@ -650,6 +671,7 @@ begin
       Style.SystemFont := False;
       Style.Clipping := True;
       Style.Opaque := False;
+      ARect.Left := gw;
       DestCanvas.TextRect(ARect, 0, 0, Caption, Style);
     end;
   end;

bgratheme.pas

@@ -7,7 +7,7 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
-  BGRABitmap, BGRABitmapTypes;
+  BGRABitmap, BGRABitmapTypes, BGRASVGImageList;
 
 type
   TBGRAThemeButtonState = (btbsNormal, btbsHover, btbsActive, btbsDisabled);
@@ -71,7 +71,7 @@ type
     procedure InvalidateThemedControls;
 
     procedure DrawButton(Caption: string; State: TBGRAThemeButtonState;
-      Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface); virtual;
+      Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface; AImageIndex: Integer = -1; AImageList: TBGRASVGImageList = nil); virtual;
     procedure DrawRadioButton(Caption: string; State: TBGRAThemeButtonState;
     {%H-}Focused: boolean; Checked: boolean; ARect: TRect; ASurface: TBGRAThemeSurface); virtual;
     procedure DrawCheckBox(Caption: string; State: TBGRAThemeButtonState;
@@ -234,7 +234,8 @@ begin
 end;
 
 procedure TBGRATheme.DrawButton(Caption: string; State: TBGRAThemeButtonState;
-  Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface);
+  Focused: boolean; ARect: TRect; ASurface: TBGRAThemeSurface;
+  AImageIndex: Integer; AImageList: TBGRASVGImageList);
 var
   Style: TTextStyle;
 begin

bgrathemebutton.pas

@@ -7,7 +7,7 @@ interface
 
 uses
   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
-  BGRATheme, Types, ExtCtrls;
+  BGRATheme, Types, ExtCtrls, BGRASVGImageList;
 
 type
 
@@ -15,9 +15,13 @@ type
 
   TBGRAThemeButton = class(TBGRAThemeControl)
   private
+    FImageIndex: integer;
+    FImageList: TBGRASVGImageList;
     FModalResult: TModalResult;
     FState: TBGRAThemeButtonState;
     FTimerHover: TTimer;
+    procedure SetImageIndex(AValue: integer);
+    procedure SetImageList(AValue: TBGRASVGImageList);
     procedure SetState(AValue: TBGRAThemeButtonState);
     procedure TimerHoverElapse(Sender: TObject);
   protected
@@ -45,6 +49,8 @@ type
     property Caption;
     property Enabled;
     property Font;
+    property ImageList: TBGRASVGImageList read FImageList write SetImageList;
+    property ImageIndex: integer read FImageIndex write SetImageIndex;
     property OnClick;
   end;
 
@@ -63,12 +69,29 @@ end;
 
 procedure TBGRAThemeButton.SetState(AValue: TBGRAThemeButtonState);
 begin
-  if FState=AValue then Exit;
-  FState:=AValue;
+  if FState = AValue then
+    Exit;
+  FState := AValue;
   FTimerHover.Enabled := (FState = btbsHover);
   Invalidate;
 end;
 
+procedure TBGRAThemeButton.SetImageIndex(AValue: integer);
+begin
+  if FImageIndex = AValue then
+    Exit;
+  FImageIndex := AValue;
+  Invalidate;
+end;
+
+procedure TBGRAThemeButton.SetImageList(AValue: TBGRASVGImageList);
+begin
+  if FImageList = AValue then
+    Exit;
+  FImageList := AValue;
+  Invalidate;
+end;
+
 procedure TBGRAThemeButton.TimerHoverElapse(Sender: TObject);
 begin
   UpdateHoverState;
@@ -85,7 +108,8 @@ begin
   inherited MouseEnter;
   if Enabled then
     State := btbsHover
-    else State := btbsDisabled;
+  else
+    State := btbsDisabled;
 end;
 
 procedure TBGRAThemeButton.MouseLeave;
@@ -93,7 +117,8 @@ begin
   inherited MouseLeave;
   if Enabled then
     State := btbsNormal
-    else State := btbsDisabled;
+  else
+    State := btbsDisabled;
 end;
 
 procedure TBGRAThemeButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
@@ -129,7 +154,8 @@ begin
   inherited SetEnabled(Value);
   if Value then
     State := btbsNormal
-    else State := btbsDisabled;
+  else
+    State := btbsDisabled;
 end;
 
 procedure TBGRAThemeButton.TextChanged;
@@ -145,9 +171,9 @@ begin
   surface := TBGRAThemeSurface.Create(self);
   try
     if Assigned(Theme) then
-      Theme.DrawButton(Caption, FState, Focused, ClientRect, surface)
+      Theme.DrawButton(Caption, FState, Focused, ClientRect, surface, FImageIndex, FImageList)
     else
-      BGRADefaultTheme.DrawButton(Caption, FState, Focused, ClientRect, surface);
+      BGRADefaultTheme.DrawButton(Caption, FState, Focused, ClientRect, surface, FImageIndex, FImageList);
   finally
     surface.Free;
   end;
@@ -165,12 +191,12 @@ var
 begin
   p := ScreenToClient(Mouse.CursorPos);
   if (p.x >= 0) and (p.x <= Width) and (p.y >= 0) and (p.y <= Height) then
-   State := btbsHover
-   else
-     if Enabled then
-       State := btbsNormal
-     else
-       State := btbsDisabled;
+    State := btbsHover
+  else
+  if Enabled then
+    State := btbsNormal
+  else
+    State := btbsDisabled;
 end;
 
 constructor TBGRAThemeButton.Create(AOwner: TComponent);
@@ -184,9 +210,9 @@ begin
     SetInitialBounds(0, 0, CX, CY);
 
   FTimerHover := TTimer.Create(self);
-  FTimerHover.Enabled := false;
+  FTimerHover.Enabled := False;
   FTimerHover.Interval := 100;
-  FTimerHover.OnTimer:=@TimerHoverElapse;
+  FTimerHover.OnTimer := @TimerHoverElapse;
 end;
 
 end.