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
|
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
procedure StringGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Déclarations privées }
public
{ Déclarations publiques }
r,c:Integer;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//Calcule la taille EXACTE d'un texte à partir d'une police de caractères choisie (Marche avec tous types de Polices : TrueType, etc...)
function TextSize(Phrase:string;police:TFont=nil):TPoint;
var
DC: HDC;
X: Integer;
Rect: TRect;
C : TBitmap;
begin
C := TBitmap.create;
try
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), Length(Phrase), Rect, (DT_EXPANDTABS or DT_CALCRECT));
C.Canvas.Handle := 0;
ReleaseDC(0, DC);
result.X:=Rect.Right;
result.Y:=Rect.Bottom;
finally
C.Free;
end;
end;
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
with Sender as TStringGrid do with Canvas do
begin
{ Sélection de la couleur de fond }
if gdFixed in State then
Brush.Color := clBtnFace
else if gdSelected in State then
Brush.Color := clNavy
else Brush.Color := clWhite;
{ Dessin du fond }
FillRect(Rect);
{ Sélection de la couleur de texte }
if gdSelected in State then
SetTextColor(Canvas.Handle,clWhite)
else SetTextColor(Canvas.Handle,clBlack);
{ Dessin du texte en utilisant la fonction API }
DrawText(Canvas.Handle, PChar(Cells[ACol,ARow]), -1, Rect ,DT_NOPREFIX or DT_WORDBREAK );
end;
end;
procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol,
ARow: Integer; const Value: String);
var APoint:TPoint;
begin
//Calcule la taille du texte
APoint:=TextSize(Value,StringGrid1.Font);
//Si le texte est plus "haut" que la ligne, on redimensionne la ligne)
if APoint.Y>StringGrid1.RowHeights[ARow]
then StringGrid1.RowHeights[ARow]:=APoint.Y; //<--Là tu peux ajouter une constante (comme une marge)
end;
procedure TForm1.StringGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
//Permet le retour chariot comme "caractère"
if Key = VK_RETURN then
StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row] := StringGrid1.Cells[StringGrid1.Col, StringGrid1.Row] + sLineBreak;
end;
end. |
[TStringGrid] Une cellule sur plusieurs lignes.
Répondre avec citation
Envoyé par Caine
Textout dessine du texte sur un Canvas et c'est tout, c'est à toi d'appeler Invalidate (ou autre) pour tout rafraichir.
Partager