bscalc.pas

BusinessSkinForm的控件包与实例

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

unit bscalc;

interface

{$WARNINGS OFF}
{$HINTS OFF}

uses Windows, SysUtils, 
     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 KeyDown(var Key: Word; Shift: TShiftState); override;
    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 Alignment;
    property UseSkinFont;
    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;

  TbsSkinCalcCurrencyEdit = class;

  TbsCurrencyPopupCalculatorForm = 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: TbsSkinCalcCurrencyEdit;
    FCalcPanel: TbsSkinPanel;
    FDisplayLabel: TbsSkinLabel;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Show(X, Y: Integer);
    procedure Hide;
  end;

  TbsSkinCalcCurrencyEdit = class(TbsSkinCurrencyEdit)
  private
    FMemory: Double;
    FPrecision: Byte;
    FCalc: TbsCurrencyPopupCalculatorForm;
    FCalcButtonSkinDataName: String;
    FCalcDisplayLabelSkinDataName: String;
    FAlphaBlend: Boolean;
    FAlphaBlendAnimation: Boolean;
    FAlphaBlendValue: Byte;
    procedure ButtonClick(Sender: TObject);
    procedure DropDown;
    procedure CloseUp;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Memory: Double read FMemory;
  published
    property Precision: Byte read FPrecision write FPrecision default DefCalcPrecision;
    property Alignment;
    property UseSkinFont;
    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 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;
  CS_DROPSHADOW_ = $20000;
  BtnOffset = 5;
  
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, '=', '%'];