Discussion :

[Zatoobux]

@CapJAck : chez moi la proposition de remplacer le test

Code :

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

if ((ACol=aCol2) and (ARow=aRow2)) then

par

Code :

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

if ((ACol>=ACol1) and (ACol<=ACol2) and (ARow>=ARow1) and (ARow<=ARow2)) then

ne corrige pas le probleme, mais je ne comprends pas ce que tu veux dire par

Évidemment ! Il faut modifier aussi le premier test !

STP peux tu poster le code complet pour eviter les ambiguités.

Merci,

a+

[CapJack]

Il y a deux tests :

Code :

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

if ((ACol=aCol2) and (ARow=aRow2)) then

Il faut les remplacer tous les deux par :

Code :

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

if ((ACol>=ACol1) and (ACol<=ACol2) and (ARow>=ARow1) and (ARow<=ARow2)) then

[CapJack]

Code complet :

Edit : dans les options, goFixedVertLine et goFixedHorzLine doivent être à false.

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
function MergedCells(ASG:TStringGrid; ACol,ARow,ACol1,ARow1,ACol2,ARow2:Integer; ACurrentState: TGridDrawState):Boolean;
var
  x1,y1,x2,y2:Integer;
  Rect:TRect;
begin
 with ASG, Canvas do
  begin
   //Initialisations diverses
   Rect := Bounds(0,0,0,0);
   x1 := ACol1;
   y1 := ARow1;
   x2 := ACol2;
   y2 := ARow2;
   result := false;
 
   //On vérifie que la zone fusionnée est valide
   if x1 < 0 then x1 := 0;
   if x2 > ColCount-1 then x2 := ColCount-1;
   if y1 < 0 then y1 := 0;
   if y2 > RowCount-1 then y2 := RowCount-1;
 
   if (x1 > x2) or (y1 > y2) then
    begin
      result := false;
      exit;
    end;
 
   if ((ACol>=ACol1) and (ACol<=ACol2) and (ARow>=ARow1) and (ARow<=ARow2)) then
    begin
     Rect.Left := CellRect(ACol1,ARow1).Left;
     Rect.Top := CellRect(ACol1,ARow1).Top;
     Rect.Right := CellRect(ACol2,ARow2).Right;
     Rect.Bottom := CellRect(ACol2,ARow2).Bottom;
//     if Rect.Right > ASG.Width then Rect.Right := ASG.Width;
     FillRect(Rect);
     // Le bloc qui suit pour imiter le "look" par défaut
     if GridLineWidth = 1 then
      begin
       Pen.Color := clBlack;Pen.Width := 1;
       Canvas.Rectangle(Rect.Left-1,Rect.Top-1,Rect.Right+1,Rect.Bottom+1);
      end;
     //
     Frame3D(ASG.Canvas, Rect, clBtnHighlight, clBtnShadow, BevelWidth);
     InflateRect(Rect,-2,-2);
     DrawText(ASG.Canvas.Handle, PChar(Cells[ACol1,ARow1]), -1, Rect ,DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE );
    end;
 
   //Si la cellule courante est dans la zone de fusion, on dit qu'on la dessiné (même si ce n'est pas vrai :) )
   if ((ACol>=ACol1) and (ARow>=ARow1) and (ACol<=ACol2) and (ARow<=ARow2)) then
    result := True;
 
  end;
end;
 
// Évènement OnDrawCell
 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
 with Sender as TStringGrid do
 if gdFixed in State then // Si cellule fixe :
 if not MergedCells(SG_Resultats,ACol,ARow,2,0,3,0,State)
    and not MergedCells(SG_Resultats,ACol,ARow,4,0,5,0,State)
    then begin // Si cellule fixe pas fusionnée :
          FillRect(Canvas.Handle,Rect,Canvas.Brush.Handle);
          // Le bloc qui suit pour imiter le "look" par défaut
          if GridLineWidth = 1 then
           begin
            Canvas.Pen.Color := clBlack;Canvas.Pen.Width := 1;
            Canvas.Rectangle(Rect.Left-1,Rect.Top-1,Rect.Right+1,Rect.Bottom+1);
           end;
          //
          Frame3D(Canvas, Rect, clBtnHighlight, clBtnShadow, BevelWidth);
          InflateRect(Rect,-2,-2);
          DrawText(Canvas.Handle, PChar(Cells[ACol,ARow]), -1, Rect ,DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE );
         end;
end;

[User]

Salut CapJack,

Et merci pour le mal que tu t'es donné

J'ai copié ton code,

modifier les paramètres Col1,Row1,Col2,Row2 en fonction de mes cellules à fusionner dans mon grid

et pas moyen d'avoir le résultat esconté,

les cellules sont bien fusionné mais le texte à l'intérieur n'est pas fuionné (il se répète et quand tu scroll le texte se mélange)

A mon avis c'est très compliqué comme problème,

le problème c'est que je n'arrive pas à installer le composant EGrid pour Delphi 5 (je suis sous Delphi 7)


Voila désolé et encore merci à toi !

User

[CapJack]

OnDrawCell de la TStringGrid doit être bien associé à l'évènement de la deuxième partie de mon code. Dans la propriété Options, goFixedVertLine et goFixedHorzLine doivent être à false. Ça marche parfaitement avec Delphi 2005. Après, le TStringGrid de Delphi 7 a peut-être un comportement différent ?

[User]

Désolé pour le retard;

Oui CapJack,

goFixedVertLine et goFixedHorzLine à false

et OnDrawCell aussi relié à l'évènement de la deuxième partie de code

J'ignore si tu as raison pour Delphi 7 en tous pas moyen d'installer le EGrid de Delphi 5...

J'ai envoyé 1 message à waskol, il selmble pas mal occupé en ce moment, il essayera de se joindre à nous d'ici 1 ou 2 jours...

Tu as de la chance que ca marche chez toi !

@+

[CapJack]

Je viens de tester avec mon vieux Delphi 3; moyennant quelques ajustements ça marche... C'est un grrrros mystère.

[Zatoobux]

CapJack, merci pour le code complet. Comme pour User ce code ne corrige pas le probleme du scroll et du redimensionnement de grid chez moi (Delphi 5).

La solution que j'ai proposé en utilisant les propriétés FixedCols et VisibleColCount me semble une bonne piste àprès quelques amélioration.

Comme je le disais je n'ai pas bcp de temps pour ce probleme precis...

a+

[LadyWasky]

Bon, je reviens vers ce truc à la demande générale

Je viens de corriger un bug qui trainait (on travaille toujours avec les cellules normales, les cellules fixes restent encore à voir mais ça ne devrait pas poser trop de problèmes.

Il s'agit de la procédure CalcRectOffset, j'ai commenté la ligne bugguée :

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
function CalcRectOffset(ASG:TStringGrid):TPoint;
var i,j:integer;
    x,y:Integer;
begin
  with ASG do
  begin
    x:=0;
    y:=0;
 
    if LeftCol>FixedCols then
    for i:=FixedCols to LeftCol-1 do inc(x,ColWidths[i]+GridLineWidth);
 
    if TopRow>FixedRows then
//    for j:=FixedRows to TopRow-1 do inc(y,Top+RowHeights[j]+GridLineWidth);
    for j:=FixedRows to TopRow-1 do inc(y,RowHeights[j]+GridLineWidth);
  end;
  Result:=Point(-x,-y);
end;

ce qui nous donne l'unité suivante comme point de départ :

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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
unit UnitFusionStringGrid;
 
interface
uses Windows, Classes, Graphics, StdCtrls,SysUtils,Grids;
type
  TAlignementVertical=(alVTop,alVCenter,alVBottom);
  TAlignementHorizontal=(alHLeft,alHCenter,alHRight);
  TJustification=(JustLeft,JustCenter,JustRight);
 
  TZoneFusionnee=record
    ColLeft,RowTop,ColRight,RowBottom:Integer;
    AlignementHorizontal:TAlignementHorizontal;
    AlignementVertical:TAlignementVertical;
    TextJustification:TJustification;
    State:TGridDrawState;
    ZoneValide:Boolean;
  end;
 
  TParametresOnDrawCell=record
     LeStringGrid:TStringGrid;
     ACol,ARow:Integer;
     Rect:TRect;
     State:TGridDrawState;
  end;
 
//utilitaire pour la visibilité du code
function SetZoneFusionnee(AStringGrid:TStringGrid;ZoneText:string;
                       ColLeft,RowTop,ColRight,RowBottom:Integer;
                       AlignementHorizontal:TAlignementHorizontal;
                       AlignementVertical:TAlignementVertical;
                       TextJustification:TJustification):TZoneFusionnee;
//Pour dessiner une cellule simple (utilisée par MergedCells une zone)
procedure DessineCellule(ParametresOnDrawCell:TParametresOnDrawCell;
                       AlignementHorizontal:TAlignementHorizontal;
                       AlignementVertical:TAlignementVertical;
                       TextJustification:TJustification);
 
//Pour dessiner une fusion de cellules
function DessineZone(ParametresOnDrawCell:TParametresOnDrawCell;var ZoneFusionnee:TZoneFusionnee):Boolean;
 
//pour vérifier si une cellule se trouve dans la zone fusionnee spécifiee;
function CelluleEstDansZone(ACol,Arow:Integer;ZoneFusionnee:TZoneFusionnee):Boolean;
 
implementation
 
uses Types;
 
function CelluleEstDansZone(ACol,Arow:Integer;ZoneFusionnee:TZoneFusionnee):Boolean;
begin
  with ZoneFusionnee do
    result:=((ACol>=ColLeft) and (ARow>=RowTop) and (ACol<=ColRight) and (ARow<=RowBottom));
end;
 
function CelluleCouranteEstDansZone(ParametresOnDrawCell:TParametresOnDrawCell;ZoneFusionnee:TZoneFusionnee):Boolean;
begin
  with ParametresOnDrawCell do
  result:=CelluleEstDansZone(ACol,ARow,ZoneFusionnee);
end;
 
function ZoneEstValide(AStringGrid:TStringGrid;var AZone:TZoneFusionnee):Boolean;
begin
  with AZone do
  begin
    //on modifie la zone pour qu'elle rentre dans le stringgrid
    if ColLeft<0 then ColLeft:=0;
    if ColRight>AStringGrid.ColCount-1 then ColRight:=AStringGrid.ColCount-1;
    if RowTop<0 then RowTop:=0;
    if RowBottom>AStringGrid.RowCount-1 then RowBottom:=AStringGrid.RowCount-1;
 
    //On vérifie aue la zone fusionnée est valide
    ZoneValide:=(ColLeft<=ColRight) and (RowTop<=RowBottom);
  end;
 
  Result:=AZone.ZoneValide;
end;
 
function SetZoneFusionnee(AStringGrid:TStringGrid;ZoneText:string;
                       ColLeft,RowTop,ColRight,RowBottom:Integer;
                       AlignementHorizontal:TAlignementHorizontal;
                       AlignementVertical:TAlignementVertical;
                       TextJustification:TJustification):TZoneFusionnee;
var AZone:TZoneFusionnee;
begin
  AZone.ColLeft:=ColLeft;
  AZone.RowTop:=RowTop;
  AZone.ColRight:=ColRight;
  AZone.RowBottom:=RowBottom;
  AZone.AlignementHorizontal:=AlignementHorizontal;
  AZone.AlignementVertical:=AlignementVertical;
  AZone.TextJustification:=TextJustification;
 
  if ZoneEstValide(AStringGrid,AZone) then AStringGrid.Cells[ColLeft,RowTop]:=ZoneText;
 
  result:=AZone;
end;
 
//Voir FAQ Delphi de www.developpez.com pour cette fonction :
//URL : http://delphi.developpez.com/faq/?page=typechaine#dimensionstexte
Function TextSize(Phrase : string; Police : TFont = nil) : TPoint;
var
  DC: HDC;
  X: Integer;
  Rect: TRect;
  C : TBitmap;
begin
  C := TBitmap.create;
  if police <> nil then  C.canvas.Font := police;
 
    Rect.Left := 0;
    Rect.Top:=0;
    Rect.Right:=0;
    Rect.Bottom:=0;
    DC := GetDC(0);
    C.Canvas.Handle := DC;
    DrawText(C.Canvas.Handle, PChar(Phrase), -1, Rect, (DT_EXPANDTABS or DT_CALCRECT));
    C.Canvas.Handle := 0;
    ReleaseDC(0, DC);
    result.X:=Rect.Right-Rect.Left;
    result.Y:=Rect.Bottom-Rect.Top;
    C.Free;
end;
 
procedure DessineTexteMultiligne(AString: string;ACanvas:TCanvas;ARect: TRect;
                       AlignementHorizontal:TAlignementHorizontal;
                       AlignementVertical:TAlignementVertical;
                       TextJustification:TJustification);
var
  AHeight,AWidth:integer;
  Rect,oldClipRect:TRect;
  ATop,ALeft,H,W:Integer;
  AText:string;
  JustificationDuTexte:Integer;
  MyRgn:HRGN;
begin
  with ACanvas do
  begin
    Lock;
    AHeight:=ARect.Bottom-ARect.Top;
    AWidth:=ARect.Right-ARect.Left;
    //on calcule la taille du rectangle dans lequel va tenir le texte
    W:=TextSize(AString,ACanvas.Font).X;
    H:=TextSize(AString,ACanvas.Font).Y;
 
    //on calcule la position (Haut,Gauche) du rectangle dans lequel va tenir le texte
    //en fonction de l'alignement horizontal et vertical choisis
    ATop:=ARect.Top;
    ALeft:=ARect.Left;
 
 
    case AlignementVertical of
      alVBottom : ATop:=ARect.Bottom-H;
      alVCenter : ATop:=ARect.Top+(AHeight-H) div 2;
      alVTop    : ATop:=ARect.Top;
    end;
 
    case AlignementHorizontal of
      alHLeft  : ALeft:=ARect.Left;
      alHCenter: ALeft:=ARect.Left+(AWidth-W) div 2;
      alHRight : ALeft:=ARect.Right-W;
    end;
 
    //Fin du calcul du rectangle, on met le resultat dans Rect
    Rect:=Bounds(ALeft,ATop,W,H);
 
    //On rempli le rectangle de la zone sinon on voit le texte que delphi à dessiné
    FillRect(ARect);
 
    //On détermine les paramètres de justification à passer à Windows
    case TextJustification of
      JustLeft  : JustificationDuTexte:=DT_LEFT;
      JustCenter: JustificationDuTexte:=DT_CENTER;
      JustRight : JustificationDuTexte:=DT_RIGHT;
    end;
 
    //Si le texte est plus grand que notre zone, on prend cette précaution (Clipping)
    with ARect do MyRgn :=CreateRectRgn(Left,Top,Right,Bottom);
    SelectClipRgn(Handle,MyRgn);
 
    //On dessine le texte
    DrawText(Handle,PChar(AString),-1,Rect,JustificationDuTexte or DT_NOPREFIX or DT_WORDBREAK );
 
    //On a plus besoin de la zone de clipping
    SelectClipRgn(Handle,0);
    DeleteObject(MyRgn);
    Unlock;
  end;
end;
 
procedure DessineCellule(ParametresOnDrawCell:TParametresOnDrawCell;
                       AlignementHorizontal:TAlignementHorizontal;
                       AlignementVertical:TAlignementVertical;
                       TextJustification:TJustification);
var s:string;
begin
  with ParametresOnDrawCell do
  begin
    s:=LeStringGrid.Cells[ACol,ARow];
    DessineTexteMultiligne(s,LeStringGrid.Canvas,Rect,AlignementHorizontal,AlignementVertical,TextJustification);
  end;
end;
 
//Pour calculer la position de la cellule (LeftCol,TopRow) dans le StringGrid
// --> voir CalcRect ci dessous
function CalcRectOffset(ASG:TStringGrid):TPoint;
var i,j:integer;
    x,y:Integer;
begin
  with ASG do
  begin
    x:=0;
    y:=0;
 
    if LeftCol>FixedCols then
    for i:=FixedCols to LeftCol-1 do inc(x,ColWidths[i]+GridLineWidth);
 
    if TopRow>FixedRows then
//    for j:=FixedRows to TopRow-1 do inc(y,Top+RowHeights[j]+GridLineWidth);
    for j:=FixedRows to TopRow-1 do inc(y,RowHeights[j]+GridLineWidth);
  end;
  Result:=Point(-x,-y);
end;
 
//Pour calculer le rectangle d'une cellule même s'il n'est pas visible (utilise CalcRectOffset)
function CalcRect(ASG:TStringGrid;ACol,ARow:integer):TRect;
var i,j:integer;
    ARect:TRect;
    Offsets:TPoint;
begin
  Offsets:=CalcRectOffset(ASG);
  with ASG do
  begin
    ARect:=Bounds(Offsets.X,Offsets.Y,0,0);
    if ACol>0 then
    for i:=0 to ACol-1 do ARect.Left:=Arect.Left+ColWidths[i]+GridLineWidth;
    //ARect.Left:=ARect.Left+GridLineWidth;
    ARect.Right:=ARect.Left;
    ARect.Right:=ARect.Right+ColWidths[ACol];
 
    if ARow>0 then
    for j:=0 to ARow-1 do ARect.Top:=Arect.Top+RowHeights[j]+GridLineWidth;
    //ARect.Top:=ARect.Top+GridLineWidth;
    ARect.Bottom:=ARect.Top;
    ARect.Bottom:=ARect.Bottom+RowHeights[ARow];
  end;
 
  Result:=ARect;
end;
 
function DessineZone(ParametresOnDrawCell:TParametresOnDrawCell;
                     var ZoneFusionnee:TZoneFusionnee):Boolean;
var i,j:Integer;
    ARect:TRect;
    UneZone:TZoneFusionnee;
    DesParametres:TParametresOnDrawCell;
begin
  //Initialisations diverses
  result:=False;
  ARect:=Bounds(0,0,0,0);
 
  //On vérifie que la zone fusionnée est valide
  if not ZoneEstValide(ParametresOnDrawCell.LeStringGrid,ZoneFusionnee) then Exit;
 
  //parametres d'états
  with ParametresOnDrawCell,ZoneFusionnee do
  if ((ACol=ColLeft) and (ARow=RowTop)) then State:=[];
  ZoneFusionnee.State:=ZoneFusionnee.State+ParametresOnDrawCell.State;
 
  //Si la cellule courante est dans la zone de fusion, on dessine dans la fusion le texte de la cellule en haut à gauche
  if CelluleCouranteEstDansZone(ParametresOnDrawCell,ZoneFusionnee)
  then begin
        //Calcule le rectangle de la zone fusionnée
        with ZoneFusionnee,ParametresOnDrawCell do with LeStringGrid do
        begin
          ARect.TopLeft:=CalcRect(LeStringGrid,ColLeft,RowTop).TopLeft;
          ARect.BottomRight:=CalcRect(LeStringGrid ,ColRight,RowBottom).BottomRight;
        end;
 
        //on va passer les parametres de OnDrawCell avec une zone de dessin un peu élargie;
        DesParametres:=ParametresOnDrawCell;
        DesParametres.Rect:=ARect;
        DesParametres.ACol:=ZoneFusionnee.ColLeft;
        DesParametres.ARow:=ZoneFusionnee.RowTop;
        DesParametres.State:=ZoneFusionnee.State;
        DessineCellule(DesParametres,
                       ZoneFusionnee.AlignementHorizontal,
                       ZoneFusionnee.AlignementVertical,
                       ZoneFusionnee.TextJustification);
        result:=True;
       end;
end;
 
end.

Le plus casse pied à mettre au point ont été les procédures CalcRect et CalcRectOffset qui s'occupent de calculer les coordonnées des cellules "non-fixes" (coordonnées dans la zone cliente du contrôle).

En effet, les cellules "non-fixes" possèdent une position "relative" qui changent avec les scrollbars (quand il y en a...). Cette position est calculée en fonction des lignes fixes et des colonnes fixes déjà présente (dont la position ne varie qu'en fonction d'une seule scrollbar).

Tout le truc va consister à modifier notre CalcRect et notre CalcRectOffset, pour que les valeurs renvoyées soit aussi adaptées au cellules fixes. C'est là où est la clé, pour la cosmétique, on verra ça après, allons y étape par étape

[CapJack]

Bon, je laisse tomber, c'est le genre de malentendu qui a le don de m'énerver, surtout qu'on n'a pas l'impression d'avoir perdu son temps, pas du tout...

Je croyais qu'on parlait de cellules fixes, c'est le titre du fil c'est de ça qu'on parle depuis le début, et c'est évident dans mon code, si on se donne la peine de le lire un peu.

Ensuite il va avoir collision de sources, waskol. Pour les cellules non-fixes je ne m'étais même pas posé la question puisque ce n'était pas le problème.

Enfin, j'espère que le problème sera résolu.

[LadyWasky]

Bonjour,
Le problème provient du fait que mes cellules à fusionner appartiennent à une ligne fixe.

J'ai la vilaine barre de séparation des colonnes qui apparaît par dessus mon chef d'oeuvre de programmation.



Visiblement, elles se dessinent après l'appel à la procédure OnDrawCell.

Exact, Delphi redessine les bordures après le OnDrawCell (celà se passe dans une sous-procédure appelée DrawCells de la méthode TStringGrid.Paint ), mais Delphi ne le fait que si certaines conditions sont réunies :

• si State=gdFixed
• si la propriété CTL3D=true (d'ailleurs, ça me fait penser à qulque chose)
• si DefaultDrawing=true

Donc :
- forcer State=gdFixed (mission impossible ?)
- soit, il faut mettre DefaultDrawing à false et tout redessiner
- soit mettre CTL3D à false, et le résultat n'est pas trop moche
Voir code joint en fichier zip

@CapJack
Oui, tu as raison, on parle bien des cellules fixes, il n'y a aucun malentendu, mais dans mon code d'origine, je ne les avais pas pris en compte au niveau du dessin et il fallait bien repartir de quelque chose de solide.
Et ne t'inquiète pas, je vais essayer ta solution qui me parait assez intéressante.

Donc excuses moi, mais le temps pour moi de me remettre "dans le bain" est nécessaire

[LadyWasky]

Et voici une solution inspirée de CapJack, qui n'a pas ménagé ses efforts.
Bien sur on peut améliorer le rendu, mais voici le principe :

- On met la propriété Ctl3D du StringGrid à true
- dans les options, goFixedVertLine et goFixedHorzLine doivent être à false (CapJack )
- Et on modifie la procédure DessineCellule comme suit (dans l'unité UnitFusionStringGrid) afin de rajouter un cadre 3D autour de la cellule fixe :

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 DessineCellule(ParametresOnDrawCell:TParametresOnDrawCell;
                       AlignementHorizontal:TAlignementHorizontal;
                       AlignementVertical:TAlignementVertical;
                       TextJustification:TJustification);
var s:string;
    ARect:trect;
begin
  with ParametresOnDrawCell do
  begin
    s:=LeStringGrid.Cells[ACol,ARow];
    ARect:=Rect;
 
    //Dessin particulier si on a affaire à une cellule fixe
    if gdFixed in State then
    begin
      //Solution basée sur celle de CapJack
      Frame3D(LeStringGrid.Canvas, ARect, clBtnHighlight, clBtnShadow, 1);
    end;
    DessineTexteMultiligne(s,LeStringGrid.Canvas,ARect,AlignementHorizontal,AlignementVertical,TextJustification);
  end;
end;

ça ne fait pas trop mal aux yeux

Pour tout vous avouer il me reste un chouilla à régler avec l'éventuelle première ligne ou colonne "non-fixe" qui juxtapose la dernière ligne ou colonne "fixe" : Cette colonne ou ligne "non fixe" à tendance à prendre par endroits la couleur des cellules fixes.

[User]

Merci waskol (et aussi CapJack),

pour tout le boulot produit (le chantier devrais-je dire),

J'ai hate de tester ton code, mais pour l'instant il me reste à comprendre comment l'implementer sur OnDrawCell, j'avoue que c'est pas très clair au niveau des paramètres...

En tous cas tu risque de rendre service a pas mal de monde !

Il vaut mieux se baser sur 1 seul code maintenant pour éviter les complications...

Bonne continuation !

[Zatoobux]

salut,

Désollé... mais il y a encore quelque chose qui me chagrine dans la dernière solution proposée par Waskoll :

Si j'ai une colonne fixe, que la somme de la largeur des colonnes est plus grande que la largeur du grid (en gros :le grid n'est pas assez large) si on scroll horizontalement alors la fusion est mal dessinée :


Alors qu'on devrait avoir :


Par contre dans la seconde capture le texte n'est pas dessiné au bonne endroit, il devrait etre tronqué à gauche...

Pour arriver à la deuxieme image j'ai modifié dans le dernier code de Waskol :

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
function ZoneEstValide(AStringGrid:TStringGrid;var AZone:TZoneFusionnee):Boolean;
begin
  with AZone do
  begin
    //on modifie la zone pour qu'elle rentre dans le stringgrid
    if ColLeft<AStringGrid.leftCol then ColLeft:=AStringGrid.leftCol;
    //if ColLeft<0 then ColLeft:=0;
    if ColRight>AStringGrid.ColCount-1 then ColRight:=AStringGrid.ColCount-1;
    if RowTop<0 then RowTop:=0;
    if RowBottom>AStringGrid.RowCount-1 then RowBottom:=AStringGrid.RowCount-1;

    //On vérifie aue la zone fusionnée est valide
    ZoneValide:=(ColLeft<=ColRight) and (RowTop<=RowBottom);
  end;

  Result:=AZone.ZoneValide;
end;

Cette modif corrige horizontalement mais meme modif possible verticalement.
Dans cette correction on ne compare pas à la colonne 0 mais à la colonne non fixe la plus à gauche (TStringGrid.leftCol).

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
function DessineZone(ParametresOnDrawCell:TParametresOnDrawCell;
                     var ZoneFusionnee:TZoneFusionnee):Boolean;
var i,j:Integer;
    ARect:TRect;
   // UneZone:TZoneFusionnee;
    locZone:TZoneFusionnee;
    DesParametres:TParametresOnDrawCell;
begin
  //Initialisations diverses
  locZone := ZoneFusionnee;

  result:=False;
  ARect:=Bounds(0,0,0,0);

  //On vérifie que la zone fusionnée est valide
  if not ZoneEstValide2(ParametresOnDrawCell.LeStringGrid,locZone(*ZoneFusionnee*)) then Exit;

  //parametres d'états
  with ParametresOnDrawCell,locZone(*ZoneFusionnee*) do
  if ((ACol=ColLeft) and (ARow=RowTop)) then State:=[];
  locZone(*ZoneFusionnee*).State:=locZone(*ZoneFusionnee*).State+ParametresOnDrawCell.State;

  //Si la cellule courante est dans la zone de fusion, on dessine dans la fusion le texte de la cellule en haut à gauche
  if CelluleCouranteEstDansZone(ParametresOnDrawCell,locZone(*ZoneFusionnee*))
  then begin
        //Calcule le rectangle de la zone fusionnée
        with locZone(*ZoneFusionnee*),ParametresOnDrawCell do with LeStringGrid do
        begin
          ARect.TopLeft:=CalcRect(LeStringGrid,ColLeft,RowTop).TopLeft;
          ARect.BottomRight:=CalcRect(LeStringGrid ,ColRight,RowBottom).BottomRight;
        end;
 
        //on va passer les parametres de OnDrawCell avec une zone de dessin un peu élargie;
        DesParametres:=ParametresOnDrawCell;
        DesParametres.Rect:=ARect;
      //  DesParametres.ACol:=locZone(*ZoneFusionnee*).ColLeft;
      //  DesParametres.ARow:=locZone(*ZoneFusionnee*).RowTop;
        DesParametres.ACol:=ZoneFusionnee.ColLeft; //- On prend parametre zone original pour le texte
        DesParametres.ARow:=ZoneFusionnee.RowTop;
        DesParametres.State:=locZone(*ZoneFusionnee*).State;
        DessineCellule(DesParametres,
                       locZone(*ZoneFusionnee*).AlignementHorizontal,
                       locZone(*ZoneFusionnee*).AlignementVertical,
                       locZone(*ZoneFusionnee*).TextJustification);

        result:=True;
       end;
end;

Dans dessineZone on définit une zone locale à la fonction. Locale car elle sera eventuellement modifié par ZoneEstValide mais que l'on ne veut pas perdre la definition de la zone au niveau global.
Tout ce qui était fait avec ZoneFusionné est fait avec locZone saufpour determiner le texte à dessiner (DesParametres.ACol:=ZoneFusionnee.ColLeft).

Je sais je suis un peu lourd à vouloir placer mon TStringGrid.LeftCol depuis le debut...

a+

[User]

Bonjour,

Je me permait de remonter ce sujet, car je n'ai toujours pas trouvé une solution définitive malgré le formidable travail de waskol.

Auriez-vous des nouveautés à proposer ou un lien pour réaliser la fusion de cellules fixes sur un TStringGrid comportant des scrolls (cas général)

Merci beaucoup à tous, mais je n'ai malheureusement pas pu non plus installer de composant qui réalise cela, et j'en aurais vraiment besoin...

@+

[CapJack]

Il faut préciser quelle version de Windows et quelle version de Delphi, parce que le code que j'avais posté fonctionne parfaitement sous Windows XP/Delphi 2005.

[User]

Salut CapJack,

Windows XP, Delphi 7

@+

[LadyWasky]

La soluce de CapJack fonctionne très correctement sous XP,Delphi 7)

Là, je ne peux pas trop vous aider, je suis en train de réinstaller tout mon PC, et je n'ai pas encore remis Delphi

[User]

Excusez mon ignorance mais la je n'y arrive vraiment pas:



voici mon code copie de CapJack:

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids,ExtCtrls;
 
type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
function MergedCells(ASG:TStringGrid; ACol,ARow,ACol1,ARow1,ACol2,ARow2:Integer; ACurrentState: TGridDrawState):Boolean;
var
  x1,y1,x2,y2:Integer;
  Rect:TRect;
begin
 with ASG, Canvas do
  begin
   //Initialisations diverses
   Rect := Bounds(0,0,0,0);
   x1 := ACol1;
   y1 := ARow1;
   x2 := ACol2;
   y2 := ARow2;
   result := false;
 
   //On vérifie que la zone fusionnée est valide
   if x1 < 0 then x1 := 0;
   if x2 > ColCount-1 then x2 := ColCount-1;
   if y1 < 0 then y1 := 0;
   if y2 > RowCount-1 then y2 := RowCount-1;
 
   if (x1 > x2) or (y1 > y2) then
    begin
      result := false;
      exit;
    end;
 
   if ((ACol>=ACol1) and (ACol<=ACol2) and (ARow>=ARow1) and (ARow<=ARow2)) then
    begin
     Rect.Left := CellRect(ACol1,ARow1).Left;
     Rect.Top := CellRect(ACol1,ARow1).Top;
     Rect.Right := CellRect(ACol2,ARow2).Right;
     Rect.Bottom := CellRect(ACol2,ARow2).Bottom;
//     if Rect.Right > ASG.Width then Rect.Right := ASG.Width;
     FillRect(Rect);
     // Le bloc qui suit pour imiter le "look" par défaut
     if GridLineWidth = 1 then
      begin
       Pen.Color := clBlack;Pen.Width := 1;
       Canvas.Rectangle(Rect.Left-1,Rect.Top-1,Rect.Right+1,Rect.Bottom+1);
      end;
     //
     Frame3D(ASG.Canvas, Rect, clBtnHighlight, clBtnShadow, 1);
     InflateRect(Rect,-2,-2);
     DrawText(ASG.Canvas.Handle, PChar(Cells[ACol1,ARow1]), -1, Rect ,DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE );
    end;
 
   //Si la cellule courante est dans la zone de fusion, on dit qu'on la dessiné (même si ce n'est pas vrai :) )
   if ((ACol>=ACol1) and (ARow>=ARow1) and (ACol<=ACol2) and (ARow<=ARow2)) then
    result := True;
 
  end;
end;
 
 
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
with Sender as TStringGrid do
 if gdFixed in State then // Si cellule fixe :
 if not MergedCells(StringGrid1,ACol,ARow,1,0,3,0,State)
    and not MergedCells(StringGrid1,ACol,ARow,5,0,7,0,State)
    then begin // Si cellule fixe pas fusionnée :
          FillRect(Canvas.Handle,Rect,Canvas.Brush.Handle);
          // Le bloc qui suit pour imiter le "look" par défaut
          if GridLineWidth = 1 then
           begin
            Canvas.Pen.Color := clBlack;Canvas.Pen.Width := 1;
            Canvas.Rectangle(Rect.Left-1,Rect.Top-1,Rect.Right+1,Rect.Bottom+1);
           end;
          //
          Frame3D(Canvas, Rect, clBtnHighlight, clBtnShadow, BevelWidth);
          InflateRect(Rect,-2,-2);
          DrawText(Canvas.Handle, PChar(Cells[ACol,ARow]), -1, Rect ,DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE );
         end;
 
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[1,0]:='Hello1';
StringGrid1.Cells[2,0]:='';
StringGrid1.Cells[3,0]:='';
 
StringGrid1.Cells[5,0]:='Hello2';
StringGrid1.Cells[6,0]:='';
StringGrid1.Cells[7,0]:='';
 
end;

avec biensur goFixedVertLine et goFixedHorzLine à false, ...

Le résultat n'est pas bon...

Quelqu'un pour tester mon code en le copiant dans une unit ?

OU EST MON ERREUR ?




Merci à tous,

[CapJack]

Non, effectivement, il y a un problème avec le défilement intégré au composant TStringGrid. Nous voilà au point de départ...