How do i read in a number to enter details with arrays and records? - pascal

I am having trouble reading the array of records using my ReadAllCars function. How do I get to read all 4 inputs of the Car records into the Cars array? I keep getting dynamic array error.
type
cars = record
model:String;
year:integer;
end;
car = array of cars;
function readCar(prompt: String): Cars;
begin
WriteLn(prompt);
result.model := ReadString('Car Model: ');
result.year := ReadInteger('Year: ');
end;
**(this is my problem)**
function ReadAllCars(count:integer): Cars;
var
carArray: array of cars;
i:integer;
begin
setLength(carArray, count);
for i := 0 to high(carArray)do
begin
result.carArray[i] := readCar('Enter Car Details');
end;
end;
procedure Main();
var
cars: Array of Car;
begin
cars := ReadAllCars(4);
end;

The problem is here:
function ReadAllCars(count:integer): Cars;
This function returns type cars, which is declared as a record, not an array.
You have mixed up type Cars = record ... with a declared variable cars : array of cars.
This is how ReadAllCars should look like:
function ReadAllCars(count:integer): Car;
var
i:integer;
begin
setLength(Result, count);
for i := 0 to high(Result)do
begin
result[i] := readCar('Enter Car Details');
end;
end;

Related

Sorting a string list containing numbers and strings

I'm trying to sort a string grid filled with scores and strings like so:
via a sorted string list which is sorted by single columns from the grid called SUB 1, SUB 2, FINAL, TOTAL respectively (all these columns work except FINAL) and I'm not getting the results I need in the FINAL column.
I'm trying to get the column sorted like so, for example :
24
20
12
5
DNF
EXE
WE
but I'm getting this result instead (the result I do not want):
DNF
EXE
WE
24
20
12
5
In what way could I change my code to sort the grid as I want to sort it?
My code:
function Compare2(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
begin
//comparer for custom sort used in SortLTSGrid
if List[Index1] = List[Index2] then
Result := 0
else if List[Index1] < List[Index2] then
Result := 1
else
Result := -1;
end;
procedure TfrmPuntehou.SortLTSGrid(var grid: TStringGrid; columntotal: Integer);
var
TheList : TStringList;
i,l,iCount,m:integer;
const
separator = ',';
const
arrCodes:array[1..10] of string = ('DNF','DNS','WD','WE','DNA','OD','RD','EXR','EXE','PP');
begin
//sorts grid largest to smallest according to one column
//get grid row amount
iCount:=grid.RowCount - 1;
//create and fill the string list
TheList := TStringList.Create;
//fill the list
for i := 1 to (iCount) do
begin
for l := 1 to Length(arrCodes) do
begin
if grid.Rows[i].Strings[columntotal] = arrCodes[l] then
begin
TheList.Add('0'+separator+grid.Rows[i].Text);
end;
end;
TheList.Add(grid.Rows[i].Strings[columntotal]+separator+grid.Rows[i].Text);
end;
//try block to sort and write all strings in the list to the grid correctly
try
TheList.CustomSort(Compare2);
for i:= 1 to (iCount) do
begin
grid.Rows[i].Text := TheList.Strings[(i-1)] ;
end;
//fill the row numbers
for m := 1 to iCount do
begin
grid.Cells[0,m]:= IntToStr(m);
end;
finally
TheList.Free;
end;
end;
You can use two different lists to store items, and two different sorting functions (because you want to sort them in different direction; numbers will be ordered as decreasing and strings will be ordered as ascending) to sort lists. Sort the lists separately, and than merge them.
Please consider #David Heffernan's performance warning.
program Project3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Classes;
var
slStrings, slNumbers:TStringList;
test:string;
function CompareForNumbers(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
var
val1, val2:Integer;
begin
val1 := StrToInt(List[Index1]);
val2 := StrToInt(List[Index2]);
if val1 = val2 then
Result := 0
else if val1 < val2 then
Result := 1
else
Result := -1;
end;
function CompareForStrings(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
begin
if List[Index1] = List[Index2] then
Result := 0
else if List[Index1] > List[Index2] then
Result := 1
else
Result := -1;
end;
begin
slStrings := TStringList.Create();
slNumbers := TStringList.Create();
try
slStrings.Add('EXE');
slStrings.Add('WE');
slStrings.Add('DNF');
slNumbers.Add('5');
slNumbers.Add('20');
slNumbers.Add('24');
slNumbers.Add('12');
slNumbers.CustomSort(CompareForNumbers);
slStrings.CustomSort(CompareForStrings);
slNumbers.AddStrings(slStrings);
Writeln(slNumbers.Text);
Readln(test);
finally
slStrings.Free();
slNumbers.Free();
end;
end.
To use single list to handle #David Heffernan's performance warning, i've write this;
program Project3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Classes;
var
slStrings:TStringList;
test:string;
function Compare(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
var
val1, val2:Integer;
val1integer, val2integer:Boolean;
begin
val1integer := TryStrToInt(List[Index1], val1);
val2integer := TryStrToInt(List[Index2], val2);
if val1integer and val2integer then
begin
if val1 = val2 then
Result := 0
else if val1 < val2 then
Result := 1
else
Result := -1;
end
else if (not val1integer) And (not val2integer) then
begin
if List[Index1] = List[Index2] then
Result := 0
else if List[Index1] > List[Index2] then
Result := 1
else
Result := -1;
end
else
begin
if val1integer then
Result := -1
else
Result := 1;
end;
end;
begin
slStrings := TStringList.Create();
try
slStrings.Add('EXE');
slStrings.Add('5');
slStrings.Add('WE');
slStrings.Add('20');
slStrings.Add('DNF');
slStrings.Add('24');
slStrings.Add('12');
slStrings.Add('A');
slStrings.Add('6');
slStrings.Add('E');
slStrings.Add('B');
slStrings.Add('4');
slStrings.Add('T');
slStrings.Add('444');
slStrings.CustomSort(Compare);
Writeln(slStrings.Text);
Readln(test);
finally
slStrings.Free();
end;
end.
I believe you want to sort times by shortest to longest first, then all text alphabetically (although that is arguable).
I would not modify the texts in the way that you do. Instead I would simply modify the comparer function and pass the texts 'as is'.
To test it I used a TMemo, but the principle applies to the tables - just copy the appropriate column to the string list.
function Compare2(
List : TStringList;
Index1 : Integer;
Index2 : Integer) : Integer;
var
i1IsNumeric, i2IsNumeric : boolean;
i1, i2 : integer;
begin
//comparer for custom sort used in SortLTSGrid
i1IsNumeric := TryStrToInt( List[Index1], i1 );
i2IsNumeric := TryStrToInt( List[Index2], i2 );
if i1IsNumeric and (not i2IsNumeric) then
begin
Result := -1;
end
else if i2IsNumeric and (not i1IsNumeric) then
begin
Result := 1;
end
else if i1IsNumeric then
begin
Result := Sign( i1-i2);
end
else
begin
Result := CompareStr( List[Index1], List[Index2] );
end;
end;
Here is my test routine using a memo
procedure TForm4.Button1Click(Sender: TObject);
var
iList : TStringList;
begin
iList := TStringList.Create;
try
iList.Assign( Memo1.Lines );
iList.CustomSort( Compare2 );
Memo1.Lines.Assign( iList );
finally
iList.Free;
end;
end;
Your routine would be more like (although this I have not tested)
procedure TfrmPuntehou.SortLTSGrid(var grid: TStringGrid; columntotal: Integer);
var
TheList : TStringList;
i,l,iCount,m:integer;
const
separator = ',';
const
arrCodes:array[1..10] of string = ('DNF','DNS','WD','WE','DNA','OD','RD','EXR','EXE','PP');
begin
//sorts grid largest to smallest according to one column
//get grid row amount
iCount:=grid.RowCount - 1;
//create and fill the string list
TheList := TStringList.Create;
//fill the list
for i := 1 to (iCount) do
begin
TheList.Add(grid.Rows[i].Text);
end;
//try block to sort and write all strings in the list to the grid correctly
try
TheList.CustomSort(Compare2);
for i:= 1 to (iCount) do
begin
grid.Rows[i].Text := TheList.Strings[(i-1)] ;
end;
//fill the row numbers
for m := 1 to iCount do
begin
grid.Cells[0,m]:= IntToStr(m);
end;
finally
TheList.Free;
end;
end;

Oracle - Get function parameter value in cursor

I have a package where I have created one function like this
create or replace package pk_server_control
is
function fn_get_employees_by_consultant(consultant_id number) return number;
end;
-----------------------------------------------------------------
create or replace package body pk_server_control
is
**function fn_get_employees_by_consultant(consultant_id number)
return number
is
cursor employees is select c.CST_NAME, a.NO_OF_EMPLOYEES from NISHAN_LDS_ACCOUNT a join NISHAN_LDS_CONSULTANT c
on c.CONSULTANT_ID = a.FK1_CONSULTANT_ID where c.CONSULTANT_ID =consultant_id ;
total number := 0; **
begin
for data in employees
loop
total := total + data.NO_OF_EMPLOYEES;
end loop;
return total;
end;
end;
begin
dbms_output.put_line(pk_server_control.fn_get_employees_by_consultant(1));
end;
I need to get value from the parameter "consultant_id number" of function "fn_get_employees_by_consultant" into "consultant_id" of the cursor "". While running, it doesn't give an error also it doesn't pass the value. Please help me to get through this :)
Try this
create or replace package pk_server_control
is
function fn_get_employees_by_consultant(consultant_id number) return number;
end;
-----------------------------------------------------------------
create or replace package body pk_server_control
is
function fn_get_employees_by_consultant(consultant_id number)
return number
is
val number := consultant_id;
cursor employees is select c.CST_NAME, a.NO_OF_EMPLOYEES from NISHAN_LDS_ACCOUNT a join NISHAN_LDS_CONSULTANT c
on c.CONSULTANT_ID = a.FK1_CONSULTANT_ID where c.CONSULTANT_ID =val;
total number := 0;
begin
for data in employees
loop
total := total + data.NO_OF_EMPLOYEES;
end loop;
return total;
end;
end;
begin
dbms_output.put_line(pk_server_control.fn_get_employees_by_consultant(3));
end;

Functions and procedures that call other functions and procedures

I need to:
Write a function called ReadCar(): Car; that reads from the terminal values for each of the fields in a Car record and returns the completed record.
Write a procedure called WriteCar(c: Car); that takes a car record and writes each of the fields to the terminal with a description for the field as well as the field value.
Write a function called ReadAllCars(count: Integer): Cars; that calls your ReadCar() function count times and stores each car in Cars.
Write a procedure called WriteAllCars(carArray: Cars); that calls your WriteCar() procedure for each car in carArray.
So far I believe I have done steps 1 and 2 correctly but I am not sure how to do steps 3 and 4. How should I begin those steps? By the end of this program I am supposed to be able to enter data for 3 cars and it print the data properly.
program carDetails;
uses TerminalUserInput;
type Cars = Array of Car;
Car = record
ID : integer;
Manufacturer : string;
Model : string;
Registration : integer;
end;
function ReadCar(): Car;
begin
WriteLn(promt);
ReadCar.ID := readInteger('Please enter the Car ID ');
ReadCar.Manufacturer := readString('Please enter the manufacturer of car '+ ReadCar.ID);
ReadCar.Model := readString('Please enter the model of car '+ ReadCar.ID);
ReadCar.Registration := readInteger('Please enter the registration number for car '+ ReadCar.ID);
end;
procedure WriteCar(c: Car);
begin
WriteLn('ID - ', c.ID);
WriteLn('Manufacturer - ', c.Manufacturer);
WriteLn('Model - ', c.Model);
WriteLn('Registration - ', c.Registration);
end;
function ReadAllCars(count: integer): Cars;
begin
end;
procedure WriteAllCars(carArray: Cars);
begin
end;
procedure Main();
var cars: Array of Car;
index: Integer;
begin
cars := ReadAllCars(3);
WriteAllCars(cars);
end;
begin
Main();
end.
I'm not going to do your coursework (from Swinburne Uni?) for you, but here are a few points.
You need to declare your Car record before your Cars array.
type //Cars = Array of Car;
Car = record
ID : integer;
Manufacturer : string;
Model : string;
Registration : integer;
end;
Cars = Array of Car;
In ReadCar, your Prompt variable is undeclared (and mispelt). It should be
function ReadCar(const Prompt : String): Car;
begin
// WriteLn(promt);
WriteLn(Prompt);
Also in ReadCar, you need to convert Car.ID to a string before you can use it in your calls to readString, like so:
ReadCar.Manufacturer := readString('Please enter the manufacturer of car ' + IntToStr(ReadCar.ID));
ReadCar.Model := readString('Please enter the model of car ' + IntToStr(ReadCar.ID));
ReadCar.Registration := readInteger('Please enter the registration number for car ' + IntToStr(ReadCar.ID));
In ReadCars, you need to set the length of the array returned by it:
function ReadAllCars(count: integer): Cars;
begin
SetLength(Result, Count);
end;
Having done all that, writeCars is actually very simple. All you need is
procedure WriteAllCars(carArray: Cars);
var
i : Integer;
begin
for i:= Low(carArray) to High(carArray) do
WriteCar(carArray[i]);
end;
Using the Low() and High() functions sidesteps the issue of having to know the lower and upper bounds of an array declared the way your Cars one is (i.e. an array of record). Actually they are zero-based, not 1-based.
For some reason, SO's code-formatter doesn't do its normal stuff with the code in this answer, I'll try and tidy it up later.

Pascal: Error trying to rewrite array and assistance with printing my array

So i'm working on this pascal application which has a menu where you can do multiple things.
After entering an album (which is what my program does) and trying to edit it by writing over the current album I get an error as shown in the image.
There have been no errors when compiling except the warning:
(100,9) Warning: Function result variable does not seem to initialized
Here is my code:
program MusicPlayer;
uses TerminalUserInput;
type
// You should have a track record
TrackRec = record
name: String;
location: String;
end;
type TrackArray = array of TrackRec;
GenreType = (Pop, Rap, Rock, Classic);
AlbumRec = Record
name: String;
genre: GenreType;
location: array of TrackRec; // this and track should be track: array of TrackRec
numberOfTracks: Integer;
tracks: TrackArray;
end;
type AlbumArray = array of AlbumRec; // this should be an array of AlbumRec
function ReadGenre(prompt: String): GenreType;
var
option: Integer;
begin
WriteLn('Press 1 for Pop');
WriteLn('Press 2 for Rap');
WriteLn('Press 3 for Rock');
WriteLn('Press 4 for Classic');
option := ReadInteger(prompt);
while (option<1) or (option>3) do
begin
WriteLn('Please enter a number between 1-4');
option := ReadInteger(prompt);
end;
case option of
1: result := Pop;
2: result := Rap;
3: result := Rock;
else
result := Classic;
end;
end;
function CheckLength(prompt: string): Integer;
var
i: Integer;
begin
i := ReadInteger(prompt);
while (i < 0) or (i > 20) do
begin
WriteLn('Please enter a number between 1-20');
i := ReadInteger(prompt);
end;
result := i;
end;
function ReadTracks(count: Integer): TrackArray;
var
i: Integer;
begin
setLength(result, count);
for i := 0 to High(result) do
begin
result[i].name := ReadString('Track Name: ');
result[i].location := ReadString('Track Location: ');
end;
end;
function ReadAlbum(): AlbumRec;
begin
result.name := ReadString('What is the name of the album?');
result.genre := ReadGenre('What is the genre of the album?');
result.numberOfTracks := CheckLength('How many tracks are in the album?');
result.tracks := ReadTracks(result.numberOfTracks);
end;
function ReadAlbums(count: Integer): AlbumArray;
var
i: Integer;
begin
SetLength(result, count);
for i := 0 to High(result) do
begin
result[i] := ReadAlbum();
end;
end;
function ChangeAlbum(count: Integer): AlbumArray;
var
i: Integer;
begin
for i := count to count do
begin
result[i] := ReadAlbum();
end;
end;
procedure PrintAlbum(count: Integer; album: array of AlbumRec);
var
i: Integer;
begin
if count = 1 then
begin
for i := 0 to High(album) do
begin
WriteLn('Album Number: ', i);
WriteLn('Album name is: ', album[i].name);
WriteLn('Album genre is: ', album[i].genre);
end
end;
for i := 1 to count - 1 do
begin
WriteLn('Album name is: ', album[i].name);
WriteLn('Album genre is: ', album[i].genre);
end;
end;
procedure PrintTrack(tracks: TrackArray);
var
i: Integer;
begin
i := ReadInteger('Which track number do you wish to play?');
i := i - 1;
WriteLn('Now playing track: ', tracks[i].name);
WriteLn('Track location: ', tracks[i].location);
end;
function CheckIfFinished(): Boolean;
var answer: String;
begin
WriteLn('Do you want to enter another set of tracks? ');
ReadLn(answer);
LowerCase(answer);
case answer of
'no': result := true;
'n': result := true;
'x': result := true;
else
result := false;
end;
end;
procedure Main();
var
i, count, select, change: Integer;
albums: AlbumArray;
begin
WriteLn('Please select an option: ');
WriteLn('-------------------------');
WriteLn('1. Read Albums');
WriteLn('2. Display Albums');
WriteLn('3. Select an Album');
WriteLn('4. Update an Album');
WriteLn('5. Exit');
WriteLn('-------------------------');
repeat
i := ReadInteger('Your Option:');
case i of
1:
begin
count := ReadInteger('How many albums: ');
albums := ReadAlbums(count);
end;
2:
begin
WriteLn('1. Display All Albums');
WriteLn('2. Display All Albums by Genre');
select := ReadInteger('Your Option: ');
if i = 1 then
begin
PrintAlbum(select, albums);
end;
// if i = 2 then
// WriteLn('1. Pop');
// WriteLn('2. Rap');
// WriteLn('3. Rock');
// WriteLn('4. Classic');
// albums := ReadAlbums(count);
end;
3:
begin
select := ReadInteger('Which album would you like to play? ');
PrintAlbum(select, albums);
PrintTrack(albums[select-1].tracks);
end;
4:
begin
change := ReadInteger('Which album would you like to edit?');
albums := ChangeAlbum(change);
end;
end;
until i = 5;
end;
begin
Main();
end.
The function that the warning refers to, on line 100, is
function ChangeAlbum(count: Integer): AlbumArray;
var
i: Integer;
begin
for i := count to count do
begin
result[i] := ReadAlbum();
end;
end;
The warning says:
Warning: Function result variable does not seem to initialized
And indeed the result variable has not been initialized.
The design of the function is wrong though. You are trying to modify an existing element in an array. You should not be returning a new array. The function is not necessary though. You should simply remove it. Then you need to look at the one place where you call the function.
change := ReadInteger('Which album would you like to edit?');
albums := ChangeAlbum(change);
You should instead code that like this:
change := ReadInteger('Which album would you like to edit?');
albums[change] := ReadAlbum();
I've not checked anything else in your program. I would not be surprised if there are other problems. I've just tried to address the specific question that you asked.

Access Array of Array in Pl SQL

I have Array list having List of Arrays.
for example:
//Array list type is varchar
Listarray1(0) := 'data';
Listarray1(1) := 'data1';
Listarray2(0) := 'data2';
Listarray2(1) := 'data3';
//Sub list type is listarray
SUBLIST(0) := Listarray1;
SUBLIST(0) := Listarray2;
how to print the each array using loop
Multidimensional arrays in PL/SQL you do like this:
DECLARE
TYPE Sub_Array_list IS TABLE OF VARCHAR2(100);
TYPE Array_list IS TABLE OF Sub_Array_list;
My_array Array_list := Array_list();
BEGIN
My_array.EXTEND;
My_array(My_array.LAST) := Sub_Array_list('data', 'data1');
My_array.EXTEND;
My_array(My_array.LAST) := Sub_Array_list('data2', 'data3');
FOR i IN My_array.FIRST..My_array.LAST LOOP
FOR k IN My_array(i).FIRST..My_array(i).LAST LOOP
DBMS_OUTPUT.PUT_LINE ( 'My_array('||i||')('||k||') = '||My_array(i)(k) );
END LOOP;
END LOOP;
END;

Resources