home *** CD-ROM | disk | FTP | other *** search
/ PC World Plus! (NZ) 2001 June / HDC50.iso / Runimage / Delphi50 / Source / Samples / SPIN.PAS < prev   
Pascal/Delphi Source File  |  1999-08-11  |  17KB  |  640 lines
  1. unit Spin;
  2.  
  3. interface
  4.  
  5. uses Windows, Classes, StdCtrls, ExtCtrls, Controls, Messages, SysUtils,
  6.   Forms, Graphics, Menus, Buttons;
  7.  
  8. const
  9.   InitRepeatPause = 400;  { pause before repeat timer (ms) }
  10.   RepeatPause     = 100;  { pause before hint window displays (ms)}
  11.  
  12. type
  13.  
  14.   TNumGlyphs = Buttons.TNumGlyphs;
  15.  
  16.   TTimerSpeedButton = class;
  17.  
  18. { TSpinButton }
  19.  
  20.   TSpinButton = class (TWinControl)
  21.   private
  22.     FUpButton: TTimerSpeedButton;
  23.     FDownButton: TTimerSpeedButton;
  24.     FFocusedButton: TTimerSpeedButton;
  25.     FFocusControl: TWinControl;
  26.     FOnUpClick: TNotifyEvent;
  27.     FOnDownClick: TNotifyEvent;
  28.     function CreateButton: TTimerSpeedButton;
  29.     function GetUpGlyph: TBitmap;
  30.     function GetDownGlyph: TBitmap;
  31.     procedure SetUpGlyph(Value: TBitmap);
  32.     procedure SetDownGlyph(Value: TBitmap);
  33.     function GetUpNumGlyphs: TNumGlyphs;
  34.     function GetDownNumGlyphs: TNumGlyphs;
  35.     procedure SetUpNumGlyphs(Value: TNumGlyphs);
  36.     procedure SetDownNumGlyphs(Value: TNumGlyphs);
  37.     procedure BtnClick(Sender: TObject);
  38.     procedure BtnMouseDown (Sender: TObject; Button: TMouseButton;
  39.       Shift: TShiftState; X, Y: Integer);
  40.     procedure SetFocusBtn (Btn: TTimerSpeedButton);
  41.     procedure AdjustSize (var W, H: Integer); reintroduce;
  42.     procedure WMSize(var Message: TWMSize);  message WM_SIZE;
  43.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  44.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  45.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  46.   protected
  47.     procedure Loaded; override;
  48.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  49.     procedure Notification(AComponent: TComponent;
  50.       Operation: TOperation); override;
  51.   public
  52.     constructor Create(AOwner: TComponent); override;
  53.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  54.   published
  55.     property Align;
  56.     property Anchors;
  57.     property Constraints;
  58.     property Ctl3D;
  59.     property DownGlyph: TBitmap read GetDownGlyph write SetDownGlyph;
  60.     property DownNumGlyphs: TNumGlyphs read GetDownNumGlyphs write SetDownNumGlyphs default 1;
  61.     property DragCursor;
  62.     property DragKind;
  63.     property DragMode;
  64.     property Enabled;
  65.     property FocusControl: TWinControl read FFocusControl write FFocusControl;
  66.     property ParentCtl3D;
  67.     property ParentShowHint;
  68.     property PopupMenu;
  69.     property ShowHint;
  70.     property TabOrder;
  71.     property TabStop;
  72.     property UpGlyph: TBitmap read GetUpGlyph write SetUpGlyph;
  73.     property UpNumGlyphs: TNumGlyphs read GetUpNumGlyphs write SetUpNumGlyphs default 1;
  74.     property Visible;
  75.     property OnDownClick: TNotifyEvent read FOnDownClick write FOnDownClick;
  76.     property OnDragDrop;
  77.     property OnDragOver;
  78.     property OnEndDock;
  79.     property OnEndDrag;
  80.     property OnEnter;
  81.     property OnExit;
  82.     property OnStartDock;
  83.     property OnStartDrag;
  84.     property OnUpClick: TNotifyEvent read FOnUpClick write FOnUpClick;
  85.   end;
  86.  
  87. { TSpinEdit }
  88.  
  89.   TSpinEdit = class(TCustomEdit)
  90.   private
  91.     FMinValue: LongInt;
  92.     FMaxValue: LongInt;
  93.     FIncrement: LongInt;
  94.     FButton: TSpinButton;
  95.     FEditorEnabled: Boolean;
  96.     function GetMinHeight: Integer;
  97.     function GetValue: LongInt;
  98.     function CheckValue (NewValue: LongInt): LongInt;
  99.     procedure SetValue (NewValue: LongInt);
  100.     procedure SetEditRect;
  101.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  102.     procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
  103.     procedure CMExit(var Message: TCMExit);   message CM_EXIT;
  104.     procedure WMPaste(var Message: TWMPaste);   message WM_PASTE;
  105.     procedure WMCut(var Message: TWMCut);   message WM_CUT;
  106.   protected
  107.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  108.     function IsValidChar(Key: Char): Boolean; virtual;
  109.     procedure UpClick (Sender: TObject); virtual;
  110.     procedure DownClick (Sender: TObject); virtual;
  111.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  112.     procedure KeyPress(var Key: Char); override;
  113.     procedure CreateParams(var Params: TCreateParams); override;
  114.     procedure CreateWnd; override;
  115.   public
  116.     constructor Create(AOwner: TComponent); override;
  117.     destructor Destroy; override;
  118.     property Button: TSpinButton read FButton;
  119.   published
  120.     property Anchors;
  121.     property AutoSelect;
  122.     property AutoSize;
  123.     property Color;
  124.     property Constraints;
  125.     property Ctl3D;
  126.     property DragCursor;
  127.     property DragMode;
  128.     property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
  129.     property Enabled;
  130.     property Font;
  131.     property Increment: LongInt read FIncrement write FIncrement default 1;
  132.     property MaxLength;
  133.     property MaxValue: LongInt read FMaxValue write FMaxValue;
  134.     property MinValue: LongInt read FMinValue write FMinValue;
  135.     property ParentColor;
  136.     property ParentCtl3D;
  137.     property ParentFont;
  138.     property ParentShowHint;
  139.     property PopupMenu;
  140.     property ReadOnly;
  141.     property ShowHint;
  142.     property TabOrder;
  143.     property TabStop;
  144.     property Value: LongInt read GetValue write SetValue;
  145.     property Visible;
  146.     property OnChange;
  147.     property OnClick;
  148.     property OnDblClick;
  149.     property OnDragDrop;
  150.     property OnDragOver;
  151.     property OnEndDrag;
  152.     property OnEnter;
  153.     property OnExit;
  154.     property OnKeyDown;
  155.     property OnKeyPress;
  156.     property OnKeyUp;
  157.     property OnMouseDown;
  158.     property OnMouseMove;
  159.     property OnMouseUp;
  160.     property OnStartDrag;
  161.   end;
  162.  
  163. { TTimerSpeedButton }
  164.  
  165.   TTimeBtnState = set of (tbFocusRect, tbAllowTimer);
  166.  
  167.   TTimerSpeedButton = class(TSpeedButton)
  168.   private
  169.     FRepeatTimer: TTimer;
  170.     FTimeBtnState: TTimeBtnState;
  171.     procedure TimerExpired(Sender: TObject);
  172.   protected
  173.     procedure Paint; override;
  174.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  175.       X, Y: Integer); override;
  176.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
  177.       X, Y: Integer); override;
  178.   public
  179.     destructor Destroy; override;
  180.     property TimeBtnState: TTimeBtnState read FTimeBtnState write FTimeBtnState;
  181.   end;
  182.  
  183. implementation
  184.  
  185. {$R SPIN}
  186.  
  187. { TSpinButton }
  188.  
  189. constructor TSpinButton.Create(AOwner: TComponent);
  190. begin
  191.   inherited Create(AOwner);
  192.   ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] +
  193.     [csFramed, csOpaque];
  194.  
  195.   FUpButton := CreateButton;
  196.   FDownButton := CreateButton;
  197.   UpGlyph := nil;
  198.   DownGlyph := nil;
  199.  
  200.   Width := 20;
  201.   Height := 25;
  202.   FFocusedButton := FUpButton;
  203. end;
  204.  
  205. function TSpinButton.CreateButton: TTimerSpeedButton;
  206. begin
  207.   Result := TTimerSpeedButton.Create (Self);
  208.   Result.OnClick := BtnClick;
  209.   Result.OnMouseDown := BtnMouseDown;
  210.   Result.Visible := True;
  211.   Result.Enabled := True;
  212.   Result.TimeBtnState := [tbAllowTimer];
  213.   Result.Parent := Self;
  214. end;
  215.  
  216. procedure TSpinButton.Notification(AComponent: TComponent;
  217.   Operation: TOperation);
  218. begin
  219.   inherited Notification(AComponent, Operation);
  220.   if (Operation = opRemove) and (AComponent = FFocusControl) then
  221.     FFocusControl := nil;
  222. end;
  223.  
  224. procedure TSpinButton.AdjustSize (var W, H: Integer);
  225. begin
  226.   if (FUpButton = nil) or (csLoading in ComponentState) then Exit;
  227.   if W < 15 then W := 15;
  228.   FUpButton.SetBounds (0, 0, W, H div 2);
  229.   FDownButton.SetBounds (0, FUpButton.Height - 1, W, H - FUpButton.Height + 1);
  230. end;
  231.  
  232. procedure TSpinButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  233. var
  234.   W, H: Integer;
  235. begin
  236.   W := AWidth;
  237.   H := AHeight;
  238.   AdjustSize (W, H);
  239.   inherited SetBounds (ALeft, ATop, W, H);
  240. end;
  241.  
  242. procedure TSpinButton.WMSize(var Message: TWMSize);
  243. var
  244.   W, H: Integer;
  245. begin
  246.   inherited;
  247.  
  248.   { check for minimum size }
  249.   W := Width;
  250.   H := Height;
  251.   AdjustSize (W, H);
  252.   if (W <> Width) or (H <> Height) then
  253.     inherited SetBounds(Left, Top, W, H);
  254.   Message.Result := 0;
  255. end;
  256.  
  257. procedure TSpinButton.WMSetFocus(var Message: TWMSetFocus);
  258. begin
  259.   FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
  260.   FFocusedButton.Invalidate;
  261. end;
  262.  
  263. procedure TSpinButton.WMKillFocus(var Message: TWMKillFocus);
  264. begin
  265.   FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
  266.   FFocusedButton.Invalidate;
  267. end;
  268.  
  269. procedure TSpinButton.KeyDown(var Key: Word; Shift: TShiftState);
  270. begin
  271.   case Key of
  272.     VK_UP:
  273.       begin
  274.         SetFocusBtn (FUpButton);
  275.         FUpButton.Click;
  276.       end;
  277.     VK_DOWN:
  278.       begin
  279.         SetFocusBtn (FDownButton);
  280.         FDownButton.Click;
  281.       end;
  282.     VK_SPACE:
  283.       FFocusedButton.Click;
  284.   end;
  285. end;
  286.  
  287. procedure TSpinButton.BtnMouseDown (Sender: TObject; Button: TMouseButton;
  288.   Shift: TShiftState; X, Y: Integer);
  289. begin
  290.   if Button = mbLeft then
  291.   begin
  292.     SetFocusBtn (TTimerSpeedButton (Sender));
  293.     if (FFocusControl <> nil) and FFocusControl.TabStop and 
  294.         FFocusControl.CanFocus and (GetFocus <> FFocusControl.Handle) then
  295.       FFocusControl.SetFocus
  296.     else if TabStop and (GetFocus <> Handle) and CanFocus then
  297.       SetFocus;
  298.   end;
  299. end;
  300.  
  301. procedure TSpinButton.BtnClick(Sender: TObject);
  302. begin
  303.   if Sender = FUpButton then
  304.   begin
  305.     if Assigned(FOnUpClick) then FOnUpClick(Self);
  306.   end
  307.   else
  308.     if Assigned(FOnDownClick) then FOnDownClick(Self);
  309. end;
  310.  
  311. procedure TSpinButton.SetFocusBtn (Btn: TTimerSpeedButton);
  312. begin
  313.   if TabStop and CanFocus and  (Btn <> FFocusedButton) then
  314.   begin
  315.     FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
  316.     FFocusedButton := Btn;
  317.     if (GetFocus = Handle) then 
  318.     begin
  319.        FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
  320.        Invalidate;
  321.     end;
  322.   end;
  323. end;
  324.  
  325. procedure TSpinButton.WMGetDlgCode(var Message: TWMGetDlgCode);
  326. begin
  327.   Message.Result := DLGC_WANTARROWS;
  328. end;
  329.  
  330. procedure TSpinButton.Loaded;
  331. var
  332.   W, H: Integer;
  333. begin
  334.   inherited Loaded;
  335.   W := Width;
  336.   H := Height;
  337.   AdjustSize (W, H);
  338.   if (W <> Width) or (H <> Height) then
  339.     inherited SetBounds (Left, Top, W, H);
  340. end;
  341.  
  342. function TSpinButton.GetUpGlyph: TBitmap;
  343. begin
  344.   Result := FUpButton.Glyph;
  345. end;
  346.  
  347. procedure TSpinButton.SetUpGlyph(Value: TBitmap);
  348. begin
  349.   if Value <> nil then
  350.     FUpButton.Glyph := Value
  351.   else
  352.   begin
  353.     FUpButton.Glyph.Handle := LoadBitmap(HInstance, 'SpinUp');
  354.     FUpButton.NumGlyphs := 1;
  355.     FUpButton.Invalidate;
  356.   end;
  357. end;
  358.  
  359. function TSpinButton.GetUpNumGlyphs: TNumGlyphs;
  360. begin
  361.   Result := FUpButton.NumGlyphs;
  362. end;
  363.  
  364. procedure TSpinButton.SetUpNumGlyphs(Value: TNumGlyphs);
  365. begin
  366.   FUpButton.NumGlyphs := Value;
  367. end;
  368.  
  369. function TSpinButton.GetDownGlyph: TBitmap;
  370. begin
  371.   Result := FDownButton.Glyph;
  372. end;
  373.  
  374. procedure TSpinButton.SetDownGlyph(Value: TBitmap);
  375. begin
  376.   if Value <> nil then
  377.     FDownButton.Glyph := Value
  378.   else
  379.   begin
  380.     FDownButton.Glyph.Handle := LoadBitmap(HInstance, 'SpinDown');
  381.     FUpButton.NumGlyphs := 1;
  382.     FDownButton.Invalidate;
  383.   end;
  384. end;
  385.  
  386. function TSpinButton.GetDownNumGlyphs: TNumGlyphs;
  387. begin
  388.   Result := FDownButton.NumGlyphs;
  389. end;
  390.  
  391. procedure TSpinButton.SetDownNumGlyphs(Value: TNumGlyphs);
  392. begin
  393.   FDownButton.NumGlyphs := Value;
  394. end;
  395.  
  396. { TSpinEdit }
  397.  
  398. constructor TSpinEdit.Create(AOwner: TComponent);
  399. begin
  400.   inherited Create(AOwner);
  401.   FButton := TSpinButton.Create (Self);
  402.   FButton.Width := 15;
  403.   FButton.Height := 17;
  404.   FButton.Visible := True;  
  405.   FButton.Parent := Self;
  406.   FButton.FocusControl := Self;
  407.   FButton.OnUpClick := UpClick;
  408.   FButton.OnDownClick := DownClick;
  409.   Text := '0';
  410.   ControlStyle := ControlStyle - [csSetCaption];
  411.   FIncrement := 1;
  412.   FEditorEnabled := True;
  413. end;
  414.  
  415. destructor TSpinEdit.Destroy;
  416. begin
  417.   FButton := nil;
  418.   inherited Destroy;
  419. end;
  420.  
  421. procedure TSpinEdit.GetChildren(Proc: TGetChildProc; Root: TComponent);
  422. begin
  423. end;
  424.  
  425. procedure TSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
  426. begin
  427.   if Key = VK_UP then UpClick (Self)
  428.   else if Key = VK_DOWN then DownClick (Self);
  429.   inherited KeyDown(Key, Shift);
  430. end;
  431.  
  432. procedure TSpinEdit.KeyPress(var Key: Char);
  433. begin
  434.   if not IsValidChar(Key) then
  435.   begin
  436.     Key := #0;
  437.     MessageBeep(0)
  438.   end;
  439.   if Key <> #0 then inherited KeyPress(Key);
  440. end;
  441.  
  442. function TSpinEdit.IsValidChar(Key: Char): Boolean;
  443. begin
  444.   Result := (Key in [DecimalSeparator, '+', '-', '0'..'9']) or
  445.     ((Key < #32) and (Key <> Chr(VK_RETURN)));
  446.   if not FEditorEnabled and Result and ((Key >= #32) or
  447.       (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then
  448.     Result := False;
  449. end;
  450.  
  451. procedure TSpinEdit.CreateParams(var Params: TCreateParams);
  452. begin
  453.   inherited CreateParams(Params);
  454. {  Params.Style := Params.Style and not WS_BORDER;  }
  455.   Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
  456. end;
  457.  
  458. procedure TSpinEdit.CreateWnd;
  459. begin
  460.   inherited CreateWnd;
  461.   SetEditRect;
  462. end;
  463.  
  464. procedure TSpinEdit.SetEditRect;
  465. var
  466.   Loc: TRect;
  467. begin
  468.   SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
  469.   Loc.Bottom := ClientHeight + 1;  {+1 is workaround for windows paint bug}
  470.   Loc.Right := ClientWidth - FButton.Width - 2;
  471.   Loc.Top := 0;  
  472.   Loc.Left := 0;  
  473.   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
  474.   SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));  {debug}
  475. end;
  476.  
  477. procedure TSpinEdit.WMSize(var Message: TWMSize);
  478. var
  479.   MinHeight: Integer;
  480. begin
  481.   inherited;
  482.   MinHeight := GetMinHeight;
  483.     { text edit bug: if size to less than minheight, then edit ctrl does
  484.       not display the text }
  485.   if Height < MinHeight then   
  486.     Height := MinHeight
  487.   else if FButton <> nil then
  488.   begin
  489.     if NewStyleControls and Ctl3D then
  490.       FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 5)
  491.     else FButton.SetBounds (Width - FButton.Width, 1, FButton.Width, Height - 3);
  492.     SetEditRect;
  493.   end;
  494. end;
  495.  
  496. function TSpinEdit.GetMinHeight: Integer;
  497. var
  498.   DC: HDC;
  499.   SaveFont: HFont;
  500.   I: Integer;
  501.   SysMetrics, Metrics: TTextMetric;
  502. begin
  503.   DC := GetDC(0);
  504.   GetTextMetrics(DC, SysMetrics);
  505.   SaveFont := SelectObject(DC, Font.Handle);
  506.   GetTextMetrics(DC, Metrics);
  507.   SelectObject(DC, SaveFont);
  508.   ReleaseDC(0, DC);
  509.   I := SysMetrics.tmHeight;
  510.   if I > Metrics.tmHeight then I := Metrics.tmHeight;
  511.   Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 2;
  512. end;
  513.  
  514. procedure TSpinEdit.UpClick (Sender: TObject);
  515. begin
  516.   if ReadOnly then MessageBeep(0)
  517.   else Value := Value + FIncrement;
  518. end;
  519.  
  520. procedure TSpinEdit.DownClick (Sender: TObject);
  521. begin
  522.   if ReadOnly then MessageBeep(0)
  523.   else Value := Value - FIncrement;
  524. end;
  525.  
  526. procedure TSpinEdit.WMPaste(var Message: TWMPaste);   
  527. begin
  528.   if not FEditorEnabled or ReadOnly then Exit;
  529.   inherited;
  530. end;
  531.  
  532. procedure TSpinEdit.WMCut(var Message: TWMPaste);   
  533. begin
  534.   if not FEditorEnabled or ReadOnly then Exit;
  535.   inherited;
  536. end;
  537.  
  538. procedure TSpinEdit.CMExit(var Message: TCMExit);
  539. begin
  540.   inherited;
  541.   if CheckValue (Value) <> Value then
  542.     SetValue (Value);
  543. end;
  544.  
  545. function TSpinEdit.GetValue: LongInt;
  546. begin
  547.   try
  548.     Result := StrToInt (Text);
  549.   except
  550.     Result := FMinValue;
  551.   end;
  552. end;
  553.  
  554. procedure TSpinEdit.SetValue (NewValue: LongInt);
  555. begin
  556.   Text := IntToStr (CheckValue (NewValue));
  557. end;
  558.  
  559. function TSpinEdit.CheckValue (NewValue: LongInt): LongInt;
  560. begin
  561.   Result := NewValue;
  562.   if (FMaxValue <> FMinValue) then
  563.   begin
  564.     if NewValue < FMinValue then
  565.       Result := FMinValue
  566.     else if NewValue > FMaxValue then
  567.       Result := FMaxValue;
  568.   end;
  569. end;
  570.  
  571. procedure TSpinEdit.CMEnter(var Message: TCMGotFocus);
  572. begin
  573.   if AutoSelect and not (csLButtonDown in ControlState) then
  574.     SelectAll;
  575.   inherited;
  576. end;
  577.  
  578. {TTimerSpeedButton}
  579.  
  580. destructor TTimerSpeedButton.Destroy;
  581. begin
  582.   if FRepeatTimer <> nil then
  583.     FRepeatTimer.Free;
  584.   inherited Destroy;
  585. end;
  586.  
  587. procedure TTimerSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  588.   X, Y: Integer);
  589. begin
  590.   inherited MouseDown (Button, Shift, X, Y);
  591.   if tbAllowTimer in FTimeBtnState then
  592.   begin
  593.     if FRepeatTimer = nil then
  594.       FRepeatTimer := TTimer.Create(Self);
  595.  
  596.     FRepeatTimer.OnTimer := TimerExpired;
  597.     FRepeatTimer.Interval := InitRepeatPause;
  598.     FRepeatTimer.Enabled  := True;
  599.   end;
  600. end;
  601.  
  602. procedure TTimerSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  603.                                   X, Y: Integer);
  604. begin
  605.   inherited MouseUp (Button, Shift, X, Y);
  606.   if FRepeatTimer <> nil then
  607.     FRepeatTimer.Enabled  := False;
  608. end;
  609.  
  610. procedure TTimerSpeedButton.TimerExpired(Sender: TObject);
  611. begin
  612.   FRepeatTimer.Interval := RepeatPause;
  613.   if (FState = bsDown) and MouseCapture then
  614.   begin
  615.     try
  616.       Click;
  617.     except
  618.       FRepeatTimer.Enabled := False;
  619.       raise;
  620.     end;
  621.   end;
  622. end;
  623.  
  624. procedure TTimerSpeedButton.Paint;
  625. var
  626.   R: TRect;
  627. begin
  628.   inherited Paint;
  629.   if tbFocusRect in FTimeBtnState then
  630.   begin
  631.     R := Bounds(0, 0, Width, Height);
  632.     InflateRect(R, -3, -3);
  633.     if FState = bsDown then
  634.       OffsetRect(R, 1, 1);
  635.     DrawFocusRect(Canvas.Handle, R);
  636.   end;
  637. end;
  638.  
  639. end.
  640.