Entwickler-Ecke
Grafische Benutzeroberflächen (VCL & FireMonkey) - Erbe von TGraphicControl zeichnet nichts
Kay E. - Fr 20.05.11 17:49
Titel: Erbe von TGraphicControl zeichnet nichts
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:
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:
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
bummi - Fr 20.05.11 18:12
Das Hauptproblem ist daß Du FCaption und Caption mischt
btw.löschen der Oberfläche ist nicht nötig, Paint malt ohnehin alles neu.
Den Sinn von FFont habe ich nicht verstanden.
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:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
| unit CaptionUnit;
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
Canvas.Pen.Width := 2;
Canvas.Pen.Color := clBlack;
Canvas.Rectangle(boundsrect);
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(FCaption);
vWidth := Canvas.TextWidth(FCaption);
Canvas.Brush.Style := bsClear;
Canvas.TextOut(HalfWidth - round(vWidth / 2), HalfHeight - round(vHeight / 2), FCaption);
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. |
Kay E. - So 22.05.11 18:06
Ah, manchmal sieht man den Wald vor lauter Bäumen nicht. Danke dir!
Anzumerken ist, dass noch ein paar Kleinigkeiten bei den hordgecodeden Zahlen nicht gestimmt haben, aber das hab ich rausgefunden. Auch das mit dem Paint ist ein guter Einwand. Danke dafür!
Grüße Kay
Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2026 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!