bscalc.pas

一套非常好用的delphi控件,方便程序员工作

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);
  if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
  then
    FCalc.Caption := SkinData.ResourceStrData.GetResStr('CALC_CAP');
  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 + BtnOffset * 2;
    FH := FCalcPanel.Height + FDisplayLabel.Height + BtnOffset;

    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);
begin
  inherited;
  ButtonMode := True;
  FValue := 0;
  FIncrement := 1;
  FDecimal := 2;
  StopCheck := True;
  Text := '0';
  StopCheck := False;
  FromEdit := False;
  Width := 120;
  Height := 20;
  FSkinDataName := 'buttonedit';
  OnButtonClick := ButtonClick;
  FCalc := TbsPopupCalculatorForm.Create(Self);
  FCalc.Visible := False;
  FCalc.CalcEdit := Self;
  FCalc.Parent := Self;
  FMemory := 0.0;
  FPrecision := DefCalcPrecision;
  FCalcButtonSkinDataName := 'toolbutton';
  FCalcDisplayLabelSkinDataName := 'label';
  FAlphaBlend := False;
  FAlphaBlendValue := 0;
end;

destructor TbsSkinCalcEdit.Destroy;
begin
  FCalc.Free;
  inherited;
end;

procedure TbsSkinCalcEdit.CMCancelMode(var Message: TCMCancelMode);
begin
  if (Message.Sender <> FCalc) and
     not FCalc.ContainsControl(Message.Sender)
  then
    CloseUp;
end;

procedure TbsSkinCalcEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_ESCAPE) and FCalc.Visible then CloseUp;
  inherited;
end;

procedure TbsSkinCalcEdit.CloseUp;
begin
  if FCalc.Visible then FCalc.Hide;
  if CheckW2KWXP and FAlphaBlend
  then
    SetWindowLong(FCalc.Handle, GWL_EXSTYLE,
                  GetWindowLong(Handle, GWL_EXSTYLE) and not WS_EX_LAYERED);
end;

procedure TbsSkinCalcEdit.DropDown;
var
  i, Y: Integer;
  P: TPoint;
begin
 with FCalc do
  begin
    SkinData := Self.SkinData;
    FCalcPanel.SkinData := Self.SkinData;
    FDisplayLabel.DefaultFont := FDefaultFont;
    FDisplayLabel.SkinDataName := FCalcDisplayLabelSkinDataName;
    FDisplayLabel.SkinData := Self.SkinData;
    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 := FCalcButtonSkinDataName;
      SkinData := Self.SkinData;
    end
    else
    if FCalcPanel.Controls[i] is TbsSkinStdLabel then
    with TbsSkinStdLabel(FCalcPanel.Controls[i]) do
    begin
      DefaultFont := Self.DefaultFont;
      SkinData := Self.SkinData;
    end;
    TCalculatorPanel(FCalcPanel).FMemory := Self.FMemory;
    TCalculatorPanel(FCalcPanel).UpdateMemoryLabel;
    TCalculatorPanel(FCalcPanel).FPrecision := Max(2, Self.Precision);
    TCalculatorPanel(FCalcPanel).FBeepOnError := False;
    if Self.FValue <> 0 then begin
      TCalculatorPanel(FCalcPanel).DisplayValue := Self.FValue;
      TCalculatorPanel(FCalcPanel).FStatus := csFirst;
      TCalculatorPanel(FCalcPanel).FOperator := '=';
    end;
    Width := 210 + BtnOffset * 2;
    //
    if FIndex = -1
    then
      Height := FCalcPanel.Height + FDisplayLabel.Height + 2
    else
      Height := FCalcPanel.Height + FDisplayLabel.Height +
      (RectHeight(SkinRect) - RectHeight(ClRect));
    //
    Height := Height + BtnOffset;
    P := Self.Parent.ClientToScreen(Point(Self.Left, Self.Top));
    Y := P.Y + Self.Height;
    if Y + FCalc.Height > Screen.Height then Y := P.Y - FCalc.Height;
    if P.X + FCalc.Width > Screen.Width
    then P.X := Screen.Width - FCalc.Width;
    if P.X < 0 then P.X := 0;
    FCalc.Left := P.X;
    FCalc.Top := Y;
    //
    if CheckW2KWXP and FAlphaBlend
    then
      begin
        SetWindowLong(FCalc.Handle, GWL_EXSTYLE,
                      GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
        SetAlphaBlendTransparent(FCalc.Handle, 0)
      end;
    FCalc.Show(P.X, Y);
    //
    if FAlphaBlend and not FAlphaBlendAnimation and CheckW2KWXP
    then
      begin
        Application.ProcessMessages;
        SetAlphaBlendTransparent(FCalc.Handle, FAlphaBlendValue)
      end
    else
    if CheckW2KWXP and FAlphaBlend and FAlphaBlendAnimation
    then
      begin
        Application.ProcessMessages;
        I := 0;
        repeat
          Inc(i, 2);
          if i > FAlphaBlendValue then i := FAlphaBlendValue;
          SetAlphaBlendTransparent(FCalc.Handle, i);
        until i >= FAlphaBlendValue;
      end;
  end;
end;

procedure TbsSkinCalcEdit.ButtonClick(Sender: TObject);
begin
  if FCalc.Visible then CloseUp else DropDown;
end;

procedure TbsSkinCalcEdit.SetValueType(NewType: TbsValueType);
begin
  if FValueType <> NewType
  then
    begin
      FValueType := NewType;
      if FValueType = vtInteger
      then
        begin
          FIncrement := Round(FIncrement);
          if FIncrement = 0 then FIncrement := 1;
        end;
  end;
end;

procedure TbsSkinCalcEdit.SetDecimal(NewValue: Byte);
begin
  if FDecimal <> NewValue then begin
    FDecimal := NewValue;
  end;
end;

function TbsSkinCalcEdit.CheckValue;
begin
  Result := NewValue;
  if (FMaxValue <> FMinValue)
  then
    begin
      if NewValue < FMinValue then
      Result := FMinValue
      else if NewValue > FMaxValue then
      Result := FMaxValue;
    end;
end;

procedure TbsSkinCalcEdit.SetMinValue;
begin
  FMinValue := AValue;
end;

procedure TbsSkinCalcEdit.SetMaxValue;
begin
  FMaxValue := AValue;
end;

function TbsSkinCalcEdit.IsNumText;

function GetMinus: Boolean;
var
  i: Integer;
  S: String;
begin
  S := AText;
  i := Pos('-', S);
  if i > 1
  then
    Result := False
  else
    begin
      Delete(S, i, 1);
      Result := Pos('-', S) = 0;
    end;
end;

function GetP: Boolean;
var
  i: Integer;
  S: String;
begin
  S := AText;
  i := Pos(DecimalSeparator, S);
  if i = 1
  then
    Result := False
  else
    begin
      Delete(S, i, 1);
      Result := Pos(DecimalSeparator, S) = 0;
    end;
end;

const
  EditChars = '01234567890-';
var
  i: Integer;
  S: String;
begin
  S := EditChars;
  Result := True;
  if ValueType = vtFloat
  then
    S := S + DecimalSeparator;
  if (Text = '') or (Text = '-')
  then
    begin
      Result := False;
      Exit;
    end;

  for i := 1 to Length(Text) do
  begin
    if Pos(Text[i], S) = 0
    then
      begin
        Result := False;
        Break;
      end;
  end;

  Result := Result and GetMinus;

  if ValueType = vtFloat
  then
    Result := Result and GetP;

end;

procedure TbsSkinCalcEdit.Change;
var
  NewValue, TmpValue: Double;
begin
  if FromEdit then Exit;
  if not StopCheck and IsNumText(Text)
  then