Moin!
Ich will grad nur nen einfachen Nachfahren von TGraphicControl produzieren, der ein zusätzliches Property "Caption" hat, was einen Text enthalten soll, den das Control dann auf sein Canvas zeichnen soll.
Das ist der komplette Code der Klasse:
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:
| unit CaptionImage;
interface
uses Controls, Classes, Graphics, Types;
type
TCaptionImage = class(TGraphicControl)
protected
procedure Paint; override;
private
FCaption: string;
FFont: TFont;
function HalfHeight: Integer;
function HalfWidth: Integer;
procedure ClearCanvas;
procedure SetFont;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetCaption(Caption: string);
end;
implementation
procedure TCaptionImage.ClearCanvas;
var
vRect: TRect;
begin
vRect.TopLeft := Point(Left, Top);
vRect.BottomRight := Point(left + Width, Top + Height);
Canvas.Pen.Color := clBtnFace;
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(vrect);
Canvas.Pen.Width := 2;
Canvas.Pen.Color := clBlack;
Canvas.Rectangle(vRect);
end;
constructor TCaptionImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FFont := TFont.Create;
FCaption := 'Test';
Width := 50;
Height := 30;
SetFont;
SetCaption(FCaption);
end;
destructor TCaptionImage.Destroy;
begin
FFont.Free;
inherited;
end;
function TCaptionImage.HalfHeight: Integer;
begin
result := round(Height / 2);
end;
function TCaptionImage.HalfWidth: Integer;
begin
result := round(Width / 2);
end;
procedure TCaptionImage.Paint;
var
vHeight, vWidth: Integer;
begin
inherited;
if FCaption <> '' then
begin
ClearCanvas;
vHeight := Canvas.TextHeight(Caption);
vWidth := Canvas.TextWidth(Caption);
Canvas.TextOut(HalfWidth - round(vWidth / 2), HalfHeight - round(vHeight / 2), Caption);
Enabled := True;
end
else
begin
ClearCanvas;
Enabled := False;
end;
end;
procedure TCaptionImage.SetCaption(Caption: string);
begin
FCaption := Caption;
Invalidate;
end;
procedure TCaptionImage.SetFont;
begin
FFont.Name := 'Tahoma';
FFont.Size := 8;
FFont.Style := [fsBold];
FFont.Color := clWindowText;
Canvas.Font := FFont;
end;
end. |
Das ist der Aufruf in der Main:
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
| private
CaptionImage: TCaptionImage;
procedure TForm1.FormCreate(Sender: TObject);
begin
CaptionImage := TCaptionImage.Create(Form1);
CaptionImage.Parent := Form1;
CaptionImage.Left := 100;
CaptionImage.Top := 100;
end; |
Das Control zeigt nichts an, also weder Schrift noch Rahmen. Es sollte aber an sich schon da sein, zumindest sagt der Compiler das.
Wo liegt das Problem?
Grüße Kay
