1: unit Subut;
2: 
3: interface
4: 
5: uses
6:   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
7:   Forms, Dialogs, ExtCtrls, Menus;
8: 
9: type
10: 
11:   TStatus = (stEin, stAus);
12: 
13:   TSuperButton = class(TCustomPanel)
14: 
15:   private          { Private-Deklarationen }
16: 
17:     FCaptionAus, FCaptionEin: string;
18:     FColorAus, FColorEin: TColor;
19:     FFontColorAus, FFontColorEin: TColor;
20:     FModalResult: TModalResult;
21:     FStatus: TStatus;
22:     FToggle: boolean;
23:     procedure SetCaptionAus(ACaption: string);
24:     procedure SetCaptionEin(ACaption: string);
25:     procedure SetColorAus(AColor: TColor);
26:     procedure SetColorEin(AColor: TColor);
27:     procedure SetFontColorAus(AFontColor: TColor);
28:     procedure SetFontColorEin(AFontColor: TColor);
29:     procedure SetStatus(AStatus: TStatus);
30:     procedure SetToggle(AToggle: boolean);
31: 
32:   protected        { Protected-Deklarationen }
33: 
34:   public           { Public-Deklarationen }
35:     constructor Create(AOwner: TComponent); override;
36:     procedure Loaded; override;
37:     procedure Click; override;
38:     procedure MouseDown(Button:TMouseButton; Shift:TShiftState; X,Y:integer); override;
39:     procedure MouseUp(Button:TMouseButton; Shift:TShiftState; X,Y:integer); override;
40: 
41:   published        { Published-Deklarationen }
42:                    { Im Entwurfsmodus im Objektinspektor verfgbar }
43:     property CaptionAus: string read FCaptionAus write SetCaptionAus;
44:     property CaptionEin: string read FCaptionEin write SetCaptionEin;
45:     property ColorAus: TColor read FColorAus write SetColorAus default clRed;
46:     property ColorEin: TColor read FColorEin write SetColorEin default clLime;
47:     property FontColorAus: TColor read FFontColorAus write SetFontColorAus default clBlue;
48:     property FontColorEin: TColor read FFontColorEin write SetFontColorEin default clYellow;
49:     property ModalResult: TModalResult read FModalResult write FModalResult default 0;
50:     property Status: TStatus read FStatus write SetStatus default stAus;
51:     property Toggle: boolean read FToggle write SetToggle default False;
52: 
53:     { gegenber TButton fehlen noch folgende
54:       Eigenschaften:  Cancel, Default
55:       Ereignisse:     OnKeyDown, OnKeyPress, OnKeyUp }
56: 
57:     { Aus EXTCTRLS.PAS die Eigenschaften,
58:       die von TPanel=class(TCustomPanel) freigegeben wurden }
59:     property Align;
60:     property Alignment;
61:     property BevelInner;
62:     property BevelOuter;
63:     property BevelWidth;
64:     property BorderWidth;
65:     property BorderStyle;
66:   { property Caption;             ersetzt durch CaptionAus & CapitonEin }
67:   { property Color;               ersetzt durch ColorAus & ColorEin }
68:   { property Ctl3D;               in TButton nicht vorhanden }
69:     property DragCursor;
70:     property DragMode;
71:     property Enabled;
72:     property Font;
73:   { property Locked;              in TButton nicht vorhanden }
74:   { property ParentColor;         in TButton nicht vorhanden }
75:   { property ParentCtl3D;         in TButton nicht vorhanden }
76:     property ParentFont;
77:     property ParentShowHint;
78:     property PopupMenu;        
79:     property ShowHint;
80:     property TabOrder;
81:     property TabStop;
82:     property Visible;
83:     { Ereignisse }
84:     property OnClick;
85:   { property OnDblClick;          in TButton nicht vorhanden }
86:     property OnDragDrop;
87:     property OnDragOver;
88:     property OnEndDrag;
89:     property OnEnter;
90:     property OnExit;
91:     property OnMouseDown;
92:     property OnMouseMove;
93:     property OnMouseUp;
94:   { property OnResize;            in TButton nicht vorhanden }
95: 
96:   end;
97: 
98: procedure Register;
99: 
100: {==============================================================================}
101: implementation
102: 
103: constructor TSuperButton.Create(AOwner: TComponent);
104: begin
105:   inherited Create(AOwner);  {wie er beim Einfgen ins Formular erscheint}
106:   {  ControlStyle := ... ev. notwendig }
107:   Height := 33;              { Anpassungen an TButton }
108:   Width  := 89;              { -"- }
109:   BevelInner := bvRaised;
110:   BevelOuter := bvRaised;
111:   FCaptionAus := 'AUS';
112:   FCaptionEin := 'EIN';
113:   Caption := FCaptionAus;
114:   FColorAus := clRed;
115:   FColorEin := clLime;
116:   Color := FColorAus;
117:   FFontColorAus := clYellow;
118:   FFontColorEin := clBlue;
119:   Font.Color := FFontColorAus;
120:   FStatus := stAus;
121:   FToggle := False;
122: end;
123: 
124: procedure TSuperButton.SetStatus(AStatus: TStatus);
125: begin
126:   if AStatus <> FStatus then
127:   begin
128:     FStatus := AStatus;
129:     if AStatus = stEin
130:     then begin
131:            BevelInner := bvLowered;
132:            BevelOuter := bvLowered;
133:            Caption := FCaptionEin;
134:            Color := FColorEin;
135:            Font.Color := FFontColorEin;
136:          end
137:     else begin
138:            BevelInner := bvRaised;
139:            BevelOuter := bvRaised;
140:            Caption := FCaptionAus;
141:            Color := FColorAus;
142:            Font.Color := FFontColorAus;
143:          end;
144:     Invalidate;
145:   end;
146: end;
147: 
148: procedure TSuperButton.SetToggle(AToggle: boolean);
149: begin
150:   if AToggle <> FToggle then FToggle := AToggle;
151: end;
152: 
153: procedure TSuperButton.SetCaptionAus(ACaption: string);
154: begin
155:   if ACaption <> FCaptionAus then
156:   begin
157:     FCaptionAus := ACaption;
158:     if FStatus = stAus then
159:     begin
160:       Caption := ACaption;
161:       Invalidate;
162:     end;
163:   end;
164: end;
165: 
166: procedure TSuperButton.SetCaptionEin(ACaption: string);
167: begin
168:   if ACaption <> FCaptionEin then
169:   begin
170:     FCaptionEin := ACaption;
171:     if FStatus = stEin then
172:     begin
173:       Caption := ACaption;
174:       Invalidate;
175:     end;
176:   end;
177: end;
178: 
179: procedure TSuperButton.SetColorAus(AColor: TColor);
180: begin
181:   if AColor <> FColorAus then
182:   begin
183:     FColorAus := AColor;
184:     if FStatus = stAus then
185:     begin
186:       Color := AColor;
187:       Invalidate;
188:     end;
189:   end;
190: end;
191: 
192: procedure TSuperButton.SetColorEin(AColor: TColor);
193: begin
194:   if AColor <> FColorEin then
195:   begin
196:     FColorEin := AColor;
197:     if FStatus = stEin then
198:     begin
199:       Color := AColor;
200:       Invalidate;
201:     end;
202:   end;
203: end;
204: 
205: procedure TSuperButton.SetFontColorAus(AFontColor: TColor);
206: begin
207:   if AFontColor <> FFontColorAus then
208:   begin
209:     FFontColorAus := AFontColor;
210:     if FStatus = stAus then
211:     begin
212:       Font.Color := AFontColor;
213:       Invalidate;
214:     end;
215:   end;
216: end;
217: 
218: procedure TSuperButton.SetFontColorEin(AFontColor: TColor);
219: begin
220:   if AFontColor <> FFontColorEin then
221:   begin
222:     FFontColorEin := AFontColor;
223:     if FStatus = stEin then
224:     begin
225:       Font.Color := AFontColor;
226:       Invalidate;
227:     end;
228:   end;
229: end;
230: 
231: procedure TSuperButton.Click;
232: var   Form: TForm;
233: begin
234:   if FToggle
235:   then begin if FStatus = stEin then Status := stAus else Status := stEin;
236:        end
237:   else begin { Codesequenz aus TButton.Click }
238:          Form := GetParentForm(Self);
239:          if Form <> nil then Form.ModalResult := ModalResult;
240:        end;
241:   inherited Click;
242: end;
243: 
244: procedure TSuperButton.MouseDown(Button:TMouseButton; Shift:TShiftState; X,Y:integer);
245: begin
246:   if not FToggle then Status := stEin;
247:   inherited MouseDown(Button, Shift, X, Y );
248: end;
249: 
250: procedure TSuperButton.MouseUp(Button:TMouseButton; Shift:TShiftState; X,Y:integer);
251: begin
252:   if not FToggle then Status := stAus;
253:   inherited MouseUp(Button, Shift, X, Y );
254: end;
255: 
256: procedure TSuperButton.Loaded;
257: begin
258:   inherited Loaded;
259:   if FStatus=stEin
260:   then begin
261:          Caption := FCaptionEin;
262:          Color := FColorEin;
263:          Font.Color := FFontColorEin;
264:        end
265:   else begin
266:          Caption := FCaptionAus;
267:          Color := FColorAus;
268:          Font.Color := FFontColorAus;
269:        end;
270:   Invalidate;
271: end;
272: 
273: procedure Register;
274: begin
275:   RegisterComponents('Beispiele', [TSuperButton]);
276: end;
277: 
278: 
279: end.
280: 
