TStringgrid : Canvas mutilignes tronqués par EndEllipsis

Invité · 27/10/2012, 12h39

Bonjour,

Vacances scolaires obligent, j'en profite pour améliorer mes composants. J'ai un vieux problème de "marge" dans les TStringGrids.

Il s'agit de la gestion de la hauteur automatique des Rows multilignes. Une bonne image vaudra mieux qu'une longue explication :

La hauteur de la ligne est calculée automatiquement. Si elle dépasse une FMaxRowHeight (non nulle), alors la ligne est affichée en DT_END_Ellipsis.
Ici, le DT_END_Ellipsis fonctionne parfaitement, mais le Canvas est trop court de 2 pixels.
Compte tenu du code que j'emploie, si je corrige le Canvas.Bottom, alors il est de la bonne taille, mais le DT_END_Ellipsis est mal géré puisqu'il est réalisé sur la ligne du dessous du texte affichée, ligne que l'on ne voit pas... et on ne voit pas les points de suspension.

Code :

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

1
2
3
4
5
6
7
8
 
procedure TFormMain.FormCreate(Sender: TObject);
var
  sErr : string;
begin
 lzTest1.RowCount:= 60;
 lzTest1.Cells[2,35] :='a'+LineEnding+'b'+LineEnding+'c'+' defg hijkl mnopq rstuv wx yz abcdef ghij klmno';
[...];

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
 
procedure TlzTest.DrawCell(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
var
  bRect : TRect;
  sTmp : String;
begin
  inherited;
  if not (csDesigning in ComponentState) then
    if (arow > FixedRows) and (aCol = 2) then begin {//Modification pour simplifier le code dans cet exemple}
      FEllipsis := False;
      sTmp := cells[aCol, aRow];
      { Dessin du fond }
        bRect := aRect;
        DrawText(Canvas.Handle, PChar(sTmp), length(sTmp), bRect,
          DT_CALCRECT or DT_WORDBREAK);
      if (bRect.Bottom - bRect.Top) > DefaultRowHeight then begin
         if FMaxRowHeight = 0 then
           RowHeights[aRow] := bRect.Bottom - bRect.Top
         else
           if bRect.Bottom - bRect.Top > FMaxRowHeight then begin
              RowHeights[aRow] := FMaxRowHeight;
              FEllipsis := True;
            end else
              RowHeights[aRow] := bRect.Bottom - bRect.Top;
      end
      else
       RowHeights[aRow] := DefaultRowHeight;
 
      with Canvas do begin
       FillRect(aRect);
      { Reconstruction des lignes}
       if goHorzLine in Options then
         Line(arect.Left,arect.Bottom-1,arect.Right,arect.Bottom-1)
       else
         if aRow = RowCount -1 then
           Line(arect.Left,arect.Bottom-1,arect.Right,arect.Bottom-1);
       if goVertLine in Options then
         Line(arect.right-1,arect.top,arect.Right-1,arect.Bottom)
       else
         if aCol = ColCount -1 then
           Line(arect.right-1,arect.top,arect.Right-1,arect.Bottom);
     end;
 
    { Dessin du texte }
     if not FEllipsis then begin
     [...] 
     end else begin
       if Columns.Count > 0 then begin
          [...]
       end else
        {Pas de TColumn utilisé donc alignement à gauche}
         DrawText(Canvas.Handle, PChar(sTmp), length(sTmp), aRect,
           DT_LEFT or DT_WORDBREAK OR DT_END_ELLIPSIS);
     end;
  end;
end;

Merci de votre aide.
Cordialement. Gilles

**tourlourou** · 27/10/2012, 14h29

Bonjour,

Un patch à 2 balles :
1) tu affines le calcul du rectangle nécessaire dans une boucle à laquelle tu passes un texte de plus en plus court jusqu'à ce que ça tienne dans les limites que tu t'es fixé.
2) tu passes le rectangle avec une marge de sécurité
3) et le texte à la longueur ainsi déterminée ('...' inclus)

Invité · 29/10/2012, 11h09

Bonjour Yves... et merci pour votre aide.

Envoyé par tourlourou

[...]
1) tu affines le calcul du rectangle nécessaire dans une boucle[...]

Oui, c'est une solution mais les TStringgrids font déjà tellement de boucles pour afficher les cellules... qu'on ne va pas finir de boucler

Mais en effet, je me suis inspiré de votre principe... en triturant (un peu) les Canvas. Le problème semble réglé sous Windows... Voici un extrait du code de base (ie celui qui posait problème) lorsqu'on définit la hauteur maximale d'une ligne (ici 85).

J'attends de savoir si DT_WORDBREAK OR DT_END_ELLIPSIS (le second surtout) est compatible gtk2. Je ne dispose pas de Linux ici.

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
unit lzTest;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Controls, LMessages,
  StdCtrls, {Tedit, TStaticText}
  Graphics, {TColor}
  Dialogs, Forms,
  LCLType {HiWord},
  LCLIntf {GetKeyState},
  Grids, math {Floor};
 
type
  TlzTest =  class(TStringGrid)
  private
   { Private declarations }
   FMaxRowHauteur    : Integer;
   HMaxRowRecalculee : Integer;
   HUneLigne         : Integer;
   HEspaceVertical   : Integer;
   FDecalCanvHor, FDecalCanvVert : Integer; {Constantes de décalage du Canvas  
   pour caler l'écriture avec DrawText: 4 & 4 imputées dans Create}
  protected
    { Protected declarations }
    procedure SetMaxRowHeight(aValue: Integer);
    function  DeflateRect(const R: TRect): TRect;
    function  InvDeflateRect(const R: TRect; const hRow: Integer): TRect;    
  public
    { Public declarations }
    constructor Create( aOwner: TComponent ); override;
    destructor  Destroy; override;
    procedure DrawCell(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
      override;
  published
    { Published declarations }
    property MaxRowHeight : Integer Read FMaxRowHauteur Write SetMaxRowHeight;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
 {$I lzTest_icon.lrs}
  RegisterComponents('lzAddition',[TlzTest]);
end;
 
constructor TlzTest.Create(aOwner: TComponent);
begin
 inherited;
 
 FMaxRowHauteur    := 0;
 HMaxRowRecalculee := 0;
 HUneLigne         := 0;
 HEspaceVertical   := 0;
 FDecalCanvHor     := 4;
 FDecalCanvVert    := 4;       
end;
 
 
destructor TlzTest.Destroy;
begin
 inherited Destroy;
end;
 
procedure TlzTest.SetMaxRowHeight(aValue: Integer);
begin
 if FMaxRowHauteur <> aValue then
   if (FMaxRowHauteur = 0) OR (FMaxRowHauteur > DefaultRowHeight) then
      FMaxRowHauteur:= aValue;
end;
 
function TlzTest.InvDeflateRect(const R: TRect; const hRow: Integer): TRect;
begin
   with R do
     SetRect(Result, Left +FDecalCanvHor, Top +FDecalCanvVert,
                     Right -FDecalCanvHor , Top +hRow +FDecalCanvVert -1);
end;
 
function TlzTest.DeflateRect(const R: TRect): TRect;
begin
   with R do
     SetRect(Result, Left +FDecalCanvHor ,Top, Right -FDecalCanvHor, Bottom );
end;
 
procedure TlzTest.DrawCell(aCol, aRow: Integer; aRect: TRect; aState: TGridDrawState);
var
  bRect : TRect;
  sTmp : String;
begin
  inherited;
 
  if not (csDesigning in ComponentState) then
    if (aRow >= FixedRows) and (aCol = 2) then begin
      {Calcul .de la hauteur d'une ligne
              .de l'espace vertical non utilisé dans la cellule
       Correction de FMaxRowHauteur si nécessaire}
       if (HUneLigne= 0) then begin
         bRect := aRect; {OBLIGATOIRE}
         sTmp := 'a';
         DrawText(Canvas.Handle, PChar(sTmp), length(sTmp), bRect,
         DT_CALCRECT or DT_WORDBREAK);
         HUneLigne:= bRect.Bottom - bRect.Top;
         HEspaceVertical:= DefaultRowHeight - HUneLigne;
         HMaxRowRecalculee    :=  Floor(FMaxRowHauteur/HUneLigne)*HUneLigne +HEspaceVertical;
      end;
 
      {Calcul de la hauteur de la ligne afin d'obtenir un affichage non tronqué
       verticalement}
      sTmp := cells[aCol, aRow];
      bRect := DeflateRect(aRect);
      DrawText(Canvas.Handle, PChar(sTmp), Length(sTmp), bRect,
               DT_CALCRECT or DT_WORDBREAK);
      if  bRect.Bottom - bRect.Top <= DefaultRowHeight then
        RowHeights[aRow] := DefaultRowHeight
      else begin
        with bRect do
        if Floor((Bottom -Top)/HUneLigne)*HUneLigne +HEspaceVertical > HMaxRowRecalculee
        then RowHeights[aRow] := HMaxRowRecalculee
        else RowHeights[aRow] := Floor((Bottom -Top)/HUneLigne)*HUneLigne +HEspaceVertical;
      end;
 
      with Canvas do begin
        {On efface}
        FillRect(aRect);
        {On retrace les lignes... sinon y en a pas... (Cela ne devrait pas être)}
        with aRect do begin
          if goHorzLine in Options then
            Line(Left, Bottom -1, Right, Bottom -1)
          else
            if aRow = RowCount -1 then
              Line(Left, Bottom -1, Right, Bottom -1);
          if goVertLine in Options then
            Line(Right -1, Top, Right -1, Bottom)
          else
            if aCol = ColCount -1 then
              Line(Right -1, Top, Right -1, Bottom);
        end;
      end;
 
     {Le texte}
     sTmp := cells[aCol, aRow];
 
     aRect := InvDeflateRect(aRect, RowHeights[aRow] -HEspaceVertical);
     DrawText(Canvas.Handle, PChar(sTmp), Length(sTmp), aRect,
              DT_LEFT OR DT_WORDBREAK OR DT_END_ELLIPSIS);
 
  end;
end;
 
end.

Et pour tester

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
 
procedure TFormMain.FormCreate(Sender: TObject);
begin
  with lzTest1 do begin
    Width   := 352;
    Height  := 319;
    Options := Options +[goCellEllipsis, goColSizing];
   {goCellEllipsis sans rapport : simplement pour tester avec la phrase Test
    dans la colonne 1}
 
   Cells[1,1] := 'Phrase Test';
   Cells[2,1] := 'Phrase Test';
   Cells[2,3] := 'Une petite phrase';
   Cells[2,4] := 'Lorem ipsum dolor sit amet, consectetuer adipiscing elit, '+
                 'sed diam nonummy nibh euismod tincidunt ut laoreet dolore '+
                 'magna aliquam erat volutpat.';
   MaxRowHeight := 85;
   RowCount     := 60; {... dans mon test... mais peu importe}
  end;   
end;

Le résultat (sur la colonne 2):

Cordialement. Gilles

Addendum : J'ai testé ce midi sur mon Ubuntu 10.04. Il ne fallait pas rêver. Voici le résultat (à gauche après le Form.OnShow, à droite après un élargissement de la colonne 2):

Sous Nux, le DT_END_ELLIPSIS (colonne 2) n'est pas géré par Lazarus pas plus d'ailleurs que le goCellEllipsis dans les Options de la Stringgrid (colonne 1). Il semblerait que cela puisse pourtant partiellement fonctionner, en tous cas pour les TStringgrid. Je n'ai pas eu le temps de faire des tests complets sous Ubuntu ce midi, mais les premiers sont négatifs... Et puis, il faudrait que j'installe une version plus récente (Ubuntu 12.04). Bon, j'ai un code (la version de départ) commun aux 2 OS qui fonctionne mais sans le EndEllipsis.

Donc résolu sous Windows et en attente sou Linux (mais avec une solution sans EndEllpisis)

TStringgrid : Canvas mutilignes tronqués par EndEllipsis [Lazarus]

Lazarus Pascal

Discussions similaires

Partager

Partager