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.

**LadyWasky** · 10/05/2007, 11h50

Envoyé par cretindezalpes

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** · 10/05/2007, 12h17

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** · 10/05/2007, 17h13

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** · 10/05/2007, 19h07

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 :
Nom : MergedCell2_Pb.gif
Affichages : 87
Taille : 9,1 Ko

Nom : MergedCell2_Pb.gif
Affichages : 87
Taille : 9,1 Ko

Alors qu'on devrait avoir :
Nom : MergedCell2_ok.gif
Affichages : 88
Taille : 8,6 Ko

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** · 24/05/2007, 15h25

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...

@+

Fusion de cellules fixes

Delphi

Vue hybride

Discussions similaires

Partager

Partager