Skip to content

Array management by pointer

Indeed the application we here offer has the same graphical interface of previous used in by-value mode: only the engine changes, only management of array's items changes.

To check this is true, download the project code.In next page we show all used code.

[Just an advice: like in by-value code, visual elements don't manage all kind of events; so software can give errors, but only related to events, not to management code]

A good way to learn the different methods is to confront the two codes.

Functions and procedures are called the same in both of ones, so that the job will be easy: you only must get the different behavior.

unit Unit1; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls;

//Definition of Employee type (Record) : Here we define TEmployee type of a generic Employee
type
  pEmployee = ^TEmployee; //Define a pointer of TEmployee

  TEmployee = Record
    Id : integer;
    Name  : string;
    Surname  : string;
  end;
//End of employee type

type

  { TForm1 }

  TForm1 = class(TForm)
    ButtonAdd: TButton;
    ButtonModify: TButton;
    ButtonDelete: TButton;
    ButtonShow: TButton;
    EditNameNew: TEdit;
    EditSurnameNew: TEdit;
    EditIdModify: TEdit;
    EditNameModify: TEdit;
    EditSurnameModify: TEdit;
    EditIdDelete: TEdit;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    LabelNameDelete: TLabel;
    LabelSurnameDelete: TLabel;
    Memo: TMemo;
    procedure ButtonAddClick(Sender: TObject);
    procedure ButtonDeleteClick(Sender: TObject);
    procedure ButtonModifyClick(Sender: TObject);
    procedure ButtonShowClick(Sender: TObject);
    procedure EditIdDeleteChange(Sender: TObject);
    procedure EditIdModifyChange(Sender: TObject);

  private
    { private declarations }
    EmployeeArray  : Array of pEmployee; //DYNAMIC Array of elements type pEmployees (pEmployee - pointers of employees)  Array starts from a[0], a[1] etc ...
    function findNumberOfEmployees(): integer;
    function findNextFreeId(): integer;
    procedure addEmployee(pEmp:pEmployee);
    procedure modifyEmployee(id:integer; pEmpnew:pEmployee);
    procedure deleteEmployee(id:integer);
    function getEmployee(id:integer): pEmployee; //get the pointer of an employee
    function printEmployeeWithId(id:integer): string;
    function printEmployeeWithIndex(index:integer): string;
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{ TForm1 }

/////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////
////////////////////////PRIVATE FUNCTIONS////////////////////////////////////

function TForm1.findNumberOfEmployees(): integer;
begin
 result := Length(self.EmployeeArray);
end;

function TForm1.findNextFreeId(): integer;
var imax :integer;
begin
  imax:=self.findNumberOfEmployees-1; //arrays start from a[0] etc...
  if imax <> -1 then result := self.EmployeeArray[imax]^.Id +1
  else result := 1;
end;

procedure TForm1.addEmployee(pEmp:pEmployee); //I add employees on the end of EmployeeArray ONLY
var imax :integer;
begin

  imax:=self.findNumberOfEmployees;
  SetLength(self.EmployeeArray, imax+1);
  self.EmployeeArray[imax] := pEmp; //copy by pointer //starts from a[0]

end;

procedure TForm1.modifyEmployee(id:integer; pEmpnew:pEmployee);
var i,imax :integer;
begin

  imax:=self.findNumberOfEmployees-1;//arrays start from a[0] etc...
  for i:=0 to imax do begin
    if self.EmployeeArray[i]^.id = id then begin
      self.EmployeeArray[i]^:=pEmpnew^; //copy by value //starts from a[0]
      break;
    end;
  end;

end;

procedure TForm1.deleteEmployee(id:integer);
var i,k,imax,deletepoint :integer;
begin

  imax:=self.findNumberOfEmployees-1;
  deletepoint:=0;

  for i:=0 to imax do begin
    if self.EmployeeArray[i]^.id = id then begin
      deletepoint:=i;
      if deletepoint < imax then begin
         dispose(self.EmployeeArray[deletepoint]); //FREE the created pointer
         for k:=deletepoint+1 to imax do begin
           self.EmployeeArray[k-1]:=self.EmployeeArray[k];
         end;
         self.EmployeeArray[imax]:=nil;
         SetLength(self.EmployeeArray, imax);
      end else begin //deletepoint = imax
        dispose(self.EmployeeArray[imax]); //FREE the created pointer
        SetLength(self.EmployeeArray, imax);
      end;
      break;
    end;
  end;

end;

function TForm1.getEmployee(id:integer): pEmployee;
var i,imax :integer;
begin

  result:=nil;
  imax:=self.findNumberOfEmployees-1;
  for i:=0 to imax do begin
    if self.EmployeeArray[i]^.id = id then begin
      result:= self.EmployeeArray[i];
      break;
    end;
  end;

end;

function TForm1.printEmployeeWithId(id:integer): string;
var i,imax :integer;
begin
  imax:=self.findNumberOfEmployees-1;
  for i:=0 to imax do begin
    if self.EmployeeArray[i]^.id = id then begin
      result:= 'Id : ' + inttostr((self.EmployeeArray[i]^).Id)  + '; Name : ' + self.EmployeeArray[i]^.Name  + '; Surname : ' + self.EmployeeArray[i]^.Surname;
      break;
    end;
  end;

end;

function TForm1.printEmployeeWithIndex(index:integer): string;
begin
   result:= 'Id : ' + inttostr((self.EmployeeArray[index]^).Id)  + '; Name : ' + self.EmployeeArray[index]^.Name  + '; Surname : ' + self.EmployeeArray[index]^.Surname;
end;

//////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////
///////////////////////////EVENTS/////////////////////////////////////////////

//add employee event
procedure TForm1.ButtonAddClick(Sender: TObject);
var pEmpTemp:pEmployee;
begin

   //create a new temp employee
   new(pEmpTemp);
   pEmpTemp^.Id := self.findNextFreeId;
   pEmpTemp^.Name := EditNameNew.Text;
   pEmpTemp^.Surname := EditSurnameNew.Text;

   self.addEmployee(pEmpTemp);

   showmessage('Employee with this info : ' + self.printEmployeeWithId(pEmpTemp^.Id) + ' added into array.');

end;

//modify employe event
procedure TForm1.ButtonModifyClick(Sender: TObject);
var tempEmployee:TEmployee;
begin
   tempEmployee.Id := strtoint(EditIdModify.Text);
   tempEmployee.Name := EditNameModify.Text;
   tempEmployee.Surname := EditSurnameModify.Text;

   self.modifyEmployee(tempEmployee.Id,@tempEmployee);

   showmessage('Employee with this info : ' + self.printEmployeeWithId(tempEmployee.Id) + ' modifided.');
   ButtonModify.Enabled := false;
end;

//delete employee event
procedure TForm1.ButtonDeleteClick(Sender: TObject);
begin
   self.deleteEmployee(strtoint(EditIdDelete.Text)) ;
   showmessage('Employee deleted');
   ButtonDelete.Enabled := false;
end;

//Show all employees event
procedure TForm1.ButtonShowClick(Sender: TObject);
var i,imax:integer;
begin
  memo.Clear;
  imax:=self.findNumberOfEmployees-1;

  for i:=0 to imax do begin
    Memo.Lines.Add(self.printEmployeeWithIndex(i));
  end;

end;

//on modify change
procedure TForm1.EditIdModifyChange(Sender: TObject);
var pTempEmployee : pEmployee;
begin
    pTempEmployee := getEmployee(strtoint(EditIdModify.Text));
    if pTempEmployee <> nil then begin
      EditNameModify.text := pTempEmployee^.Name;
      EditSurnameModify.text := pTempEmployee^.Surname;
      ButtonModify.Enabled := true;
    end else begin
      EditNameModify.text := 'N/A';
      EditSurnameModify.text := 'N/A';
      ButtonModify.Enabled := false;
    end;
    pTempEmployee:=nil;
end;

//on delete change
procedure TForm1.EditIdDeleteChange(Sender: TObject);
var pTempEmployee : pEmployee;
begin
    pTempEmployee := getEmployee(strtoint(EditIdDelete.Text));
    if pTempEmployee <> nil then begin
      LabelNameDelete.Caption := pTempEmployee^.Name;
      LabelSurnameDelete.Caption := pTempEmployee^.Surname;
      ButtonDelete.Enabled := true;
    end else begin
      LabelNameDelete.Caption := 'N/A';
      LabelSurnameDelete.Caption := 'N/A';
      ButtonDelete.Enabled := false;
    end;
    pTempEmployee:=nil;
end;

initialization
  {$I unit1.lrs}

end.

That's all for now.
See you on next article!