Карта сайтаСсылкиКонтакты

Небольшой калькулятор

PDF Печать
Статьи

Этот код показывает, как создать окно без заголовка, которое будет перемещаться мышью. Установите свойство FormStyle в fsStayOnTop. Форма содержит 18 маленьких кнопок. Когда Вы будете создавать форму, делайте компоненты калькулятора крошечными, это очень симпатично!

Не забудьте поставить кнопку выхода, так как программа не имеет заголовка.


unit Tincalcz;
 
{$X-}
 
interface
 
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Menus, StdCtrls, ExtCtrls, Buttons;
 
type
  TCalcForm = class(TForm)
    ExitButton: TBitBtn;  // кнопка выход
    Entry: TEdit;
    Zero: TButton;     // кнопка 0
    One: TButton;      // кнопка 1 и т.д.
    Two: TButton;
    Three: TButton;
    Four: TButton;
    Five: TButton;
    Six: TButton;
    Seven: TButton;
    Eight: TButton;
    Nine: TButton;
    Decimal: TButton;  // кнопка .
    Clear: TButton;    // кнопка C
    AllClear: TButton; // кнопка AC
    Equal: TButton;    // кнопка =
    Plus: TButton;     // кнопка + и т.д.
    Minus: TButton;
    Divide: TButton;
    Multiply: TButton;
    // events
    procedure OneClick(Sender: TObject);
    procedure TwoClick(Sender: TObject);
    procedure ThreeClick(Sender: TObject);
    procedure FourClick(Sender: TObject);
    procedure FiveClick(Sender: TObject);
    procedure SixClick(Sender: TObject);
    procedure SevenClick(Sender: TObject);
    procedure EightClick(Sender: TObject);
    procedure NineClick(Sender: TObject);
    procedure PlusClick(Sender: TObject);
    procedure MinusClick(Sender: TObject);
    procedure MultiplyClick(Sender: TObject);
    procedure DivideClick(Sender: TObject);
    procedure ClearClick(Sender: TObject);
    procedure AllClearClick(Sender: TObject);
    procedure EntryChange(Sender: TObject);
    procedure EqualClick(Sender: TObject);
    procedure DecimalClick(Sender: TObject);
    procedure Display;
    procedure ExitButtonClick(Sender: TObject);
    procedure ZeroClick(Sender: TObject);
  private
    { Private declarations }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMNCHitTest(var Msg: TMessage);  message WM_NCHITTEST;
  public
    { Public declarations }
  end;
 
var
  CalcForm: TCalcForm;
  Total   : Double;
  Complete: Boolean;
  Operator: Char;
 
implementation
 
{$R *.DFM}
 
// задержка, в миллисекундах
procedure Delay(msecs: integer);
var
  FirstTickCount: longint;
begin
  FirstTickCount := GetTickCount;
   repeat
     Application.ProcessMessages; { даем доступ к другим элементам }
   until ((GetTickCount-FirstTickCount) >= Longint(msecs));
end;
 
// переопределяем стиль, без заголовка
procedure TCalcForm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams (Params);
  Params.Style := ws_Popup or ws_ClipChildren
      or ws_ClipSiblings or ws_Border;
end;
 
// левая кнопка мыши будет перетаскивать форму
procedure TCalcForm.WMNCHitTest(var Msg: TMessage);
begin
  if GetAsyncKeyState(VK_LBUTTON) < 0 then
    Msg.Result := HTCAPTION
  else
    Msg.Result := HTCLIENT;
end;
 
procedure Calculate(Number: Real; NextOp: Char);
begin
  if not Complete or (Total = 0.0) then
  case Operator of
     '+': Total := Total + Number;
     '-': Total := Total - Number;
     'x': Total := Total * Number;
     '/':
       begin
         if Number <> 0 then
           Total := Total / Number
         else
         begin
           CalcForm.Entry.Text := 'Деление на ноль!';
           Delay(3000);
         end;
       end;
  end;
  Operator := NextOp;
  Complete := True;
end;
 
procedure TCalcForm.ZeroClick(Sender: TObject);
begin
  if Complete then Entry.Text := '';
  Entry.Text := Entry.Text + '0';
end;
 
procedure TCalcForm.OneClick(Sender: TObject);
begin
  if Complete then Entry.Text := '';
  Entry.Text := Entry.Text + '1';

end;
 
procedure TCalcForm.TwoClick(Sender: TObject);
begin
  if Complete then Entry.Text := '';
  Entry.Text := Entry.Text + '2';
end;
 
procedure TCalcForm.ThreeClick(Sender: TObject);
begin
  if Complete then Entry.Text := '';
  Entry.Text := Entry.Text + '3';
end;
 
procedure TCalcForm.FourClick(Sender: TObject);
begin
  if Complete then Entry.Text := '';
  Entry.Text := Entry.Text + '4';
end;
 
procedure TCalcForm.FiveClick(Sender: TObject);
begin
  if Complete then Entry.Text := '';
  Entry.Text := Entry.Text + '5';
end;
 
procedure TCalcForm.SixClick(Sender: TObject);
begin
  if Complete then Entry.Text := '';
  Entry.Text := Entry.Text + '6';
end;
 
procedure TCalcForm.SevenClick(Sender: TObject);
begin
  if Complete then Entry.Text := '';
  Entry.Text := Entry.Text + '7';
end;
 
procedure TCalcForm.EightClick(Sender: TObject);
begin
  if Complete then Entry.Text := '';
  Entry.Text := Entry.Text + '8';
end;
 
procedure TCalcForm.NineClick(Sender: TObject);
begin
  if Complete then Entry.Text := '';
  Entry.Text := Entry.Text + '9';
end;
 
procedure TCalcForm.PlusClick(Sender: TObject);
begin
  Calculate(StrToFloat(Entry.Text), '+');
  Display;
end;
 
procedure TCalcForm.MinusClick(Sender: TObject);
begin
  Calculate(StrToFloat(Entry.Text), '-');
  Display;
end;
 
procedure TCalcForm.MultiplyClick(Sender: TObject);
begin
  Calculate(StrToFloat(Entry.Text), 'x');
  Display;
end;
 
procedure TCalcForm.DivideClick(Sender: TObject);
begin
  Calculate(StrToFloat(Entry.Text), '/');
  Display;
end;
 
procedure TCalcForm.ClearClick(Sender: TObject);
begin
  Entry.Text := '0';
  Complete := True;
end;
 
procedure TCalcForm.AllClearClick(Sender: TObject);
begin
  Entry.Text := '0';
  Complete := True;
  Total := 0.0;
  Operator := '+';
end;
 
procedure TCalcForm.EntryChange(Sender: TObject);
begin
  if Entry.Text = '' then Complete := False;
end;
 
procedure TCalcForm.EqualClick(Sender: TObject);
begin
  Calculate(StrToFloat(Entry.Text), '+');
  Display;
  Complete := True;
  Total := 0.0;
end;
 
procedure TCalcForm.DecimalClick(Sender: TObject);
begin
  if Complete then Entry.Text := '';
  if Pos('.', Entry.Text) = 0 then
    Entry.Text := Entry.Text + '.';
end;
 
// форматируем результат для отображения
procedure TCalcForm.Display;
var
  Sf: String;
begin
  if Frac(Total) = 0 then
    Str(Total:16:0, Sf)
  else
  if abs(Total) < 0.1 then
    Str(Total:16:12, Sf)
  else
  if abs(Total) < 1.0 then
    Str(Total:16:10, Sf)
  else
  if abs(Total) < 100.0 then
    Str(Total:16:8, Sf)
  else
  if abs(Total) < 10000.0 then
    Str(Total:16:4, Sf)
  else
    Str(Total:16:2, Sf);
  Entry.Text := Sf;
end;
 
procedure TCalcForm.ExitButtonClick(Sender: TObject);
begin
  Close;
end;
 
Initialization
 
  Complete := True;
  Total := 0.0;
  Operator := '+';
 
end.

 

Добавить комментарий


Защитный код
Обновить