bscalc.pas

漂亮的皮肤控件 for delphi 567

{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       BusinessSkinForm                                            }
{       Version 2.52                                                }
{                                                                   }
{       Copyright (c) 2000-2003 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: [e-mail]                                 }
{                                                                   }
{*******************************************************************}

unit bscalc;

interface

uses Windows, SysUtils, {$IFDEF VER 140}Variants,{$ENDIF}
     {$IFDEF VER 150}Variants,{$ENDIF}
  Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus,
  ExtCtrls, Buttons, bsSkinCtrls, Clipbrd, BusinessSkinForm, bsSkinData,
  bsSkinBoxCtrls;

const
  DefCalcPrecision = 15;

type
  TbsCalcState = (csFirst, csValid, csError);
  TbsCalculatorForm = class;

{ TbsSkinCalculator }

  TbsSkinCalculator = class(TComponent)
  private
    FAlphaBlend: Boolean;
    FAlphaBlendAnimation: Boolean;
    FAlphaBlendValue: Byte;
    FSD: TbsSkinData;
    FCtrlFSD: TbsSkinData;
    FButtonSkinDataName: String;
    FDisplayLabelSkinDataName: String;
    FDefaultFont: TFont;
    FValue: Double;
    FTitle: String;
    FMemory: Double;
    FPrecision: Byte;
    FBeepOnError: Boolean;
    FHelpContext: THelpContext;
    FCalc: TbsCalculatorForm;
    FOnChange: TNotifyEvent;
    FOnCalcKey: TKeyPressEvent;
    FOnDisplayChange: TNotifyEvent;
    function GetDisplay: Double;
    function GetTitle: string;
    procedure SetTitle(const Value: string);
    procedure SetDefaultFont(Value: TFont);
    function TitleStored: Boolean;
  protected
    procedure Change; dynamic;
    procedure CalcKey(var Key: Char); dynamic;
    procedure DisplayChange; dynamic;
    procedure Notification(AComponent: TComponent;  Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
    property CalcDisplay: Double read GetDisplay;
    property Memory: Double read FMemory;
  published
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property SkinData: TbsSkinData read FSD write FSD;
    property CtrlSkinData: TbsSkinData read FCtrlFSD write FCtrlFSD;
    property ButtonSkinDataName: String
      read FButtonSkinDataName write FButtonSkinDataName;
    property DisplayLabelSkinDataName: String
      read FDisplayLabelSkinDataName write FDisplayLabelSkinDataName;
    property DefaultFont: TFont read FDefaultFont write SetDefaultFont;  
    property BeepOnError: Boolean read FBeepOnError write FBeepOnError default True;
    property HelpContext: THelpContext read FHelpContext write FHelpContext default 0;
    property Precision: Byte read FPrecision write FPrecision default DefCalcPrecision;
    property Title: string read GetTitle write SetTitle stored TitleStored;
    property Value: Double read FValue write FValue;
    property OnCalcKey: TKeyPressEvent read FOnCalcKey write FOnCalcKey;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDisplayChange: TNotifyEvent read FOnDisplayChange write FOnDisplayChange;
  end;

{ TbsCalculatorForm }

  TbsCalculatorForm = class(TForm)
  private
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  protected
    procedure OkClick(Sender: TObject);
    procedure CancelClick(Sender: TObject);
    procedure CalcKey(Sender: TObject; var Key: Char);
    procedure DisplayChange(Sender: TObject);
  public
    BSF: TbsBusinessSkinForm;
    FCalcPanel: TbsSkinPanel;
    FDisplayLabel: TbsSkinLabel;
    constructor Create(AOwner: TComponent); override;
  end;

  TbsSkinCalcEdit = class;

  TbsPopupCalculatorForm = class(TbsSkinPanel)
  protected
    procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure OkClick(Sender: TObject);
    procedure CancelClick(Sender: TObject);
  public
    CalcEdit: TbsSkinCalcEdit;
    FCalcPanel: TbsSkinPanel;
    FDisplayLabel: TbsSkinLabel;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Show(X, Y: Integer);
    procedure Hide;
  end;

  TbsSkinCalcEdit = class(TbsSkinCustomEdit)
  private
    FMemory: Double;
    FPrecision: Byte;
    FCalc: TbsPopupCalculatorForm;
    StopCheck, FromEdit: Boolean;
    FDecimal: Byte;
    FMinValue, FMaxValue, FIncrement: Double;
    FValueType: TbsValueType;
    FValue: Double;
    FCalcButtonSkinDataName: String;
    FCalcDisplayLabelSkinDataName: String;
    FAlphaBlend: Boolean;
    FAlphaBlendAnimation: Boolean;
    FAlphaBlendValue: Byte;
    procedure SetValue(AValue: Double);
    procedure SetMinValue(AValue: Double);
    procedure SetMaxValue(AValue: Double);
    procedure SetValueType(NewType: TbsValueType);
    procedure SetDecimal(NewValue: Byte);
    procedure ButtonClick(Sender: TObject);
    procedure DropDown;
    procedure CloseUp;
  protected
    function CheckValue(NewValue: Double): Double;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure KeyPress(var Key: Char); override;
    function IsValidChar(Key: Char): Boolean;
    procedure Change; override;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    property Text;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function IsNumText(AText: String): Boolean;
    property Memory: Double read FMemory;
  published
    property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
    property AlphaBlendAnimation: Boolean
      read FAlphaBlendAnimation write FAlphaBlendAnimation;
    property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
    property CalcButtonSkinDataName: String
      read FCalcButtonSkinDataName
      write FCalcButtonSkinDataName;
    property CalcDisplayLabelSkinDataName: String
      read FCalcDisplayLabelSkinDataName
      write FCalcDisplayLabelSkinDataName;
    property Precision: Byte read FPrecision write FPrecision default DefCalcPrecision;
    property ValueType: TbsValueType read FValueType write SetValueType;
    property Decimal: Byte read FDecimal write SetDecimal default 2;
     property Align;
    property MinValue: Double read FMinValue write SetMinValue;
    property MaxValue: Double read FMaxValue write SetMaxValue;
    property Value: Double read FValue write SetValue;
    property Increment: Double read FIncrement write FIncrement;
        property DefaultFont;
    property DefaultWidth;
    property DefaultHeight;
    property ButtonMode;
    property SkinData;
    property SkinDataName;
    property OnMouseEnter;
    property OnMouseLeave;
    property ReadOnly;
    property Font;
    property Anchors;
    property AutoSelect;
    property BiDiMode;
    property CharCase;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property HideSelection;
    property ImeMode;
    property ImeName;
    property MaxLength;
    property OEMConvert;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnButtonClick;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;


function CreateCalculatorForm(AOwner: TComponent; AHelpContext: THelpContext): TbsCalculatorForm;

implementation

 {$R bscalc}

uses bsUtils, bsConst;

const
  WS_EX_LAYERED = $80000;
  
type
  TCalcBtnKind =
   (cbNone, cbNum0, cbNum1, cbNum2, cbNum3, cbNum4, cbNum5, cbNum6,
    cbNum7, cbNum8, cbNum9, cbSgn, cbDcm, cbDiv, cbMul, cbSub,
    cbAdd, cbSqr, cbPcnt, cbRev, cbEql, cbBck, cbClr, cbMP,
    cbMS, cbMR, cbMC, cbOk, cbCancel);

function CreateCalculatorForm(AOwner: TComponent; AHelpContext: THelpContext): TbsCalculatorForm;
begin
  Result := TbsCalculatorForm.Create(AOwner);
  with Result do
  try
    HelpContext := AHelpContext;
    if HelpContext <> 0 then BorderIcons := BorderIcons + [biHelp];
    if Screen.PixelsPerInch <> 96 then begin { scale to screen res }
      ScaleBy(Screen.PixelsPerInch, 96);
      Left := (Screen.Width div 2) - (Width div 2);
      Top := (Screen.Height div 2) - (Height div 2);
    end;
  except
    Free;
    raise;
  end;
end;

{ TCalcButton }

type
  TCalcButton = class(TbsSkinSpeedButton)
  private
    FKind: TCalcBtnKind;
  protected
  public
    constructor CreateKind(AOwner: TComponent; AKind: TCalcBtnKind);
    property Kind: TCalcBtnKind read FKind;
  end;

constructor TCalcButton.CreateKind(AOwner: TComponent; AKind: TCalcBtnKind);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FKind := AKind;
  if FKind in [cbNum0..cbClr] then Tag := Ord(Kind) - 1
  else Tag := -1;
end;

const
  BtnPos: array[TCalcBtnKind] of TPoint =
  ((X: -1; Y: -1), (X: 38; Y: 120), (X: 38; Y: 92), (X: 71; Y: 92),
    (X: 104; Y: 92), (X: 38; Y: 64), (X: 71; Y: 64), (X: 104; Y: 64),
    (X: 38; Y: 36), (X: 71; Y: 36), (X: 104; Y: 36), (X: 71; Y: 120),
    (X: 104; Y: 120), (X: 137; Y: 36), (X: 137; Y: 64), (X: 137; Y: 92),
    (X: 137; Y: 120), (X: 170; Y: 36), (X: 170; Y: 64), (X: 170; Y: 92),
    (X: 170; Y: 120), (X: 104; Y: 6), (X: 154; Y: 6), (X: 5; Y: 120),
    (X: 5; Y: 92), (X: 5; Y: 64), (X: 5; Y: 36),
    (X: 38; Y: 6), (X: 71; Y: 6));

   ResultKeys = [#13, '=', '%'];

function CreateCalcBtn(AParent: TWinControl; AKind: TCalcBtnKind;
  AOnClick: TNotifyEvent): TCalcButton;
const
  BtnCaptions: array[cbSgn..cbMC] of PChar =
   ('+/-', ',', '/', '*', '-', '+', 'sqrt', '%', '1/x', '=', '<', 'C',
    'MP', 'MS', 'MR', 'MC');
begin
  Result := TCalcButton.CreateKind(AParent, AKind);
  with Result do
  try
    if Kind in [cbNum0..cbNum9] then Caption := IntToStr(Tag)
    else if Kind = cbDcm then Caption := DecimalSeparator
    else if Kind in [cbSgn..cbMC] then Caption := StrPas(BtnCaptions[Kind]);
    Left := BtnPos[Kind].X;
    Top := BtnPos[Kind].Y;
    Width := 30;
    Height := 22;
    OnClick := AOnClick;
    Parent := AParent;
  except
    Free;
    raise;
  end;
end;

{ TCalculatorPanel }

type
  TCalculatorPanel = class(TbsSkinPanel)
  private
    FText: string;
    FStatus: TbsCalcState;
    FOperator: Char;
    FOperand: Double;
    FMemory: Double;
    FPrecision: Byte;
    FBeepOnError: Boolean;
    FMemoryLabel: TbsSkinStdLabel;
    FOnError: TNotifyEvent;
    FOnOk: TNotifyEvent;
    FOnCancel: TNotifyEvent;
    FOnResult: TNotifyEvent;
    FOnTextChange: TNotifyEvent;
    FOnCalcKey: TKeyPressEvent;
    FOnDisplayChange: TNotifyEvent;
    FControl: TControl;
    procedure SetText(const Value: string);
    procedure CheckFirst;
    procedure CalcKey(Key: Char);
    procedure Clear;
    procedure Error;
    procedure SetDisplay(R: Double);
    function GetDisplay: Double;
    procedure UpdateMemoryLabel;
    function FindButton(Key: Char): TbsSkinSpeedButton;
    procedure BtnClick(Sender: TObject);
  protected
    procedure TextChanged; virtual;
  public
    constructor CreateLayout(AOwner: TComponent);
    procedure CalcKeyPress(Sender: TObject; var Key: Char);
    procedure Copy;
    procedure Paste;
    property DisplayValue: Double read GetDisplay write SetDisplay;
    property Text: string read FText;
    property OnOkClick: TNotifyEvent read FOnOk write FOnOk;
    property OnCancelClick: TNotifyEvent read FOnCancel write FOnCancel;
    property OnResultClick: TNotifyEvent read FOnResult write FOnResult;
    property OnError: TNotifyEvent read FOnError write FOnError;
    property OnTextChange: TNotifyEvent read FOnTextChange write FOnTextChange;
    property OnCalcKey: TKeyPressEvent read FOnCalcKey write FOnCalcKey;
    property OnDisplayChange: TNotifyEvent read FOnDisplayChange write FOnDisplayChange;
  end;

constructor TCalculatorPanel.CreateLayout(AOwner: TComponent);
var
  I: TCalcBtnKind;
const
    BtnCaptions: array[cbSgn..cbCancel] of PChar =
    ('+/-', ',', '/', '*', '-', '+', 'sqrt', '%', '1/x', '=', '', '',
    'MP', 'MS', 'MR', 'MC', '', '');
begin
  inherited Create(AOwner);
  Height := 150;
  Width := 210;
  try
    for I := cbNum0 to cbCancel do begin
      if BtnPos[I].X > 0 then
        with CreateCalcBtn(Self, I, BtnClick) do
        begin
          NumGlyphs := 1;
          case I of
            cbClr: Glyph.LoadFromResourceName(HInstance, 'BS_CALC_CLEAR');
            cbBck: Glyph.LoadFromResourceName(HInstance, 'BS_CALC_BACKSPACE');
            cbOK: Glyph.LoadFromResourceName(HInstance, 'BS_CALC_OK');
            cbCancel: Glyph.LoadFromResourceName(HInstance, 'BS_CALC_CANCEL');
          end;
          if (Kind in [cbBck, cbClr]) then Width := 46;
          if (Kind in [cbSgn..cbCancel]) then Caption := BtnCaptions[Kind];
        end;
    end;
    FMemoryLabel := TbsSkinStdLabel.Create(Self);
    with FMemoryLabel do begin
      SetBounds(6, 7, 34, 20);
      Parent := Self;
      Alignment := taCenter;
    end;
  finally
  end;
  FText := '0';
  FMemory := 0.0;
  FPrecision := DefCalcPrecision;
  FBeepOnError := True;
end;

procedure TCalculatorPanel.SetText(const Value: string);
begin
  if FText <> Value then begin
    FText := Value;
    TextChanged;
  end;
end;

procedure TCalculatorPanel.TextChanged;
begin
  if Assigned(FControl) then TLabel(FControl).Caption := FText;
  if Assigned(FOnTextChange) then FOnTextChange(Self);