Entwickler-Ecke :: Thema anzeigen - Eigene Komponente: Shape+Label

Xion - Fr 25.08.06 12:03
Titel: Eigene Komponente: Shape+Label

ich will einen 'Button' machen. er soll ein aus einem Shape als Hintergrund bestehen und aus einem Label darauf. Wie muss ich da das Parent bei OnCreate setzen und von was sollte ich die Klasse ableiten?

Delphi-Quelltext

1:
2:
3:
4:
5:
6:

constructor TStyleButton.Create(Owner:TComponent);
begin
 inherited;
 Shape:=TShape.Create(Owner);
 Shape.Parent:=Self;
end;

wenn ich TStyleButton von TButton ableite funktionierts, aber wenn ichs von TLabel/TShape ableiten funzts nicht...Leider funktioniert es auch nicht wenn ich als Parent Owner zuweise.

XION

//EDIT: wenn ich die Zeile mit Parent weglasse, funktionierts, allerdings haben dann meine einstellungen des shapes keine auswirkung :gruebel: :schmoll:

//nee, doch nicht, dann ist nur das Shape von TStyleButton=class(TShape) da...

Martok - Fr 25.08.06 12:09

Also ich würde diesen Button von TControl ableiten. Wobei zu überlegen wäre, ob man nicht das Zeichnen des Texte und der Shape lieber selbst übernimmt. Dann würde sich TGraphicControl anbieten.

Xion - Fr 25.08.06 12:10

TControl funktioniert auch nicht...

Martok - Fr 25.08.06 12:24

Hm, stimmt. TWinControl wäre besser, TControl geht ja nicht als Parent ;)

Wie gesagt, warum überhaupt TShape un TLabel? Das wirst du nur unter nicht unerheblichem Aufwand flackerfrei kriegen. Außerdem möchtest du bestimmt einen transparenten Hintergrund(also zum Beispiel an den Kreisen soll was frei sein).

Es gäbe damit die Möglichkeit, von TShape abzuleiten und die Paint-Procedure zu überschreiben. In dieser würdest du dann den Text des Buttons malen.

Xion - Fr 25.08.06 12:59

ok, thx
ich machs erstmal so mit Shape und Label um etwas erfahrung zu sammeln, weil das meine erste Komponente ist. Danach probier ich dann mal mit der Paint-Proc

Code compiliert zwar aber ich hab immernoch nix hingemalt bekommen

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

constructor TStyleButton.Create(Owner:TComponent);
begin
 inherited;
 Shape:=TShape.Create(Owner);
 Shape.Parent:=Self;
 Shape.Pen.Color:=ClYellow;
 Shape.Brush.Color:=clBlack;
 Shape.Width:=150;
 Shape.Height:=25;
 Shape.Top:=100;
 Shape.Left:=0;
 Shape.Shape:=stRoundRect;
end;

procedure TForm1.FormCreate(Sender: TObject);
var StyleBut: TStyleButton;
begin
 StyleBut:=TStyleButton.Create(Form1);
 StyleBut.Parent:=Form1;

es müsste doch jetzt eigentlich in der oberen ecke das shape zu sehen sein, oder?

Martok - Fr 25.08.06 13:25

In der oberen Ecke des Buttons. Die Koordinaten beziehen sich immer auf den Parent. daher kann es sein (bzw.wird es sein), dass das Shape einfach außerhalb des Button liegt. Nimm also Left:= 0 und Top:= 0, dann solltest du zumindest was sehen.

Xion - Fr 25.08.06 13:36

Ich mache ja im Constructor nur ein Shape und, dass will ich dann bei Form1.OnCreate auf die Form setzen. Dann soll an der Position 0/100 der TStyleButton auf der Form sitzen. Und nicht auf der Position 0/100 auf dem TWinControl...wenn ich jetzt schreibe

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:

procedure TForm1.FormCreate(Sender: TObject);
var StyleBut: TStyleButton;
begin
 StyleBut:=TStyleButton.Create(Form1);
 StyleBut.Parent:=Form1;
 StyleBut.Width:=200;
 StyleBut.Height:=200;

dann geht es, weil ich das TWinControl groß genug gezogen hab. Ich könnte natürlich jetzt einfach im Constructor das TWinControl auf die Größe des Shapes setzten, aber geht das nicht auch einfach so, dass ich das Shape gleich auf die Form setze?

Martok - Fr 25.08.06 14:07

Das würde gehen, in dem du als Parent:= TWinControl(Owner) nimmst, allerdings wäre das sinnlos.
Ich würde das so lösen:

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

TStyleButton=class(TWinControl)

public
  procedure Resize; override;   //wird bei Groessenaenderung aufgerufen
....
procedure TStyleButton.Resize;
begin
  inherited;  //geerbte Methode aufrufen
  Shape.BoundsRect:= ClientRect;  //Shape an dem Control ausrichten
end;

Mittlerweile hab ich aber den Eindruck, das das Ableiten von TShape einfacher wäre. Controls ineinander Verpacken ist immer ein wenig schwieriger.

Xion - Fr 25.08.06 14:33

ok, ich probiers mal mit TShape...

Thx für deine Hilfe :zustimm:

Xion - Di 29.08.06 14:47

Hab jetzt folgendes:

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:

unit StyleMods;

interface

uses Messages,StdCtrls,ExtCtrls,Graphics,Classes,Controls,Windows;




type
   TStyleButton=class(TShape)
    public
     FBackLeaveColor: TColor;
     FBackEnterColor: TColor;
     FFontLeaveColor: TColor;
     FFontEnterColor: TColor;
     FCaption: String;
     constructor Create(Owner: TComponent); override;
     destructor Destroy; override;
     property BackLeaveColor: TColor read FBackLeaveColor write FBackLeaveColor;
     property BackEnterColor: TColor read FBackEnterColor write FBackEnterColor;
     property FontLeaveColor: TColor read FFontLeaveColor write FFontLeaveColor;
     property FontEnterColor: TColor read FFontEnterColor write FFontEnterColor;
     property Caption: String read FCaption write FCaption;
     property OnClick;
    protected
    private
     procedure OnMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
     procedure OnMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
     procedure PaintText(BackColor,FontColor: TColor);
end;


procedure Register;
     
implementation

procedure Register;
begin
  RegisterComponents('StyleMods', [TStyleButton]);
end;


//TStyleButton
constructor TStyleButton.Create(Owner:TComponent);
begin
 inherited;
 BackEnterColor:=cLSkyBlue;
 FontEnterColor:=clBlack;  
 BackLeaveColor:=cLBlack;
 FontLeaveColor:=clLime;

 Parent:=TWinControl(Owner);
 Pen.Color:=ClYellow;
 Brush.Color:=BackLeaveColor;
 Width:=150;
 Height:=25;
 Shape:=stRoundRect;

 PaintText(BackLeaveColor,FontLeaveColor);
end;

procedure TStyleButton.OnMouseEnter(var Message: TMessage);
begin
 PaintText(BackEnterColor,FontEnterColor);
end;

procedure TStyleButton.OnMouseLeave(var Message: TMessage);
begin
 PaintText(BackLeaveColor,FontLeaveColor);
end;

procedure TStyleButton.PaintText(BackColor,FontColor: TColor);
var Rect: TRect;S: String;
begin
 Rect.Left:=2;
 Rect.Top:=2;
 Rect.BottomRight.X:=Self.Width-2;
 Rect.BottomRight.Y:=Self.Height-2;
 Self.Canvas.MoveTo(2,2);
 Self.Canvas.Brush.Color:=BackColor;
 Self.Canvas.Pen.Color:=BackColor;
 Self.Canvas.FillRect(Rect);
 Self.Canvas.Font.Color:=FontColor;
 Self.Canvas.Font.Name:='Agency FB';
 Self.Canvas.Font.Size:=-15;
 Self.Canvas.Font.Style:=[fsBold];
 DrawText(Canvas.Handle,PChar(s),Length(Caption),Rect,DT_SINGLELINE or DT_CENTER or DT_VCENTER);
end;

destructor TStyleButton.Destroy;
begin
  inherited Destroy;
end;

end.

Ziel:
Ein Shape mit Caption, das mit MouseLeave und MouseOver Effekten den Button ersetzen soll.

Probleme:
1. Im Object Inspector will ich den ganzen Unsinn wie Align usw. nicht haben, momentan nur
BackLeaveColor: TColor;
BackEnterColor: TColor;
FontLeaveColor: TColor;
FontEnterColor: TColor;
Caption: String;

2. Wenn ich auf mein Formular zur Design-Zeit den StyleButton setze und z.B. einen normalen Button, gibt es aufgrund des .Canvas einen unschönen Effekt: Der Button wird dann auch farbig angemalt, wenn der StyleButton dahinterliegt. Wenn ich den StyleButton verschiebe ist der Button immernoch bemalt :(

3. Die Effekt OnMouseLeave und OnMouseEnter sind schon während der Design-Zeit aktiv.

ich will keine fertigen Komponenten von Jedi o.ä., ich will nämlich was dazulernen ;)

THX für alle die antworten

Xion

lotus - So 28.01.07 23:14

Hallo!
Genau wegen dieser Frage habe ich mich im Forum angemeldet...war ich also net der erste mit dieser Idee...

Meine Fragen:

1. Ist es möglich in die neue Klasse (Vorfahre: TShape) immer ein TLabel zu integrieren (wie z.B bei TLabeledEdit)?

2. Hat TShape die Eigenschaft TCanvas?

...

naja das wars erstmal

Mfg, Forumsneuling lotus

Xion - Di 30.01.07 17:51

also, ich machs jetzt immer so (funktioniert am besten):

1) eine eigene Klasse machen (die von nichts abgeleitet ist)
2) die gewünschten Compos reinsetzen

somit hast du dann eine Klasse, die mit Shape und Label ist, sie hat zwar keinen Vorfahre, so gehts aber am besten.

TShape hat kein Canvas, müsste man ggf. noch einbauen

Bsp für Lable+Shape

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:

type TStyleButton=class
   private
    Lbl: TLabel;   
    Shape: TShape;
                       
    FActiveBrush: TColor;
    FActiveFont: TColor;
    FCaption: String;   
    FHeight: integer;
    FLeft: integer;
    FParent: TWinControl;
    FPenColor: TColor;
    FTop: integer;
    FUnactiveBrush: TColor;
    FUnactiveFont: TColor;
    FVisible: boolean;
    FWidth: integer;

    FOnButtonClick: TNotifyEvent;
    FOnButtonEnter: TNotifyEvent;
    FOnButtonLeave: TNotifyEvent;

    procedure SetActiveBrush(Value: TColor);
    procedure SetActiveFont(Value: TColor);
    procedure SetCaption(Value: String);
    procedure SetLeft(Value: integer);
    procedure SetParent(Value: TWinControl);
    procedure SetPenColor(Value: TColor);
    procedure SetTop(Value: integer);
    procedure SetUnactiveBrush(Value: TColor);
    procedure SetUnactiveFont(Value: TColor);      
    procedure SetVisible(Value: boolean);
    procedure SetWidth(Value: integer);

    procedure ButtonClick(Sender: TObject);
    procedure ButtonEnter(Sender: TObject);
    procedure ButtonLeave(Sender: TObject);
   public
    constructor Create(AOwner: TComponent);
    destructor Free;
   published

    property ActiveBrush: TColor read FActiveBrush write SetActiveBrush;
    property ActiveFont: TColor read FActiveFont write SetActiveFont;
    property Caption: String read FCaption write SetCaption;
    property Height: integer read FHeight;
    property Left: integer read FLeft write SetLeft;
    property Parent: TWinControl read FParent write SetParent;
    property PenColor: TColor read FPenColor write SetPenColor;
    property Top: integer read FTop write SetTop;
    property UnactiveBrush: TColor read FUnactiveBrush write SetUnactiveBrush;
    property UnactiveFont: TColor read FUnactiveFont write SetUnactiveFont;
    property Visible: boolean read FVisible write SetVisible;
    property Width: integer read FWidth write SetWidth;

    property [url]OnButtonClick[/url]: TNotifyEvent read FOnButtonClick write FOnButtonClick;
    property OnButtonEnter: TNotifyEvent read FOnButtonEnter write FOnButtonEnter;
    property OnButtonLeave: TNotifyEvent read FOnButtonLeave write FOnButtonLeave;
end;

wenn du willst, kann ich dir mal die Unit schicken, dann kannst dirs mal angucken, wie ichs gemacht hab.

lotus - Di 30.01.07 18:46

Ja das wäre nett...habe noch ein paar Probleme... -)

lotus

Xion - Mi 31.01.07 14:20

UStyleButton (aus UMenu)

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:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:

{******************************************************}
{                                                      }
{                    UStyleButton                      }
{                                                      }
{         Copyright (c) 2006 - Xion-Visions            }
{                                                      }
{                     Including:                       }
{                   -TStyleButton                      }
{******************************************************}

unit UStyleButton;

interface

uses Graphics,ExtCtrls,Classes,Controls,StdCtrls,Gauges,Forms,SysUtils;

type TStyleButton=class
   private
    Lbl: TLabel;
    Shape: TShape;
                       
    FActiveBrush: TColor;
    FActiveFont: TColor;
    FCaption: String;   
    FHeight: integer;
    FLeft: integer;
    FParent: TWinControl;
    FPenColor: TColor;
    FTop: integer;
    FUnactiveBrush: TColor;
    FUnactiveFont: TColor;
    FVisible: boolean;
    FWidth: integer;

    FOnButtonClick: TNotifyEvent;
    FOnButtonEnter: TNotifyEvent;
    FOnButtonLeave: TNotifyEvent;

    procedure SetActiveBrush(Value: TColor);
    procedure SetActiveFont(Value: TColor);
    procedure SetCaption(Value: String);
    procedure SetLeft(Value: integer);
    procedure SetParent(Value: TWinControl);
    procedure SetPenColor(Value: TColor);
    procedure SetTop(Value: integer);
    procedure SetUnactiveBrush(Value: TColor);
    procedure SetUnactiveFont(Value: TColor);      
    procedure SetVisible(Value: boolean);
    procedure SetWidth(Value: integer);

    procedure ButtonClick(Sender: TObject);
    procedure ButtonEnter(Sender: TObject);
    procedure ButtonLeave(Sender: TObject);
   public
    constructor Create(AOwner: TComponent);
    destructor Free;
   published

    property ActiveBrush: TColor read FActiveBrush write SetActiveBrush;
    property ActiveFont: TColor read FActiveFont write SetActiveFont;
    property Caption: String read FCaption write SetCaption;
    property Height: integer read FHeight;
    property Left: integer read FLeft write SetLeft;
    property Parent: TWinControl read FParent write SetParent;
    property PenColor: TColor read FPenColor write SetPenColor;
    property Top: integer read FTop write SetTop;
    property UnactiveBrush: TColor read FUnactiveBrush write SetUnactiveBrush;
    property UnactiveFont: TColor read FUnactiveFont write SetUnactiveFont;
    property Visible: boolean read FVisible write SetVisible;
    property Width: integer read FWidth write SetWidth;

    property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
    property OnButtonEnter: TNotifyEvent read FOnButtonEnter write FOnButtonEnter;
    property OnButtonLeave: TNotifyEvent read FOnButtonLeave write FOnButtonLeave;
end;

implementation

{##########################################}
{------------- TStyleButton ------------------}
constructor TStyleButton.Create(AOwner: TComponent);
begin
 Shape:=TShape.Create(AOwner);
 FHeight:=25;
 Shape.Height:=FHeight;
 Shape.Shape:=stRoundRect;
 Lbl:=TLabel.Create(AOwner);
 Lbl.Height:=Shape.Height-4;
 Lbl.AutoSize:=False;
 Lbl.Alignment:=taCenter;
 Lbl.OnClick:=ButtonClick;
 Lbl.OnMouseEnter:=ButtonEnter;
 Lbl.OnMouseLeave:=ButtonLeave;    
 Lbl.Font.Name:='Agency FB';
 Lbl.Font.Size:=-16;
 Lbl.Font.Style:=[fsBold];

 //default-Werte:
 Top:=0;
 Left:=0;        
 Width:=100;
 PenColor:=ClYellow;
 UnactiveBrush:=clBlack;
 UnactiveFont:=clLime;
 ActiveBrush:=clSkyBlue;
 ActiveFont:=clBlack;
 Caption:='FREE';
 Visible:=True;
end;

destructor TStyleButton.Free;
begin
 Lbl.Free;
 Shape.Free;
end;

{******** SetProcs *********}
procedure TStyleButton.SetActiveBrush(Value: TColor);
begin
 if Value<>FActiveBrush then
  begin
   FActiveBrush:=Value;
  end;
end;

procedure TStyleButton.SetActiveFont(Value: TColor);
begin
 if Value<>FActiveFont then
  begin
   FActiveFont:=Value;
  end;
end;

procedure TStyleButton.SetCaption(Value: String);
begin
 if Value<>FCaption then
  begin
   FCaption:=Value;
   Lbl.Caption:=Value;
  end;
end;

procedure TStyleButton.SetLeft(Value: integer);
begin
 if Value<>FLeft then
  begin
   FLeft:=Value;
   Lbl.Left:=Value+2;
   Shape.Left:=Value;
  end;
end;

procedure TStyleButton.SetParent(Value: TWinControl);
begin
 if Value<>FParent then
  begin
   FParent:=Value;
   Shape.Parent:=Value;
   Lbl.Parent:=Value;
  end;
end;

procedure TStyleButton.SetPenColor(Value: TColor);
begin
 FPenColor:=Value;
 Shape.Pen.Color:=Value;
end;

procedure TStyleButton.SetTop(Value: integer);
begin
 if Value<>FTop then
  begin
   FTop:=Value;
   Lbl.Top:=Value+2;
   Shape.Top:=Value;
  end;
end;

procedure TStyleButton.SetUnactiveBrush(Value: TColor);
begin
 FUnactiveBrush:=Value;
 Shape.Brush.Color:=Value;
 Lbl.Color:=Value;
end;

procedure TStyleButton.SetUnactiveFont(Value: TColor);
begin
 FUnactiveFont:=Value;
 Lbl.Font.Color:=Value;
end;

procedure TStyleButton.SetVisible(Value:boolean);
begin
 if Value<>FVisible then
  begin
   FVisible:=Value;
   Lbl.Visible:=Value;   
   Shape.Visible:=Value;
  end;
end;

procedure TStyleButton.SetWidth(Value: integer);
begin
 if Value<>FWidth then
  begin
   FWidth:=Value;
   Shape.Width:=Value;
   Lbl.Width:=Value-4;
  end;
end;
{******** UpDateProcs *********}
{******** Sonstige *********}
procedure TStyleButton.ButtonClick(Sender: TObject);
begin
 if Assigned(OnButtonClick) then
  OnButtonClick(Self);
end;

procedure TStyleButton.ButtonEnter(Sender: TObject);
begin
 if Assigned(OnButtonEnter) then
  OnButtonEnter(Self);    
 Lbl.Color:=FActiveBrush;
 Lbl.Font.Color:=FActiveFont;
end;

procedure TStyleButton.ButtonLeave(Sender: TObject);
begin
 if Assigned(OnButtonLeave) then
  OnButtonLeave(Self);
 Lbl.Color:=UnactiveBrush;
 Lbl.Font.Color:=UnactiveFont;
end;
{##########################################}


end.


{##########################################}

{Code example:
var StyleBut: TStyleButton;

 StyleBut:=TStyleButton.Create(Form1);
 StyleBut.Parent:=Form1;
 StyleBut.Caption:='Style1';
 StyleBut.PenColor:=clLime;
 StyleBut.ActiveBrush:=clLime;
 StyleBut.ActiveFont:=clBlack;
 StyleBut.UnactiveBrush:=clBlack;
 StyleBut.UnactiveFont:=clLime;
}

Für Fragen bin ich natürlich immer da ;)

(Diese Komponente ist nicht im OI zu platzieren, da ich aber sowieso das meiste dynamisch erstelle ist das für mich kein problem. Probier einfach mal das Code-example aus, vergess aber nicht UStyleButton dann einzubinden ;) )

lotus - Sa 10.02.07 15:47

Danke! :)

Hab mich mal damit beschäftigt und jetzt folgendes:

Wenn ich TShapeButton.create (in steht ist Label:=TLabel.create) aufrufe kann ich auf das Label zugreifen und alles ist i.o.

Wenn die Komponente jedoch einfach in den Objektinspektor lege, dann wird das Label nicht angezeigt und es kommen Zugriffsfehler, wenn ich darauf zugreifen will..
Was muss ich da anders machen?

Hab die Komponente übrigens von TShape abgeleitet!

Danke im Voraus, lotus

lotus - Mi 14.02.07 23:13

Weiß das keiner? :(