Hey,
gerne würde ich für eine meiner Anwendungen ein Intro erzeugen, dabei muss Text dargestellt werden, in einem bestimmten Winkel (muss zur Hintergrundgrafik passen).
Das habe ich soweit mit einer Prozedur und ner Paintbox hinbekommen. Jedoch habe ich jetzt das Problem, dass im Hintergrund des Textes ein farbiges Quadrat angezeigt wird...ist es irgendwie möglich dieses transparent zu machen?
Ich habe bereits vergeblich versucht mit:
Delphi-Quelltext
1:
2:
| form1.TransparentColorValue:=clRed;
form1.TransparentColor:=true; |
es zu realisieren, das klappt aber nicht wie gewünscht.
Kann mir jemand helfen doer kennt gar eine ganz andere Möglichkeit den Text in Rotation darzustellen?
Grüße Xsus
Hier der komplette Quelltext:
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:
| unit Intro;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.jpeg, Vcl.ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Timer1: TTimer;
PaintBox1: TPaintBox;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
AlphaBlend := True;
AlphaBlendValue := 0;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Timer1.Enabled := TRUE;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
AlphaBlendValue := AlphaBlendValue + 17;
if AlphaBlendValue > 254 then
begin
Timer1.Enabled := FALSE;
end;
end;
procedure TextOutAngle(const Canvas: TCanvas; X, Y: Integer; const AText: string; AAngle: Integer);
var
hCurFont: HFONT;
LogFont: TLogFont;
begin
with Canvas do
begin
hCurFont := Font.Handle;
try
GetObject(Font.Handle, SizeOf(LogFont), @LogFont);
LogFont.lfEscapement := AAngle;
LogFont.lfOrientation := AAngle;
Font.Handle:= CreateFontIndirect(LogFont);
try
TextOut(X, Y, AText);
finally
DeleteObject(Font.Handle);
end;
finally
Font.Handle := hCurFont;
end;
end;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
Paintbox1.Canvas.Font.Name:='Lucida Calligraphy';
Paintbox1.Canvas.Font.Size:=24;
TextOutAngle(Paintbox1.Canvas, 10, 25, 'TEXT', 51);
end;
end. |
xsus
