scurredit.pas

AlphaControls是一个Delphi标准控件的集合

unit sCurrEdit;

{$I sDefs.inc}

interface

uses SysUtils, Windows,  Messages, Classes, Graphics, Controls, Menus, Forms, 
  StdCtrls, Mask, Buttons, sCustomComboEdit, sUtils, sCalcUnit, sStyleUtil, sConst;

type

{ TsCustomNumEdit }

  TsCustomNumEdit = class(TsCustomComboEdit)
  private
    FCanvas: TControlCanvas;
    FAlignment: TAlignment;
    FFocused: Boolean;
    FValue: Extended;
    FMinValue, FMaxValue: Extended;
    FDecimalPlaces: Cardinal;
    FBeepOnError: Boolean;
    FCheckOnExit: Boolean;
    FFormatOnEditing: Boolean;
    FFormatting: Boolean;
    FDisplayFormat: PString;
    procedure SetFocused(Value: Boolean);
    procedure SetAlignment(Value: TAlignment);
    procedure SetBeepOnError(Value: Boolean);
    procedure SetDisplayFormat(const Value: string);
    function GetDisplayFormat: string;
    procedure SetDecimalPlaces(Value: Cardinal);
    function GetValue: Extended;
    procedure SetValue(AValue: Extended);
    function GetAsInteger: Longint;
    procedure SetMaxValue(AValue: Extended);
    procedure SetMinValue(AValue: Extended);
    function GetText: string;
    procedure SetText(const AValue: string);
    function TextToValText(const AValue: string): string;
    function CheckValue(NewValue: Extended; RaiseOnError: Boolean): Extended;
    function IsFormatStored: Boolean;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
//    property FormatOnEditing: Boolean read FFormatOnEditing write SetFormatOnEditing default False;
  protected
    procedure Change; override;
    procedure ReformatEditText; dynamic;
    procedure DataChanged; virtual;
    function DefFormat: string; virtual;
    procedure KeyPress(var Key: Char); override;
    function IsValidChar(Key: Char): Boolean; virtual;
    function FormatDisplayText(Value: Extended): string;
    function GetDisplayText: string; virtual;
    procedure Reset; override;
    procedure CheckRange;
    procedure UpdateData;
    property Formatting: Boolean read FFormatting;
    property Alignment: TAlignment read FAlignment write SetAlignment default taRightJustify;
    property BeepOnError: Boolean read FBeepOnError write SetBeepOnError default True;
    property CheckOnExit: Boolean read FCheckOnExit write FCheckOnExit default False;
    property DecimalPlaces: Cardinal read FDecimalPlaces write SetDecimalPlaces default 2;
    property DisplayFormat: string read GetDisplayFormat write SetDisplayFormat stored IsFormatStored;
    property MaxValue: Extended read FMaxValue write SetMaxValue;
    property MinValue: Extended read FMinValue write SetMinValue;
    property Text: string read GetText write SetText stored False;
    property MaxLength default 0;
    procedure PopupWindowShow; override;
    property ClickKey;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear; override;
    property AsInteger: Longint read GetAsInteger;
    property DisplayText: string read GetDisplayText;
    property DroppedDown;
    property Value: Extended read GetValue write SetValue;
    procedure WndProc (var Message: TMessage); override;
  end;

{ TsCalcEdit }

  TsCalcEdit = class(TsCustomNumEdit)
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ClickKey;
    property Alignment;
    property AutoSelect;
//    property AutoSize;
//    property BeepOnError;
    property CheckOnExit;
    property DecimalPlaces;
    property DirectInput;
    property DisplayFormat;
    property DragCursor;
//    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property ImeMode;
    property ImeName;
    property MaxLength;
    property MaxValue;
    property MinValue;
    property ParentFont;
    property ParentShowHint;
    property PopupAlign;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Value;
    property Visible;
    property OnButtonClick;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

implementation

uses Consts, sControlsManager, sVclUtils, sStyleSimply, sMessages;

function PaintEdit(Editor: TsCustomComboEdit; const AText: string;
  AAlignment: TAlignment; StandardPaint: Boolean;
  var ACanvas: TControlCanvas; var Message: TWMPaint): Boolean;
var
  AWidth, ALeft: Integer;
  Margins: TPoint;
  R: TRect;
  DC: HDC;
  PS: TPaintStruct;
  S: string;
  ExStyle: DWORD;
const
  AlignStyle: array[Boolean, TAlignment] of DWORD =
   ((WS_EX_LEFT, WS_EX_RIGHT, WS_EX_LEFT), (WS_EX_RIGHT, WS_EX_LEFT, WS_EX_LEFT));
begin
  Result := True;
  with Editor do begin
    if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
    if StandardPaint and not (csPaintCopy in ControlState) then begin
      if SysLocale.MiddleEast and HandleAllocated and (IsRightToLeft) then begin
        ExStyle := DWORD(GetWindowLong(Handle, GWL_EXSTYLE)) and (not WS_EX_RIGHT) and
          (not WS_EX_RTLREADING) and (not WS_EX_LEFTSCROLLBAR);
        if UseRightToLeftReading then
          ExStyle := ExStyle or WS_EX_RTLREADING;
        if UseRightToLeftScrollbar then
          ExStyle := ExStyle or WS_EX_LEFTSCROLLBAR;
        ExStyle := ExStyle or
          AlignStyle[UseRightToLeftAlignment, AAlignment];
        if DWORD(GetWindowLong(Handle, GWL_EXSTYLE)) <> ExStyle then
          SetWindowLong(Handle, GWL_EXSTYLE, ExStyle);
      end;
      Result := False;
      Exit;
    end;

    { Since edit controls do not handle justification unless multi-line (and
      then only poorly) we will draw right and center justify manually unless
      the edit has the focus. }
      
    if ACanvas = nil then begin
      ACanvas := TControlCanvas.Create;
      ACanvas.Control := Editor;
    end;
    DC := Message.DC;
    if DC = 0 then DC := BeginPaint(Handle, PS);
    ACanvas.Handle := DC;
    try
      ACanvas.Font := Font;
      if not Enabled and NewStyleControls and not
        (csDesigning in ComponentState) and
        (ColorToRGB(sStyle.GetActiveColor) <> ColorToRGB(clGrayText)) then
        ACanvas.Font.Color := clGrayText;
      with ACanvas do begin
        R := ClientRect;
        Brush.Color := sStyle.GetActiveColor;
        S := AText;
        AWidth := TextWidth(S);
        Margins := EditorTextMargins(Editor);
        if GlyphMode.Width > 0 then Inc(AWidth);
        case AAlignment of
          taLeftJustify: ALeft := Margins.X;
          taRightJustify:
            ALeft := ClientWidth - Button.Width - AWidth - Margins.X - 2;
          else
            ALeft := (ClientWidth - Button.Width - AWidth) div 2;
        end;
        if SysLocale.MiddleEast then UpdateTextFlags;
        TextRect(R, ALeft, Margins.Y, S);
      end;
    finally
      ACanvas.Handle := 0;
      if Message.DC = 0 then EndPaint(Handle, PS);
    end;
  end;
end;

{ TsCustomNumEdit }

constructor TsCustomNumEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csSetCaption];
  FAlignment := taRightJustify;
  FDisplayFormat := NewStr(DefFormat);
  MaxLength := 0;
  FDecimalPlaces := 2;
  FBeepOnError := True;
  inherited Text := '';
  inherited Alignment := taLeftJustify;
  DataChanged;
  PopupWidth := 213;
end;

destructor TsCustomNumEdit.Destroy;
begin
  if Assigned(FCanvas) then FreeAndNil(FCanvas);
  DisposeStr(FDisplayFormat);
  if Assigned(FPopupwindow) then FreeAndNil(FPopupWindow);
  inherited Destroy;
end;

function TsCustomNumEdit.DefFormat: string;
begin
  Result := '### ##0.00;-### ##0.00;0';
end;

function TsCustomNumEdit.IsFormatStored: Boolean;
begin
  Result := (DisplayFormat <> DefFormat);
end;

function TsCustomNumEdit.IsValidChar(Key: Char): Boolean;
var
  S: string;
  SelStart, SelStop, DecPos: Integer;
  RetValue: Extended;
begin
  Result := False;
  S := EditText;
  GetSel(SelStart, SelStop);
  System.Delete(S, SelStart + 1, SelStop - SelStart);
  System.Insert(Key, S, SelStart + 1);
  S := TextToValText(S);
  DecPos := Pos(DecimalSeparator, S);
  if (DecPos > 0) then begin
    SelStart := Pos('E', UpperCase(S));
    if (SelStart > DecPos) then begin
      DecPos := SelStart - DecPos
    end
    else begin
      DecPos := Length(S) - DecPos;
    end;
    if DecPos > Integer(FDecimalPlaces) then Exit;
  end;
  Result := IsValidFloat(S, RetValue);
  if Result and (FMinValue >= 0) and (FMaxValue > 0) and (RetValue < 0) then
    Result := False;
end;

procedure TsCustomNumEdit.KeyPress(var Key: Char);
begin
  if Key in ['.', ','] - [ThousandSeparator] then Key := DecimalSeparator;
  inherited KeyPress(Key);
  if (Key in [#32..#255]) and not IsValidChar(Key) then begin
    if BeepOnError then MessageBeep(0);
    Key := #0;
  end
  else if Key = #27 then begin
    Reset;
    Key := #0;
  end;
end;

procedure TsCustomNumEdit.Reset;
begin
  DataChanged;
  SelectAll;
end;

procedure TsCustomNumEdit.SetBeepOnError(Value: Boolean);
begin
  if FBeepOnError <> Value then begin
    FBeepOnError := Value;
  end;
end;

procedure TsCustomNumEdit.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then begin
    FAlignment := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsCustomNumEdit.SetDisplayFormat(const Value: string);