calculatoreh.pas

自己做的用delphi开发的学生成绩管理系统。

{*******************************************************}
{                                                       }
{                       EhLib v3.0                      }
{         TCalculatorEh, TPopupCalculatorEh             }
{                                                       }
{      Copyright (c) 2002,2003 by Dmitry V. Bolshakov   }
{                                                       }
{*******************************************************}

{$I EhLib.Inc}

{$IFDEF EH_LIB_VCL}
unit CalculatorEh;
{$ELSE}
unit QCalculatorEh;
{$ENDIF}

interface

{$IFDEF EH_LIB_VCL}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Buttons, Math, ClipBrd, ToolCtrlsEh;
{$ELSE}
  Types, SysUtils, Classes, QGraphics, QControls, QForms, QDialogs,
  QStdCtrls, QExtCtrls, QButtons, Math, QClipBrd, QToolCtrlsEh;
{$ENDIF}

const
  DefCalcPrecision = 15;

type
  TCalcStateEh = (csFirstEh, csValidEh, csErrorEh);

{ TCalculatorEh }

  TCalculatorEh = class(TCustomControl)
    Panel1: TPanel;
    SpeedButton1: TSpeedButtonEh;
    SpeedButton2: TSpeedButtonEh;
    SpeedButton3: TSpeedButtonEh;
    SpeedButton4: TSpeedButtonEh;
    SpeedButton5: TSpeedButtonEh;
    SpeedButton6: TSpeedButtonEh;
    SpeedButton7: TSpeedButtonEh;
    SpeedButton8: TSpeedButtonEh;
    SpeedButton9: TSpeedButtonEh;
    SpeedButton10: TSpeedButtonEh;
    SpeedButton11: TSpeedButtonEh;
    SpeedButton12: TSpeedButtonEh;
    SpeedButton13: TSpeedButtonEh;
    SpeedButton14: TSpeedButtonEh;
    SpeedButton15: TSpeedButtonEh;
    SpeedButton16: TSpeedButtonEh;
    SpeedButton18: TSpeedButtonEh;
    SpeedButton19: TSpeedButtonEh;
    SpeedButton20: TSpeedButtonEh;
    SpeedButton22: TSpeedButtonEh;
    SpeedButton23: TSpeedButtonEh;
    SpeedButton24: TSpeedButtonEh;
    spEqual: TSpeedButtonEh;
    TextBox: TLabel;
    procedure SpeedButtonClick(Sender: TObject);
  private
    FBorderStyle: TBorderStyle;
    FClientHeight: Integer;
    FClientWidth: Integer;
    FOperand: Double;
    FOperator: Char;
    FPixelsPerInch: Integer;
    FStatus: TCalcStateEh;
    FTextHeight: Integer;
    function GetDisplayText: String;
    function GetDisplayValue: Double;
    function GetPixelsPerInch: Integer;
    procedure CheckFirst;
    procedure Clear;
    procedure Error;
    procedure ReadTextHeight(Reader: TReader);
    procedure SetBorderStyle(const Value: TBorderStyle);
    procedure SetClientHeight(Value: Integer);
    procedure SetClientWidth(Value: Integer);
    procedure SetDisplayText(const Value: String);
    procedure SetDisplayValue(const Value: Double);
    procedure SetOldCreateOrder(const Value: Boolean);
    procedure SetPixelsPerInch(const Value: Integer);
    procedure UpdateEqualButton;
  protected
{$IFDEF EH_LIB_VCL}
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
    function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
{$ENDIF}
    function GetBorderSize: Integer; virtual;
    function GetTextHeight: Integer;
{$IFDEF EH_LIB_VCL}
    procedure CreateParams(var Params: TCreateParams); override;
{$ENDIF}
    procedure DefineProperties(Filer: TFiler); override;
    procedure KeyPress(var Key: Char); override;
    procedure ReadState(Reader: TReader); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Copy;
    procedure Paste;
    procedure ProcessKey(Key: Char); virtual;
    property DisplayText: String read GetDisplayText write SetDisplayText;
    property DisplayValue: Double read GetDisplayValue write SetDisplayValue;
  published
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle;
    property ClientHeight write SetClientHeight;
    property ClientWidth write SetClientWidth;
    property Color;
    property Font;
    property OldCreateOrder: Boolean write SetOldCreateOrder;
    property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch stored False;
  end;

{ IPopupCalculatorEh }

  IPopupCalculatorEh = interface
    ['{697F81AD-0E0F-4A4A-A016-A713620660DE}']
    function GetEnterCanClose: Boolean;
    function GetFlat: Boolean;
    function GetValue: Variant;
    procedure SetFlat(const Value: Boolean);
    procedure SetValue(const Value: Variant);
    property Value: Variant read GetValue write SetValue;
    property Flat: Boolean read GetFlat write SetFlat;
    property EnterCanClose: Boolean read GetEnterCanClose;
  end;

{ TPopupCalculatorEh }

  TPopupCalculatorEh = class(TCalculatorEh, IPopupCalculatorEh, IUnknown)
  private
    FBorderWidth: Integer;
    FFlat: Boolean;
{$IFDEF EH_LIB_VCL}
    procedure CMCloseUpEh(var Message: TMessage); message CM_CLOSEUPEH;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
{$ENDIF}
  protected
    {IPopupCalculatorEh}
    function GetEnterCanClose: Boolean;
    function GetFlat: Boolean;
    function GetValue: Variant;
    procedure SetFlat(const Value: Boolean);
    procedure SetValue(const Value: Variant);
  protected
{$IFDEF EH_LIB_VCL}
    function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
    procedure CreateParams(var Params: TCreateParams); override;
{$ENDIF}
    procedure DrawBorder; virtual;
    procedure UpdateBorderWidth;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  public
    constructor Create(AOwner: TComponent); override;
    function CanFocus: Boolean; {$IFDEF EH_LIB_5} override; {$ENDIF}
    procedure ProcessKey(Key: Char); override;
    property Flat: Boolean read GetFlat write SetFlat default True;
    property Ctl3D;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterClass(TSpeedButtonEh);
end;

{$IFDEF EH_LIB_VCL}
{$R *.DFM}
{$ELSE}
{$R *.Xfm}
{$ENDIF}

const
  SError = 'Error';

  TagToCharArray: array[0..23] of Char =
    (#0,
     '7','8','9','/','S','C',
     '4','5','6','*','%','A',
     '1','2','3','-','R',#8,
     '0','I','.','+','='    );

{ TPopupCalculator }

constructor TCalculatorEh.Create(AOwner: TComponent);
var
  i: Integer;
begin
  inherited Create(AOwner);
  FPixelsPerInch := Screen.PixelsPerInch;
  InitInheritedComponent(Self, TCustomControl);
  for i := 0 to ComponentCount-1 do
    if Components[i] is TSpeedButtonEh then
    begin
      TSpeedButtonEh(Components[i]).Style := ebsGlyphEh;
      TSpeedButtonEh(Components[i]).Active := True;
    end;
{$IFDEF EH_LIB_VCL}
  AutoSize := True;
{$ENDIF}
end;

procedure TCalculatorEh.SetClientHeight(Value: Integer);
begin
  if csReadingState in ControlState then
  begin
    FClientHeight := Value;
    ScalingFlags := ScalingFlags + [sfHeight];
  end else
    inherited ClientHeight := Value;
end;

procedure TCalculatorEh.SetClientWidth(Value: Integer);
begin
  if csReadingState in ControlState then
  begin
    FClientWidth := Value;
    ScalingFlags := ScalingFlags + [sfWidth];
  end else
    inherited ClientWidth := Value;
end;

function TCalculatorEh.GetPixelsPerInch: Integer;
begin
  Result := FPixelsPerInch;
  if Result = 0 then Result := Screen.PixelsPerInch;
end;

procedure TCalculatorEh.SetPixelsPerInch(const Value: Integer);
begin
  if (Value <> GetPixelsPerInch) and ((Value = 0) or (Value >= 36))
    and (not (csLoading in ComponentState) or (FPixelsPerInch <> 0)) then
    FPixelsPerInch := Value;
end;

procedure TCalculatorEh.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);
  Filer.DefineProperty('PixelsPerInch', nil, nil, not IsControl);
  Filer.DefineProperty('TextHeight', ReadTextHeight, nil, not IsControl);
end;

procedure TCalculatorEh.ReadTextHeight(Reader: TReader);
begin
  FTextHeight := Reader.ReadInteger;
end;

procedure TCalculatorEh.ReadState(Reader: TReader);
var
  NewTextHeight: Integer;
  Scaled: Boolean;
begin
  DisableAlign;
  try
    FClientWidth := 0;
    FClientHeight := 0;
    FTextHeight := 0;
    Scaled := False;
    inherited ReadState(Reader);
    if (FPixelsPerInch <> 0) and (FTextHeight > 0) then
    begin
      if (sfFont in ScalingFlags) and (FPixelsPerInch <> Screen.PixelsPerInch) then
        Font.Height := MulDiv(Font.Height, Screen.PixelsPerInch, FPixelsPerInch);
      FPixelsPerInch := Screen.PixelsPerInch;
      NewTextHeight := GetTextHeight;
      if FTextHeight <> NewTextHeight then
      begin
        Scaled := True;
//        ScaleScrollBars(NewTextHeight, FTextHeight);
        ScaleControls(NewTextHeight, FTextHeight);
        if sfWidth in ScalingFlags then
          FClientWidth := MulDiv(FClientWidth, NewTextHeight, FTextHeight);
        if sfHeight in ScalingFlags then
          FClientHeight := MulDiv(FClientHeight, NewTextHeight, FTextHeight);
      end;
    end;
  //  if FClientWidth > 0 then inherited ClientWidth := FClientWidth;
//    if FClientHeight > 0 then inherited ClientHeight := FClientHeight;
    ScalingFlags := [];
    if not Scaled then
    begin
      { Forces all ScalingFlags to [] }
//      ScaleScrollBars(1, 1);
      ScaleControls(1, 1);
    end;
    Perform(CM_PARENTBIDIMODECHANGED, 0, 0);
  finally
    EnableAlign;
  end;
end;

function TCalculatorEh.GetTextHeight: Integer;
var
  RestoreCanvas: Boolean;
begin
  RestoreCanvas := not HandleAllocated;
  if RestoreCanvas then
    Canvas.Handle := GetDC(0);
  try
    Canvas.Font := Self.Font;
    Result := Canvas.TextHeight('0');
  finally
    if RestoreCanvas then
    begin
      ReleaseDC(0, Canvas.Handle);
      Canvas.Handle := 0;
    end;
  end;
end;

procedure TCalculatorEh.ProcessKey(Key: Char);
var
  R: Double;
begin
  Key := UpCase(Key);
  if (FStatus = csErrorEh) and (Key <> 'C') then
    Key := #0;
  if Key in [DecimalSeparator, '.', ','] then
  begin
    CheckFirst;
    if Pos(DecimalSeparator, DisplayText) = 0 then
      DisplayText := DisplayText + DecimalSeparator;
    Exit;
  end;
  case Key of
    'R': // 1/x
      if FStatus in [csValidEh, csFirstEh] then
      begin
        FStatus := csFirstEh;
        if DisplayValue = 0
          then Error
          else DisplayValue := 1.0 / DisplayValue;
      end;
    'S': // Sqrt
      if FStatus in [csValidEh, csFirstEh] then
      begin
        FStatus := csFirstEh;
        if DisplayValue < 0
          then Error
          else DisplayValue := Sqrt(DisplayValue);
      end;
    '0'..'9':
      begin
        CheckFirst;
        if DisplayText = '0' then
          DisplayText := '';
        if Pos('E', DisplayText) = 0 then
        begin
          if Length(DisplayText) < Max(2, DefCalcPrecision) + Ord(Boolean(Pos('-', DisplayText))) then
            DisplayText := DisplayText + Key;
        end;
      end;
    #8: // <-|
      begin
        CheckFirst;
        if (Length(DisplayText) = 1) or ((Length(DisplayText) = 2) and (DisplayText[1] = '-')) then
          DisplayText := '0'
        else
          DisplayText := System.Copy(DisplayText, 1, Length(DisplayText) - 1);