Implementing an Enqueue function (PASCAL) - error-handling

I'm having trouble getting the queue in my program to work. Every adjustment I've tried has resulted in an 'ERangeError: Range check error'.
I know this is because the program is trying to access something that doesn't exist, but I cannot figure out how to fix it.
Here is my queue implementation...
node = record //Square on chessboard
x: integer; //Row coordinate
y: integer; //Col coordinate
d: integer; //Distance from starting position
next: ^node;// (for the queue)
end; //node
coord = ^node;//'Coordinates'
queue = record//Queue w/ Linked List
head: coord;
tail: coord;
end; //queue
procedure init(var q: queue);
begin
q.head := nil;
q.tail := nil;
end; //init
function isEmpty(const q: queue): boolean;
begin
isEmpty := (q.head = nil);
end; //isEmpty
procedure push(var q: queue; m, n, o: integer);
var C: coord;
begin
new(C);
C^.x := m;
C^.y := n;
C^.d := o;
if q.head = nil then begin
q.head := C;
q.tail := q.head;
end
else begin
q.tail^.next := C;
q.tail := C;
end;
end; //push
procedure pop(var q: queue; out m: int; out n: int; out o: int);
var C: coord;
begin
m := q.head^.x;
n := q.head^.y;
o := q.head^.d;
C := q.head;
q.head := q.head^.next;
dispose(C);
if q.head = nil then q.tail := nil;
end; //pop
...and here is the main part of the function that is interacting with it.
while not isEmpty(q) do begin
pop(q, row, col, dst);
new(crd2);
crd2^.x := row;
crd2^.y := col;
crd2^.d := dst;
if valid(B, crd2) and not visited[crd2^.x, crd2^.y] then
visited[crd2^.x, crd2^.y] := true; //Mark square as visited
if (crd2^.x = Gl^.x) and (crd2^.y = Gl^.y) then
exit(crd2^.d); //Goal Check
for i := 1 to 8 do begin
crd2^.x := crd2^.x + mvmtX[i];
crd2^.y := crd2^.y + mvmtY[i];
if valid(B, crd2) and not visited[crd2^.x, crd2^.y] then begin
crd2^.d := crd2^.d + 1;
push(q, crd2^.x, crd2^.y, crd2^.d);
end;//if valid(B, crd)...
end;//for i
end;//while not isEmpty(q)
exit(crd^.d);
end;
I thought I had covered the issue by adding enough new(node) calls in the program, but the error still persists. I'm really at a loss and would appreciate any clarity you could offer.
I would email my professor but he is skiing right now and is hard to reach.
Thank you for any advice :)

Related

InnoSetup timer block all page

I need to get the output of the execution of my script and integrate it into the installer, everything works well, but I need to add a "cancel" button, it will not be difficult to add a button, but during the execution of the timer, the entire installer window is blocked, but I can not minimize to tray and press any button.
function SetTimer(
Wnd: LongWord; IDEvent, Elapse: LongWord; TimerFunc: LongWord): LongWord;
external 'SetTimer#user32.dll stdcall';
function KillTimer(hWnd: LongWord; uIDEvent: LongWord): BOOL;
external 'KillTimer#user32.dll stdcall';
var
ProgressFileName: string;
function BufferToAnsi(const Buffer: string): AnsiString;
var
W: Word;
I: Integer;
begin
SetLength(Result, Length(Buffer) * 2);
for I := 1 to Length(Buffer) do
begin
W := Ord(Buffer[I]);
Result[(I * 2)] := Chr(W shr 8); { high byte }
Result[(I * 2) - 1] := Chr(Byte(W)); { low byte }
end;
end;
procedure UpdateProgress;
var
S: AnsiString;
I, L, Max: Integer;
Buffer: string;
Stream: TFileStream;
Lines: TStringList;
begin
if not FileExists(ProgressFileName) then
begin
Log(Format('Progress file %s does not exist', [ProgressFileName]));
end
else
begin
try
Stream := TFileStream.Create(ProgressFileName, fmOpenRead or fmShareDenyNone);
try
L := Stream.Size;
Max := 100*2014;
if L > Max then
begin
Stream.Position := L - Max;
L := Max;
end;
SetLength(Buffer, (L div 2) + (L mod 2));
Stream.ReadBuffer(Buffer, L);
S := BufferToAnsi(Buffer);
finally
Stream.Free;
end;
except
Log(Format('Failed to read progress from file %s - %s', [
ProgressFileName, GetExceptionMessage]));
end;
end;
if S <> '' then
begin
Log('Progress len = ' + IntToStr(Length(S)));
Lines := TStringList.Create();
Lines.Text := S;
for I := 0 to Lines.Count - 1 do
begin
if I < ProgressListBox.Items.Count then
begin
ProgressListBox.Items[I] := Lines[I];
end
else
begin
ProgressListBox.Items.Add(Lines[I]);
end
end;
ProgressListBox.ItemIndex := ProgressListBox.Items.Count - 1;
ProgressListBox.Selected[ProgressListBox.ItemIndex] := False;
Lines.Free;
end;
ProgressPage.SetProgress(0, 1);
end;
procedure UpdateProgressProc(
H: LongWord; Msg: LongWord; Event: LongWord; Time: LongWord);
begin
UpdateProgress;
end;
procedure RunInstallBatInsideProgress;
var
ResultCode: Integer;
Timer: LongWord;
AppPath: string;
AppError: string;
Command: string;
begin
ProgressPage :=
CreateOutputProgressPage(
'Installing something', 'Please wait until this finishes...');
ProgressPage.Show();
ProgressListBox := TNewListBox.Create(WizardForm);
ProgressListBox.Parent := ProgressPage.Surface;
ProgressListBox.Top := 0;
ProgressListBox.Left := 0;
ProgressListBox.Width := ProgressPage.SurfaceWidth;
ProgressListBox.Height := ProgressPage.SurfaceHeight;
ProgressPage.ProgressBar.Top := -100;
try
Timer := SetTimer(0, 0, 250, CreateCallback(#UpdateProgressProc));
AppPath := ExpandConstant('{app}\installer.py');
ProgressFileName := ExpandConstant('{app}\tmp\installer-progress.log');
Log(Format('Expecting progress in %s', [ProgressFileName]));
Command := Format('""%s" > "%s""', [AppPath, ProgressFileName]);
if not Exec(ExpandConstant('{cmd}'), '/c ' + Command + ExpandConstant(' {app}\PIPE'), '', SW_HIDE, ewWaitUntilTerminated, ResultCode) then
begin
AppError := 'Cannot start app';
end
else
if ResultCode <> 0 then
begin
AppError := Format('App failed with code %d', [ResultCode]);
end;
UpdateProgress;
finally
KillTimer(0, Timer);
ProgressPage.Hide;
DeleteFile(ProgressFileName);
ProgressPage.Free();
end;
if AppError <> '' then
begin
RaiseException(AppError);
end;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep=ssPostInstall then
begin
RunInstallBatInsideProgress;
end
end;
enter image description here

How to sum 1+2^2+3^3+...n^n in pascal?

I want to sum that thing but only use the 'for loop' (no power functions). I've already created a loop that generates powers:
Program powers;
Var
i, n, result : integer;
writeln('enter N'), read(n);
BEGIN
Result := 1;
for i := 1 to n do
begin
Result := Result * n;
end;
writeln('result=',result);
END.
But I neither have any idea on how to make that code generate multiple powers ( this code only generates n^n) nor how to make a loop that sums them together.
It's best to break problems down into smaller problems. In this case, you may wish to have a pow function to handle the exponentiation for you.
Hopefully the pow function is acceptable if it's not a library function.
function pow(n, exp : integer) : integer;
var
i, result : integer;
begin
result := n;
for i := 2 to exp do
result := result * n;
pow := result;
end;
Then the main portion of your program is simpler.
program powers;
var
n, i, sum : integer;
function pow(n, exp : integer) : integer;
var
i, result : integer;
begin
result := n;
for i := 2 to exp do
result := result * n;
pow := result;
end;
begin
sum := 0;
write('enter N:');
readln(n);
for i := 0 to n do
sum := sum + pow(i, i);
writeln('result=', sum);
end.
Now that I finally understand what you're asking, please try this:
Program powers;
Var
i, j, n, p, result : integer;
BEGIN
write('enter N:');
readln(n);
Result := 0;
for i := 1 to n do
begin
p := 1;
for j := 1 to i do
p := p * i;
Result := Result + p;
end;
writeln('result=', result);
END.

Does HelpNDoc Pascal Script support structures?

I am trying to create a structure:
MyTopic
TopicID : String;
HelpID : Integer;
I wanted to create an array of these structures so I could sort them.
I have tried using this type / record syntax but it is failing.
Update
I defined this type and procedure:
type
TMyTopicRecord = record
idTopic : String;
idContextHelp : integer;
End;
procedure GetSortedTopicIDs(aTopics : array of String; size : Integer);
var
aMyTopicRecords : array of TMyTopicRecord;
temp : TMyTopicRecord;
iTopic, i, j : Integer;
begin
// Init the array
SetLength(aMyTopicRecords, size);
// Fill the array with the existing topid ids.
// Get the context ids at the same time.
for iTopic := 0 to size - 1 do
aMyTopicRecords[iTopic].idTopic := aTopics[iTopic];
aMyTopicRecords[iTopic].idContextHelp := HndTopics.GetTopicHelpContext(aTopics[iTopic]);
// Sort the array on context id
for i := size-1 DownTo 1 do
for j := 2 to i do
if (aMyTopicRecords[j-1].idContextHelp > aMyTopicRecords[j].idContextHelp) Then
begin
temp := aMyTopicRecords[j-1];
aMyTopicRecords[j-1] := aMyTopicRecords[j];
aMyTopicRecords[j] := temp;
end;
// Rebuild the original array of topic ids
for iTopic := 0 to size - 1 do
aTopics[iTopic] := aMyTopicRecords[iTopic].idTopic;
end;
The procedure gets called in a loop of the parent function (code snipped):
function GetKeywordsAsHtml(): string;
var
aKeywordList: THndKeywordsInfoArray;
aAssociatedTopics: array of string;
nBlocLevel, nDif, nClose, nCurKeywordLevel, nCurKeywordChildrenCnt: Integer;
nCurKeyword, nCurKeywordTopic: Integer;
nCountAssociatedTopics: Integer;
sCurrentKeyword, sKeywordLink, sKeywordRelated: string;
sKeywordJsCaption: string;
begin
Result := '<ul>';
nBlocLevel := 0;
try
aKeywordList := HndKeywords.GetKeywordList(False);
for nCurKeyword := 0 to length(aKeywordList) - 1 do
begin
sCurrentKeyword := aKeywordList[nCurKeyword].id;
nCurKeywordLevel := HndKeywords.GetKeywordLevel(sCurrentKeyword);
nCurKeywordChildrenCnt := HndKeywords.GetKeywordDirectChildrenCount(sCurrentKeyword);
sKeywordLink := '#';
sKeywordRelated := '[]';
aAssociatedTopics := HndTopicsKeywords.GetTopicsAssociatedWithKeyword(sCurrentKeyword);
nCountAssociatedTopics := Length(aAssociatedTopics);
if nCountAssociatedTopics > 0 then
begin
GetSortedTopicIDs(aAssociatedTopics, nCountAssociatedTopics);
// Code snipped
end;
end;
finally
Result := Result + '</ul>';
end;
end;
The script compiled in the HelpNDoc internal editor with no issues. But when I go to actually build my HTML documentation I encounter a problem:
The HelpNDoc API is explained here.
Is there something wrong with my code?
I decided to go about it a different way and used a simpler technique:
procedure GetSortedTopicIDs(var aTopics : array of String; iNumTopics : Integer);
var
iTopic : Integer;
// List of output
aList: TStringList;
begin
// Init list
aList := TStringList.Create;
// Build a new array of "nnn x"
// - nnn is the help context id
// - x is the topid id
// Note: I know that the context ID values are within the range 0 - 200
for iTopic := 0 to iNumTopics - 1 do
// We pad the context id with 0. We could increase the padding width to
// make the script mre useful
aList.Add(Format('%0.3d %s', [
HndTopics.GetTopicHelpContext(aTopics[iTopic]),
aTopics[iTopic]
]));
// Now we sort the new array (which basically sorts it by context id)
aList.Sort;
// Update original array
for iTopic := 0 to iNumTopics - 1 do
// We ignore the "nnn " part of the string to get just the topic id
aTopics[iTopic] := copy(aList[iTopic],5, length(aList[iTopic])-4);
// Tidy up
aList.Free;
end;
This compiles and I get the sorted array of topic IDs at the end of it. So the pop-up help is now listed as I want.

The error 'Grid index out of range' when switching between the databases

This is the procedure to display the Customer Database:
procedure TfrmMain.mnuCustomerClick(Sender: TObject);
var
j: integer;
begin
con := TFDConnection.Create(nil);
query := TFDQuery.Create(con);
con.LoginPrompt := False;
con.Open('DriverID=SQLite;Database=C:\Users\katiee\Documents\Embarcadero\Studio\Projects\ProgramDatabase;');
query.Connection := con;
query.sql.Text := 'SELECT * FROM CustDatabase ORDER BY ID';
query.Open();
query.First;
sgdDatabases.colCount := 9;
sgdDatabases.FixedCols := 0;
for j := 0 to sgdDatabases.rowCount do
sgdDatabases.ColWidths[j] := 100;
sgdDatabases.Cells[0, 0] := 'ID';
sgdDatabases.Cells[1, 0] := 'First Name';
sgdDatabases.Cells[2, 0] := 'Last Name';
sgdDatabases.Cells[3, 0] := 'Address';
sgdDatabases.Cells[4, 0] := 'Town';
sgdDatabases.Cells[5, 0] := 'County';
sgdDatabases.Cells[6, 0] := 'Postcode';
sgdDatabases.Cells[7, 0] := 'Telephone No.';
sgdDatabases.Cells[8, 0] := 'E-Mail';
row := 1;
while not query.EOF do
begin
ID := query.FieldByName('ID').AsString;
firstname := query.FieldByName('First Name').AsString;
lastname := query.FieldByName('Last Name').AsString;
address := query.FieldByName('Address').AsString;
town := query.FieldByName('Town').AsString;
county := query.FieldByName('County').AsString;
postcode := query.FieldByName('Postcode').AsString;
telno := query.FieldByName('TelNo').AsString;
email := query.FieldByName('Email').AsString;
sgdDatabases.Cells[0, row] := ID;
sgdDatabases.Cells[1, row] := firstname;
sgdDatabases.Cells[2, row] := lastname;
sgdDatabases.Cells[3, row] := address;
sgdDatabases.Cells[4, row] := town;
sgdDatabases.Cells[5, row] := county;
sgdDatabases.Cells[6, row] := postcode;
sgdDatabases.Cells[7, row] := telno;
sgdDatabases.Cells[8, row] := email;
sgdDatabases.RowCount := sgdDatabases.RowCount + 1;
row := row + 1;
query.Next;
end;
end;
This is the procedure to display the Employee Database, which is basically identical except "SELECT * FROM EmplDatabase":
procedure TfrmMain.mnuEmployeeClick(Sender: TObject);
var
i: integer;
begin
con := TFDConnection.Create(nil);
query := TFDQuery.Create(con);
con.LoginPrompt := False;
con.Open('DriverID=SQLite;Database=C:\Users\kasio\Documents\Embarcadero\Studio\Projects\ProgramDatabase;');
query.Connection := con;
query.sql.Text := 'SELECT * FROM EmplDatabase ORDER BY ID';
query.Open();
query.First;
sgdDatabases.colCount := 9;
sgdDatabases.FixedCols := 0;
for i := 0 to sgdDatabases.RowCount do
sgdDatabases.ColWidths[i] := 100;
sgdDatabases.Cells[0, 0] := 'ID';
sgdDatabases.Cells[1, 0] := 'First Name';
sgdDatabases.Cells[2, 0] := 'Last Name';
sgdDatabases.Cells[3, 0] := 'Address';
sgdDatabases.Cells[4, 0] := 'Town';
sgdDatabases.Cells[5, 0] := 'County';
sgdDatabases.Cells[6, 0] := 'Postcode';
sgdDatabases.Cells[7, 0] := 'Telephone No.';
sgdDatabases.Cells[8, 0] := 'E-Mail';
row := 1;
while not query.EOF do
begin
ID := query.FieldByName('ID').AsString;
firstname := query.FieldByName('First Name').AsString;
lastname := query.FieldByName('Last Name').AsString;
address := query.FieldByName('Address').AsString;
town := query.FieldByName('Town').AsString;
county := query.FieldByName('County').AsString;
postcode := query.FieldByName('Postcode').AsString;
telno := query.FieldByName('TelNo').AsString;
email := query.FieldByName('Email').AsString;
sgdDatabases.Cells[0, row] := ID;
sgdDatabases.Cells[1, row] := firstname;
sgdDatabases.Cells[2, row] := lastname;
sgdDatabases.Cells[3, row] := address;
sgdDatabases.Cells[4, row] := town;
sgdDatabases.Cells[5, row] := county;
sgdDatabases.Cells[6, row] := postcode;
sgdDatabases.Cells[7, row] := telno;
sgdDatabases.Cells[8, row] := email;
sgdDatabases.RowCount := sgdDatabases.RowCount + 1;
row := row + 1;
query.Next;
end;
end;
When I run the program, I can open either of the databases on the first click, but then if I click again on either of the Customer or Employee buttons or try to change the database, the following error shows: "Project ProjectQuote.exe raised exception class EInvalidGridOperation with message 'Grid index out of range'".
If I delete the line
sgdDatabases.RowCount := sgdDatabases.RowCount + 1;
from the code, it displays both databases, but only shows the first four rows from the database even if there's more.
(I am aware of the uselessly repeated code and no I can't use anything else other than TStringGrid)
This line of your code looks wrong to me:
for j := 0 to sgdDatabases.rowCount do
sgdDatabases.ColWidths[j] := 100;
The [Index] of a StringGrid's ColWidths property is a column number, not a row number, so sgdDatabases.rowCount should have nothing to do with it. If, at the time the above code executes, the number of rows in the grid is greater than the number of columns, you will get an "Index out of range" error when the value of j reaches a value which represents an invalid column number.
In any case, even if that code were valid in that respect , there is an "off by one" error involving sgdDatabases.rowCount. The row numbers are zero-based, so it should be sgdDatabases.rowCount - 1 (assuming you were attempting to refer to a particular row by index, of course).
A more general point is that you can single-step through your code using the IDE's debugger; if you do that, you will see the exception occur when one particular line is executed, and that's the place to start looking for the cause. You should always include the location of the exception in your SO question, because readers should not have to guess this.
Usually, the IDE debugger will find the exception even if you don't single-step, as long as you go to
Tools | Debugger Options | Embarcadero Debuggers | Language Exceptions
in the IDE and check the checkbox Notify on Language Exceptions.
Btw, it would be better if you wrote a general-purpose routine to populate a StringGrid from a Dataset, maybe along the following lines:
procedure TForm1.DatasetToGrid(Dataset : TDataset; Grid : TStringGrid);
var
Col,
Row : Integer;
begin
Grid.RowCount := 1;
Row := 0;
// The following gives the column headers the names of the
// Dataset fields.
for Col := 0 to Dataset.FieldCount - 1 do
Grid.Cells[Col, Row] := Dataset.Fields[Col].FieldName;
Inc(Row);
Dataset.First;
while not Dataset.Eof do begin
for Col := 0 to Dataset.FieldCount - 1 do begin
// Oops! we don't need this Row := Grid.RowCount;
Grid.Cells[Col, Row] := DataSet.Fields[Col].AsString;;
end;
Dataset.Next;
Grid.RowCount := Grid.RowCount + 1;
Inc(Row);
end;
end;
One of the benefits of doing it that way is that all your mistakes are in one place, not duplicated in duplicated code, so if you fix them once, you're done.

how to compare two linear lists in pascal

The task is to create new list which contains 2 linear lists, and if elements of first list equal to elements of second list then we must delete the same element from new list
procedure CreateList(var t1,L1,t2,L2:plist);
var
tmp1, tmp2:plist;
begin
t1 := L1;
t2 := L2;
while t1 <> nil do
begin
write(t1^.Data, ' ');
t1 := t1^.Next;
while t2 <> nil do
begin
write(t2^.data, ' ');
tmp2:=t2;
t2 := t2^.Next;
if(t2 = tmp1^.next) then // here is the problem how to compare 2 elements
begin
tmp1 := t1;
t1 := t1^.Next;
Dispose(tmp1);
end;
end;
end;
Writeln;
readkey;
end;
I advise you to change type of you list for something like:
type
TData = integer;
PList = ^TList;
TList = record
data : TData;
next : PList;
copy : boolean;
end;
After you will use value .copy for checking copys. Here is simple code you need.
I tried to make all code as simple as possible.
procedure deleteCopys(var list:PList);
// make all TList.copy := false (after we will use it)
var
curList : PList;
begin
curList := list;
while (curList<>nil) do
begin
curList^.copy := false;
curList := curList^.next;
End;
End;
procedure createList(var list1, list2, list3:PList);
// we belive that: (list3 is empty) and (there is no copys in list1)
// and (there is no copys in list2)
var
curList1, curList2 : PList;
begin
deleteCopys(list1);
deleteCopys(list2);
deleteCopys(list3);
// make TList.copy := true for equal elements
// from curList1 and curList2
curList1 := list1;
while (curList1 <> nil) do
begin
curList2 := list2;
while (curList2 <> nil) do
begin
if (curList1^.data = curList2^.data) then
begin
curList1^.copy := true;
curList2^.copy := true;
break;
End;
curList2 := curList2^.next;
End;
curList1 := curList1^.next;
End;
// now we can put all elements from list1 and list2
// with state TLilt.copy=false
// and each of them will be different
// (Let's do it :)
curList1 := list1;
while (curList1 <> nil) do
begin
if (curList1^.copy = false) then
begin
//some procedure for new element
putNewElement(list3, curList1^.data);
End;
End;
curList2 := list2;
while (curList2 <> nil) do
begin
if (curList2^.copy = false) then
begin
//some procedure for new element
putNewElement(list3, curList2^.data);
End;
End;
end;
I hope it will help you!