home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / CURREDIT.PAS < prev    next >
Pascal/Delphi Source File  |  2001-06-24  |  22KB  |  836 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1995, 1996 AO ROSNO             }
  6. {         Copyright (c) 1997, 1998 Master-Bank          }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit CurrEdit;
  11.  
  12. {$I RX.INC}
  13. {$W-}
  14.  
  15. interface
  16.  
  17. uses SysUtils, {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  18.   Messages, Classes, Graphics, Controls, Menus, Forms, StdCtrls, Mask,
  19.   Buttons, ToolEdit;
  20.  
  21. type
  22.  
  23. { TCustomNumEdit }
  24.  
  25.   TCustomNumEdit = class(TCustomComboEdit)
  26.   private
  27.     FCanvas: TControlCanvas;
  28.     FAlignment: TAlignment;
  29.     FFocused: Boolean;
  30.     FValue: Extended;
  31.     FMinValue, FMaxValue: Extended;
  32.     FDecimalPlaces: Cardinal;
  33.     FBeepOnError: Boolean;
  34.     FCheckOnExit: Boolean;
  35.     FZeroEmpty: Boolean;
  36.     FFormatOnEditing: Boolean;
  37.     FFormatting: Boolean;
  38.     FDisplayFormat: PString;
  39.     procedure SetFocused(Value: Boolean);
  40.     procedure SetAlignment(Value: TAlignment);
  41.     procedure SetBeepOnError(Value: Boolean);
  42.     procedure SetDisplayFormat(const Value: string);
  43.     function GetDisplayFormat: string;
  44.     procedure SetDecimalPlaces(Value: Cardinal);
  45.     function GetValue: Extended;
  46.     procedure SetValue(AValue: Extended);
  47.     function GetAsInteger: Longint;
  48.     procedure SetAsInteger(AValue: Longint);
  49.     procedure SetMaxValue(AValue: Extended);
  50.     procedure SetMinValue(AValue: Extended);
  51.     procedure SetZeroEmpty(Value: Boolean);
  52.     procedure SetFormatOnEditing(Value: Boolean);
  53.     function GetText: string;
  54.     procedure SetText(const AValue: string);
  55.     function TextToValText(const AValue: string): string;
  56.     function CheckValue(NewValue: Extended; RaiseOnError: Boolean): Extended;
  57.     function IsFormatStored: Boolean;
  58.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  59.     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  60.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  61.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  62.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  63.     procedure WMPaste(var Message: TMessage); message WM_PASTE;
  64.   protected
  65. {$IFDEF WIN32}
  66.     procedure AcceptValue(const Value: Variant); override;
  67. {$ELSE}
  68.     procedure AcceptValue(const Value: string); override;
  69. {$ENDIF}
  70.     procedure Change; override;
  71.     procedure ReformatEditText; dynamic;
  72.     function GetDefaultBitmap(var DestroyNeeded: Boolean): TBitmap; override;
  73.     procedure DataChanged; virtual;
  74.     function DefaultDisplayFormat: string; virtual;
  75.     procedure KeyPress(var Key: Char); override;
  76.     function IsValidChar(Key: Char): Boolean; virtual;
  77.     function FormatDisplayText(Value: Extended): string;
  78.     function GetDisplayText: string; virtual;
  79.     procedure Reset; override;
  80.     procedure CheckRange;
  81.     procedure UpdateData;
  82.     procedure UpdatePopup; virtual;
  83.     property Formatting: Boolean read FFormatting;
  84.     property Alignment: TAlignment read FAlignment write SetAlignment
  85.       default taRightJustify;
  86.     property BeepOnError: Boolean read FBeepOnError write SetBeepOnError
  87.       default True;
  88.     property CheckOnExit: Boolean read FCheckOnExit write FCheckOnExit default False;
  89.     property GlyphKind default gkDefault;
  90.     property ButtonWidth default 20;
  91.     property DecimalPlaces: Cardinal read FDecimalPlaces write SetDecimalPlaces
  92.       default 2;
  93.     property DisplayFormat: string read GetDisplayFormat write SetDisplayFormat
  94.       stored IsFormatStored;
  95.     property MaxValue: Extended read FMaxValue write SetMaxValue;
  96.     property MinValue: Extended read FMinValue write SetMinValue;
  97.     property FormatOnEditing: Boolean read FFormatOnEditing
  98.       write SetFormatOnEditing default False;
  99.     property Text: string read GetText write SetText stored False;
  100.     property MaxLength default 0;
  101.     property ZeroEmpty: Boolean read FZeroEmpty write SetZeroEmpty default True;
  102.   public
  103.     constructor Create(AOwner: TComponent); override;
  104.     destructor Destroy; override;
  105.     procedure Clear; {$IFDEF RX_D5} override; {$ENDIF}
  106.     property AsInteger: Longint read GetAsInteger write SetAsInteger;
  107.     property DisplayText: string read GetDisplayText;
  108.     property PopupVisible;
  109.     property Value: Extended read GetValue write SetValue;
  110.   end;
  111.  
  112. { TCurrencyEdit }
  113.  
  114.   TCurrencyEdit = class(TCustomNumEdit)
  115.   protected
  116.     function DefaultDisplayFormat: string; override;
  117.   public
  118.     constructor Create(AOwner: TComponent); override;
  119.   published
  120.     property Alignment;
  121.     property AutoSelect;
  122.     property AutoSize;
  123.     property BeepOnError;
  124.     property BorderStyle;
  125.     property CheckOnExit;
  126.     property Color;
  127.     property Ctl3D;
  128.     property DecimalPlaces;
  129.     property DisplayFormat;
  130.     property DragCursor;
  131.     property DragMode;
  132.     property Enabled;
  133.     property Font;
  134.     property FormatOnEditing;
  135.     property HideSelection;
  136. {$IFDEF RX_D4}
  137.     property Anchors;
  138.     property BiDiMode;
  139.     property Constraints;
  140.     property DragKind;
  141.     property ParentBiDiMode;
  142. {$ENDIF}
  143. {$IFDEF WIN32}
  144.   {$IFNDEF VER90}
  145.     property ImeMode;
  146.     property ImeName;
  147.   {$ENDIF}
  148. {$ENDIF}
  149.     property MaxLength;
  150.     property MaxValue;
  151.     property MinValue;
  152.     property ParentColor;
  153.     property ParentCtl3D;
  154.     property ParentFont;
  155.     property ParentShowHint;
  156.     property PopupMenu;
  157.     property ReadOnly;
  158.     property ShowHint;
  159.     property TabOrder;
  160.     property TabStop;
  161.     property Text;
  162.     property Value;
  163.     property Visible;
  164.     property ZeroEmpty;
  165.     property OnChange;
  166.     property OnClick;
  167.     property OnDblClick;
  168.     property OnDragDrop;
  169.     property OnDragOver;
  170.     property OnEndDrag;
  171.     property OnEnter;
  172.     property OnExit;
  173.     property OnKeyDown;
  174.     property OnKeyPress;
  175.     property OnKeyUp;
  176.     property OnMouseDown;
  177.     property OnMouseMove;
  178.     property OnMouseUp;
  179. {$IFDEF RX_D5}
  180.     property OnContextPopup;
  181. {$ENDIF}
  182. {$IFDEF WIN32}
  183.     property OnStartDrag;
  184. {$ENDIF}
  185. {$IFDEF RX_D4}
  186.     property OnEndDock;
  187.     property OnStartDock;
  188. {$ENDIF}
  189.   end;
  190.  
  191. { TRxCustomCalcEdit }
  192.  
  193.   TRxCustomCalcEdit = class(TCustomNumEdit)
  194.   public
  195.     constructor Create(AOwner: TComponent); override;
  196.   end;
  197.  
  198. { TRxCalcEdit }
  199.  
  200.   TRxCalcEdit = class(TRxCustomCalcEdit)
  201.   published
  202.     property Alignment;
  203.     property AutoSelect;
  204.     property AutoSize;
  205.     property BeepOnError;
  206.     property BorderStyle;
  207.     property ButtonHint;
  208.     property CheckOnExit;
  209.     property ClickKey;
  210.     property Color;
  211.     property Ctl3D;
  212.     property DecimalPlaces;
  213.     property DirectInput;
  214.     property DisplayFormat;
  215.     property DragCursor;
  216.     property DragMode;
  217.     property Enabled;
  218.     property Font;
  219.     property FormatOnEditing;
  220.     property GlyphKind;
  221.     { Ensure GlyphKind is published before Glyph and ButtonWidth }
  222.     property Glyph;
  223.     property ButtonWidth;
  224.     property HideSelection;
  225. {$IFDEF RX_D4}
  226.     property Anchors;
  227.     property BiDiMode;
  228.     property Constraints;
  229.     property DragKind;
  230.     property ParentBiDiMode;
  231. {$ENDIF}
  232. {$IFDEF WIN32}
  233.   {$IFNDEF VER90}
  234.     property ImeMode;
  235.     property ImeName;
  236.   {$ENDIF}
  237. {$ENDIF}
  238.     property MaxLength;
  239.     property MaxValue;
  240.     property MinValue;
  241.     property NumGlyphs;
  242.     property ParentColor;
  243.     property ParentCtl3D;
  244.     property ParentFont;
  245.     property ParentShowHint;
  246.     property PopupAlign;
  247.     property PopupMenu;
  248.     property ReadOnly;
  249.     property ShowHint;
  250.     property TabOrder;
  251.     property TabStop;
  252.     property Text;
  253.     property Value;
  254.     property Visible;
  255.     property ZeroEmpty;
  256.     property OnButtonClick;
  257.     property OnChange;
  258.     property OnClick;
  259.     property OnDblClick;
  260.     property OnDragDrop;
  261.     property OnDragOver;
  262.     property OnEndDrag;
  263.     property OnEnter;
  264.     property OnExit;
  265.     property OnKeyDown;
  266.     property OnKeyPress;
  267.     property OnKeyUp;
  268.     property OnMouseDown;
  269.     property OnMouseMove;
  270.     property OnMouseUp;
  271. {$IFDEF RX_D5}
  272.     property OnContextPopup;
  273. {$ENDIF}
  274. {$IFDEF WIN32}
  275.     property OnStartDrag;
  276. {$ENDIF}
  277. {$IFDEF RX_D4}
  278.     property OnEndDock;
  279.     property OnStartDock;
  280. {$ENDIF}
  281.   end;
  282.  
  283. implementation
  284.  
  285. uses Consts, rxStrUtils, VclUtils, MaxMin, RxCalc;
  286.  
  287. {$IFDEF WIN32}
  288.  {$R *.R32}
  289. {$ELSE}
  290.  {$R *.R16}
  291. {$ENDIF}
  292.  
  293. const
  294.   sCalcBmp = 'CEDITBMP'; { Numeric editor button glyph }
  295.   CalcBitmap: TBitmap = nil;
  296.  
  297. type
  298.   THack = class(TPopupWindow);
  299.  
  300. function IsValidFloat(const Value: string; var RetValue: Extended): Boolean;
  301. var
  302.   I: Integer;
  303.   Buffer: array[0..63] of Char;
  304. begin
  305.   Result := False;
  306.   for I := 1 to Length(Value) do
  307.     if not (Value[I] in [DecimalSeparator, '-', '+', '0'..'9', 'e', 'E']) then
  308.       Exit;
  309.   Result := TextToFloat(StrPLCopy(Buffer, Value,
  310.     SizeOf(Buffer) - 1), RetValue {$IFDEF WIN32}, fvExtended {$ENDIF});
  311. end;
  312.  
  313. function FormatFloatStr(const S: string; Thousands: Boolean): string;
  314. var
  315.   I, MaxSym, MinSym, Group: Integer;
  316.   IsSign: Boolean;
  317. begin
  318.   Result := '';
  319.   MaxSym := Length(S);
  320.   IsSign := (MaxSym > 0) and (S[1] in ['-', '+']);
  321.   if IsSign then MinSym := 2
  322.   else MinSym := 1;
  323.   I := Pos(DecimalSeparator, S);
  324.   if I > 0 then MaxSym := I - 1;
  325.   I := Pos('E', AnsiUpperCase(S));
  326.   if I > 0 then MaxSym := Min(I - 1, MaxSym);
  327.   Result := Copy(S, MaxSym + 1, MaxInt);
  328.   Group := 0;
  329.   for I := MaxSym downto MinSym do begin
  330.     Result := S[I] + Result;
  331.     Inc(Group);
  332.     if (Group = 3) and Thousands and (I > MinSym) then begin
  333.       Group := 0;
  334.       Result := ThousandSeparator + Result;
  335.     end;
  336.   end;
  337.   if IsSign then Result := S[1] + Result;
  338. end;
  339.  
  340. { TCustomNumEdit }
  341.  
  342. constructor TCustomNumEdit.Create(AOwner: TComponent);
  343. begin
  344.   inherited Create(AOwner);
  345.   ControlStyle := ControlStyle - [csSetCaption];
  346.   MaxLength := 0;
  347.   FBeepOnError := True;
  348.   FAlignment := taRightJustify;
  349.   FDisplayFormat := NewStr(DefaultDisplayFormat);
  350.   FDecimalPlaces := 2;
  351.   FZeroEmpty := True;
  352.   inherited Text := '';
  353.   inherited Alignment := taLeftJustify;
  354.   FDefNumGlyphs := 2;
  355.   { forces update }
  356.   DataChanged;
  357.   ControlState := ControlState + [csCreating];
  358.   try
  359.     GlyphKind := gkDefault;
  360.     ButtonWidth := 20;
  361.   finally
  362.     ControlState := ControlState - [csCreating];
  363.   end;
  364. end;
  365.  
  366. destructor TCustomNumEdit.Destroy;
  367. begin
  368.   FCanvas.Free;
  369.   DisposeStr(FDisplayFormat);
  370.   if FPopup <> nil then begin
  371.     TPopupWindow(FPopup).OnCloseUp := nil;
  372.     FPopup.Free;
  373.     FPopup := nil;
  374.   end;
  375.   inherited Destroy;
  376. end;
  377.  
  378. function TCustomNumEdit.GetDefaultBitmap(var DestroyNeeded: Boolean): TBitmap;
  379. begin
  380.   DestroyNeeded := False;
  381.   if CalcBitmap = nil then begin
  382.     CalcBitmap := TBitmap.Create;
  383.     CalcBitmap.Handle := LoadBitmap(hInstance, sCalcBmp);
  384.   end;
  385.   Result := CalcBitmap;
  386. end;
  387.  
  388. function TCustomNumEdit.DefaultDisplayFormat: string;
  389. begin
  390.   Result := ',0.##';
  391. end;
  392.  
  393. function TCustomNumEdit.IsFormatStored: Boolean;
  394. begin
  395.   Result := (DisplayFormat <> DefaultDisplayFormat);
  396. end;
  397.  
  398. function TCustomNumEdit.IsValidChar(Key: Char): Boolean;
  399. var
  400.   S: string;
  401.   SelStart, SelStop, DecPos: Integer;
  402.   RetValue: Extended;
  403. begin
  404.   Result := False;
  405.   S := EditText;
  406.   GetSel(SelStart, SelStop);
  407.   System.Delete(S, SelStart + 1, SelStop - SelStart);
  408.   System.Insert(Key, S, SelStart + 1);
  409.   S := TextToValText(S);
  410.   DecPos := Pos(DecimalSeparator, S);
  411.   if (DecPos > 0) then begin
  412.     SelStart := Pos('E', UpperCase(S));
  413.     if (SelStart > DecPos) then DecPos := SelStart - DecPos
  414.     else DecPos := Length(S) - DecPos;
  415.     if DecPos > Integer(FDecimalPlaces) then Exit;
  416.   end;
  417.   Result := IsValidFloat(S, RetValue);
  418.   if Result and (FMinValue >= 0) and (FMaxValue > 0) and (RetValue < 0) then
  419.     Result := False;
  420. end;
  421.  
  422. procedure TCustomNumEdit.KeyPress(var Key: Char);
  423. begin
  424.   if PopupVisible and (UpCase(Key) in ['0'..'9', DecimalSeparator, '.', ',',
  425.     '+', '-', '*', '/', '_', '=', 'C', 'R', 'Q', '%', #8, #13]) then
  426.   begin
  427.     THack(FPopup).KeyPress(Key);
  428.     Key := #0;
  429.   end;
  430.   if Key in ['.', ','] then Key := DecimalSeparator;
  431.   inherited KeyPress(Key);
  432.   if (Key in [#32..#255]) and not IsValidChar(Key) then begin
  433.     if BeepOnError then MessageBeep(0);
  434.     Key := #0;
  435.   end
  436.   else if Key = #27 then begin
  437.     Reset;
  438.     Key := #0;
  439.   end;
  440. end;
  441.  
  442. procedure TCustomNumEdit.Reset;
  443. begin
  444.   DataChanged;
  445.   SelectAll;
  446. end;
  447.  
  448. procedure TCustomNumEdit.SetZeroEmpty(Value: Boolean);
  449. begin
  450.   if FZeroEmpty <> Value then begin
  451.     FZeroEmpty := Value;
  452.     DataChanged;
  453.   end;
  454. end;
  455.  
  456. procedure TCustomNumEdit.SetBeepOnError(Value: Boolean);
  457. begin
  458.   if FBeepOnError <> Value then begin
  459.     FBeepOnError := Value;
  460.     UpdatePopup;
  461.   end;
  462. end;
  463.  
  464. procedure TCustomNumEdit.SetAlignment(Value: TAlignment);
  465. begin
  466.   if FAlignment <> Value then begin
  467.     FAlignment := Value;
  468.     Invalidate;
  469.   end;
  470. end;
  471.  
  472. procedure TCustomNumEdit.SetDisplayFormat(const Value: string);
  473. begin
  474.   if DisplayFormat <> Value then begin
  475.     AssignStr(FDisplayFormat, Value);
  476.     Invalidate;
  477.     DataChanged;
  478.   end;
  479. end;
  480.  
  481. function TCustomNumEdit.GetDisplayFormat: string;
  482. begin
  483.   Result := FDisplayFormat^;
  484. end;
  485.  
  486. procedure TCustomNumEdit.SetFocused(Value: Boolean);
  487. begin
  488.   if FFocused <> Value then begin
  489.     FFocused := Value;
  490.     Invalidate;
  491.     FFormatting := True;
  492.     try
  493.       DataChanged;
  494.     finally
  495.       FFormatting := False;
  496.     end;
  497.   end;
  498. end;
  499.  
  500. procedure TCustomNumEdit.SetFormatOnEditing(Value: Boolean);
  501. begin
  502.   if FFormatOnEditing <> Value then begin
  503.     FFormatOnEditing := Value;
  504.     if FFormatOnEditing then inherited Alignment := Alignment
  505.     else inherited Alignment := taLeftJustify;
  506.     if FFormatOnEditing and FFocused then ReformatEditText
  507.     else if FFocused then begin
  508.       UpdateData;
  509.       DataChanged;
  510.     end;
  511.   end;
  512. end;
  513.  
  514. procedure TCustomNumEdit.SetDecimalPlaces(Value: Cardinal);
  515. begin
  516.   if FDecimalPlaces <> Value then begin
  517.     FDecimalPlaces := Value;
  518.     DataChanged;
  519.     Invalidate;
  520.   end;
  521. end;
  522.  
  523. function TCustomNumEdit.FormatDisplayText(Value: Extended): string;
  524. begin
  525.   if DisplayFormat <> '' then
  526.     Result := FormatFloat(DisplayFormat, Value)
  527.   else
  528.     Result := FloatToStr(Value);
  529. end;
  530.  
  531. function TCustomNumEdit.GetDisplayText: string;
  532. begin
  533.   Result := FormatDisplayText(FValue);
  534. end;
  535.  
  536. procedure TCustomNumEdit.Clear;
  537. begin
  538.   Text := '';
  539. end;
  540.  
  541. procedure TCustomNumEdit.DataChanged;
  542. var
  543.   EditFormat: string;
  544. begin
  545.   EditFormat := '0';
  546.   if FDecimalPlaces > 0 then
  547.     EditFormat := EditFormat + '.' + MakeStr('#', FDecimalPlaces);
  548.   if (FValue = 0.0) and FZeroEmpty then
  549.     EditText := ''
  550.   else
  551.     EditText := FormatFloat(EditFormat, FValue);
  552. end;
  553.  
  554. function TCustomNumEdit.CheckValue(NewValue: Extended;
  555.   RaiseOnError: Boolean): Extended;
  556. begin
  557.   Result := NewValue;
  558.   if (FMaxValue <> FMinValue) then begin
  559.     if (FMaxValue > FMinValue) then begin
  560.       if NewValue < FMinValue then Result := FMinValue
  561.       else if NewValue > FMaxValue then Result := FMaxValue;
  562.     end
  563.     else begin
  564.       if FMaxValue = 0 then begin
  565.         if NewValue < FMinValue then Result := FMinValue;
  566.       end
  567.       else if FMinValue = 0 then begin
  568.         if NewValue > FMaxValue then Result := FMaxValue;
  569.       end;
  570.     end;
  571.     if RaiseOnError and (Result <> NewValue) then
  572.       raise ERangeError.CreateFmt(ReplaceStr(ResStr(SOutOfRange), '%d', '%.*f'),
  573.         [DecimalPlaces, FMinValue, DecimalPlaces, FMaxValue]);
  574.   end;
  575. end;
  576.  
  577. procedure TCustomNumEdit.CheckRange;
  578. begin
  579.   if not (csDesigning in ComponentState) and CheckOnExit then
  580.     CheckValue(StrToFloat(TextToValText(EditText)), True);
  581. end;
  582.  
  583. procedure TCustomNumEdit.UpdateData;
  584. begin
  585.   ValidateEdit;
  586.   FValue := CheckValue(StrToFloat(TextToValText(EditText)), False);
  587. end;
  588.  
  589. procedure TCustomNumEdit.UpdatePopup;
  590. begin
  591.   if FPopup <> nil then
  592.     SetupPopupCalculator(FPopup, DefCalcPrecision, BeepOnError);
  593. end;
  594.  
  595. function TCustomNumEdit.GetValue: Extended;
  596. begin
  597.   if not (csDesigning in ComponentState) then
  598.     try
  599.       UpdateData;
  600.     except
  601.       FValue := FMinValue;
  602.     end;
  603.   Result := FValue;
  604. end;
  605.  
  606. procedure TCustomNumEdit.SetValue(AValue: Extended);
  607. begin
  608.   FValue := CheckValue(AValue, False);
  609.   DataChanged;
  610.   Invalidate;
  611. end;
  612.  
  613. function TCustomNumEdit.GetAsInteger: Longint;
  614. begin
  615.   Result := Trunc(Value);
  616. end;
  617.  
  618. procedure TCustomNumEdit.SetAsInteger(AValue: Longint);
  619. begin
  620.   SetValue(AValue);
  621. end;
  622.  
  623. procedure TCustomNumEdit.SetMinValue(AValue: Extended);
  624. begin
  625.   if FMinValue <> AValue then begin
  626.     FMinValue := AValue;
  627.     Value := FValue;
  628.   end;
  629. end;
  630.  
  631. procedure TCustomNumEdit.SetMaxValue(AValue: Extended);
  632. begin
  633.   if FMaxValue <> AValue then begin
  634.     FMaxValue := AValue;
  635.     Value := FValue;
  636.   end;
  637. end;
  638.  
  639. function TCustomNumEdit.GetText: string;
  640. begin
  641.   Result := inherited Text;
  642. end;
  643.  
  644. function TCustomNumEdit.TextToValText(const AValue: string): string;
  645. begin
  646.   Result := DelRSpace(AValue);
  647.   if DecimalSeparator <> ThousandSeparator then begin
  648.     Result := DelChars(Result, ThousandSeparator);
  649.   end;
  650.   if (DecimalSeparator <> '.') and (ThousandSeparator <> '.') then
  651.     Result := ReplaceStr(Result, '.', DecimalSeparator);
  652.   if (DecimalSeparator <> ',') and (ThousandSeparator <> ',') then
  653.     Result := ReplaceStr(Result, ',', DecimalSeparator);
  654.   if Result = '' then Result := '0'
  655.   else if Result = '-' then Result := '-0';
  656. end;
  657.  
  658. procedure TCustomNumEdit.SetText(const AValue: string);
  659. begin
  660.   if not (csReading in ComponentState) then begin
  661.     FValue := CheckValue(StrToFloat(TextToValText(AValue)), False);
  662.     DataChanged;
  663.     Invalidate;
  664.   end;
  665. end;
  666.  
  667. procedure TCustomNumEdit.ReformatEditText;
  668. var
  669.   S: string;
  670.   IsEmpty: Boolean;
  671.   OldLen, SelStart, SelStop: Integer;
  672. begin
  673.   FFormatting := True;
  674.   try
  675.     S := inherited Text;
  676.     OldLen := Length(S);
  677.     IsEmpty := (OldLen = 0) or (S = '-');
  678.     if HandleAllocated then GetSel(SelStart, SelStop);
  679.     if not IsEmpty then S := TextToValText(S);
  680.     S := FormatFloatStr(S, Pos(',', DisplayFormat) > 0);
  681.     inherited Text := S;
  682.     if HandleAllocated and (GetFocus = Handle) and not
  683.       (csDesigning in ComponentState) then
  684.     begin
  685.       Inc(SelStart, Length(S) - OldLen);
  686.       SetCursor(SelStart);
  687.     end;
  688.   finally
  689.     FFormatting := False;
  690.   end;
  691. end;
  692.  
  693. procedure TCustomNumEdit.Change;
  694. begin
  695.   if not FFormatting then begin
  696.     if FFormatOnEditing and FFocused then ReformatEditText;
  697.     inherited Change;
  698.   end;
  699. end;
  700.  
  701. {$IFDEF WIN32}
  702. procedure TCustomNumEdit.AcceptValue(const Value: Variant);
  703. {$ELSE}
  704. procedure TCustomNumEdit.AcceptValue(const Value: string);
  705. {$ENDIF}
  706. begin
  707.   inherited AcceptValue(Value);
  708. end;
  709.  
  710. procedure TCustomNumEdit.WMPaste(var Message: TMessage);
  711. var
  712.   S: string;
  713. begin
  714.   S := EditText;
  715.   try
  716.     inherited;
  717.     UpdateData;
  718.   except
  719.     EditText := S;
  720.     SelectAll;
  721.     if CanFocus then SetFocus;
  722.     if BeepOnError then MessageBeep(0);
  723.   end;
  724. end;
  725.  
  726. procedure TCustomNumEdit.CMEnter(var Message: TCMEnter);
  727. begin
  728.   SetFocused(True);
  729.   if FFormatOnEditing then ReformatEditText;
  730.   inherited;
  731. end;
  732.  
  733. procedure TCustomNumEdit.CMExit(var Message: TCMExit);
  734. begin
  735.   try
  736.     CheckRange;
  737.     UpdateData;
  738.   except
  739.     SelectAll;
  740.     if CanFocus then SetFocus;
  741.     raise;
  742.   end;
  743.   SetFocused(False);
  744.   SetCursor(0);
  745.   DoExit;
  746. end;
  747.  
  748. procedure TCustomNumEdit.CMEnabledChanged(var Message: TMessage);
  749. begin
  750.   inherited;
  751.   if NewStyleControls and not FFocused then Invalidate;
  752. end;
  753.  
  754. procedure TCustomNumEdit.WMPaint(var Message: TWMPaint);
  755. var
  756.   S: string;
  757. begin
  758.   if PopupVisible then S := TPopupWindow(FPopup).GetPopupText
  759.   else S := GetDisplayText;
  760.   if not PaintComboEdit(Self, S, FAlignment, FFocused and not PopupVisible,
  761.     FCanvas, Message) then inherited;
  762. end;
  763.  
  764. procedure TCustomNumEdit.CMFontChanged(var Message: TMessage);
  765. begin
  766.   inherited;
  767.   Invalidate;
  768. end;
  769.  
  770. { TCurrencyEdit }
  771.  
  772. constructor TCurrencyEdit.Create(AOwner: TComponent);
  773. begin
  774.   inherited Create(AOwner);
  775.   ControlState := ControlState + [csCreating];
  776.   try
  777.     ButtonWidth := 0;
  778.   finally
  779.     ControlState := ControlState - [csCreating];
  780.   end;
  781. end;
  782.  
  783. function TCurrencyEdit.DefaultDisplayFormat: string;
  784. var
  785.   CurrStr: string;
  786.   I: Integer;
  787.   C: Char;
  788. begin
  789.   Result := ',0.' + MakeStr('0', CurrencyDecimals);
  790.   CurrStr := '';
  791.   for I := 1 to Length(CurrencyString) do begin
  792.     C := CurrencyString[I];
  793.     if C in [',', '.'] then CurrStr := CurrStr + '''' + C + ''''
  794.     else CurrStr := CurrStr + C;
  795.   end;
  796.   if Length(CurrStr) > 0 then
  797.     case CurrencyFormat of
  798.       0: Result := CurrStr + Result; { '$1' }
  799.       1: Result := Result + CurrStr; { '1$' }
  800.       2: Result := CurrStr + ' ' + Result; { '$ 1' }
  801.       3: Result := Result + ' ' + CurrStr; { '1 $' }
  802.     end;
  803.   Result := Format('%s;-%s', [Result, Result]);
  804. end;
  805.  
  806. { TRxCustomCalcEdit }
  807.  
  808. constructor TRxCustomCalcEdit.Create(AOwner: TComponent);
  809. begin
  810.   inherited Create(AOwner);
  811.   ControlState := ControlState + [csCreating];
  812.   try
  813.     FPopup := TPopupWindow(CreatePopupCalculator(Self
  814.       {$IFDEF RX_D4}, BiDiMode {$ENDIF}));
  815.     TPopupWindow(FPopup).OnCloseUp := PopupCloseUp;
  816.     UpdatePopup;
  817.   finally
  818.     ControlState := ControlState - [csCreating];
  819.   end;
  820. end;
  821.  
  822. procedure DestroyLocals; far;
  823. begin
  824.   CalcBitmap.Free;
  825.   CalcBitmap := nil;
  826. end;
  827.  
  828. {$IFDEF WIN32}
  829. initialization
  830. finalization
  831.   DestroyLocals;
  832. {$ELSE}
  833. initialization
  834.   AddExitProc(DestroyLocals);
  835. {$ENDIF}
  836. end.