source: ProjectTemplates/FileMenuProject/Packages/Common/UTheme.pas

unit UTheme;

interface

uses
  Classes, SysUtils, Graphics, ComCtrls, Controls, ExtCtrls, Menus, StdCtrls,
  Spin, Forms, Contnrs, Grids;

type
  TTheme = class
    Name: string;
    ColorWindow: TColor;
    ColorWindowText: TColor;
    ColorControl: TColor;
    ColorControlText: TColor;
    ColorControlSelected: TColor;
  end;

  { TThemes }

  TThemes = class(TObjectList)
    function AddNew(Name: string): TTheme;
    function FindByName(Name: string): TTheme;
    procedure LoadToStrings(Strings: TStrings);
  end;

  { TThemeManager }

  TThemeManager = class(TComponent)
  private
    FTheme: TTheme;
    procedure SetTheme(AValue: TTheme);
    procedure SetThemeName(AValue: TTheme);
  public
    Used: Boolean;
    Themes: TThemes;
    procedure ApplyTheme(Component: TComponent);
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UseTheme(Form: TForm);
    property Theme: TTheme read FTheme write SetTheme;
  end;

procedure Register;

implementation

{ TThemes }

procedure Register;
begin
  RegisterComponents('Common', [TThemeManager]);
end;

function TThemes.AddNew(Name: string): TTheme;
begin
  Result := TTheme.Create;
  Result.Name := Name;
  Add(Result);
end;

function TThemes.FindByName(Name: string): TTheme;
var
  Theme: TTheme;
begin
  Result := nil;
  for Theme in Self do
    if Theme.Name = Name then begin
      Result := Theme;
      Exit;
    end;
end;

procedure TThemes.LoadToStrings(Strings: TStrings);
var
  Theme: TTheme;
begin
  Strings.Clear;
  for Theme in Self do
    Strings.AddObject(Theme.Name, Theme);
end;

procedure TThemeManager.SetThemeName(AValue: TTheme);
begin
  if FTheme = AValue then Exit;
  FTheme := AValue;
end;

procedure TThemeManager.SetTheme(AValue: TTheme);
begin
  if FTheme = AValue then Exit;
  FTheme := AValue;
end;

constructor TThemeManager.Create(AOwner: TComponent);
begin
  inherited;
  Themes := TThemes.Create;
  with Themes.AddNew('System') do begin
    ColorWindow := clWindow;
    ColorWindowText := clWindowText;
    ColorControl := clMenu;
    ColorControlText := clWindowText;
    ColorControlSelected := clWindow;
  end;
  Theme := TTheme(Themes.First);
  with Themes.AddNew('Dark') do begin
    ColorWindow := RGBToColor($20, $20, $20);
    ColorWindowText := clWhite;
    ColorControl := RGBToColor($40, $40, $40);
    ColorControlText := clWhite;
    ColorControlSelected := RGBToColor(96, 125, 155);
  end;
  with Themes.AddNew('Light') do begin
    ColorWindow := clWhite;
    ColorWindowText := clBlack;
    ColorControl := RGBToColor($e0, $e0, $e0);
    ColorControlText := clBlack;
    ColorControlSelected := RGBToColor(196, 225, 255);
  end;
end;

destructor TThemeManager.Destroy;
begin
  Themes.Free;
  inherited Destroy;
end;

procedure TThemeManager.ApplyTheme(Component: TComponent);
var
  Control: TControl;
  I: Integer;
begin
  for I := 0 to Component.ComponentCount - 1 do
    ApplyTheme(Component.Components[I]);

  if Component is TControl then begin
    Control := (Component as TControl);
    if (Control is TEdit) or (Control is TSpinEdit) or (Control is TComboBox) and
    (Control is TMemo) or (Control is TListView) or (Control is TCustomDrawGrid) or
    (Control is TCheckBox) then begin
      Control.Color := FTheme.ColorWindow;
      Control.Font.Color := FTheme.ColorWindowText;
    end else begin
      Control.Color := FTheme.ColorControl;
      Control.Font.Color := FTheme.ColorControlText;
    end;

    if Control is TCustomDrawGrid then begin
      (Control as TCustomDrawGrid).Editor.Color := FTheme.ColorWindow;
      (Control as TCustomDrawGrid).Editor.Font.Color := FTheme.ColorWindowText;
    end;
  end;
end;

procedure TThemeManager.UseTheme(Form: TForm);
begin
  if not Used and (FTheme.Name = 'System') then Exit;
  ApplyTheme(Form);
  Used := True;
end;


end.