unit PMA.Theme;
{
  Palette et controles peints a la main.

  POURQUOI PAS UN STYLE : aucun des styles livres avec Delphi n'est pense pour
  un mobile - degrades gris, angles vifs, cadres epais, tous datent de
  l'epoque bureau. Et la journee a montre que tout ce qui passe par un gabarit
  de style peut ne pas exister dans le style charge : le gabarit de ligne de
  liste, l'invite de recherche, la ligne de detail ont disparu tour a tour.

  Un style RESTE charge malgre tout, comme socle : les champs de saisie, la
  liste et le memo sont des controles natifs qu'on ne va pas reecrire, et sans
  style ils s'afficheraient en clair. Tout le reste - boutons, surfaces,
  couleurs - est peint ici, ou rien ne peut disparaitre.

  Le style vient de Dark.style, livre avec Delphi, recopie dans le depot pour
  que la compilation ne depende pas d'un chemin d'installation.
}

interface

uses
  System.UITypes, System.Classes, FMX.Types, FMX.Objects, FMX.StdCtrls;

const
  // Ardoise et cyan, la palette du poste Windows.
  COL_BG      = TAlphaColor($FF0F172A);   // fond general
  COL_SURFACE = TAlphaColor($FF1E293B);   // blocs poses dessus
  COL_RAISED  = TAlphaColor($FF334155);   // bouton au repos
  COL_TEXT    = TAlphaColor($FFE2E8F0);
  COL_MUTED   = TAlphaColor($FF94A3B8);
  COL_ACCENT  = TAlphaColor($FF22D3EE);
  COL_ON_ACC  = TAlphaColor($FF042F3B);   // texte sur fond accentue

/// A appeler une fois, avant la creation de la forme.
procedure ApplyDarkTheme;

/// Bouton plat. APrimary le remplit de cyan ; sinon il reste sobre.
/// Renvoie un TRectangle et non un TButton : c'est justement pour ne plus
/// dependre du gabarit qu'un TButton irait chercher dans le style.
function FlatButton(AParent: TFmxObject; const AText: string;
  AOnClick: TNotifyEvent; APrimary: Boolean = False): TRectangle;

/// Le libelle est un enfant du bouton, retenu par TagObject.
procedure SetButtonText(AButton: TRectangle; const AText: string);
procedure SetButtonEnabled(AButton: TRectangle; AEnabled: Boolean);

/// Bloc de fond, coins arrondis.
function Surface(AParent: TFmxObject): TRectangle;

/// Met un libelle a la palette. AMuted pour les intitules discrets.
procedure Tint(ALabel: TLabel; ASize: Single; AMuted: Boolean = False);

implementation

uses
  System.SysUtils, System.Types, FMX.Styles, FMX.Graphics, FMX.Controls;

{$R 'theme\theme.res' 'theme\theme.rc'}

procedure ApplyDarkTheme;
var
  LStyle: TFmxObject;
begin
  try
    // La lecture appartient a TStyleStreaming, l'application a TStyleManager.
    LStyle := TStyleStreaming.LoadFromResource(HInstance, 'PMDARKSTYLE', RT_RCDATA);
    if LStyle <> nil then
      TStyleManager.SetStyle(LStyle);
  except
    // Rien : l'apparence par defaut reste utilisable.
  end;
end;

type
  /// Retient l'etat au repos pour le restaurer apres l'appui. Un TRectangle
  /// n'a pas d'etat « enfonce » : sans retour visuel, on ne sait pas si le
  /// doigt a porte.
  TPressFeedback = class(TComponent)
  public
    Rest: TAlphaColor;
    procedure Down(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Single);
    procedure Up(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Single);
    procedure Leave(Sender: TObject);
  end;

procedure TPressFeedback.Down(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  if Sender is TRectangle then TRectangle(Sender).Opacity := 0.62;
end;

procedure TPressFeedback.Up(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Single);
begin
  if Sender is TRectangle then TRectangle(Sender).Opacity := 1;
end;

procedure TPressFeedback.Leave(Sender: TObject);
begin
  if Sender is TRectangle then TRectangle(Sender).Opacity := 1;
end;

function Surface(AParent: TFmxObject): TRectangle;
begin
  Result := TRectangle.Create(AParent);
  Result.Parent := AParent;
  Result.Fill.Color := COL_SURFACE;
  Result.Stroke.Kind := TBrushKind.None;
  Result.XRadius := 12;
  Result.YRadius := 12;
end;

function FlatButton(AParent: TFmxObject; const AText: string;
  AOnClick: TNotifyEvent; APrimary: Boolean): TRectangle;
var
  LCaption: TLabel;
  LFeedback: TPressFeedback;
begin
  Result := TRectangle.Create(AParent);
  Result.Parent := AParent;
  Result.Stroke.Kind := TBrushKind.None;
  Result.XRadius := 10;
  Result.YRadius := 10;
  Result.Cursor := crHandPoint;
  if APrimary then Result.Fill.Color := COL_ACCENT
              else Result.Fill.Color := COL_RAISED;
  Result.OnClick := AOnClick;

  LCaption := TLabel.Create(Result);
  LCaption.Parent := Result;
  LCaption.Align := TAlignLayout.Client;
  LCaption.HitTest := False;          // le clic doit atteindre le rectangle
  LCaption.Text := AText;
  LCaption.TextSettings.HorzAlign := TTextAlign.Center;
  LCaption.TextSettings.VertAlign := TTextAlign.Center;
  LCaption.StyledSettings := [];      // on gouverne police ET couleur
  LCaption.TextSettings.Font.Size := 15;
  if APrimary then LCaption.TextSettings.FontColor := COL_ON_ACC
              else LCaption.TextSettings.FontColor := COL_TEXT;
  Result.TagObject := LCaption;

  // Le retour d'appui appartient au bouton : il vit et meurt avec lui.
  LFeedback := TPressFeedback.Create(Result);
  LFeedback.Rest := Result.Fill.Color;
  Result.OnMouseDown := LFeedback.Down;
  Result.OnMouseUp := LFeedback.Up;
  Result.OnMouseLeave := LFeedback.Leave;
end;

procedure SetButtonText(AButton: TRectangle; const AText: string);
begin
  if (AButton <> nil) and (AButton.TagObject is TLabel) then
    TLabel(AButton.TagObject).Text := AText;
end;

procedure SetButtonEnabled(AButton: TRectangle; AEnabled: Boolean);
begin
  if AButton = nil then Exit;
  AButton.Enabled := AEnabled;
  // Enabled seul ne se voit pas sur une forme peinte : sans ce grise, un
  // bouton inactif invite a insister.
  if AEnabled then AButton.Opacity := 1 else AButton.Opacity := 0.4;
end;

procedure Tint(ALabel: TLabel; ASize: Single; AMuted: Boolean);
begin
  ALabel.StyledSettings := [];
  ALabel.TextSettings.Font.Size := ASize;
  if AMuted then ALabel.TextSettings.FontColor := COL_MUTED
            else ALabel.TextSettings.FontColor := COL_TEXT;
end;

end.