Fusion de cellules fixes

**cretindezalpes** · 25/04/2007, 14h54

Bonjour,

sentant les reproches arriver, je préfère prévenir que j'ai lu la FAQ et le post http://www.developpez.net/forums/showthread.php?t=98874

Voilà. je cherche à fusionner des cellules d'une stringgrid et la solution proposée ci-dessus ne me donne qu'un résultat partiellement satisfaisant.

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.

Note : dans l'image ci-dessus, je n'ai pas géré l'affichage des cellules mis à part les deux fusionnées.

Si vous avez une quelconque idée, je suis preneur

(Sauf celle consistant à ne fixer aucune ligne, à réaliser à la main le dessin de celles devant théoriquement l'être et gérer leur non-sélection par l'utilisateur).

Merci d'avance.

**CapJack** · 25/04/2007, 16h33

Salut.

On peut avoir le bout de code pour faire des essais ?

**cretindezalpes** · 25/04/2007, 17h28

Voilà.
Pour que ca marche, il faut une StringGrid nommée SG_Resultats avec au moins 3 lignes dont 2 sont "Fixed". 6 colonnes dont 0 "fixed". J'ai l'habitude de mettre la GridLinewidth à 0.

Dans une fonction d'initialisation quelconque :

Code :

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

1
2
3
4
5
6
7
8
9
10
  SG_Resultats.ColWidths[0] := 22;
  SG_Resultats.Cells[1,0] := 'Entités';
  SG_Resultats.Cells[2,0] := 'Données évaluées';
  SG_Resultats.Cells[3,0] := '';
  SG_Resultats.Cells[4,0] := 'Erreurs évaluées';
  SG_Resultats.Cells[5,0] := '';
  SG_Resultats.Cells[2,1] := 'Valeur';
  SG_Resultats.Cells[3,1] := 'Pertinence';
  SG_Resultats.Cells[4,1] := 'Valeur';
  SG_Resultats.Cells[5,1] := 'Pertinence';

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TF_Evaluation.SG_ResultatsDrawCell(Sender: TObject; ACol,ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
  //Seules 2x2 cellules sont fusionnées de la première ligne
  if not MergedCells(SG_Resultats,ACol,ARow,2,0,3,0,State)then
    if not MergedCells(SG_Resultats,ACol,ARow,4,0,5,0,State)then
    begin
      //Les lignes non fusionnées de l'entete sont écrites en centré
      if ARow<2 then
        DrawText(SG_Resultats.Canvas.Handle, PChar(SG_Resultats.Cells[ACol,ARow]), -1, Rect , DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE )
      //Les lignes du reste du tableau sont alignées à gauche
      else
        DrawText(SG_Resultats.Canvas.Handle, PChar(SG_Resultats.Cells[ACol,ARow]), -1, Rect , DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE );
    end;
end;

avec la fonction MergedCells honteusement pompée sur le lien du thread juste au dessus

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
function MergedCells(ASG:TStringGrid; ACol,ARow,ACol1,ARow1,ACol2,ARow2:Integer; ACurrentState: TGridDrawState):Boolean;
var
  x1,y1,x2,y2:Integer;
  Rect:TRect;
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 > ASG.ColCount-1 then
    x2 := ASG.ColCount-1;
  if y1 < 0 then
    y1 := 0;
  if y2 > ASG.RowCount-1 then
    y2 := ASG.RowCount-1;
 
  if (x1 > x2) or (y1 > y2) then
  begin
    result := false;
    exit;
  end;
 
   //Si la cellule courante est la dernière de la zone de fusion, on dessine dans la fusion le texte de la cellule en haut à gauche
  if ((ACol=ACol2) and (ARow=ARow2)) then
  begin
    Rect.Left := ASG.CellRect(ACol1,ARow1).Left+1;
    Rect.Top := ASG.CellRect(ACol1,ARow1).Top+1;
    Rect.Right := ASG.CellRect(ACol2,ARow2).Right-1;
    Rect.bottom := ASG.CellRect(ACol2,ARow2).Bottom-1;
    DrawText(ASG.Canvas.Handle, PChar(ASG.Cells[ACol1,ARow1]), -1, Rect ,DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE );
//    ASG.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2, ASG.Cells[ACol1,ARow1]);
  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;

**CapJack** · 25/04/2007, 18h45

Oh là là, que c'est approximatif comme code !

En plus, chez moi ça ne marche pas : il m'affiche le texte en double !

Dans ton évènement OnDrawCell, la condition "if ARow < 2" n'est pas top, il faut mieux tester State. En plus, cette condition ne concerne que la cellule en haut à gauche, où il n'y a rien. Et puisqu'il faut les redessiner, de toute façon, pourquoi ne pas carrément centrer toutes les cellules d'en-tête ?

Bon, déjà dans les options, mettons goFixedVertLine et goFixedHorzLine à false. Ajouter ExtCtrls dans la clause Uses s'il n'y est déjà.

Ensuite, je te propose de modifier l'avant-dernier bloc de la fonction MergedCell avec ceci :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
//Si la cellule courante est la dernière de la zone de fusion, on dessine dans la fusion le texte de la cellule en haut à gauche
  if ((ACol=ACol2) and (ARow=ARow2)) then
  begin
    Rect.Left := ASG.CellRect(ACol1,ARow1).Left;
    Rect.Top := ASG.CellRect(ACol1,ARow1).Top;
    Rect.Right := ASG.CellRect(ACol2,ARow2).Right;
    Rect.bottom := ASG.CellRect(ACol2,ARow2).Bottom;
    FillRect(ASG.Canvas.Handle,Rect,ASG.Canvas.Brush.Handle);
    Frame3D(ASG.Canvas, Rect, clBtnHighlight, clBtnShadow, ASG.BevelWidth);
    InflateRect(Rect,-2-ASG.GridLineWidth,-2-ASG.GridLineWidth);
    DrawText(ASG.Canvas.Handle, PChar(ASG.Cells[ACol1,ARow1]), -1, Rect ,DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE );
  end;

Et, pour OnDrawCell :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure TForm1.SG_ResultatsDrawCell(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);
          Frame3D(Canvas, Rect, clBtnHighlight, clBtnShadow, BevelWidth);
          InflateRect(Rect,-2-GridLineWidth,-2-GridLineWidth);
          DrawText(Canvas.Handle, PChar(Cells[ACol,ARow]), -1, Rect ,DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE );
         end;
end;

**CapJack** · 25/04/2007, 19h45

Correction à ma solution :

En fait, il n'y a pas besoin de retire GridLineWidht au Rect (en plus de la valeur 2). En outre, il faut rajouter un peu de code pour avoir le "look" original, dans l'unique cas où GridLineWidth est égal à 1 (dans les autres cas, c'est bon).

On peut "purifier" un peu la fonction MergedCells :

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
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;
 
   //Si la cellule courante est la dernière de la zone de fusion, on dessine dans la fusion le texte de la cellule en haut à gauche
   if ((ACol=ACol2) 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;
     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(Canvas, Rect, clBtnHighlight, clBtnShadow, BevelWidth);
     InflateRect(Rect,-2,-2);
     DrawText(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;

Et dans l'évènement OnDrawCell :

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 TForm1.SG_ResultatsDrawCell(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;

Voilà, j'en ai terminé. L'idéal serait d'encapsuler tout ça dans un descendant de TStringList, mais là, ça devient un gros boulot parce qu'il faut choisir comment coder les cellules fusionnées dans le cas général.

**cretindezalpes** · 26/04/2007, 09h24

merci je vais tester.
Et oui, le code est approximatif, vu que j'effectue des tests

Je n'ai pas remis l'intégralité du code mais juste la partie qui permettait de comprendre le problème.

**cretindezalpes** · 26/04/2007, 11h05

Merci ca marche nickel.

Edit : j'ai du rajouter un repaint sur l'évenement onresize sinon j'avais un problème de rafraichissement.

**Zatoobux** · 26/04/2007, 16h56

Salut à tous,

Ce post m'interesse car j'avais rencontré le meme probleme que j'avais laissé en attente...

Le code donnée fonctionne mal quand toutes les colonnes du grid ne sont pas visibles (scroll).

Nom : Image1.jpg
Affichages : 351
Taille : 68,9 Ko

Nom : Image1.jpg
Affichages : 351
Taille : 68,9 Ko

Je regarde comment améliorer ça mais si quelqu'un à la solution ...

a+

**CapJack** · 28/04/2007, 20h21

Bien vu. Je n'ai pas encore trouvé de réponse.

**EPJSoft** · 29/04/2007, 15h25

personnellement j'avais modifié le code [function MergedCells] avec

Code :

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

1
2
3
4
5
6
7
8
9
 
    Rect.Left := ASG.CellRect(ACol1,ARow1).Left;
    Rect.Top := ASG.CellRect(ACol1,ARow1).Top;
    //Rect.Right := ASG.CellRect(ACol2,ARow2).Right;
    Rect.Right := Rect.Left;
    // reutilisation de x1 qui ne sert a plus rien
    for x1:= ACol1 to ACol2 do : Rect.Right := Rect.Right + ColWidth[x1] + GridLineWidth;
    Rect.Bottom := CellRect(ACol2,ARow2).Bottom;
    FillRect(Rect);

**CapJack** · 03/05/2007, 12h46

Non, ça ne marche pas.

J'ai enfin compris le pourquoi du comment.

En fait, MergedCells attend qu'on soit rendu à la cellule la plus en bas et à droite de la zone fusionnée pour dessiner la correction :

Code :

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

   if ((ACol=ACol2) and (ARow=ARow2)) then

Seulement voilà, si cette cellule se trouve en dehors de la zone visible la correction ne s'effectue donc pas car OnDrawCell ne sera pas appelée pour cette cellule. Si on remplace Col2 par Col1, on risque d'avoir le problème à gauche au lieu de droite, et si on remplace ARow2 par ARow1, en haut au lieu du bas. La meilleure méthode reste de remplacer la ligne ci-dessus par :

Code :

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

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

Du coup la correction s'effectue plusieurs fois, tant pis, mais au moins il n'y a plus de problèmes. Je m'en veux de n'avoir pas vu ça tout de suite, alors que c'était si simple...

**Zatoobux** · 03/05/2007, 13h14

Je test avec utilisation des propriétés TopRow, LeftCol et VisibleColCount du grid... mais c'est pas au point...

a+

**CapJack** · 03/05/2007, 14h53

Euh... oui, mais encore ? Je n'ai pas compris de quoi tu parles.

**Zatoobux** · 03/05/2007, 15h05

Ok pardon, je me suis mélangé les pinceau avec un autre probleme de cette algo pour lequel je n'avais pas fait de capture.
Le probleme auquel je fais allusion est quand on scroll horizontalement le grid et qu'au moins une cellule fusionnée n'est pas affichée. Dans ce cas les cellules fusionnées ne sont plus du tout les bonnes...

Le grid affiche :
Nom : MergedCell_Pb.gif
Affichages : 290
Taille : 8,4 Ko

Nom : MergedCell_Pb.gif
Affichages : 290
Taille : 8,4 Ko

au lieu de :
Nom : MergedCell01.gif
Affichages : 275
Taille : 9,4 Ko

a+

**User** · 05/05/2007, 23h40

Je suis très interessé par le code de CapJack,
(a mon avis très utiles)
mais malheureusement je ne parvient pas à le faire fonctionner correctement dans le cas d'1 scroll horizontale,

Ca marche bien sur toutes les cellules fixes sauf pour si une partie des cellules qui doivent être fusionné ne sont pas affiché (problème de scroll..)

ca vient peut-être de moi,

si quelqu'un peut m'éclairer

@+

**CapJack** · 06/05/2007, 00h55

Il y a une ligne à modifier, c'est quelques messages plus haut.

**Zatoobux** · 07/05/2007, 08h59

Bonjour à tous,

Pour le probleme de scroll j'ai modifié la fonction comme indiqué ci-dessous mais il reste plusieurs problemes :

Si le bord du grid est exactement sur une ligne de colonne probleme d'affichage
Le texte des cellules fusionnées n'est pas tronqué quand on scroll

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
 
function MergedCells2(ASG:TStringGrid; ACol,ARow,ACol1,ARow1,ACol2,ARow2:Integer; ACurrentState: TGridDrawState):Boolean;
var
  x1,y1,x2,y2:Integer;
  Rect:TRect;
  NoRightDrow: boolean;
  OCol1,ORow1,OCol2,ORow2:Integer;
 
  function GetWidth (FromCol, ToCol: integer): integer;
  var
    i: integer;
  begin
    result := 0;
    for i := FromCol to ToCol do
      inc (result,ASG.ColWidths [i]);
 
  end;
begin
 NoRightDrow := false;
 with ASG, Canvas do
  begin
 
   //Initialisations diverses
   OCol1 := ACol1;
   ORow1 := ARow1;
   OCol2 := ACol2;
   ORow2 := ARow2;
 
   result := false;
   Rect := Bounds(0,0,0,0);
   if ACol1 < LeftCol then  /// MODIFICATION ICI
     begin
       ACol1 := LeftCol;
     end;
 
   x1 := ACol1;
   y1 := ARow1;
 
   if ACol2 >= LeftCol  + VisibleColCount then  /// MODIFICATION ICI
     begin
       ACol2 := LeftCol  + VisibleColCount ;
       NoRightDrow := true;
     end;
 
   x2 := ACol2;
   y2 := ARow2;
 
 
   //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;
 
   //Si la cellule courante est la dernière de la zone de fusion, on dessine dans la fusion le texte de la cellule en haut à gauche
   //if ((ACol=aCol2) and (ARow=aRow2)) then
   if ((ACol=aCol2) and (ARow=aRow2)) then
    begin
 
     Rect.Left := CellRect(ACol1,ARow1).Left;
     Rect.Top := CellRect(ACol1,ARow1).Top;
 
     Rect.Right := Rect.Left;
 
    FillRect(Rect);
 
     if NoRightDrow then
       begin
       Rect.Right := Rect.Left + GetWidth (oCol1,oCol2)+ 2;
 
       end
     else
       Rect.Right := CellRect(ACol2,ARow2).Right;
 
     Rect.Bottom := CellRect(ACol2,ARow2).Bottom;
     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(Canvas, Rect, clBtnHighlight, clBtnShadow, 1(*BevelWidth*));
     InflateRect(Rect,-2,-2);
     DrawText(Handle, PChar(Cells[OCol1,ORow1]), -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;

Je n'utilise pas encore ce code à cause des probleme ci-dessous mais User m'a demandé la solution que j'envisage...

a+

**CapJack** · 07/05/2007, 09h35

Évidemment ! Il faut modifier aussi le premier test !

**LadyWasky** · 09/05/2007, 13h54

C'est "chaud", hein ?

Pour l'instant, je n'ai pas fait mieux que ce que j'avais fait dans ce fameux fil de discussion.

Si vous sortez une solution qui règle tous les problèmes je suis preneur