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