feat(apk): edition de l'entree entiere en un seul enregistrement, et icone choisie dans la galerie

Un crayon ouvre un formulaire pre-rempli : tous les champs modifiables a la
fois, un seul Save, donc UN commit au lieu d'un par champ ('setfields',
plusieurs PatchEntryField dans le meme CommitChange).

L'icone quitte le menu de l'entree pour ce formulaire : From site (recherche),
Image... (galerie, reduite a 128 px, provenance custom) et Remove.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
r-zakarya
2026-09-25 14:57:58 +01:00
parent 5f1a98df7d
commit 0c12997ad4
3 changed files with 250 additions and 3 deletions
+166 -1
View File
@@ -48,6 +48,7 @@ uses
FMX.Controls.Presentation, FMX.StdCtrls, FMX.Memo, FMX.Memo.Types,
FMX.ScrollBox, FMX.Layouts, FMX.Edit, FMX.ListBox, FMX.Objects,
FMX.WebBrowser, System.Messaging, FMX.Media,
FMX.MediaLibrary, FMX.MediaLibrary.Actions,
PMA.Vault;
const
@@ -340,6 +341,9 @@ type
/// Change UN champ de l'entree ouverte. Le nom du champ vient de la page,
/// et n'est donc pas cru sur parole.
procedure SaveEntryField(const AField, ANewValue: string);
/// Plusieurs champs d'un coup, en UN SEUL enregistrement - donc un seul
/// commit dans le depot. Les deux tableaux vont par paires.
procedure SaveEntryFields(const AFields, AValues: TArray<string>);
/// Ajoute une entree au coffre. Le mot de passe voyage par le pont,
/// comme 'setfield' - meme regle, meme journalisation muette.
procedure CreateEntry(const ATitle, ASite, AUser, APwd, AKind,
@@ -382,6 +386,9 @@ type
// Scanner du QR affiche par le poste (ZXing.Delphi, Apache 2.0).
var
FScanning, FScanBusy: Boolean;
/// L'action de la galerie survit a l'appel : le selecteur d'Android rend
/// la main tout de suite et rappelle plus tard.
FPickIcon: TTakePhotoFromLibraryAction;
FScanFrame: Integer;
FScanLay: TLayout;
FScanImg: TImage;
@@ -401,6 +408,12 @@ type
function PwdName: string;
/// Va chercher l'icone du site de l'entree ouverte, ou l'efface.
procedure SetEntryIcon(AFetch: Boolean);
/// CHOISIR UNE IMAGE DE LA GALERIE comme icone. Elle est reduite avant
/// d'entrer dans le coffre - une photo de telephone pese quelques Mo, et
/// une icone se regarde a 32 px dans une liste.
procedure PickEntryIcon;
procedure BeginPickIcon;
procedure IconPicked(AImage: TBitmap);
/// Le depot a bouge, ou ne l'a plus : LE DRAPEAU ET SON TEMOIN ENSEMBLE.
///
/// Ils ne l'etaient pas. FRemoteAhead etait remis a faux a trois endroits -
@@ -1254,6 +1267,46 @@ begin
end);
end;
/// L'EDITION DE L'ENTREE ENTIERE. Un champ a la fois, c'etait un commit par
/// champ : corriger un nom et son adresse laissait deux instantanes dans le
/// depot. Ici les corrections s'appliquent l'une apres l'autre au meme clair,
/// et c'est le resultat qui part.
///
/// Le filtre des noms est celui de SaveEntryField, et pour la meme raison : ce
/// qui traverse le pont se traite comme une entree exterieure.
procedure TForm8.SaveEntryFields(const AFields, AValues: TArray<string>);
var
LUuid, LTitle: string;
I: Integer;
begin
if Length(AFields) = 0 then Exit;
if FCurrent.Uuid = '' then
begin
RefuseChange('This entry has no uuid - cannot be updated');
Exit;
end;
for I := 0 to High(AFields) do
if (AFields[I] <> 'title') and (AFields[I] <> 'site')
and (AFields[I] <> 'username') and (AFields[I] <> 'password')
and (AFields[I] <> 'folder') and (AFields[I] <> 'totp_secret') then
begin
RefuseChange('That field cannot be changed from here');
Exit;
end;
LUuid := FCurrent.Uuid;
LTitle := FCurrent.Display;
CommitChange('Saved: ' + LTitle,
Format('%d field(s) changed from phone', [Length(AFields)]), LUuid,
function (APlain: string): string
var
J: Integer;
begin
Result := APlain;
for J := 0 to High(AFields) do
Result := PatchEntryField(Result, LUuid, AFields[J], AValues[J]);
end);
end;
/// SUPPRIMER - la seule action sans retour depuis le telephone.
///
/// Elle ne met pas a la corbeille : celle du poste ne voyage pas dans la
@@ -1950,7 +2003,10 @@ begin
end
else if LAction = 'icon' then
SetEntryIcon(Param('a') = 'fetch')
begin
if Param('a') = 'pick' then PickEntryIcon
else SetEntryIcon(Param('a') = 'fetch');
end
{$IFDEF DEBUG}
// JETER LE COFFRE LOCAL - debogage seulement, et absent a la compilation
@@ -2002,6 +2058,21 @@ begin
SaveEntryField(TNetEncoding.URL.Decode(Param('f')),
TNetEncoding.URL.Decode(Param('v')))
// f0=&v0=&f1=&v1=... : autant de paires que de champs modifies.
else if LAction = 'setfields' then
begin
var LF: TArray<string> := [];
var LV: TArray<string> := [];
var LN := 0;
while Param('f' + IntToStr(LN)) <> '' do
begin
LF := LF + [TNetEncoding.URL.Decode(Param('f' + IntToStr(LN)))];
LV := LV + [TNetEncoding.URL.Decode(Param('v' + IntToStr(LN)))];
Inc(LN);
end;
SaveEntryFields(LF, LV);
end
// La page vient de poser le focus sur la recherche : on deplie le clavier.
else if LAction = 'kbd' then
ShowSoftKeyboard
@@ -3392,6 +3463,100 @@ begin
end).Start;
end;
/// L'ICONE VENUE DE LA GALERIE. Provenance a VRAI, comme un televersement
/// depuis le poste : une icone choisie ne doit jamais etre remplacee par une
/// recherche automatique, et ce drapeau est ce qui le dit au poste.
const
ICON_MAX_PX = 128;
procedure TForm8.IconPicked(AImage: TBitmap);
var
LSmall: TBitmap;
LStream: TMemoryStream;
LB64: TBase64Encoding;
LUri, LTitle, LUuid: string;
LScale: Single;
begin
if (AImage = nil) or (AImage.Width = 0) or (AImage.Height = 0) then Exit;
if FCurrent.Uuid = '' then Exit;
LUuid := FCurrent.Uuid;
LTitle := FCurrent.Display;
if AImage.Width > AImage.Height then
LScale := ICON_MAX_PX / AImage.Width
else
LScale := ICON_MAX_PX / AImage.Height;
if LScale > 1 then LScale := 1;
LSmall := TBitmap.Create(Round(AImage.Width * LScale),
Round(AImage.Height * LScale));
try
LSmall.Canvas.BeginScene;
try
LSmall.Canvas.DrawBitmap(AImage, RectF(0, 0, AImage.Width, AImage.Height),
RectF(0, 0, LSmall.Width, LSmall.Height), 1, True);
finally
LSmall.Canvas.EndScene;
end;
LStream := TMemoryStream.Create;
try
LSmall.SaveToStream(LStream); // PNG
// Sans coupure de ligne : une URI data: coupee ne s'affiche pas.
LB64 := TBase64Encoding.Create(0);
try
LUri := 'data:image/png;base64,'
+ LB64.EncodeBytesToString(LStream.Memory, LStream.Size);
finally
LB64.Free;
end;
finally
LStream.Free;
end;
finally
LSmall.Free;
end;
Log(Format('icon: picked image, %d chars', [Length(LUri)]));
CommitChange('Icon set: ' + LTitle, 'icon picked on phone', LUuid,
function (APlain: string): string
begin
Result := PatchEntryIcon(APlain, LUuid, LUri, True);
end);
end;
procedure TForm8.BeginPickIcon;
begin
if FPickIcon = nil then
begin
FPickIcon := TTakePhotoFromLibraryAction.Create(Self);
FPickIcon.OnDidFinishTaking := IconPicked;
end;
FPickIcon.Execute;
end;
procedure TForm8.PickEntryIcon;
begin
if FBusy then Exit;
if FCurrent.Uuid = '' then
begin
RefuseChange('This entry has no uuid');
Exit;
end;
{$IFDEF ANDROID}
// Les deux noms : le premier est celui d'Android 13 et plus, le second celui
// d'avant. Un nom inconnu du systeme est simplement refuse, et le selecteur
// recent n'exige de toute facon rien - on ouvre donc dans tous les cas, et
// c'est Android qui refuse s'il doit refuser.
PermissionsService.RequestPermissions(
['android.permission.READ_MEDIA_IMAGES',
'android.permission.READ_EXTERNAL_STORAGE'],
procedure(const APermissions: TClassicStringDynArray;
const AGrantResults: TClassicPermissionStatusDynArray)
begin
BeginPickIcon;
end);
{$ELSE}
BeginPickIcon;
{$ENDIF}
end;
/// POSER OU CHANGER LE CODE, IMMEDIATEMENT ET SUR DEMANDE.
///
/// Le coffre doit etre ouvert : c'est la seule preuve que le code courant est