home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d56 / DM2KVCL.ZIP / FLOATED.PAS < prev    next >
Pascal/Delphi Source File  |  2000-09-12  |  4KB  |  123 lines
  1. {****************************************************************************}
  2. {                            Data Master 2000                                }
  3. {****************************************************************************}
  4. unit FloatEd;
  5.  
  6. interface
  7.  
  8. uses
  9.   Windows, Messages, SysUtils, Classes, Graphics, Controls,
  10.   Forms, Dialogs, StdCtrls, Spin;
  11.  
  12. {This simple descendant of TSpinEdit works with extended numbers}
  13.  
  14. type
  15.   TFloatEdit=class(TSpinEdit)
  16.   private
  17.     FIncrement,FMinValue,FMaxValue: extended;
  18.     FMinWidth, FDecimals: integer;
  19.     FFType: TFloatFormat;
  20.     FMultiply: boolean;
  21.     procedure SetValue(NewValue: extended);
  22.     function GetValue: extended;
  23.     function CheckValue(NewValue: extended): extended;
  24.     procedure SetFType(T: TFloatFormat);
  25.     procedure SetMinWidth(I: integer);
  26.     procedure SetDecimals(I: integer);
  27.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  28.  protected
  29.     function IsValidChar(Key: Char): Boolean; override;
  30.     procedure UpClick (Sender: TObject); override;
  31.     procedure DownClick (Sender: TObject); override;
  32.   public
  33.     constructor Create(AOwner: TComponent); override;
  34.   published
  35.     property Value: extended read GetValue write SetValue;
  36.     property FType: TFloatFormat read FFType write SetFType;
  37.     property MinWidth: integer read FMinWidth write SetMinWidth;
  38.     property Decimals: integer read FDecimals write SetDecimals;
  39.     property Increment: extended read FIncrement write FIncrement;
  40.     property MinValue: extended read FMinValue write FMinValue;
  41.     property MaxValue: extended read FMaxValue write FMaxValue;
  42.     property Multiply: boolean read FMultiply write FMultiply;
  43.   end;
  44.  
  45. procedure Register;
  46.  
  47. implementation
  48.  
  49. function TFloatEdit.GetValue: extended;
  50. begin
  51.   try
  52.     Result:=StrToFloat(Text);
  53.   except
  54.     Result:=FMinValue;
  55.   end;
  56. end;
  57.  
  58. procedure TFloatEdit.SetValue(NewValue: extended);
  59. begin
  60.   Text:=FloatToStrF(CheckValue(NewValue), FFType, FMinWidth, FDecimals);
  61. end;
  62.  
  63. procedure TFloatEdit.SetFType(T: TFloatFormat);
  64. begin if T<>FFType then begin FFType:=T; SetValue(Value); end; end;
  65.  
  66. procedure TFloatEdit.SetMinWidth(I: integer);
  67. begin if I<>FMinWidth then begin FMinWidth:=I; SetValue(Value); end; end;
  68.  
  69. procedure TFloatEdit.SetDecimals(I: integer);
  70. begin if I<>FDecimals then begin FDecimals:=I; SetValue(Value); end; end;
  71.  
  72. function TFloatEdit.CheckValue(NewValue: extended): extended;
  73. begin
  74.   Result:=NewValue;
  75.   if (FMaxValue<>FMinValue) then
  76.   begin
  77.     if NewValue<FMinValue then Result:=FMinValue
  78.     else if NewValue>FMaxValue then Result:=FMaxValue;
  79.   end;
  80. end;
  81.  
  82. constructor TFloatEdit.Create(AOwner: TComponent);
  83. begin
  84.   inherited Create(AOwner);
  85.   FIncrement:=1; FFType:=ffGeneral; FMinWidth:=10; FDecimals:=4;
  86.   FMultiply:=false;
  87. end;
  88.  
  89. function TFloatEdit.IsValidChar(Key: Char): Boolean;
  90. begin
  91.   Result:=(Key in [DecimalSeparator, '+', '-', '0'..'9', 'e', 'E']) or
  92.     ((Key < #32) and (Key <> Chr(VK_RETURN)));
  93.   if not EditorEnabled and Result and ((Key >= #32) or
  94.       (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then
  95.     Result := False;
  96. end;
  97.  
  98. procedure TFloatEdit.UpClick (Sender: TObject);
  99. begin
  100.   if ReadOnly then MessageBeep(0) else
  101.   if Multiply then Value:=Value*FIncrement else Value:=Value+FIncrement;
  102. end;
  103.  
  104. procedure TFloatEdit.DownClick (Sender: TObject);
  105. begin
  106.   if (FIncrement=0) or ReadOnly then MessageBeep(0) else
  107.   if Multiply then Value:=Value/FIncrement else Value:=Value-FIncrement;
  108. end;
  109.  
  110. procedure TFloatEdit.CMExit(var Message: TCMExit);
  111. begin
  112.   DoExit;
  113.   {^support inherited behavior, i.e. OnExit; but "inherited;" cause integer
  114.   conversion error if text doesn't present integer! (see spinedit)}
  115.   if CheckValue(Value)<>Value then SetValue(Value);
  116. end;
  117.  
  118. {component registration - this unit may be used separately from dm2000}
  119. procedure Register;
  120. begin RegisterComponents('DM2000', [TFloatEdit]); end;
  121.  
  122. end.
  123.