bscalc.pas

漂亮的皮肤控件 for delphi 567

end;

procedure TCalculatorPanel.Error;
begin
  FStatus := csError;
  SetText(BS_ERROR);
  if FBeepOnError then MessageBeep(0);
  if Assigned(FOnError) then FOnError(Self);
end;

procedure TCalculatorPanel.SetDisplay(R: Double);
var
  S: string;
begin
  S := FloatToStrF(R, ffGeneral, Max(2, FPrecision), 0);
  if FText <> S then begin
    SetText(S);
    if Assigned(FOnDisplayChange) then FOnDisplayChange(Self);
  end;
end;

function TCalculatorPanel.GetDisplay: Double;
begin
  if FStatus = csError then Result := 0.0
  else Result := StrToFloat(Trim(FText));
end;

procedure TCalculatorPanel.CheckFirst;
begin
  if FStatus = csFirst then begin
    FStatus := csValid;
    SetText('0');
  end;
end;

procedure TCalculatorPanel.UpdateMemoryLabel;
begin
  if FMemoryLabel <> nil then
    if FMemory <> 0.0 then FMemoryLabel.Caption := 'M'
    else FMemoryLabel.Caption := '';
end;

procedure TCalculatorPanel.CalcKey(Key: Char);
var
  R: Double;
begin
  Key := UpCase(Key);
  if (FStatus = csError) and (Key <> 'C') then Key := #0;
  if Assigned(FOnCalcKey) then FOnCalcKey(Self, Key);
  if Key in [DecimalSeparator, '.', ','] then begin
    CheckFirst;
    if Pos(DecimalSeparator, FText) = 0 then
      SetText(FText + DecimalSeparator);
    Exit;
  end;
  case Key of
    'R':
      if FStatus in [csValid, csFirst] then begin
        FStatus := csFirst;
        if GetDisplay = 0 then Error else SetDisplay(1.0 / GetDisplay);
      end;
    'Q':
      if FStatus in [csValid, csFirst] then begin
        FStatus := csFirst;
        if GetDisplay < 0 then Error else SetDisplay(Sqrt(GetDisplay));
      end;
    '0'..'9':
      begin
        CheckFirst;
        if FText = '0' then SetText('');
        if Pos('E', FText) = 0 then begin
          if Length(FText) < Max(2, FPrecision) + Ord(Boolean(Pos('-', FText))) then
            SetText(FText + Key)
          else if FBeepOnError then MessageBeep(0);
        end;
      end;
    #8:
      begin
        CheckFirst;
        if (Length(FText) = 1) or ((Length(FText) = 2) and (FText[1] = '-')) then
          SetText('0')
        else
          SetText(System.Copy(FText, 1, Length(FText) - 1));
      end;
    '_': SetDisplay(-GetDisplay);
    '+', '-', '*', '/', '=', '%', #13:
      begin
        if FStatus = csValid then begin
          FStatus := csFirst;
          R := GetDisplay;
          if Key = '%' then
            case FOperator of
              '+', '-': R := FOperand * R / 100.0;
              '*', '/': R := R / 100.0;
            end;
          case FOperator of
            '+': SetDisplay(FOperand + R);
            '-': SetDisplay(FOperand - R);
            '*': SetDisplay(FOperand * R);
            '/': if R = 0 then Error else SetDisplay(FOperand / R);
          end;
        end;
        FOperator := Key;
        FOperand := GetDisplay;
        if Key in ResultKeys then
          if Assigned(FOnResult) then FOnResult(Self);
      end;
    #27, 'C': Clear;
    ^C: Copy;
    ^V: Paste;
  end;
end;

procedure TCalculatorPanel.Clear;
begin
  FStatus := csFirst;
  SetDisplay(0.0);
  FOperator := '=';
end;

procedure TCalculatorPanel.CalcKeyPress(Sender: TObject; var Key: Char);
var
  Btn: TbsSkinSpeedButton;
begin
  Btn := FindButton(Key);
  if Btn <> nil then Btn.ButtonClick
  else CalcKey(Key);
end;

function TCalculatorPanel.FindButton(Key: Char): TbsSkinSpeedButton;
const
  ButtonChars = '0123456789_./*-+Q%R='#8'C';
var
  I: Integer;
  BtnTag: Longint;
begin
  if Key in [DecimalSeparator, '.', ','] then Key := '.'
  else if Key = #13 then Key := '='
  else if Key = #27 then Key := 'C';
  BtnTag := Pos(UpCase(Key), ButtonChars) - 1;
  if BtnTag >= 0 then
    for I := 0 to ControlCount - 1 do begin
      if Controls[I] is TbsSkinSpeedButton then begin
        Result := TbsSkinSpeedButton(Controls[I]);
        if Result.Tag = BtnTag then Exit;
      end;
    end;
  Result := nil;
end;

procedure TCalculatorPanel.BtnClick(Sender: TObject);
begin
  case TCalcButton(Sender).Kind of
    cbNum0..cbNum9: CalcKey(Char(TComponent(Sender).Tag + Ord('0')));
    cbSgn: CalcKey('_');
    cbDcm: CalcKey(DecimalSeparator);
    cbDiv: CalcKey('/');
    cbMul: CalcKey('*');
    cbSub: CalcKey('-');
    cbAdd: CalcKey('+');
    cbSqr: CalcKey('Q');
    cbPcnt: CalcKey('%');
    cbRev: CalcKey('R');
    cbEql: CalcKey('=');
    cbBck: CalcKey(#8);
    cbClr: CalcKey('C');
    cbMP:
      if FStatus in [csValid, csFirst] then begin
        FStatus := csFirst;
        FMemory := FMemory + GetDisplay;
        UpdateMemoryLabel;
      end;
    cbMS:
      if FStatus in [csValid, csFirst] then begin
        FStatus := csFirst;
        FMemory := GetDisplay;
        UpdateMemoryLabel;
      end;
    cbMR:
      if FStatus in [csValid, csFirst] then begin
        FStatus := csFirst;
        CheckFirst;
        SetDisplay(FMemory);
      end;
    cbMC:
      begin
        FMemory := 0.0;
        UpdateMemoryLabel;
      end;
    cbOk:
      begin
        if FStatus <> csError then begin
          CalcKey('=');
          DisplayValue := DisplayValue; { to raise exception on error }
          if Assigned(FOnOk) then FOnOk(Self);
        end
        else if FBeepOnError then MessageBeep(0);
      end;
    cbCancel: if Assigned(FOnCancel) then FOnCancel(Self);
  end;
end;

procedure TCalculatorPanel.Copy;
begin
  Clipboard.AsText := FText;
end;

procedure TCalculatorPanel.Paste;
begin
  if Clipboard.HasFormat(CF_TEXT) then
    try
      SetDisplay(StrToFloat(Trim(ReplaceStr(Clipboard.AsText,
        CurrencyString, ''))));
    except
      SetText('0');
    end;
end;

{ TbsCalculator }

constructor TbsSkinCalculator.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTitle := BS_CALC_CAP;
  FPrecision := DefCalcPrecision;
  FBeepOnError := True;
  FButtonSkinDataName := 'toolbutton';
  FDisplayLabelSkinDataName := 'label';
  FDefaultFont := TFont.Create;
  with FDefaultFont do
  begin
    Name := 'Arial';
    Style := [];
    Height := 14;
  end;
end;

destructor TbsSkinCalculator.Destroy;
begin
  FOnChange := nil;
  FOnDisplayChange := nil;
  FDefaultFont.Free;
  inherited Destroy;
end;

procedure TbsSkinCalculator.SetDefaultFont;
begin
  FDefaultFont.Assign(Value);
end;


procedure TbsSkinCalculator.Notification;
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
  if (Operation = opRemove) and (AComponent = FCtrlFSD) then FCtrlFSD := nil;
end;

function TbsSkinCalculator.GetTitle: string;
begin
  Result := FTitle;
end;

procedure TbsSkinCalculator.SetTitle(const Value: string);
begin
  FTitle := Value;
end;

function TbsSkinCalculator.TitleStored: Boolean;
begin
  Result := Title <> BS_CALC_CAP;
end;

function TbsSkinCalculator.GetDisplay: Double;
begin
  if Assigned(FCalc) then
    Result := TCalculatorPanel(FCalc.FCalcPanel).GetDisplay
  else Result := FValue;
end;

procedure TbsSkinCalculator.CalcKey(var Key: Char);
begin
  if Assigned(FOnCalcKey) then FOnCalcKey(Self, Key);
end;

procedure TbsSkinCalculator.DisplayChange;
begin
  if Assigned(FOnDisplayChange) then FOnDisplayChange(Self);
end;

procedure TbsSkinCalculator.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

function TbsSkinCalculator.Execute: Boolean;
var
  i: Integer;
  FW, FH: Integer;
begin
  FCalc := CreateCalculatorForm(Self, HelpContext);
  with FCalc do
  try
    FCalcPanel.SkinData := Self.CtrlSkinData;
    FDisplayLabel.DefaultFont := FDefaultFont;
    FDisplayLabel.SkinDataName := FDisplayLabelSkinDataName;
    FDisplayLabel.SkinData := Self.CtrlSkinData;
    for i := 0 to FCalcPanel.ControlCount - 1 do
    if FCalcPanel.Controls[i] is TbsSkinSpeedButton then
    with TbsSkinSpeedButton(FCalcPanel.Controls[i]) do
    begin
      DefaultFont := Self.DefaultFont;
      DefaultHeight := 25;
      SkinDataName := FButtonSkinDataName;
      SkinData := CtrlSkinData;
    end
    else
    if FCalcPanel.Controls[i] is TbsSkinStdLabel then
    with TbsSkinStdLabel(FCalcPanel.Controls[i]) do
    begin
      DefaultFont := Self.DefaultFont;
      SkinData := CtrlSkinData;
    end;
    Caption := Self.Title;
    TCalculatorPanel(FCalcPanel).FMemory := Self.FMemory;
    TCalculatorPanel(FCalcPanel).UpdateMemoryLabel;
    TCalculatorPanel(FCalcPanel).FPrecision := Max(2, Self.Precision);
    TCalculatorPanel(FCalcPanel).FBeepOnError := Self.BeepOnError;
    if Self.FValue <> 0 then begin
      TCalculatorPanel(FCalcPanel).DisplayValue := Self.FValue;
      TCalculatorPanel(FCalcPanel).FStatus := csFirst;
      TCalculatorPanel(FCalcPanel).FOperator := '=';
    end;

    BSF.BorderIcons := [];
    BSF.SkinData := Self.SkinData;
    BSF.MenusSkinData := Self.CtrlSkinData;
    BSF.AlphaBlend := AlphaBlend;
    BSF.AlphaBlendAnimation := AlphaBlendAnimation;
    BSF.AlphaBlendValue := AlphaBlendValue;

    FW := 205;
    FH := FCalcPanel.Height + FDisplayLabel.Height;

    if (SkinData <> nil) and not SkinData.Empty
    then
      begin
        if FW < BSF.GetMinWidth then FW := BSF.GetMinWidth;
        if FH < BSF.GetMinHeight then FH := BSF.GetMinHeight;  
      end;

    ClientWidth := FW;
    ClientHeight := FH;

    Result := (ShowModal = mrOk);

    if Result then begin
      Self.FMemory := TCalculatorPanel(FCalcPanel).FMemory;
      if (TCalculatorPanel(FCalcPanel).DisplayValue <> Self.FValue) then begin
        Self.FValue := TCalculatorPanel(FCalcPanel).DisplayValue;
        Change;
      end;
    end;
  finally
    Free;
    FCalc := nil;
  end;
end;

{ TbsCalculatorForm }

constructor TbsCalculatorForm.Create(AOwner: TComponent);
begin
  inherited CreateNew(AOwner);
  BorderStyle := bsDialog;
  Caption := BS_CALC_CAP;
  KeyPreview := True;
  PixelsPerInch := 96;
  Position := poScreenCenter;
  OnKeyPress := FormKeyPress;
  { DisplayPanel }
  FDisplayLabel := TbsSkinLabel.Create(Self);
  with FDisplayLabel do begin
    Align := alTop;
    Parent := Self;
    AutoSize := False;
    Alignment := taRightJustify;
    Caption := '0';
    BorderStyle := bvFrame;
    DefaultHeight := 20;
  end;
  { CalcPanel }
  FCalcPanel := TCalculatorPanel.CreateLayout(Self);
  with TCalculatorPanel(FCalcPanel) do begin
    Align := alTop;
    Parent := Self;
    OnOkClick := Self.OkClick;
    OnCancelClick := Self.CancelClick;
    OnCalcKey := Self.CalcKey;
    OnDisplayChange := Self.DisplayChange;
    FControl := FDisplayLabel;
    BorderStyle := bvNone;
  end;
  BSF := TbsBusinessSkinForm.Create(Self);
end;

procedure TbsCalculatorForm.FormKeyPress(Sender: TObject; var Key: Char);
begin
  TCalculatorPanel(FCalcPanel).CalcKeyPress(Sender, Key);
end;

procedure TbsCalculatorForm.OkClick(Sender: TObject);
begin
  ModalResult := mrOk;
end;

procedure TbsCalculatorForm.CancelClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TbsCalculatorForm.CalcKey(Sender: TObject; var Key: Char);
begin
  if (Owner <> nil) and (Owner is TbsSkinCalculator) then
    TbsSkinCalculator(Owner).CalcKey(Key);
end;

procedure TbsCalculatorForm.DisplayChange(Sender: TObject);
begin
  if (Owner <> nil) and (Owner is TbsSkinCalculator) then
    TbsSkinCalculator(Owner).DisplayChange;
end;

constructor TbsSkinCalcEdit.Create(AOwner: TComponent);