Delphi Tutorial
In the following Delphi tutorial, I will provide you with documentation and sample code on how to build a simple delphi program called Cash Register.
Introduction
Cash register is an application which enables the operator to add products, add transactions and calculate the total price, VAT and total gross cost. Also operator can calculate the amount he needs to return to customer by entering the customer tendered price. Objective of this software is to enable the operator to add products and calculate transactions, total price, VAT and total gross price. Another feature is to edit the existing transaction if the quantity is entered wrong by the operator. Add and Edit product forms can be accessed through Edit menu. After adding products it’s possible to save the products in a file and open it later through File menu.
Program Documentation
Data Structure
Data for the products is maintained with an array products of TProduct record as follows:
TProduct = record
name: string[20];
price: real;
Program operation
Initialisation
When program starts, in the formCreate procedure in the main form, number of the products will be set to zero (listing line 593).
Adding a product
When operator opens the edit menu and click on add, mnuEditAddProductClick procedure opens the add product form (listing line 298). When operator clicks on the add button in the add product form, btnAddClick procedure executes by validating the data and if the data is correct and its not already exists, this procedure adds the product in the main form combo box as well as to the products array and clears the product name and price after addition. (Listing line 634)
Editing existing products
By selecting Modify… under Edit menu, Edit Product form appears in the modal mode by calling frmEditProduct.ShowModal; procedure (Listing line 305), in the Edit product form, operator selects a product from products combo box which executes cmbProductsChange procedure (Listing line 753) which shows the selected product name and price in the product and price text boxes. When operator clicks on the save, btnSaveClick will be executed (Listing line 766) by validating the values, if the values are correct it updates products array in the main form (Listing line 799) as well as combo box in the edit product and main product. Then it clears the price and product text box and also deselects the combo box by setting its itemindex to zero (Listing line 809).
Adding transactions
When operator clicks on the add button in the main form, btnAddClick procedure in the main form executes and validates the values, if the values are valid, it calculates the net cost, vat and then total cost and adds them to the products, quantities, prices, net cost, vat, and gross cost list boxes. (Listing line 186) and then clears the text boxes, deselect the list boxes by setting their itemIndex to -1 and then calls calculateAll procedure (Listing line 254). TfrmMain.calculateAll procedure is the main calculation procedure (Listing line 333), in this procedure, all the items in the transaction will be calculated for the total net cost, total vat and total gross cost. If there is any value entered in the customer tendered price, the change value will be calculated in this module as well.
Saving products in a file
When operator selects Save As… in the file menu, mnuFileSaveClick procedure in the main menu executes (Listing line 135) which opens dlgSave dialogue box for the operator to select a file for save, if the file already exists, operator will get a confirmation message which the file will be overwritten to confirm it (Listing line 147), If operator clicks on the No button, procedure will be aborted by calling the Exit procedure. Otherwise cash register will open the selected file and write all items in the products array to the file and then closes the file.
Opening products file
When operator selects Open… in the file menu, mnuFileOpenClick executes (Listing line 258), when user selects a file, a confirmation message will appear for the operator which the changes will be lost, if operator clicks on the no button, open procedure will be aborted by calling Exit procedure, other wise number of products will be set to zero (Listing line 274) and cash register loads all of the records (Listing line 281) from the selected file into the products array as well as products combo box in the main form .
Exiting cash register
When operator clicks on the Exit in the File menu, mnuExitClick executes (Listing line 129) by calling close procedure (Listing line 131).
Getting About Form
When operator selects About… in the main form, mnuHelpAboutClick procedure executes which opens About form in the modal mode (Listing line 309) by calling frmAbout.ShowModal; procedure.
Program Listing
Main Form
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls;
type
TProduct = record
name: string[20];
price: real;
end;
TfrmMain = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
products: array of TProduct;
nProducts: integer;
end;
var
frmMain: TfrmMain;
implementation
uses editProduct, RegisterProduct, About;
{$R *.dfm}
// invokes when user clicks on the exit menu in the file menu and closes the application
procedure TfrmMain.mnuExitClick(Sender: TObject);
begin
close;
end;
// This procedure invokes when user clicks on the save in the file menu
procedure TfrmMain.mnuFileSaveClick(Sender: TObject);
var
productsFile: file of TProduct;
i: integer;
begin
{
When user selects a file if file is exists, show a confirmation message to the user if user clicks on the No button; exit the procedure
}
if dlgSave.Execute then
begin
if fileExists(dlgSave.FileName) then
begin
if MessageDlg('Do you want to overwrite the file?',
mtConfirmation, [mbYes, mbNo], 0) = mrNo then
begin
Exit;
end
end;
// Open the file, if file is not exists, then create it, if already exists, file will be overwritten
AssignFile(productsFile,dlgSave.FileName);
reWrite(productsFile);
// Loop through registered items and write them in the products file
for i:= 0 to nProducts-1 do
begin
write(productsFile,products[i]);
end;
closeFile(productsFile);
end;
end;
{
This procedure invokes when user selects a product in the products combo box,
The selected item price will appear in the price textbpx
}
procedure TfrmMain.cmbProductsChange(Sender: TObject);
var
strPrice: string;
begin
// convert the selected item price to string, display in the price text box, clear quantity
Str(products[cmbProducts.ItemIndex].price:0:2,strPrice);
edtPrice.Text := strPrice;
edtQuantity.Clear;
end;
// This procedure invokes when user clicks on the add button
procedure TfrmMain.btnAddClick(Sender: TObject);
var
rlPrice, rlNetCost, rlVat, rlGrossCost: real;
intQuantity,intError: integer;
strNetCost, strVat, strGrossCost: string;
begin
// If no item is selected exit procedure and set focus on products combo box
if cmbProducts.ItemIndex = -1 then
begin
showMessage('Please select a product');
cmbProducts.SetFocus;
Exit;
end;
// Validating price
Val(edtPrice.Text,rlPrice,intError);
if intError <> 0 then
begin
showMessage('Price is not valid');
edtPrice.SetFocus;
Exit;
end;
// Validating quantity
Val(edtQuantity.Text,intQuantity,intError);
if intError <> 0 then
begin
showMessage('Quantity is not valid');
edtQuantity.SetFocus;
Exit;
end;
// calculating the amounts
rlNetCost := rlPrice*intQuantity;
rlVat := rlNetCost*17.5/100;
rlGrossCost := rlNetCost + rlVat;
// Converting Netcost, VAT and Gross Cost variables to string
Str((rlNetCost):0:2,strNetCost);
Str((rlVat):0:2,strVat);
Str((rlGrossCost):0:2,strGrossCost);
// Adding product item in the list boxes, quantity, price, netcost, vat and gross cost
lstProducts.Items.Add(cmbProducts.Text);
lstQuantities.Items.Add(edtQuantity.Text);
lstPrices.Items.Add(edtPrice.Text);
lstNetCost.Items.Add(strNetCost);
lstVat.Items.Add(strVat);
lstGrossCost.Items.Add(strGrossCost);
// Disable Update button
btnUpdate.Enabled := false;
// Deselect the list boxes
lstProducts.ItemIndex := -1;
lstQuantities.ItemIndex := -1;
lstPrices.ItemIndex := -1;
lstNetCost.ItemIndex := -1;
lstVat.ItemIndex := -1;
lstGrossCost.ItemIndex := -1;
// Clearing the form
cmbProducts.ItemIndex := -1;
edtPrice.Clear;
edtQuantity.Clear;
// Call the calculateAll procedure to calculate all values once again
calculateAll;
end;
// This procedure invokes when user clicks on the open menu in the file
procedure TfrmMain.mnuFileOpenClick(Sender: TObject);
var
productsFile: file of TProduct;
begin
if dlgOpen.Execute then
begin
// Show confirmation message to the user before loading the file, exit if user clicks on the No.
if MessageDlg('All of the changes will be lost, do you want to continue?',
mtConfirmation, [mbYes, mbNo], 0) = mrNo then
begin
Exit;
end;
// Clear products combo box, set products to 0
cmbProducts.Clear;
nProducts := 0;
// Open the products file
AssignFile(productsFile,dlgOpen.FileName);
reset(productsFile);
// Loop through records in the file and load them in the combo boxes and products array
while not EOF(productsFile) do
begin
setLength(products,nProducts+1);
read(productsFile,products[nProducts]);
cmbProducts.Items.Add(products[nProducts].name);
nProducts := nProducts+1;
end;
// Close the file
closeFile(productsFile);
end;
end;
// Executes when user clicks on the register menu under products; shows add product form
procedure TfrmMain.mnuEditAddProductClick(Sender: TObject);
begin
frmAddProduct.ShowModal;
end;
// Executes when user clicks on the Modify menu under products; displays edit product form
procedure TfrmMain.mnuEditModifyClick(Sender: TObject);
begin
frmEditProduct.ShowModal;
end;
// This procedure invokes when user clicks on the about submenu in the help menu
procedure TfrmMain.mnuHelpAboutClick(Sender: TObject);
begin
frmAbout.ShowModal;
end;
// Selects all list boxes along when user clicks on an item in the products list box
procedure TfrmMain.lstProductsMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
with lstProducts do
begin
lstQuantities.ItemIndex := ItemIndex;
lstPrices.ItemIndex := ItemIndex;
lstNetCost.ItemIndex := ItemIndex;
lstVat.ItemIndex := ItemIndex;
lstGrossCost.ItemIndex := ItemIndex;
end;
end;
{
Form main calculate procedure to calculate all list boxes as well as customer tendered price
if user entered any, this procedure shows total netcost, vat and total gross cost as well
}
procedure TfrmMain.calculateAll;
var
rlTotalNetCost, rlTotalVat, rlTotalGross: real;
rlNetCost, rlVat,rlGross, rlTenderedPrice, rlChange: real;
i, error: integer;
strTotalNetCost, strTotalVat, strTotalGross, strChange: string;
begin
// Reset all of the totals to 0
rlTotalNetCost :=0;
rlTotalVat := 0;
rlTotalGross := 0;
// loop through items in one of the list boxes and calculate total amounts
for i:=0 to lstNetCost.Count-1 do
begin
Val(lstNetCost.Items[i],rlNetCost,error);
Val(lstVat.Items[i],rlVat,error);
Val(lstGrossCost.Items[i],rlGross,error);
rlTotalNetCost := rlTotalNetCost + rlNetCost;
rlTotalVat := rlTotalVat + rlVat;
rlTotalGross := rlTotalGross + rlGross;
end;
// Display the total amounts in the total labels
Str(rlTotalNetCost:0:2,strTotalNetCost);
Str(rlTotalVat:0:2,strTotalVat);
Str(rlTotalGross:0:2,strTotalGross);
lblTotalNetCost.Caption := '£ '+strTotalNetCost;
lblTotalVat.Caption := '£ '+strTotalVat;
lblTotalGross.Caption := '£ '+strTotalGross;
// reset background color
lblChange.Color := ClBtnFace;
// If tendered price text box is not empty then calculate the change as well
if edtTenderedPrice.Text <> '' then
begin
// Validate the tendered price
Val(edtTenderedPrice.Text,rlTenderedPrice,error);
if error = 0 then
begin
// Calculate the change, if tendered price is valid, if its not enough display the message
rlChange := rlTenderedPrice - rlTotalGross;
Str(rlChange:0:2,strChange);
lblChange.Caption := '£ '+strChange;
if rlChange < 0 then
begin
lblChange.Color := ClRed;
lblChange.Caption := 'Amount is not enough';
end;
end
// if customer tendered price is not valid then display appropriate caption
else
begin
lblChange.Color := ClRed;
lblChange.Caption := 'Amount is not valid';
end;
end
// If user does not enter any amount in the tendered price, set the change to 0
else
begin
lblChange.Caption := '£ 0.00';
end;
end;
// This procedure invokes when user changes customer tendered price textbox
procedure TfrmMain.edtTenderedPriceChange(Sender: TObject);
begin
// Calling calculateAll procedure to recalculate all form for updating change label as well
CalculateAll;
end;
// This procedure invokes when user clicks on the delete selected in the edit menu
procedure TfrmMain.mnuEditDeleteSelectedClick(Sender: TObject);
var
intSelectedItem: integer;
begin
// Check if no item is selected, display a message
intSelectedItem := lstProducts.ItemIndex;
if intSelectedItem = -1 then
begin
showMessage('No transaction is selected to delete.');
end
// If an item is selected then delete from the list boxes and calculate all totals
else
begin
lstProducts.DeleteSelected;
lstQuantities.DeleteSelected;
lstPrices.DeleteSelected;
lstNetCost.DeleteSelected;
lstVat.DeleteSelected;
lstGrossCost.DeleteSelected;
CalculateAll;
end;
end;
// This procedure invokes when user clicks on the delete last item in the edit menu
procedure TfrmMain.mnuEditDeleteLastClick(Sender: TObject);
var
intLastItem: integer;
begin
// Display an error message when there is no item to delete
intLastItem := lstProducts.Count-1;
if lstProducts.Count = 0 then
begin
showMessage('There is no item to delete.');
end
// Delete last item from list boxes and recalculate all totals
else
begin
// delete last item from list boxes
lstProducts.Items.Delete(intLastItem);
lstQuantities.Items.Delete(intLastItem);
lstPrices.Items.Delete(intLastItem);
lstNetCost.Items.Delete(intLastItem);
lstVat.Items.Delete(intLastItem);
lstGrossCost.Items.Delete(intLastItem);
CalculateAll;
end;
end;
// This procedure invokes when user clicks on the new sub menu in the file menu
procedure TfrmMain.edtFileNewClick(Sender: TObject);
begin
// display a confirm message for clearing the form for new customer
if MessageDlg('Are you sure?', mtConfirmation, mbOkCancel, 0) = mrOk then
begin
// Clear the add transaction form and all list boxes, recalculate totals to set them all to 0
cmbProducts.ItemIndex := -1;
edtPrice.Clear;
edtQuantity.Clear;
lstProducts.Clear;
lstQuantities.Clear;
lstPrices.Clear;
lstNetCost.Clear;
lstVat.Clear;
lstGrossCost.Clear;
calculateAll;
end;
end;
{
This procedure invokes when user clicks on the products list box
And selected transaction appears in the add transaction form for editing
}
procedure TfrmMain.lstProductsClick(Sender: TObject);
var
i: integer;
begin
// loop through products to find the selected item to display it in the products combo box
for i:=0 to nProducts-1 do
begin
if cmbProducts.Items[i] = lstProducts.Items[lstProducts.ItemIndex] then
begin
cmbProducts.ItemIndex := i;
end;
end;
// update price and quantity to the selected transaction, then enable the update button
edtPrice.Text := lstPrices.Items[lstProducts.itemIndex];
edtQuantity.Text := lstQuantities.Items[lstProducts.itemIndex];
btnUpdate.Enabled := true;
end;
{
This procedure invokes when user clicks on the update button, to save the changes of the selected transaction.
It will update transaction price and quantity and calculate all transactions again
}
procedure TfrmMain.btnUpdateClick(Sender: TObject);
var
intQuantity, error: integer;
rlPrice, rlNetCost,rlVat,rlGrossCost: real;
strNetCost, strVat, strGrossCost: string;
begin
// Abort if no transaction is selected
if lstProducts.ItemIndex = -1 then
begin
showMessage('No transaction is selected');
Exit;
end;
// Validating the price, display error message and then exit if price is not valid
Val(edtPrice.Text,rlPrice,error);
if error <> 0 then
begin
showMessage('Price is not valid');
edtPrice.SetFocus;
Exit;
end;
// Validating the quantity, display error message, exit the procedure if quantity is not valid
Val(edtQuantity.Text,intQuantity,error);
if error <> 0 then
begin
showMessage('Quantity is not valid');
edtQuantity.SetFocus;
Exit;
end;
// Calculating the amounts
rlNetCost := rlPrice * intQuantity;
rlVat := rlNetCost * 17.5/100;
rlGrossCost := rlNetCost + rlVat;
str(rlNetCost:0:2,strNetCost);
str(rlVat:0:2,strVat);
str(rlGrossCost:0:2,strGrossCost);
// Update the transaction list boxes with new values
lstQuantities.Items[lstProducts.ItemIndex] := edtQuantity.Text;
lstPrices.Items[lstProducts.ItemIndex] := edtPrice.Text;
lstNetCost.Items[lstProducts.ItemIndex] := strNetCost;
lstVat.Items[lstProducts.ItemIndex] := strVat;
lstGrossCost.Items[lstProducts.ItemIndex] := strGrossCost;
// Deselect the list boxes as well as disable the update button
lstProducts.ItemIndex := -1;
lstQuantities.ItemIndex := -1;
lstPrices.ItemIndex := -1;
lstNetCost.ItemIndex := -1;
lstVat.ItemIndex := -1;
lstGrossCost.ItemIndex := -1;
btnUpdate.Enabled := false;
// call calculate procedure to re calculate the form
calculateAll;
// Clear quantity text box and display a message after updating the transaction
edtQuantity.Clear;
showMessage('Item updated successfully');
end;
// Display a confirmation message before closing the application for saving data
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if MessageDlg('If you exit, the changes after last save will be lost, do you want to
continue?',mtConfirmation, [mbYes, mbNo], 0) = mrNo then
begin
Exit;
end;
end;
// This procedure invokes when form is being created to set the number of products to 0
procedure TfrmMain.FormCreate(Sender: TObject);
begin
nProducts := 0;
end;
end.
end.
Register Product Form
unit RegisterProduct;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TfrmAddProduct = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
edtProduct: TEdit;
edtPrice: TEdit;
btnAdd: TButton;
procedure btnAddClick(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmAddProduct: TfrmAddProduct;
implementation
uses
Main;
{$R *.dfm}
// This procedure adds a product when users click on the add button
procedure TfrmAddProduct.btnAddClick(Sender: TObject);
var
rlPrice: real;
i, errorPrice: integer;
begin
// Validate the product title, display error message and exit if product title is blank
if edtProduct.Text = '' then
begin
showMessage('Product name is required');
edtProduct.SetFocus;
Exit;
end;
// Validate product price, display an error message and exit if price is not valid
Val(edtPrice.Text,rlPrice,errorPrice);
if errorPrice <> 0 then
begin
showMessage('Price is not valid');
edtPrice.SetFocus;
exit;
end;
// Check if this product name is not already registered
for i:=0 to frmMain.nProducts-1 do
begin
{
If find product name in the registered products case insensitive (using lowerCase function)
To make sure user cannot register an item twice even by passing uppercase words
}
if lowerCase(frmMain.products[i].name) = lowerCase(edtProduct.Text) then
begin
showMessage('This item already has been registered');
edtProduct.SetFocus;
Exit;
end;
end;
// Registering the product in the main form by adding it to the products array
with frmMain do
begin
setLength(products,nProducts+1);
products[nProducts].name := edtProduct.Text;
products[nProducts].price := rlPrice;
cmbProducts.Items.Add(edtProduct.Text);
nProducts := nProducts+1;
end;
// Clearing product name and product price and display a message
edtProduct.Clear;
edtPrice.Clear;
showMessage('Product registered successfully');
end;
// This procedure invokes when add product form is being displayed
procedure TfrmAddProduct.FormShow(Sender: TObject);
begin
edtProduct.SetFocus
end;
end.
Edit Product Form
unit editProduct;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TfrmEditProduct = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmEditProduct: TfrmEditProduct;
implementation
uses
Main;
{$R *.dfm}
{
This procedure invokes when users selects Modify Product in the edit menu on the
main form, so it loads the registered products in the products combo box
}
procedure TfrmEditProduct.FormShow(Sender: TObject);
var
i: integer;
begin
cmbProducts.Clear;
edtPrice.Clear;
// Loop through registered products and add them to the products combo box
for i:=0 to frmMain.nProducts-1 do
begin
cmbProducts.Items.Add(frmMain.products[i].name);
end;
end;
{
This procedure invokes when users select a product in the products combo box in the
modify product form, and it displays product price in the price edit box
}
procedure TfrmEditProduct.cmbProductsChange(Sender: TObject);
var
strPrice: string;
begin
edtProductName.Text := cmbProducts.Text;
str(frmMain.products[cmbProducts.ItemIndex].price:0:2,strPrice);
edtPrice.Text := strPrice;
end;
{
This procedure invokes when user clicks on the save button And it verify price and if the price is valid, it saves the changes in the products array in the form1
}
procedure TfrmEditProduct.btnSaveClick(Sender: TObject);
var
intError, intItem: integer;
rlPrice: real;
begin
// Exit if no item is selected
intItem := cmbProducts.ItemIndex;
if intItem = -1 then
begin
showMessage('Please select a product');
exit;
end;
// Validating product name
if edtProductName.Text = '' then
begin
showMessage('Product name is required');
edtProductName.SetFocus;
exit;
end;
// Validating price
Val(edtPrice.Text,rlPrice,intError);
if intError <> 0 then
begin
showMessage('Price is not valid');
edtPrice.SetFocus;
Exit;
end;
// Changing the price to the new price and title
cmbProducts.Items[intItem] := edtProductName.Text;
frmMain.products[intItem].price := rlPrice;
frmMain.products[intItem].name := edtProductName.Text;
frmMain.cmbProducts.Items[intItem] := edtProductName.Text;
showMessage('Product saved successfully');
// Deselecting the item in the combo box
// Clearing the title and price textbox as well as deselect items in the products combo box
edtProductName.Clear;
edtPrice.Clear;
cmbProducts.ItemIndex := -1;
// Deselect product in main form and clear price and quantity
frmMain.cmbProducts.ItemIndex := -1;
frmMain.edtPrice.Clear;
frmMain.edtQuantity.Clear;
end;
// Delete selected product from cash register
procedure TfrmEditProduct.btnDeleteClick(Sender: TObject);
var
i: integer;
begin
//If there is no item selected, display error message
if cmbProducts.ItemIndex = -1 then
begin
showMessage('Please select a product');
exit;
end;
// Loop in products array in the form1 to delete the selected product from array and form
for i:= cmbProducts.ItemIndex to frmMain.nProducts-2 do
begin
frmMain.products[i] := frmMain.products[i+1];
end;
// Delete selected product as well as reducing one from number of the products
frmMain.nProducts := frmMain.nProducts -1;
cmbProducts.DeleteSelected;
// Clearing text boxes as well as display a message box
edtPrice.Clear;
edtProductName.Clear;
showMessage('Selected product has been removed succeffully');
end;
end.
About Form
unit About;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TfrmAbout = class(TForm)
btnOk: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure btnOkClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmAbout: TfrmAbout;
implementation
uses
Main;
{$R *.dfm}
// This procedure executes when user clicks on the Ok button to close the about form
procedure TfrmAbout.btnOkClick(Sender: TObject);
begin
close;
end;
end.
Download link: Delphi-Tutorial.zip
Download Link: