wwcalculator.pas

一套及时通讯的原码

unit wwcalculator;

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

interface

uses
  Windows, messages, Sysutils, Forms, Classes, Controls, StdCtrls, extctrls, ComCtrls, Graphics, Buttons,wwcommon,wwdbedit, wwtypes, wwframe;

type
  TwwCalcButtonType = (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);

  TCalcState = (csNone, csAdd, csSubtract, csMultiply, csDivide);

  TwwCalcOption = (cboHotTrackButtons, cboFlatButtons, cboHideBorder, cboHideEditor, cboShowStatus);
  TwwCalcOptions = set of TwwCalcOption;
  TwwCalcBitmapDrawStyle = (cbdStretch, cbdTile, cbdTopLeft, cbdCenter);

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

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

  TwwCalcButton = class(TSpeedButton)
  private
    FCalc:TwwCalculator;
    ButtonColor:TColor;
    ButtonFontColor:TColor;
    FOptions: TwwCalcOptions;
    FTransparent:Boolean;
    FBtnType:TwwCalcButtonType;
    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;
  protected
    procedure Paint; override;
  public
    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;
    BtnType:TwwCalcButtonType;
  end;

  TwwCalculator = class(TCustomPanel)
   private
    FResultEdit: TwwdbEdit;
    FStatusLabel: TLabel;
    FMemoryValue: Double;

    FLastValue: Double;

    FCurrentValue: Double;
    FResultValue: Double;
    FLastOperand: Double;
    FLastOP:TwwCalcButtonType;
    FNextToLastOp:TwwCalcButtonType;
    FDecimalEntered:Boolean;
    FClearOnNextKey:Boolean;
    FLastOperatorEquals:Boolean;
    FLastStatus:String;

    F3D:Boolean;
    FStatusBevel: TwwCalcBevel;
    FMemoryBevel: TwwCalcBevel;
    FMemoryStatus: TwwCalcLabel;
    FPanelColor:TColor;
    FBackSpaceValid: Boolean;
    FOptions: TwwCalcOptions;
    FBackgroundBitmap: TPicture;
    FPaintBitmap: TBitmap;
    OldBoundsRect: TRect;
    FMargin:integer;
    FBackgroundBitmapDrawStyle: TwwCalcBitmapDrawStyle;
    InitBitmapsFlag: boolean;
    procedure SetOptions(Value: TwwCalcOptions);
    procedure SetPanelColor(Value: TColor);
    procedure SetMargin(Value: Integer);
    procedure SetBackgroundBitmapDrawStyle(Value: TwwCalcBitmapDrawStyle);
    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 [TwwCalcButtonType] of TButtonRecord;

     procedure CalcButtons; virtual;
     procedure Compute(Sender: TObject); virtual;
     function GetText : string; virtual;
     procedure SetText(const Value : string); virtual;
     procedure Loaded; override;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure FullRepaint; virtual;
     procedure RefreshSummary; virtual;
     procedure Paint; override;
     function IsBinaryOperator(ButtonType:TwwCalcButtonType):boolean; virtual;
     procedure Reset; virtual;
     function OpToChar(aOp:TwwCalcButtonType):Char; virtual;
     function CharToOp(c:Char;Ctrl:Boolean):TwwCalcButtonType; virtual;
     procedure ResultKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
     procedure DoCalc(ButtonType:TwwCalcButtonType); virtual;

     property Value : Double read FCurrentValue write FCurrentValue;
     property PaintBitmap: TBitmap read FPaintBitmap write FPaintBitmap;
     property ResultEdit: TwwDBEdit read FResultEdit write FResultEdit;
     property StatusLabel: TLabel read FStatusLabel write FStatusLabel;
     property MemoryStatus:TwwCalcLabel read FMemoryStatus write FMemoryStatus;
     property MemoryValue:Double read FMemoryValue write FMemoryValue;
   published
     property Align;
     property BackgroundBitmap: TPicture read FBackgroundBitmap write SetBackgroundBitmap;
     property BackgroundBitmapDrawStyle: TwwCalcBitmapDrawStyle read FBackgroundBitmapDrawStyle write SetBackgroundBitmapDrawStyle;
     property Border3D: Boolean read F3D write SetBorder3D default False;
     property ButtonMargin: integer read FMargin write SetMargin default 3;
     property Font;
     property Options: TwwCalcOptions read FOptions write SetOptions default [];
     property PanelColor: TColor read FPanelColor write SetPanelColor default clBtnFace;
     property Text : string read GetText write SetText;
   end;
procedure Register;

implementation

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:=wwMin(255,dr+Trunc((255-dr)*0.50)) ;
      green:=wwMin(255,dg+Trunc((255-dg)*0.50)) ;
      blue:=wwMin(255,db+Trunc((255-db)*0.50)) ;
   end
   else begin
      red:=wwMax(0,Trunc(dr*0.50)) ;
      green:=wwMax(0,Trunc(dg*0.50)) ;
      blue:=wwMax(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;

function ButtonRecord(btnType:TwwCalcButtonType;
  aTop, aLeft, aWidth, aHeight: Integer; aCaption: string;
  aColor: TColor = clBlack; aHint:string = ''): TButtonRecord;
begin
  Result.btnType := btnType;
  Result.Top := aTop;
  Result.Left := aLeft;
  Result.Width := aWidth;
  Result.Height := aHeight;
  Result.Caption := aCaption;
  Result.Color := aColor;
  Result.Hint := aHint;
end;

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

{ TwwCalcBevel }
procedure TwwCalcBevel.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;

{ TwwCalcButton }
constructor TwwCalcButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCalc := AOwner as TwwCalculator;
  ControlStyle := ControlStyle + [csCaptureMouse, csDoubleClicks, csReflector];
  ButtonColor := clBtnFace;
  ButtonFontColor := clWindowText;
end;

destructor TwwCalcButton.Destroy;
begin
  inherited Destroy;
end;

procedure TwwCalcButton.WMRButtonDown(var Message: TWMRButtonDown);
begin
  inherited;
  if FCalc.StatusLabel <> nil then
     FCalc.statuslabel.Caption := Self.Hint;
end;

procedure TwwCalcButton.WMRButtonUp(var Message: TWMRButtonUp);
begin
  inherited;
  FCalc.RefreshSummary;
end;

constructor TwwCalcLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCalc := AOwner as TwwCalculator;
end;

procedure TwwCalcLabel.WMRButtonDown(var Message: TWMRButtonDown);
begin
  inherited;
  if FCalc.StatusLabel <> nil then
     FCalc.statuslabel.Caption := FloatToStr(FCalc.MemoryValue);
end;

procedure TwwCalcLabel.WMRButtonUp(var Message: TWMRButtonUp);
begin
  inherited;
  FCalc.RefreshSummary;
end;

procedure TwwCalcButton.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.result:= 1;
end;

procedure TwwCalcButton.Paint;
var
  IsDown: Boolean;
  R: TRect;
  P:TPoint;
  MouseinButton:BOolean;
  Btnlight,Btnshadow:TColor;
  SaveFontColor,SaveBrushColor,SavePenColor:TColor;
begin
  try
     Canvas.Lock;
     R := ClientRect;

     GetCursorPos(P);
     P:=(screenToClient(p));

     if PtInRect(r,p) then
        MouseInButton := True
     else MouseInButton := False;

     IsDown := (csLButtonDown in ControlState) and MouseInButton;

     Canvas.Font := Self.Font;
     Canvas.Pen.Color := clBlack;
     Canvas.Font.Color := ButtonFontColor;
     Canvas.Brush.Color := ButtonColor;

     if FTransparent then begin
        Canvas.CopyRect(ClientRect,(Parent as TwwCalculator).PaintBitmap.Canvas,
          Rect(Left,Top,Left+WIdth,Top+Height));
     end
     else Canvas.FillRect(r);

     if MouseInButton and (cboHotTrackButtons in FOptions) and not (cboFlatButtons in FOptions) then
    begin
       Canvas.Pen.Color := clWindowFrame;
       Canvas.Pen.Width := 1;
       Canvas.Brush.Style := bsClear;
       Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);

    { DrawFrameControl must draw within this border }
      InflateRect(R, -1, -1);
     end;

     Canvas.Pen.Color := clBtnShadow;
     Canvas.Pen.Width := 1;
     Canvas.Brush.Color := ButtonColor;

     BTnShadow:= changeColor(ButtonColor,False);
     BtnLight := changeColor(ButtonColor,True);

  { DrawFrameControl does not draw a pressed button correctly }
  if IsDown then
  begin
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
    Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
    Canvas.Pen.Color := BtnShadow;
    Canvas.Polyline([Point(r.left,r.bottom),Point(r.left,r.top),Point(r.right,r.top)]);
    Canvas.Pen.Color := clBlack;
    Canvas.Polyline([Point(r.left+1,r.bottom-1),Point(r.left+1,r.top+1),Point(r.right-1,r.top+1)]);
    Canvas.Pen.Color := BtnLight;
    Canvas.Polyline([Point(r.left+2,r.bottom-2),Point(r.right-2,r.bottom-2),Point(r.right-2,r.top+2)]);
    Canvas.Pen.Color := clWhite;
    Canvas.Polyline([Point(r.left+1,r.bottom-1),Point(r.right-1,r.bottom-1),Point(r.right-1,r.top+1)]);
    InflateRect(R, -1, -1);
  end
  else
  begin
    if not (cboFlatButtons in fOptions) or
       (PtInRect(r,p) and ((cboHotTrackButtons in FOptions))) then begin
      Canvas.Brush.Style := bsClear;
       Canvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
       Canvas.Pen.Color := BtnLight;
       Canvas.Polyline([Point(r.left,r.bottom),Point(r.left,r.top),Point(r.right,r.top)]);
       Canvas.Pen.Color := clWhite;
       Canvas.Polyline([Point(r.left+1,r.bottom-1),Point(r.left+1,r.top+1),Point(r.right-1,r.top+1)]);
       Canvas.Pen.Color := BtnShadow;
       Canvas.Polyline([Point(r.left+2,r.bottom-2),Point(r.right-2,r.bottom-2),Point(r.right-2,r.top+1)]);
       Canvas.Pen.Color := clBlack;
       Canvas.Polyline([Point(r.left+1,r.bottom-1),Point(r.right-1,r.bottom-1),Point(r.right-1,r.top)]);
    end;

//    InflateRect(R, -1, -1);
  end;

 if PtInRect(r,p) and False then
  begin
    R := ClientRect;
    InflateRect(R, -1, -1);
  end;

  if IsDown then
    OffsetRect(R, 1, 1);

  Canvas.Brush.Style := bsClear;
  DrawText(Canvas.Handle,PChar(Caption),length(caption),R,DT_CENTER or DT_VCENTER or DT_SINGLELINE);

{ if PtInRect(r,p) or False then
  begin
    R := ClientRect;
    InflateRect(R, -4, -4);
    Canvas.Pen.Color := clWindowFrame;
    Canvas.Brush.Color := clBtnFace;
//    DrawFocusRect(Canvas.Handle, R);
  end;}
  finally
     Canvas.Font.COlor := SaveFontColor;
     Canvas.Brush.Color := SaveBrushColor;
     Canvas.Pen.COlor := SavePenColor;
     Canvas.Unlock;
  end;
end;

procedure TwwCalcButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if cboHotTrackButtons in FOptions then
     Invalidate;
end;

procedure TwwCalcButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if cboHotTrackButtons in FOptions then
     Invalidate;

end;

procedure TwwCalcButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

{ TwwCalculator }
constructor TwwCalculator.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetBounds(0,0,250,200);
  FMemoryValue := 0;