The code shows you how to create a window without a titlebar that can be dragged with the mouse. Set the FormStyle property to fsStayOnTop. The form contains a small 18 button calculator. When you create the form and calculator components, try to make it tiny, it is cute that way!
A small stay-on-top calculator (Delphi)
{------------------------ tincalcz.pas -------------------------
Create a captionless small window that can be dragged and
stays on top, set the FormStyle property to fsStayOnTop.
Supply an exit button since this form has no titlebar.
The form contains a small 18 button calculator.
Delphi 3.0 vegaseat 11dec1995
---------------------------------------------------------------}
unit Tincalcz;
{$X-}
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Menus, StdCtrls, ExtCtrls, Buttons;
type
TCalcForm = class(TForm)
ExitButton: TBitBtn; // needs an exit button
Entry: TEdit;
Zero: TButton; // button lebeled 0
One: TButton; // button labeled 1 etc.
Two: TButton;
Three: TButton;
Four: TButton;
Five: TButton;
Six: TButton;
Seven: TButton;
Eight: TButton;
Nine: TButton;
Decimal: TButton; // button labeled .
Clear: TButton; // button labeled C
AllClear: TButton; // button labeled AC
Equal: TButton; // button =
Plus: TButton; // button + etc.
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}
// the missing delay() procedure, delay in milliseconds
procedure Delay(msecs: integer);
var
FirstTickCount: longint;
begin
FirstTickCount := GetTickCount;
repeat
Application.ProcessMessages; { allowing access to other controls }
until ((GetTickCount-FirstTickCount) >= Longint(msecs));
end;
// override form's style to create a window without titlebar
procedure TCalcForm.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams (Params);
Params.Style := ws_Popup or ws_ClipChildren or ws_ClipSiblings or ws_Border;
end;
// left mouse button will drag form
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 := 'Division by Zero!';
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;
// format the result display
procedure TCalcForm.Display;
var
Sf: String;
begin
if Frac(Total) = 0 then // no fraction, no decimals
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.
Be a part of the DaniWeb community
We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.