calculatoreh.pas

最新的 DBGRIDEH4.0

            case FOperator of
              '+', '-': R := FOperand * R / 100.0;
              '*', '/': R := R / 100.0;
            end;
          case FOperator of
            '+': DisplayValue := FOperand + R;
            '-': DisplayValue := FOperand - R;
            '*': DisplayValue := FOperand * R;
            '/': if R = 0
                    then Error
                    else DisplayValue := FOperand / R;
          end;
        end;
        FOperator := Key;
        FOperand := DisplayValue;
      end;
    #27, 'C': Clear;
    ^C: DoCopy;
    ^V: Paste;
  end;
  UpdateEqualButton;
end;

procedure TCalculatorEh.CheckFirst;
begin
  if FStatus = csFirstEh then
  begin
    FStatus := csValidEh;
    DisplayText := '0';
  end;
end;

procedure TCalculatorEh.Clear;
begin
  FStatus := csFirstEh;
  DisplayValue := 0.0;
  FOperator := '=';
  FOperand := 0.0;
  UpdateEqualButton;
end;

procedure TCalculatorEh.DoCopy;
begin
  Clipboard.AsText := DisplayText;
end;

procedure TCalculatorEh.Error;
begin
  FStatus := csErrorEh;
  DisplayText := SError;
end;

function TCalculatorEh.GetDisplayValue: Double;
begin
  if FStatus = csErrorEh
    then Result := 0.0
    else Result := StrToFloat(Trim(DisplayText));
end;

procedure TCalculatorEh.Paste;
begin
  if Clipboard.HasFormat(CF_TEXT) then
//      SetDisplay(StrToFloat(Trim(ReplaceStr(Clipboard.AsText, CurrencyString, ''))));
    DisplayValue := StrToFloat(Trim(Clipboard.AsText));
end;

function TCalculatorEh.GetDisplayText: String;
begin
  Result := TextBox.Caption;
end;

procedure TCalculatorEh.SetDisplayText(const Value: String);
begin
  TextBox.Caption := Value;
end;

procedure TCalculatorEh.SetDisplayValue(const Value: Double);
begin
  DisplayText := FloatToStrF(Value, ffGeneral, Max(2, DefCalcPrecision), 0);
end;

procedure TCalculatorEh.SpeedButtonClick(Sender: TObject);
begin
  ProcessKey(TagToCharArray[Integer(TSpeedButton(Sender).Tag)]);
end;

procedure TCalculatorEh.UpdateEqualButton;
begin
  if (FOperand <> 0.0) and (FStatus = csValidEh) and (FOperator in ['+', '-', '*', '/'])
    then spEqual.Caption := '='
    else spEqual.Caption := 'Ok';
end;

procedure TCalculatorEh.SetBorderStyle(const Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TCalculatorEh.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or BorderStyles[FBorderStyle];
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

function TCalculatorEh.GetBorderSize: Integer;
var
  Params: TCreateParams;
  R: TRect;
begin
  CreateParams(Params);
  SetRect(R, 0, 0, 0, 0);
  AdjustWindowRectEx(R, Params.Style, False, Params.ExStyle);
  Result := R.Bottom - R.Top;
end;

procedure TCalculatorEh.SetOldCreateOrder(const Value: Boolean);
begin
  // Nothing to do
end;

procedure TCalculatorEh.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  ProcessKey(Key);
end;

procedure TCalculatorEh.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if Key = VK_DELETE then
    ProcessKey('C');
end;

function TCalculatorEh.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := True;
  NewWidth := FClientWidth + GetBorderSize;
  NewHeight := FClientHeight + GetBorderSize;
end;

{ TPopupCalculatorEh }

constructor TPopupCalculatorEh.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable]; //Really not Replicatable, only for CtrlGrid
  //FOwner := AOwner;
//  AutoSize := True;
  Ctl3D := True;
  ParentCtl3D := False;
  TabStop := False;
  FFlat := True;
end;

{CM messages processing}

procedure TPopupCalculatorEh.CMCloseUpEh(var Message: TMessage);
var
  ComboEdit: IComboEditEh;
begin
  if Supports(Owner, IComboEditEh, ComboEdit) then
    ComboEdit.CloseUp(False);
end;

procedure TPopupCalculatorEh.CMCtl3DChanged(var Message: TMessage);
begin
  inherited;
  UpdateBorderWidth;
  RecreateWnd;
end;

procedure TPopupCalculatorEh.CMWantSpecialKey( var Message: TCMWantSpecialKey);
var
  ComboEdit: IComboEditEh;
begin
  if not Supports(Owner, IComboEditEh, ComboEdit) then
    Exit;
  if (Message.CharCode in [VK_RETURN, VK_ESCAPE]) then
  begin
    ComboEdit.CloseUp(Message.CharCode = VK_RETURN);
    Message.Result := 1;
  end else
    inherited;
end;

{WM messages processing}

procedure TPopupCalculatorEh.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  Message.Result := Message.Result or DLGC_WANTARROWS or DLGC_WANTCHARS or DLGC_WANTTAB;
end;

procedure TPopupCalculatorEh.WMNCCalcSize(var Message: TWMNCCalcSize);
{$IFDEF CIL}
var
  r: TNCCalcSizeParams;
begin
  inherited;
  r := Message.CalcSize_Params;
  InflateRect(r.rgrc0, -FBorderWidth, -FBorderWidth);
  Message.CalcSize_Params := r;
end;
{$ELSE}
begin
  inherited;
  with Message.CalcSize_Params^ do
    InflateRect(rgrc[0], -FBorderWidth, -FBorderWidth);
end;
{$ENDIF}

procedure TPopupCalculatorEh.WMNCPaint(var Message: TWMNCPaint);
begin
  inherited;
  DrawBorder;
end;

procedure TPopupCalculatorEh.WMMouseActivate(var Message: TWMMouseActivate);
begin
  Message.Result := MA_NOACTIVATE;
end;

procedure TPopupCalculatorEh.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or WS_POPUP;
    if not Ctl3D then Style := Style or WS_BORDER;
    ExStyle := WS_EX_TOOLWINDOW {or WS_EX_TOPMOST};
    WindowClass.Style := CS_SAVEBITS;
  end;
end;

procedure TPopupCalculatorEh.DrawBorder;
var
  DC: HDC;
  R: TRect;
begin
  if Ctl3D = True then
  begin
    DC := GetWindowDC(Handle);
    try
      GetWindowRect(Handle, R);
      OffsetRect(R, -R.Left, -R.Top);
      FrameRect(DC, R, GetSysColorBrush(COLOR_3DDKSHADOW));
      //DrawEdge(DC, R, BDR_RAISEDOUTER, BF_RECT);
      InflateRect(R, -1, -1);
      DrawEdge(DC, R, BDR_RAISEDINNER, BF_RECT);
    finally
      ReleaseDC(Handle, DC);
    end;
  end;
end;

procedure TPopupCalculatorEh.UpdateBorderWidth;
begin
  if Ctl3D
    then FBorderWidth := 2
    else FBorderWidth := 0;
end;

function TPopupCalculatorEh.CanFocus: Boolean;
begin
  Result := False;
end;

function TPopupCalculatorEh.GetValue: Variant;
begin
  if FStatus = csErrorEh then
  begin
{$IFDEF CIL}
    Result := VarFromException(EDivByZero.Create);
{$ELSE}
    TVarData(Result).VType := varError;
    TVarData(Result).VInteger := -1;
{$ENDIF}
  end else
    Result := DisplayValue;
end;

procedure TPopupCalculatorEh.SetValue(const Value: Variant);
begin
  Clear;
  DisplayValue := Value;
end;

procedure TPopupCalculatorEh.ProcessKey(Key: Char);
var
  ComboEdit: IComboEditEh;
begin
  if (Key in ['=', #13]) and (spEqual.Caption = 'Ok') then
  begin
    if Supports(Owner, IComboEditEh, ComboEdit) then
      ComboEdit.CloseUp(True)
  end else
    inherited ProcessKey(Key);
end;

procedure TPopupCalculatorEh.KeyDown(var Key: Word; Shift: TShiftState);
var
  ComboEdit: IComboEditEh;
begin
  inherited KeyDown(Key, Shift);
  if Key = VK_ESCAPE then
  begin
    if Supports(Owner, IComboEditEh, ComboEdit) then
      ComboEdit.CloseUp(False);
    Key := 0;
  end;
end;

function TPopupCalculatorEh.GetFlat: Boolean;
begin
  Result := FFlat;
end;

procedure TPopupCalculatorEh.SetFlat(const Value: Boolean);
var
  i: Integer;
begin
  if Value <> FFlat then
  begin
    FFlat := Value;
    for i := 0 to ComponentCount-1 do
      if Components[i] is TSpeedButtonEh then
        TSpeedButtonEh(Components[i]).Flat := False;
  end;
end;

function TPopupCalculatorEh.GetEnterCanClose: Boolean;
begin
  Result := (spEqual.Caption = 'Ok');
end;

function TPopupCalculatorEh.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
  Result := inherited CanAutoSize(NewWidth, NewHeight);
  if Result then
  begin
    Inc(NewWidth, FBorderWidth*2);
    Inc(NewHeight, FBorderWidth*2);
  end;
end;

function TCalculatorEh.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheelDown(Shift, MousePos);
  if not Result then
  begin
    if FStatus <> csErrorEh then
      DisplayValue := DisplayValue - 1;
    Result := True;
  end;
end;

function TCalculatorEh.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheelUp(Shift, MousePos);
  if not Result then
  begin
    if FStatus <> csErrorEh then
      DisplayValue := DisplayValue + 1;
    Result := True;
  end;
end;

end.