From e5eb91cd3f386295821d405627c0d42b3116cb54 Mon Sep 17 00:00:00 2001 From: r-zakarya <82443831+r-zakarya@users.noreply.github.com> Date: Sat, 15 Aug 2026 16:55:54 +0100 Subject: [PATCH] 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 --- android-client/PMA.Theme.pas | 153 ++++++++++++++++++++++++++++++++--- mainApk.pas | 105 ++++++++++++------------ 2 files changed, 195 insertions(+), 63 deletions(-) diff --git a/android-client/PMA.Theme.pas b/android-client/PMA.Theme.pas index 80a556a..72a4650 100644 --- a/android-client/PMA.Theme.pas +++ b/android-client/PMA.Theme.pas @@ -1,28 +1,60 @@ 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 - projet ne pose aucun fichier a cote de l'application - c'est le meme trou qui - oblige a mettre en place le manifeste et les .dex a la main. Une ressource - liee dans le .so ne depend de rien : elle est la ou n'est pas, et elle est la. + 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 dependre 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. + 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, System.Classes, FMX.Styles, FMX.Types; + System.SysUtils, System.Types, FMX.Styles, FMX.Graphics, FMX.Controls; {$R 'theme\theme.res' 'theme\theme.rc'} @@ -40,4 +72,105 @@ begin 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. diff --git a/mainApk.pas b/mainApk.pas index 26242a3..f18c469 100644 --- a/mainApk.pas +++ b/mainApk.pas @@ -1,4 +1,4 @@ -unit mainApk; +unit mainApk; { Client Android en LECTURE SEULE : deverrouiller, chercher, copier. @@ -90,7 +90,7 @@ type // --- ecran 1 : deverrouillage FLayUnlock: TLayout; FUrl, FToken, FPwd: TEdit; - FBtnOpen, FBtnSync, FBtnSettings: TButton; + FBtnOpen, FBtnSync, FBtnSettings: TRectangle; FLaySettings: TLayout; FStatus: TLabel; FLog: TMemo; @@ -114,6 +114,7 @@ type FLayDetail: TLayout; FDetBody: TVertScrollBox; FDetTitle, FDetToast: TLabel; + FBtnReveal: TRectangle; FRows: TArray; FRowCtls: TArray; FRowValues: TArray; @@ -189,7 +190,7 @@ implementation uses PMA.Crypto, PMA.SyncClient, PMA.Store, PMA.Biometric, PMA.Totp, - PMA.ScreenGuard, PMA.Clipboard; + PMA.ScreenGuard, PMA.Clipboard, PMA.Theme; {$R *.fmx} @@ -210,6 +211,10 @@ var begin inherited; 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 FVault := TVault.Create; FIcons := TObjectDictionary.Create([doOwnsValues]); @@ -263,15 +268,12 @@ end; /// s'empilent A REBOURS de leur creation : le dernier cree se retrouve tout en /// haut. Chaque Build* cree donc du bas vers le haut. function TopButton(AParent: TFmxObject; const AText: string; - AOnClick: TNotifyEvent; AHeight: Single = 48): TButton; + AOnClick: TNotifyEvent; AHeight: Single = 52; APrimary: Boolean = False): TRectangle; begin - Result := TButton.Create(AParent); - Result.Parent := AParent; + Result := FlatButton(AParent, AText, AOnClick, APrimary); Result.Align := TAlignLayout.Top; - Result.Margins.Rect := RectF(8, 4, 8, 0); + Result.Margins.Rect := RectF(16, 8, 16, 0); Result.Height := AHeight; - Result.Text := AText; - Result.OnClick := AOnClick; end; function TopEdit(AParent: TFmxObject; const APrompt, AText: string; @@ -316,6 +318,8 @@ begin FLaySettings.Visible := False; FToken := TopEdit(FLaySettings, 'jeton Bearer', FIRSTRUN_TOKEN); 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. if LoadDeviceSettings(LUrl, LToken) then begin @@ -324,29 +328,28 @@ begin end; FBtnSettings := TopButton(FLayUnlock, 'Reglages du serveur', - OnToggleSettings, 36); - FBtnSettings.TextSettings.Font.Size := 12; + OnToggleSettings, 40); 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. 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.Parent := FLayUnlock; FStatus.Align := TAlignLayout.Top; - FStatus.Margins.Rect := RectF(8, 16, 8, 0); - FStatus.Height := 24; - FStatus.StyledSettings := FStatus.StyledSettings - [TStyledSetting.Size]; - FStatus.TextSettings.Font.Size := 15; + FStatus.Margins.Rect := RectF(16, 24, 16, 4); + FStatus.Height := 26; + Tint(FStatus, 15, True); end; procedure TForm8.BuildList; var LBar, LTop: TLayout; - LBtnLock: TButton; + LBtnLock: TRectangle; begin FLayList := TLayout.Create(Self); FLayList.Parent := Self; @@ -358,28 +361,30 @@ begin LBar.Align := TAlignLayout.Bottom; LBar.Height := 52; - LBtnLock := TButton.Create(Self); - LBtnLock.Parent := LBar; + LBtnLock := FlatButton(LBar, 'Verrouiller', OnBackTap); LBtnLock.Align := TAlignLayout.Left; - LBtnLock.Margins.Rect := RectF(8, 4, 0, 8); - LBtnLock.Width := 130; - LBtnLock.Text := 'Verrouiller'; - LBtnLock.OnClick := OnBackTap; + LBtnLock.Margins.Rect := RectF(16, 4, 0, 8); + LBtnLock.Width := 140; LBtnLock.Tag := 1; // 1 = verrouiller, 0 = simple retour (voir OnBackTap) FCount := TLabel.Create(Self); FCount.Parent := LBar; 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.VertAlign := TTextAlign.Center; + Tint(FCount, 13, True); FList := TListBox.Create(Self); FList.Parent := FLayList; FList.Align := TAlignLayout.Client; - FList.Margins.Rect := RectF(4, 0, 4, 0); - FList.ItemHeight := 56; + FList.Margins.Rect := RectF(8, 0, 8, 0); + FList.ItemHeight := 62; 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.Parent := FLayList; @@ -452,35 +457,29 @@ begin end; function AddRowButton(ARow: TLayout; const AText: string; ATag: Integer; - AOnClick: TNotifyEvent): TButton; + AOnClick: TNotifyEvent): TRectangle; begin - Result := TButton.Create(ARow); - Result.Parent := ARow; + Result := FlatButton(ARow, AText, AOnClick); Result.Align := TAlignLayout.Right; - Result.Margins.Left := 6; - Result.Width := 90; - Result.Text := AText; + Result.Margins.Rect := RectF(8, 6, 0, 6); + Result.Width := 96; Result.Tag := ATag; - Result.OnClick := AOnClick; end; procedure TForm8.BuildDetail; var - LBtnBack: TButton; + LBtnBack: TRectangle; begin FLayDetail := TLayout.Create(Self); FLayDetail.Parent := Self; FLayDetail.Align := TAlignLayout.Client; FLayDetail.Visible := False; - LBtnBack := TButton.Create(Self); - LBtnBack.Parent := FLayDetail; + LBtnBack := FlatButton(FLayDetail, 'Retour', OnBackTap); LBtnBack.Align := TAlignLayout.Bottom; - LBtnBack.Height := 48; - LBtnBack.Margins.Rect := RectF(8, 8, 8, 8); - LBtnBack.Text := 'Retour'; + LBtnBack.Height := 52; + LBtnBack.Margins.Rect := RectF(16, 8, 16, 8); LBtnBack.Tag := 0; - LBtnBack.OnClick := OnBackTap; FDetToast := TLabel.Create(Self); FDetToast.Parent := FLayDetail; @@ -522,12 +521,12 @@ begin Status('Coffre present sur cet appareil - protege') else Status('Coffre present sur cet appareil'); - FBtnSync.Text := 'Synchroniser'; + SetButtonText(FBtnSync, 'Synchroniser'); end else begin Status('Aucun coffre local - premier telechargement'); - FBtnSync.Text := 'Telecharger le coffre'; + SetButtonText(FBtnSync, 'Telecharger le coffre'); end; end; @@ -714,7 +713,7 @@ end; procedure TForm8.OnBackTap(Sender: TObject); begin // 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 else ShowList; @@ -894,7 +893,7 @@ begin end; 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 // 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 @@ -1258,20 +1257,20 @@ var I: Integer; begin Touch; - if not (Sender is TButton) then Exit; - I := TButton(Sender).Tag; + if not (Sender is TRectangle) then Exit; + I := TRectangle(Sender).Tag; if (I < 0) or (I > High(FRows)) then Exit; FRowShown[I] := not FRowShown[I]; if FRowShown[I] then begin FRowValues[I].Text := FRows[I].Value; - TButton(Sender).Text := 'Masquer'; + SetButtonText(TRectangle(Sender), 'Masquer'); end else begin FRowValues[I].Text := MASK; - TButton(Sender).Text := 'Afficher'; + SetButtonText(TRectangle(Sender), 'Afficher'); end; end; @@ -1280,8 +1279,8 @@ var I: Integer; begin Touch; - if not (Sender is TButton) then Exit; - I := TButton(Sender).Tag; + if not (Sender is TRectangle) then Exit; + I := TRectangle(Sender).Tag; // -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. if I = -1 then @@ -1387,8 +1386,8 @@ end; procedure TForm8.SetBusy(ABusy: Boolean); begin FBusy := ABusy; - FBtnSync.Enabled := not ABusy; - FBtnOpen.Enabled := not ABusy; + SetButtonEnabled(FBtnSync, not ABusy); + SetButtonEnabled(FBtnOpen, not ABusy); end; end.