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. |