Discussion :

[franckcl]

bonjour,

J'ai recherché un peu partout sans succès.
J'aimerai simplement donner une couleur de fond à une cellule en particulier.

Comment parvenir à cela ?
Avec la VCL j'écrivais du code sur l'évènement OnDrawCell mais avec la FMX comment fait-t-on ?

merci
Franck

[franckcl]

J'ai finalement trouvé une solution.
Il s'agit de rajouter un rectangle dans le style de la cellule et de rendre ce rectangle partiellement transparent.
Ce n'est pas parfait car le texte reste en dessous mais pour le moment ça règle mon problème.

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
 
//------------------------------------------------------------------------------------------------------------------------------
Procedure TInspectorForm.ChangeCellDesign(Acol,Aline:integer;SG:TStringGrid);
var
  CellCtrl: TStyledControl;
  Rectangle:TRectangle;
Begin
  CellCtrl := TColumnAccess(SG.Columns[Acol]).CellControlByRow(Aline);
 
  if (CellCtrl<>nil) and (CellCtrl is TTextCell) then
  with TTextCell(CellCtrl) do
  begin
    StyledSettings := []; // [ssFamily,ssSize,ssStyle,ssFontColor]
    FontColor   := claBlack;
    Font.Family := 'Segoe UI'; // 'Arial'; // par défaut: 'Segoe UI'
    Font.Style  := []; //Font.Style - [ TFontStyle.fsBold ];
    Font.Size   := 10;
    VertTextAlign:= TTextAlign.taTrailing;
 
    Rectangle := TRectangle.Create(CellCtrl);
    Rectangle.Parent:=CellCtrl;
    Rectangle.HitTest:=false;
    Rectangle.Align:=talignLayout.alClient;
    Rectangle.Fill.Color:=claSilver;
    Rectangle.Opacity:=0.3;
  end;
End;

[ShaiLeTroll]

Je ne connais pas FMX mais le TTextCell a un Canvas et une propriété BoundsRect,
tu pourrais tenter un FillText qui fourni les mêmes options TFillTextFlags et TTextAlign !

[SergioMaster]

Bonjour,

je sais que cela ne répond pas à la question , mais le fait qu'il manque un onDrawCell a la TStringGrid m'a fait acheter la FMXGrid de TMS nettement plus 'conviviale' .

En lisant ton post , je me suis re penché sur mes différents essais m'avais amené au même code que toi

[ShaiLeTroll]

mais le fait qu'il manque un onDrawCell a la TStringGrid m'a fait acheter la FMXGrid de TMS nettement plus 'conviviale' ....

Je crois justement que ce n'est pas la philosophie de FMX où il faut passer par des style
Dans la documentation on trouve la même bidouille à base de TRectangle mais en amont lors de Conception de composants FireMonkey

TMS fourni des classes plus 'conviviales' parce qu'il nous manque les bons exemples,
Embarcadero a fourni des démos mais pas les plus utiles !
J'ai pas mal utilisé TMS, certains compo comme les Combo était bien pratique,
certes peu un lourd mais pas trop destabilisant contrairement à l'infame DevExpress qui ne respectent aucune convention et habitude Delphi

On utilise des trucs mais au final on ne maitrise plus du tout le Framework natif de Delphi que ce soit VCL ou FMX !
Je maintiens des applications où sur une même Form, tu peux avoir une grille TcxGrid (DevExpress), une TtsGrid(ObjectSight TopGrid) et un TRxDrawGrid (RX Lib)
Trois lib de grille sur une même TForm, certe chaque à un affichage bien précis et un comportement métier bien précis mais c'est dingue d'en arriver là !
Pour le moment, toutes les nouvelles applications que j'ai fait ne contiennent QUE du standard VCL (avec du code de customisation réutilisable, oui finalement, j'ai fait une SLT Lib mais toujours 100%RTL\VCL de base )
Si j'ai un jour l'occasion de faire du FMX, j'essayerais de comprendre ces styles et comment les personnaliser ponctuellement

Le OnDrawCell n'existe pas dans la TStringGrid mais un fou peu tenter de gérer directement dans le TStringGrid.OnPaint ou TTextCell.OnPaint

[SergioMaster]

Je crois justement que ce n'est pas la philosophie de FMX où il faut passer par des style

mais TMSFMXGrid passe justement aussi par les styles en nous mâchant simplement le travail j'avais mis un post a ce sujet (flemme de retrouver )

en reprenant mes tests j'avais essayé :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
procedure TForm19.StringGrid1ApplyStyleLookup(Sender: TObject);
var
  Couleur: TBrushObject;
  I: Integer;
begin
  Couleur := TBrushObject((Sender as TStringGrid).FindStyleResource('linefill',true));
  if Couleur<>Nil then
  begin
    Couleur.Brush.Color:=clared;
  end;
end;

sans résultat , mais peut être n'etait-ce pas le bon objet ?

[ShaiLeTroll]

'LineFill' c'est pour ShowVertLines et ShowHorzLine

Comme cela m'intéressait pas mal, je découvre totalement FMX !

J'ai fait cette petite classe TStringGridSLTXAssistant pour juste changer la couleur de fond !

je pense qu'en étudiant le code lié à AlternatingRowBackground, on doit pouvoir obtenir la cellule en cours de sélection et donc la dessin différemment !

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
 
{ TStringGridSLTXAssistant }
 
//------------------------------------------------------------------------------
constructor TStringGridSLTXAssistant.Create(AStringGrid: TStringGrid);
var
  fsr: TFmxObject;
begin
  inherited Create();
 
  FStringGrid := AStringGrid;
 
  fsr := FStringGrid.FindStyleResource('content');
  if fsr is TControl then
  begin
    FOriginalPainting := TControl(fsr).OnPainting;
    TControl(fsr).OnPainting := DoContentPaint;
  end;
end;
 
//------------------------------------------------------------------------------
constructor TStringGridSLTXAssistant.Create(Sender: TObject);
begin
  inherited Create();
 
  if Assigned(Sender) then
  begin
    if Sender is TStringGrid then
      Create(TStringGrid(Sender))
    else
      raise EStringGridSLTXAssistantError.CreateFmt(ERR_UNASSISTED_CLASS, [ClassName(), Sender.ClassName(), TStringGrid.ClassName()]);
  end
  else
    raise EStringGridSLTXAssistantError.CreateFmt(ERR_UNASSISTED_CLASS, [ClassName(), '[nil]', TStringGrid.ClassName()])
end;
 
//------------------------------------------------------------------------------
destructor TStringGridSLTXAssistant.Destroy();
begin
  FreeAndNil(FFullFill);
 
  inherited Destroy();
end;
 
 
//------------------------------------------------------------------------------
procedure TStringGridSLTXAssistant.DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
begin
  if Assigned(FFullFill) and (FBackgroundColor <> claNull) and not FStringGrid.AlternatingRowBackground then
    FullPainting(Canvas, ARect, FBackgroundColor)
  else
    FOriginalPainting(Sender, Canvas, ARect);
end;
 
//------------------------------------------------------------------------------
procedure TStringGridSLTXAssistant.FullPainting(Canvas: TCanvas; const ARect: TRectF; AColor: TColor);
begin
  Canvas.Fill.Assign(FFullFill);
  Canvas.FillRect(RectF(0, FStringGrid.TopRow * FStringGrid.RowHeight, FStringGrid.Width, FStringGrid.Height), 0, 0, [], FStringGrid.AbsoluteOpacity);
end;
 
//------------------------------------------------------------------------------
procedure TStringGridSLTXAssistant.SetBackgroundColor(const Value: TColor);
begin
  FBackgroundColor := Value;
  if not Assigned(FFullFill) then
    FFullFill := TBrush.Create(TBrushKind.bkSolid, Value);
  FStringGrid.InvalidateRect(FStringGrid.BoundsRect);
end;

un TForm qui montre comment l'utiliser

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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
 
unit ZooFMX_MainForm;
 
interface
 
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Grid, FMX.Layouts;
 
type
  TStringGridSLTXAssistant = class;
 
  TZooFMXMainForm = class(TForm)
    StringGrid1: TStringGrid;
    StringColumn1: TStringColumn;
    StringColumn2: TStringColumn;
    StringColumn3: TStringColumn;
    btnSetFullColor: TButton;
    procedure StringGrid1ApplyStyleLookup(Sender: TObject);
    procedure btnSetFullColorClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Déclarations privées }
    FStringGridAssistant: TStringGridSLTXAssistant;
  public
    { Déclarations publiques }
 
  end;
 
  /// <summary>Erreur liée à l'assistant TStringGridSLTXAssistant de la classe FMX TStringGrid</summary>
  EStringGridSLTXAssistantError = class(Exception);
 
  /// <summary>Assistance de la classe TStringGrid</summary>
  TStringGridSLTXAssistant = class(TObject)
  private
    FStringGrid: TStringGrid;
    FOriginalPainting: TOnPaintEvent;
    FBackgroundColor: TColor;
    FFullFill: TBrush;
 
    procedure SetBackgroundColor(const Value: TColor);
    procedure DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
    procedure FullPainting(Canvas: TCanvas; const ARect: TRectF; AColor: TColor);
 
  public
    constructor Create(AStringGrid: TStringGrid); overload;
    constructor Create(Sender: TObject); overload;
    destructor Destroy(); override;
 
    property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
  end;
 
 
var
  ZooFMXMainForm: TZooFMXMainForm;
 
implementation
 
uses
  System.Math;
 
const
  ERR_UNASSISTED_CLASS = 'La Classe d''Assistance %s ne prend pas en charge la classe %s mais la classe %s';
 
{$R *.fmx}
 
//------------------------------------------------------------------------------
procedure TZooFMXMainForm.StringGrid1ApplyStyleLookup(Sender: TObject);
begin
  FStringGridAssistant := TStringGridSLTXAssistant.Create(Sender);
end;
 
//------------------------------------------------------------------------------
procedure TZooFMXMainForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FStringGridAssistant);
end;
 
//------------------------------------------------------------------------------
procedure TZooFMXMainForm.btnSetFullColorClick(Sender: TObject);
begin
  FStringGridAssistant.BackgroundColor := claRed;
end;
 
{ TStringGridSLTXAssistant }
 
//------------------------------------------------------------------------------
constructor TStringGridSLTXAssistant.Create(AStringGrid: TStringGrid);
var
  fsr: TFmxObject;
begin
  inherited Create();
 
  FStringGrid := AStringGrid;
 
  fsr := FStringGrid.FindStyleResource('content');
  if fsr is TControl then
  begin
    FOriginalPainting := TControl(fsr).OnPainting;
    TControl(fsr).OnPainting := DoContentPaint;
  end;
end;
 
//------------------------------------------------------------------------------
constructor TStringGridSLTXAssistant.Create(Sender: TObject);
begin
  inherited Create();
 
  if Assigned(Sender) then
  begin
    if Sender is TStringGrid then
      Create(TStringGrid(Sender))
    else
      raise EStringGridSLTXAssistantError.CreateFmt(ERR_UNASSISTED_CLASS, [ClassName(), Sender.ClassName(), TStringGrid.ClassName()]);
  end
  else
    raise EStringGridSLTXAssistantError.CreateFmt(ERR_UNASSISTED_CLASS, [ClassName(), '[nil]', TStringGrid.ClassName()])
end;
 
//------------------------------------------------------------------------------
destructor TStringGridSLTXAssistant.Destroy();
begin
  FreeAndNil(FFullFill);
 
  inherited Destroy();
end;
 
 
//------------------------------------------------------------------------------
procedure TStringGridSLTXAssistant.DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
begin
  if Assigned(FFullFill) and (FBackgroundColor <> claNull) and not FStringGrid.AlternatingRowBackground then
    FullPainting(Canvas, ARect, FBackgroundColor)
  else
    FOriginalPainting(Sender, Canvas, ARect);
end;
 
//------------------------------------------------------------------------------
procedure TStringGridSLTXAssistant.FullPainting(Canvas: TCanvas; const ARect: TRectF; AColor: TColor);
begin
  Canvas.Fill.Assign(FFullFill);
  Canvas.FillRect(RectF(0, FStringGrid.TopRow * FStringGrid.RowHeight, FStringGrid.Width, FStringGrid.Height), 0, 0, [], FStringGrid.AbsoluteOpacity);
end;
 
//------------------------------------------------------------------------------
procedure TStringGridSLTXAssistant.SetBackgroundColor(const Value: TColor);
begin
  FBackgroundColor := Value;
  if not Assigned(FFullFill) then
    FFullFill := TBrush.Create(TBrushKind.bkSolid, Value);
  FStringGrid.InvalidateRect(FStringGrid.BoundsRect);
end;
 
end.

Voici la version VCL dont je me suis inspiré, je lui ajoute quand il faut de vieux code moche que je réécrit pour que cela soit réutilisable !
La TstringGrid ne l'utilise pas souvent, mon unité TDBGridSLTAssistant pour TDBGRid est bien plus complète

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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
 
//------------------------------------------------------------------------------
(*                SoLuTions is an Versatile Library for Delphi                 -
 *                                                                             -
 *  Copyright ou © ou Copr. "SLT Solutions", (2006)                            -
 *  contributeur : ShaiLeTroll (2012) - Gestion des Styles sous C++BuilderXE2  -
 *  contributeur : ShaiLeTroll (2012) - Documentation Insight                  -
 *  contributeur : ShaiLeTroll (2014) - Traduction du code C++Builder vers DelphiXE2
 *                                                                             -
 * ShaiLeTroll@gmail.com                                                       -
 *                                                                             -
 * Ce logiciel est un programme informatique servant à aider les développeurs  -
 * Delphi avec une bibliothèque polyvalente, adaptable et fragmentable.        -
 *                                                                             -
 * Ce logiciel est régi par la licence CeCILL-C soumise au droit français et   -
 * respectant les principes de diffusion des logiciels libres. Vous pouvez     -
 * utiliser, modifier et/ou redistribuer ce programme sous les conditions      -
 * de la licence CeCILL-C telle que diffusée par le CEA, le CNRS et l'INRIA    -
 * sur le site "http://www.cecill.info".                                       -
 *                                                                             -
 * En contrepartie de l'accessibilité au code source et des droits de copie,   -
 * de modification et de redistribution accordés par cette licence, il n'est   -
 * offert aux utilisateurs qu'une garantie limitée.  Pour les mêmes raisons,   -
 * seule une responsabilité restreinte pèse sur l'auteur du programme,  le     -
 * titulaire des droits patrimoniaux et les concédants successifs.             -
 *                                                                             -
 * A cet égard  l'attention de l'utilisateur est attirée sur les risques       -
 * associés au chargement,  à l'utilisation,  à la modification et/ou au       -
 * développement et à la reproduction du logiciel par l'utilisateur étant      -
 * donné sa spécificité de logiciel libre, qui peut le rendre complexe à       -
 * manipuler et qui le réserve donc à des développeurs et des professionnels   -
 * avertis possédant  des  connaissances  informatiques approfondies.  Les     -
 * utilisateurs sont donc invités à charger  et  tester  l'adéquation  du      -
 * logiciel à leurs besoins dans des conditions permettant d'assurer la        -
 * sécurité de leurs systèmes et ou de leurs données et, plus généralement,    -
 * à l'utiliser et l'exploiter dans les mêmes conditions de sécurité.          -
 *                                                                             -
 * Le fait que vous puissiez accéder à cet en-tête signifie que vous avez      -
 * pris connaissance de la licence CeCILL-C, et que vous en avez accepté les   -
 * termes.                                                                     -
 *                                                                             -
 *----------------------------------------------------------------------------*)
unit SLT.Controls.VCL.GridsEx;
 
interface
 
uses System.SysUtils, System.Types,
  Vcl.Grids, Vcl.Graphics, Vcl.Themes;
 
type
  /// <summary>Erreur liée à l'assistant TStringGridSLTAssistant de la classe TStringGrid</summary>
  EStringGridSLTAssistantError = class(Exception);
 
  /// <summary>Assistance de la classe TStringGrid</summary>
  /// <remarks>Le TStringGridSLTAssistant n'est pas un class helper car lors de sa création la version utilisée était C++Builder XE2,
  /// Traduction C++Builder vers Delphi en concervant ce concept des Assistances de classes (Class Helper) du Delphi.NET</remarks>
  TStringGridSLTAssistant = class(TObject)
  private
    // Membres privés
    FStringGrid: TStringGrid;
  public
    // Constructeurs
    constructor Create(AStringGrid: TStringGrid); overload;
    constructor Create(Sender: TObject); overload;
 
    /// <summary>DrawCellOfEmptyGrid Fournit une assistance au TStringGrid.OnDrawCell pour fournir le rendu d'une cellule vide</summary>
    /// <param name="ACol">indique l'indice de colonne de la cellule à redessiner</param>
    /// <param name="ARow">indique l'indice de ligne de la cellule à redessiner</param>
    /// <param name="Rect">indique la zone à redessiner</param>
    /// <param name="State">Le paramètre State indique si la cellule détient la focalisation, si elle est sélectionnée ou si la cellule est une cellule fixe (qui ne défile pas).</param>
    procedure DrawCellEmpty(ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
 
    /// <summary>DrawCellTitleCenter Fournit une assistance au TStringGrid.OnDrawCell pour fournir le rendu d'une cellule de titre avec son texte centré horizontalement et verticalement</summary>
    /// <param name="AText">indique le texte de cellule à redessiner</param>
    /// <param name="Rect">indique la zone à redessiner</param>
    /// <param name="State">Le paramètre State indique si la cellule détient la focalisation, si elle est sélectionnée ou si la cellule est une cellule fixe (qui ne défile pas).</param>
    procedure DrawCellTitleCenter(const AText: string; Rect: TRect; State: TGridDrawState);
 
    // Méthodes d'ergonomie
    procedure ZoomColumnWidth(AZoomPourcent: Integer);
 
    // Propriétés
    property StringGrid: TStringGrid read FStringGrid;
  end;
 
implementation
 
const
  ERR_UNASSISTED_CLASS = 'La Classe d''Assistance %s ne prend pas en charge la classe %s mais la classe %s';
 
{ TStringGridSLTAssistant }
 
//------------------------------------------------------------------------------
constructor TStringGridSLTAssistant.Create(AStringGrid: TStringGrid);
begin
  inherited Create();
 
  FStringGrid := AStringGrid;
end;
 
//------------------------------------------------------------------------------
constructor TStringGridSLTAssistant.Create(Sender: TObject);
begin
  inherited Create();
 
  if Assigned(Sender) then
  begin
    if Sender is TStringGrid then
      FStringGrid := TStringGrid(Sender)
    else
      raise EStringGridSLTAssistantError.CreateFmt(ERR_UNASSISTED_CLASS, [ClassName(), Sender.ClassName(), TStringGrid.ClassName()]);
  end
  else
    raise EStringGridSLTAssistantError.CreateFmt(ERR_UNASSISTED_CLASS, [ClassName(), '[nil]', TStringGrid.ClassName()])
end;
 
//------------------------------------------------------------------------------
procedure TStringGridSLTAssistant.DrawCellEmpty(ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  Details: TThemedElementDetails;
  DetailColor: TColor;
begin
  with StringGrid.Canvas do
  begin
    if StyleServices.Enabled then
    begin
      Details := StyleServices.GetElementDetails(tgCellNormal);
      StyleServices.GetElementColor(Details, ecFillColor, DetailColor);
      Pen.Color := DetailColor;
      Brush.Color := DetailColor;
    end
    else
    begin
      Pen.Color := StringGrid.Color;
      Brush.Color := StringGrid.Color;
    end;
    Rectangle(Rect);
  end;
end;
 
//------------------------------------------------------------------------------
procedure TStringGridSLTAssistant.DrawCellTitleCenter(const AText: string; Rect: TRect; State: TGridDrawState);
var
  vText: string;
  vRect: TRect;
begin
  // TextRect encapsule DraxTextEx et est aussi pénible avec ses paramètres in-out !
  vText := AText;
  vRect := Rect;
  // DT_CENTER Centers text horizontally in the rectangle.
  // DT_VCENTER Centers text vertically. This value is used only with the DT_SINGLELINE value.
  StringGrid.Canvas.TextRect(vRect, vText, [tfCenter, tfSingleLine, tfVerticalCenter]);
end;
 
//------------------------------------------------------------------------------
procedure TStringGridSLTAssistant.ZoomColumnWidth(AZoomPourcent: Integer);
var
  I: Integer;
begin
  for I := 0 to StringGrid.ColCount - 1 do
    StringGrid.ColWidths[I] := Round(StringGrid.ColWidths[I] * AZoomPourcent / 100);
end;
 
end.

[ShaiLeTroll]

Pour colorer Juste une ligne, suffit de changer le code ainsi (SANS PROTECTION)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
//------------------------------------------------------------------------------
procedure TStringGridSLTXAssistant.FullPainting(Sender: TObject; Canvas: TCanvas; const ARect: TRectF; AColor: TColor);
begin
  FOriginalPainting(Sender, Canvas, ARect);
 
  Canvas.Fill.Assign(FFullFill);
//  Canvas.FillRect(RectF(0, FStringGrid.TopRow * FStringGrid.RowHeight, FStringGrid.Width, FStringGrid.Height), 0, 0, [], FStringGrid.AbsoluteOpacity);
 
 
  Canvas.FillRect(RectF(0, FStringGrid.Selected * FStringGrid.RowHeight, FStringGrid.Width, (FStringGrid.Selected + 1) * FStringGrid.RowHeight), 0, 0, [], FStringGrid.AbsoluteOpacity);
end;

Pour colorer la cellule sélectionné (il faut mettre ReadOnly à True et ShowSelectedCell à False sinon ça affiche l'inplaceeditor) !

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
//------------------------------------------------------------------------------
procedure TStringGridSLTXAssistant.FullPainting(Sender: TObject; Canvas: TCanvas; const ARect: TRectF; AColor: TColor);
begin
  FOriginalPainting(Sender, Canvas, ARect);
 
  Canvas.Fill.Assign(FFullFill);
//  Canvas.FillRect(RectF(0, FStringGrid.TopRow * FStringGrid.RowHeight, FStringGrid.Width, FStringGrid.Height), 0, 0, [], FStringGrid.AbsoluteOpacity);
// Canvas.FillRect(RectF(0, FStringGrid.Selected * FStringGrid.RowHeight, FStringGrid.Width, (FStringGrid.Selected + 1) * FStringGrid.RowHeight), 0, 0, [], FStringGrid.AbsoluteOpacity);
  Canvas.FillRect(RectF(FStringGrid.Columns[FStringGrid.ColumnIndex].ParentedRect.Left , FStringGrid.Selected * FStringGrid.RowHeight,FStringGrid.Columns[FStringGrid.ColumnIndex].ParentedRect.Right, (FStringGrid.Selected + 1) * FStringGrid.RowHeight), 0, 0, [], FStringGrid.AbsoluteOpacity);
 
 
end;

[franckcl]

Merci pour ces infos.
Pour le moment j'en suis resté avec mon Trectangle qui suffit amplement.
Je découvre petit à petit le FMX et je découvre aussi toute la puissance de ce framework mais ce n'est pas simple lorsqu'on a l'habitude de la VCL.
Cela donne un look particulière pro et moderne aux applications et je pense que c'est un gain de temps lorsqu'on maitrise la bête.
Le problème est qu'il n'est pas facile de trouver des réponses à nos questions car je pense que 90% des utilisateurs de Delphi sont encore restés avec la VCL.

[ShaiLeTroll]

Cela donne un look particulière pro et moderne aux applications et je pense que c'est un gain de temps lorsqu'on maitrise la bête.
Le problème est qu'il n'est pas facile de trouver des réponses à nos questions car je pense que 90% des utilisateurs de Delphi sont encore restés avec la VCL.

Je n'ai pas encore fait de FMX, et à chaque fois que je m'y suis intéressé c'est pour aider un membre du forum par pur curiosité,
c'est en lisant le code et très peu la documentation que j'ai trouvé la réponse !
C'est vrai que c'est dommage que la doc se limite à "Embarcadero n'a pas de détail sur cette technologie"

Sinon en VCL, avec les Styles VCL tu peux faire une application au look "moderne" sans utiliser FMX
Personnellement, mes release sont en Amethyst Kamri et mes debug en Smokey Kamri

Dans mon ancienne boite, pour le lecteur vidéo, j'étais en Carbon

[polo69]

J'ai développer un programme de résolution de SUDOKU avec la vcl StringGrid Delphi 5
J'ai téléchargé Delphi RX Delph1 10.1 Berlin
J'ai voulu passer mon prog en version multi pour l'installer sur Mac
Sous FMX ,Je n'ai plus l'évenement OndrawCelll et surtout la fonction TextOut() pour mettre une cellule avec un fond coloré
Les solutions proposées ci- dessus ne marchent pas ?
Je cherche une solution avec cette version de Delphi

[franckcl]

bonjour,

Lorsque j'avais créé ce post il y a deux ans, c'était vraiment compliqué de dessiner les cellules soit même.
Avec Berlin 10.1, à priori c'est beaucoup plus simple, va voir l'évènement OnDrawColumnCell dans le composant TStringGrid, ça devrait répondre à ta question.
Je crois qu'il faut aussi possitionner DefaultDrawing = false

Tiens nous au courant et si tu peux donner un exemple, ça servira à d'autres.

Merci
Franck

[polo69]

bonjour,

Lorsque j'avais créé ce post il y a deux ans, c'était vraiment compliqué de dessiner les cellules soit même.
Avec Berlin 10.1, à priori c'est beaucoup plus simple, va voir l'évènement OnDrawColumnCell dans le composant TStringGrid, ça devrait répondre à ta question.
Je crois qu'il faut aussi possitionner DefaultDrawing = false

Tiens nous au courant et si tu peux donner un exemple, ça servira à d'autres.

Merci
Franck

Je donne mon code qui ne marche pas
si je mets DefaultDrawing = false plus rien ne s'affiche dans la cellule sauf si je clique dessus
l'explication de la procedure StringGridDrawColumnCell() dit que la cellule doit s'afficher avec la couleur de la police pour les caractères et
le fond avec la couleur du pinceau ???
Je voudrais que la couleur de fond change: plus de un caractère avec une couleur et un caractère avec une autre couleur
j'ai tout essayé ça ne marche pas, pas moyen d'avoir un fond coloré tranparent comme avec TextOut() des ancienne version de DElphi

Si j'utilise la procedure FillRect(Bounds,0,0,[],1,RowColor); au lieu de FillText la cellule prend la couleur et cache les caractères

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
procedure TForm1.StringGrid1DrawColumnCell(Sender: TObject;
  const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF;
  const Row: Integer; const Value: TValue; const State: TGridDrawStates);
 
var
  RowColor : TBrush;
   isSelected : boolean;
  FontColor : Integer;
  S :String;
  long: byte;
  SelectedRow :Integer;
 
begin
 
   RowColor := Tbrush.Create(TBrushKind.Solid,TAlphaColors.Null);
   isSelected := ((Sender as TStringGrid).Selected = Row) and
    ((Sender as TStringGrid).ColumnIndex = Column.Index);
 //  SelectedRow := (Sender as TStringGrid).Selected;
 
 
   s:=stringGrid1.Cells[Column.Index,Row];
   FontColor :=TAlphaColorRec.Black;
   stringGrid1.TextSettings.FontColor:= TAlphaColors.Blue ;
   Long:= length(S);
 
   if not (isSelected) then
  begin
 
     Case long of
      1:
      begin
        FontColor := TAlphaColors.Aqua;
        RowColor.Color := TAlphaColors.blue;
      end;
      else
      begin
        FontColor := TAlphaColors.White;
      end;
    end;
  end
  else
  begin
      Case long of
      1:
      begin
          FontColor :=TAlphaColors.Cyan;
          RowColor.Color :=TAlphaColors.Aquamarine;
       end;
      else
      begin
        FontColor := TAlphaColorRec.White;
        end;
    end;
  end;
     Canvas.FillText(Bounds,S,false,0,[TFillTextFlag.RightToLeft],TTextAlign.center ,TTextAlign.center);
  end;
end.

[franckcl]

Bonjour,

Je n'ai pas regardé dans le détail ton code, mais pour te donner un exemple qui fonctionne mais qui ne répond peut être pas à ce que tu cherches mais en l'adaptant un peu, tu devrais y arriver:

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
 
procedure TForm1.StringGrid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF;
  const Row: Integer; const Value: TValue; const State: TGridDrawStates);
begin
  with Canvas do
  Begin
    // Pour remplir d'une couleur données
    Fill.Color := TAlphaColors.Yellow;
    FillRect(Bounds,0,0,AllCorners,1);
 
    // Pour ecrire du texte d'une couleur donnée
    Fill.Color := TAlphaColors.Black;
    FillText(Bounds,IntToStr(Row)+','+IntToStr(Column.Index),true,1,[TFillTextFlag.RightToLeft],TTextAlign.Leading);
 
    // Pour afficher une ligne diagonale d'une certaine couleur
    Stroke.Color:=TAlphaColors.Blue;
    DrawLine(PointF(Bounds.left,Bounds.top), PointF(Bounds.right,Bounds.Bottom), $FF);
  End;
end;

voilà le résultat:

[polo69]

[QUOTE=franckcl;8735510]Bonjour,

Je n'ai pas regardé dans le détail ton code, mais pour te donner un exemple qui fonctionne mais qui ne répond peut être pas à ce que tu cherches mais en l'adaptant un peu, tu devrais y arriver:

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
 
procedure TForm1.StringGrid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF;
  const Row: Integer; const Value: TValue; const State: TGridDrawStates);
begin
  with Canvas do
  Begin
    // Pour remplir d'une couleur données
    Fill.Color := TAlphaColors.Yellow;
    FillRect(Bounds,0,0,AllCorners,1);
 
    // Pour ecrire du texte d'une couleur donnée
    Fill.Color := TAlphaColors.Black;
    FillText(Bounds,IntToStr(Row)+','+IntToStr(Column.Index),true,1,[TFillTextFlag.RightToLeft],TTextAlign.Leading);
 
    // Pour afficher une ligne diagonale d'une certaine couleur
    Stroke.Color:=TAlphaColors.Blue;
    DrawLine(PointF(Bounds.left,Bounds.top), PointF(Bounds.right,Bounds.Bottom), $FF);
  End;
end;

Un grand merci à Frankcl
ça marche je cherchais des trucs compliqués alors que la solution était simple, il suffisait de faire les appels de procédure ( fillrect et filltext
Chaque fois que l'on change fill.color et font.size. Maintenant il me reste à mettre les lignes de séparation des carrés comme une grille de SUDOKU
Je vais m'y atteler,mais si tu as une piste je suis preneur

[Thierry Laborde]

Bonjour,

Juste pour ajouter une info.
En fait si jamais vous avez déjà rempli le contenu des cellules avec le texte ailleurs dans votre application vous n’êtes pas obligé de faire un filltext, il suffit juste de penser à appeler le DefaultDrawCell :

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
procedure TForm1.StringGrid1DrawColumnCell(Sender: TObject;
  const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF;
  const Row: Integer; const Value: TValue; const State: TGridDrawStates);
const
  HorzTextMargin = 5;
  VertTextMargin = 5;
var
  RowColor : TBrush;
  Rect     : TRectF;
begin
  Rect := Bounds;
  Rect.Inflate(HorzTextMargin, VertTextMargin);
  RowColor := Tbrush.Create(TBrushKind.Solid,TAlphaColors.Red);
  Canvas.FillRect(Rect, 0, 0, [], 1, RowColor);
  Column.DefaultDrawCell(Canvas,Bounds,Row,Value,State);
end;

[polo69]

Bonjour,

Juste pour ajouter une info.
En fait si jamais vous avez déjà rempli le contenu des cellules avec le texte ailleurs dans votre application vous n’êtes pas obligé de faire un filltext, il suffit juste de penser à appeler le DefaultDrawCell :

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
procedure TForm1.StringGrid1DrawColumnCell(Sender: TObject;
  const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF;
  const Row: Integer; const Value: TValue; const State: TGridDrawStates);
const
  HorzTextMargin = 5;
  VertTextMargin = 5;
var
  RowColor : TBrush;
  Rect     : TRectF;
begin
  Rect := Bounds;
  Rect.Inflate(HorzTextMargin, VertTextMargin);
  RowColor := Tbrush.Create(TBrushKind.Solid,TAlphaColors.Red);
  Canvas.FillRect(Rect, 0, 0, [], 1, RowColor);
  Column.DefaultDrawCell(Canvas,Bounds,Row,Value,State);
end;

Merci pour l'info
Je ne connaissait pas la fonction Inflate() ni DefaultDrawCell()
ça marche aussi avec ta procèdure , mais dans mon programme je fais varier la couleur du fond et la taille des caractères
en fonction de la valeur du contenu, donc je suis bien obligé de faire appel à la fonction FillText() à chaque modification du contenu, qu'en penses tu

[Thierry Laborde]

mais dans mon programme je fais varier la couleur du fond et la taille des caractères
en fonction de la valeur du contenu, donc je suis bien obligé de faire appel à la fonction FillText() à chaque modification du contenu, qu'en penses tu

Oui dans ce cas là il faudra appeler Filltext

[krzysiu]

bonjour à tous,

j'ai testé les exemples et ça marche, mais j'ai un souci, lorsque je change la couleur du texte, c'est tous les textes de toutes les cellules que changent, or j'aimerais ne changer la couleur du texte que d'une seule cellule.

Merci pour votre aide, je continue à chercher

Krzysiu

[franckcl]

Pour personnaliser la couleur d'une cellule il te suffit dans ce cas de faire un choix en fonction de la colonne et du numéro de ligne.

Par exemple pour écrire un texte de couleur rouge uniquement dans la cellule de 3ème ligne et 1ère colonne:

Code :

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

1
2
3
    if (Column=StringColumn1) and (Row=2)
      then Fill.Color := TAlphaColors.Red
      else Fill.Color := TAlphaColors.Black;

Pour reprendre mon exemple cela devient:

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
 
procedure TForm2.StringGrid1DrawColumnCell(Sender: TObject; const Canvas: TCanvas; const Column: TColumn; const Bounds: TRectF;
  const Row: Integer; const Value: TValue; const State: TGridDrawStates);
begin
  with Canvas do
  Begin
    // Pour remplir d'une couleur données
    Fill.Color := TAlphaColors.Yellow;
    FillRect(Bounds,0,0,AllCorners,1);
 
    // Pour ecrire du texte d'une couleur donnée
    if (Column=StringColumn1) and (Row=2)
      then Fill.Color := TAlphaColors.Red
      else Fill.Color := TAlphaColors.Black;
    FillText(Bounds,IntToStr(Row)+','+IntToStr(Column.Index),true,1,[TFillTextFlag.RightToLeft],TTextAlign.Leading);
 
    // Pour afficher une ligne diagonale d'une certaine couleur
    Stroke.Color:=TAlphaColors.Blue;
    DrawLine(PointF(Bounds.left,Bounds.top), PointF(Bounds.right,Bounds.Bottom), $FF);
  End;
end;

voici le résultat