Added BGRAThemes

bgracolortheme.pas

@@ -0,0 +1,131 @@
+unit BGRAColorTheme;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, BGRATheme;
+
+type
+
+  { TBGRAColorTheme }
+
+  TBGRAColorTheme = class(TBGRATheme)
+  private
+    FColorActive: TColor;
+    FColorDisabled: TColor;
+    FColorFocused: TColor;
+    FColorHover: TColor;
+    FColorNormal: TColor;
+    FColorText: TColor;
+    procedure SetFColorActive(AValue: TColor);
+    procedure SetFColorDisabled(AValue: TColor);
+    procedure SetFColorFocused(AValue: TColor);
+    procedure SetFColorHover(AValue: TColor);
+    procedure SetFColorNormal(AValue: TColor);
+    procedure SetFColorText(AValue: TColor);
+
+  protected
+
+  public
+    procedure DrawButton(Caption: string; State: TBGRAThemeButtonState;
+      Focused: boolean; ARect: TRect; DestCanvas: TCanvas); override;
+  published
+    property ColorNormal: TColor read FColorNormal write SetFColorNormal;
+    property ColorHover: TColor read FColorHover write SetFColorHover;
+    property ColorActive: TColor read FColorActive write SetFColorActive;
+    property ColorDisabled: TColor read FColorDisabled write SetFColorDisabled;
+    property ColorFocused: TColor read FColorFocused write SetFColorFocused;
+    property ColorText: TColor read FColorText write SetFColorText;
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('BGRA Themes', [TBGRAColorTheme]);
+end;
+
+{ TBGRAColorTheme }
+
+procedure TBGRAColorTheme.SetFColorActive(AValue: TColor);
+begin
+  if FColorActive = AValue then
+    Exit;
+  FColorActive := AValue;
+end;
+
+procedure TBGRAColorTheme.SetFColorDisabled(AValue: TColor);
+begin
+  if FColorDisabled = AValue then
+    Exit;
+  FColorDisabled := AValue;
+end;
+
+procedure TBGRAColorTheme.SetFColorFocused(AValue: TColor);
+begin
+  if FColorFocused = AValue then
+    Exit;
+  FColorFocused := AValue;
+end;
+
+procedure TBGRAColorTheme.SetFColorHover(AValue: TColor);
+begin
+  if FColorHover = AValue then
+    Exit;
+  FColorHover := AValue;
+end;
+
+procedure TBGRAColorTheme.SetFColorNormal(AValue: TColor);
+begin
+  if FColorNormal = AValue then
+    Exit;
+  FColorNormal := AValue;
+end;
+
+procedure TBGRAColorTheme.SetFColorText(AValue: TColor);
+begin
+  if FColorText = AValue then
+    Exit;
+  FColorText := AValue;
+end;
+
+procedure TBGRAColorTheme.DrawButton(Caption: string; State: TBGRAThemeButtonState;
+  Focused: boolean; ARect: TRect; DestCanvas: TCanvas);
+var
+  Style: TTextStyle;
+begin
+  case State of
+    btbsNormal: DestCanvas.Brush.Color := ColorNormal;
+    btbsHover: DestCanvas.Brush.Color := ColorHover;
+    btbsActive: DestCanvas.Brush.Color := ColorActive;
+    btbsDisabled: DestCanvas.Brush.Color := ColorDisabled;
+  end;
+
+  DestCanvas.Pen.Color := DestCanvas.Brush.Color;
+  DestCanvas.Rectangle(ARect);
+
+  if Focused then
+  begin
+    DestCanvas.Pen.Color := ColorFocused;
+    DestCanvas.Rectangle(ARect);
+  end;
+
+  if Caption <> '' then
+  begin
+    Style.Alignment := taCenter;
+    Style.Layout := tlCenter;
+    Style.Wordbreak := True;
+    Style.SystemFont := False;
+    Style.Clipping := True;
+    Style.Opaque := False;
+    if ColorText <> clDefault then
+      DestCanvas.Font.Color := ColorText;
+    DestCanvas.TextRect(ARect, 0, 0, Caption, Style);
+  end;
+end;
+
+end.

bgracontrols.lpk

@@ -34,7 +34,7 @@
     <Description Value="BGRA Controls is a set of graphical UI elements that you can use with Lazarus LCL applications."/>
     <License Value="Modified LGPL"/>
     <Version Major="6" Release="4"/>
-    <Files Count="47">
+    <Files Count="51">
       <Item1>
         <Filename Value="bcbasectrls.pas"/>
         <AddToUsesPkgSection Value="False"/>
@@ -263,6 +263,26 @@
         <AddToUsesPkgSection Value="False"/>
         <UnitName Value="MouseAndKeyInput"/>
       </Item47>
+      <Item48>
+        <Filename Value="bgraimagetheme.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="BGRAImageTheme"/>
+      </Item48>
+      <Item49>
+        <Filename Value="bgrathemebutton.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="BGRAThemeButton"/>
+      </Item49>
+      <Item50>
+        <Filename Value="bgratheme.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="BGRATheme"/>
+      </Item50>
+      <Item51>
+        <Filename Value="bgracolortheme.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="BGRAColorTheme"/>
+      </Item51>
     </Files>
     <RequiredPkgs Count="2">
       <Item1>

bgracontrols.pas

@@ -16,7 +16,8 @@ uses
   BGRAImageManipulation, BGRAKnob, BGRAResizeSpeedButton, BGRAShape, 
   BGRASpeedButton, BGRASpriteAnimation, BGRAVirtualScreen, ColorSpeedButton, 
   DTAnalogClock, DTAnalogCommon, DTAnalogGauge, dtthemedclock, dtthemedgauge, 
-  MaterialColors, LazarusPackageIntf;
+  MaterialColors, BGRAImageTheme, BGRAThemeButton, BGRATheme, BGRAColorTheme, 
+  LazarusPackageIntf;
 
 implementation
 
@@ -52,6 +53,10 @@ begin
   RegisterUnit('DTAnalogGauge', @DTAnalogGauge.Register);
   RegisterUnit('dtthemedclock', @dtthemedclock.Register);
   RegisterUnit('dtthemedgauge', @dtthemedgauge.Register);
+  RegisterUnit('BGRAImageTheme', @BGRAImageTheme.Register);
+  RegisterUnit('BGRAThemeButton', @BGRAThemeButton.Register);
+  RegisterUnit('BGRATheme', @BGRATheme.Register);
+  RegisterUnit('BGRAColorTheme', @BGRAColorTheme.Register);
 end;
 
 initialization

bgraimagetheme.pas

@@ -0,0 +1,98 @@
+unit BGRAImageTheme;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, BGRATheme,
+  BGRASliceScaling, BGRABitmap, BGRABitmapTypes;
+
+type
+
+  { TBGRAImageTheme }
+
+  TBGRAImageTheme = class(TBGRATheme)
+  private
+    FBackgroundColor: TColor;
+    FSliceScalingButton: TBGRAMultiSliceScaling;
+    FImageButtonResource: string;
+    procedure SetFBackgroundColor(AValue: TColor);
+  protected
+
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure LoadResources(AFileName: string);
+    procedure DrawButton(Caption: string; State: TBGRAThemeButtonState;
+      Focused: boolean; ARect: TRect; DestCanvas: TCanvas); override;
+  published
+    property BackgroundColor: TColor read FBackgroundColor
+      write SetFBackgroundColor default clForm;
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('BGRA Themes', [TBGRAImageTheme]);
+end;
+
+{ TBGRAImageTheme }
+
+procedure TBGRAImageTheme.SetFBackgroundColor(AValue: TColor);
+begin
+  if FBackgroundColor = AValue then
+    Exit;
+  FBackgroundColor := AValue;
+end;
+
+constructor TBGRAImageTheme.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  BackgroundColor := clForm;
+end;
+
+procedure TBGRAImageTheme.LoadResources(AFileName: string);
+begin
+  if Assigned(FSliceScalingButton) then
+    FSliceScalingButton.Free;
+  FSliceScalingButton := TBGRAMultiSliceScaling.Create(AFileName, 'Button');
+end;
+
+procedure TBGRAImageTheme.DrawButton(Caption: string; State: TBGRAThemeButtonState;
+  Focused: boolean; ARect: TRect; DestCanvas: TCanvas);
+var
+  Style: TTextStyle;
+  ImageIndex: integer;
+  bmp: TBGRABitmap;
+begin
+  case State of
+    btbsNormal: ImageIndex := 0;
+    btbsHover: ImageIndex := 1;
+    btbsActive: ImageIndex := 2;
+    btbsDisabled: ImageIndex := 3;
+  end;
+
+  bmp := TBGRABitmap.Create(ARect.Width, ARect.Height, BackgroundColor);
+
+  if Assigned(FSliceScalingButton) then
+    FSliceScalingButton.Draw(ImageIndex, bmp, 0, 0, bmp.Width, bmp.Height);
+
+  bmp.Draw(DestCanvas, ARect);
+  bmp.Free;
+
+  if Caption <> '' then
+  begin
+    Style.Alignment := taCenter;
+    Style.Layout := tlCenter;
+    Style.Wordbreak := True;
+    Style.SystemFont := False;
+    Style.Clipping := True;
+    Style.Opaque := False;
+    DestCanvas.TextRect(ARect, 0, 0, Caption, Style);
+  end;
+end;
+
+end.

bgratheme.pas

@@ -0,0 +1,71 @@
+unit BGRATheme;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs;
+
+type
+  TBGRAThemeButtonState = (btbsNormal, btbsHover, btbsActive, btbsDisabled);
+
+  { TBGRATheme }
+
+  TBGRATheme = class(TComponent)
+  private
+
+  protected
+
+  public
+    procedure DrawButton(Caption: string; State: TBGRAThemeButtonState;
+      Focused: boolean; ARect: TRect; DestCanvas: TCanvas); virtual;
+  published
+
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('BGRA Themes', [TBGRATheme]);
+end;
+
+{ TBGRATheme }
+
+procedure TBGRATheme.DrawButton(Caption: string; State: TBGRAThemeButtonState;
+  Focused: boolean; ARect: TRect; DestCanvas: TCanvas);
+var
+  Style: TTextStyle;
+begin
+  case State of
+    btbsNormal: DestCanvas.Brush.Color := RGBToColor(225, 225, 225);
+    btbsHover: DestCanvas.Brush.Color := RGBToColor(229, 241, 251);
+    btbsActive: DestCanvas.Brush.Color := RGBToColor(204, 228, 247);
+    btbsDisabled: DestCanvas.Brush.Color := RGBToColor(204, 204, 204);
+  end;
+
+  DestCanvas.Pen.Color := DestCanvas.Brush.Color;
+  DestCanvas.Rectangle(ARect);
+
+  if Focused then
+  begin
+    DestCanvas.Pen.Color := clBlack;
+    DestCanvas.Rectangle(ARect);
+  end;
+
+  if Caption <> '' then
+  begin
+    Style.Alignment := taCenter;
+    Style.Layout := tlCenter;
+    Style.Wordbreak := True;
+    Style.SystemFont := False;
+    Style.Clipping := True;
+    Style.Opaque := False;
+    DestCanvas.TextRect(ARect, 0, 0, Caption, Style);
+  end;
+end;
+
+end.

bgrathemebutton.pas

@@ -0,0 +1,123 @@
+unit BGRAThemeButton;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
+  BGRATheme;
+
+type
+
+  { TBGRAThemeButton }
+
+  TBGRAThemeButton = class(TCustomControl)
+  private
+    FTheme: TBGRATheme;
+    FState: TBGRAThemeButtonState;
+    procedure SetFTheme(AValue: TBGRATheme);
+  protected
+    procedure MouseEnter; override;
+    procedure MouseLeave; override;
+    procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
+    procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
+    procedure Click; override;
+    procedure SetEnabled(Value: Boolean); override;
+    procedure TextChanged; override;
+    procedure Paint; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+  published
+    property Caption;
+    property Font;
+    property Enabled;
+    property Theme: TBGRATheme read FTheme write SetFTheme;
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('BGRA Themes', [TBGRAThemeButton]);
+end;
+
+{ TBGRAThemeButton }
+
+procedure TBGRAThemeButton.SetFTheme(AValue: TBGRATheme);
+begin
+  if FTheme = AValue then
+    Exit;
+  FTheme := AValue;
+  Invalidate;
+end;
+
+procedure TBGRAThemeButton.MouseEnter;
+begin
+  inherited MouseEnter;
+  FState := btbsHover;
+  Invalidate;
+end;
+
+procedure TBGRAThemeButton.MouseLeave;
+begin
+  inherited MouseLeave;
+  FState := btbsNormal;
+  Invalidate;
+end;
+
+procedure TBGRAThemeButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
+  X, Y: Integer);
+begin
+  inherited MouseDown(Button, Shift, X, Y);
+  FState := btbsActive;
+  Invalidate;
+end;
+
+procedure TBGRAThemeButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
+  Y: Integer);
+begin
+  inherited MouseUp(Button, Shift, X, Y);
+  if ClientRect.Contains(Point(X, Y)) then
+    FState := btbsHover
+  else
+    FState := btbsNormal;
+  Invalidate;
+end;
+
+procedure TBGRAThemeButton.Click;
+begin
+  inherited Click;
+end;
+
+procedure TBGRAThemeButton.SetEnabled(Value: Boolean);
+begin
+  inherited SetEnabled(Value);
+  if Value then
+    FState := btbsNormal
+  else
+    FState := btbsDisabled;
+  Invalidate;
+end;
+
+procedure TBGRAThemeButton.TextChanged;
+begin
+  inherited TextChanged;
+  Invalidate;
+end;
+
+procedure TBGRAThemeButton.Paint;
+begin
+  if Assigned(Theme) then
+    Theme.DrawButton(Caption, FState, Focused, ClientRect, Canvas);
+end;
+
+constructor TBGRAThemeButton.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FState := btbsNormal;
+end;
+
+end.

test/test_bgrathemes/test.lpi

@@ -0,0 +1,85 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="test"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+      <Resources Count="1">
+        <Resource_0 FileName="..\..\..\bgracontrols\test\test_bcimagebutton_3dbutton\boton3d.png" Type="RCDATA" ResourceName="BOTON3D"/>
+      </Resources>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="bgracontrols"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="test.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="umain.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="frmBGRAThemesButton"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="test"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

test/test_bgrathemes/test.lpr

@@ -0,0 +1,22 @@
+program test;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, umain
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TfrmBGRAThemesButton, frmBGRAThemesButton);
+  Application.Run;
+end.
+

test/test_bgrathemes/theme.ini

@@ -0,0 +1,10 @@
+[Button]
+Bitmap=button.png
+NumberOfItems=4
+HorizontalDirection=False
+MarginTop=9
+MarginRight=13
+MarginBottom=15
+MarginLeft=13
+Repeat=MiddleHorizontal
+Repeat1=Top+Bottom+MiddleHorizontal

test/test_bgrathemes/umain.lfm

@@ -0,0 +1,68 @@
+object frmBGRAThemesButton: TfrmBGRAThemesButton
+  Left = 350
+  Height = 240
+  Top = 119
+  Width = 449
+  Caption = 'BGRA Themes - Button'
+  ClientHeight = 240
+  ClientWidth = 449
+  OnCreate = FormCreate
+  Position = poScreenCenter
+  LCLVersion = '2.1.0.0'
+  object BGRAThemeButton1: TBGRAThemeButton
+    Left = 8
+    Height = 32
+    Top = 16
+    Width = 144
+    Caption = 'Default Theme'
+    Theme = BGRATheme1
+  end
+  object BGRAThemeButton2: TBGRAThemeButton
+    Left = 8
+    Height = 32
+    Top = 64
+    Width = 144
+    Caption = 'Color Theme'
+    Theme = BGRAColorTheme1
+  end
+  object BGRAThemeButton3: TBGRAThemeButton
+    Left = 8
+    Height = 80
+    Top = 112
+    Width = 144
+    Caption = 'Image Theme'
+    Theme = BGRAImageTheme1
+  end
+  object ListBox1: TListBox
+    Left = 272
+    Height = 211
+    Top = 13
+    Width = 164
+    Items.Strings = (
+      'Default'
+      'Color'
+      'Image'
+    )
+    ItemHeight = 15
+    OnSelectionChange = ListBox1SelectionChange
+    TabOrder = 3
+  end
+  object BGRATheme1: TBGRATheme
+    Left = 224
+    Top = 16
+  end
+  object BGRAColorTheme1: TBGRAColorTheme
+    ColorNormal = 4227327
+    ColorHover = 16744576
+    ColorActive = 8404992
+    ColorDisabled = clGray
+    ColorFocused = clBlack
+    ColorText = clWhite
+    Left = 224
+    Top = 72
+  end
+  object BGRAImageTheme1: TBGRAImageTheme
+    Left = 224
+    Top = 130
+  end
+end

test/test_bgrathemes/umain.pas

@@ -0,0 +1,68 @@
+unit umain;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, BGRATheme,
+  BGRAThemeButton, BGRAColorTheme, BGRAImageTheme;
+
+type
+
+  { TfrmBGRAThemesButton }
+
+  TfrmBGRAThemesButton = class(TForm)
+    BGRAColorTheme1: TBGRAColorTheme;
+    BGRAImageTheme1: TBGRAImageTheme;
+    BGRATheme1: TBGRATheme;
+    BGRAThemeButton1: TBGRAThemeButton;
+    BGRAThemeButton2: TBGRAThemeButton;
+    BGRAThemeButton3: TBGRAThemeButton;
+    ListBox1: TListBox;
+    procedure FormCreate(Sender: TObject);
+    procedure ListBox1SelectionChange(Sender: TObject; User: boolean);
+  private
+
+  public
+
+  end;
+
+var
+  frmBGRAThemesButton: TfrmBGRAThemesButton;
+
+implementation
+
+{$R *.lfm}
+
+{ TfrmBGRAThemesButton }
+
+procedure TfrmBGRAThemesButton.FormCreate(Sender: TObject);
+begin
+  BGRAImageTheme1.LoadResources('theme.ini');
+end;
+
+procedure TfrmBGRAThemesButton.ListBox1SelectionChange(Sender: TObject;
+  User: boolean);
+begin
+  case ListBox1.ItemIndex of
+    0: begin
+      BGRAThemeButton1.Theme := BGRATheme1;
+      BGRAThemeButton2.Theme := BGRATheme1;
+      BGRAThemeButton3.Theme := BGRATheme1;
+    end;
+    1: begin
+      BGRAThemeButton1.Theme := BGRAColorTheme1;
+      BGRAThemeButton2.Theme := BGRAColorTheme1;
+      BGRAThemeButton3.Theme := BGRAColorTheme1;
+    end;
+    2: begin
+      BGRAThemeButton1.Theme := BGRAImageTheme1;
+      BGRAThemeButton2.Theme := BGRAImageTheme1;
+      BGRAThemeButton3.Theme := BGRAImageTheme1;
+    end;
+  end;
+end;
+
+end.
+