1 |
|
---|
2 | {ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
3 | º º
|
---|
4 | º Sibyl Portable Component Classes º
|
---|
5 | º º
|
---|
6 | º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
|
---|
7 | º º
|
---|
8 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
|
---|
9 |
|
---|
10 | Unit EXTCTRLS;
|
---|
11 |
|
---|
12 |
|
---|
13 | Interface
|
---|
14 |
|
---|
15 | Uses SysUtils,Classes,Forms,Graphics,Buttons,StdCtrls;
|
---|
16 |
|
---|
17 |
|
---|
18 | Type
|
---|
19 | TShapeType=(stRectangle,stSquare,stRoundRect,stRoundSquare,
|
---|
20 | stEllipse,stCircle,stTriangle);
|
---|
21 |
|
---|
22 | TShape=Class(TControl)
|
---|
23 | Private
|
---|
24 | FTempPen:TPen;
|
---|
25 | FTempBrush:TBrush;
|
---|
26 | FShape:TShapeType;
|
---|
27 | Function GetBrush:TBrush;
|
---|
28 | Function GetPen:TPen;
|
---|
29 | Procedure SetShape(NewShape:TShapeType);
|
---|
30 | Protected
|
---|
31 | Procedure SetupComponent;Override;
|
---|
32 | Procedure SetupShow;Override;
|
---|
33 | Property Canvas;
|
---|
34 | Public
|
---|
35 | Destructor Destroy;Override;
|
---|
36 | Procedure Redraw(Const rec:TRect);Override;
|
---|
37 | Property XAlign;
|
---|
38 | Property XStretch;
|
---|
39 | Property YAlign;
|
---|
40 | Property YStretch;
|
---|
41 | Published
|
---|
42 | Property Align;
|
---|
43 | Property Brush:TBrush Read GetBrush;
|
---|
44 | Property DragCursor;
|
---|
45 | Property DragMode;
|
---|
46 | Property Enabled;
|
---|
47 | Property ParentShowHint;
|
---|
48 | Property Pen:TPen Read GetPen;
|
---|
49 | Property Shape:TShapeType Read FShape Write SetShape;
|
---|
50 | Property ShowHint;
|
---|
51 | Property Visible;
|
---|
52 | Property ZOrder;
|
---|
53 |
|
---|
54 | Property OnCanDrag;
|
---|
55 | Property OnDragDrop;
|
---|
56 | Property OnDragOver;
|
---|
57 | Property OnEndDrag;
|
---|
58 | Property OnMouseClick;
|
---|
59 | Property OnMouseDblClick;
|
---|
60 | Property OnMouseDown;
|
---|
61 | Property OnMouseMove;
|
---|
62 | Property OnMouseUp;
|
---|
63 | Property OnSetupShow;
|
---|
64 | Property OnStartDrag;
|
---|
65 | End;
|
---|
66 |
|
---|
67 |
|
---|
68 | TPaintBox=Class(TControl)
|
---|
69 | Protected
|
---|
70 | Procedure SetupComponent;Override;
|
---|
71 | Public
|
---|
72 | Procedure Redraw(Const rec:TRect);Override;
|
---|
73 | Property XAlign;
|
---|
74 | Property XStretch;
|
---|
75 | Property YAlign;
|
---|
76 | Property YStretch;
|
---|
77 | Published
|
---|
78 | Property Align;
|
---|
79 | Property Color;
|
---|
80 | Property DragCursor;
|
---|
81 | Property DragMode;
|
---|
82 | Property Enabled;
|
---|
83 | Property Font;
|
---|
84 | Property ParentColor;
|
---|
85 | Property ParentPenColor;
|
---|
86 | Property ParentFont;
|
---|
87 | Property ParentShowHint;
|
---|
88 | Property PenColor;
|
---|
89 | Property ShowHint;
|
---|
90 | Property Visible;
|
---|
91 | Property ZOrder;
|
---|
92 |
|
---|
93 | Property OnCanDrag;
|
---|
94 | Property OnClick;
|
---|
95 | Property OnDblClick;
|
---|
96 | Property OnDragDrop;
|
---|
97 | Property OnDragOver;
|
---|
98 | Property OnEndDrag;
|
---|
99 | Property OnFontChange;
|
---|
100 | Property OnMouseClick;
|
---|
101 | Property OnMouseDblClick;
|
---|
102 | Property OnMouseDown;
|
---|
103 | Property OnMouseMove;
|
---|
104 | Property OnMouseUp;
|
---|
105 | Property OnPaint;
|
---|
106 | Property OnSetupShow;
|
---|
107 | Property OnStartDrag;
|
---|
108 | End;
|
---|
109 |
|
---|
110 |
|
---|
111 | TImage=Class(TControl)
|
---|
112 | Private
|
---|
113 | FPicture:TPicture;
|
---|
114 | FNeedBitmap:Boolean;
|
---|
115 | FAutoSize:Boolean;
|
---|
116 | FStretch:Boolean;
|
---|
117 | FCenter:Boolean;
|
---|
118 | FOnChange:TNotifyEvent;
|
---|
119 | Procedure SetStretch(NewValue:Boolean);
|
---|
120 | Procedure SetCenter(NewValue:Boolean);
|
---|
121 | Procedure SetBitmap(NewBitmap:TBitmap);
|
---|
122 | Function GetBitmap:TBitmap;
|
---|
123 | Function GetIcon:TIcon;
|
---|
124 | Procedure SetIcon(NewIcon:TIcon);
|
---|
125 | Function GetGraphic:TGraphic;
|
---|
126 | Procedure SetGraphic(NewGraphic:TGraphic);
|
---|
127 | Procedure PictureChanged(Sender:TObject);
|
---|
128 | Protected
|
---|
129 | Procedure Change;Virtual;
|
---|
130 | Procedure SetupComponent;Override;
|
---|
131 | Procedure SetupShow;Override;
|
---|
132 | Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
|
---|
133 | Property NeedBitmap:Boolean Read FNeedBitmap Write FNeedBitmap;
|
---|
134 | Public
|
---|
135 | Destructor Destroy;Override;
|
---|
136 | Procedure Redraw(Const rec:TRect);Override;
|
---|
137 | Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
|
---|
138 | Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
|
---|
139 | Public
|
---|
140 | Property XAlign;
|
---|
141 | Property XStretch;
|
---|
142 | Property YAlign;
|
---|
143 | Property YStretch;
|
---|
144 | Property Picture:TPicture Read {Get}FPicture;
|
---|
145 | Property Graphic:TGraphic read GetGraphic write SetGraphic;
|
---|
146 | Property Icon:TIcon Read GetIcon Write SetIcon;
|
---|
147 | Published
|
---|
148 | Property Align;
|
---|
149 | Property AutoSize:Boolean Read FAutoSize Write FAutoSize;
|
---|
150 | Property Center:Boolean Read FCenter Write SetCenter;
|
---|
151 | Property DragCursor;
|
---|
152 | Property DragMode;
|
---|
153 | Property Enabled;
|
---|
154 | Property ParentShowHint;
|
---|
155 | Property Bitmap:TBitmap Read GetBitmap Write SetBitmap;
|
---|
156 | Property PopupMenu;
|
---|
157 | Property ShowHint;
|
---|
158 | Property Stretch:Boolean Read FStretch Write SetStretch;
|
---|
159 | Property Visible;
|
---|
160 | Property ZOrder;
|
---|
161 |
|
---|
162 | Property OnCanDrag;
|
---|
163 | Property OnChange:TNotifyEvent read FOnChange write FOnChange;
|
---|
164 | Property OnClick;
|
---|
165 | Property OnDblClick;
|
---|
166 | Property OnDragDrop;
|
---|
167 | Property OnDragOver;
|
---|
168 | Property OnEndDrag;
|
---|
169 | Property OnMouseClick;
|
---|
170 | Property OnMouseDblClick;
|
---|
171 | Property OnMouseDown;
|
---|
172 | Property OnMouseMove;
|
---|
173 | Property OnMouseUp;
|
---|
174 | Property OnSetupShow;
|
---|
175 | Property OnStartDrag;
|
---|
176 | End;
|
---|
177 |
|
---|
178 |
|
---|
179 | {$M+}
|
---|
180 | TBevelShape=(bsBottomLine,bsBox,bsFrame,bsLeftLine,bsRightLine,bsTopLine,
|
---|
181 | bsBorder);
|
---|
182 |
|
---|
183 | TBevelStyle=(bsLowered,bsRaised);
|
---|
184 | {$M-}
|
---|
185 |
|
---|
186 | TBevel=Class(TControl)
|
---|
187 | Private
|
---|
188 | FShape:TBevelShape;
|
---|
189 | FStyle:TBevelStyle;
|
---|
190 | Procedure SetShape(NewShape:TBevelShape);
|
---|
191 | Procedure SetStyle(NewStyle:TBevelStyle);
|
---|
192 | Protected
|
---|
193 | Procedure SetupComponent;Override;
|
---|
194 | Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
|
---|
195 | Public
|
---|
196 | Procedure Redraw(Const rec:TRect);Override;
|
---|
197 | Property XAlign;
|
---|
198 | Property XStretch;
|
---|
199 | Property YAlign;
|
---|
200 | Property YStretch;
|
---|
201 | Published
|
---|
202 | Property Align;
|
---|
203 | Property ParentShowHint;
|
---|
204 | Property PopupMenu;
|
---|
205 | Property Shape:TBevelShape Read FShape Write SetShape;
|
---|
206 | Property ShowHint;
|
---|
207 | Property Style:TBevelStyle Read FStyle Write SetStyle;
|
---|
208 | Property Visible;
|
---|
209 | Property ZOrder;
|
---|
210 |
|
---|
211 | Property OnCommand;
|
---|
212 | Property OnResize;
|
---|
213 | Property OnSetupShow;
|
---|
214 | End;
|
---|
215 |
|
---|
216 |
|
---|
217 | {$M+}
|
---|
218 | TPanelBevel=(bvRaised,bvLowered,bvNone);
|
---|
219 | {$M-}
|
---|
220 |
|
---|
221 | TPanel=Class(TControl)
|
---|
222 | Private
|
---|
223 | FBevelInner:TPanelBevel;
|
---|
224 | FBevelOuter:TPanelBevel;
|
---|
225 | FBevelWidth:LongInt;
|
---|
226 | FBorderStyle:TBorderStyle;
|
---|
227 | FBorderWidth:LongInt;
|
---|
228 | FAlignment:TAlignment;
|
---|
229 | FInterior:TRect;
|
---|
230 | Procedure CMTextChanged(Var Msg:TMessage); Message CM_TEXTCHANGED;
|
---|
231 | Procedure SetBevelInner(NewBevel:TPanelBevel);
|
---|
232 | Procedure SetBevelOuter(NewBevel:TPanelBevel);
|
---|
233 | Procedure SetBevelWidth(NewWidth:LongInt);
|
---|
234 | Procedure SetBorderStyle(NewStyle:TBorderStyle);
|
---|
235 | Procedure SetBorderWidth(NewWidth:LongInt);
|
---|
236 | Procedure SetAlignment(ta:TAlignment);
|
---|
237 | Protected
|
---|
238 | Procedure SetupComponent;Override;
|
---|
239 | Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
|
---|
240 | Procedure DrawText(Const rec:TRect);Virtual;
|
---|
241 | Public
|
---|
242 | Procedure Redraw(Const rec:TRect);Override;
|
---|
243 | Property XAlign;
|
---|
244 | Property XStretch;
|
---|
245 | Property YAlign;
|
---|
246 | Property YStretch;
|
---|
247 | Published
|
---|
248 | Property Align;
|
---|
249 | Property Alignment:TAlignment Read FAlignment Write SetAlignment;
|
---|
250 | Property BevelInner:TPanelBevel Read FBevelInner Write SetBevelInner;
|
---|
251 | Property BevelOuter:TPanelBevel Read FBevelOuter Write SetBevelOuter;
|
---|
252 | Property BevelWidth:LongInt Read FBevelWidth Write SetBevelWidth;
|
---|
253 | Property BorderStyle:TBorderStyle Read FBorderStyle Write SetBorderStyle;
|
---|
254 | Property BorderWidth:LongInt Read FBorderWidth Write SetBorderWidth;
|
---|
255 | Property Caption;
|
---|
256 | Property Color;
|
---|
257 | Property DragCursor;
|
---|
258 | Property DragMode;
|
---|
259 | Property Enabled;
|
---|
260 | Property Font;
|
---|
261 | Property ParentColor;
|
---|
262 | Property ParentPenColor;
|
---|
263 | Property ParentFont;
|
---|
264 | Property ParentShowHint;
|
---|
265 | Property PenColor;
|
---|
266 | Property PopupMenu;
|
---|
267 | Property ShowHint;
|
---|
268 | Property TabOrder;
|
---|
269 | Property TabStop;
|
---|
270 | Property Visible;
|
---|
271 | Property ZOrder;
|
---|
272 |
|
---|
273 | Property OnCanDrag;
|
---|
274 | Property OnClick;
|
---|
275 | Property OnCommand;
|
---|
276 | Property OnDblClick;
|
---|
277 | Property OnDragDrop;
|
---|
278 | Property OnDragOver;
|
---|
279 | Property OnEndDrag;
|
---|
280 | Property OnFontChange;
|
---|
281 | Property OnMouseClick;
|
---|
282 | Property OnMouseDblClick;
|
---|
283 | Property OnMouseDown;
|
---|
284 | Property OnMouseMove;
|
---|
285 | Property OnMouseUp;
|
---|
286 | Property OnPaint;
|
---|
287 | Property OnResize;
|
---|
288 | Property OnSetupShow;
|
---|
289 | Property OnStartDrag;
|
---|
290 | End;
|
---|
291 |
|
---|
292 |
|
---|
293 | TRadioGroup=Class(TGroupBox)
|
---|
294 | Private
|
---|
295 | FItems:TStrings;
|
---|
296 | FRadios:TList;
|
---|
297 | FItemIndex:LongInt;
|
---|
298 | FColumns:LongInt;
|
---|
299 | FOnClick:TNotifyEvent;
|
---|
300 | FIsTabStop:boolean; // radio buttons are tabstops
|
---|
301 | Procedure SetItemIndex(Value:LongInt);
|
---|
302 | Procedure SetColumns(Value:LongInt);
|
---|
303 | Procedure SetItems(Value:TStrings);
|
---|
304 | Procedure SetRadioCount(Value:LongInt);
|
---|
305 | Function GetItemsEnabled(Index:LongInt):Boolean;
|
---|
306 | Procedure SetItemsEnabled(Index:LongInt;Value:Boolean);
|
---|
307 | Procedure UpdateRadios;
|
---|
308 | Procedure ArrangeRadios;
|
---|
309 | Procedure EvItemsChange(Sender:TObject);
|
---|
310 | Procedure EvRadioClick(Sender:TObject);
|
---|
311 | procedure UpdateTabList;
|
---|
312 | Protected
|
---|
313 | Procedure SetupComponent;Override;
|
---|
314 | Procedure SetupShow;Override;
|
---|
315 | Procedure Resize;Override;
|
---|
316 | Procedure FontChange;Override;
|
---|
317 | Procedure Click;Virtual;
|
---|
318 | Procedure ItemIndexChange;Virtual;
|
---|
319 | function GetTabStop:boolean;
|
---|
320 | procedure SetTabStop(Value:boolean);
|
---|
321 | procedure WMFocussing( Var Msg: TMessage ); message WM_FOCUSSING;
|
---|
322 | Public
|
---|
323 | Destructor Destroy;Override;
|
---|
324 | Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
|
---|
325 | Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
|
---|
326 | Property ItemsEnabled[Index:LongInt]:Boolean Read GetItemsEnabled Write SetItemsEnabled;
|
---|
327 | Property XAlign;
|
---|
328 | Property XStretch;
|
---|
329 | Property YAlign;
|
---|
330 | Property YStretch;
|
---|
331 | Published
|
---|
332 | Property Align;
|
---|
333 | Property Caption;
|
---|
334 | Property Color;
|
---|
335 | Property Columns:LongInt Read FColumns Write SetColumns;
|
---|
336 | Property DragCursor;
|
---|
337 | Property DragMode;
|
---|
338 | Property Enabled;
|
---|
339 | Property Font;
|
---|
340 | Property ItemIndex:LongInt Read FItemIndex Write SetItemIndex;
|
---|
341 | Property Items:TStrings Read FItems Write SetItems;
|
---|
342 | Property ParentColor;
|
---|
343 | Property ParentPenColor;
|
---|
344 | Property ParentFont;
|
---|
345 | Property ParentShowHint;
|
---|
346 | Property PenColor;
|
---|
347 | Property ShowHint;
|
---|
348 | Property TabOrder;
|
---|
349 | property TabStop: boolean read GetTabStop write SetTabStop;
|
---|
350 | Property Visible;
|
---|
351 | Property ZOrder;
|
---|
352 |
|
---|
353 | Property OnCanDrag;
|
---|
354 | Property OnClick:TNotifyEvent Read FOnClick Write FOnClick;
|
---|
355 | Property OnDragDrop;
|
---|
356 | Property OnDragOver;
|
---|
357 | Property OnEndDrag;
|
---|
358 | Property OnEnter;
|
---|
359 | Property OnExit;
|
---|
360 | Property OnFontChange;
|
---|
361 | Property OnSetupShow;
|
---|
362 | Property OnStartDrag;
|
---|
363 | End;
|
---|
364 |
|
---|
365 |
|
---|
366 |
|
---|
367 | Function InsertShape(parent:TControl;Left,Bottom,Width,Height:LongInt):TShape;
|
---|
368 | Function InsertImage(parent:TControl;Left,Bottom,Width,Height:LongInt;BitmapId:LongWord):TImage;
|
---|
369 | Function InsertImageName(parent:TControl;Left,Bottom,Width,Height:LongInt;Const BitmapId:String):TImage;
|
---|
370 | Function InsertBevel(parent:TControl;Left,Bottom,Width,Height:LongInt;
|
---|
371 | Shape:TBevelShape;Style:TBevelStyle):TBevel;
|
---|
372 | Function InsertPanel(parent:TControl;Left,Bottom,Width,Height:LongInt;
|
---|
373 | BevelInner:TPanelBevel;BevelOuter:TPanelBevel;BevelWidth:LongInt;
|
---|
374 | Caption:String):TPanel;
|
---|
375 | Function InsertRadioGroup(parent:TControl;Left,Bottom,Width,Height:LongInt;
|
---|
376 | Caption:String):TRadioGroup;
|
---|
377 |
|
---|
378 |
|
---|
379 | Implementation
|
---|
380 |
|
---|
381 |
|
---|
382 | Function InsertShape(parent:TControl;Left,Bottom,Width,Height:LongInt):TShape;
|
---|
383 | Begin
|
---|
384 | Result.Create(parent);
|
---|
385 | Result.SetWindowPos(Left,Bottom,Width,Height);
|
---|
386 | Result.parent := parent;
|
---|
387 | End;
|
---|
388 |
|
---|
389 |
|
---|
390 | Function InsertImage(Parent:TControl;Left,Bottom,Width,Height:LongInt;
|
---|
391 | BitmapId:LongWord):TImage;
|
---|
392 | Var Bitmap:TBitmap;
|
---|
393 | Begin
|
---|
394 | Result.Create(parent);
|
---|
395 | Result.SetWindowPos(Left,Bottom,Width,Height);
|
---|
396 | Bitmap.Create;
|
---|
397 | Bitmap.LoadFromResourceId(BitmapId);
|
---|
398 | Result.Picture.Graphic:=Bitmap;
|
---|
399 | Bitmap.Destroy; {#}
|
---|
400 | Result.Parent := Parent;
|
---|
401 | End;
|
---|
402 |
|
---|
403 | Function InsertImageName(Parent:TControl;Left,Bottom,Width,Height:LongInt;
|
---|
404 | Const BitmapId:String):TImage;
|
---|
405 | Var Bitmap:TBitmap;
|
---|
406 | Begin
|
---|
407 | Result.Create(parent);
|
---|
408 | Result.SetWindowPos(Left,Bottom,Width,Height);
|
---|
409 | Bitmap.Create;
|
---|
410 | Bitmap.LoadFromResourceName(BitmapId);
|
---|
411 | Result.Picture.Graphic:=Bitmap;
|
---|
412 | Bitmap.Destroy; {#}
|
---|
413 | Result.Parent := Parent;
|
---|
414 | End;
|
---|
415 |
|
---|
416 |
|
---|
417 | Function InsertBevel(parent:TControl;Left,Bottom,Width,Height:LongInt;
|
---|
418 | Shape:TBevelShape;Style:TBevelStyle):TBevel;
|
---|
419 | Begin
|
---|
420 | Result.Create(parent);
|
---|
421 | Result.Shape := Shape;
|
---|
422 | Result.Style := Style;
|
---|
423 | Result.SetWindowPos(Left,Bottom,Width,Height);
|
---|
424 | Result.parent := parent;
|
---|
425 | End;
|
---|
426 |
|
---|
427 |
|
---|
428 | Function InsertPanel(parent:TControl;Left,Bottom,Width,Height:LongInt;
|
---|
429 | BevelInner:TPanelBevel;BevelOuter:TPanelBevel;BevelWidth:LongInt;
|
---|
430 | Caption:String):TPanel;
|
---|
431 | Begin
|
---|
432 | Result.Create(parent);
|
---|
433 | Result.BevelInner:=BevelInner;
|
---|
434 | Result.BevelOuter:=BevelOuter;
|
---|
435 | Result.BevelWidth:=BevelWidth;
|
---|
436 | Result.SetWindowPos(Left,Bottom,Width,Height);
|
---|
437 | Result.Caption := Caption;
|
---|
438 | Result.parent := parent;
|
---|
439 | End;
|
---|
440 |
|
---|
441 |
|
---|
442 | Function InsertRadioGroup(parent:TControl;Left,Bottom,Width,Height:LongInt;
|
---|
443 | Caption:String):TRadioGroup;
|
---|
444 | Begin
|
---|
445 | Result.Create(parent);
|
---|
446 | Result.SetWindowPos(Left,Bottom,Width,Height);
|
---|
447 | Result.Caption := Caption;
|
---|
448 | Result.parent := parent;
|
---|
449 | End;
|
---|
450 |
|
---|
451 |
|
---|
452 |
|
---|
453 | {
|
---|
454 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
455 | º º
|
---|
456 | º Speed-Pascal/2 Version 2.0 º
|
---|
457 | º º
|
---|
458 | º Speed-Pascal Component Classes (SPCC) º
|
---|
459 | º º
|
---|
460 | º This section: TShape Class Implementation º
|
---|
461 | º º
|
---|
462 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
463 | º º
|
---|
464 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
465 | }
|
---|
466 |
|
---|
467 | Procedure TShape.SetupComponent;
|
---|
468 | Begin
|
---|
469 | Inherited SetupComponent;
|
---|
470 |
|
---|
471 | Name:='Shape';
|
---|
472 | Height:=100;
|
---|
473 | Width:=100;
|
---|
474 | ParentPenColor:=False;
|
---|
475 | ParentColor:=True;
|
---|
476 | TabStop:=False;
|
---|
477 | ZOrder:=zoBottom;
|
---|
478 | FShape:=stRectangle;
|
---|
479 | FTempBrush.Create(Nil);
|
---|
480 | //FTempBrush.Color := clWhite;
|
---|
481 | FTempPen.Create(Nil);
|
---|
482 | End;
|
---|
483 |
|
---|
484 | Procedure TShape.SetupShow;
|
---|
485 | Begin
|
---|
486 | Inherited SetupShow;
|
---|
487 |
|
---|
488 | Canvas.Brush:=FTempBrush;
|
---|
489 | Canvas.Pen:=FTempPen;
|
---|
490 | End;
|
---|
491 |
|
---|
492 | Destructor TShape.Destroy;
|
---|
493 | Begin
|
---|
494 | Inherited Destroy;
|
---|
495 |
|
---|
496 | FTempBrush.Destroy;
|
---|
497 | FTempPen.Destroy;
|
---|
498 | End;
|
---|
499 |
|
---|
500 | Function TShape.GetBrush:TBrush;
|
---|
501 | Begin
|
---|
502 | If Canvas <> Nil Then Result := Canvas.Brush
|
---|
503 | Else Result := FTempBrush;
|
---|
504 | End;
|
---|
505 |
|
---|
506 | Function TShape.GetPen:TPen;
|
---|
507 | Begin
|
---|
508 | If Canvas <> Nil Then Result := Canvas.Pen
|
---|
509 | Else Result := FTempPen;
|
---|
510 | End;
|
---|
511 |
|
---|
512 | Procedure TShape.SetShape(NewShape:TShapeType);
|
---|
513 | Begin
|
---|
514 | FShape:=NewShape;
|
---|
515 | Invalidate;
|
---|
516 | End;
|
---|
517 |
|
---|
518 | Procedure TShape.Redraw(Const rec:TRect);
|
---|
519 | Var SaveColor:TColor;
|
---|
520 | OldPenColor,OldBrushColor:TColor;
|
---|
521 | SaveStyle:TBrushStyle;
|
---|
522 | Radius,middleX,MiddleY,W,H:LongInt;
|
---|
523 | rc:TRect;
|
---|
524 |
|
---|
525 | Procedure DrawTriangle;
|
---|
526 | Begin
|
---|
527 | Canvas.PenPos:=Point(0,0);
|
---|
528 | Canvas.LineTo(Width,0);
|
---|
529 | Canvas.LineTo(Width Div 2,Height);
|
---|
530 | Canvas.LineTo(0,0);
|
---|
531 | End;
|
---|
532 | Begin
|
---|
533 | If Canvas = Nil Then exit;
|
---|
534 | OldPenColor := Canvas.Pen.Color;
|
---|
535 | OldBrushColor := Canvas.Brush.Color;
|
---|
536 |
|
---|
537 | SaveColor:=Canvas.Pen.color;
|
---|
538 |
|
---|
539 | If Canvas.Brush.Style=bsSolid Then Canvas.Pen.color:=Canvas.Brush.color;
|
---|
540 |
|
---|
541 | middleX := ClientWidth Div 2;
|
---|
542 | MiddleY := ClientHeight Div 2;
|
---|
543 |
|
---|
544 | Case FShape Of
|
---|
545 | stTriangle:
|
---|
546 | Begin
|
---|
547 | Canvas.BeginPath;
|
---|
548 | DrawTriangle;
|
---|
549 | Canvas.EndPath;
|
---|
550 | Canvas.FillPath;
|
---|
551 | Canvas.Pen.color:=SaveColor;
|
---|
552 |
|
---|
553 | Canvas.BeginPath;
|
---|
554 | DrawTriangle;
|
---|
555 | Canvas.EndPath;
|
---|
556 | Canvas.OutlinePath;
|
---|
557 |
|
---|
558 | Canvas.BeginPath;
|
---|
559 | DrawTriangle;
|
---|
560 | Canvas.EndPath;
|
---|
561 | Canvas.PathToClipRegion(paDiff);
|
---|
562 | End;
|
---|
563 | stRectangle,stSquare:
|
---|
564 | Begin
|
---|
565 | If FShape=stSquare Then
|
---|
566 | Begin
|
---|
567 | If Width>Height Then
|
---|
568 | Begin
|
---|
569 | rc.Bottom:=0;
|
---|
570 | rc.Top:=Height-1;
|
---|
571 | rc.Left:=(Width-Height) Div 2;
|
---|
572 | rc.Right:=rc.Left+Height;
|
---|
573 | End
|
---|
574 | Else
|
---|
575 | Begin
|
---|
576 | rc.Left:=0;
|
---|
577 | rc.Right:=Width-1;
|
---|
578 | rc.Bottom:=(Height-Width) Div 2;
|
---|
579 | rc.Top:=rc.Bottom+Width;
|
---|
580 | End;
|
---|
581 | End
|
---|
582 | Else rc:=ClientRect;
|
---|
583 |
|
---|
584 | Canvas.BeginPath;
|
---|
585 | Canvas.Rectangle(rc);
|
---|
586 | Canvas.EndPath;
|
---|
587 | Canvas.FillPath;
|
---|
588 | Canvas.Pen.color:=SaveColor;
|
---|
589 |
|
---|
590 | Canvas.BeginPath;
|
---|
591 | Canvas.Rectangle(rc);
|
---|
592 | Canvas.EndPath;
|
---|
593 | Canvas.OutlinePath;
|
---|
594 |
|
---|
595 | Canvas.BeginPath;
|
---|
596 | Canvas.Rectangle(rc);
|
---|
597 | Canvas.EndPath;
|
---|
598 | Canvas.PathToClipRegion(paDiff);
|
---|
599 | End;
|
---|
600 | stRoundRect,stRoundSquare:
|
---|
601 | Begin
|
---|
602 | If FShape=stRoundSquare Then
|
---|
603 | Begin
|
---|
604 | If Width>Height Then
|
---|
605 | Begin
|
---|
606 | rc.Bottom:=0;
|
---|
607 | rc.Top:=Height-1;
|
---|
608 | rc.Left:=(Width-Height) Div 2;
|
---|
609 | rc.Right:=rc.Left+Height;
|
---|
610 | End
|
---|
611 | Else
|
---|
612 | Begin
|
---|
613 | rc.Left:=0;
|
---|
614 | rc.Right:=Width-1;
|
---|
615 | rc.Bottom:=(Height-Width) Div 2;
|
---|
616 | rc.Top:=rc.Bottom+Width;
|
---|
617 | End;
|
---|
618 | End
|
---|
619 | Else rc:=ClientRect;
|
---|
620 |
|
---|
621 | W:=(rc.Right-rc.Left) Div 10;
|
---|
622 | H:=(rc.Top-rc.Bottom) Div 10;
|
---|
623 |
|
---|
624 | Canvas.BeginPath;
|
---|
625 | Canvas.RoundRect(rc,W,H);
|
---|
626 | Canvas.EndPath;
|
---|
627 | Canvas.FillPath;
|
---|
628 | Canvas.Pen.color:=SaveColor;
|
---|
629 |
|
---|
630 | Canvas.BeginPath;
|
---|
631 | Canvas.RoundRect(rc,W,H);
|
---|
632 | Canvas.EndPath;
|
---|
633 | Canvas.OutlinePath;
|
---|
634 |
|
---|
635 | Canvas.BeginPath;
|
---|
636 | Canvas.RoundRect(rc,W,H);
|
---|
637 | Canvas.EndPath;
|
---|
638 | Canvas.PathToClipRegion(paDiff);
|
---|
639 | End;
|
---|
640 | stEllipse:
|
---|
641 | Begin
|
---|
642 | Canvas.BeginPath;
|
---|
643 | Canvas.Ellipse(middleX,MiddleY,middleX-1,MiddleY-1);
|
---|
644 | Canvas.EndPath;
|
---|
645 | Canvas.FillPath;
|
---|
646 | Canvas.Pen.color:=SaveColor;
|
---|
647 |
|
---|
648 | Canvas.BeginPath;
|
---|
649 | Canvas.Ellipse(middleX,MiddleY,middleX-1,MiddleY-1);
|
---|
650 | Canvas.EndPath;
|
---|
651 | Canvas.OutlinePath;
|
---|
652 |
|
---|
653 | Canvas.BeginPath;
|
---|
654 | Canvas.Ellipse(middleX,MiddleY,middleX-1,MiddleY-1);
|
---|
655 | Canvas.EndPath;
|
---|
656 | Canvas.PathToClipRegion(paDiff);
|
---|
657 | End;
|
---|
658 | stCircle:
|
---|
659 | Begin
|
---|
660 | If ClientWidth>ClientHeight Then Radius:=MiddleY
|
---|
661 | Else Radius:=middleX;
|
---|
662 |
|
---|
663 | Canvas.BeginPath;
|
---|
664 | Canvas.Circle(middleX,MiddleY,Radius-1);
|
---|
665 | Canvas.EndPath;
|
---|
666 | Canvas.FillPath;
|
---|
667 | Canvas.Pen.color:=SaveColor;
|
---|
668 |
|
---|
669 | Canvas.BeginPath;
|
---|
670 | Canvas.Circle(middleX,MiddleY,Radius-1);
|
---|
671 | Canvas.EndPath;
|
---|
672 | Canvas.OutlinePath;
|
---|
673 |
|
---|
674 | Canvas.BeginPath;
|
---|
675 | Canvas.Circle(middleX,MiddleY,Radius-1);
|
---|
676 | Canvas.EndPath;
|
---|
677 | Canvas.PathToClipRegion(paDiff);
|
---|
678 | End;
|
---|
679 | End; //Case
|
---|
680 |
|
---|
681 | Canvas.Pen.Color := OldPenColor;
|
---|
682 | Canvas.Brush.Color := OldBrushColor;
|
---|
683 |
|
---|
684 | SaveColor:=Canvas.Pen.color;
|
---|
685 | SaveStyle:=Canvas.Brush.Style;
|
---|
686 |
|
---|
687 | Canvas.Pen.color:=color;
|
---|
688 | Canvas.Brush.Style:=bsSolid;
|
---|
689 | Canvas.Box(rec);
|
---|
690 |
|
---|
691 | Canvas.Pen.color:=SaveColor;
|
---|
692 | Canvas.Brush.Style:=SaveStyle;
|
---|
693 | End;
|
---|
694 |
|
---|
695 |
|
---|
696 | {
|
---|
697 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
698 | º º
|
---|
699 | º Speed-Pascal/2 Version 2.0 º
|
---|
700 | º º
|
---|
701 | º Speed-Pascal Component Classes (SPCC) º
|
---|
702 | º º
|
---|
703 | º This section: TImage Class Implementation º
|
---|
704 | º º
|
---|
705 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
706 | º º
|
---|
707 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
708 | }
|
---|
709 |
|
---|
710 |
|
---|
711 | Procedure TImage.SetupComponent;
|
---|
712 | Begin
|
---|
713 | Inherited SetupComponent;
|
---|
714 |
|
---|
715 | Name:='Image';
|
---|
716 | Caption:=Name;
|
---|
717 | Width:=50;
|
---|
718 | Height:=50;
|
---|
719 | ParentPenColor:=False;
|
---|
720 | ParentColor:=True;
|
---|
721 | CursorTabStop:=False;
|
---|
722 | TabStop:=False;
|
---|
723 | FNeedBitmap:=True;
|
---|
724 | ZOrder:=zoBottom;
|
---|
725 | FAutoSize:=False;
|
---|
726 | FStretch:=True;
|
---|
727 | FCenter:=False;
|
---|
728 |
|
---|
729 | FPicture.Create(Self);
|
---|
730 | FPicture.OnChange := PictureChanged;
|
---|
731 | End;
|
---|
732 |
|
---|
733 | Procedure TImage.Change;
|
---|
734 | Begin
|
---|
735 | If FOnChange<>Nil Then FOnChange(Self);
|
---|
736 | End;
|
---|
737 |
|
---|
738 | Procedure TImage.PictureChanged(Sender:TObject);
|
---|
739 | Begin
|
---|
740 | Change;
|
---|
741 | Invalidate;
|
---|
742 | End;
|
---|
743 |
|
---|
744 |
|
---|
745 | Procedure TImage.SetStretch(NewValue:Boolean);
|
---|
746 | Begin
|
---|
747 | FStretch:=NewValue;
|
---|
748 | Invalidate;
|
---|
749 | End;
|
---|
750 |
|
---|
751 | Procedure TImage.SetCenter(NewValue:Boolean);
|
---|
752 | Begin
|
---|
753 | FCenter:=NewValue;
|
---|
754 | Invalidate;
|
---|
755 | End;
|
---|
756 |
|
---|
757 | Procedure TImage.SetBitmap(NewBitmap:TBitmap);
|
---|
758 | Begin
|
---|
759 | Picture.Bitmap := NewBitmap;
|
---|
760 | End;
|
---|
761 |
|
---|
762 | Function TImage.GetBitmap:TBitmap;
|
---|
763 | Begin
|
---|
764 | If ((Picture.HasFormat(TBitmap))Or(Picture.Empty)) Then
|
---|
765 | Result := Picture.Bitmap
|
---|
766 | Else
|
---|
767 | Result:=Nil;
|
---|
768 | End;
|
---|
769 |
|
---|
770 | Function TImage.GetIcon:TIcon;
|
---|
771 | Begin
|
---|
772 | If ((Picture.HasFormat(TIcon))Or(Picture.Empty)) Then
|
---|
773 | Result := Picture.Icon
|
---|
774 | Else
|
---|
775 | Result:=Nil;
|
---|
776 | End;
|
---|
777 |
|
---|
778 | Procedure TImage.SetIcon(NewIcon:TIcon);
|
---|
779 | Begin
|
---|
780 | Picture.Icon:=NewIcon;
|
---|
781 | End;
|
---|
782 |
|
---|
783 | Function TImage.GetGraphic:TGraphic;
|
---|
784 | Begin
|
---|
785 | Result:=Picture.Graphic;
|
---|
786 | End;
|
---|
787 |
|
---|
788 | Procedure TImage.SetGraphic(NewGraphic:TGraphic);
|
---|
789 | Begin
|
---|
790 | Picture.Graphic:=NewGraphic;
|
---|
791 | End;
|
---|
792 |
|
---|
793 | Procedure TImage.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
|
---|
794 | Begin
|
---|
795 | Inherited MouseDown(Button,ShiftState,X,Y);
|
---|
796 |
|
---|
797 | If Button = mbLeft Then
|
---|
798 | If Form Is TForm Then
|
---|
799 | Begin
|
---|
800 | Form.BringToFront;
|
---|
801 |
|
---|
802 | LastMsg.Handled:=True; {!!}
|
---|
803 | LastMsg.Result:=0;
|
---|
804 | End;
|
---|
805 | End;
|
---|
806 |
|
---|
807 | Procedure TImage.Redraw(Const rec:TRect);
|
---|
808 | Var rc:TRect;
|
---|
809 | X,Y:LongInt;
|
---|
810 | aGraphic:TGraphic;
|
---|
811 | Label proceed;
|
---|
812 | Begin
|
---|
813 | If Canvas = Nil Then Exit;
|
---|
814 |
|
---|
815 | If FPicture.Graphic <> Nil Then
|
---|
816 | If not FPicture.Graphic.Empty Then
|
---|
817 | Begin
|
---|
818 | aGraphic := FPicture.Graphic;
|
---|
819 | //clear background for icons and pointers
|
---|
820 | If (aGraphic Is TIcon)
|
---|
821 | Or (aGraphic Is TPointer)
|
---|
822 | Or (aGraphic Is TMetaFile) Then
|
---|
823 | Inherited Redraw(rec);
|
---|
824 | goto proceed; // what is the 60's - AaronL
|
---|
825 | End;
|
---|
826 |
|
---|
827 | Inherited Redraw(rec);
|
---|
828 |
|
---|
829 | If Designed Then
|
---|
830 | Begin
|
---|
831 | Canvas.DeleteClipRegion;
|
---|
832 | Canvas.Brush.color:=color;
|
---|
833 | Canvas.Pen.color:=clBlack;
|
---|
834 | Canvas.TextOut(4,4,Name);
|
---|
835 | rc.Left:=1;
|
---|
836 | rc.Top:=Height-1;
|
---|
837 | rc.Bottom:=1;
|
---|
838 | rc.Right:=Width-1;
|
---|
839 | Canvas.Rectangle(rc);
|
---|
840 | End;
|
---|
841 | Exit;
|
---|
842 |
|
---|
843 | proceed:
|
---|
844 | {If aGraphic Is TBitmap Then
|
---|
845 | Bitmap.RealizePalette(Canvas);}
|
---|
846 | If Stretch Then Canvas.StretchDraw(0,0,Width,Height,aGraphic)
|
---|
847 | Else If ((Center)And(aGraphic.Width<=Width)And(aGraphic.Height<=Height)) Then
|
---|
848 | Begin
|
---|
849 | X:=Width Div 2;
|
---|
850 | Y:=Height Div 2;
|
---|
851 | Dec(X,aGraphic.Width Div 2);
|
---|
852 | Dec(Y,aGraphic.Height Div 2);
|
---|
853 | Canvas.Draw(X,Y,aGraphic);
|
---|
854 | rc.Left:=X;
|
---|
855 | rc.Right:=X+aGraphic.Width-1;
|
---|
856 | rc.Bottom:=Y;
|
---|
857 | rc.Top:=Y+aGraphic.Height-1;
|
---|
858 | Canvas.ExcludeClipRect(rc);
|
---|
859 | Inherited Redraw(rec);
|
---|
860 | End
|
---|
861 | Else
|
---|
862 | Begin
|
---|
863 | Canvas.Draw(0,0,aGraphic);
|
---|
864 | rc.Left:=0;
|
---|
865 | rc.Right:=aGraphic.Width-1;
|
---|
866 | rc.Bottom:=0;
|
---|
867 | rc.Top:=aGraphic.Height-1;
|
---|
868 | Canvas.ExcludeClipRect(rc);
|
---|
869 | Inherited Redraw(rec);
|
---|
870 | End;
|
---|
871 | End;
|
---|
872 |
|
---|
873 | Procedure TImage.SetupShow;
|
---|
874 | Var needBMP:Boolean;
|
---|
875 | aBMP:TBitmap;
|
---|
876 | Begin
|
---|
877 | needBmp := FALSE;
|
---|
878 |
|
---|
879 | If Designed Then
|
---|
880 | If FNeedBitmap Then
|
---|
881 | If ComponentState * [csDetail,csLoaded] = [] Then needBmp := TRUE;
|
---|
882 |
|
---|
883 | If FPicture.Graphic <> Nil Then
|
---|
884 | If not FPicture.Graphic.Empty Then needBMP := FALSE;
|
---|
885 |
|
---|
886 |
|
---|
887 | If needBMP Then
|
---|
888 | Begin
|
---|
889 | aBMP := Bitmap;
|
---|
890 |
|
---|
891 | If CallClassPropertyEditor(aBMP) = peOk Then
|
---|
892 | Begin
|
---|
893 | Width := aBMP.Width;
|
---|
894 | Height := aBMP.Height;
|
---|
895 | End
|
---|
896 | Else
|
---|
897 | Begin
|
---|
898 | //aBMP.Destroy;
|
---|
899 | Bitmap := Nil;
|
---|
900 | End;
|
---|
901 | End;
|
---|
902 |
|
---|
903 | {$IFDEF OS2}
|
---|
904 | If FPicture.Graphic Is TBitmap Then
|
---|
905 | Bitmap.RealizePalette(Canvas);
|
---|
906 | {$ENDIF}
|
---|
907 |
|
---|
908 | Inherited SetupShow;
|
---|
909 | End;
|
---|
910 |
|
---|
911 | Destructor TImage.Destroy;
|
---|
912 | Begin
|
---|
913 | If FPicture <> Nil Then
|
---|
914 | Begin
|
---|
915 | FPicture.Destroy;
|
---|
916 | FPicture := Nil;
|
---|
917 | End;
|
---|
918 |
|
---|
919 | Inherited Destroy;
|
---|
920 | End;
|
---|
921 |
|
---|
922 | Procedure TImage.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
|
---|
923 | Begin
|
---|
924 | If ResName = rnPicture Then
|
---|
925 | Begin
|
---|
926 | If DataLen <> 0 Then Bitmap.ReadSCUResource(rnBitmap,Data,DataLen);
|
---|
927 | End
|
---|
928 | Else Inherited ReadSCUResource(ResName,Data,DataLen);
|
---|
929 | End;
|
---|
930 |
|
---|
931 |
|
---|
932 | Function TImage.WriteSCUResource(Stream:TResourceStream):Boolean;
|
---|
933 | Begin
|
---|
934 | Result := Inherited WriteSCUResource(Stream);
|
---|
935 | If Not Result Then Exit;
|
---|
936 |
|
---|
937 | If FPicture.Graphic Is TBitmap
|
---|
938 | Then Result := Bitmap.WriteSCUResourceName(Stream,rnPicture);
|
---|
939 | End;
|
---|
940 |
|
---|
941 |
|
---|
942 | {
|
---|
943 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
944 | º º
|
---|
945 | º Speed-Pascal/2 Version 2.0 º
|
---|
946 | º º
|
---|
947 | º Speed-Pascal Component Classes (SPCC) º
|
---|
948 | º º
|
---|
949 | º This section: TBevel Class Implementation º
|
---|
950 | º º
|
---|
951 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
952 | º º
|
---|
953 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
954 | }
|
---|
955 |
|
---|
956 | Procedure TBevel.SetupComponent;
|
---|
957 | Begin
|
---|
958 | Inherited SetupComponent;
|
---|
959 |
|
---|
960 | Name:='Bevel';
|
---|
961 | Height:=100;
|
---|
962 | Width:=100;
|
---|
963 | ParentPenColor:=True;
|
---|
964 | ParentColor:=True;
|
---|
965 | CursorTabStop:=False;
|
---|
966 | TabStop:=False;
|
---|
967 | ZOrder:=zoBottom;
|
---|
968 | FShape:=bsBox;
|
---|
969 | FStyle:=bsLowered;
|
---|
970 | Include(ComponentState, csAcceptsControls);
|
---|
971 | End;
|
---|
972 |
|
---|
973 | Procedure TBevel.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
|
---|
974 | Begin
|
---|
975 | Inherited MouseDown(Button,ShiftState,X,Y);
|
---|
976 |
|
---|
977 | If Button = mbLeft Then
|
---|
978 | If Form Is TForm Then
|
---|
979 | Begin
|
---|
980 | Form.BringToFront;
|
---|
981 |
|
---|
982 | LastMsg.Handled:=True; {!!}
|
---|
983 | LastMsg.Result:=0;
|
---|
984 | End;
|
---|
985 | End;
|
---|
986 |
|
---|
987 | Procedure TBevel.SetShape(NewShape:TBevelShape);
|
---|
988 | Begin
|
---|
989 | FShape := NewShape;
|
---|
990 | If Handle <> 0 Then Invalidate;
|
---|
991 | End;
|
---|
992 |
|
---|
993 | Procedure TBevel.SetStyle(NewStyle:TBevelStyle);
|
---|
994 | Begin
|
---|
995 | FStyle := NewStyle;
|
---|
996 | If Handle <> 0 Then Invalidate;
|
---|
997 | End;
|
---|
998 |
|
---|
999 | Procedure TBevel.Redraw(Const rec:TRect);
|
---|
1000 | Var rc1:TRect;
|
---|
1001 | RaisedColor:TColor;
|
---|
1002 | LoweredColor:TColor;
|
---|
1003 | Begin
|
---|
1004 | If Canvas = Nil Then Exit;
|
---|
1005 | Inherited Redraw(rec);
|
---|
1006 |
|
---|
1007 | rc1 := ClientRect;
|
---|
1008 |
|
---|
1009 | If FStyle=bsRaised Then
|
---|
1010 | Begin
|
---|
1011 | RaisedColor:=clWhite;
|
---|
1012 | LoweredColor:=clDkGray;
|
---|
1013 | End
|
---|
1014 | Else
|
---|
1015 | Begin
|
---|
1016 | RaisedColor:=clDkGray;
|
---|
1017 | LoweredColor:=clWhite;
|
---|
1018 | End;
|
---|
1019 |
|
---|
1020 | Case FShape Of
|
---|
1021 | bsBottomLine:
|
---|
1022 | Begin
|
---|
1023 | Canvas.Pen.color:=LoweredColor;
|
---|
1024 | Canvas.Line(rc1.Left,rc1.Bottom,rc1.Right,rc1.Bottom);
|
---|
1025 | Inc(rc1.Bottom);
|
---|
1026 | Canvas.Pen.color:=RaisedColor;
|
---|
1027 | Canvas.Line(rc1.Left,rc1.Bottom,rc1.Right,rc1.Bottom);
|
---|
1028 | End;
|
---|
1029 | bsBox:
|
---|
1030 | Begin
|
---|
1031 | Canvas.ShadowedBorder(rc1,RaisedColor,LoweredColor);
|
---|
1032 | End;
|
---|
1033 | bsFrame:
|
---|
1034 | Begin
|
---|
1035 | DrawSystemFrame(Self,rc1,LoweredColor,RaisedColor);
|
---|
1036 | End;
|
---|
1037 | bsBorder:
|
---|
1038 | Begin
|
---|
1039 | DrawSystemBorder(Self,rc1,bsSingle); {only lowered}
|
---|
1040 | End;
|
---|
1041 | bsLeftLine:
|
---|
1042 | Begin
|
---|
1043 | Canvas.Pen.color:=RaisedColor;
|
---|
1044 | Canvas.Line(rc1.Left,rc1.Top,rc1.Left,rc1.Bottom);
|
---|
1045 | Inc(rc1.Left);
|
---|
1046 | Canvas.Pen.color:=LoweredColor;
|
---|
1047 | Canvas.Line(rc1.Left,rc1.Top,rc1.Left,rc1.Bottom);
|
---|
1048 | End;
|
---|
1049 | bsRightLine:
|
---|
1050 | Begin
|
---|
1051 | Canvas.Pen.color:=LoweredColor;
|
---|
1052 | Canvas.Line(rc1.Right,rc1.Top,rc1.Right,rc1.Bottom);
|
---|
1053 | Dec(rc1.Right);
|
---|
1054 | Canvas.Pen.color:=RaisedColor;
|
---|
1055 | Canvas.Line(rc1.Right,rc1.Top,rc1.Right,rc1.Bottom);
|
---|
1056 | End;
|
---|
1057 | bsTopLine:
|
---|
1058 | Begin
|
---|
1059 | Canvas.Pen.color:=RaisedColor;
|
---|
1060 | Canvas.Line(rc1.Left,rc1.Top,rc1.Right,rc1.Top);
|
---|
1061 | Dec(rc1.Top);
|
---|
1062 | Canvas.Pen.color:=LoweredColor;
|
---|
1063 | Canvas.Line(rc1.Left,rc1.Top,rc1.Right,rc1.Top);
|
---|
1064 | End;
|
---|
1065 | End; {Case}
|
---|
1066 | End;
|
---|
1067 |
|
---|
1068 | {
|
---|
1069 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
1070 | º º
|
---|
1071 | º Speed-Pascal/2 Version 2.0 º
|
---|
1072 | º º
|
---|
1073 | º Speed-Pascal Component Classes (SPCC) º
|
---|
1074 | º º
|
---|
1075 | º This section: TPanel Class Implementation º
|
---|
1076 | º º
|
---|
1077 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
1078 | º º
|
---|
1079 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
1080 | }
|
---|
1081 |
|
---|
1082 | Procedure TPanel.SetupComponent;
|
---|
1083 | Begin
|
---|
1084 | Inherited SetupComponent;
|
---|
1085 |
|
---|
1086 | Name:='Panel';
|
---|
1087 | Caption:=Name;
|
---|
1088 | Height:=100;
|
---|
1089 | Width:=100;
|
---|
1090 | ParentPenColor:=True;
|
---|
1091 | ParentColor:=True;
|
---|
1092 | CursorTabStop:=False;
|
---|
1093 | TabStop:=False;
|
---|
1094 | ZOrder:=zoBottom;
|
---|
1095 | FBevelInner:=bvNone;
|
---|
1096 | FBevelOuter:=bvRaised;
|
---|
1097 | FBevelWidth:=1;
|
---|
1098 | FBorderStyle:=bsNone;
|
---|
1099 | FBorderWidth:=0;
|
---|
1100 | FAlignment:=taCenter;
|
---|
1101 | Include(ComponentState, csAcceptsControls);
|
---|
1102 | End;
|
---|
1103 |
|
---|
1104 | Procedure TPanel.Redraw(Const rec:TRect);
|
---|
1105 | Var OuterRaisedColor:TColor;
|
---|
1106 | OuterLoweredColor:TColor;
|
---|
1107 | InnerRaisedColor:TColor;
|
---|
1108 | InnerLoweredColor:TColor;
|
---|
1109 | rc1:TRect;
|
---|
1110 |
|
---|
1111 | Procedure DrawFrame(rc:TRect;FrameWidth:LongInt;HiColor,LoColor:TColor);
|
---|
1112 | Var PointsArray:Array[0..5] Of TPoint;
|
---|
1113 | offs:LongInt;
|
---|
1114 | Begin
|
---|
1115 | offs := FrameWidth-1;
|
---|
1116 |
|
---|
1117 | If FrameWidth > 1 Then
|
---|
1118 | Begin
|
---|
1119 | PointsArray[0] := Point(rc.Left,rc.Bottom);
|
---|
1120 | PointsArray[1] := Point(rc.Left+offs,rc.Bottom+offs);
|
---|
1121 | PointsArray[2] := Point(rc.Left+offs,rc.Top-offs);
|
---|
1122 | PointsArray[3] := Point(rc.Right-offs,rc.Top-offs);
|
---|
1123 | PointsArray[4] := Point(rc.Right,rc.Top);
|
---|
1124 | PointsArray[5] := Point(rc.Left,rc.Top);
|
---|
1125 | Canvas.Pen.color := HiColor;
|
---|
1126 | Canvas.Polygon(PointsArray);
|
---|
1127 | PointsArray[2] := Point(rc.Right-offs,rc.Bottom+offs);
|
---|
1128 | PointsArray[3] := Point(rc.Right-offs,rc.Top-offs);
|
---|
1129 | PointsArray[4] := Point(rc.Right,rc.Top);
|
---|
1130 | PointsArray[5] := Point(rc.Right,rc.Bottom);
|
---|
1131 | Canvas.Pen.color := LoColor;
|
---|
1132 | Canvas.Polygon(PointsArray);
|
---|
1133 | End
|
---|
1134 | Else Canvas.ShadowedBorder(rc1,HiColor,LoColor);
|
---|
1135 | End;
|
---|
1136 | Begin
|
---|
1137 | If Canvas = Nil Then Exit;
|
---|
1138 |
|
---|
1139 | If FBevelInner = bvRaised Then
|
---|
1140 | Begin
|
---|
1141 | InnerRaisedColor := clBtnHighlight;
|
---|
1142 | InnerLoweredColor := clBtnShadow;
|
---|
1143 | End
|
---|
1144 | Else
|
---|
1145 | Begin
|
---|
1146 | InnerRaisedColor := clBtnShadow;
|
---|
1147 | InnerLoweredColor := clBtnHighlight;
|
---|
1148 | End;
|
---|
1149 |
|
---|
1150 | If FBevelOuter = bvRaised Then
|
---|
1151 | Begin
|
---|
1152 | OuterRaisedColor := clBtnHighlight;
|
---|
1153 | OuterLoweredColor := clBtnShadow;
|
---|
1154 | End
|
---|
1155 | Else
|
---|
1156 | Begin
|
---|
1157 | OuterRaisedColor := clBtnShadow;
|
---|
1158 | OuterLoweredColor := clBtnHighlight;
|
---|
1159 | End;
|
---|
1160 |
|
---|
1161 | rc1 := ClientRect;
|
---|
1162 | DrawSystemBorder(Self,rc1,FBorderStyle);
|
---|
1163 |
|
---|
1164 | If FBevelOuter <> bvNone Then
|
---|
1165 | If FBevelWidth > 0 Then
|
---|
1166 | Begin
|
---|
1167 | DrawFrame(rc1,FBevelWidth,OuterRaisedColor,OuterLoweredColor);
|
---|
1168 | InflateRect(rc1,-FBevelWidth,-FBevelWidth);
|
---|
1169 | End;
|
---|
1170 |
|
---|
1171 | If FBorderWidth > 0 Then
|
---|
1172 | Begin
|
---|
1173 | DrawFrame(rc1,FBorderWidth,color,color);
|
---|
1174 | InflateRect(rc1,-FBorderWidth,-FBorderWidth);
|
---|
1175 | End;
|
---|
1176 |
|
---|
1177 | If FBevelInner <> bvNone Then
|
---|
1178 | If FBevelWidth > 0 Then
|
---|
1179 | Begin
|
---|
1180 | DrawFrame(rc1,FBevelWidth,InnerRaisedColor,InnerLoweredColor);
|
---|
1181 | InflateRect(rc1,-FBevelWidth,-FBevelWidth);
|
---|
1182 | End;
|
---|
1183 |
|
---|
1184 | FInterior := rc1;
|
---|
1185 | DrawText(rec);
|
---|
1186 | End;
|
---|
1187 |
|
---|
1188 | {$HINTS OFF}
|
---|
1189 | Procedure TPanel.DrawText(Const rec:TRect);
|
---|
1190 | Var X,Y,CX,CY:LongInt;
|
---|
1191 | Begin
|
---|
1192 | If Canvas = Nil Then Exit;
|
---|
1193 |
|
---|
1194 | Canvas.FillRect(FInterior,color);
|
---|
1195 | Canvas.SetClipRegion([FInterior]);
|
---|
1196 |
|
---|
1197 | {Draw Caption}
|
---|
1198 | If Caption <> '' Then
|
---|
1199 | Begin
|
---|
1200 | Canvas.GetTextExtent(Caption,CX,CY);
|
---|
1201 | Case FAlignment Of
|
---|
1202 | taLeftJustify: X := FInterior.Left+1;
|
---|
1203 | taRightJustify: X := FInterior.Right-CX;
|
---|
1204 | taCenter: X := (Width-CX) Div 2;
|
---|
1205 | End;
|
---|
1206 | Y := (Height-CY) Div 2;
|
---|
1207 | Canvas.Pen.color := PenColor;
|
---|
1208 | Canvas.Brush.color := color;
|
---|
1209 | Canvas.TextOut(X,Y,Caption);
|
---|
1210 | End;
|
---|
1211 |
|
---|
1212 | Canvas.DeleteClipRegion; {Win95!}
|
---|
1213 | End;
|
---|
1214 | {$HINTS ON}
|
---|
1215 |
|
---|
1216 |
|
---|
1217 | Procedure TPanel.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
|
---|
1218 | Begin
|
---|
1219 | Inherited MouseDown(Button,ShiftState,X,Y);
|
---|
1220 |
|
---|
1221 | If Button = mbLeft Then
|
---|
1222 | If Form Is TForm Then
|
---|
1223 | Begin
|
---|
1224 | Form.BringToFront;
|
---|
1225 |
|
---|
1226 | LastMsg.Handled:=True; {!!}
|
---|
1227 | LastMsg.Result:=0;
|
---|
1228 | End;
|
---|
1229 | End;
|
---|
1230 |
|
---|
1231 |
|
---|
1232 | Procedure TPanel.SetBevelInner(NewBevel:TPanelBevel);
|
---|
1233 | Begin
|
---|
1234 | FBevelInner:=NewBevel;
|
---|
1235 | If Handle<>0 Then Invalidate;
|
---|
1236 | End;
|
---|
1237 |
|
---|
1238 | Procedure TPanel.SetBevelOuter(NewBevel:TPanelBevel);
|
---|
1239 | Begin
|
---|
1240 | FBevelOuter:=NewBevel;
|
---|
1241 | If Handle<>0 Then Invalidate;
|
---|
1242 | End;
|
---|
1243 |
|
---|
1244 | Procedure TPanel.SetBevelWidth(NewWidth:LongInt);
|
---|
1245 | Begin
|
---|
1246 | If NewWidth<0 Then NewWidth:=0;
|
---|
1247 | FBevelWidth:=NewWidth;
|
---|
1248 | If Handle<>0 Then Invalidate;
|
---|
1249 | End;
|
---|
1250 |
|
---|
1251 | Procedure TPanel.SetBorderStyle(NewStyle:TBorderStyle);
|
---|
1252 | Begin
|
---|
1253 | FBorderStyle:=NewStyle;
|
---|
1254 | If Handle<>0 Then Invalidate;
|
---|
1255 | End;
|
---|
1256 |
|
---|
1257 | Procedure TPanel.SetBorderWidth(NewWidth:LongInt);
|
---|
1258 | Begin
|
---|
1259 | If NewWidth<0 Then NewWidth:=0;
|
---|
1260 | FBorderWidth:=NewWidth;
|
---|
1261 | If Handle<>0 Then Invalidate;
|
---|
1262 | End;
|
---|
1263 |
|
---|
1264 | Procedure TPanel.SetAlignment(ta:TAlignment);
|
---|
1265 | Begin
|
---|
1266 | FAlignment:=ta;
|
---|
1267 | If Handle<>0 Then DrawText(ClientRect);
|
---|
1268 | End;
|
---|
1269 |
|
---|
1270 | {$HINTS OFF}
|
---|
1271 | Procedure TPanel.CMTextChanged(Var Msg:TMessage);
|
---|
1272 | Begin
|
---|
1273 | DrawText(ClientRect);
|
---|
1274 | End;
|
---|
1275 | {$HINTS ON}
|
---|
1276 |
|
---|
1277 |
|
---|
1278 | {
|
---|
1279 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
1280 | º º
|
---|
1281 | º Speed-Pascal/2 Version 2.0 º
|
---|
1282 | º º
|
---|
1283 | º Speed-Pascal Component Classes (SPCC) º
|
---|
1284 | º º
|
---|
1285 | º This section: TRadioGroup Class Implementation º
|
---|
1286 | º º
|
---|
1287 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
1288 | º º
|
---|
1289 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
1290 | }
|
---|
1291 |
|
---|
1292 | Procedure TRadioGroup.SetupComponent;
|
---|
1293 | Begin
|
---|
1294 | Inherited SetupComponent;
|
---|
1295 |
|
---|
1296 | Name := 'RadioGroup';
|
---|
1297 | Caption := Name;
|
---|
1298 |
|
---|
1299 | FRadios.Create;
|
---|
1300 | FItems := TStringList.Create;
|
---|
1301 | TStringList(FItems).OnChange := EvItemsChange;
|
---|
1302 | FItemIndex := -1;
|
---|
1303 | FColumns := 1;
|
---|
1304 | End;
|
---|
1305 |
|
---|
1306 |
|
---|
1307 | Procedure TRadioGroup.SetupShow;
|
---|
1308 | Begin
|
---|
1309 | Inherited SetupShow;
|
---|
1310 |
|
---|
1311 | UpdateRadios;
|
---|
1312 | SetItemIndex(FItemIndex);
|
---|
1313 | ArrangeRadios;
|
---|
1314 | End;
|
---|
1315 |
|
---|
1316 |
|
---|
1317 | Destructor TRadioGroup.Destroy;
|
---|
1318 | Begin
|
---|
1319 | SetRadioCount(0);
|
---|
1320 | FRadios.Destroy;
|
---|
1321 | FRadios := Nil;
|
---|
1322 | TStringList(FItems).OnChange := Nil;
|
---|
1323 | FItems.Destroy;
|
---|
1324 | FItems := Nil;
|
---|
1325 |
|
---|
1326 | Inherited Destroy;
|
---|
1327 | End;
|
---|
1328 |
|
---|
1329 |
|
---|
1330 | Procedure TRadioGroup.Resize;
|
---|
1331 | Begin
|
---|
1332 | Inherited Resize;
|
---|
1333 |
|
---|
1334 | ArrangeRadios;
|
---|
1335 | End;
|
---|
1336 |
|
---|
1337 |
|
---|
1338 | Procedure TRadioGroup.FontChange;
|
---|
1339 | Var I:LongInt;
|
---|
1340 | Radio:TRadioButton;
|
---|
1341 | Begin
|
---|
1342 | Inherited FontChange;
|
---|
1343 |
|
---|
1344 | For I := 0 To FRadios.Count-1 Do
|
---|
1345 | Begin
|
---|
1346 | Radio := TRadioButton(FRadios.Items[I]);
|
---|
1347 | Radio.Font := Font;
|
---|
1348 | End;
|
---|
1349 | ArrangeRadios;
|
---|
1350 | End;
|
---|
1351 |
|
---|
1352 |
|
---|
1353 | Procedure TRadioGroup.Click;
|
---|
1354 | Begin
|
---|
1355 | If FOnClick <> Nil Then FOnClick(Self);
|
---|
1356 | End;
|
---|
1357 |
|
---|
1358 |
|
---|
1359 | Procedure TRadioGroup.SetItemIndex(Value:LongInt);
|
---|
1360 | Begin
|
---|
1361 | If ComponentState * [csReading] <> [] Then
|
---|
1362 | Begin
|
---|
1363 | FItemIndex := Value;
|
---|
1364 | Exit;
|
---|
1365 | End;
|
---|
1366 |
|
---|
1367 | If Value < 0 Then Value := -1;
|
---|
1368 | If Value >= FItems.Count Then Value := FItems.Count-1;
|
---|
1369 |
|
---|
1370 | if Handle <> 0 then
|
---|
1371 | begin
|
---|
1372 | // Update the radio buttons
|
---|
1373 | {deselect old because New Value can be < 0}
|
---|
1374 | If (FItemIndex >= 0) And (FItemIndex < FRadios.Count)
|
---|
1375 | Then TRadioButton(FRadios[FItemIndex]).Checked := False;
|
---|
1376 |
|
---|
1377 | FItemIndex := Value;
|
---|
1378 | If FItemIndex >= 0 {Select New} Then
|
---|
1379 | Begin
|
---|
1380 | TRadioButton(FRadios[FItemIndex]).Checked := True;
|
---|
1381 | If HasFocus then
|
---|
1382 | TRadioButton(FRadios[FItemIndex]).Focus;
|
---|
1383 | End;
|
---|
1384 | UpdateTabList;
|
---|
1385 |
|
---|
1386 | end
|
---|
1387 | else
|
---|
1388 | begin
|
---|
1389 | // No radios to update yet - AaronL
|
---|
1390 | FItemIndex := Value;
|
---|
1391 | end;
|
---|
1392 |
|
---|
1393 | ItemIndexChange;
|
---|
1394 | End;
|
---|
1395 |
|
---|
1396 |
|
---|
1397 | Procedure TRadioGroup.ItemIndexChange;
|
---|
1398 | Begin
|
---|
1399 | End;
|
---|
1400 |
|
---|
1401 |
|
---|
1402 | Procedure TRadioGroup.SetColumns(Value:LongInt);
|
---|
1403 | Begin
|
---|
1404 | If Value <= 0 Then Value := 1;
|
---|
1405 | If FColumns <> Value Then
|
---|
1406 | Begin
|
---|
1407 | FColumns := Value;
|
---|
1408 | ArrangeRadios;
|
---|
1409 | End;
|
---|
1410 | End;
|
---|
1411 |
|
---|
1412 |
|
---|
1413 | Procedure TRadioGroup.SetItems(Value:TStrings);
|
---|
1414 | Begin
|
---|
1415 | If Value <> FItems Then FItems.Assign(Value);
|
---|
1416 | End;
|
---|
1417 |
|
---|
1418 |
|
---|
1419 | Procedure TRadioGroup.SetRadioCount(Value:LongInt);
|
---|
1420 | Var Radio:TRadioButton;
|
---|
1421 | Begin
|
---|
1422 | While FRadios.Count < Value Do
|
---|
1423 | Begin
|
---|
1424 | Radio.Create(Self);
|
---|
1425 | Include(Radio.ComponentState, csDetail);
|
---|
1426 | Radio.Font := Font;
|
---|
1427 | Radio.OnClick := EvRadioClick;
|
---|
1428 | Radio.TabStop := True;
|
---|
1429 | Radio.CursorTabStop := true;
|
---|
1430 | FRadios.Add(Radio);
|
---|
1431 | End;
|
---|
1432 | While FRadios.Count > Value Do
|
---|
1433 | Begin
|
---|
1434 | Radio := TRadioButton(FRadios.Last);
|
---|
1435 | FRadios.Remove(Radio);
|
---|
1436 | Radio.Destroy;
|
---|
1437 | End;
|
---|
1438 | End;
|
---|
1439 |
|
---|
1440 |
|
---|
1441 | Function TRadioGroup.GetItemsEnabled(Index:LongInt):Boolean;
|
---|
1442 | Var Radio:TRadioButton;
|
---|
1443 | Begin
|
---|
1444 | Radio := TRadioButton(FRadios.Items[Index]);
|
---|
1445 | Result := Radio.Enabled;
|
---|
1446 | End;
|
---|
1447 |
|
---|
1448 |
|
---|
1449 | Procedure TRadioGroup.SetItemsEnabled(Index:LongInt;Value:Boolean);
|
---|
1450 | Var Radio:TRadioButton;
|
---|
1451 | Begin
|
---|
1452 | Radio := TRadioButton(FRadios.Items[Index]);
|
---|
1453 | Radio.Enabled := Value;
|
---|
1454 | End;
|
---|
1455 |
|
---|
1456 |
|
---|
1457 | Procedure TRadioGroup.UpdateRadios;
|
---|
1458 | Var I:LongInt;
|
---|
1459 | Radio:TRadioButton;
|
---|
1460 | Begin
|
---|
1461 | SetRadioCount(FItems.Count);
|
---|
1462 | For I := 0 To FItems.Count- 1 Do
|
---|
1463 | Begin
|
---|
1464 | Radio := TRadioButton(FRadios.Items[I]);
|
---|
1465 | Radio.Caption := FItems[I];
|
---|
1466 | End;
|
---|
1467 | SetItemIndex(FItemIndex);
|
---|
1468 | ArrangeRadios;
|
---|
1469 | End;
|
---|
1470 |
|
---|
1471 |
|
---|
1472 | Procedure TRadioGroup.ArrangeRadios;
|
---|
1473 | Const Margin=10;
|
---|
1474 | Var I:LongInt;
|
---|
1475 | Radio:TRadioButton;
|
---|
1476 | RadioWidth:LongInt;
|
---|
1477 | RadioHeight:LongInt;
|
---|
1478 | RadiosPerColumn:LongInt;
|
---|
1479 | XPos,YPos:LongInt;
|
---|
1480 | rc:TRect;
|
---|
1481 | Begin
|
---|
1482 | If Handle = 0 Then Exit;
|
---|
1483 | If FRadios.Count = 0 Then Exit;
|
---|
1484 |
|
---|
1485 | rc := ClientRect;
|
---|
1486 | Inc(rc.Left,Margin);
|
---|
1487 | Inc(rc.Bottom,Margin);
|
---|
1488 | Dec(rc.Right,Margin);
|
---|
1489 | Dec(rc.Top,Margin+Font.Height);
|
---|
1490 |
|
---|
1491 | RadiosPerColumn := (FRadios.Count + FColumns - 1) Div FColumns;
|
---|
1492 | RadioWidth := (rc.Right - rc.Left) Div FColumns;
|
---|
1493 | RadioHeight := (rc.Top - rc.Bottom) Div RadiosPerColumn;
|
---|
1494 |
|
---|
1495 | XPos := rc.Left;
|
---|
1496 | YPos := rc.Top - RadioHeight;
|
---|
1497 | For I := 0 To FRadios.Count-1 Do
|
---|
1498 | Begin
|
---|
1499 | Radio := TRadioButton(FRadios[I]);
|
---|
1500 | Radio.SetWindowPos(XPos,YPos,RadioWidth,RadioHeight);
|
---|
1501 | If Radio.parent = Nil Then Radio.parent := Self;
|
---|
1502 |
|
---|
1503 | If ((I+1) Mod RadiosPerColumn) = 0 Then
|
---|
1504 | Begin
|
---|
1505 | YPos := rc.Top - RadioHeight;
|
---|
1506 | Inc(XPos,RadioWidth);
|
---|
1507 | End
|
---|
1508 | Else Dec(YPos,RadioHeight);
|
---|
1509 | End;
|
---|
1510 | End;
|
---|
1511 |
|
---|
1512 |
|
---|
1513 | {$HINTS OFF}
|
---|
1514 | Procedure TRadioGroup.EvItemsChange(Sender:TObject);
|
---|
1515 | Begin
|
---|
1516 | If ComponentState * [csReading] = [] Then
|
---|
1517 | Begin
|
---|
1518 | UpdateRadios;
|
---|
1519 | End;
|
---|
1520 | End;
|
---|
1521 | {$HINTS ON}
|
---|
1522 |
|
---|
1523 | Procedure TRadioGroup.EvRadioClick(Sender:TObject);
|
---|
1524 | Begin
|
---|
1525 | FItemIndex := FRadios.IndexOf(Sender);
|
---|
1526 |
|
---|
1527 | UpdateTabList;
|
---|
1528 | ItemIndexChange;
|
---|
1529 | Click;
|
---|
1530 | End;
|
---|
1531 |
|
---|
1532 |
|
---|
1533 | function TRadioGroup.GetTabStop:boolean;
|
---|
1534 | Begin
|
---|
1535 | result := FIsTabStop;
|
---|
1536 | End;
|
---|
1537 |
|
---|
1538 | procedure TRadioGroup.UpdateTabList;
|
---|
1539 | Begin
|
---|
1540 | If Handle = 0 then
|
---|
1541 | exit;
|
---|
1542 | if FTabList = nil then
|
---|
1543 | FTabList := TList.Create;
|
---|
1544 | FTabList.Clear;
|
---|
1545 | If not FIsTabStop then
|
---|
1546 | exit;
|
---|
1547 | if FRadios.Count = 0 then
|
---|
1548 | exit;
|
---|
1549 |
|
---|
1550 | If FItemIndex >= 0 {Select New} Then
|
---|
1551 | Begin
|
---|
1552 | FTabList.Add(FRadios[FItemIndex]);
|
---|
1553 | End
|
---|
1554 | Else If FRadios.Count > 0 Then
|
---|
1555 | Begin
|
---|
1556 | // tabbing will go to the first radio...
|
---|
1557 | FTabList.Add(FRadios[0]);
|
---|
1558 | End;
|
---|
1559 | End;
|
---|
1560 |
|
---|
1561 | procedure TRadioGroup.SetTabStop(Value:boolean);
|
---|
1562 | Begin
|
---|
1563 | FIsTabStop := Value;
|
---|
1564 | UpdateTabList;
|
---|
1565 | End;
|
---|
1566 |
|
---|
1567 | procedure TRadioGroup.WMFocussing( Var Msg: TMessage );
|
---|
1568 | Begin
|
---|
1569 | if FItemIndex <> -1 then
|
---|
1570 | Msg.Result := LONGWORD( FRadios[ FItemIndex ] );
|
---|
1571 | Msg.Handled := true;
|
---|
1572 | End;
|
---|
1573 |
|
---|
1574 |
|
---|
1575 | Function TRadioGroup.WriteSCUResource(Stream:TResourceStream):Boolean;
|
---|
1576 | Var aText:PChar;
|
---|
1577 | Begin
|
---|
1578 | Result := Inherited WriteSCUResource(Stream);
|
---|
1579 | If Not Result Then Exit;
|
---|
1580 |
|
---|
1581 | aText := Items.GetText;
|
---|
1582 | If aText <> Nil Then
|
---|
1583 | Begin
|
---|
1584 | Result := Stream.NewResourceEntry(rnItems,aText^,Length(aText^)+1);
|
---|
1585 | StrDispose(aText);
|
---|
1586 | End;
|
---|
1587 | End;
|
---|
1588 |
|
---|
1589 |
|
---|
1590 | Procedure TRadioGroup.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
|
---|
1591 | Var aText:PChar;
|
---|
1592 | Begin
|
---|
1593 | If ResName = rnItems Then
|
---|
1594 | Begin
|
---|
1595 | aText := @Data;
|
---|
1596 | Items.SetText(aText);
|
---|
1597 | End
|
---|
1598 | Else Inherited ReadSCUResource(ResName,Data,DataLen)
|
---|
1599 | End;
|
---|
1600 |
|
---|
1601 |
|
---|
1602 | {
|
---|
1603 | ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
|
---|
1604 | º º
|
---|
1605 | º Speed-Pascal/2 Version 2.0 º
|
---|
1606 | º º
|
---|
1607 | º Speed-Pascal Component Classes (SPCC) º
|
---|
1608 | º º
|
---|
1609 | º This section: TPaintBox Class Implementation º
|
---|
1610 | º º
|
---|
1611 | º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
|
---|
1612 | º º
|
---|
1613 | ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
|
---|
1614 | }
|
---|
1615 |
|
---|
1616 | Procedure TPaintBox.SetupComponent;
|
---|
1617 | Begin
|
---|
1618 | Inherited SetupComponent;
|
---|
1619 | Name:='PaintBox';
|
---|
1620 | Height:=200;
|
---|
1621 | Width:=200;
|
---|
1622 | ParentPenColor:=True;
|
---|
1623 | ParentColor:=True;
|
---|
1624 | TabStop:=False;
|
---|
1625 | ZOrder:=zoBottom;
|
---|
1626 | End;
|
---|
1627 |
|
---|
1628 |
|
---|
1629 | Procedure TPaintBox.Redraw(Const rec:TRect);
|
---|
1630 | Var rc:TRect;
|
---|
1631 | Begin
|
---|
1632 | Inherited Redraw(rec);
|
---|
1633 |
|
---|
1634 | If Designed Then
|
---|
1635 | Begin
|
---|
1636 | rc:=ClientRect;
|
---|
1637 | Canvas.Brush.color:=color;
|
---|
1638 | Canvas.Pen.color:=clBlack;
|
---|
1639 | Canvas.TextOut(20,20,'PaintBox');
|
---|
1640 | Canvas.Pen.Style := psDash;
|
---|
1641 | Canvas.Brush.Style := bsClear;
|
---|
1642 | Canvas.Rectangle(rc);
|
---|
1643 | End;
|
---|
1644 | End;
|
---|
1645 |
|
---|
1646 |
|
---|
1647 | Begin
|
---|
1648 | End.
|
---|
1649 |
|
---|