fccalculator.pas

一套及时通讯的原码

unit fcCalculator;
{
//
// Components : TfcCalculator
//
// Copyright (c) 2001 by Woll2Woll Software
//
// Changes:
// 12/12/2001-Fixed bug with button remaining down when shift op happens sometimes.
// 3/1/2002-PYW-Added support for TDBCtrlGrid.
// 3/1/2002-PYW-Added code to handle very large numbers with Exponential notation.
// 3/1/2002-PYW-Use new function to handle num pad keys in windows 98.
}

//Change from TBitBtn to TSpeedButton and remove tabstops from other controls.
//Replace other controls with TLabel and TBevels and TShape.

//Calculator when hitting 3*3**** should not keep multiplying itself.
//Add custom button capability.
//Add OnDrawCalcButton to allow custom button overriding.


interface

uses
  Windows, messages, Sysutils, Forms, Classes, Controls, StdCtrls, extctrls, ComCtrls, Graphics, Buttons, fccombo, fcframe,
  fccommon,dialogs;

type
  TfcCalcButtonType = (btNone,bt0, bt1, bt2, bt3, bt4, bt5, bt6, bt7,
    bt8, bt9, btDecimal, btPlusMinus, btMultiply, btDivide,
    btAdd, btSubtract, btEquals, btSqrt, btPercent, btInverse,
    btBackspace, btClear, btClearAll, btMRecall, btMStore, btMClear,
    btMAdd);

  TfcCalculator=class;

  TfcSetButtonAttributesEvent = procedure (Calc: TfcCalculator;
    var AType:TfcCalcButtonType;
    var ACaption:String;
    var AFontColor:TColor;
    var AButtonColor:TColor;
    var AHint:String) of object;

  TCalcState = (csNone, csAdd, csSubtract, csMultiply, csDivide);
  TfcCalcOption = (cboHotTrackButtons, cboFlatButtons, cboHideBorder, cboHideEditor,
     cboShowStatus, cboHideMemory, cboSelectOnEquals, cboShowDecimal, cboSimpleCalc,
     cboFlatDrawStyle, cboRoundedButtons, cboDigitGrouping, cboCloseOnEquals);
  TfcCalcOptions = set of TfcCalcOption;
  TfcCalcBitmapDrawStyle = (cbdStretch, cbdTile, cbdTopLeft, cbdCenter);

  TfcCalcBevel = class(TBevel)
  public
    FColor:TColor;
  protected
    procedure Paint; override;
  end;

  TfcCalcLabel = class(TLabel)
  private
    FCalc:TfcCalculator;
    procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TfcCalcStatusLabel = class(TLabel)
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  end;

  TfcCalcButton = class(TSpeedButton)
  private
    FDrawKeyDown:Boolean;
    FCalc:TfcCalculator;
    ButtonColor:TColor;
    ButtonFontColor:TColor;
//    FCalcOptions: TfcCalcOptions;
    FTransparent:Boolean;
    FBtnType:TfcCalcButtonType;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBkgnd;
    procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
    function GetCalcOptions: TfcCalcOptions;
  protected
    procedure Paint; override;
    property DrawKeyDown:boolean read FDrawKeyDown write FDrawKeyDown;
  public
    property CalcOptions: TfcCalcOptions read GetCalcOptions;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TButtonRecord = record
    Top: Integer;
    Left: Integer;
    Width: Integer;
    Height: Integer;
    Caption: string;
    Hint:string;
    Color: TColor;
    ButtonColor: TColor;
    BtnType:TfcCalcButtonType;
  end;

  TfcCalculator = class(TCustomPanel)
   private
    FResultEdit: TEdit; // Need to make this right-aligned editing still
    FCalcEdit:TCustomEdit;
    FStatusLabel: TLabel;
    FMemoryValue: Double;

    FLastValue: Double;

    FCurrentValue: Double;
    FResultValue: Double;
    FLastOperand: Double;
    FLastOP:TfcCalcButtonType;
    FNextToLastOp:TfcCalcButtonType;
    FDecimalEntered:Boolean;
    FClearOnNextKey:Boolean;
    FLastOperatorEquals:Boolean;
    FLastStatus:String;
    FClearStatus:Boolean;
    FDecimalPlaces:integer;
    FLastButtonType:TfcCalcButtonType;

    F3D:Boolean;
    FStatusBevel: TfcCalcBevel;
    FMemoryBevel: TfcCalcBevel;
    FMemoryStatus: TfcCalcLabel;
    FPanelColor:TColor;
    FBackSpaceValid: Boolean;
    FOptions: TfcCalcOptions;
    FBackgroundBitmap: TPicture;
    FPaintBitmap: TBitmap;
    FOnSetButtonAttributes: TfcSetButtonAttributesEvent;

    OldBoundsRect: TRect;
    FMargin:integer;
    FBackgroundBitmapDrawStyle: TfcCalcBitmapDrawStyle;
    FCalcPrecision:Integer;
    InitBitmapsFlag: boolean;
    OpPressedWithShiftFlag: boolean;
    procedure SetOptions(Value: TfcCalcOptions);
    procedure SetPanelColor(Value: TColor);
    procedure SetMargin(Value: Integer);
    procedure SetBackgroundBitmapDrawStyle(Value: TfcCalcBitmapDrawStyle);
    procedure SetBackgroundBitmap(Value: TPicture);
    procedure SetBorder3D(const Value:Boolean);
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBkgnd;
   protected
     Btns: array [TfcCalcButtonType] of TButtonRecord;

     procedure CalcButtons; virtual;
     procedure Compute(Sender: TObject); virtual;
     function GetText : string; virtual;
     procedure SetText(const Value : string); virtual;
     function GetCalcEdit : TCustomEdit; virtual;
     procedure SetCalcEdit(const Value : TCustomEdit); virtual;
     function ButtonRecord(btnType:TfcCalcButtonType;
        aTop, aLeft, aWidth, aHeight: Integer; aCaption: string;
        aFontColor: TColor = clBlack; aHint:string = ''): TButtonRecord; virtual;
     procedure Loaded; override;
     property CalcPrecision:Integer read FCalcPrecision write FCalcPrecision;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure FullRepaint; virtual;
     procedure RefreshSummary; virtual;
     procedure Paint; override;
     function IsBinaryOperator(ButtonType:TfcCalcButtonType):boolean; virtual;
     procedure Reset; virtual;
     function OpToChar(aOp:TfcCalcButtonType):Char; virtual;
     function CharToButton(c:Char;Ctrl:Boolean):TfcCalcButton;
     function OpToButton(op:TfcCalcButtonType):TfcCalcButton;
     function CharToOp(c:Char;Ctrl:Boolean):TfcCalcButtonType; virtual;
     procedure ResultKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
     procedure ResultKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
     procedure DoCalc(ButtonType:TfcCalcButtonType); virtual;
     procedure DoCreateButton(Calc: TfcCalculator;var AType:TfcCalcButtonType;var ACaption:String;
       var AFontColor:TColor; var AButtonColor:TColor; var AHint:String); virtual;

     property Value : Double read FCurrentValue write FCurrentValue;
     property PaintBitmap: TBitmap read FPaintBitmap write FPaintBitmap;
     property ResultEdit: TEdit read FResultEdit write FResultEdit;
     property StatusLabel: TLabel read FStatusLabel write FStatusLabel;
     property MemoryStatus:TfcCalcLabel read FMemoryStatus write FMemoryStatus;
     property MemoryValue:Double read FMemoryValue write FMemoryValue;
     property CalcEdit:TCustomEdit read GetCalcEdit write SetCalcEdit;
     property LastOp:TfcCalcButtonType read FLastOp;
     property LastOperatorEquals:Boolean read FLastOperatorEquals;
   published
     property Align;
     property BackgroundBitmap: TPicture read FBackgroundBitmap write SetBackgroundBitmap;
     property BackgroundBitmapDrawStyle: TfcCalcBitmapDrawStyle read FBackgroundBitmapDrawStyle write SetBackgroundBitmapDrawStyle;
     property Border3D: Boolean read F3D write SetBorder3D default False;
     property ButtonMargin: integer read FMargin write SetMargin default 3;
     property FixedDecimalPlaces:integer read FDecimalPlaces write FDecimalPlaces default -1;
     property Font;
     property Options: TfcCalcOptions read FOptions write SetOptions default [];
     property PanelColor: TColor read FPanelColor write SetPanelColor default clBtnFace;
     property Text : string read GetText write SetText;
     property OnSetButtonAttributes: TfcSetButtonAttributesEvent read FOnSetButtonAttributes write FOnSetButtonAttributes;
     property Visible;
   end;
//procedure Register;

implementation

type
  TRightEdit = class (TEdit)
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  end;

procedure TRightEdit.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  Windows.HideCaret(self.handle);
end;

procedure TRightEdit.CreateParams(var Params: TCreateParams);
begin
   inherited CreateParams(Params);
   Params.ExStyle := Params.ExStyle or WS_EX_RIGHT
end;

procedure GetColorByteValues(AColor: TColor; var Reserved, Blue, Green, Red: Byte);
  var WinColor: COLORREF;
begin
  WinColor := ColorToRGB(AColor);
  Reserved := ($FF000000 and WinColor) Shr 24;
  Blue := ($00FF0000 and WinColor) Shr 16;
  Green := ($0000FF00 and WinColor) Shr 8;
  Red := ($000000FF and WinColor);
end;

function changecolor(acolor:TCOlor;brighten:boolean):TColor;
var  red,green,blue,dummy:Byte;
     dr,dg,db:integer;
begin
   GetColorByteValues(acolor,dummy,blue,green,red);
   dr:=red;dg:=green;db:=blue;
   if brighten then begin
      red:=fcMin(255,dr+Trunc((255-dr)*0.50)) ;
      green:=fcMin(255,dg+Trunc((255-dg)*0.50)) ;
      blue:=fcMin(255,db+Trunc((255-db)*0.50)) ;
   end
   else begin
      red:=fcMax(0,Trunc(dr*0.50)) ;
      green:=fcMax(0,Trunc(dg*0.50)) ;
      blue:=fcMax(0,Trunc(db*0.50)) ;
   end;
   result := TColor(RGB(red, Green, Blue))
end;

procedure Frame3D(Canvas: TCanvas; var Rect: TRect; TopColor, BottomColor: TColor;
  Width: Integer);

  procedure DoRect;
  var
    TopRight, BottomLeft: TPoint;
  begin
    with Canvas, Rect do
    begin
      TopRight.X := Right;
      TopRight.Y := Top;
      BottomLeft.X := Left;
      BottomLeft.Y := Bottom;
      Pen.Color := TopColor;
      PolyLine([BottomLeft, TopLeft, TopRight]);
      Pen.Color := BottomColor;
      Dec(BottomLeft.X);
      PolyLine([TopRight, BottomRight, BottomLeft]);
    end;
  end;

begin
  Canvas.Pen.Width := 1;
  Dec(Rect.Bottom); Dec(Rect.Right);
  while Width > 0 do
  begin
    Dec(Width);
    DoRect;
    InflateRect(Rect, -1, -1);
  end;
  Inc(Rect.Bottom); Inc(Rect.Right);
end;

procedure TfcCalcStatusLabel.CMTextChanged(var Message: TMessage);
begin
  Hint := Caption;
  inherited;
end;

function TfcCalculator.ButtonRecord(btnType:TfcCalcButtonType;
  aTop, aLeft, aWidth, aHeight: Integer; aCaption: string;
  aFontColor: TColor = clBlack; aHint:string = ''): TButtonRecord;
var aButtonColor:TColor;
begin
  aButtonColor := PanelColor;
  DoCreateButton(Self, btnType, ACaption, AFontColor, AButtonColor, AHint);
  Result.btnType := btnType;
  Result.Top := aTop;
  Result.Left := aLeft;
  Result.Width := aWidth;
  Result.Height := aHeight;
  Result.Caption := aCaption;
  Result.Color := aFontColor;
  Result.Hint := aHint;
  Result.ButtonColor := aButtonColor;
end;

{procedure TfcCalcButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
//  with Params do Style := Style or BS_OWNERDRAW;
end;}

{ TfcCalcBevel }
procedure TfcCalcBevel.Paint;
var R:TRect;
    BtnShadow,BtnLight:TColor;
begin
   R:= Rect(0,0,Width,Height);
   Frame3D(Canvas, R, clBlack, clWhite, 1);

   BtnShadow:= changeColor(FColor,False);
   BtnLight := changeColor(FColor,True);

   R:= Rect(1,1,Width-1,Height-1);
   Frame3D(Canvas, R, BtnShadow, BtnLight, 1);
end;

{ TfcCalcButton }
constructor TfcCalcButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCalc := AOwner as TfcCalculator;
  ControlStyle := ControlStyle + [csCaptureMouse, csDoubleClicks, csReflector];
  //3/1/2002-PYW-Add support for TDBCtrlGrid
  ControlStyle := ControlStyle + [csReplicatable];
  ButtonColor := clBtnFace;
  ButtonFontColor := clWindowText;
end;

destructor TfcCalcButton.Destroy;