Commentaires

Mon nouvel Helper

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
unit ColoredBindNavigator;

interface

 uses System.Classes, System.UIConsts,System.UITypes,System.Types,System.SysUtils,
      FMX.Bind.Navigator, FMX.Graphics, FMX.Forms, FMX.Types,
      Data.Bind.Controls;

/// range TNavigateButton in three groups
const   NavigatorScrollings = [nbFirst, nbPrior, nbNext, nbLast,nbRefresh];
        NavigatorValidations = [nbInsert, nbDelete, nbEdit, nbPost, nbCancel,
                                nbApplyUpdates];
        NavigatorCancelations = [nbDelete,nbCancel,nbCancelUpdates];

type

  TNavigatorColors = record
    scroll : TAlphacolor;
    update : TAlphacolor;
    cancel : TAlphacolor;
    class operator initialize (out Dest: TNavigatorColors);
    class operator finalize (var Dest: TNavigatorColors);
  end;

  TColorNavButton = class helper for TBindNavButton
    /// set the color of the Tpath.fill.color property
    procedure setcolor(c : TAlphaColor);
    /// apply the custom colors corresponding to the TNavigateButton type
    /// Three groups NavigatorScrollings,NavigatorValidations,NavigatorCancelations
    /// see const part
    procedure ApplyColorStyle(customcolors : TNavigatorColors);
  end;

  TColorBindNavigator = class helper for TCustomBindNavigator
    /// initialize and apply custom colors
    function customcolors(scrollcolor, Updatecolor, cancelcolor : TAlphaColor) : TNavigatorColors; overload;
    function customcolors(colors : TNavigatorColors) : TNavigatorColors; overload;
  end;

implementation


{ TColorNavButton }
procedure TColorNavButton.ApplyColorStyle(customcolors : TNavigatorColors);
var defaultstylecolor : TAlphaColor;
begin
inherited;
with Self do
  DefaultStylecolor:=FPath.Fill.Color;
if (TNavigateButton(Self.index) in NavigatorScrollings)
    AND (customcolors.scroll<>TAlphacolors.Alpha)
//    AND (customcolors.scroll<>DefaultStyleColor)   // todo test
 then Setcolor(customcolors.scroll);
if (TNavigateButton(Self.index) in NavigatorValidations)
    AND (customcolors.update<>TAlphacolors.Alpha)
 then Setcolor(customcolors.update);
if (TNavigateButton(Self.index) in NavigatorCancelations)
    AND (customcolors.cancel<>TAlphacolors.Alpha)
 then Setcolor(customcolors.cancel);
end;

procedure TColorNavButton.setcolor(c: TAlphaColor);
begin
with Self do
   FPath.Fill.Color:=c;
end;

{ TNavigatorColors }
class operator TNavigatorColors.finalize(var Dest: TNavigatorColors);
begin
// nothing to do
end;

class operator TNavigatorColors.initialize(out Dest: TNavigatorColors);
begin
Dest.scroll:=TAlphaColors.Alpha;
Dest.update:=TAlphaColors.Alpha;
Dest.cancel:=TAlphaColors.Alpha;
end;


{ TColorBindNavigator }
function TColorBindNavigator.customcolors(scrollcolor, Updatecolor,
  cancelcolor: TAlphaColor) : TNavigatorColors;
var colors : TNavigatorColors;
begin
Colors.scroll:=scrollcolor;
Colors.update:=updatecolor;
Colors.cancel:=cancelcolor;
customcolors(Colors);
Result:=Colors;
end;

function TColorBindNavigator.customcolors(
  colors: TNavigatorColors): TNavigatorColors;
begin
for var i := 0 to  self.ControlsCount-1 do
      TBindNavButton(Self.Controls[i]).ApplyColorStyle(colors);
end;

end.

Le changement dans la fonction TColorBindNavigator.customcolors(scrollcolor, Updatecolor, cancelcolor: TAlphaColor)à savoir l'utilisation d'une variable colors : TNavigatorColors plutôt que d'utiliser result à fait la différence.

Un seul reproche désormais , à mon avis, plutôt que d'utiliser un helper, appliquer cette recherche au sein d'un dérivé du TCustomGrid pour avoir un composant wyseewyg

Absolument pas, label1 ne contient toujours qu'une seule et unique valeur. TcontrolList est un composant VCL avec d'étranges affinités FMX mais bien que l'ont ai l'impression que le label appartienne au composant ce n'est pas vraiment le cas

La propriété Label1 doit me sembe-t-il être préfixée par la TList.

Merci Sergio pour ta réponse.
Cela me fait bizzare, le premier language que j'ai appris est le Pascal au lycée et à l'époque Delphi me faisait réver parce qu'il était possible de faire des applis avec des interfaces graphiques. Je suis surpris qu'ils soient toujours d'actualité. Tant mieux.

J'ai parcouru la page wikipédia de Delphi et en effet on apprends que embarcadero a repris le flanbeau.
Je trouve que c'est une chouette idée ce grade MVP permettant de réunir la crème de la crème.

Un grand bravo à toi.

Pour répondre à weed, ce club n'a de renommée que dans le monde des utilisateurs de Delphi ou de C++. https://www.embarcadero.com/fr/embarcadero-mvp-program
Ce statut s'obtient par cooptation de membre via parrainage, et se mérite lorsque l'on commence à être "visible" en écrivant des articles, faisant des vdéos et commençant à être connu sur les forums spécifiques. Avantage, avoir des informations de première main et des aides de membres très influents de cette communauté très restreinte.

Merci à DVP qui m'a permis de l'être puisque hébergeant mes articles, mon blog et qui m'a permis durant toutes ces années de devenir connu comme le loup blanc.
En juste retour des choses, DVP est enfin visible sur les pages d'Embarcadero https://blogs.embarcadero.com/fr/communaute/ avant ma nomination, il n'y avait rien concernant les forums francophones

Cela étant, pour l'instant, je savoure mon tout nouveau statut de néo-retraité avant de me remettre dans le bain et écrire les articles (la liste est longue) que la vie pro m'avait fait procrastiner.

Et quel est ce club renommé ?

Quelques petites coquilles s'étaient glissées dans mes explications sur la syntaxe.
Merci à navyg de me les avoir signalées.
Elles sont désormais corrigées, mais, nul n'étant parfait, signalez-moi les restantes par MP

Salut SergioMaster,
Félicitations

Félicitations

Mis à jour ce matin

Bonjour Sergio,

Merci beaucoup pour ces astuces très pratiques !! Toujours des articles TOP!

Très intéressant. En fait les styles sont de très puissants outils car ils permettent de vraiment faire des belles choses. Mais ça demande de l'investissement et du travail mais ça vaut vraiment le coup. Depuis que j'ai découvert ça je ne peux plus m'en passer.

Il semblerait que le zip contenant la démo soit corrompu, en attendant que je le corrige je vous fournis une version qui gère plus ou moins bien la couleur de texte en fonction de la couleur de fond.

Parfait. Merci Serge!

Merci pour ton partage! Je trouve cela très intéressant!

Bonjour,
Merci Serge pour ce partage. C'est toujours instructif pour tout le monde.

Chapeau l'artiste !



ça va m'être très utile dès que mon pc sera réparé.

Bonjour,

effectivement Soundex peut être inclus diectement dans SQLite mais pas sans avoir à le recompiler, c'est là que le bât blesse.
Alors que, avec Firedac, il serait facile de déclarer une fonction qui utiliserait la fonction soundex de Delphi au débotté :

Code Pascal :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
procedure TForm1.SQLSoundEx(AFunc: TSQLiteFunctionInstance;
  AInputs: TSQLiteInputs; AOutput: TSQLiteOutput; var AUserData: TObject);
begin
Aoutput.asBoolean:= SoundExSimilar(Ainputs[0].AsWideString,Ainputs[1].asWideString,MinIntValue([Length(Ainputs[0].AsWideString),Length(Ainputs[1].AsWideString)]);
end;

Tiens, j'aurais peut-être du autiliser cet exemple pour un fonction à 2 paramètres que de me lancer dans ces tableaux de replacements

Bonjour Serge,
Firedac semble en effet simplifier considérablement l'accès aux fonctions externes par rapport à l'API SQLite.
Quant à SoundEx, il peut être implémenté comme fonction de base selon le build de la bibliothèque :

soundex(X)

The soundex(X) function returns a string that is the soundex encoding of the string X. The string "?000" is returned if the argument is NULL or contains no ASCII alphabetic characters. This function is omitted from SQLite by default. It is only available if the SQLITE_SOUNDEX compile-time option is used when SQLite is built.

Après avoir testé sous Ubuntu (cela fonctionne ) mais j'ai procédé à quelques changements au niveau du traitement de l'image, mise en ressource cela m'évite de déployer le fichier fleche.png ainsi que les problèmes de chemin de chargement c'est donc tout bénéfice.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
procedure TBonus.ListViewMenuUpdateObjects(const Sender: TObject;
  const AItem: TListViewItem);
//  NOTE
// il serait mieux de ne charger qu'une seule fois la ressource dans un Stream
// de même s'il s'agit d'un fichier
// d'où "l'avantage" de la liste d'image quoique, si l'on utilise un MultiResBitmap on se retrouvera dans le même cas
var aStream: TResourceStream;
begin
// Chargement d'une ressource
if AItem.Purpose=TListItemPurpose.Header then
  begin
     aStream := TResourceStream.Create(HInstance,'fleche',RT_RCDATA);
      try
        AItem.Objects.ImageObject.Bitmap.LoadFromStream(aStream);
     finally
       aStream.Free;
    end;
// Chargement fichier "externe"
//    AItem.Objects.ImageObject.Bitmap.LoadFromFile('..\..\fleche.png');
// Utilisation TImageList
//    AItem.Objects.ImageObject.Bitmap:=ImageList1.Bitmap(TSizeF.Create(32,32),0);
  end;
end;

Ces changements ont été répercutés dans le zip.