Korrekter Umgang mit Delphi Styles und eigenen Komponenten

[TiGü]

Ich habe mich in meiner eigenen Anwendung auf einen einzigen selbst erstellten Style konzentriert.
Jeden Style abdecken zu wollen ist eine Mammutaufgabe.
Fraglich auch, ob das sinnvoll ist.
Ich würde den Anwender die Wahl lassen zwischen den normalen Windows-Style und einen anderen.

Dementsprechend muss man ggf. alles doppelt haben: Imagelisten, Image-Ressourcen usw. und zur Laufzeit beim Programmstart austauschen.
Die Farben müssen dann entsprechend aus den Style extrahiert werden (GetSystemColor/GetStyleColor).

Hier mal so ein Minimalbeispiel:

Delphi-Quellcode:

unit StylesTestFrm;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.StdCtrls,
  Vcl.ExtCtrls,
  System.Generics.Collections,
  Vcl.Themes,
  Vcl.ImgList;

type

  TLineState = (Start, Move, Stop);

  TPainter = class
  strict private
    FIsLineStarted : Boolean;
    FCanvas : TCanvas;
    FImageIndex : Integer;
    FImageList : TImageList;
    FPoints : TList<TPoint>;
  public
    procedure Clear;
    function PaintLine(LineState : TLineState; X, Y : Integer) : Boolean;
    procedure Paint;

    constructor Create(ACanvas : TCanvas; AImageList : TImageList);
    destructor Destroy; override;

    property IsLineStarted : Boolean read FIsLineStarted write FIsLineStarted;
  end;

  TForm2 = class(TForm)
    PaintBox1 : TPaintBox;
    ilSystem : TImageList;
    ilStyle : TImageList;
    procedure FormCreate(Sender : TObject);
    procedure PaintBox1MouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
    procedure PaintBox1MouseMove(Sender : TObject; Shift : TShiftState; X, Y : Integer);
    procedure PaintBox1Paint(Sender : TObject);
    procedure PaintBox1MouseUp(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
    procedure FormDestroy(Sender: TObject);
  private
    FPainter : TPainter;
  public
  end;

var
  Form2 : TForm2;

implementation

uses
  System.Math;

{$R *.dfm}

procedure TForm2.FormCreate(Sender : TObject);
var
  LCurrentImageList : TImageList;
begin
  LCurrentImageList := ilStyle;
  if StyleServices.IsSystemStyle then
  begin
    LCurrentImageList := ilSystem;
  end;

  FPainter := TPainter.Create(PaintBox1.Canvas, LCurrentImageList);
end;

procedure TForm2.FormDestroy(Sender: TObject);
begin
  FPainter.Free;
end;

procedure TForm2.PaintBox1MouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
begin
  case Button of
    TMouseButton.mbLeft :
    begin
      if FPainter.PaintLine(TLineState.Start, X, Y) then
        PaintBox1.Repaint;
    end;
  end;
end;

procedure TForm2.PaintBox1MouseMove(Sender : TObject; Shift : TShiftState; X, Y : Integer);
begin
  if FPainter.PaintLine(TLineState.Move, X, Y) then
    PaintBox1.Repaint;
end;

procedure TForm2.PaintBox1MouseUp(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
begin
  case Button of
    TMouseButton.mbLeft :
    begin
      if FPainter.PaintLine(TLineState.Stop, X, Y) then
        PaintBox1.Repaint;
    end;
    TMouseButton.mbRight :
    begin
      FPainter.Clear;
      PaintBox1.Repaint;
    end;
  end;
end;

procedure TForm2.PaintBox1Paint(Sender : TObject);
begin
  if Assigned(FPainter) then
  begin
    FPainter.Paint;
  end;
end;

procedure TPainter.Clear;
begin
  FCanvas.FillRect(FCanvas.ClipRect);
  FPoints.Clear;
  FImageIndex := 0;
end;

constructor TPainter.Create(ACanvas : TCanvas; AImageList : TImageList);
begin
  FCanvas := ACanvas;
  FImageList := AImageList;
  FPoints := TList<TPoint>.Create;
  FCanvas.Pen.Width := 5;
  FCanvas.Pen.Color := StyleServices.GetSystemColor(clHighlight);
  FCanvas.Brush.Color := StyleServices.GetSystemColor(clBackground);
end;

destructor TPainter.Destroy;
begin
  FPoints.Free;
  inherited;
end;

procedure TPainter.Paint;
var
  LPoints : TArray<TPoint>;
  LLastPosition : TPoint;
begin
  LPoints := FPoints.ToArray;
  FCanvas.Polyline(LPoints);

  if InRange(FImageIndex, 0, FImageList.Count - 1) then
  begin
    Inc(FImageIndex)
  end
  else
  begin
    FImageIndex := 0;
  end;

  if FPoints.Count > 0 then
  begin
    LLastPosition := FPoints.Last;
    FImageList.Draw(FCanvas, LLastPosition.X + 3, LLastPosition.Y + 3, FImageIndex);
  end;
end;

function TPainter.PaintLine(LineState : TLineState; X, Y : Integer) : Boolean;
var
  LPosition : TPoint;
begin
  LPosition := TPoint.Create(X, Y);
  case LineState of
    Start :
    begin
      FPoints.Add(LPosition);
      IsLineStarted := True;
    end;
    Move :
    begin
      if IsLineStarted then
      begin
        if LPosition <> FPoints.Last then
        begin
          FPoints.Add(LPosition);
        end;
      end;
    end;
    Stop :
    begin
      if IsLineStarted then
      begin
        FPoints.Clear;
        IsLineStarted := False;
      end;
    end;
  end;
  Result := IsLineStarted;
end;

end.