voilà, comment faire une rotation de caractères dans un canvas alors que le textout ne permet que des translations circulaires.
j'avais la solution dans mes archives à partir de l'apis windows mais je ne la retrouve pas...
merci
voilà, comment faire une rotation de caractères dans un canvas alors que le textout ne permet que des translations circulaires.
j'avais la solution dans mes archives à partir de l'apis windows mais je ne la retrouve pas...
merci
Salut !
J'avais ça dans un coin :Me rappelle pas où je l'ai trouvé, mais ça fonctionne.
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 function IsTrueType(Font: TFont): Boolean; var DC: HDC; C : TBitmap; Metrics: TTextMetric; begin C := TBitmap.create; try C.canvas.Font := Font; DC := GetDC(0); try C.Canvas.Handle := DC; C.Canvas.Font := Font; GetTextMetrics(C.Canvas.Handle, Metrics ); Result := ( Metrics.tmPitchAndFamily and tmpf_TrueType ) = tmpf_TrueType; C.Canvas.Handle := 0; finally ReleaseDC(0, DC); end; finally C.Free; end; 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; procedure TexteAngle(AString: string;ACanvas:TCanvas;Font:TFont;x,y:integer;d:integer); //angle en degres begin ACanvas.Font := Font; with ACanvas do begin Brush.Color := clYellow; Font.Handle := CreateRotatedFont(Font, d); TextOut(X, Y, AString); end; end; procedure TForm1.Button1Click(Sender: TObject); begin TexteAngle('Bonjour', Form1.Canvas, Form1.Font, 50, 70, 45); TexteAngle('Bonjour', Form1.Canvas, Form1.Font, 50, 70, 180); TexteAngle('Bonjour', Form1.Canvas, Form1.Font, 50, 70, -90); end;
HTH,
--
jp
pas mal du tout ton coin![]()
merci à toi.
je teste tout ça et j'adapte à mon code..
Moi je m'en souvien (c'est un copyleft "Ma pomme à moi"Envoyé par Jipété
![]()
)
http://www.developpez.net/forums/sho...70&postcount=3
Sinon, j'ai une remarque à formuler, sous cette forme, il ne te sera peut-être pas très facile de placer ton texte exactement là où tu veux (Par défaut, c'est le coin supérieur gauche qui sert de point d'ancrage x/y au texte dessiné).
Mais j'avais déjà proposé une solution ici :
http://www.developpez.net/forums/sho...11&postcount=4
bon dev![]()
merci, je viens de découvrir ton post, je n'ai pas regardé ton source...
je vais le faire ...
sinon j'ai bidouillé ça hier soir à partir du code fourni, exemple:
merci pour ton intervention, je regarde ton boulot
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
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 unit Unit1; interface {$R *.dfm} uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,math,ExtCtrls; type TForm1 = class(TForm) procedure FormPaint(Sender: TObject); procedure FormCreate(Sender: TObject); private { Déclarations privées } teta:integer; pos:Tpoint; function IsTrueType(Font: TFont): Boolean; function CreateRotatedFont(Font: TFont; Angle: Integer): HFont; procedure TexteAngle(AString: string;ACanvas:TCanvas;Font:TFont;x,y:integer;d:integer); Function rotationpoint(xo,yo:integer;tetadeg:real;pt:Tpoint):Tpoint; public { Déclarations publiques } end; var Form1: TForm1; implementation function TForm1.IsTrueType(Font: TFont): Boolean; var DC: HDC; C : TBitmap; Metrics: TTextMetric; begin C := TBitmap.create; try C.canvas.Font := Font; DC := GetDC(0); try C.Canvas.Handle := DC; C.Canvas.Font := Font; GetTextMetrics(C.Canvas.Handle, Metrics ); Result := ( Metrics.tmPitchAndFamily and tmpf_TrueType ) = tmpf_TrueType; C.Canvas.Handle := 0; finally ReleaseDC(0, DC); end; finally C.Free; end; end; function TForm1.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 :=1; 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; procedure TForm1.TexteAngle(AString: string;ACanvas:TCanvas;Font:TFont;x,y:integer;d:integer); //angle en degres begin ACanvas.Font := Font; with ACanvas do begin Brush.style:=bsclear; Font.Handle := CreateRotatedFont(Font, d); TextOut(X, Y, AString); end; end; Function TForm1.rotationpoint(xo,yo:integer;tetadeg:real;pt:Tpoint):Tpoint; var teta:real; Rayon:integer; fi: real; begin teta:=(pi*tetadeg/180); if pt.x-xo<>0 then fi:=arctan2(pt.y-yo,pt.x-xo) else fi:=-pi/2; Rayon:=round(sqrt(sqr(pt.x-xo)+sqr(pt.y-yo))); result:=point(Round(xo+Rayon*cos(teta+fi)),Round(yo+Rayon*sin(teta+fi))); end; procedure TForm1.FormCreate(Sender: TObject); begin width:=screen.Width; height:=screen.Height; position:=poscreencenter; with font do begin Size:=15; Name:='arial'; style:=[fsbold]; end; Pos:=point(clientwidth div 6,clientheight div 2); end; procedure TForm1.FormPaint(Sender: TObject); var i:integer; begin for i:=1 to 36 do begin inc(teta,10); texteangle('Bonjour à toi',canvas,font,rotationpoint(clientwidth div 2,clientheight div 2,teta,pos).X,rotationpoint(clientwidth div 2,clientheight div 2,teta,pos).Y,-teta); end; end; end.![]()
pour mon code, j'avais besoin de faire tourner un aimant droit sur lui-même en précisant le pôle nord et sud dessus et faire tourner les caractères N et S...
Maintenant, ça marche.
Pour l'aimant, je fais tourné un tableau de points et j'ai adopté la méthode précédente pour les caractères. Mais effectivement, ce n'est pas pratique pour placer correctement les caractères vu x,y coin en haut à gauche...
les caractères doivent être symétriques par rapport au centre de la rotation...
ton complément va donc être bien utile...
salut
Partager