Discussion :

[zarbydigital]

Hello,

J'aimerais deformer ma police, c'est dire que je voudrait dire que ma chaine de caractere "Hello World" se case dans un Rectangle de (p.ex) 100px de larg et 50px de haut.

Est-ce que c'est possible ???

Merci les gars

[petitcoucou31]

j'ai juste cette routine qui pourrait te mettre sur la voie , tu sais jouer sur la hauteur de la largeur de ta police ..

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
 
procedure Toto.afficheTexteVertival(texte:string;Destination:Tlabel;Size:integer);
var
  LgFnt : TLogFont;
  Fnt   : TFont;
  X,Y,H,L:integer;
begin
 
  Destination.Canvas.Font.Name :=Police;
  Destination.Canvas.Font.style:=[Fsbold];
  Fnt := TFont.Create;
  Fnt.Assign(Destination.Canvas.Font);
  GetObject(Fnt.Handle, sizeof(LgFnt), @LgFnt);
 
  LgFnt.lfEscapement :=900;
  LgFnt.lfQuality := ANTIALIASED_QUALITY;
  LgFnt.lfHeight :=20;
  LgFnt.lfWidth := round(LgFnt.lfHeight / 2.5 );
  LgFnt.lfWeight :=1;
 
  Fnt.Handle := CreateFontIndirect(LgFnt);
  Destination.Canvas.Font.Assign(Fnt);
  Destination.Canvas.Font.color:=clgray;
 
  H:=Destination.Canvas.TextHeight(texte);
  L:=Destination.Canvas.Textwidth(texte);
 
  X:=(destination.Width-H) div 2 ;
  Y:=(destination.Height-L) div 2 ;
  Y:=destination.Height-Y;
  Fnt.Free;
  Destination.Canvas.TextOut(X,Y,texte);
end;

bye

[LadyWasky]

Je crois qu'il faut transformer ton texte en Path (chemin de points) avec des fonctions comme BeginPath, Endpath, etc... comme dans ce code

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
var size: TSize;
  ...
  PaintBox1.Canvas.Font.Assign(Edit1.Font);
  GetTextExtentPoint32(PaintBox1.Canvas.Handle, PChar(Edit1.Text),
       Length(Edit1.Text), size);
  BeginPath(PaintBox1.Canvas.Handle);
  TextOut(PaintBox1.Canvas.Handle, 0, 0, PChar(Edit1.Text),
       Length(Edit1.Text));
  EndPath(PaintBox1.Canvas.Handle);
  SelectClipPath(PaintBox1.Canvas.Handle, RGN_DIFF);
  PaintBox1.Canvas.CopyMode := cmSrcCopy;
  PaintBox1.Canvas.CopyRect(
     Rect(0, 0, size.cx, size.cy), Canvas,
     Rect(Image1.Left, Image1.Top,
          Image1.Left + size.cx, Image1.Top + size.cy));

Le mieux c'est que tu ailles jeter un oeil sur le sit du EFG Computer Lab, à la rubrique Text : http://www.efg2.com/Lab/Library/Delp...ithms.htm#Text

Sinon, l'autre idée :
1) c'est d'abord de dessiner ton texte dans un Bitmap de sorte qu'il aie la même taille que ton texte (Utilisation de la fonction Windows DrawText)
2) de copier ton bitmap obtenu sur ton Canvas de destination avec StretchDraw

Voici un bout de code (dans une fiche j'ai mis un bouton, et j'ai codé son OnClick ) :

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
procedure TForm1.Button1Click(Sender: TObject);
var ARect,DestRect:TRect;
    TonTexte:String;
    ABitmap:TBitMap;
    x,y:Integer;
begin
  ABitmap:=TBitmap.create;
  try
  TonTexte:='Hello World !';
 
  //Choix de la Police
  ABitmap.Canvas.Font.Name:='Arial';
  ABitmap.Canvas.Font.Size:=32; //Plus elle est grande, plus joli ce sera !!!
 
  ARect:=Bounds(0,0,0,0);
  //Mesure le texte (taille renvoyée dans ARect)
  DrawText(ABitmap.Canvas.Handle, PChar(TonTexte), Length(TonTexte), ARect, (DT_EXPANDTABS or DT_CALCRECT));
 
  //Redimensionne le Bitmap
  ABitMap.Width:=ARect.Right;
  ABitMap.Height:=ARect.Bottom;
 
  //Dessine le texte dans le bitmap;
  DrawText(ABitmap.Canvas.Handle,PChar(TonTexte),Length(TonTexte),ARect,0);
 
  //Ta zone de destination
  DestRect:=Bounds(20,20,100,50);
  //dessin sur ta fiche dans ton rectangle de destination
  Form1.Canvas.StretchDraw(DestRect,ABitmap);
 
  //dessin du Bitmap (pour comparer, donc la ligne est a supprimer dans ton cas)
  Form1.Canvas.Draw(100,100,ABitmap);
 
  finally
    ABitMap.Free;
  end;
end;