Some people new to Delphi show doubts related to how
to use variable size arrays.
This has to do with memory allocation techniques using
GetMem(), FreeMem() and ReallocMem().
The following code uses a dynamic size vector to show
an char table. Is obvious that it's a very stupid char table
implementation, but the target is only to show how to
use a dynamic size vector.
This code includes the use of a form to test it working.
You can choose the size of the vector (between 0 and 10)
in an UpDown control and press the button to show the
vector in the memo field.
The code is divided in 2 parts:
1 - the unit code
2 - the layout of the form has text
Create a new application with this form as main form
and make your own experiments.
This is the second example.
Watch the first for more detailed code comments.
============================================================
============================================================
Here goes the unit of the form :
============================================================
unit uFrmVectorTest;
interface
uses
Controls, Forms, ComCtrls, StdCtrls, Classes, SysUtils;
Const
_MyVectorMaxElements = 20000; // a reasonable maximum
_MyVectorMaxIndex = _MyVectorMaxElements-1;
Type
TMyElement = record //.......... // you array element type declaration
a : integer;
s : string[50];
end;
TMyVector = array[0.._MyVectorMaxIndex] of TMyElement;
TMyVectorPtr = ^TMyVector;
TfrmVectorTest2 = class(TForm)
btnShowVector: TButton;
txtVectorSize: TEdit;
updnVectorSize: TUpDown;
memoVector: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnShowVectorClick(Sender: TObject);
private
{ Private declarations }
elementCount : integer;
vectorPtr : TMyVectorPtr;
public
{ Public declarations }
procedure initVector;
procedure resizeVector(i_newElementCount : integer);
procedure freeVector;
end; // TfrmVectorTest
var
frmVectorTest2: TfrmVectorTest2;
implementation
{$R *.DFM}
procedure TfrmVectorTest2.initVector;
begin
elementCount := 0;
vectorPtr := Nil;
end; // TfrmVectorTest.initVector
procedure TfrmVectorTest2.resizeVector(i_newElementCount : integer);
begin
if i_newElementCount > _MyVectorMaxElements
then raise Exception.Create('New vector size too big')
else
begin
if i_newElementCount < 0 then
i_newElementCount := 0;
elementCount := i_newElementCount;
ReallocMem(vectorPtr, elementCount * sizeOf(vectorPtr^[0]));
end; // else
end; // TfrmVectorTest.resizeVector
procedure TfrmVectorTest2.freeVector;
begin
resizeVector(0);
end; // TfrmVectorTest.freeVector
procedure TfrmVectorTest2.FormCreate(Sender: TObject);
begin
initVector;
end; // TfrmVectorTest.FormCreate
procedure TfrmVectorTest2.FormDestroy(Sender: TObject);
begin
freeVector;
end; // TfrmVectorTest.FormDestroy
procedure TfrmVectorTest2.btnShowVectorClick(Sender: TObject);
var
newCount, oldCount : integer;
procedure fillNewElements;
var i : integer;
begin
for i := oldCount to newCount-1 do
begin
vectorPtr^[i].a := i;
vectorPtr^[i].s := ' - ' + Chr(Ord('A') + i);
end; // for
end; // fillNewTableElements
procedure showAll;
var i : integer;
begin
self.memoVector.Clear;
for i := 0 to newCount-1 do
memoVector.Lines.Add(IntToStr(vectorPtr^[i].a) + vectorPtr^[i].s);
end; // showAll
begin
oldCount := elementCount;
newCount := updnVectorSize.Position;
resizeVector(newCount);
if newCount > oldCount then
fillNewElements;
showAll;
end; // TfrmVectorTest.btnShowVectorClick
end.
============================================================
============================================================
Here goes the layout of the form :
============================================================
object frmVectorTest2: TfrmVectorTest2
Left = 329
Top = 233
Width = 329
Height = 212
Caption = 'Vector Test'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object btnShowVector: TButton
Left = 72
Top = 8
Width = 81
Height = 25
Caption = '&Show Chars'
TabOrder = 1
OnClick = btnShowVectorClick
end
object txtVectorSize: TEdit
Left = 8
Top = 8
Width = 41
Height = 21
TabOrder = 0
Text = '0'
end
object updnVectorSize: TUpDown
Left = 49
Top = 8
Width = 15
Height = 21
Associate = txtVectorSize
Min = 0
Max = 10
Position = 0
TabOrder = 2
Wrap = False
end
object memoVector: TMemo
Left = 160
Top = 8
Width = 153
Height = 169
ReadOnly = True
ScrollBars = ssVertical
TabOrder = 3
WordWrap = False
end
end
--
=======================================
Paulo Gaspar
ip204...@ip.pt
paulo.gas...@capgemini.pt
=======================================
