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
|
type
TAlignementVertical=(alVTop,alVCenter,alVBottom);
TAlignementHorizontal=(alHLeft,alHCenter,alHRight);
TJustification=(JustLeft,JustCenter,JustRight);
//La valeur du paramètre AWidth détermine si on effectue unretour
//à la ligne automatique ou non :
// - avec AWidth=0 => pas de WordWrap
// - avec AWidth<>0 => WorWrap sur la largeur donnée
Function TextSize(Phrase : string; AWidth:integer; Police : TFont = nil) : TPoint;
var
DC: HDC;
X: Integer;
Rect: TRect;
C : TBitmap;
WordWrapParams:integer;
begin
C := TBitmap.create;
if police <> nil then C.canvas.Font := police;
Rect.Left := 0;
Rect.Top:=0;
Rect.Right:=AWidth;
Rect.Bottom:=0;
DC := GetDC(0);
C.Canvas.Handle := DC;
WordWrapParams:=0;
if AWidth<>0 then WordWrapParams:=DT_NOCLIP or DT_NOPREFIX or DT_WORDBREAK;
DrawText(C.Canvas.Handle, PChar(Phrase), -1, Rect, WordWrapParams or (DT_EXPANDTABS or DT_CALCRECT));
C.Canvas.Handle := 0;
ReleaseDC(0, DC);
result.X:=Rect.Right-Rect.Left;
result.Y:=Rect.Bottom-Rect.Top;
C.Free;
end;
//Notre procedure d'affichage de texte multiligne
procedure DessineTexteMultiligne(AString: string; Ellipsis,WordWrap:boolean;ACanvas:TCanvas;ARect: TRect;
AlignementHorizontal:TAlignementHorizontal;
AlignementVertical:TAlignementVertical;
TextJustification:TJustification);
var
AHeight,AWidth:integer;
Rect,oldClipRect:TRect;
ATop,ALeft,H,W:Integer;
AText:string;
JustificationDuTexte:Integer;
MyRgn:HRGN;
APoint:TPoint;
begin
with ACanvas do
begin
Lock;
AHeight:=ARect.Bottom-ARect.Top;
AWidth:=ARect.Right-ARect.Left;
//on calcule la taille du rectangle dans lequel va tenir le texte (sans WordWrap)
APoint:=TextSize(AString,0,ACanvas.Font);
W:=APoint.X;
H:=APoint.Y;
//on calcule la position (Haut,Gauche) du rectangle dans lequel va tenir le texte
//en fonction de l'alignement horizontal et vertical choisis
ATop:=ARect.Top;
ALeft:=ARect.Left;
If WordWrap then //Si on veut un "WordWrap" (retour à la ligne automatique)
if W>(ARect.Right-ARect.Left) then //et que le texte dépasse du rectangle de destination
begin //alors...
W:=AWidth; //on fixe la largeur du texte
AText:=AString;
H:=TextSize(AText,W,ACanvas.Font).y; //on recalcule la hauteur du texte
if Ellipsis then
begin
while (H>AHeight) do
begin
AText:=Copy(AText,1,Length(AText)-1);
H:=TextSize(AText+'...',W,ACanvas.Font).y;
end;
AText:=AText+'...';
end;
end;
case AlignementVertical of
alVBottom : ATop:=ARect.Bottom-H;
alVCenter : ATop:=ARect.Top+((AHeight-H) div 2);
alVTop : ATop:=ARect.Top;
end;
case AlignementHorizontal of
alHLeft : ALeft:=ARect.Left;
alHCenter: ALeft:=ARect.Left+(AWidth-W) div 2;
alHRight : ALeft:=ARect.Right-W;
end;
//Fin du calcul du rectangle, on met le resultat dans Rect
Rect:=Bounds(ALeft,ATop,W,H);
//On rempli le rectangle de la zone sinon on voit le texte que delphi à dessiné
FillRect(ARect);
//On détermine les paramètres de justification à passer à Windows
case TextJustification of
JustLeft : JustificationDuTexte:=DT_LEFT;
JustCenter: JustificationDuTexte:=DT_CENTER;
JustRight : JustificationDuTexte:=DT_RIGHT;
end;
//Si le texte est plus grand que notre zone, on prend cette précaution (Clipping)
with ARect do MyRgn :=CreateRectRgn(Left,Top,Right,Bottom);
SelectClipRgn(Handle,MyRgn);
//On dessine le texte
DrawText(Handle,PChar(AText),-1,Rect,JustificationDuTexte or DT_NOCLIP or DT_NOPREFIX or DT_WORDBREAK );
//On a plus besoin de la zone de clipping
SelectClipRgn(Handle,0);
DeleteObject(MyRgn);
Unlock;
end;
end; |
Partager