source: trunk/Sibyl/SPCC/BUTTONS.PAS@ 201

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

+ sibyl staff
  • Property svn:eol-style set to native
File size: 68.0 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 Buttons;
11
12
13Interface
14
15{$IFDEF OS2}
16Uses PmWin,BseDos;
17{$ENDIF}
18
19{$IFDEF Win95}
20Uses WinUser,CommCtrl;
21{$ENDIF}
22
23Uses SysUtils,Messages,Classes,Forms,Graphics;
24
25Type
26 TButtonControl=Class(TControl)
27 Private
28 FOnClick:TNotifyEvent;
29 Protected
30 Procedure SetupComponent;Override;
31 Procedure GetClassData(Var ClassData:TClassData);Override;
32 Procedure ParentNotification(Var Msg:TMessage);Override;
33 Function EvaluateShortCut(KeyCode:TKeyCode):Boolean;Override;
34 Public
35 Procedure Click;Virtual;
36 Property OnClick:TNotifyEvent Read FOnClick Write FOnClick;
37 End;
38
39
40 TRadioButton=Class(TButtonControl)
41 Private
42 FInitChecked:Boolean;
43 Function GetChecked:Boolean;
44 Procedure SetChecked(NewState:Boolean);
45 Protected
46 Procedure SetupComponent;Override;
47 Procedure CreateParams(Var Params:TCreateParams);Override;
48 Procedure CreateWnd;Override;
49 Public
50 Procedure Click;Override;
51 Procedure SetFocus;Override;
52 Published
53 Property Align;
54 Property Color;
55 Property Caption;
56 Property Checked:Boolean Read GetChecked Write SetChecked;
57 Property DragCursor;
58 Property DragMode;
59 Property Enabled;
60 Property Font;
61 Property ParentColor;
62 Property ParentFont;
63 Property ParentPenColor;
64 Property ParentShowHint;
65 Property PenColor;
66 Property PopupMenu;
67 Property ShowHint;
68 Property TabOrder;
69 Property TabStop;
70 Property Visible;
71 Property ZOrder;
72
73 Property OnCanDrag;
74 Property OnClick;
75 Property OnDragDrop;
76 Property OnDragOver;
77 Property OnEndDrag;
78 Property OnEnter;
79 Property OnExit;
80 Property OnFontChange;
81 Property OnKeyPress;
82 Property OnMouseDown;
83 Property OnMouseMove;
84 Property OnMouseUp;
85 Property OnScan;
86 Property OnSetupShow;
87 Property OnStartDrag;
88 End;
89
90
91 TCheckBoxState=(cbUnchecked,cbChecked,cbGrayed);
92
93 TCheckBox=Class(TButtonControl)
94 Private
95 FInitState:TCheckBoxState;
96 FAllowGrayed:Boolean;
97 Function GetChecked:Boolean;
98 Procedure SetChecked(NewState:Boolean);
99 Function GetState:TCheckBoxState;
100 Procedure SetState(NewState:TCheckBoxState);
101 Protected
102 Procedure SetupComponent;Override;
103 Procedure CreateParams(Var Params:TCreateParams);Override;
104 Procedure CreateWnd;Override;
105 Procedure Toggle;Virtual;
106 Public
107 Procedure Click;Override;
108 Published
109 Property Align;
110 Property AllowGrayed:Boolean Read FAllowGrayed Write FAllowGrayed;
111 Property Color;
112 Property Caption;
113 Property Checked:Boolean Read GetChecked Write SetChecked;
114 Property PenColor;
115 Property DragCursor;
116 Property DragMode;
117 Property Enabled;
118 Property Font;
119 Property ParentColor;
120 Property ParentPenColor;
121 Property ParentFont;
122 Property ParentShowHint;
123 Property PopupMenu;
124 Property ShowHint;
125 Property State:TCheckBoxState Read GetState Write SetState;
126 Property TabOrder;
127 Property TabStop;
128 Property Visible;
129 Property ZOrder;
130
131 Property OnCanDrag;
132 Property OnClick;
133 Property OnDragDrop;
134 Property OnDragOver;
135 Property OnEndDrag;
136 Property OnEnter;
137 Property OnExit;
138 Property OnFontChange;
139 Property OnKeyPress;
140 Property OnMouseDown;
141 Property OnMouseMove;
142 Property OnMouseUp;
143 Property OnScan;
144 Property OnSetupShow;
145 Property OnStartDrag;
146 End;
147
148
149 TButton=Class(TButtonControl)
150 Private
151 FCancel:Boolean;
152 FDefault:Boolean;
153 FModalResult:TCommand;
154 Procedure SetDefault(Value:Boolean);Virtual;
155 Procedure SetCancel(Value:Boolean);
156 Function GetFormButton(Default:Boolean):TButton;
157 Procedure SetFormButton(Default:Boolean;Button:TButton);
158 Protected
159 Procedure SetupComponent;Override;
160 Procedure CreateParams(Var Params:TCreateParams);Override;
161 Procedure SetupShow;Override;
162 Procedure SetFocus;Override;
163 Public
164 Destructor Destroy;Override;
165 Procedure Click;Override;
166 Property XAlign;
167 Property XStretch;
168 Property YAlign;
169 Property YStretch;
170 Published
171 Property Align;
172 Property Color;
173 Property Cancel:Boolean Read FCancel Write SetCancel;
174 Property Caption;
175 Property PenColor;
176 Property Command;
177 Property Default:Boolean Read FDefault Write SetDefault;
178 Property DragCursor;
179 Property DragMode;
180 Property Enabled;
181 Property Font;
182 Property ModalResult:TCommand Read FModalResult Write FModalResult;
183 Property ParentColor;
184 Property ParentPenColor;
185 Property ParentFont;
186 Property ParentShowHint;
187 Property PopupMenu;
188 Property ShowHint;
189 Property TabOrder;
190 Property TabStop;
191 Property Visible;
192 Property ZOrder;
193
194 Property OnCanDrag;
195 Property OnClick;
196 Property OnDragDrop;
197 Property OnDragOver;
198 Property OnEndDrag;
199 Property OnEnter;
200 Property OnExit;
201 Property OnFontChange;
202 Property OnKeyPress;
203 Property OnMouseDown;
204 Property OnMouseMove;
205 Property OnMouseUp;
206 Property OnScan;
207 Property OnSetupShow;
208 Property OnStartDrag;
209 End;
210
211
212 TPosSize=Record
213 Left,Bottom,Width,Height:LongInt;
214 End;
215
216 {$M+}
217 TButtonLayout=(blGlyphLeft,blGlyphRight,blGlyphTop,blGlyphBottom);
218
219 TBitBtnKind=(bkCustom,bkOk,bkCancel,bkHelp,bkYes,bkNo,bkClose,
220 bkAbort,bkRetry,bkIgnore,bkAll,bkOpen);
221 {$M-}
222
223 TNumGlyphs=LongInt;
224
225 TBitBtn=Class(TButton)
226 Private
227 bmp:TPosSize;
228 txt:TPosSize;
229 Int:TPosSize;
230 IsBmp:Boolean;
231 IsTxt:Boolean;
232 IsMnemo:Boolean;
233 InRedraw:Boolean;
234 FDragging:Boolean;
235 FDown:Boolean;
236 FSpaceDown:Boolean;
237 FLayout:TButtonLayout;
238 FMargin:LongInt;
239 FSpacing:LongInt;
240 FKind:TBitBtnKind;
241 FBitmap:TBitmap;
242 FMaskBitmap:TBitmap;
243 FMaskedBitmap:TBitmap;
244 FNumGlyphs:TNumGlyphs;
245 Private
246 Procedure CMTextChanged(Var Msg:TMessage);Message CM_TEXTCHANGED;
247 {$IFDEF Win95}
248 Procedure WMKeyDown(Var Msg:TMessage); Message WM_KEYDOWN;
249 Procedure WMKeyUp(Var Msg:TMessage); Message WM_KEYUP;
250 {$ENDIF}
251 Procedure SetDefault(Value:Boolean);Override;
252 Function GetDown:Boolean;Virtual;
253 Procedure SetDown(Value:Boolean);Virtual;
254 Procedure SetLayout(Value:TButtonLayout);
255 Procedure SetMargin(Value:LongInt);
256 Procedure SetSpacing(Value:LongInt);
257 Procedure SetKind(Value:TBitBtnKind);
258 Function GetGlyph:TBitmap;
259 Procedure SetGlyph(NewBitmap:TBitmap);Virtual;
260 Procedure CreateBitmaps;
261 Procedure SetNumGlyphs(NewValue:TNumGlyphs);
262 Protected
263 Procedure SetupComponent;Override;
264 Procedure GetClassData(Var ClassData:TClassData);Override;
265 Procedure CreateParams(Var Params:TCreateParams);Override;
266 Procedure SetupShow;Override;
267 Procedure RealignControls;Override;
268 Procedure FontChange;Override;
269 {$IFDEF OS2}
270 Procedure ParentNotification(Var Msg:TMessage);Override;
271 {$ENDIF}
272 Procedure DrawFrame(Down:Boolean);Virtual;
273 Procedure DrawText(Const Caption:String;Down:Boolean);Virtual;
274 Procedure DrawBitmap(Bitmap:TBitmap;Mask:TBitmap;Down:Boolean);Virtual;
275 Procedure Arrange;Virtual;
276 Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
277 Procedure MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
278 Procedure MouseMove(ShiftState:TShiftState;X,Y:LongInt);Override;
279 Procedure MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
280 Property Down:Boolean Read GetDown Write SetDown;
281 Public
282 Destructor Destroy;Override;
283 Procedure Redraw(Const rec:TRect);Override;
284 Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
285 Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
286 Procedure Click;Override;
287 Published
288 Property Glyph:TBitmap Read GetGlyph Write SetGlyph;
289 Property Kind:TBitBtnKind Read FKind Write SetKind;
290 Property Layout:TButtonLayout Read FLayout Write SetLayout;
291 Property Margin:LongInt Read FMargin Write SetMargin;
292 Property Spacing:LongInt Read FSpacing Write SetSpacing;
293 Property NumGlyphs:TNumGlyphs read FNumGlyphs write SetNumGlyphs;
294 Property OnPaint;
295 End;
296
297
298 TAnimatedButton=Class(TBitBtn)
299 Private
300 FSaveBitmap:TBitmap;
301 FBitmapList:TBitmapList;
302 FAnimationTimer:TTimer;
303 FLastPlayItem:LongInt;
304 FInterval:LongInt;
305 Procedure SetInterval(Value:LongInt);
306 Procedure SetGlyph(NewBitmap:TBitmap);Override;
307 Procedure EvTimer(Sender:TObject);
308 Protected
309 Procedure SetupComponent;Override;
310 Public
311 Destructor Destroy;Override;
312 Procedure SetupShow;Override;
313 Procedure StartAnimation;
314 Procedure StopAnimation;
315 Procedure ResetAnimation;
316 Property BitmapList:TBitmapList Read FBitmapList;
317 Published
318 Property Interval:LongInt Read FInterval Write SetInterval;
319 End;
320
321 TButtonState=(bsNormal,bsUp,bsDown,bsDisabled,bsExclusive);
322
323 TSpeedButton=Class(TBitBtn)
324 Private
325 FIgnoreClick:Boolean;
326 FState:TButtonState;
327 FAllowAllUp:Boolean;
328 FGroupIndex:LongInt;
329 Private
330 Function GetState:TButtonState;
331 Procedure SetState(NewValue:TButtonState);
332 {$IFDEF OS2}
333 Procedure WMChar(Var Msg:TWMChar); Message WM_CHAR;
334 {$ENDIF}
335 Procedure UpdateExclusive;
336 Procedure cmButtonPressed(Var Msg:TMessage);Message CM_BUTTONPRESSED;
337 Function GetDown:Boolean;Override;
338 Procedure SetDown(Value:Boolean);Override;
339 Procedure SetAllowAllUp(Value:Boolean);
340 Procedure SetGroupIndex(Value:LongInt);
341 Property ModalResult;
342 Protected
343 Procedure SetupComponent;Override;
344 Procedure CreateParams(Var Params:TCreateParams);Override;
345 {$IFDEF OS2}
346 Procedure ParentNotification(Var Msg:TMessage);Override;
347 {$ENDIF}
348 Procedure DrawFrame(Down:Boolean);Override;
349 Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
350 Procedure MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
351 Procedure MouseMove(ShiftState:TShiftState;X,Y:LongInt);Override;
352 Procedure MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
353 Property State:TButtonState Read GetState Write SetState;
354 Public
355 Procedure Click;Override;
356 Published
357 Property AllowAllUp:Boolean Read FAllowAllUp Write SetAllowAllUp;
358 Property GroupIndex:LongInt Read FGroupIndex Write SetGroupIndex;
359 Property Down; {after Property GroupIndex!}
360 End;
361
362
363Function InsertButton(parent:TControl;Left,Bottom,Width,Height:LongInt;
364 Caption,Hint:String):TButton;
365Function InsertRadioButton(parent:TControl;Left,Bottom,Width,Height:LongInt;
366 Caption,Hint:String):TRadioButton;
367Function InsertCheckBox(parent:TControl;Left,Bottom,Width,Height:LongInt;
368 Caption,Hint:String):TCheckBox;
369Function InsertBitBtn(parent:TControl;Left,Bottom,Width,Height:LongInt;
370 Kind:TBitBtnKind;Caption,Hint:String):TBitBtn;
371Function InsertAnimatedButton(parent:TControl;Left,Bottom,Width,Height:LongInt;
372 BitmapId:LongWord;Caption,Hint:String):TAnimatedButton;
373Function InsertAnimatedButtonName(parent:TControl;Left,Bottom,Width,Height:LongInt;
374 Const BitmapId:String;Caption,Hint:String):TAnimatedButton;
375Function InsertSpeedButton(parent:TControl;Left,Bottom,Width,Height:LongInt;
376 BitmapId:LongWord;Caption,Hint:String):TSpeedButton;
377
378
379Procedure SetPackedCheckBoxList(aList:Array Of TCheckBox;Value:LongWord);
380Function GetPackedCheckBoxList(aList:Array Of TCheckBox):LongWord;
381Procedure SetPackedRadioButtonList(aList:Array Of TRadioButton;Value:LongWord);
382Function GetPackedRadioButtonList(aList:Array Of TRadioButton):LongWord;
383
384Var
385 ShowBitBtnGlyph:Boolean; //Show Glyphs In BitBtns
386
387
388Implementation
389
390{$R Buttons}
391
392Const
393 StdBtnCaptionIds:Array[TBitBtnKind] Of LongWord=
394 (SError, SOkButton, SCancelButton, SHelpButton, SYesButton, SNoButton, SCloseButton,
395 SAbortButton, SRetryButton, SIgnoreButton, SAllButton, SOpenButton);
396
397 StdBtnCmds:Array[TBitBtnKind] Of LongWord=
398 (0, cmOk, cmCancel, 0, cmYes, cmNo, 0, cmAbort, cmRetry, cmIgnore,
399 cmAll, cmOpen);
400
401 StdBtnBmpIds:Array[TBitBtnKind] Of String[20]=
402 ('', 'StdBmpOk', 'StdBmpCancel', 'StdBmpHelp', 'StdBmpYes', 'StdBmpNo',
403 'StdBmpClose', 'StdBmpAbort', 'StdBmpRetry', 'StdBmpIgnore', 'StdBmpAll',
404 'StdBmpOpen');
405
406 btDefault:Boolean=True;
407 btCancel:Boolean=False;
408
409Var
410 StdBtnBitmapMasks:Array[TBitBtnKind] Of TBitmap;
411 StdBtnBitmapsMasked:Array[TBitBtnKind] Of TBitmap;
412
413
414Function GetStdBtnBitmap(Kind:TBitBtnKind):TBitmap;
415Var ResId:String;
416 Bitmap: TBitmap;
417Begin
418 Result := StdBtnBitmapsMasked[Kind];
419 If Result = Nil Then
420 Begin
421 ResId := StdBtnBmpIds[Kind];
422 If ResId = '' Then Exit;
423
424 Bitmap := TBitmap.Create;
425 Bitmap.LoadFromResourceName(ResId);
426
427 StdBtnBitmapMasks[Kind] := Bitmap.CreateAutoMask;
428 StdBtnBitmapsMasked[Kind] := Bitmap.CopyMasked(StdBtnBitmapMasks[Kind]);
429
430 // don't need the original resource bitmap, only the masked copy.
431 Bitmap.Destroy;
432
433 Result := StdBtnBitmapsMasked[Kind];
434 End;
435End;
436
437Function GetStdBtnBitmapMask(Kind:TBitBtnKind):TBitmap;
438Var ResId:String;
439 Bitmap: TBitmap;
440Begin
441 Result := StdBtnBitmapMasks[Kind];
442 If Result = Nil Then
443 Begin
444 GetStdBtnBitmap(Kind);
445 Result := StdBtnBitmapMasks[Kind];
446 End;
447End;
448
449{
450ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
451º º
452º Speed-Pascal/2 Version 2.0 º
453º º
454º Speed-Pascal Component Classes (SPCC) º
455º º
456º This section: Some useful FUNCTIONs º
457º º
458º (C) 1997 SpeedSoft. All rights reserved. Disclosure probibited ! º
459º º
460ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
461}
462
463Procedure SetPackedCheckBoxList(aList:Array Of TCheckBox;Value:LongWord);
464Var T:LongWord;
465Begin
466 For T := Low(aList) To High(aList) Do
467 Begin
468 aList[T].Checked := (Value And (1 Shl T)) <> 0;
469 End;
470End;
471
472Function GetPackedCheckBoxList(aList:Array Of TCheckBox):LongWord;
473Var T:LongWord;
474Begin
475 Result := 0;
476 For T := Low(aList) To High(aList) Do
477 If aList[T].Checked Then Result := Result Or (1 Shl T);
478End;
479
480Procedure SetPackedRadioButtonList(aList:Array Of TRadioButton;Value:LongWord);
481Var T:LongWord;
482Begin
483 For T := Low(aList) To High(aList) Do
484 Begin
485 aList[T].Checked := Value = T;
486 End;
487End;
488
489Function GetPackedRadioButtonList(aList:Array Of TRadioButton):LongWord;
490Var T:LongWord;
491Begin
492 Result := 0;
493 For T := Low(aList) To High(aList) Do
494 If aList[T].Checked Then Result := T;
495End;
496
497
498Function InsertButton(parent:TControl;Left,Bottom,Width,Height:LongInt;Caption,Hint:String):TButton;
499Begin
500 Result.Create(parent);
501 Result.SetWindowPos(Left,Bottom,Width,Height);
502 Result.Caption := Caption;
503 Result.TabStop := True;
504 Result.Hint := Hint;
505 Result.parent := parent;
506End;
507
508
509Function InsertRadioButton(parent:TControl;Left,Bottom,Width,Height:LongInt;Caption,Hint:String):TRadioButton;
510Begin
511 Result.Create(parent);
512 Result.SetWindowPos(Left,Bottom,Width,Height);
513 Result.Caption := Caption;
514 Result.TabStop := True;
515 Result.Hint := Hint;
516 Result.parent := parent;
517End;
518
519
520Function InsertCheckBox(parent:TControl;Left,Bottom,Width,Height:LongInt;Caption,Hint:String):TCheckBox;
521Begin
522 Result.Create(parent);
523 Result.SetWindowPos(Left,Bottom,Width,Height);
524 Result.Caption := Caption;
525 Result.TabStop := True;
526 Result.Hint := Hint;
527 Result.parent := parent;
528End;
529
530
531Function InsertBitBtn(parent:TControl;Left,Bottom,Width,Height:LongInt;Kind:TBitBtnKind;Caption,Hint:String):TBitBtn;
532Begin
533 Result.Create(parent);
534 Result.SetWindowPos(Left,Bottom,Width,Height);
535 Result.TabStop := True;
536 Result.Hint := Hint;
537 Result.parent := parent;
538 Result.Kind := Kind;
539 Result.Caption := Caption;
540End;
541
542
543Function InsertAnimatedButton(parent:TControl;Left,Bottom,Width,Height:LongInt;BitmapId:LongWord;Caption,Hint:String):TAnimatedButton;
544Begin
545 Result.Create(parent);
546 Result.SetWindowPos(Left,Bottom,Width,Height);
547 Result.Caption := Caption;
548 Result.TabStop := True;
549 Result.Hint := Hint;
550 If BitmapId <> 0 Then Result.Glyph.LoadFromResourceId(BitmapId);
551 Result.parent := parent;
552End;
553
554Function InsertAnimatedButtonName(parent:TControl;Left,Bottom,Width,Height:LongInt;Const BitmapId:String;Caption,Hint:String):TAnimatedButton;
555Begin
556 Result.Create(parent);
557 Result.SetWindowPos(Left,Bottom,Width,Height);
558 Result.Caption := Caption;
559 Result.TabStop := True;
560 Result.Hint := Hint;
561 If BitmapId <> '' Then Result.Glyph.LoadFromResourceName(BitmapId);
562 Result.parent := parent;
563End;
564
565
566Function InsertSpeedButton(parent:TControl;Left,Bottom,Width,Height:LongInt;BitmapId:LongWord;Caption,Hint:String):TSpeedButton;
567Begin
568 Result.Create(parent);
569 Result.SetWindowPos(Left,Bottom,Width,Height);
570 Result.Caption := Caption;
571 Result.TabStop := False;
572 Result.Hint := Hint;
573 If BitmapId <> 0 Then Result.Glyph.LoadFromResourceId(BitmapId);
574 Result.parent := parent;
575End;
576
577
578{
579ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
580º º
581º Speed-Pascal/2 Version 2.0 º
582º º
583º Speed-Pascal Component Classes (SPCC) º
584º º
585º This section: TButtonControl Class Implementation º
586º º
587º (C) 1997 SpeedSoft. All rights reserved. Disclosure probibited ! º
588º º
589ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
590}
591
592Procedure TButtonControl.SetupComponent;
593Begin
594 Inherited SetupComponent;
595
596 Name := 'ButtonControl';
597 Height := 30;
598 Width := 80;
599 Ownerdraw := False;
600 PenColor := clBtnText;
601 color := clBtnFace;
602 ParentPenColor := False;
603 ParentColor := False;
604End;
605
606
607Procedure TButtonControl.GetClassData(Var ClassData:TClassData);
608Begin
609 Inherited GetClassData(ClassData);
610
611 {$IFDEF OS2}
612 ClassData.ClassULong := WC_BUTTON;
613 {$ENDIF}
614 {$IFDEF Win95}
615 CreateSubClass(ClassData,'BUTTON');
616 {$ENDIF}
617End;
618
619
620Procedure TButtonControl.ParentNotification(Var Msg:TMessage);
621Begin
622 Inherited ParentNotification(Msg);
623
624 If Designed Then Exit;
625
626 {$IFDEF OS2}
627 If Msg.Param1Hi In [BN_CLICKED,BN_DBLCLICKED] Then
628 {$ENDIF}
629 {$IFDEF Win95}
630 If Msg.Param1Hi In [BN_CLICKED,BN_DOUBLECLICKED] Then
631 {$ENDIF}
632 Begin
633 Click;
634 Msg.Handled := True;
635 Msg.Result := 0;
636 End;
637End;
638
639
640Procedure TButtonControl.Click;
641Begin
642 If FOnClick <> Nil Then FOnClick(Self);
643End;
644
645
646Function TButtonControl.EvaluateShortCut(KeyCode:TKeyCode):Boolean;
647Var S:String;
648 P:Integer;
649 key:TKeyCode;
650Begin
651 S := Caption;
652 P := Pos(MnemoChar,S); { & }
653 If (P > 0) And (P < Length(S)) Then
654 Begin
655 key := (Ord(S[P+1]) Or $20) + kb_Alt + kb_Char;
656 If key = KeyCode Then
657 Begin
658 Click;
659 Result := True;
660 Exit;
661 End;
662 End;
663 Result := Inherited EvaluateShortCut(KeyCode);
664End;
665
666
667{
668ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
669º º
670º Speed-Pascal/2 Version 2.0 º
671º º
672º Speed-Pascal Component Classes (SPCC) º
673º º
674º This section: TRadioButton Class Implementation º
675º º
676º (C) 1997 SpeedSoft. All rights reserved. Disclosure probibited ! º
677º º
678ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
679}
680
681Procedure TRadioButton.SetupComponent;
682Begin
683 Inherited SetupComponent;
684
685 Name := 'RadioButton';
686 Caption := Name;
687 Height := 20;
688 Width := 130;
689 PenColor := clWindowText;
690 ParentPenColor := False;
691 ParentColor := True;
692 FInitChecked := False;
693End;
694
695
696Procedure TRadioButton.CreateParams(Var Params:TCreateParams);
697Begin
698 Inherited CreateParams(Params);
699
700 {$IFDEF OS2}
701 Params.Style := Params.Style Or BS_RADIOBUTTON;
702 {$ENDIF}
703 {$IFDEF Win95}
704 Params.Style := Params.Style Or BS_AUTORADIOBUTTON;
705 {$ENDIF}
706End;
707
708
709Procedure TRadioButton.CreateWnd;
710Begin
711 Inherited CreateWnd;
712
713 SetChecked(FInitChecked);
714End;
715
716
717Function TRadioButton.GetChecked:Boolean;
718Var res:Word;
719Begin
720 Result := FInitChecked;
721 If Handle = 0 Then Exit;
722
723 {$IFDEF OS2}
724 res := WinSendMsg(Handle,BM_QUERYCHECK,0,0);
725 {$ENDIF}
726 {$IFDEF Win95}
727 res := SendMessage(Handle,BM_GETCHECK,0,0);
728 {$ENDIF}
729 Result := (res = 1);
730End;
731
732
733{$IFDEF OS2}
734Function GetGroup(Radio:TControl):TControl;
735Var ARadioRec,AChildRec:TRect;
736 AChild:TControl;
737 I:LongInt;
738Begin
739 Result := Radio.parent;
740 If Result = Nil Then Exit;
741
742 ARadioRec := Radio.WindowRect;
743
744 For I := 0 To Radio.parent.ControlCount-1 Do
745 Begin
746 AChild := Radio.parent.Controls[I];
747 AChildRec := AChild.WindowRect;
748
749 If RectInRect(ARadioRec,AChildRec) Then
750 Begin
751 If Result <> Radio.parent Then {Select the smallest group}
752 Begin
753 If RectInRect(AChildRec,Result.WindowRect)
754 Then Result := AChild;
755 End
756 Else Result := AChild;
757 End;
758 End;
759End;
760
761
762Procedure DeCheckAllRadiosInGroup(actual:TControl);
763Var T:LongInt;
764 group:TControl;
765 Radio:TRadioButton;
766Begin
767 group := GetGroup(actual);
768 If group = Nil Then Exit;
769
770 For T := 0 To actual.parent.ControlCount-1 Do
771 Begin
772 Radio := TRadioButton(actual.parent.Controls[T]);
773 If Radio Is TRadioButton Then
774 If Radio <> actual Then
775 If GetGroup(Radio) = group Then Radio.SetChecked(False);
776 End;
777End;
778{$ENDIF}
779
780
781Procedure TRadioButton.SetChecked(NewState:Boolean);
782Begin
783 FInitChecked := NewState;
784 If Handle = 0 Then Exit;
785 If NewState = GetChecked Then Exit;
786
787 If NewState = True Then
788 Begin
789 {$IFDEF OS2}
790 DeCheckAllRadiosInGroup(Self);
791 {$ENDIF}
792 SendMsg(Handle,BM_SETCHECK,1,0);
793 End
794 Else SendMsg(Handle,BM_SETCHECK,0,0)
795End;
796
797
798Procedure TRadioButton.Click;
799Begin
800 SetChecked(True);
801
802 Inherited Click;
803End;
804
805Procedure TRadioButton.SetFocus;
806Begin
807 Click;
808End;
809
810{
811ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
812º º
813º Speed-Pascal/2 Version 2.0 º
814º º
815º Speed-Pascal Component Classes (SPCC) º
816º º
817º This section: TCheckBox Class Implementation º
818º º
819º (C) 1997 SpeedSoft. All rights reserved. Disclosure probibited ! º
820º º
821ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
822}
823
824Procedure TCheckBox.SetupComponent;
825Begin
826 Inherited SetupComponent;
827
828 Name := 'CheckBox';
829 Caption := Name;
830 Height := 20;
831 Width := 130;
832 PenColor := clWindowText;
833 ParentPenColor := False;
834 ParentColor := True;
835 FInitState := cbUnchecked;
836End;
837
838
839Procedure TCheckBox.CreateParams(Var Params:TCreateParams);
840Begin
841 Inherited CreateParams(Params);
842
843 Params.Style := Params.Style Or BS_3STATE;
844End;
845
846
847Procedure TCheckBox.CreateWnd;
848Begin
849 Inherited CreateWnd;
850
851 SetState(FInitState);
852End;
853
854
855Procedure TCheckBox.Click;
856Begin
857 Toggle;
858
859 Inherited Click;
860End;
861
862
863Procedure TCheckBox.Toggle;
864Begin
865 Case State Of
866 cbUnchecked: If AllowGrayed Then State := cbGrayed
867 Else State := cbChecked;
868 cbChecked: State := cbUnchecked;
869 cbGrayed: State := cbChecked;
870 End;
871End;
872
873
874Procedure TCheckBox.SetChecked(NewState:Boolean);
875Begin
876 If NewState Then State := cbChecked
877 Else State := cbUnchecked;
878End;
879
880
881Function TCheckBox.GetChecked:Boolean;
882Begin
883 Result := State = cbChecked;
884End;
885
886
887Procedure TCheckBox.SetState(NewState:TCheckBoxState);
888Begin
889 FInitState := NewState;
890 If NewState = GetState Then Exit;
891 If Handle = 0 Then Exit;
892
893 SendMsg(Handle,BM_SETCHECK,LongWord(FInitState),0);
894End;
895
896
897Function TCheckBox.GetState:TCheckBoxState;
898Var res:Word;
899Begin
900 Result := FInitState;
901 If Handle = 0 Then Exit;
902
903 {$IFDEF OS2}
904 res := WinSendMsg(Handle,BM_QUERYCHECK,0,0);
905 {$ENDIF}
906 {$IFDEF Win95}
907 res := SendMessage(Handle,BM_GETCHECK,0,0);
908 {$ENDIF}
909 Result := TCheckBoxState(res);
910End;
911
912
913{
914ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
915º º
916º Speed-Pascal/2 Version 2.0 º
917º º
918º Speed-Pascal Component Classes (SPCC) º
919º º
920º This section: TButton Class Implementation º
921º º
922º (C) 1997 SpeedSoft. All rights reserved. Disclosure probibited ! º
923º º
924ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
925}
926
927Procedure TButton.SetupComponent;
928Begin
929 Inherited SetupComponent;
930
931 Name := 'Button';
932 Caption := Name;
933 Height := 30;
934 Width := 80;
935 PenColor := clBtnText;
936 color := clBtnFace;
937 ParentPenColor := False;
938 ParentColor := False;
939 FDefault := False;
940End;
941
942
943Procedure TButton.CreateParams(Var Params:TCreateParams);
944Begin
945 Inherited CreateParams(Params);
946
947 {$IFDEF OS2}
948 Params.Style := Params.Style Or BS_PUSHBUTTON;
949 If FDefault Then Params.Style := Params.Style Or BS_DEFAULT;
950 {$ENDIF}
951 {$IFDEF Win95}
952 If FDefault Then Params.Style := Params.Style Or BS_DEFPUSHBUTTON
953 Else Params.Style := Params.Style Or BS_PUSHBUTTON;
954 {$ENDIF}
955End;
956
957
958Procedure TButton.SetupShow;
959Begin
960 Inherited SetupShow;
961 SetDefault(FDefault); {Update the Form}
962 SetCancel(FCancel); {Update the Form}
963End;
964
965
966Procedure TButton.SetFocus;
967Begin
968 Inherited SetFocus;
969 SetDefault(True);
970End;
971
972
973Procedure TButton.SetDefault(Value:Boolean);
974Var DefBtn:TButton;
975Begin
976 FDefault := Value;
977 If Handle <> 0 Then
978 Begin
979 {$IFDEF OS2}
980 WinSendMsg(Handle,BM_SETDEFAULT,LongWord(FDefault),0);
981 {$ENDIF}
982 {$IFDEF Win95}
983 If FDefault Then SendMessage(Handle,BM_SETSTYLE,BS_DEFPUSHBUTTON,1)
984 Else SendMessage(Handle,BM_SETSTYLE,BS_PUSHBUTTON,1);
985 {$ENDIF}
986 End;
987
988 If Form Is TForm Then
989 Begin
990 DefBtn := GetFormButton(btDefault);
991 If FDefault Then
992 Begin
993 If DefBtn Is TButton Then
994 If DefBtn <> Self Then DefBtn.Default := False;
995
996 SetFormButton(btDefault,Self);
997 End
998 Else If DefBtn = Self Then SetFormButton(btDefault,Nil);
999 End;
1000End;
1001
1002
1003Procedure TButton.SetCancel(Value:Boolean);
1004Var EscBtn:TButton;
1005Begin
1006 FCancel := Value;
1007
1008 If Form Is TForm Then
1009 Begin
1010 EscBtn := GetFormButton(btCancel);
1011 If FCancel Then
1012 Begin
1013 If EscBtn Is TButton Then
1014 If EscBtn <> Self Then EscBtn.Cancel := False;
1015
1016 SetFormButton(btCancel,Self);
1017 End
1018 Else If EscBtn = Self Then SetFormButton(btCancel,Nil);;
1019 End;
1020End;
1021
1022
1023Destructor TButton.Destroy;
1024Begin
1025 If Form Is TForm Then
1026 Begin
1027 If GetFormButton(btDefault) = Self Then SetFormButton(btDefault,Nil);
1028 If GetFormButton(btCancel) = Self Then SetFormButton(btCancel,Nil);
1029 End;
1030 Inherited Destroy;
1031End;
1032
1033
1034Procedure TButton.Click;
1035Begin
1036 Inherited Click;
1037
1038 If parent <> Nil Then
1039 Begin
1040 If ComponentState * [csDetail] = [] Then
1041 Begin
1042 If Form <> Nil Then
1043 Begin
1044 If ModalResult<>cmNull Then
1045 Form.ModalResult := ModalResult;
1046 {force To Handle the modal Result}
1047 SendMsg(Form.Handle,CM_COMMAND,Command{cmNull},0);
1048 End;
1049 End
1050 Else SendMsg(parent.Handle,CM_COMMAND,Command,0)
1051 End;
1052End;
1053
1054
1055Function TButton.GetFormButton(Default:Boolean):TButton;
1056Var mp1:LongWord;
1057Begin
1058 Result := Nil;
1059 If Form <> Nil Then
1060 Begin
1061 If Default Then mp1 := 3
1062 Else mp1 := 4;
1063 Result := TButton(Form.Perform(CM_UPDATEBUTTONS,mp1,0));
1064 End;
1065End;
1066
1067
1068Procedure TButton.SetFormButton(Default:Boolean;Button:TButton);
1069Var mp1:LongWord;
1070Begin
1071 If Form <> Nil Then
1072 Begin
1073 If Default Then mp1 := 1
1074 Else mp1 := 2;
1075 Form.Perform(CM_UPDATEBUTTONS,mp1,LongWord(Button));
1076 End;
1077End;
1078
1079
1080{
1081ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1082º º
1083º Speed-Pascal/2 Version 2.0 º
1084º º
1085º Speed-Pascal Component Classes (SPCC) º
1086º º
1087º This section: TBitBtn Class Implementation º
1088º º
1089º (C) 1997 SpeedSoft. All rights reserved. Disclosure probibited ! º
1090º º
1091ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1092}
1093
1094Procedure TBitBtn.SetupComponent;
1095Begin
1096 Inherited SetupComponent;
1097
1098 Name := 'BitBtn';
1099 Caption := Name;
1100 Height := 30;
1101 Width := 100;
1102 PenColor := clBtnText;
1103 color := clBtnFace;
1104 Ownerdraw := True;
1105 FBitmap := Nil;
1106 FDown := False;
1107 FSpaceDown := False;
1108 FLayout := blGlyphLeft;
1109 FMargin := -1;
1110 FSpacing := 4;
1111 FKind := bkCustom;
1112 InRedraw := False;
1113 FNumGlyphs:=1;
1114End;
1115
1116
1117Procedure TBitBtn.SetNumGlyphs(NewValue:TNumGlyphs);
1118Begin
1119 If NewValue<0 Then NewValue:=1
1120 Else If NewValue>4 Then NewValue:=4;
1121 If NewValue=FNumGlyphs Then exit;
1122 FNumGlyphs:=NewValue;
1123 Arrange;
1124 Invalidate;
1125End;
1126
1127
1128Procedure TBitBtn.GetClassData(Var ClassData:TClassData);
1129Begin
1130 {$IFDEF OS2}
1131 Inherited GetClassData(ClassData);
1132 {$ENDIF}
1133 {$IFDEF Win95}
1134 TControl.GetClassData(ClassData); {no WC_BUTTON !}
1135 {$ENDIF}
1136End;
1137
1138
1139Procedure TBitBtn.CreateParams(Var Params:TCreateParams);
1140Begin
1141 TControl.CreateParams(Params);
1142
1143 {$IFDEF OS2}
1144 Params.Style := Params.Style Or BS_USERBUTTON;
1145 {$ENDIF}
1146End;
1147
1148
1149Procedure TBitBtn.SetupShow;
1150Begin
1151 Inherited SetupShow;
1152
1153 Arrange;
1154 {force To send the Window Message}
1155 If FDown Then
1156 Begin
1157 FDown := False; {dont ignore SetDown}
1158 SetDown(True);
1159 End;
1160End;
1161
1162
1163Destructor TBitBtn.Destroy;
1164Begin
1165 If FBitmap <> Nil Then FBitmap.Destroy;
1166 FBitmap := Nil;
1167
1168 Inherited Destroy;
1169End;
1170
1171
1172Procedure TBitBtn.RealignControls;
1173Begin
1174 Arrange;
1175 Invalidate;
1176End;
1177
1178
1179Procedure TBitBtn.FontChange;
1180Begin
1181 RealignControls;
1182
1183 Inherited FontChange;
1184End;
1185
1186
1187{$IFDEF Win95}
1188Procedure TBitBtn.WMKeyDown(Var Msg:TMessage);
1189Var KeyCode:LongInt;
1190Begin
1191 Inherited;
1192
1193 Msg.Handled := True;
1194 If IsControlLocked(Self) Then Exit;
1195
1196 KeyCode := Msg.Param1;
1197 If KeyCode = VK_SPACE Then
1198 If Not FSpaceDown Then
1199 Begin
1200 FSpaceDown := True;
1201 MouseDown(mbLeft,[],0,0);
1202 End;
1203End;
1204
1205
1206Procedure TBitBtn.WMKeyUp(Var Msg:TMessage);
1207Var KeyCode:LongInt;
1208Begin
1209 Inherited;
1210
1211 Msg.Handled := True;
1212 If IsControlLocked(Self) Then Exit;
1213
1214 KeyCode := Msg.Param1;
1215 If KeyCode = VK_SPACE Then
1216 If FSpaceDown Then
1217 Begin
1218 FSpaceDown := False;
1219 MouseUp(mbLeft,[],0,0);
1220 End;
1221
1222 If KeyCode = VK_ESCAPE Then
1223 If FSpaceDown Then
1224 Begin
1225 FSpaceDown := False;
1226 MouseUp(mbLeft,[],-1,-1); {no Click}
1227 End;
1228End;
1229{$ENDIF}
1230
1231
1232{$IFDEF OS2}
1233Procedure TBitBtn.ParentNotification(Var Msg:TMessage);
1234Var pUserBtn:PUSERBUTTON;
1235Begin
1236 TControl.ParentNotification(Msg);
1237
1238 If Designed Then Exit;
1239
1240 Case Msg.Param1Hi Of
1241 BN_CLICKED:
1242 Begin
1243 {OS2: Param2 Contains the Handle, If the Message was WM_CONTROL
1244 To avoid duplicate Click only Use the WM_COMMAND event}
1245 If Msg.Param2 <> 0 Then Exit;
1246 Click;
1247 End;
1248 BN_PAINT:
1249 Begin
1250 pUserBtn := Pointer(Msg.Param2);
1251 FDefault := (pUserBtn^.fsState And BDS_DEFAULT) <> 0;
1252 Paint(ClientRect);
1253 End;
1254 End;
1255 Msg.Handled := True;
1256 Msg.Result := 0;
1257End;
1258{$ENDIF}
1259
1260Procedure TBitBtn.Arrange;
1261Var space:LongInt;
1262 rc1:TRect;
1263 S,S1,S2:String;
1264 P:Integer;
1265 FBmp:TBitmap;
1266 CX,CY:LongInt;
1267Begin
1268 If Canvas = Nil Then Exit;
1269 rc1 := ClientRect;
1270 Inc(rc1.Right);
1271 Inc(rc1.Top);
1272 {Size Of the Output String}
1273 S := ReplaceMnemo(Caption);
1274 P := Pos(MnemoChar,S);
1275 IsMnemo := (P > 0) And (P < Length(S));
1276 If IsMnemo Then
1277 Begin
1278 s1 := S;
1279 {Draw normal portion}
1280 s2 := Copy(s1,1,P-1);
1281 Delete(s1,1,P); {incl. MnemoChar}
1282 Canvas.GetTextExtent(s2,CX,CY);
1283 txt.Width:=CX;
1284 txt.Height:=CY;
1285
1286 {Draw underlines portion}
1287 s2 := Copy(s1,1,1); {Mnemo}
1288 Delete(s1,1,1);
1289 Canvas.GetTextExtent(s2,CX,CY);
1290 inc(txt.Width,CX);
1291 If CY>txt.Height Then txt.Height:=CY;
1292
1293 {Draw rest portion}
1294 s2 := s1;
1295 Canvas.GetTextExtent(s2,CX,CY);
1296 inc(txt.Width,CX);
1297 If CY>txt.Height Then txt.Height:=CY;
1298
1299 Delete(S,P,1); {Delete Mnemo}
1300 End
1301 Else Canvas.GetTextExtent(S,txt.Width,txt.Height);
1302 IsTxt := S <> '';
1303
1304 If FKind = bkCustom Then FBmp := FBitmap
1305 Else FBmp := GetStdBtnBitmap(FKind);
1306
1307 IsBmp := False;
1308 bmp.Width := 0;
1309 bmp.Height := 0;
1310 If ShowBitBtnGlyph Or (ClassType <> TBitBtn) Or Designed Then
1311 If FBmp <> Nil Then
1312 If Not FBmp.Empty Then
1313 Begin
1314 IsBmp := True;
1315 bmp.Width := FBmp.Width Div NumGlyphs;
1316 bmp.Height := FBmp.Height;
1317 End;
1318
1319 If IsBmp And IsTxt Then space := FSpacing
1320 Else space := 0;
1321
1322 If IsBmp Or IsTxt Then
1323 Case FLayout Of
1324 blGlyphLeft:
1325 Begin
1326 {determine full Size}
1327 Int.Width := bmp.Width + space + txt.Width;
1328
1329 If bmp.Height > txt.Height Then Int.Height := bmp.Height
1330 Else Int.Height := txt.Height;
1331
1332 Int.Bottom := ((rc1.Top - rc1.Bottom) - Int.Height) Div 2;
1333
1334 If FMargin >= 0 Then Int.Left := FMargin
1335 Else Int.Left := ((rc1.Right - rc1.Left) - Int.Width) Div 2;
1336
1337 If IsBmp Then
1338 Begin
1339 bmp.Left := Int.Left;
1340 bmp.Bottom := Int.Bottom;
1341 If bmp.Height < txt.Height
1342 Then Inc(bmp.Bottom, (txt.Height - bmp.Height) Div 2);
1343 End;
1344 If IsTxt Then
1345 Begin
1346 txt.Left := Int.Left + bmp.Width + space;
1347 txt.Bottom := Int.Bottom;
1348 If txt.Height < bmp.Height
1349 Then Inc(txt.Bottom, (bmp.Height - txt.Height) Div 2);
1350 End;
1351 End;
1352 blGlyphRight:
1353 Begin
1354 {determine full Size}
1355 Int.Width := bmp.Width + space + txt.Width;
1356
1357 If bmp.Height > txt.Height Then Int.Height := bmp.Height
1358 Else Int.Height := txt.Height;
1359
1360 Int.Bottom := ((rc1.Top - rc1.Bottom) - Int.Height) Div 2;
1361
1362 If FMargin >= 0 Then Int.Left := rc1.Right - Int.Width - FMargin
1363 Else Int.Left := ((rc1.Right - rc1.Left) - Int.Width) Div 2;
1364
1365 If IsTxt Then
1366 Begin
1367 txt.Left := Int.Left;
1368 txt.Bottom := Int.Bottom;
1369 If txt.Height < bmp.Height
1370 Then Inc(txt.Bottom, (bmp.Height - txt.Height) Div 2);
1371 End;
1372 If IsBmp Then
1373 Begin
1374 bmp.Left := Int.Left + txt.Width + space;
1375 bmp.Bottom := Int.Bottom;
1376 If bmp.Height < txt.Height
1377 Then Inc(bmp.Bottom, (txt.Height - bmp.Height) Div 2);
1378 End;
1379 End;
1380 blGlyphTop:
1381 Begin
1382 {determine full Size}
1383 Int.Height := bmp.Height + space + txt.Height;
1384
1385 If bmp.Width > txt.Width Then Int.Width := bmp.Width
1386 Else Int.Width := txt.Width;
1387
1388 Int.Left := ((rc1.Right - rc1.Left) - Int.Width) Div 2;
1389
1390 If FMargin >= 0 Then Int.Bottom := rc1.Top - Int.Height - FMargin
1391 Else Int.Bottom := ((rc1.Top - rc1.Bottom) - Int.Height) Div 2;
1392
1393 If IsTxt Then
1394 Begin
1395 txt.Left := Int.Left;
1396 txt.Bottom := Int.Bottom;
1397 If txt.Width < bmp.Width
1398 Then Inc(txt.Left, (bmp.Width - txt.Width) Div 2);
1399 End;
1400 If IsBmp Then
1401 Begin
1402 bmp.Left := Int.Left;
1403 bmp.Bottom := Int.Bottom + txt.Height + space;
1404 If bmp.Width < txt.Width
1405 Then Inc(bmp.Left, (txt.Width - bmp.Width) Div 2);
1406 End;
1407 End;
1408 blGlyphBottom:
1409 Begin
1410 {determine full Size}
1411 Int.Height := bmp.Height + space + txt.Height;
1412
1413 If bmp.Width > txt.Width Then Int.Width := bmp.Width
1414 Else Int.Width := txt.Width;
1415
1416 Int.Left := ((rc1.Right - rc1.Left) - Int.Width) Div 2;
1417
1418 If FMargin >= 0 Then Int.Bottom := FMargin
1419 Else Int.Bottom := ((rc1.Top - rc1.Bottom) - Int.Height) Div 2;
1420
1421 If IsBmp Then
1422 Begin
1423 bmp.Left := Int.Left;
1424 bmp.Bottom := Int.Bottom;
1425 If bmp.Width < txt.Width
1426 Then Inc(bmp.Left, (txt.Width - bmp.Width) Div 2);
1427 End;
1428 If IsTxt Then
1429 Begin
1430 txt.Left := Int.Left;
1431 txt.Bottom := Int.Bottom + bmp.Height + space;
1432 If txt.Width < bmp.Width
1433 Then Inc(txt.Left, (bmp.Width - txt.Width) Div 2);
1434 End;
1435 End;
1436 End;
1437End;
1438
1439
1440Procedure TBitBtn.Redraw(Const rec:TRect);
1441Var Bitmap:TBitmap;
1442Begin
1443 If Canvas = Nil Then Exit;
1444 If InRedraw Then Exit;
1445 InRedraw := True; {MnemoString causes recursive Redraw}
1446
1447 If Canvas.ClipRect <> rec Then Canvas.ClipRect := rec; {manual call}
1448
1449 DrawFrame(Down);
1450
1451 If IsTxt Then DrawText(ReplaceMnemo(Caption),Down);
1452
1453 If IsBmp Then
1454 Begin
1455 If FKind = bkCustom Then
1456 DrawBitmap( FMaskedBitmap,
1457 FMaskBitmap,
1458 Down )
1459 Else
1460 DrawBitmap( GetStdBtnBitmap( FKind ),
1461 GetStdBtnBitmapMask( FKind ),
1462 Down );
1463 End;
1464
1465 Inherited Redraw(rec);
1466
1467 Canvas.DeleteClipRegion;
1468 InRedraw := False;
1469End;
1470
1471
1472Procedure TBitBtn.DrawFrame(Down:Boolean);
1473Var rc1:TRect;
1474 PBG:TColor;
1475{$IFDEF OS2}
1476 offs:LongInt;
1477{$ENDIF}
1478Label Warp;
1479Begin
1480 rc1 := ClientRect;
1481
1482 If Application<>Nil Then
1483 Begin
1484 Case Application.Platform Of
1485 {$IFDEF OS2}
1486 OS2Ver20, OS2Ver30: {WARP}
1487 Begin
1488Warp:
1489 {typecast To have access To BackColor}
1490 If parent <> Nil Then PBG := TForm(parent).color
1491 Else PBG := clBackGround;
1492
1493 If Default Then Canvas.Pen.color := clBtnDefault
1494 Else Canvas.Pen.color := PBG;
1495 Canvas.Rectangle(rc1);
1496 InflateRect(rc1,-1,-1);
1497
1498 Canvas.Pen.color := clWindowFrame;
1499 Canvas.Rectangle(rc1);
1500 InflateRect(rc1,-1,-1);
1501 If Down
1502 Then Canvas.ShadowedBorder(rc1,clBtnShadow,clBtnHighlight)
1503 Else Canvas.ShadowedBorder(rc1,clBtnHighlight,clBtnShadow);
1504 InflateRect(rc1,-1,-1);
1505
1506 //{$IFDEF OS2}
1507 Canvas.Pen.color := PBG;
1508 If Default Then offs := 3
1509 Else offs := 2;
1510 Canvas.Pixels[rc1.Left-offs,rc1.Bottom-offs]:=Canvas.Pen.color;
1511 Canvas.Pixels[rc1.Left-offs,rc1.Top+offs]:=Canvas.Pen.color;
1512 Canvas.Pixels[rc1.Right+offs,rc1.Bottom-offs]:=Canvas.Pen.color;
1513 Canvas.Pixels[rc1.Right+offs,rc1.Top+offs]:=Canvas.Pen.color;
1514 //{$ENDIF}
1515 End;
1516 OS2Ver40: {MERLIN}
1517 Begin
1518 {typecast To have access To BackColor}
1519 If parent <> Nil Then PBG := TForm(parent).color
1520 Else PBG := clBackGround;
1521
1522 If Default Then Canvas.Pen.color := clBtnDefault
1523 Else Canvas.Pen.color := PBG;
1524 Canvas.Rectangle(rc1);
1525 InflateRect(rc1,-1,-1);
1526 If Default Then
1527 Begin
1528 Canvas.Rectangle(rc1);
1529 InflateRect(rc1,-1,-1);
1530 End
1531 Else
1532 Begin
1533 Canvas.ShadowedBorder(rc1,clBtnShadow,clBtnHighlight);
1534 InflateRect(rc1,-1,-1);
1535 End;
1536
1537 If Down Then
1538 Begin
1539 Canvas.ShadowedBorder(rc1,clBtnShadow,clBtnHighlight);
1540 InflateRect(rc1,-1,-1);
1541 Canvas.ShadowedBorder(rc1,clBtnShadow,clBtnHighlight);
1542 End
1543 Else
1544 Begin
1545 Canvas.ShadowedBorder(rc1,clBtnHighlight,clBtnShadow);
1546 InflateRect(rc1,-1,-1);
1547 Canvas.ShadowedBorder(rc1,clBtnHighlight,clBtnShadow);
1548 End;
1549 InflateRect(rc1,-1,-1);
1550 End;
1551 {$ENDIF}
1552 {$IFDEF Win95}
1553 Win32:
1554 Begin
1555Warp:
1556 If Default Then
1557 Begin
1558 Canvas.Pen.color := clBtnDefault;
1559 Canvas.Rectangle(rc1);
1560 InflateRect(rc1,-1,-1);
1561 End;
1562
1563 If Down Then
1564 Begin
1565 Canvas.Pen.color := clBtnShadow;
1566 Canvas.Rectangle(rc1);
1567 InflateRect(rc1,-1,-1);
1568 End
1569 Else
1570 Begin
1571 Canvas.ShadowedBorder(rc1,clBtnHighlight,cl3DDkShadow);
1572 InflateRect(rc1,-1,-1);
1573 Canvas.ShadowedBorder(rc1,cl3DLight,clBtnShadow);
1574 InflateRect(rc1,-1,-1);
1575 End;
1576 End;
1577 {$ENDIF}
1578 End; //case
1579 End
1580 Else goto Warp;
1581
1582 Canvas.ClipRect := IntersectRect(Canvas.ClipRect,rc1);
1583End;
1584
1585
1586Procedure TBitBtn.DrawText(Const Caption:String;Down:Boolean);
1587Var rc1:TRect;
1588Begin
1589 Canvas.Brush.color := color;
1590 If Enabled Then Canvas.Pen.color := PenColor
1591 Else Canvas.Pen.color := clDkGray;
1592
1593 rc1.Left := txt.Left;
1594 rc1.Bottom := txt.Bottom;
1595 If Down Then
1596 Begin
1597 Inc(rc1.Left);
1598 Dec(rc1.Bottom);
1599 End;
1600
1601 rc1.Right := rc1.Left + txt.Width -1;
1602 {$IFDEF WIN32}
1603 inc(rc1.Right);
1604 {$ENDIF}
1605 rc1.Top := rc1.Bottom + txt.Height -1;
1606 If IsMnemo Then Canvas.MnemoTextOut(rc1.Left,rc1.Bottom,Caption)
1607 Else Canvas.TextOut(rc1.Left,rc1.Bottom,Caption);
1608 Canvas.ExcludeClipRect(rc1);
1609End;
1610
1611
1612Procedure TBitBtn.DrawBitmap( Bitmap: TBitmap;
1613 Mask: TBitmap;
1614 Down: Boolean );
1615Var Src,Dest:TRect;
1616Begin
1617 Dest.Left := bmp.Left;
1618 Dest.Bottom := bmp.Bottom;
1619 If Down Then If NumGlyphs<3 Then
1620 Begin
1621 Inc(Dest.Left);
1622 Dec(Dest.Bottom);
1623 End;
1624 Dest.Right := Dest.Left + bmp.Width;
1625 Dest.Top := Dest.Bottom + bmp.Height;
1626 Canvas.FillRect(Dest,Color);
1627 If Bitmap = nil Then
1628 Exit;
1629
1630 // default source is whole bitmap.
1631 Src.Left := 0;
1632 Src.Bottom := 0;
1633 Src.Right := bmp.Width;
1634 Src.Top := bmp.Height;
1635
1636 If Enabled Then
1637 Begin
1638 If ((NumGlyphs>2)And(Down)) Then
1639 Begin
1640 // use third position in bitmap
1641 Src.Left:=bmp.Width*2;
1642 Src.Bottom:=0;
1643 Src.Right:=Src.Left+bmp.Width;
1644 Src.Top:=bmp.Height;
1645 if Mask <> nil then
1646 Bitmap.DrawMasked(Canvas,Mask,Src,Dest.Left,Dest.Bottom)
1647 else
1648 Bitmap.PartialDraw(Canvas,Dest,Src);
1649 End
1650 Else
1651 Begin
1652 if Mask <> nil then
1653 Bitmap.DrawMaskedDisabled(Canvas,Mask,Src,Dest.Left,Dest.Bottom)
1654 else
1655 Bitmap.DrawDisabled(Canvas,Dest);
1656 End;
1657 End
1658 Else
1659 Begin
1660 If NumGlyphs>1 Then
1661 Begin
1662 // use second position in bitmap
1663 Src.Left:=bmp.Width;
1664 Src.Bottom:=0;
1665 Src.Right:=Dest.Left+bmp.Width;
1666 Src.Top:=bmp.Height;
1667 if Mask <> nil then
1668 Bitmap.DrawMasked(Canvas,Mask,Src,Dest.Left,Dest.Bottom)
1669 else
1670 Bitmap.PartialDraw(Canvas,Dest,Src);
1671 End
1672 Else
1673 Begin
1674 if Mask <> nil then
1675 Bitmap.DrawMaskedDisabled(Canvas,Mask,Src,Dest.Left,Dest.Bottom)
1676 else
1677 Bitmap.DrawDisabled(Canvas,Dest);
1678 End;
1679 End;
1680
1681 Dec(Dest.Right);
1682 Dec(Dest.Top);
1683 Canvas.ExcludeClipRect(Dest);
1684End;
1685
1686
1687Procedure TBitBtn.SetDefault(Value:Boolean);
1688Begin
1689 Inherited SetDefault(Value);
1690
1691 Refresh;
1692// Paint(ClientRect);
1693End;
1694
1695
1696Function TBitBtn.GetDown:Boolean;
1697Begin
1698 Result := FDown;
1699 {$IFDEF OS2}
1700 If Handle <> 0 Then Result := Boolean(WinSendMsg(Handle,BM_QUERYHILITE,0,0));
1701 {$ENDIF}
1702End;
1703
1704
1705Procedure TBitBtn.SetDown(Value:Boolean);
1706Begin
1707 If FDown = Value Then Exit;
1708 FDown := Value;
1709 {$IFDEF OS2}
1710 If Handle <> 0 Then WinSendMsg(Handle,BM_SETHILITE,LongWord(FDown),0);
1711 {$ENDIF}
1712 {$IFDEF Win95}
1713 Paint(ClientRect);
1714 {$ENDIF}
1715End;
1716
1717
1718Procedure TBitBtn.SetLayout(Value:TButtonLayout);
1719Begin
1720 If FLayout <> Value Then
1721 Begin
1722 FLayout := Value;
1723 Arrange;
1724 Invalidate;
1725 End;
1726End;
1727
1728
1729Procedure TBitBtn.SetMargin(Value:LongInt);
1730Begin
1731 If FMargin <> Value Then
1732 Begin
1733 FMargin := Value;
1734 Arrange;
1735 Invalidate;
1736 End;
1737End;
1738
1739
1740Procedure TBitBtn.SetSpacing(Value:LongInt);
1741Begin
1742 If FSpacing <> Value Then
1743 If FSpacing >= 0 Then
1744 Begin
1745 FSpacing := Value;
1746 Arrange;
1747 Invalidate;
1748 End;
1749End;
1750
1751
1752Procedure TBitBtn.SetKind(Value:TBitBtnKind);
1753Begin
1754 If FKind <> Value Then
1755 Begin
1756 FKind := Value;
1757 If FKind <> bkCustom Then
1758 Begin
1759 If ComponentState * [csReading] = [] Then
1760 Begin
1761 If FKind=bkCustom Then Caption:=''
1762 Else Caption := LoadNLSStr(StdBtnCaptionIds[FKind]);
1763 Command := StdBtnCmds[FKind]; {For SpeedButtons}
1764 ModalResult := StdBtnCmds[FKind]; {For Buttons...}
1765
1766 Default := FKind In [bkOk,bkYes];
1767 Cancel := FKind In [bkCancel,bkNo];
1768 End;
1769
1770 If FBitmap <> Nil Then FBitmap.Destroy; {!}
1771 FBitmap := Nil;
1772 End;
1773 Arrange;
1774 Invalidate;
1775 End;
1776End;
1777
1778Procedure TBitBtn.CreateBitmaps;
1779Var
1780 TransparentColor: TColor;
1781Begin
1782 FMaskBitmap.Free;
1783 FMaskedBitmap.Free;
1784
1785 If FBitmap <> Nil Then
1786 Begin
1787 TransparentColor := FBitmap.Canvas.Pixels[ 0, 0 ];
1788 FMaskBitmap := TBitmap( FBitmap.CreateMask( TransparentColor ) );
1789 FMaskedBitmap := FBitmap.CopyMasked( FMaskBitmap );
1790 End;
1791End;
1792
1793Procedure TBitBtn.SetGlyph(NewBitmap:TBitmap);
1794Var OldBitmap:TBitmap;
1795Begin
1796 OldBitmap := FBitmap;
1797
1798 {Create internal Copy}
1799 If NewBitmap <> Nil Then FBitmap := NewBitmap.Copy
1800 Else FBitmap := Nil;
1801
1802 If FBitmap <> Nil Then Include(FBitmap.ComponentState, csDetail);
1803
1804 If OldBitmap <> Nil Then
1805 If OldBitmap <> NewBitmap Then OldBitmap.Destroy;
1806
1807 CreateBitmaps;
1808
1809 Kind := bkCustom; {!}
1810
1811 Arrange;
1812 Invalidate;
1813End;
1814
1815
1816Function TBitBtn.GetGlyph:TBitmap;
1817Begin
1818 If FBitmap = Nil Then
1819 Begin
1820 FBitmap.Create;
1821 Include(FBitmap.ComponentState, csDetail);
1822 End;
1823 Result := FBitmap;
1824End;
1825
1826
1827{$HINTS OFF}
1828Procedure TBitBtn.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1829Begin
1830 Inherited MouseDown(Button,ShiftState,X,Y);
1831
1832 {$IFDEF Win95}
1833 If Self Is TSpeedButton Then exit;
1834 If Button = mbLeft Then
1835 Begin
1836 Focus;
1837 FDown := True;
1838 Default := True;
1839 Paint(ClientRect);
1840 FDragging := True;
1841 MouseCapture := True;
1842 End;
1843 {$ENDIF}
1844End;
1845
1846
1847Procedure TBitBtn.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
1848{$IFDEF Win95}
1849Var NewDown:Boolean;
1850{$ENDIF}
1851Begin
1852 Inherited MouseMove(ShiftState,X,Y);
1853
1854 {$IFDEF Win95}
1855 If Self Is TSpeedButton Then exit;
1856 If Not FDragging Then Exit;
1857 NewDown := PointInRect(Point(X,Y),ClientRect);
1858
1859 If NewDown <> FDown Then
1860 Begin
1861 FDown := NewDown;
1862 Paint(ClientRect);
1863 End;
1864 {$ENDIF}
1865End;
1866
1867
1868Procedure TBitBtn.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1869Begin
1870 Inherited MouseUp(Button,ShiftState,X,Y);
1871
1872 {$IFDEF Win95}
1873 If Self Is TSpeedButton Then exit;
1874 If Button = mbLeft Then
1875 Begin
1876 If Not FDragging Then Exit;
1877 FDragging := False;
1878 FDown := False;
1879 Paint(ClientRect);
1880 MouseCapture := False;
1881 If PointInRect(Point(X,Y),ClientRect) Then Click;
1882 End;
1883 {$ENDIF}
1884End;
1885
1886
1887Procedure TBitBtn.MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1888Begin
1889 Inherited MouseDblClick(Button,ShiftState,X,Y);
1890
1891 {$IFDEF Win95}
1892 If Button = mbLeft Then
1893 Begin
1894 MouseDown(Button,ShiftState,X,Y);
1895 End;
1896 {$ENDIF}
1897End;
1898
1899
1900Procedure TBitBtn.CMTextChanged(Var Msg:TMessage);
1901Begin
1902 Arrange;
1903 Invalidate;
1904End;
1905{$HINTS ON}
1906
1907
1908Procedure TBitBtn.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
1909Begin
1910 If ResName = rnGlyph Then
1911 Begin
1912 If DataLen <> 0 Then
1913 Begin
1914 Glyph.ReadSCUResource(rnBitmap,Data,DataLen);
1915 CreateBitmaps;
1916 End
1917 End
1918 Else Inherited ReadSCUResource(ResName,Data,DataLen);
1919End;
1920
1921
1922Function TBitBtn.WriteSCUResource(Stream:TResourceStream):Boolean;
1923Begin
1924 Result := Inherited WriteSCUResource(Stream);
1925 If Not Result Then Exit;
1926
1927 If (FBitmap <> Nil) And (ComponentState * [csDetail] = [])
1928 Then Result := FBitmap.WriteSCUResourceName(Stream,rnGlyph);
1929End;
1930
1931
1932Procedure TBitBtn.Click;
1933Var Control:TControl;
1934Begin
1935 Case FKind Of {they have Not A modal Result automatically}
1936 bkClose:
1937 Begin
1938 If (Form <> Nil) And Not Designed Then Form.Close
1939 Else Inherited Click;
1940 End;
1941 bkHelp:
1942 Begin
1943 Control := Self;
1944 While (Control <> Nil) And (Control.HelpContext = 0)
1945 Do Control := Control.parent;
1946
1947 If Control <> Nil Then Application.HelpContext(Control.HelpContext)
1948 Else Inherited Click;
1949 End;
1950 Else Inherited Click;
1951 End;
1952End;
1953
1954
1955{
1956ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1957º º
1958º Speed-Pascal/2 Version 2.0 º
1959º º
1960º Speed-Pascal Component Classes (SPCC) º
1961º º
1962º This section: TAnimatedButton Class Implementation º
1963º º
1964º (C) 1997 SpeedSoft. All rights reserved. Disclosure probibited ! º
1965º º
1966ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1967}
1968
1969Procedure TAnimatedButton.SetupComponent;
1970Begin
1971 Inherited SetupComponent;
1972
1973 Name := 'AnimatedButton';
1974 Caption := Name;
1975 FBitmapList.Create;
1976 FBitmapList.Duplicates := True;
1977 FInterval := 200;
1978 FSaveBitmap := Nil;
1979End;
1980
1981
1982Destructor TAnimatedButton.Destroy;
1983Begin
1984 StopAnimation;
1985 FBitmapList.Destroy;
1986 FBitmapList := Nil;
1987 FBitmap := Nil;
1988
1989 Inherited Destroy;
1990End;
1991
1992
1993Procedure TAnimatedButton.SetupShow;
1994Begin
1995 Inherited SetupShow;
1996
1997 If FBitmapList.Count > 0 Then
1998 If FBitmap = Nil Then Glyph := FBitmapList.First
1999 Else If FBitmap.Empty Then Glyph := FBitmapList.First;
2000End;
2001
2002
2003Procedure TAnimatedButton.SetGlyph(NewBitmap:TBitmap);
2004Begin
2005 Inherited SetGlyph(NewBitmap);
2006
2007 FSaveBitmap := FBitmap;
2008End;
2009
2010
2011Procedure TAnimatedButton.StartAnimation;
2012Begin
2013 If FBitmapList.Count = 0 Then Exit;
2014
2015 If FAnimationTimer=Nil Then
2016 Begin
2017 FAnimationTimer.Create(Self);
2018 Include(FAnimationTimer.ComponentState, csDetail);
2019 FAnimationTimer.OnTimer := EvTimer;
2020 FAnimationTimer.Interval := FInterval;
2021 End;
2022 FAnimationTimer.Start;
2023End;
2024
2025
2026Procedure TAnimatedButton.StopAnimation;
2027Begin
2028 If FAnimationTimer <> Nil Then FAnimationTimer.Stop;
2029End;
2030
2031
2032Procedure TAnimatedButton.ResetAnimation;
2033Begin
2034 StopAnimation;
2035 FLastPlayItem := 0;
2036
2037 FBitmap := FSaveBitmap;
2038 If FBitmapList.Count > 0 Then
2039 If FBitmap = Nil Then Glyph := FBitmapList.First
2040 Else If FBitmap.Empty Then Glyph := FBitmapList.First;
2041 Arrange;
2042 Paint(ClientRect);
2043End;
2044
2045
2046Procedure TAnimatedButton.SetInterval(Value:LongInt);
2047Var WasRunning:Boolean;
2048Begin
2049 FInterval := Value;
2050 If FAnimationTimer <> Nil Then
2051 Begin
2052 WasRunning:=FAnimationTimer.Running;
2053 FAnimationTimer.Stop;
2054 FAnimationTimer.Interval := FInterval;
2055 If WasRunning Then FAnimationTimer.Start;
2056 End;
2057End;
2058
2059
2060Procedure TAnimatedButton.EvTimer(Sender:TObject);
2061Var CompleteRedraw:Boolean;
2062 FLastBitmap:TBitmap;
2063Begin
2064 If Sender = FAnimationTimer Then
2065 Begin
2066 If FLastPlayItem >= FBitmapList.Count Then FLastPlayItem := 0;
2067 FLastBitmap := FBitmap;
2068 FBitmap := FBitmapList.Bitmaps[FLastPlayItem];
2069
2070 CompleteRedraw := False;
2071 If (FLastBitmap <> Nil) And (FBitmap <> Nil) Then
2072 Begin
2073 If (FLastBitmap.Width <> FBitmap.Width) Or
2074 (FLastBitmap.Height <> FBitmap.Height)
2075 Then CompleteRedraw := True;
2076 End
2077 Else
2078 If (FLastBitmap = Nil) Xor (FBitmap = Nil) {mutex Nil}
2079 Then CompleteRedraw := True;
2080
2081 If CompleteRedraw Then
2082 Begin
2083 Arrange;
2084 Paint(ClientRect);
2085 End
2086 Else
2087 Begin
2088 If FKind = bkCustom Then
2089 DrawBitmap( FMaskedBitmap,
2090 FMaskBitmap,
2091 Down )
2092 Else
2093 DrawBitmap( GetStdBtnBitmap( FKind ),
2094 GetStdBtnBitmapMask( FKind ),
2095 Down );
2096 End;
2097 Update;
2098 Inc(FLastPlayItem);
2099 End;
2100End;
2101
2102
2103{
2104ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2105º º
2106º Speed-Pascal/2 Version 2.0 º
2107º º
2108º Speed-Pascal Component Classes (SPCC) º
2109º º
2110º This section: TBitBtn Class Implementation º
2111º º
2112º (C) 1997 SpeedSoft. All rights reserved. Disclosure probibited ! º
2113º º
2114ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2115}
2116
2117Procedure TSpeedButton.SetupComponent;
2118Begin
2119 Inherited SetupComponent;
2120
2121 Name := 'SpeedButton';
2122 Caption := '';
2123 Height := 30;
2124 Width := 30;
2125 FAllowAllUp := False;
2126 CursorTabStop := False;
2127 TabStop := False;
2128 FGroupIndex := 0;
2129 FState := bsNormal;
2130 FDragging := False;
2131 FIgnoreClick := False;
2132End;
2133
2134
2135Function TSpeedButton.GetState:TButtonState;
2136Begin
2137 If not Enabled Then Result:=bsDisabled
2138 Else Result:=FState;
2139End;
2140
2141
2142Procedure TSpeedButton.SetState(NewValue:TButtonState);
2143Begin
2144 If NewValue=FState Then exit;
2145 If NewValue=bsDisabled Then Enabled:=False
2146 Else FState:=NewValue;
2147End;
2148
2149
2150Procedure TSpeedButton.CreateParams(Var Params:TCreateParams);
2151Begin
2152 Inherited CreateParams(Params);
2153
2154 {$IFDEF OS2}
2155 Params.Style := Params.Style Or BS_NOPOINTERFOCUS;
2156 {$ENDIF}
2157End;
2158
2159
2160{$IFDEF OS2}
2161Procedure TSpeedButton.WMChar(Var Msg:TWMChar);
2162Var KeyCode:Word;
2163Begin
2164 Inherited;
2165
2166 Msg.Handled := True;
2167 If IsControlLocked(Self) Then Exit;
2168
2169 If Msg.KeyData And KC_VIRTUALKEY <> 0 Then {Virtual key}
2170 Begin
2171 KeyCode := Msg.VirtualKeyCode;
2172 If Msg.KeyData And KC_KEYUP <> 0 Then
2173 Begin
2174 If KeyCode = VK_SPACE Then
2175 If FSpaceDown Then
2176 Begin
2177 FSpaceDown := False;
2178 MouseUp(mbLeft,[],0,0);
2179 End;
2180
2181 If KeyCode = VK_ESC Then
2182 If FSpaceDown Then
2183 Begin
2184 FSpaceDown := False;
2185 MouseUp(mbLeft,[],-1,-1);
2186 End;
2187 End
2188 Else
2189 Begin
2190 If KeyCode = VK_SPACE Then
2191 If Not FSpaceDown Then
2192 Begin
2193 FSpaceDown := True;
2194 MouseDown(mbLeft,[],0,0);
2195 End;
2196 End;
2197 End;
2198End;
2199{$ENDIF}
2200
2201
2202{$IFDEF OS2}
2203Procedure TSpeedButton.ParentNotification(Var Msg:TMessage);
2204Var pUserBtn:PUSERBUTTON;
2205Begin
2206 TControl.ParentNotification(Msg);
2207
2208 If Designed Then Exit;
2209
2210 Case Msg.Param1Hi Of
2211 BN_CLICKED:
2212 Begin
2213 {OS2: Param2 Contains the Handle, If the Message was WM_CONTROL
2214 To avoid duplicate Click only Use the WM_COMMAND event}
2215 If Msg.Param2 <> 0 Then Exit;
2216 If Not FIgnoreClick Then Click;
2217 FIgnoreClick := False;
2218 End;
2219 BN_PAINT:
2220 Begin
2221 pUserBtn := Pointer(Msg.Param2);
2222 FDefault := (pUserBtn^.fsState And BDS_DEFAULT) <> 0;
2223 Paint(ClientRect);
2224 End;
2225 End;
2226 Msg.Handled := True;
2227 Msg.Result := 0;
2228End;
2229{$ENDIF}
2230
2231
2232Procedure TSpeedButton.DrawFrame(Down:Boolean);
2233Var rc1:TRect;
2234Begin
2235 rc1 := ClientRect;
2236
2237 If Down Then
2238 Begin
2239 Canvas.ShadowedBorder(rc1,clBtnShadow,clBtnHighlight);
2240 InflateRect(rc1,-1,-1);
2241 Canvas.ShadowedBorder(rc1,cl3DDkShadow,clBtnHighlight);
2242 End
2243 Else
2244 Begin
2245 Canvas.ShadowedBorder(rc1,clBtnHighlight,cl3DDkShadow);
2246 InflateRect(rc1,-1,-1);
2247 Canvas.ShadowedBorder(rc1,clBtnHighlight,clBtnShadow);
2248 End;
2249 InflateRect(rc1,-1,-1);
2250
2251 Canvas.ClipRect := IntersectRect(Canvas.ClipRect,rc1);
2252End;
2253
2254
2255Procedure TSpeedButton.UpdateExclusive;
2256Var Msg:TMessage;
2257Begin
2258 If parent = Nil Then Exit;
2259 If FGroupIndex = 0 Then Exit;
2260
2261 FillChar(Msg,SizeOf(Msg),0);
2262 Msg.Msg := CM_BUTTONPRESSED;
2263 Msg.Param1 := LongInt(Self);
2264 Msg.Param2 := FGroupIndex;
2265 Msg.Result := 0;
2266
2267 Parent.BroadCast(Msg);
2268End;
2269
2270
2271Procedure TSpeedButton.cmButtonPressed(Var Msg:TMessage);
2272Var Sender:TSpeedButton;
2273Begin
2274 Sender := TSpeedButton(Msg.Param1);
2275 If Not (Sender Is TSpeedButton) Then Exit;
2276 If Sender = Self Then Exit;
2277 If Msg.Param2 <> FGroupIndex Then Exit;
2278
2279 If Sender.FDown And FDown Then
2280 Begin
2281 FDown := False;
2282 FState := bsNormal;
2283 {$IFDEF OS2}
2284 If Handle <> 0 Then WinSendMsg(Handle,BM_SETHILITE,LongWord(FDown),0);
2285 {$ENDIF}
2286 Paint(ClientRect);
2287 End;
2288 FAllowAllUp := Sender.AllowAllUp;
2289End;
2290
2291
2292Function TSpeedButton.GetDown:Boolean;
2293Begin
2294 Case FState Of {Painting State}
2295 bsDown: Result := True;
2296 bsUp: Result := False;
2297 Else Result := Inherited GetDown;
2298 End;
2299End;
2300
2301
2302Procedure TSpeedButton.SetDown(Value:Boolean);
2303Begin
2304 If FGroupIndex = 0 Then Value := False;
2305 If FDown <> Value Then
2306 Begin
2307 If FDown And (Not FAllowAllUp) Then Exit;
2308 FDown := Value;
2309 If Value Then UpdateExclusive
2310 Else FState := bsNormal;
2311 {$IFDEF OS2}
2312 If Handle <> 0 Then WinSendMsg(Handle,BM_SETHILITE,LongWord(FDown),0);
2313 {$ENDIF}
2314 Paint(ClientRect); {!}
2315 {prevent up Redraw With mouse Click}
2316 If FDown And (Not FAllowAllUp) Then FState := bsDown;
2317 End;
2318End;
2319
2320
2321Procedure TSpeedButton.SetAllowAllUp(Value:Boolean);
2322Begin
2323 If FAllowAllUp <> Value Then
2324 Begin
2325 FAllowAllUp := Value;
2326 UpdateExclusive;
2327 End;
2328End;
2329
2330
2331Procedure TSpeedButton.SetGroupIndex(Value:LongInt);
2332Begin
2333 If FGroupIndex <> Value Then
2334 Begin
2335 FGroupIndex := Value;
2336 UpdateExclusive;
2337 End;
2338End;
2339
2340
2341{$HINTS OFF}
2342Procedure TSpeedButton.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
2343Begin
2344 Inherited MouseDown(Button,ShiftState,X,Y);
2345
2346 If Button = mbLeft Then
2347 Begin
2348 {$IFDEF OS2}
2349 If FGroupIndex = 0 Then Exit;
2350 {$ENDIF}
2351 If FDown And (Not FAllowAllUp) Then
2352 Begin
2353 FState := bsDown; {sonst bringt OS/2 den Button up}
2354 Exit; {cannot switch OFF}
2355 End;
2356
2357 If Not FDown Then
2358 Begin
2359 FState := bsDown;
2360 Paint(ClientRect);
2361 End;
2362 FDragging := True;
2363 {$IFDEF Win95}
2364 MouseCapture := True;
2365 {$ENDIF}
2366 End;
2367End;
2368
2369
2370Procedure TSpeedButton.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
2371Var NewState:TButtonState;
2372Begin
2373 Inherited MouseMove(ShiftState,X,Y);
2374
2375 If Not FDragging Then Exit;
2376
2377 If Not FDown Then
2378 Begin
2379 If PointInRect(Point(X,Y),ClientRect) Then NewState := bsDown
2380 Else NewState := bsUp;
2381 End
2382 Else NewState := bsDown;
2383
2384 If NewState <> FState Then
2385 Begin
2386 FState := NewState;
2387 Paint(ClientRect);
2388 End;
2389End;
2390
2391
2392Procedure TSpeedButton.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
2393Begin
2394 Inherited MouseUp(Button,ShiftState,X,Y);
2395
2396 If Button = mbLeft Then
2397 Begin
2398 If Not FDragging Then Exit;
2399 FDragging := False;
2400 {$IFDEF Win95}
2401 MouseCapture := False;
2402 {$ENDIF}
2403 If PointInRect(Point(X,Y),ClientRect) Then
2404 Begin
2405 If FDown Then
2406 Begin
2407 If FAllowAllUp Then
2408 Begin
2409 FState := bsNormal;
2410 SetDown(False);
2411 {manually because no ParentNotification occurs}
2412 Click;
2413 End
2414 Else FIgnoreClick := True;
2415 End
2416 Else
2417 Begin
2418 If FGroupIndex = 0 Then
2419 Begin
2420 FState := bsNormal;
2421 Paint(ClientRect);
2422 End;
2423 SetDown(True);
2424 End;
2425 {$IFDEF Win95}
2426 If Not FIgnoreClick Then Click;
2427
2428 FIgnoreClick := False;
2429 {$ENDIF}
2430 End;
2431 End;
2432End;
2433
2434
2435Procedure TSpeedButton.MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
2436Begin
2437 Inherited MouseDblClick(Button,ShiftState,X,Y);
2438
2439 If Button = mbLeft Then
2440 Begin
2441 MouseDown(Button,ShiftState,X,Y);
2442 {$IFDEF OS2}
2443 MouseUp(Button,ShiftState,X,Y); {Win95 sends it Self}
2444 {$ENDIF}
2445 End;
2446End;
2447{$HINTS OFF}
2448
2449
2450Procedure TSpeedButton.Click; {Do Not send A modal Result}
2451Begin
2452 If parent <> Nil Then
2453 Begin
2454 If ComponentState * [csDetail] = [] Then
2455 Begin
2456 If Form <> Nil
2457 Then SendMsg(Form.Handle,CM_COMMAND,Command{cmNull},0);
2458 End
2459 Else SendMsg(parent.Handle,CM_COMMAND,Command,0)
2460 End;
2461
2462 TButtonControl.Click;
2463End;
2464
2465
2466Begin
2467 FillChar( StdBtnBitmapMasks, SizeOf( StdBtnBitmapMasks ), 0 );
2468 FillChar( StdBtnBitmapsMasked, SizeOf( StdBtnBitmapsMasked ), 0 );
2469 ShowBitBtnGlyph := True;
2470End.
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
Note: See TracBrowser for help on using the repository browser.