Canvas - Ecrire a la verticale [FAQ]

**zarbydigital** · 08/11/2005, 10h51

Salut,

Je fais des impressions avec delphi

Est-ce que c'est possible d'imprimer du texte a la verticale et a l'horizonale sur la meme feuille ???

Pour info:
Donc je fais tout ca dans un Canvas. Que ca soit un tImgae.Canvas ou TPrinter.Canvas c'est egal...

merci d'avance...

zd

**Archimède** · 08/11/2005, 12h09

pour écrire à la verticale, j'avais trouvé une petite routine que j'ai adapté empiriquement pour ton cas.

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 TForm1.PaintBox1Paint(Sender: TObject);
var
lgfonte:TlogFont;
fonte:Tfont;
begin
with paintbox1.canvas do begin
font.Name:='arial';
font.Size:=14;
end;
fonte:=TFONT.Create;
Fonte.Assign(paintbox1.Canvas.Font);
Getobject(fonte.Handle,sizeof(lgfonte),@Lgfonte);
LgFonte.lfEscapement:=910;
Lgfonte.lfOrientation:=910;
Fonte.Handle:=createfontindirect(lgfonte);
paintbox1.Canvas.font.Assign(fonte);
Fonte.Free;
paintbox1.canvas.textout(100,100,'vertical');
end;

les valeurs de lfEs..et lfOrient.. sont empiriques!, je n'ai pas le temps d'approfondir et de faire des recherches. excuse le code est un peu brouillon, mais c'est mieux que rien!

**LadyWasky** · 08/11/2005, 12h37

Oui mais attention, pour écrire en vertical il faut impérativement que ta police soit TrueType !

Sinon, ça marche pô !

**LadyWasky** · 08/11/2005, 12h57

Sinon tu peu l'utiliser comme ça, aussi :

Voici les fonctions magiques :

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
 
uses WinTypes, WinProcs, WIndows, Messages, SysUtils, Classes, Controls, Forms, Graphics,StdCtrls;
...
 
function IsTrueType(Font: TFont): Boolean;
var
  Metrics: TTextMetric;
begin
  Canvas.Font := Font;
  GetTextMetrics( Canvas.Handle, Metrics );
  Result := ( Metrics.tmPitchAndFamily and tmpf_TrueType ) = tmpf_TrueType;
end;
 
function CreateRotatedFont(Font: TFont; Angle: Integer): HFont;
var
  LogFont: TLogFont;
begin
  If not IsTrueType(Font) then Font.Name:='Arial';
  FillChar(LogFont, SizeOf(LogFont), 0);
  with LogFont do begin
    lfHeight := Font.Height;
    lfWidth := 0;
    lfEscapement := Angle * 10;
    lfOrientation := 0;
    if fsBold in Font.Style then lfWeight := FW_BOLD
    else lfWeight := FW_NORMAL;
    lfItalic := Ord(fsItalic in Font.Style);
    lfUnderline := Ord(fsUnderline in Font.Style);
    lfStrikeOut := Byte(fsStrikeOut in Font.Style);
    lfCharSet := Byte(Font.Charset);
    StrPCopy(lfFaceName, Font.Name);
    lfQuality := DEFAULT_QUALITY;
    lfOutPrecision := OUT_DEFAULT_PRECIS;
    lfClipPrecision := CLIP_DEFAULT_PRECIS;
    case Font.Pitch of
      fpVariable: lfPitchAndFamily := VARIABLE_PITCH;
      fpFixed: lfPitchAndFamily := FIXED_PITCH;
      else lfPitchAndFamily := DEFAULT_PITCH;
    end;
  end;
  Result := CreateFontIndirect(LogFont);
end;

Un exemple de procedure toute faite pour une réutilisation facilité

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
 
procedure DrawLabel(AString: string;ACanvas:TCanvas;ARect: TRect; Alignment:TAlignment;ALayout:TTextLayout;Angle:boolean);
var
  AHeight,AWidth:integer;
  R:TRect;
  H,W,WW,ATop,ALeft:Integer;
  FontNewHeight:integer;
  AText:string;
begin
  ACanvas.Font:=Font;
  with ACanvas do
  begin
    Brush.Color:=Font.Color;
    FrameRect(ARect);
    InflateRect(ARect,-1,-1);
    AHeight:=ARect.Bottom-ARect.Top;
    AWidth:=ARect.Right-ARect.Left;
    AText:=AString;
    WW:=TextSize(AText,Font).X;
 
    if Angle then
    begin
      begin
        FontNewHeight:=Ceil(Font.Height*AHeight/WW);
        Font.Height:=FontNewHeight;
        W:=TextSize(AString,Font).X;
        H:=Round(TextSize(AString,Font).Y*1.5);
      end;
      if H>AWidth then
      begin
        FontNewHeight:=Ceil(Font.Height*AWidth/H);
        Font.Height:=FontNewHeight;
        W:=TextSize(AString,Font).X;
        H:=TextSize(AString,Font).Y;
      end;
    end
    else
    begin
      FontNewHeight:=Ceil(Font.Height*AWidth/WW);
      Font.Height:=FontNewHeight;
      W:=TextSize(AString,Font).X;
      H:=TextSize(AString,Font).Y;
    end;
    if Angle then Font.Handle:=CreateRotatedFont(Font, 90);  //<-- tu peux adapter ici, là ça écrira de bas en haut.
    ATop:=ARect.Top;
    ALeft:=ARect.Left;
    if Angle then
    begin
      case ALayout of
        tlBottom : ATop:=ARect.Bottom-W;
        tlCenter : ATop:=ARect.Top+((AHeight-W) div 2);
        tlTop    : ATop:=ARect.Top;
      end;
 
      case Alignment of
        taLeftJustify  : ALeft:=ARect.Left;
        taCenter       : ALeft:=ARect.Left+(AWidth-H) div 2;
        taRightJustify : ALeft:=ARect.Right-H;
      end;
      R := Bounds(ALeft,ATop,H,W);
    end
    else
    begin
      case ALayout of
        tlBottom : ATop:=ARect.Bottom-H;
        tlCenter : ATop:=ARect.Top+((AHeight-H) div 2);
        tlTop    : ATop:=ARect.Top;
      end;
 
      case Alignment of
        taLeftJustify  : ALeft:=ARect.Left;
        taCenter       : ALeft:=ARect.Left+(AWidth-W) div 2;
        taRightJustify : ALeft:=ARect.Right-W;
      end;
      R := Bounds(ALeft,ATop,H,W);
    end;
    ACanvas.Brush.Color := Color;
    if Angle
    then TextOut(R.Left,R.Bottom,AString)
    else TextOut(R.Left,R.Top,AString);
  end;
end;

Et un exemple d'utilisation :

Code :

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

1
2
3
4
5
 
var DestRect:TRect;
DestRect:=Bounds(0,0,form1.height,20);
 
DrawLabel(Form1.Canvas,'Bonjour',DestRect,taCenter,tlCenter,True);

**zarbydigital** · 08/11/2005, 20h48

c'est genial...

merci les gars, je vais essayer au bureau demain.

Toutefois j'avais deja trouve ce script cet apres-midi en chercher, Il marchait sur un TImage.canvas mais pas sur mon printer.canvas...

Enfin il marchait mais ma police etait plus que minuscule...