Entwickler-Ecke

Multimedia / Grafik - PaintBox - gedrehter Text - Hintergrund transparent machen


xsus - Sa 16.11.13 19:58
Titel: PaintBox - gedrehter Text - Hintergrund transparent machen
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:

Delphi-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
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  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;
   //form1.TransparentColorValue:=clRed;
   //form1.TransparentColor:=true;
   TextOutAngle(Paintbox1.Canvas, 1025'TEXT'51);
end;
end.


Mathematiker - Sa 16.11.13 20:48

Hallo,
user profile iconxsus hat folgendes geschrieben Zum zitierten Posting springen:
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?

Meine erste Idee wäre, Brush.Color zu prüfen, d.h.

Delphi-Quelltext
1:
2:
  Brush.Style:=bsclear;
  TextOut(X, Y, AText);

müsste das Problem lösen.

Beste Grüße
Mathematiker


xsus - So 17.11.13 19:15

Danke, klappt super! :)


Janina - Mi 20.11.13 23:45

Sehr elegante Lösung, Mathematiker. Ist schon verrückt, mit was für kleinen aber schwerwiegenden Problemchen man im Entwickleralltag täglich zu kämpfen hat. Da freut man sich doch über ein so feines Forum, wie dieses !