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