home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmSpin.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  29KB  |  1,121 lines

  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmSpin
  5. Purpose  : Contains Multiple "Spin" edit controls.
  6. Date     : 09-03-1998
  7. Author   : Ryan J. Mills
  8. Version  : 1.80
  9. ================================================================================}
  10.  
  11. unit rmSpin;
  12.  
  13. interface
  14.  
  15. {$I CompilerDefines.INC}
  16.  
  17. uses Windows, Classes, StdCtrls, ExtCtrls, Controls, Messages, SysUtils,
  18.   Forms, Graphics, Menus, Buttons, rmBaseEdit, rmSpeedBtns;
  19.  
  20. type
  21.  
  22. { TrmCustomSpinEdit }
  23.  
  24.   TrmCustomSpinEdit = class(TrmCustomEdit)
  25.   private
  26.     FButton: TrmSpinButton;
  27.     FEditorEnabled: Boolean;
  28.     fUseRanges: boolean;
  29.     procedure SetEditRect;
  30.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  31.     procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
  32.     procedure WMPaste(var Message: TWMPaste);   message WM_PASTE;
  33.     procedure WMCut(var Message: TWMCut);   message WM_CUT;
  34.     procedure CMExit(var Message: TCMExit);   message CM_EXIT;
  35.  
  36.     {$ifdef D4_OR_HIGHER}
  37.     procedure SetEnabled(value:Boolean); reintroduce; (* reintroduce is D4 Modification *)
  38.     function GetEnabled:Boolean; reintroduce; (* reintroduce is D4 Modification *)
  39.     {$else}
  40.     procedure SetEnabled(value:Boolean);
  41.     function GetEnabled:Boolean;
  42.     {$endif}
  43.  
  44.     procedure SetUseRanges(const Value: boolean);
  45.   protected
  46.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  47.     procedure UpClick (Sender: TObject);
  48.     procedure DownClick (Sender: TObject);
  49.  
  50.     function IsValidChar(Key: Char): Boolean; virtual;
  51.     procedure DecValue; virtual; Abstract;
  52.     procedure IncValue; virtual; Abstract;
  53.     procedure ExitCheck; virtual; Abstract;
  54.     procedure InternalUpdate; virtual; Abstract;
  55.  
  56.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  57.     procedure KeyPress(var Key: Char); override;
  58.     procedure CreateParams(var Params: TCreateParams); override;
  59.     procedure CreateWnd; override;
  60.     property Button: TrmSpinButton read FButton;
  61.     property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
  62.     property Enabled: Boolean read GetEnabled write SetEnabled default True;
  63.     property UseRanges: boolean read fUseRanges write SetUseRanges default false;
  64.   public
  65.     constructor Create(AOwner: TComponent); override;
  66.     destructor Destroy; override;
  67.   end;
  68.  
  69. { TrmSpinEdit }
  70.  
  71.   TrmSpinEdit = class(TrmCustomSpinEdit)
  72.   private
  73.     FMinValue: Integer;
  74.     FMaxValue: Integer;
  75.     FIncrement: Integer;
  76.     function GetValue: Integer;
  77.     function CheckValue (NewValue: Integer): Integer;
  78.     procedure SetValue (NewValue: Integer);
  79.     procedure SetMaxValue(const Value: Integer);
  80.     procedure SetMinValue(const Value: Integer);
  81.   protected
  82.     function IsValidChar(Key: Char): Boolean; override;
  83.     procedure IncValue; override;
  84.     procedure DecValue; override;
  85.     procedure ExitCheck; override;
  86.     procedure InternalUpdate; override;
  87.   public
  88.     constructor Create(AOwner: TComponent); override;
  89.   published
  90.     property Increment: Integer read FIncrement write FIncrement default 1;
  91.     property MaxValue: Integer read FMaxValue write SetMaxValue;
  92.     property MinValue: Integer read FMinValue write SetMinValue;
  93.     property Value: Integer read GetValue write SetValue;
  94.  
  95.     property UseRanges;
  96.  
  97.     {$ifdef D4_OR_HIGHER}
  98.     property Anchors;
  99.     property Constraints;
  100.     {$endif}
  101.     property AutoSelect;
  102.     property AutoSize;
  103.     property BorderStyle;
  104.     property Color;
  105.     property Ctl3D;
  106.     property DragCursor;
  107.     property DragMode;
  108.     property EditorEnabled;
  109.     property Enabled;
  110.     property Font;
  111.     property MaxLength;
  112.     property ParentColor;
  113.     property ParentCtl3D;
  114.     property ParentFont;
  115.     property ParentShowHint;
  116.     property PopupMenu;
  117.     property ReadOnly;
  118.     property ShowHint;
  119.     property TabOrder;
  120.     property TabStop;
  121.     property Visible;
  122.     property OnChange;
  123.     property OnClick;
  124.     property OnDblClick;
  125.     property OnDragDrop;
  126.     property OnDragOver;
  127.     property OnEndDrag;
  128.     property OnEnter;
  129.     property OnExit;
  130.     property OnKeyDown;
  131.     property OnKeyPress;
  132.     property OnKeyUp;
  133.     property OnMouseDown;
  134.     property OnMouseMove;
  135.     property OnMouseUp;
  136.     property OnStartDrag;
  137.   end;
  138.  
  139. { TrmFloatSpinEdit }
  140.  
  141.   TrmFloatSpinEdit = class(TrmCustomSpinEdit)
  142.   private
  143.     FMinValue: Double;
  144.     FMaxValue: Double;
  145.     FIncrement: Double;
  146.     function GetValue: Double;
  147.     function CheckValue (NewValue: Double): Double;
  148.     procedure SetValue (NewValue: Double);
  149.     procedure SetMaxValue(const Value: Double);
  150.     procedure SetMinValue(const Value: Double);
  151.   protected
  152.     function IsValidChar(Key: Char): Boolean; override;
  153.     procedure IncValue; override;
  154.     procedure DecValue; override;
  155.     procedure ExitCheck; override;
  156.     procedure InternalUpdate; override;
  157.   public
  158.     constructor Create(AOwner: TComponent); override;
  159.   published
  160.     property Increment: Double read FIncrement write FIncrement;
  161.     property MaxValue: Double read FMaxValue write SetMaxValue;
  162.     property MinValue: Double read FMinValue write SetMinValue;
  163.     property Value: Double read GetValue write SetValue;
  164.  
  165.     property UseRanges;
  166.  
  167.     {$ifdef D4_OR_HIGHER}
  168.     property Anchors;
  169.     property Constraints;
  170.     {$endif}
  171.     property AutoSelect;
  172.     property AutoSize;
  173.     property BorderStyle;
  174.     property Color;
  175.     property Ctl3D;
  176.     property DragCursor;
  177.     property DragMode;
  178.     property EditorEnabled;
  179.     property Enabled;
  180.     property Font;
  181.     property MaxLength;
  182.     property ParentColor;
  183.     property ParentCtl3D;
  184.     property ParentFont;
  185.     property ParentShowHint;
  186.     property PopupMenu;
  187.     property ReadOnly;
  188.     property ShowHint;
  189.     property TabOrder;
  190.     property TabStop;
  191.     property Visible;
  192.     property OnChange;
  193.     property OnClick;
  194.     property OnDblClick;
  195.     property OnDragDrop;
  196.     property OnDragOver;
  197.     property OnEndDrag;
  198.     property OnEnter;
  199.     property OnExit;
  200.     property OnKeyDown;
  201.     property OnKeyPress;
  202.     property OnKeyUp;
  203.     property OnMouseDown;
  204.     property OnMouseMove;
  205.     property OnMouseUp;
  206.     property OnStartDrag;
  207.   end;
  208.  
  209. { TrmTimeSpinEdit }
  210.  
  211.   TrmTimeDisplay = (td24Hour, td12Hour);
  212.  
  213.   TrmTimeSpinEdit = class(TrmCustomSpinEdit)
  214.   private
  215.     FMinValue: TTime;
  216.     FMaxValue: TTime;
  217.     fTimeDisplay: TrmTimeDisplay;
  218.     fHour: shortint;
  219.     fMinute: shortint;
  220.     fSecond: shortint;
  221.     fFormat: string;
  222.     fShowSeconds: boolean;
  223.     function CheckValue (NewValue: TTime): TTime;
  224.     function GetValue: TTime;
  225.     function GetMaxValue:TTime;
  226.     function GetMinValue:TTime;
  227.     procedure SetValue(NewValue: TTime);
  228.     procedure SetMaxValue(const Value: TTime);
  229.     procedure SetMinValue(const Value: TTime);
  230.     procedure SetTimeDisplay(const Value: TrmTimeDisplay);
  231.     procedure SetShowSeconds(const Value: boolean);
  232.   protected
  233.     function IsValidChar(Key: Char): Boolean; override;
  234.     procedure IncValue; override;
  235.     procedure DecValue; override;
  236.     procedure ExitCheck; override;
  237.     procedure InternalUpdate; override;
  238.     procedure UpdateText;
  239.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  240.   public
  241.     constructor Create(AOwner: TComponent); override;
  242.   published
  243.     property MaxValue: TTime read GetMaxValue write SetMaxValue;
  244.     property MinValue: TTime read GetMinValue write SetMinValue;
  245.     property TimeDisplay:TrmTimeDisplay read fTimeDisplay write SetTimeDisplay default td24hour;
  246.     property ShowSeconds:boolean read fShowSeconds write SetShowSeconds default false;
  247.  
  248.     property Value: TTime read GetValue write SetValue;
  249.     property UseRanges;
  250.  
  251.     {$ifdef D4_OR_HIGHER}
  252.     property Anchors;
  253.     property Constraints;
  254.     {$endif}
  255.     property AutoSelect;
  256.     property AutoSize;
  257.     property BorderStyle;
  258.     property Color;
  259.     property Ctl3D;
  260.     property DragCursor;
  261.     property DragMode;
  262.     property EditorEnabled;
  263.     property Enabled;
  264.     property Font;
  265.     property ParentColor;
  266.     property ParentCtl3D;
  267.     property ParentFont;
  268.     property ParentShowHint;
  269.     property PopupMenu;
  270.     property ReadOnly;
  271.     property ShowHint;
  272.     property TabOrder;
  273.     property TabStop;
  274.     property Visible;
  275.     property OnChange;
  276.     property OnClick;
  277.     property OnDblClick;
  278.     property OnDragDrop;
  279.     property OnDragOver;
  280.     property OnEndDrag;
  281.     property OnEnter;
  282.     property OnExit;
  283.     property OnKeyDown;
  284.     property OnKeyPress;
  285.     property OnKeyUp;
  286.     property OnMouseDown;
  287.     property OnMouseMove;
  288.     property OnMouseUp;
  289.     property OnStartDrag;
  290.   end;
  291.  
  292. implementation
  293.  
  294. { TrmCustomSpinEdit }
  295.  
  296. constructor TrmCustomSpinEdit.Create(AOwner: TComponent);
  297. begin
  298.   inherited Create(AOwner);
  299.   FButton := TrmSpinButton.Create (Self);
  300.   with FButton Do
  301.   begin
  302.      align := alRight;
  303.      Visible := True;
  304.      Parent := Self;
  305.      FocusControl := Self;
  306.      OnUpClick := UpClick;
  307.      OnDownClick := DownClick;
  308.   end;
  309.   fUseRanges := false;
  310.   Text := '';
  311.   ControlStyle := ControlStyle - [csSetCaption];
  312.   FEditorEnabled := True;
  313. end;
  314.  
  315. destructor TrmCustomSpinEdit.Destroy;
  316. begin
  317.   FButton := nil;
  318.   inherited Destroy;
  319. end;
  320.  
  321. procedure TrmCustomSpinEdit.DownClick(Sender: TObject);
  322. begin
  323.   if ReadOnly then
  324.      MessageBeep(0)
  325.   else
  326.   begin
  327.      if FButton.DownEnabled then
  328.         DecValue;
  329.   end;
  330. end;
  331.  
  332. procedure TrmCustomSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
  333. begin
  334.   if Key = VK_UP then
  335.   begin
  336.      UpClick (Self);
  337.      key := 0;
  338.   end
  339.   else if Key = VK_DOWN then
  340.   begin
  341.      DownClick (Self);
  342.      key := 0;
  343.   end;
  344.   inherited KeyDown(Key, Shift);
  345. end;
  346.  
  347. procedure TrmCustomSpinEdit.KeyPress(var Key: Char);
  348. begin
  349.   if not IsValidChar(Key) then
  350.   begin
  351.     Key := #0;
  352.     MessageBeep(0)
  353.   end;
  354.   if Key <> #0 then inherited KeyPress(Key);
  355. end;
  356.  
  357. procedure TrmCustomSpinEdit.CreateParams(var Params: TCreateParams);
  358. begin
  359.   inherited CreateParams(Params);
  360.   Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
  361. end;
  362.  
  363. procedure TrmCustomSpinEdit.CreateWnd;
  364. begin
  365.   inherited CreateWnd;
  366.   SetEditRect;
  367. end;
  368.  
  369. procedure TrmCustomSpinEdit.SetEditRect;
  370. var
  371.   R: TRect;
  372. begin
  373.   SendMessage(Handle, EM_GETRECT, 0, LongInt(@R));
  374.   R.Right := ClientWidth - FButton.Width - 1;
  375.   R.Top := 0;
  376.   R.Left := 0;
  377.   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@R));
  378.   SendMessage(Handle, EM_GETRECT, 0, LongInt(@R));  {debug}
  379. end;
  380.  
  381. procedure TrmCustomSpinEdit.WMSize(var Message: TWMSize);
  382. begin
  383.   inherited;
  384.   if NewStyleControls and Ctl3D then
  385.      FButton.SetBounds((width - FButton.Width) - 4, 0, FButton.Width, Height - 4)
  386.   else
  387.      FButton.SetBounds (width - FButton.Width, 1, FButton.Width, Height - 2);
  388.   SetEditRect;
  389. end;
  390.  
  391. procedure TrmCustomSpinEdit.UpClick (Sender: TObject);
  392. begin
  393.   if ReadOnly then
  394.      MessageBeep(0)
  395.   else
  396.   begin
  397.      if FButton.UpEnabled then
  398.         IncValue;
  399.   end;
  400. end;
  401.  
  402. procedure TrmCustomSpinEdit.WMPaste(var Message: TWMPaste);
  403. begin
  404.   if not FEditorEnabled or ReadOnly then Exit;
  405.   inherited;
  406. end;
  407.  
  408. procedure TrmCustomSpinEdit.WMCut(var Message: TWMPaste);
  409. begin
  410.   if not FEditorEnabled or ReadOnly then Exit;
  411.   inherited;
  412. end;
  413.  
  414. procedure TrmCustomSpinEdit.CMEnter(var Message: TCMGotFocus);
  415. begin
  416.   if AutoSelect and not (csLButtonDown in ControlState) then
  417.     SelectAll;
  418.   inherited;
  419. end;
  420.  
  421. procedure TrmCustomSpinEdit.CMExit(var Message: TCMExit);
  422. begin
  423.   inherited;
  424.   ExitCheck;
  425. end;
  426.  
  427. procedure TrmCustomSpinEdit.GetChildren(Proc: TGetChildProc; Root: TComponent);
  428. begin
  429. //Do nothing;
  430. end;
  431.  
  432. function TrmCustomSpinEdit.GetEnabled: Boolean;
  433. begin
  434.    result := inherited Enabled;
  435. end;
  436.  
  437. procedure TrmCustomSpinEdit.SetEnabled(value: Boolean);
  438. begin
  439.    inherited enabled := value;
  440.    fButton.enabled := value;
  441. end;
  442.  
  443. function TrmCustomSpinEdit.IsValidChar(Key: Char): Boolean;
  444. begin
  445.    result := false;
  446. end;
  447.  
  448. procedure TrmCustomSpinEdit.SetUseRanges(const Value: boolean);
  449. begin
  450.   fUseRanges := Value;
  451.   InternalUpdate;
  452. end;
  453.  
  454. { TrmSpinEdit }
  455.  
  456. constructor TrmSpinEdit.Create(AOwner: TComponent);
  457. begin
  458.   inherited Create(AOwner);
  459.   Text := '0';
  460.   FIncrement := 1;
  461. end;
  462.  
  463. function TrmSpinEdit.IsValidChar(Key: Char): Boolean;
  464. begin
  465.   Result := (Key in [DecimalSeparator, '+', '-', '0'..'9']) or
  466.     ((Key < #32) and (Key <> Chr(VK_RETURN)));
  467.   if not FEditorEnabled and Result and ((Key >= #32) or
  468.       (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then
  469.     Result := False;
  470. end;
  471.  
  472. function TrmSpinEdit.GetValue: Integer;
  473. begin
  474.   try
  475.     Result := StrToInt (Text);
  476.   except
  477.     Result := FMinValue;
  478.   end;
  479. end;
  480.  
  481. procedure TrmSpinEdit.SetValue (NewValue: Integer);
  482. begin
  483.   Text := IntToStr (CheckValue (NewValue));
  484. end;
  485.  
  486. function TrmSpinEdit.CheckValue (NewValue: Integer): Integer;
  487. begin
  488.   Result := NewValue;
  489.   if UseRanges then
  490.   begin
  491.      if NewValue < FMinValue then
  492.        Result := FMinValue
  493.      else if NewValue > FMaxValue then
  494.        Result := FMaxValue;
  495.  
  496.      Button.UpEnabled := (NewValue < FMaxValue);
  497.      Button.DownEnabled := (NewValue > FMinValue);
  498.   end
  499.   else
  500.   begin
  501.      Button.UpEnabled := true;
  502.      Button.DownEnabled := true;
  503.   end;
  504. end;
  505.  
  506. procedure TrmSpinEdit.DecValue;
  507. begin
  508.   Value := Value - FIncrement;
  509.   selectall;
  510. end;
  511.  
  512. procedure TrmSpinEdit.IncValue;
  513. begin
  514.   Value := Value + FIncrement;
  515.   selectall;
  516. end;
  517.  
  518. procedure TrmSpinEdit.ExitCheck;
  519. begin
  520.   if CheckValue (Value) <> Value then
  521.      SetValue (Value);
  522. end;
  523.  
  524. procedure TrmSpinEdit.SetMaxValue(const Value: Integer);
  525. begin
  526.   if value >= fMinValue then
  527.   begin
  528.      FMaxValue := Value;
  529.      CheckValue(GetValue);
  530.   end;
  531. end;
  532.  
  533. procedure TrmSpinEdit.SetMinValue(const Value: Integer);
  534. begin
  535.   if Value <= fMaxValue then
  536.   begin
  537.      FMinValue := Value;
  538.      CheckValue(GetValue);
  539.   end;
  540. end;
  541.  
  542. procedure TrmSpinEdit.InternalUpdate;
  543. begin
  544.   value := CheckValue(GetValue);
  545. end;
  546.  
  547. { TrmFloatSpinEdit }
  548.  
  549. function TrmFloatSpinEdit.CheckValue(NewValue: Double): Double;
  550. begin
  551.   Result := NewValue;
  552.   if UseRanges then
  553.   begin
  554.      if NewValue < FMinValue then
  555.        Result := FMinValue
  556.      else if NewValue > FMaxValue then
  557.        Result := FMaxValue;
  558.  
  559.      Button.UpEnabled := (NewValue < FMaxValue);
  560.      Button.DownEnabled := (NewValue > FMinValue);
  561.   end
  562.   else
  563.   begin
  564.      Button.UpEnabled := true;
  565.      Button.DownEnabled := true;
  566.   end;
  567. end;
  568.  
  569. constructor TrmFloatSpinEdit.Create(AOwner: TComponent);
  570. begin
  571.   inherited Create(AOwner);
  572.   Text := '0';
  573.   FIncrement := 1;
  574. end;
  575.  
  576. procedure TrmFloatSpinEdit.DecValue;
  577. begin
  578.   Value := Value - FIncrement;
  579.   selectall;
  580. end;
  581.  
  582. procedure TrmFloatSpinEdit.ExitCheck;
  583. begin
  584.   if CheckValue (Value) <> Value then
  585.      SetValue (Value);
  586. end;
  587.  
  588. function TrmFloatSpinEdit.GetValue: Double;
  589. begin
  590.   try
  591.     Result := StrToFloat(Text);
  592.   except
  593.     Result := FMinValue;
  594.   end;
  595. end;
  596.  
  597. procedure TrmFloatSpinEdit.IncValue;
  598. begin
  599.   Value := Value + FIncrement;
  600.   selectall;
  601. end;
  602.  
  603. procedure TrmFloatSpinEdit.InternalUpdate;
  604. begin
  605.    Value := CheckValue(GetValue);  
  606. end;
  607.  
  608. function TrmFloatSpinEdit.IsValidChar(Key: Char): Boolean;
  609. begin
  610.   Result := (Key in [DecimalSeparator, '+', '-', '0'..'9']) or
  611.     ((Key < #32) and (Key <> Chr(VK_RETURN)));
  612.   if not FEditorEnabled and Result and ((Key >= #32) or
  613.       (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then
  614.     Result := False;
  615. end;
  616.  
  617. procedure TrmFloatSpinEdit.SetMaxValue(const Value: Double);
  618. begin
  619.   if value >= fMinValue then
  620.   begin
  621.      FMaxValue := Value;
  622.      CheckValue(GetValue);
  623.   end;
  624. end;
  625.  
  626. procedure TrmFloatSpinEdit.SetMinValue(const Value: Double);
  627. begin
  628.   if value <= fMaxValue then
  629.   begin
  630.      FMinValue := Value;
  631.      CheckValue(GetValue);
  632.   end;
  633. end;
  634.  
  635. procedure TrmFloatSpinEdit.SetValue(NewValue: Double);
  636. begin
  637.   Text := FormatFloat('#######0.00', CheckValue (NewValue));
  638. end;
  639.  
  640. { TrmTimeSpinEdit }
  641.  
  642. function TrmTimeSpinEdit.CheckValue(NewValue: TTime): TTime;
  643. begin
  644.   Result := NewValue;
  645.   if UseRanges then
  646.   begin
  647.      if NewValue < FMinValue then
  648.        Result := FMinValue
  649.      else if NewValue > FMaxValue then
  650.        Result := FMaxValue;
  651.  
  652.      Button.UpEnabled := (NewValue < FMaxValue);
  653.      Button.DownEnabled := (NewValue > FMinValue);
  654.   end
  655.   else
  656.   begin
  657.      Button.UpEnabled := true;
  658.      Button.DownEnabled := true;
  659.   end;
  660. end;
  661.  
  662. constructor TrmTimeSpinEdit.Create(AOwner: TComponent);
  663. begin
  664.   inherited;
  665.   fTimeDisplay := td24Hour;
  666.   fShowSeconds := false;
  667.   fFormat := 'hh:mm:ss';
  668.   fMinValue := EncodeTime(12,0,0,0);
  669.   fMaxValue := EncodeTime(12,0,0,0);
  670.   Value := EncodeTime(12,0,0,0);
  671. end;
  672.  
  673. procedure TrmTimeSpinEdit.DecValue;
  674. var
  675.    wss : integer;
  676.    wsl : integer;
  677.    wNewTime : TTime;
  678. begin
  679.    wss := 0;
  680.    wsl := 0;
  681.    case fTimeDisplay of
  682.    td24Hour:
  683.      begin
  684.         case SelStart of
  685.           0, 1, 2:begin
  686.                  dec(fHour);
  687.                  if fhour < 0 then
  688.                     fhour := 23;
  689.                  wss := 0;
  690.                  wsl := 2;
  691.                end;
  692.           3, 4, 5:begin
  693.                  dec(fMinute);
  694.                  if fMinute < 0 then
  695.                     fMinute := 59;
  696.                  wss := 3;
  697.                  wsl := 2;
  698.                end;
  699.           6, 7, 8:begin
  700.                  dec(fSecond);
  701.                  if fSecond < 0 then
  702.                     fSecond := 59;
  703.                  wss := 6;
  704.                  wsl := 2;
  705.                end;
  706.         end;
  707.      end;
  708.    td12Hour:
  709.      begin
  710.         case SelStart of
  711.           0, 1, 2:begin
  712.                     if fHour > 11 then
  713.                     begin
  714.                        dec(fHour);
  715.                        if fhour < 12 then
  716.                           fhour := 23;
  717.                     end
  718.                     else
  719.                     begin
  720.                        dec(fHour);
  721.                        if fhour < 0 then
  722.                           fhour := 11;
  723.                     end;
  724.                     wss := 0;
  725.                     wsl := 2;
  726.                   end;
  727.           3, 4, 5:begin
  728.                     dec(fMinute);
  729.                     if fMinute < 0 then
  730.                        fMinute := 59;
  731.                     wss := 3;
  732.                     wsl := 2;
  733.                   end;
  734.           6, 7, 8:begin
  735.                      if fShowSeconds then
  736.                      begin
  737.                         dec(fSecond);
  738.                         if fSecond < 0 then
  739.                            fSecond := 59;
  740.                         wss := 6;
  741.                         wsl := 2;
  742.                      end
  743.                      else
  744.                      begin
  745.                         inc(fHour, 12);
  746.                         if fhour > 23 then
  747.                            dec(fhour, 24);
  748.                         wss := 6;
  749.                         wsl := 3;
  750.                      end;
  751.                   end;
  752.           9, 10, 11:begin
  753.                         inc(fHour, 12);
  754.                         if fhour > 23 then
  755.                            dec(fhour, 24);
  756.                         wss := 9;
  757.                         wsl := 3;
  758.                     end;
  759.         end;
  760.      end;
  761.    end;
  762.    wNewTime := CheckValue(value);
  763.    Value := wNewTime;
  764.    UpdateText;
  765.    SelStart := wss;
  766.    SelLength := wsl;
  767. end;
  768.  
  769. procedure TrmTimeSpinEdit.ExitCheck;
  770. begin
  771.   if CheckValue (Value) <> Value then
  772.      SetValue (Value);
  773. end;
  774.  
  775. function TrmTimeSpinEdit.GetMaxValue: TTime;
  776. var
  777.    wh, wm, ws, wms : word;
  778. begin
  779.    if csdesigning in componentstate then
  780.    begin
  781.       decodetime(FMaxValue, wh, wm, ws, wms);
  782.       result := encodetime(wh, wm, ws, 1);
  783.    end
  784.    else
  785.    result := fMaxValue;
  786. end;
  787.  
  788. function TrmTimeSpinEdit.GetMinValue: TTime;
  789. var
  790.    wh, wm, ws, wms : word;
  791. begin
  792.    if csdesigning in componentstate then
  793.    begin
  794.       decodetime(FMinValue, wh, wm, ws, wms);
  795.       result := encodetime(wh, wm, ws, 1);
  796.    end
  797.    else
  798.    result:= fMinValue;
  799. end;
  800.  
  801. function TrmTimeSpinEdit.GetValue: TTime;
  802. begin
  803.   try
  804.      if csdesigning in componentstate then
  805.         Result := EncodeTime(fHour, fminute, fsecond, 1)
  806.      else
  807.         result := EncodeTime(fHour, fminute, fsecond, 0);
  808.   except
  809.     Result := FMinValue;
  810.   end;
  811. end;
  812.  
  813. procedure TrmTimeSpinEdit.IncValue;
  814. var
  815.    wss : integer;
  816.    wsl : integer;
  817.    wNewTime : TTime;
  818. begin
  819.    wss := 0;
  820.    wsl := 0;
  821.    case fTimeDisplay of
  822.    td24Hour:
  823.      begin
  824.         case SelStart of
  825.           0, 1, 2:begin
  826.                  inc(fHour);
  827.                  if fhour > 23 then
  828.                     fhour := 0;
  829.                  wss := 0;
  830.                  wsl := 2;
  831.                end;
  832.           3, 4, 5:begin
  833.                  inc(fMinute);
  834.                  if fMinute > 59 then
  835.                     fMinute := 0;
  836.                  wss := 3;
  837.                  wsl := 2;
  838.                end;
  839.           6, 7, 8:begin
  840.                  inc(fSecond);
  841.                  if fSecond > 59 then
  842.                     fSecond := 0;
  843.                  wss := 6;
  844.                  wsl := 2;
  845.                end;
  846.         end;
  847.      end;
  848.    td12Hour:
  849.      begin
  850.         case SelStart of
  851.           0, 1, 2:begin
  852.                  if fHour > 11 then
  853.                  begin
  854.                     inc(fHour);
  855.                     if fhour > 23 then
  856.                        fhour := 12;
  857.                  end
  858.                  else
  859.                  begin
  860.                     inc(fHour);
  861.                     if fhour > 11 then
  862.                        fhour := 0;
  863.                  end;
  864.                  wss := 0;
  865.                  wsl := 2;
  866.                end;
  867.           3, 4, 5:begin
  868.                  inc(fMinute);
  869.                  if fMinute > 59 then
  870.                     fMinute := 0;
  871.                  wss := 3;
  872.                  wsl := 2;
  873.                end;
  874.           6, 7, 8:begin
  875.                      if fShowSeconds then
  876.                      begin
  877.                         inc(fSecond);
  878.                         if fSecond > 59 then
  879.                            fSecond := 0;
  880.                         wss := 6;
  881.                         wsl := 2;
  882.                      end
  883.                      else
  884.                      begin
  885.                         inc(fHour, 12);
  886.                         if fhour > 23 then
  887.                            dec(fhour, 24);
  888.                         wss := 6;
  889.                         wsl := 3;
  890.                      end;
  891.                end;
  892.           9, 10, 11:begin
  893.                         inc(fHour, 12);
  894.                         if fhour > 23 then
  895.                            dec(fhour, 24);
  896.                         wss := 9;
  897.                         wsl := 3;
  898.                     end;
  899.         end;
  900.      end;
  901.    end;
  902.    wNewTime := CheckValue(value);
  903.    Value := wNewTime;
  904.    UpdateText;
  905.    SelStart := wss;
  906.    SelLength := wsl;
  907. end;
  908.  
  909. procedure TrmTimeSpinEdit.InternalUpdate;
  910. begin
  911.    value := CheckValue(Value);
  912. end;
  913.  
  914. function TrmTimeSpinEdit.IsValidChar(Key: Char): Boolean;
  915. var
  916.    wNewTime : TTime;
  917.    wStr : string;
  918.    wMs, wh, wm, ws : word;
  919. begin
  920.    result := false;
  921.    wNewTime := 0.0; 
  922.    wstr := Text;
  923.    case fTimeDisplay of
  924.      td24Hour:
  925.        begin
  926.           case SelStart of
  927.             0, 1, 3, 4, 6, 7:
  928.                begin
  929.                    wstr[SelStart+1] := key;
  930.                    try
  931.                       wNewTime := CheckValue(StrToTime(wstr));
  932.                       result := true;
  933.                    except
  934.                       result := false;
  935.                    end;
  936.                end;
  937.           else
  938.              result := false;
  939.           end;
  940.        end;
  941.      td12Hour:
  942.        begin
  943.           case SelStart of
  944.             0, 1, 3, 4:
  945.             begin
  946.                wstr[SelStart+1] := key;
  947.                try
  948.                   wNewTime := CheckValue(StrToTime(wstr));
  949.                   result := true;
  950.                except
  951.                   result := false;
  952.                end;
  953.             end;
  954.             6, 7, 8, 9, 10, 11 :
  955.             begin
  956.                if fShowSeconds then
  957.                begin
  958.                   if (selStart = 6) or (selStart = 7) then
  959.                   begin
  960.                      wstr[SelStart+1] := key;
  961.                      try
  962.                         wNewTime := CheckValue(StrToTime(wstr));
  963.                         result := true;
  964.                      except
  965.                         result := false;
  966.                      end;
  967.                   end
  968. {
  969. //This has been commented out until I can figure out a nice way of updating the
  970. //text with out screwing up the values...
  971.                   else if (selstart = 9) then
  972.                   begin
  973.                      result := (key in ['a','A','p','P']);
  974.                      wstr[SelStart+1] := key;
  975.                      try
  976.                         wNewTime := CheckValue(StrToTime(wstr));
  977.                         result := true;
  978.                      except
  979.                         result := false;
  980.                      end;
  981.                   end    }
  982.                   else
  983.                   result := false;
  984.                end
  985.                else
  986.                begin
  987. {
  988. //This has been commented out until I can figure out a nice way of updating the
  989. //text with out screwing up the values...
  990.                   if (selstart = 6) then
  991.                   begin
  992.                      result := (key in ['a','A','p','P']);
  993.                      wstr[SelStart+1] := key;
  994.                      try
  995.                         wNewTime := CheckValue(StrToTime(wstr));
  996.                         result := true;
  997.                      except
  998.                         result := false;
  999.                      end;
  1000.                   end
  1001.                   else   }
  1002.                   result := false;
  1003.                end;
  1004.             end;
  1005.           else
  1006.              result := false;
  1007.           end;
  1008.        end;
  1009.    end;
  1010.    if result then
  1011.    begin
  1012.       sellength := 1;
  1013.       DecodeTime(wNewTime, wh, wm, ws, wms);
  1014.       fhour := wh;
  1015.       fMinute := wm;
  1016.       fSecond := ws;
  1017.    end;
  1018. end;
  1019.  
  1020. procedure TrmTimeSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
  1021. begin
  1022.   if key = vk_Delete then
  1023.      key := 0;
  1024.   inherited;
  1025. end;
  1026.  
  1027. procedure TrmTimeSpinEdit.SetMaxValue(const Value: TTime);
  1028. begin
  1029.   if value >= fMinValue then
  1030.   begin
  1031.      FMaxValue := Value;
  1032.      CheckValue(GetValue);
  1033.   end;
  1034. end;
  1035.  
  1036. procedure TrmTimeSpinEdit.SetMinValue(const Value: TTime);
  1037. begin
  1038.   if value <= fMaxValue then
  1039.   begin
  1040.      FMinValue := Value;
  1041.      CheckValue(GetValue);
  1042.   end;
  1043. end;
  1044.  
  1045. procedure TrmTimeSpinEdit.SetShowSeconds(const Value: boolean);
  1046. begin
  1047.   fShowSeconds := Value;
  1048.   InternalUpdate;
  1049. end;
  1050.  
  1051. procedure TrmTimeSpinEdit.SetTimeDisplay(const Value: TrmTimeDisplay);
  1052. begin
  1053.   if value <> fTimedisplay then
  1054.   begin
  1055.      fTimeDisplay := Value;
  1056.      InternalUpdate;
  1057.   end;
  1058. end;
  1059.  
  1060. procedure TrmTimeSpinEdit.SetValue(NewValue: TTime);
  1061. var
  1062.    wms : word;
  1063.    wh, wm, ws : word;
  1064. begin
  1065.    decodeTime(NewValue, wh, wm, ws, wms);
  1066.    fHour := wh; 
  1067.    fMinute := wm;
  1068.    fSecond := ws;
  1069.    UpdateText;
  1070. end;
  1071.  
  1072. procedure TrmTimeSpinEdit.UpdateText;
  1073.    function LeftPad(st:string; ch:char; len:integer):string;
  1074.    begin
  1075.       while length(st) < len do
  1076.             st := ch+st;
  1077.       result := st;
  1078.    end;
  1079. var
  1080.    wStr : string;
  1081.    wAM : boolean;
  1082. begin
  1083.    case fTimeDisplay of
  1084.       td24Hour :
  1085.         begin
  1086.            wstr := leftpad(inttostr(fHour),'0',2)+TimeSeparator+leftpad(inttostr(fMinute),'0', 2);
  1087.            if fShowSeconds then
  1088.               wstr := wstr+TimeSeparator+leftpad(inttostr(fsecond),'0', 2);
  1089.         end;
  1090.       td12Hour :
  1091.         begin
  1092.            wAM := (fHour-12 < 0);
  1093.            if wAm then
  1094.            begin
  1095.               if fhour > 0 then
  1096.                  wstr := leftpad(inttostr(fHour),' ',2)
  1097.               else
  1098.                  wStr := '12';
  1099.            end
  1100.            else
  1101.            begin
  1102.               if fhour-12 > 0 then
  1103.                  wStr := leftpad(inttostr(fHour-12),' ',2)
  1104.               else
  1105.                  wStr := '12';
  1106.            end;
  1107.            wstr := wstr+TimeSeparator+leftpad(inttostr(fMinute),'0', 2);
  1108.            if fShowSeconds then
  1109.               wstr := wstr+TimeSeparator+leftpad(inttostr(fsecond),'0', 2);
  1110.  
  1111.            if wAm then
  1112.               wstr := wstr + ' ' + TimeAMString
  1113.            else
  1114.               wstr := wstr + ' ' + TimePMString;
  1115.         end;
  1116.    end;
  1117.    text := wstr;
  1118. end;
  1119.  
  1120. end.
  1121.