A small stay-on-top calculator (Delphi)

vegaseat 0 Tallied Votes 320 Views Share

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!

{------------------------  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.