feat(android): paint the interface instead of wearing a style

None of the styles Delphi ships is meant for a phone - grey gradients, sharp
corners, thick frames, all from the desktop era. And the day showed that
anything rendered through a style template may not exist in the style that is
actually loaded: the list row template, the search prompt and the detail row
each vanished in turn.

So the buttons are rectangles we draw: slate at rest, cyan for the one action
that matters, rounded, no gradient, with a press feedback a TRectangle does
not have on its own - without it you cannot tell whether the tap landed. The
form's own fill carries the background, the list drops its frame, labels take
the palette.

A style stays loaded underneath, as a base only: edits, list and memo are
native controls we are not going to rewrite, and with no style at all they
would render light.

Palette lives in PMA.Theme, the same slate and cyan as the desktop app.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
r-zakarya
2026-08-15 16:55:54 +01:00
parent 25dc524585
commit e5eb91cd3f
2 changed files with 195 additions and 63 deletions
+143 -10
View File
@@ -1,28 +1,60 @@
unit PMA.Theme; unit PMA.Theme;
{ {
Thème sombre, chargé depuis une ressource embarquée. Palette et controles peints a la main.
POURQUOI UNE RESSOURCE ET NON UN FICHIER : le mecanisme de deploiement de ce POURQUOI PAS UN STYLE : aucun des styles livres avec Delphi n'est pense pour
projet ne pose aucun fichier a cote de l'application - c'est le meme trou qui un mobile - degrades gris, angles vifs, cadres epais, tous datent de
oblige a mettre en place le manifeste et les .dex a la main. Une ressource l'epoque bureau. Et la journee a montre que tout ce qui passe par un gabarit
liee dans le .so ne depend de rien : elle est la ou n'est pas, et elle est la. 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 Le style vient de Dark.style, livre avec Delphi, recopie dans le depot pour
que la compilation ne dependre pas d'un chemin d'installation. que la compilation ne depende pas d'un chemin d'installation.
Un echec ici n'est jamais fatal : sans style, l'application garde l'apparence
par defaut. Elle est laide, elle fonctionne.
} }
interface 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. /// A appeler une fois, avant la creation de la forme.
procedure ApplyDarkTheme; 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 implementation
uses uses
System.SysUtils, System.Types, System.Classes, FMX.Styles, FMX.Types; System.SysUtils, System.Types, FMX.Styles, FMX.Graphics, FMX.Controls;
{$R 'theme\theme.res' 'theme\theme.rc'} {$R 'theme\theme.res' 'theme\theme.rc'}
@@ -40,4 +72,105 @@ begin
end; end;
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. end.
+52 -53
View File
@@ -1,4 +1,4 @@
unit mainApk; unit mainApk;
{ {
Client Android en LECTURE SEULE : deverrouiller, chercher, copier. Client Android en LECTURE SEULE : deverrouiller, chercher, copier.
@@ -90,7 +90,7 @@ type
// --- ecran 1 : deverrouillage // --- ecran 1 : deverrouillage
FLayUnlock: TLayout; FLayUnlock: TLayout;
FUrl, FToken, FPwd: TEdit; FUrl, FToken, FPwd: TEdit;
FBtnOpen, FBtnSync, FBtnSettings: TButton; FBtnOpen, FBtnSync, FBtnSettings: TRectangle;
FLaySettings: TLayout; FLaySettings: TLayout;
FStatus: TLabel; FStatus: TLabel;
FLog: TMemo; FLog: TMemo;
@@ -114,6 +114,7 @@ type
FLayDetail: TLayout; FLayDetail: TLayout;
FDetBody: TVertScrollBox; FDetBody: TVertScrollBox;
FDetTitle, FDetToast: TLabel; FDetTitle, FDetToast: TLabel;
FBtnReveal: TRectangle;
FRows: TArray<TDetRow>; FRows: TArray<TDetRow>;
FRowCtls: TArray<TLayout>; FRowCtls: TArray<TLayout>;
FRowValues: TArray<TLabel>; FRowValues: TArray<TLabel>;
@@ -189,7 +190,7 @@ implementation
uses uses
PMA.Crypto, PMA.SyncClient, PMA.Store, PMA.Biometric, PMA.Totp, PMA.Crypto, PMA.SyncClient, PMA.Store, PMA.Biometric, PMA.Totp,
PMA.ScreenGuard, PMA.Clipboard; PMA.ScreenGuard, PMA.Clipboard, PMA.Theme;
{$R *.fmx} {$R *.fmx}
@@ -210,6 +211,10 @@ var
begin begin
inherited; inherited;
Caption := 'Coffre'; Caption := 'Coffre';
// Le fond de la forme, et non celui du style : tout le reste est peint
// par-dessus, et un gris herite se verrait entre les blocs.
Fill.Kind := TBrushKind.Solid;
Fill.Color := COL_BG;
SecureScreen; // avant tout affichage de contenu SecureScreen; // avant tout affichage de contenu
FVault := TVault.Create; FVault := TVault.Create;
FIcons := TObjectDictionary<Integer, TBitmap>.Create([doOwnsValues]); FIcons := TObjectDictionary<Integer, TBitmap>.Create([doOwnsValues]);
@@ -263,15 +268,12 @@ end;
/// s'empilent A REBOURS de leur creation : le dernier cree se retrouve tout en /// s'empilent A REBOURS de leur creation : le dernier cree se retrouve tout en
/// haut. Chaque Build* cree donc du bas vers le haut. /// haut. Chaque Build* cree donc du bas vers le haut.
function TopButton(AParent: TFmxObject; const AText: string; function TopButton(AParent: TFmxObject; const AText: string;
AOnClick: TNotifyEvent; AHeight: Single = 48): TButton; AOnClick: TNotifyEvent; AHeight: Single = 52; APrimary: Boolean = False): TRectangle;
begin begin
Result := TButton.Create(AParent); Result := FlatButton(AParent, AText, AOnClick, APrimary);
Result.Parent := AParent;
Result.Align := TAlignLayout.Top; Result.Align := TAlignLayout.Top;
Result.Margins.Rect := RectF(8, 4, 8, 0); Result.Margins.Rect := RectF(16, 8, 16, 0);
Result.Height := AHeight; Result.Height := AHeight;
Result.Text := AText;
Result.OnClick := AOnClick;
end; end;
function TopEdit(AParent: TFmxObject; const APrompt, AText: string; function TopEdit(AParent: TFmxObject; const APrompt, AText: string;
@@ -316,6 +318,8 @@ begin
FLaySettings.Visible := False; FLaySettings.Visible := False;
FToken := TopEdit(FLaySettings, 'jeton Bearer', FIRSTRUN_TOKEN); FToken := TopEdit(FLaySettings, 'jeton Bearer', FIRSTRUN_TOKEN);
FUrl := TopEdit(FLaySettings, 'URL de l''endpoint', FIRSTRUN_URL); FUrl := TopEdit(FLaySettings, 'URL de l''endpoint', FIRSTRUN_URL);
FToken.Margins.Rect := RectF(16, 8, 16, 0);
FUrl.Margins.Rect := RectF(16, 8, 16, 0);
// Ce que l'appareil a retenu l'emporte sur les valeurs de premier lancement. // Ce que l'appareil a retenu l'emporte sur les valeurs de premier lancement.
if LoadDeviceSettings(LUrl, LToken) then if LoadDeviceSettings(LUrl, LToken) then
begin begin
@@ -324,29 +328,28 @@ begin
end; end;
FBtnSettings := TopButton(FLayUnlock, 'Reglages du serveur', FBtnSettings := TopButton(FLayUnlock, 'Reglages du serveur',
OnToggleSettings, 36); OnToggleSettings, 40);
FBtnSettings.TextSettings.Font.Size := 12;
FBtnSync := TopButton(FLayUnlock, 'Synchroniser', DoSync); FBtnSync := TopButton(FLayUnlock, 'Synchroniser', DoSync);
FBtnOpen := TopButton(FLayUnlock, 'Ouvrir le coffre', DoOpenLocal); // Accentue : c'est l'action attendue quand aucun coffre n'est encore la.
FBtnOpen := TopButton(FLayUnlock, 'Ouvrir le coffre', DoOpenLocal, 52, True);
// Pre-rempli depuis le fichier local, jamais depuis ce fichier-ci. // Pre-rempli depuis le fichier local, jamais depuis ce fichier-ci.
FPwd := TopEdit(FLayUnlock, 'mot de passe de sync', TEST_PWD, True); FPwd := TopEdit(FLayUnlock, 'mot de passe de sync', TEST_PWD, True);
FPwd.Margins.Top := 12; FPwd.Margins.Rect := RectF(16, 16, 16, 0);
FStatus := TLabel.Create(Self); FStatus := TLabel.Create(Self);
FStatus.Parent := FLayUnlock; FStatus.Parent := FLayUnlock;
FStatus.Align := TAlignLayout.Top; FStatus.Align := TAlignLayout.Top;
FStatus.Margins.Rect := RectF(8, 16, 8, 0); FStatus.Margins.Rect := RectF(16, 24, 16, 4);
FStatus.Height := 24; FStatus.Height := 26;
FStatus.StyledSettings := FStatus.StyledSettings - [TStyledSetting.Size]; Tint(FStatus, 15, True);
FStatus.TextSettings.Font.Size := 15;
end; end;
procedure TForm8.BuildList; procedure TForm8.BuildList;
var var
LBar, LTop: TLayout; LBar, LTop: TLayout;
LBtnLock: TButton; LBtnLock: TRectangle;
begin begin
FLayList := TLayout.Create(Self); FLayList := TLayout.Create(Self);
FLayList.Parent := Self; FLayList.Parent := Self;
@@ -358,28 +361,30 @@ begin
LBar.Align := TAlignLayout.Bottom; LBar.Align := TAlignLayout.Bottom;
LBar.Height := 52; LBar.Height := 52;
LBtnLock := TButton.Create(Self); LBtnLock := FlatButton(LBar, 'Verrouiller', OnBackTap);
LBtnLock.Parent := LBar;
LBtnLock.Align := TAlignLayout.Left; LBtnLock.Align := TAlignLayout.Left;
LBtnLock.Margins.Rect := RectF(8, 4, 0, 8); LBtnLock.Margins.Rect := RectF(16, 4, 0, 8);
LBtnLock.Width := 130; LBtnLock.Width := 140;
LBtnLock.Text := 'Verrouiller';
LBtnLock.OnClick := OnBackTap;
LBtnLock.Tag := 1; // 1 = verrouiller, 0 = simple retour (voir OnBackTap) LBtnLock.Tag := 1; // 1 = verrouiller, 0 = simple retour (voir OnBackTap)
FCount := TLabel.Create(Self); FCount := TLabel.Create(Self);
FCount.Parent := LBar; FCount.Parent := LBar;
FCount.Align := TAlignLayout.Client; FCount.Align := TAlignLayout.Client;
FCount.Margins.Rect := RectF(12, 4, 8, 8); FCount.Margins.Rect := RectF(12, 4, 16, 8);
FCount.TextSettings.HorzAlign := TTextAlign.Trailing; FCount.TextSettings.HorzAlign := TTextAlign.Trailing;
FCount.TextSettings.VertAlign := TTextAlign.Center; FCount.TextSettings.VertAlign := TTextAlign.Center;
Tint(FCount, 13, True);
FList := TListBox.Create(Self); FList := TListBox.Create(Self);
FList.Parent := FLayList; FList.Parent := FLayList;
FList.Align := TAlignLayout.Client; FList.Align := TAlignLayout.Client;
FList.Margins.Rect := RectF(4, 0, 4, 0); FList.Margins.Rect := RectF(8, 0, 8, 0);
FList.ItemHeight := 56; FList.ItemHeight := 62;
FList.OnItemClick := OnItemTap; FList.OnItemClick := OnItemTap;
// Sans cadre : la liste est posee sur le fond general, pas dans une boite.
// Le gabarit transparent existe dans les styles livres ; s'il manquait, on
// retomberait simplement sur l'apparence encadree.
FList.StyleLookup := 'transparentlistboxstyle';
LTop := TLayout.Create(Self); LTop := TLayout.Create(Self);
LTop.Parent := FLayList; LTop.Parent := FLayList;
@@ -452,35 +457,29 @@ begin
end; end;
function AddRowButton(ARow: TLayout; const AText: string; ATag: Integer; function AddRowButton(ARow: TLayout; const AText: string; ATag: Integer;
AOnClick: TNotifyEvent): TButton; AOnClick: TNotifyEvent): TRectangle;
begin begin
Result := TButton.Create(ARow); Result := FlatButton(ARow, AText, AOnClick);
Result.Parent := ARow;
Result.Align := TAlignLayout.Right; Result.Align := TAlignLayout.Right;
Result.Margins.Left := 6; Result.Margins.Rect := RectF(8, 6, 0, 6);
Result.Width := 90; Result.Width := 96;
Result.Text := AText;
Result.Tag := ATag; Result.Tag := ATag;
Result.OnClick := AOnClick;
end; end;
procedure TForm8.BuildDetail; procedure TForm8.BuildDetail;
var var
LBtnBack: TButton; LBtnBack: TRectangle;
begin begin
FLayDetail := TLayout.Create(Self); FLayDetail := TLayout.Create(Self);
FLayDetail.Parent := Self; FLayDetail.Parent := Self;
FLayDetail.Align := TAlignLayout.Client; FLayDetail.Align := TAlignLayout.Client;
FLayDetail.Visible := False; FLayDetail.Visible := False;
LBtnBack := TButton.Create(Self); LBtnBack := FlatButton(FLayDetail, 'Retour', OnBackTap);
LBtnBack.Parent := FLayDetail;
LBtnBack.Align := TAlignLayout.Bottom; LBtnBack.Align := TAlignLayout.Bottom;
LBtnBack.Height := 48; LBtnBack.Height := 52;
LBtnBack.Margins.Rect := RectF(8, 8, 8, 8); LBtnBack.Margins.Rect := RectF(16, 8, 16, 8);
LBtnBack.Text := 'Retour';
LBtnBack.Tag := 0; LBtnBack.Tag := 0;
LBtnBack.OnClick := OnBackTap;
FDetToast := TLabel.Create(Self); FDetToast := TLabel.Create(Self);
FDetToast.Parent := FLayDetail; FDetToast.Parent := FLayDetail;
@@ -522,12 +521,12 @@ begin
Status('Coffre present sur cet appareil - protege') Status('Coffre present sur cet appareil - protege')
else else
Status('Coffre present sur cet appareil'); Status('Coffre present sur cet appareil');
FBtnSync.Text := 'Synchroniser'; SetButtonText(FBtnSync, 'Synchroniser');
end end
else else
begin begin
Status('Aucun coffre local - premier telechargement'); Status('Aucun coffre local - premier telechargement');
FBtnSync.Text := 'Telecharger le coffre'; SetButtonText(FBtnSync, 'Telecharger le coffre');
end; end;
end; end;
@@ -714,7 +713,7 @@ end;
procedure TForm8.OnBackTap(Sender: TObject); procedure TForm8.OnBackTap(Sender: TObject);
begin begin
// Tag 1 = le bouton "Verrouiller" de la liste, 0 = le "Retour" du detail. // Tag 1 = le bouton "Verrouiller" de la liste, 0 = le "Retour" du detail.
if (Sender is TButton) and (TButton(Sender).Tag = 1) then if (Sender is TRectangle) and (TRectangle(Sender).Tag = 1) then
LockVault LockVault
else else
ShowList; ShowList;
@@ -894,7 +893,7 @@ begin
end; end;
FLog.Lines.Clear; FLog.Lines.Clear;
// MEME PORTE QUE « Ouvrir le coffre ». Sans cela la protection ne tenait // MEME PORTE QUE « Ouvrir le coffre ». Sans cela la protection ne tenait
// qu'a un bouton pres : synchroniser reconstruit le coffre depuis le serveur // qu'a un bouton pres : synchroniser reconstruit le coffre depuis le serveur
// et l'affiche, ce qui revient exactement au meme resultat sans passer par // et l'affiche, ce qui revient exactement au meme resultat sans passer par
// l'authentification. La condition est la presence d'un cache protege sur // l'authentification. La condition est la presence d'un cache protege sur
@@ -1258,20 +1257,20 @@ var
I: Integer; I: Integer;
begin begin
Touch; Touch;
if not (Sender is TButton) then Exit; if not (Sender is TRectangle) then Exit;
I := TButton(Sender).Tag; I := TRectangle(Sender).Tag;
if (I < 0) or (I > High(FRows)) then Exit; if (I < 0) or (I > High(FRows)) then Exit;
FRowShown[I] := not FRowShown[I]; FRowShown[I] := not FRowShown[I];
if FRowShown[I] then if FRowShown[I] then
begin begin
FRowValues[I].Text := FRows[I].Value; FRowValues[I].Text := FRows[I].Value;
TButton(Sender).Text := 'Masquer'; SetButtonText(TRectangle(Sender), 'Masquer');
end end
else else
begin begin
FRowValues[I].Text := MASK; FRowValues[I].Text := MASK;
TButton(Sender).Text := 'Afficher'; SetButtonText(TRectangle(Sender), 'Afficher');
end; end;
end; end;
@@ -1280,8 +1279,8 @@ var
I: Integer; I: Integer;
begin begin
Touch; Touch;
if not (Sender is TButton) then Exit; if not (Sender is TRectangle) then Exit;
I := TButton(Sender).Tag; I := TRectangle(Sender).Tag;
// -1 : la ligne du TOTP, qui n'est pas dans FRows - sa valeur change chaque // -1 : la ligne du TOTP, qui n'est pas dans FRows - sa valeur change chaque
// periode et ne vit que dans FTotpCode. Copie sans l'espace d'affichage. // periode et ne vit que dans FTotpCode. Copie sans l'espace d'affichage.
if I = -1 then if I = -1 then
@@ -1387,8 +1386,8 @@ end;
procedure TForm8.SetBusy(ABusy: Boolean); procedure TForm8.SetBusy(ABusy: Boolean);
begin begin
FBusy := ABusy; FBusy := ABusy;
FBtnSync.Enabled := not ABusy; SetButtonEnabled(FBtnSync, not ABusy);
FBtnOpen.Enabled := not ABusy; SetButtonEnabled(FBtnOpen, not ABusy);
end; end;
end. end.