unit CalcFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, StdCtrls;

type
  TAction = (taNone,taAdd,taSub,taMul,taDiv);
  TfrmCalc = class(TForm)
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton12: TSpeedButton;
    SpeedButton13: TSpeedButton;
    SpeedButton14: TSpeedButton;
    SpeedButton15: TSpeedButton;
    SpeedButton16: TSpeedButton;
    SpeedButton17: TSpeedButton;
    SpeedButton18: TSpeedButton;
    SpeedButton19: TSpeedButton;
    SpeedButton20: TSpeedButton;
    SpeedButton21: TSpeedButton;
    SpeedButton22: TSpeedButton;
    SpeedButton23: TSpeedButton;
    SpeedButton24: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure SpeedButtonClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormActivate(Sender: TObject);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    Num1,Num2: Double;
    Action: TAction;
    NewNum: Boolean;
    WasForm: Boolean; //Если True - событие мыши было на форме (не на кнопке)
    pHeight, pWidth: Integer; //"эталонные" размеры формы
    function Evaluate: Boolean;
    function TextToFloat(Text: string): Double;
    procedure SetAction(Act: TAction);
    procedure CreateParams(var Param: TCreateParams); override;
  public
    { Public declarations }
    ValueTxt: TEdit;
  end;

var
  frmCalc: TfrmCalc;
  Stack: array of Double;

implementation

{$R *.dfm}

function TfrmCalc.Evaluate: Boolean;
begin //вычисления
  Result := False;
  if NewNum then Exit;
  try
    case Action of
      taNone:Num1 := Num2;
      taAdd: Num1 := Num1 + Num2;
      taSub: Num1 := Num1 - Num2;
      taMul: Num1 := Num1 * Num2;
      taDiv: Num1 := Num1 / Num2;
    end;
    ValueTxt.Text := FloatToStr(Num1);
    Result := True;
    NewNum := True;
  except
    on EZeroDivide do MessageBox(0,'Деление на ноль!','Ошибка!',MB_ICONERROR);
    on EOverflow do MessageBox(0,'Переполнение!','Ошибка!',MB_ICONERROR);
  end;
end;

procedure TfrmCalc.FormCreate(Sender: TObject);
begin
  NewNum := True;
  Action := taNone;
  WasForm := False;
  pHeight := Height;
  pWidth := Width;
end;

procedure TfrmCalc.SetAction(Act: TAction);
begin
  if Action = taNone then
  begin
    Num1 := TextToFloat(ValueTxt.Text);
    NewNum := True;
  end else
  begin
    Num2 := TextToFloat(ValueTxt.Text);
    Evaluate;
  end;
  Action := Act;
end;

procedure TfrmCalc.SpeedButtonClick(Sender: TObject);
var
  Btn: TSpeedButton;
begin
  Btn := (Sender as TSpeedButton);
  WasForm := False;
  if GetCaptureControl = Self then ReleaseCapture;
  case Btn.Tag of
    0..9: begin //0..9
            if NewNum then
            begin
              NewNum := False;
              ValueTxt.Text := '';
            end;
            if ValueTxt.Text = '0' then ValueTxt.Text := '';
            ValueTxt.Text := ValueTxt.Text + Btn.Caption;
          end;
    10:   begin {десятичная точка}
            if NewNum then
            begin
              NewNum := False;
              ValueTxt.Text := '0';
            end;
            if Pos(DecimalSeparator,ValueTxt.Text) = 0 then
              ValueTxt.Text := ValueTxt.Text + DecimalSeparator;
          end;
    11:   begin // backspace
            ValueTxt.Text := Copy(ValueTxt.Text,1,Length(ValueTxt.Text)-1);
            if ValueTxt.Text = '' then ValueTxt.Text := '0';
          end;
    12:   SetAction(taAdd); {+}
    13:   SetAction(taSub); {-}
    14:   SetAction(taMul); {*}
    15:   SetAction(taDiv); {/}
    16:   begin {%}
            if Action = taNone then Exit;
            Num2 := TextToFloat(ValueTxt.Text);
            if (Action = taAdd) or (Action = taSub) then Num2 := (Num1 / 100) * Num2;
            if (Action = taMul) or (Action = taDiv) then Num2 := Num2 / 100;
            Evaluate;
            Action := taNone;
          end;
    17:   begin {1/x}
            Num2 := TextToFloat(ValueTxt.Text);
            if Num2 <> 0 then
            begin
              Num2 := 1/Num2;
              if not Evaluate then ValueTxt.Text := FloatToStr(Num2);
              Action := taNone;
            end else MessageBox(0,'Деление на ноль!','Ошибка!',MB_ICONERROR);
          end;
    18:   begin {.00}
            if Action <> taNone then
            begin
              Num2 := TextToFloat(ValueTxt.Text);
              Evaluate;
              Action := taNone;
            end;
            Num1 := TextToFloat(ValueTxt.Text);
            ValueTxt.Text := Format('%1.'+IntToStr(CurrencyDecimals)+'f',[Num1]);
            Num1 := TextToFloat(ValueTxt.Text);
          end;
    19:   begin {=}
            Num2 := TextToFloat(ValueTxt.Text);
            Evaluate;
            ModalResult := mrOK;
          end;
    20:   begin {+/-}
            if ValueTxt.Text[1] <> '-' then ValueTxt.Text := '-'+ValueTxt.Text else
              ValueTxt.Text := Copy(ValueTxt.Text,2,Length(ValueTxt.Text));
            if NewNum then ValueTxt.Text := '0';
          end;
    21:   begin {AC}
            Num1 := 0;
            Num2 := 0;
            Action := taNone;
            ValueTxt.Text := '0';
          end;
    22:   if Length(Stack) <> 0 then {Read}
          begin
            ValueTxt.Text := FloatToStr(Stack[High(Stack)]);
            NewNum := True;
            SetLength(Stack,Length(Stack)-1);
          end else MessageBox(0,'Стек пуст!','Ошибка!',MB_ICONERROR);
    23:   begin {Write}
            SetLength(Stack,Length(Stack)+1);
            Stack[High(Stack)] := StrToFloat(ValueTxt.Text);
            NewNum := True;
          end;
  end;
  SetCaptureControl(Self); //все события мыши ловит форма
end;

function TfrmCalc.TextToFloat(Text: string): Double;
begin
  try
    Result := StrToFloat(Text);
  except
    on EOverflow do
    begin
      MessageBox(0,'Переполнение!','Ошибка!',MB_ICONERROR);
      Result := 0;
    end;
  end;
end;

procedure TfrmCalc.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if GetCaptureControl = Self then ReleaseCapture;
  case Key of
    8: SpeedButton19.Perform(WM_LBUTTONDOWN,0,0);  {Backspace}
    13: SpeedButton18.Perform(WM_LBUTTONDOWN,0,0); {= - Enter}
    46: SpeedButton19.Perform(WM_LBUTTONDOWN,0,0); {Del}
    68: SpeedButton12.Perform(WM_LBUTTONDOWN,0,0); {d - 1/x}
    69: SpeedButton21.Perform(WM_LBUTTONDOWN,0,0); {e - AC}
    70: SpeedButton17.Perform(WM_LBUTTONDOWN,0,0); {f - ,00}
    81: SpeedButton22.Perform(WM_LBUTTONDOWN,0,0); {q - +/-}
    82: SpeedButton24.Perform(WM_LBUTTONDOWN,0,0); {r - Read}
    83: SpeedButton20.Perform(WM_LBUTTONDOWN,0,0); {s - %}
    87: SpeedButton23.Perform(WM_LBUTTONDOWN,0,0); {w - Write}
    96,48: SpeedButton10.Perform(WM_LBUTTONDOWN,0,0); {0..9}
    97,49: SpeedButton7.Perform(WM_LBUTTONDOWN,0,0);
    98,50: SpeedButton8.Perform(WM_LBUTTONDOWN,0,0);
    99,51: SpeedButton9.Perform(WM_LBUTTONDOWN,0,0);
    100,52: SpeedButton4.Perform(WM_LBUTTONDOWN,0,0);
    101,53: SpeedButton5.Perform(WM_LBUTTONDOWN,0,0);
    102,54: SpeedButton6.Perform(WM_LBUTTONDOWN,0,0);
    103,55: SpeedButton1.Perform(WM_LBUTTONDOWN,0,0);
    104,56: SpeedButton2.Perform(WM_LBUTTONDOWN,0,0);
    105,57: SpeedButton3.Perform(WM_LBUTTONDOWN,0,0);
    106: SpeedButton15.Perform(WM_LBUTTONDOWN,0,0); {*}
    107: SpeedButton13.Perform(WM_LBUTTONDOWN,0,0); {+}
    109,189: SpeedButton14.Perform(WM_LBUTTONDOWN,0,0); {-}
    110,188,190: SpeedButton11.Perform(WM_LBUTTONDOWN,0,0); {,}
    111,191: SpeedButton16.Perform(WM_LBUTTONDOWN,0,0); {/}
  end;
  SetCaptureControl(Self);
end;

procedure TfrmCalc.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if GetCaptureControl = Self then ReleaseCapture;
  case Key of
    8: SpeedButton19.Perform(WM_LBUTTONUP,0,0);  {Backspace}
    13: SpeedButton18.Perform(WM_LBUTTONUP,0,0); {= - Enter}
    46: SpeedButton19.Perform(WM_LBUTTONUP,0,0); {Del}
    68: SpeedButton12.Perform(WM_LBUTTONUP,0,0); {d - 1/x}
    69: SpeedButton21.Perform(WM_LBUTTONUP,0,0); {e - AC}
    70: SpeedButton17.Perform(WM_LBUTTONUP,0,0); {f - ,00}
    81: SpeedButton22.Perform(WM_LBUTTONUP,0,0); {q - +/-}
    82: SpeedButton24.Perform(WM_LBUTTONUP,0,0); {r - Read}
    83: SpeedButton20.Perform(WM_LBUTTONUP,0,0); {s - %}
    87: SpeedButton23.Perform(WM_LBUTTONUP,0,0); {w - Write}
    96,48: SpeedButton10.Perform(WM_LBUTTONUP,0,0); {0..9}
    97,49: SpeedButton7.Perform(WM_LBUTTONUP,0,0);
    98,50: SpeedButton8.Perform(WM_LBUTTONUP,0,0);
    99,51: SpeedButton9.Perform(WM_LBUTTONUP,0,0);
    100,52: SpeedButton4.Perform(WM_LBUTTONUP,0,0);
    101,53: SpeedButton5.Perform(WM_LBUTTONUP,0,0);
    102,54: SpeedButton6.Perform(WM_LBUTTONUP,0,0);
    103,55: SpeedButton1.Perform(WM_LBUTTONUP,0,0);
    104,56: SpeedButton2.Perform(WM_LBUTTONUP,0,0);
    105,57: SpeedButton3.Perform(WM_LBUTTONUP,0,0);
    106: SpeedButton15.Perform(WM_LBUTTONUP,0,0); {*}
    107: SpeedButton13.Perform(WM_LBUTTONUP,0,0); {+}
    109,189: SpeedButton14.Perform(WM_LBUTTONUP,0,0); {-}
    110,188,190: SpeedButton11.Perform(WM_LBUTTONUP,0,0); {,}
    111,191: SpeedButton16.Perform(WM_LBUTTONUP,0,0); {/}
  end;
  SetCaptureControl(Self);
end;

procedure TfrmCalc.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  //если щелкнули мимо формы, то закрываем ее
  if not (X in [0..Width]) or not (Y in [0..Height]) then Close;
  if (GetCaptureControl = Self) then ReleaseCapture;
  if WasForm then
  begin
    WasForm := False;
    Exit;
  end;
  GetCursorPos(P);
  WasForm := True;
  //имитируем нажатие
  mouse_event(MOUSEEVENTF_ABSOLUTE+MOUSEEVENTF_LEFTDOWN,P.X,P.Y,0,0);
end;

procedure TfrmCalc.FormActivate(Sender: TObject);
begin
  if GetCaptureControl <> Self then SetCaptureControl(Self);
end;

procedure TfrmCalc.CreateParams(var Param: TCreateParams);
begin
  inherited;
  Param.Style := WS_POPUPWINDOW;
end;

procedure TfrmCalc.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  //если щелкнули не по форме, то закрываем ее
  if not (X in [0..Width]) or not (Y in [0..Height]) then Close;
  if not WasForm then
  begin
    GetCursorPos(P);
    WasForm := True;
    //имитируем отпускание
    mouse_event(MOUSEEVENTF_ABSOLUTE+MOUSEEVENTF_LEFTUP,P.X,P.Y,0,0);
  end else WasForm := False;
  SetCaptureControl(Self);
end;

procedure TfrmCalc.FormShow(Sender: TObject);
var
  I: Integer;
begin
  for I := 0 to ControlCount-1 do
  begin // вычислить новые размеры и положения кнопок
    Controls[I].Left := Trunc(Controls[I].Left*Width/pWidth+1);
    Controls[I].Width := Trunc(Controls[I].Width*Width/pWidth-1);
    Controls[I].Top := Trunc(Controls[I].Top*Height/pHeight+1);
    Controls[I].Height := Trunc(Controls[I].Height*Height/pHeight-1);
  end;
end;

end.
