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
  // FMX.Graphics pour TBrush, que PaintBackground prend en parametre.
  System.UITypes, System.Classes, FMX.Types, FMX.Graphics, FMX.Objects,
  FMX.StdCtrls;

const
  // Releve sur la recherche globale du telephone, qui est la reference pour
  // tout ce qui se touche - l'application doit ressembler a l'endroit ou elle
  // tourne, pas seulement au service qu'elle prolonge.
  //
  // CE QUI FAIT CE STYLE, et qu'il faut tenir : un DEGRADE bleu en fond, des
  // blocs qui ne sont que du BLANC TRANSLUCIDE pose dessus, AUCUNE bordure, de
  // grands arrondis, du texte blanc. La profondeur vient de la transparence,
  // pas des filets - c'est pour ca que les cadres ont disparu.
  COL_BG_TOP  = TAlphaColor($FF3E6394);   // haut du degrade
  COL_BG      = TAlphaColor($FF1B3563);   // bas du degrade, et repli uni
  COL_SURFACE = TAlphaColor($1FFFFFFF);   // bloc : 12 % de blanc
  COL_RAISED  = TAlphaColor($2EFFFFFF);   // bouton au repos : 18 %
  COL_ACCENT  = TAlphaColor($4DFFFFFF);   // action principale : 30 %
  COL_LINE    = TAlphaColor($00000000);   // plus de filet : garde pour l'API
  COL_TEXT    = TAlphaColor($FFFFFFFF);
  COL_MUTED   = TAlphaColor($B3E8F0FA);
  COL_ON_ACC  = TAlphaColor($FFFFFFFF);   // le blanc reste lisible sur 30 %

/// 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, filet discret.
function Surface(AParent: TFmxObject): TRectangle;

/// Intitule au-dessus d'une valeur : petit et discret, sans majuscules.
procedure SectionLabel(ALabel: TLabel);

/// Applique le degrade bleu du fond. A poser sur le Fill de la forme.
procedure PaintBackground(AFill: TBrush);

/// 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.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;
  // AUCUNE bordure, et un grand arrondi : c'est la translucidite qui detache
  // le bloc du fond. Un filet rendrait tout de suite l'air « application de
  // bureau ».
  Result.Stroke.Kind := TBrushKind.None;
  Result.XRadius := 20;
  Result.YRadius := 20;
end;

/// Intitule au-dessus d'une valeur. Ni majuscules ni petites capitales : rien
/// n'est en majuscules dans la reference, le second plan s'y marque par la
/// couleur et la taille seules.
procedure SectionLabel(ALabel: TLabel);
begin
  ALabel.StyledSettings := [];
  ALabel.TextSettings.Font.Size := 12;
  ALabel.TextSettings.FontColor := COL_MUTED;
end;

/// Peint le degrade de fond sur une forme.
procedure PaintBackground(AFill: TBrush);
begin
  AFill.Kind := TBrushKind.Gradient;
  AFill.Gradient.Color := COL_BG_TOP;
  AFill.Gradient.Color1 := COL_BG;
  // Rien de plus : un TGradient neuf descend deja du haut vers le bas.
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;
  // Pilule : l'arrondi vaut la moitie de la hauteur usuelle d'un bouton. Tout
  // ce qui se touche est arrondi ainsi dans la reference.
  Result.XRadius := 26;
  Result.YRadius := 26;
  Result.Cursor := crHandPoint;
  Result.Stroke.Kind := TBrushKind.None;
  // La difference entre principal et secondaire tient a l'opacite du blanc,
  // pas a une couleur : la reference n'a aucun accent colore.
  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.