source: 2.19_branch/Sibyl/SPCC/EXTCTRLS.PAS@ 376

Last change on this file since 376 was 7, checked in by RBRi, 19 years ago

+ sibyl staff

  • Property svn:eol-style set to native
File size: 45.1 KB
Line 
1
2{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3 º º
4 º Sibyl Portable Component Classes º
5 º º
6 º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
7 º º
8 ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
9
10Unit EXTCTRLS;
11
12
13Interface
14
15Uses SysUtils,Classes,Forms,Graphics,Buttons,StdCtrls;
16
17
18Type
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
367Function InsertShape(parent:TControl;Left,Bottom,Width,Height:LongInt):TShape;
368Function InsertImage(parent:TControl;Left,Bottom,Width,Height:LongInt;BitmapId:LongWord):TImage;
369Function InsertImageName(parent:TControl;Left,Bottom,Width,Height:LongInt;Const BitmapId:String):TImage;
370Function InsertBevel(parent:TControl;Left,Bottom,Width,Height:LongInt;
371 Shape:TBevelShape;Style:TBevelStyle):TBevel;
372Function InsertPanel(parent:TControl;Left,Bottom,Width,Height:LongInt;
373 BevelInner:TPanelBevel;BevelOuter:TPanelBevel;BevelWidth:LongInt;
374 Caption:String):TPanel;
375Function InsertRadioGroup(parent:TControl;Left,Bottom,Width,Height:LongInt;
376 Caption:String):TRadioGroup;
377
378
379Implementation
380
381
382Function InsertShape(parent:TControl;Left,Bottom,Width,Height:LongInt):TShape;
383Begin
384 Result.Create(parent);
385 Result.SetWindowPos(Left,Bottom,Width,Height);
386 Result.parent := parent;
387End;
388
389
390Function InsertImage(Parent:TControl;Left,Bottom,Width,Height:LongInt;
391 BitmapId:LongWord):TImage;
392Var Bitmap:TBitmap;
393Begin
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;
401End;
402
403Function InsertImageName(Parent:TControl;Left,Bottom,Width,Height:LongInt;
404 Const BitmapId:String):TImage;
405Var Bitmap:TBitmap;
406Begin
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;
414End;
415
416
417Function InsertBevel(parent:TControl;Left,Bottom,Width,Height:LongInt;
418 Shape:TBevelShape;Style:TBevelStyle):TBevel;
419Begin
420 Result.Create(parent);
421 Result.Shape := Shape;
422 Result.Style := Style;
423 Result.SetWindowPos(Left,Bottom,Width,Height);
424 Result.parent := parent;
425End;
426
427
428Function InsertPanel(parent:TControl;Left,Bottom,Width,Height:LongInt;
429 BevelInner:TPanelBevel;BevelOuter:TPanelBevel;BevelWidth:LongInt;
430 Caption:String):TPanel;
431Begin
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;
439End;
440
441
442Function InsertRadioGroup(parent:TControl;Left,Bottom,Width,Height:LongInt;
443 Caption:String):TRadioGroup;
444Begin
445 Result.Create(parent);
446 Result.SetWindowPos(Left,Bottom,Width,Height);
447 Result.Caption := Caption;
448 Result.parent := parent;
449End;
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
467Procedure TShape.SetupComponent;
468Begin
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);
482End;
483
484Procedure TShape.SetupShow;
485Begin
486 Inherited SetupShow;
487
488 Canvas.Brush:=FTempBrush;
489 Canvas.Pen:=FTempPen;
490End;
491
492Destructor TShape.Destroy;
493Begin
494 Inherited Destroy;
495
496 FTempBrush.Destroy;
497 FTempPen.Destroy;
498End;
499
500Function TShape.GetBrush:TBrush;
501Begin
502 If Canvas <> Nil Then Result := Canvas.Brush
503 Else Result := FTempBrush;
504End;
505
506Function TShape.GetPen:TPen;
507Begin
508 If Canvas <> Nil Then Result := Canvas.Pen
509 Else Result := FTempPen;
510End;
511
512Procedure TShape.SetShape(NewShape:TShapeType);
513Begin
514 FShape:=NewShape;
515 Invalidate;
516End;
517
518Procedure TShape.Redraw(Const rec:TRect);
519Var 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;
532Begin
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;
693End;
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
711Procedure TImage.SetupComponent;
712Begin
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;
731End;
732
733Procedure TImage.Change;
734Begin
735 If FOnChange<>Nil Then FOnChange(Self);
736End;
737
738Procedure TImage.PictureChanged(Sender:TObject);
739Begin
740 Change;
741 Invalidate;
742End;
743
744
745Procedure TImage.SetStretch(NewValue:Boolean);
746Begin
747 FStretch:=NewValue;
748 Invalidate;
749End;
750
751Procedure TImage.SetCenter(NewValue:Boolean);
752Begin
753 FCenter:=NewValue;
754 Invalidate;
755End;
756
757Procedure TImage.SetBitmap(NewBitmap:TBitmap);
758Begin
759 Picture.Bitmap := NewBitmap;
760End;
761
762Function TImage.GetBitmap:TBitmap;
763Begin
764 If ((Picture.HasFormat(TBitmap))Or(Picture.Empty)) Then
765 Result := Picture.Bitmap
766 Else
767 Result:=Nil;
768End;
769
770Function TImage.GetIcon:TIcon;
771Begin
772 If ((Picture.HasFormat(TIcon))Or(Picture.Empty)) Then
773 Result := Picture.Icon
774 Else
775 Result:=Nil;
776End;
777
778Procedure TImage.SetIcon(NewIcon:TIcon);
779Begin
780 Picture.Icon:=NewIcon;
781End;
782
783Function TImage.GetGraphic:TGraphic;
784Begin
785 Result:=Picture.Graphic;
786End;
787
788Procedure TImage.SetGraphic(NewGraphic:TGraphic);
789Begin
790 Picture.Graphic:=NewGraphic;
791End;
792
793Procedure TImage.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
794Begin
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;
805End;
806
807Procedure TImage.Redraw(Const rec:TRect);
808Var rc:TRect;
809 X,Y:LongInt;
810 aGraphic:TGraphic;
811Label proceed;
812Begin
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
843proceed:
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;
871End;
872
873Procedure TImage.SetupShow;
874Var needBMP:Boolean;
875 aBMP:TBitmap;
876Begin
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;
909End;
910
911Destructor TImage.Destroy;
912Begin
913 If FPicture <> Nil Then
914 Begin
915 FPicture.Destroy;
916 FPicture := Nil;
917 End;
918
919 Inherited Destroy;
920End;
921
922Procedure TImage.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
923Begin
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);
929End;
930
931
932Function TImage.WriteSCUResource(Stream:TResourceStream):Boolean;
933Begin
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);
939End;
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
956Procedure TBevel.SetupComponent;
957Begin
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);
971End;
972
973Procedure TBevel.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
974Begin
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;
985End;
986
987Procedure TBevel.SetShape(NewShape:TBevelShape);
988Begin
989 FShape := NewShape;
990 If Handle <> 0 Then Invalidate;
991End;
992
993Procedure TBevel.SetStyle(NewStyle:TBevelStyle);
994Begin
995 FStyle := NewStyle;
996 If Handle <> 0 Then Invalidate;
997End;
998
999Procedure TBevel.Redraw(Const rec:TRect);
1000Var rc1:TRect;
1001 RaisedColor:TColor;
1002 LoweredColor:TColor;
1003Begin
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}
1066End;
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
1082Procedure TPanel.SetupComponent;
1083Begin
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);
1102End;
1103
1104Procedure TPanel.Redraw(Const rec:TRect);
1105Var 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;
1136Begin
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);
1186End;
1187
1188{$HINTS OFF}
1189Procedure TPanel.DrawText(Const rec:TRect);
1190Var X,Y,CX,CY:LongInt;
1191Begin
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!}
1213End;
1214{$HINTS ON}
1215
1216
1217Procedure TPanel.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1218Begin
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;
1229End;
1230
1231
1232Procedure TPanel.SetBevelInner(NewBevel:TPanelBevel);
1233Begin
1234 FBevelInner:=NewBevel;
1235 If Handle<>0 Then Invalidate;
1236End;
1237
1238Procedure TPanel.SetBevelOuter(NewBevel:TPanelBevel);
1239Begin
1240 FBevelOuter:=NewBevel;
1241 If Handle<>0 Then Invalidate;
1242End;
1243
1244Procedure TPanel.SetBevelWidth(NewWidth:LongInt);
1245Begin
1246 If NewWidth<0 Then NewWidth:=0;
1247 FBevelWidth:=NewWidth;
1248 If Handle<>0 Then Invalidate;
1249End;
1250
1251Procedure TPanel.SetBorderStyle(NewStyle:TBorderStyle);
1252Begin
1253 FBorderStyle:=NewStyle;
1254 If Handle<>0 Then Invalidate;
1255End;
1256
1257Procedure TPanel.SetBorderWidth(NewWidth:LongInt);
1258Begin
1259 If NewWidth<0 Then NewWidth:=0;
1260 FBorderWidth:=NewWidth;
1261 If Handle<>0 Then Invalidate;
1262End;
1263
1264Procedure TPanel.SetAlignment(ta:TAlignment);
1265Begin
1266 FAlignment:=ta;
1267 If Handle<>0 Then DrawText(ClientRect);
1268End;
1269
1270{$HINTS OFF}
1271Procedure TPanel.CMTextChanged(Var Msg:TMessage);
1272Begin
1273 DrawText(ClientRect);
1274End;
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
1292Procedure TRadioGroup.SetupComponent;
1293Begin
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;
1304End;
1305
1306
1307Procedure TRadioGroup.SetupShow;
1308Begin
1309 Inherited SetupShow;
1310
1311 UpdateRadios;
1312 SetItemIndex(FItemIndex);
1313 ArrangeRadios;
1314End;
1315
1316
1317Destructor TRadioGroup.Destroy;
1318Begin
1319 SetRadioCount(0);
1320 FRadios.Destroy;
1321 FRadios := Nil;
1322 TStringList(FItems).OnChange := Nil;
1323 FItems.Destroy;
1324 FItems := Nil;
1325
1326 Inherited Destroy;
1327End;
1328
1329
1330Procedure TRadioGroup.Resize;
1331Begin
1332 Inherited Resize;
1333
1334 ArrangeRadios;
1335End;
1336
1337
1338Procedure TRadioGroup.FontChange;
1339Var I:LongInt;
1340 Radio:TRadioButton;
1341Begin
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;
1350End;
1351
1352
1353Procedure TRadioGroup.Click;
1354Begin
1355 If FOnClick <> Nil Then FOnClick(Self);
1356End;
1357
1358
1359Procedure TRadioGroup.SetItemIndex(Value:LongInt);
1360Begin
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;
1394End;
1395
1396
1397Procedure TRadioGroup.ItemIndexChange;
1398Begin
1399End;
1400
1401
1402Procedure TRadioGroup.SetColumns(Value:LongInt);
1403Begin
1404 If Value <= 0 Then Value := 1;
1405 If FColumns <> Value Then
1406 Begin
1407 FColumns := Value;
1408 ArrangeRadios;
1409 End;
1410End;
1411
1412
1413Procedure TRadioGroup.SetItems(Value:TStrings);
1414Begin
1415 If Value <> FItems Then FItems.Assign(Value);
1416End;
1417
1418
1419Procedure TRadioGroup.SetRadioCount(Value:LongInt);
1420Var Radio:TRadioButton;
1421Begin
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;
1438End;
1439
1440
1441Function TRadioGroup.GetItemsEnabled(Index:LongInt):Boolean;
1442Var Radio:TRadioButton;
1443Begin
1444 Radio := TRadioButton(FRadios.Items[Index]);
1445 Result := Radio.Enabled;
1446End;
1447
1448
1449Procedure TRadioGroup.SetItemsEnabled(Index:LongInt;Value:Boolean);
1450Var Radio:TRadioButton;
1451Begin
1452 Radio := TRadioButton(FRadios.Items[Index]);
1453 Radio.Enabled := Value;
1454End;
1455
1456
1457Procedure TRadioGroup.UpdateRadios;
1458Var I:LongInt;
1459 Radio:TRadioButton;
1460Begin
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;
1469End;
1470
1471
1472Procedure TRadioGroup.ArrangeRadios;
1473Const Margin=10;
1474Var I:LongInt;
1475 Radio:TRadioButton;
1476 RadioWidth:LongInt;
1477 RadioHeight:LongInt;
1478 RadiosPerColumn:LongInt;
1479 XPos,YPos:LongInt;
1480 rc:TRect;
1481Begin
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;
1510End;
1511
1512
1513{$HINTS OFF}
1514Procedure TRadioGroup.EvItemsChange(Sender:TObject);
1515Begin
1516 If ComponentState * [csReading] = [] Then
1517 Begin
1518 UpdateRadios;
1519 End;
1520End;
1521{$HINTS ON}
1522
1523Procedure TRadioGroup.EvRadioClick(Sender:TObject);
1524Begin
1525 FItemIndex := FRadios.IndexOf(Sender);
1526
1527 UpdateTabList;
1528 ItemIndexChange;
1529 Click;
1530End;
1531
1532
1533function TRadioGroup.GetTabStop:boolean;
1534Begin
1535 result := FIsTabStop;
1536End;
1537
1538procedure TRadioGroup.UpdateTabList;
1539Begin
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;
1559End;
1560
1561procedure TRadioGroup.SetTabStop(Value:boolean);
1562Begin
1563 FIsTabStop := Value;
1564 UpdateTabList;
1565End;
1566
1567procedure TRadioGroup.WMFocussing( Var Msg: TMessage );
1568Begin
1569 if FItemIndex <> -1 then
1570 Msg.Result := LONGWORD( FRadios[ FItemIndex ] );
1571 Msg.Handled := true;
1572End;
1573
1574
1575Function TRadioGroup.WriteSCUResource(Stream:TResourceStream):Boolean;
1576Var aText:PChar;
1577Begin
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;
1587End;
1588
1589
1590Procedure TRadioGroup.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
1591Var aText:PChar;
1592Begin
1593 If ResName = rnItems Then
1594 Begin
1595 aText := @Data;
1596 Items.SetText(aText);
1597 End
1598 Else Inherited ReadSCUResource(ResName,Data,DataLen)
1599End;
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
1616Procedure TPaintBox.SetupComponent;
1617Begin
1618 Inherited SetupComponent;
1619 Name:='PaintBox';
1620 Height:=200;
1621 Width:=200;
1622 ParentPenColor:=True;
1623 ParentColor:=True;
1624 TabStop:=False;
1625 ZOrder:=zoBottom;
1626End;
1627
1628
1629Procedure TPaintBox.Redraw(Const rec:TRect);
1630Var rc:TRect;
1631Begin
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;
1644End;
1645
1646
1647Begin
1648End.
1649
Note: See TracBrowser for help on using the repository browser.