Этот код показывает, как создать окно без заголовка, которое будет перемещаться мышью. Установите свойство 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.
|