fccalcedit.pas

一套及时通讯的原码

unit fcCalcEdit;
{
//
// Components : TfcCalcEdit
//
// Copyright (c) 2001 by Woll2Woll Software
//
// Changes:
// 10/01/2001-Added check to see if current value is 0 then start text with 0 followed by decimal
//            Added OnMouseEnter/OnMouseLeave events.  Added OnSetCalcButtonAttributes event.
//            published AutoSize,Anchors,Constraints properties.
//            Also added AllowNull property. Handled WMPaste and WMCut.
// 10/04/2001-Added Alignment and DisplayFormat property and fixed some text display issues.
// 12/12/2001-Handle additional Decimal cases when cboShowDecimal in Options.
// 1/21/2002 - Color not set when control loses focus.
// 2/28/2002 - Handle Decimal cases when selecting text or when backspacing so as to allow decimals.
// 3/1/2002 - Fixed some display problems when setting value at runtime.
// 3/1/2002 - Enabled Inplace Edit so that end-user can modify an existing number.  Modified behavior to
//            paint focused text without special formatting characters for ease of calculation and natural
//            use by end-user.  ClearOnNextKey flag use eliminated.
// 3/1/2002-PYW-Use new function to handle num pad keys in windows 98.
// 3/11/2002 - PYW - Handle Null Case in new DataChange procedure.
}

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Buttons, Forms, Dialogs,
  StdCtrls, math, extctrls, fccombo, fccommon, fcCalculator, db;

type
  TfcCustomCalcEdit = class;

  TfcPopupCalcOptions = class(TPersistent)
  private
    FBackground:TPicture;
    FBackGroundStyle: TfcCalcBitmapDrawStyle;
    FMargin:integer;
    FOptions: TfcCalcOptions;
    FPanelColor:TColor;
    procedure SetBackgroundStyle(Value: TfcCalcBitmapDrawStyle);
    procedure SetOptions(Value: TfcCalcOptions);
    procedure SetMargin(Value: Integer);
    procedure SetPanelColor(Value: TColor);
  public
    constructor Create(AOwner: TComponent);
    destructor Destroy; override;
  protected
    procedure SetBackgroundBitmap(Value: TPicture); virtual;
  published
    property Background:TPicture read FBackground write SetBackGroundBitmap;
    property BackgroundStyle: TfcCalcBitmapDrawStyle read FBackgroundStyle write SetBackgroundStyle;
    property ButtonMargin: integer read FMargin write SetMargin default 3;
    property Options: TfcCalcOptions read FOptions write SetOptions default [cboHideEditor];
    property PanelColor: TColor read FPanelColor write SetPanelColor default clBtnFace;
  end;

  TfcCalcPanel = class(TfcCalculator)
  private
    FAssociatedEdit:TfcCustomCalcEdit;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Keypress(var Key: Char); override;
//    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    procedure DoCalc(ButtonType:TfcCalcButtonType); override;
    constructor Create(AOwner: TComponent); override;
    property AssociatedEdit:TfcCustomCalcEdit read FAssociatedEdit write FAssociatedEdit;
  end;

  TfcCalcAttributesEvent = procedure (Sender: TfcCustomCalcEdit;
    var AType:TfcCalcButtonType;
    var ACaption:String;
    var AFontColor:TColor;
    var AButtonColor:TColor;
    var AHint:String) of object;


  TfcCustomCalcEdit = class(TfcCustomCombo)
  private
    FAlignment: TAlignment;
    FDisplayFormat:String;
    FDecimalPlacesStored:integer;
    FDropDownCalc:TfcCalcPanel;
    FClearOnNextKey: boolean;
    FAllowNull: boolean;
    FCalcOptions : TfcPopupCalcOptions;
    FOnCalcButtonAttributes: TfcCalcAttributesEvent;
    FOnBeforeDropDown: TNotifyEvent;

    FSkipTextChangedFlag:boolean;
    FDecimalEntered:boolean;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
  protected
    function GetValue: Double; virtual;
    procedure SetValue(Value:Double); virtual;
    procedure Paint; override;
    function GetEditRect: TRect; override;

    function IsValidOperator(Key: Char): boolean; virtual;
    function IsUnaryOperator(Key:Char):boolean; virtual;
    function IsBinaryOperator(Key:Char):boolean; virtual;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure DoBeforeDropDown; virtual;
    procedure UpdateData(Sender: TObject); override;
    procedure DataChange(Sender: TObject); override;

    // abstract methods
    function SkipInheritedPaint : boolean; override;
    function GetAlignment: TAlignment; virtual;
    function GetDropDownControl: TWinControl; override;
    function GetDropDownContainer: TWinControl; override;
    function GetItemCount: Integer; override;
    function GetItemSize: TSize; override;
    procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect; Highlight, GridPaint: Boolean;
      aText: string); override;
//    function GetPanel: TfcCalcPanel;
    property DecimalEntered : boolean read FDecimalEntered write FDecimalEntered;
    property SkipTextChangedFlag: boolean read FSkipTextChangedFlag write FSkipTextChangedFlag;
  public
    property Panel:TfcCalcPanel read fDropDownCalc write fDropDownCalc;
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure CreateWnd; override;
    //MAKE DoCloseUp and DoDropDown events.
    procedure CloseUp(Accept: Boolean); override;
    procedure DropDown; override;
    function IsDroppedDown: Boolean; override;
    procedure DoCalcButtonAttributes(Calc: TfcCalculator;var AType:TfcCalcButtonType;
      var ACaption:String; var AFontColor:TColor; var AButtonColor:TColor; var AHint:String); virtual;
    function GetDisplayText(AText:String):string; virtual;
    procedure ResetCalculator; virtual;

    property Alignment : TAlignment read GetAlignment write FAlignment default taRightJustify;
    property DisplayFormat : string read FDisplayFormat write FDisplayFormat;
    property DecimalPlacesStored : integer read FDecimalPlacesStored write FDecimalPlacesStored;
    property Value: Double read GetValue write SetValue;
    property CalcOptions: TfcPopupCalcOptions read FCalcOptions write FCalcOptions;
    property AllowNull: boolean read FAllowNull write FAllowNull default False;
    property OnSetCalcButtonAttributes:TfcCalcAttributesEvent read FOnCalcButtonAttributes write FOnCalcButtonAttributes;
    property OnBeforeDropDown: TNotifyEvent read FOnBeforeDropDown write FOnBeforeDropDown;
  end;

  TfcCalcEdit = class(TfcCustomCalcEdit)
  published
    property DisableThemes;

    property CalcOptions;
    {$ifdef fcDelphi4Up}
    property Anchors;
    property Constraints;
    {$endif}
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property ButtonEffects;
    property ButtonGlyph;
    property ButtonStyle;
    property ButtonWidth;
    property Color;
    property Ctl3D;
    property DataField;
    property DataSource;
    property DisplayFormat;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property Frame;
    property ImeMode;
    property ImeName;
    property InfoPower;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property OnSetCalcButtonAttributes;
    property ShowButton;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnBeforeDropDown;
    property OnChange;
    property OnClick;
    {$ifdef fcDelphi5Up}
    property OnContextPopup;
    {$endif}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

//procedure Register;

implementation

{procedure TfcCalcPanel.Compute(Sender: TObject);
var
 ch: char;
 ButtonType: TfcCalcButtonType;
begin
  ButtonType := TfcCalcButtonType(TSpeedButton(Sender).Tag);
  case ButtonType of
    bt0..bt9:   ch := TSpeedButton(Sender).Caption[1];
    btDecimal:  ch := '.';
    btPlusMinus: ;
    btClearAll:
      ch := 'C'; //char(vk_escape);
    btClear:    ch := char(vk_back);
    btAdd:      ch:='+';
    btSubtract: ch:='-';
    btDivide:   ch:='/';
    btMultiply: ch:='*';
    btBackSpace:ch:=char(vk_back);
    btInverse:  ch:='r';
    btPercent:  ch:='%';
    btSqrt:     ch:='@';
    btMStore:   ch:='m';
    btMAdd:     ch:='p';
    btMRecall:  ch:='r';
    btMClear:   ch:='l';
    btEquals:   ch:='=';
    else
      ch:=' ';
    end;

    SendMessage(FAssociatedEdit.Handle, WM_CHAR, word(ch), 0);
end;
 }

procedure TfcCalcPanel.Keypress(var Key: Char);
begin
  inherited Keypress(Key);
end;

    constructor TfcPopupCalcOptions.Create(AOwner: TComponent);
    begin
      FBackground := TPicture.Create;
      FMargin := 3;
      FOptions := [];
      FPanelColor := clBtnFace;
    end;

    destructor TfcPopupCalcOptions.Destroy;
    begin
      if FBackGround <> nil then begin
         FBackground.Free;
         FBackground := nil;
      end;
      inherited;
    end;

    procedure TfcPopupCalcOptions.SetBackgroundBitmap(Value: TPicture);
    begin
      FBackground.assign(Value);
    end;

    procedure TfcPopupCalcOptions.SetBackgroundStyle(Value: TfcCalcBitmapDrawStyle);
    begin
      if Value<>FBackgroundStyle then begin
         FBackgroundStyle:= Value;
      end;
    end;

    procedure TfcPopupCalcOptions.SetOptions(Value: TfcCalcOptions);
    begin
      if Value<>FOptions then begin
         FOptions:= Value;
      end;
    end;

    procedure TfcPopupCalcOptions.SetPanelColor(Value: TColor);
    begin
      if Value<>FPanelColor then begin
         FPanelColor:= Value;
      end;
    end;

    procedure TfcPopupCalcOptions.SetMargin(Value: Integer);
    begin
      if Value<>FMargin then begin
         FMargin := Value;
      end;
    end;

procedure TfcCalcPanel.DoCalc(ButtonType:TfcCalcButtonType);
begin
  if FAssociatedEdit.EditCanModify then
  begin
     inherited DoCalc(buttonType);
     FAssociatedEdit.SetModified(True);
     if (cboCloseOnEquals in Options) and (ButtonType=btEquals) then begin
       self.update;
       FAssociatedEdit.Closeup(False);
       abort; //!!!!
     end;
  end;
end;

procedure TfcCalcPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; // ak
    Style := Style or WS_BORDER;
    {$ifdef win32}
    ExStyle := WS_EX_TOOLWINDOW;

    ExStyle := ExStyle or WS_EX_CONTROLPARENT; //ak
    {$endif}

    WindowClass.Style := CS_SAVEBITS;
  end;
end;

constructor TfcCalcPanel.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   FAssociatedEdit := TfcCustomCalcEdit(AOwner);
   ControlStyle := ControlStyle + [csReplicatable];
   ControlStyle := ControlStyle + [csNoDesignVisible];
   ControlStyle := ControlStyle + [csReflector];
   Color := clBtnFace;
//   Height := 175;
//   Width := 250;
end;

procedure TfcCalcPanel.CreateWnd;
begin
  inherited CreateWnd;
  Windows.SetParent(Handle, 0);
end;

{ TfcCustomCalcEdit }

constructor TfcCustomCalcEdit.Create( aOwner: TComponent );
begin
  inherited Create( aOwner );
  MaxLength := 20;
//  WantReturns := True;
  FCalcOptions := TfcPopupCalcOptions.Create(Self);
  FAllowNull := False;
  FAlignment := taRightJustify;
  FDecimalEntered := False;
  Text:='';
end;

procedure TfcCustomCalcEdit.CreateWnd;
begin
  inherited;
end;

procedure TfcCustomCalcEdit.Loaded;
var f:extended;
begin
  inherited;
  try
    if Text='' then abort;
    f:= fcStrToRealDef(Text,0.0)
  except
    f:=0.0;
  end;

  if (AllowNull = False) and ((Text = '') or (f=0.0)) then begin
     if cboShowDecimal in CalcOptions.Options then
        Text := '0'+decimalseparator
     else Text := '0';
  end;
end;

destructor TfcCustomCalcEdit.Destroy;
begin
  inherited Destroy;
  FCalcOptions.Free;
end;

function TfcCustomCalcEdit.IsBinaryOperator(Key:Char): boolean;
begin
  Result := Key in ['+','-','*','/','%','^','='];
end;

function TfcCustomCalcEdit.IsUnaryOperator(Key:Char): boolean;
begin
  Result := Key in ['@','#','r','n','l',';','!','_'];
end;

function TfcCustomCalcEdit.IsValidOperator(Key:Char): boolean;
begin
  Result := IsBinaryOperator(Key) or IsUnaryOperator(Key) or
            (Key in ['m','p']);
end;

procedure TfcCustomCalcEdit.DoEnter;
begin
  inherited;
//  FClearOnNextKey := True;
  if (Alignment <> taRightJustify) or ((DataLink=nil) or (DataLink.Field = nil))
  then begin
    invalidate;
  end;

  if AutoSelect then selectall
  else selStart := Length(Text);
end;

procedure TfcCustomCalcEdit.DoBeforeDropDown;
begin
  if Assigned(FOnBeforeDropDown) then FOnBeforeDropDown(Self);
end;

procedure TfcCustomCalcEdit.DoExit;
begin
    inherited;
    if (Alignment <> taRightJustify) or ((DataLink=nil) or (DataLink.Field = nil)) then invalidate;
//  FClearOnNextKey := True;

    FDecimalEntered := False;
end;

procedure TfcCustomCalcEdit.ResetCalculator;