procedure searchAndReceipt;
var
amt, counter, check: integer;
gtinStore, qtyStore: array of integer;
totalCost: real;
begin
check := 0;
totalCost := 0.0;
write('Enter how many products you are purchasing: ');
repeat
readln(amt);
if (amt > 11) and (amt <= 0) then
writeln ('Please re-enter how many products are you purchasing with a value between 1-10')
else
check:= 1;
until check = 1;
SetLength(gtinStore, amt);
SetLength(qtyStore, amt);
SetLength(receiptArray, amt);
for counter:=1 to amt do
begin
write('Enter a GTIN code: ');
repeat
readln(gtinStore[counter]);
if (gtinStore[counter] >= 99999999) and (gtinStore[counter] <= 1000000) then
writeln ('Please re-enter the Gtin Code with a value of 8 digits')
else
check:= 1;
until check = 1;
check := 0;
write('Enter the Quantity: ');
repeat
readln(qtyStore[counter]);
if (qtyStore[counter] >= 11) and (qtyStore[counter] <= 0) then
writeln ('Please re-enter the quantity with a value between 1-10')
else
check:= 1;
until check = 1;
end;
assign(stockFile,'stockFile.dat');
Reset(stockFile);
counter:=1;
while not EOF(stockFile) do
begin
receiptArray[counter].productName := ('Product Not Found');
receiptArray[counter].productGTIN := 0;
receiptArray[counter].productPrice := 0.0;
inc(counter);
end;
read (stockFile, Stock);
for counter:=1 to amt+1 do
begin
while not EOF(stockFile) do
begin
read (stockFile, Stock);
if Stock.productGTIN = gtinStore[counter] then
receiptArray[counter].productGTIN:= Stock.productGTIN;
receiptArray[counter].productName:= Stock.productName;
receiptArray[counter].productPrice:= Stock.productPrice;
end;
end;
assign(receiptFile, 'receipt.txt');
rewrite(receiptFile);
for counter:= 1 to amt+1 do
begin
if receiptArray[counter].productName = 'Product Not Found' then
begin
writeln(receiptFile, 'GTIN: ', gtinStore[counter]);
writeln(receiptFile, receiptArray[counter].productName);
writeln(receiptFile, '');
end
else
begin
writeln(receiptFile, 'GTIN: ',gtinStore[counter]);
writeln(receiptFile, 'Name: ',receiptArray[counter].productName);
writeln(receiptFile, 'Quantity: ', qtyStore[counter]);
writeln(receiptFile, 'Price: £',receiptArray[counter].productPrice*qtyStore[counter]:4:2);
writeln(receiptFile, '');
totalCost := ((receiptArray[counter].productPrice * qtyStore[counter]) + totalCost);
end;
end;
choices:=1;
end;
begin
choices:= 1;
while choices <> 3 do
begin;
writeln('Press 1 to create the stock file');
writeln('Press 2 to search for an item and print a receipt');
writeln('Press 3 to exit');
write('Choice: ');
readln(choices);
writeln;
case choices of
1: createStock;
2: searchAndReceipt;
end;
end;
end.
I run this procedure (there's another procedure before this that places stock into a file), what this is supposed to do is to take that stock out and place it into a text file... however after I've entered the GTIN number and the quantities of the items my program produces this error
Exception EAccessViolation in module Task_2.exe at 00002550.
Access violation at address 00402550 in module 'Task_2.exe'. Read of address 03491DD4.
within the shell, and a message box pops up saying
Project Task_2.exe raised exception class EInvalidPointer with message 'invalid Pointer Operation'. Process Stopped
Thanks in advance
Dynamic arrays are 0-based, but your code assumes 1-based indexing. Hence you index off the end of the array, and hence the runtime errors. Fix the code by using 0-based indices. That is loop from 0 to N-1 rather than from 1 to N.
Even what you fix that, you have loops that run from 1 to N+1 so you aren't even allocating enough space for your arrays.
You should enable range checking in the compiler options so that the compiler can emit diagnostics code to give you better error messages.
Related
Hey can anybody help me with this error please, I can't seem to find a solution.
Any help would be appreciated.
I am working with Windows 8 and Delphi RAD Studio 2010.
If there are more errors then what I'm referring to please feel free to comment on them.
procedure TfrmStats.FormShow(Sender: TObject);
begin
// // Code that connects the TADOConnection to the database
// //conDatabase.Close;
// conDatabase.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\[Phase 2]\db_DatabaseStock.mdb;Persist Security Info=False' ;
// conDatabase.Open;
// Code sets radiobutton.checked and checkbox.checked to true to avoid errors and
// simplify GUI
rb2D.Checked := True;
chkShowLegend.Checked := True;
// Code hides ShowGrid checkbox
chkShowItemGrid.Visible := False;
//Code hides Stringgrid
SGStats.Visible := False;
DrawPie;
**end;** // The breakpoint is here (Where delphi says the error is)
I will also show the code for the procedure being called:
procedure TfrmStats.DrawPie;
var
sSQL :string;
iRow, iCol, iA : Integer;
dblGT, dblLST, dblValue, PiePercentage : Double;
begin
// Procedure used to draw the chart of data
// Here call Subtotal
SGstats.Cells[0,1] := 'Sub Total';
SGstats.Cells[1,1] := IntToStr(GetSub);
with qryItems do
begin
// Select itemname an populate the stringgrid
SQL.Clear;
sSQL := 'SELECT DISTINCT ItemName FROM tblItems ORDER BY ItemName';
SQL.Add(sSQL);
Open;
Active := False;
Active := True;
if (RecordCount <> 0) then
begin
SGstats.RowCount := SGstats.RowCount + RecordCount;
for iRow := 0 to RecordCount -1 do
begin
SGstats.Cells[0,iRow+2] := FieldByName('ItemName').AsString;
Next;
end;
end;
end;
qryItems.Close;
with qryItems do
begin
// Select itembookquantity and populate the stringgrid
SQL.Clear;
sSQL := 'SELECT DISTINCT ItemName, ItemBookQuantity FROM tblItems ORDER BY ItemName';
SQL.Add(sSQL);
Open;
Active := False;
Active := True;
if (RecordCount <> 0) then
begin
SGstats.RowCount := SGstats.RowCount + RecordCount;
for iRow := 0 to RecordCount -1 do
begin
SGstats.Cells[1,iRow+2] := FieldValues['ItemBookQuantity'];
Next;
end;
end;
end;
// Code that actually draws piechart
with chtStats do
begin
//Clear the charts series
while (SeriesCount> 0) do
Series[0].Free;
//Change title
Title.Text.Clear;
Title.Text.Add('Items');
// Add series to piechart
AddSeries(TPieSeries.Create(Self));
Series[0].Name := 'PieItems';
for iRow := 2 to SGstats.RowCount -2 do
begin
PiePercentage := (StrToFloat(SGstats.Cells[1,iRow])/StrToFloat(SGstats.Cells[1,1]))*100;
Series[0].Add(StrToFloat(SGstats.Cells[1, iRow]), SGStats.Cells[0,iRow] + ', ' + FormatCurr('0.####',PiePercentage) + ' %', clteecolor);
end;
end;
The subtotal is supposed to be an integer. I'm also experiencing an 'Authentication Failed' error when running the program, any assistance would be appreciated. I'm still only a beginner so I may overlook small things or make simple mistakes :D
If I need to add more information to help, please let me know!
The error message is very clear: you are trying to convert to float an empty string. Delphi raises an exception because an empty string doesn't represent any valid float value.
You need to first check that the strings that you are using are not empty, and decide what to do in that case : inform the user, draw an empty pie, ...
By the way, if you want to consider your empty strings as zeros, then you can code your own customized conversion function.
function CustomStrToFloat(string: variant): double;
begin
if (string = null) or (Trim(string) = '') then Result := 0
else Result := StrToFloat(string);
end;
Please notice that this function will still raise an exception if your input is not an empty string (or a null variant), so the user will know that you are receiving inconsistent inputs.
Now you just have to change your code in order to use your customized conversion function
...
PiePercentage := (CustomStrToFloat(SGstats.Cells[1,iRow])/CustomStrToFloat(SGstats.Cells[1,1]))*100;
Series[0].Add(CustomStrToFloat(SGstats.Cells[1, iRow]), SGStats.Cells[0,iRow] + ', ' + FormatCurr('0.####',PiePercentage) + ' %', clteecolor);
...
About the 'Authentication Failed' error, can you debug your code and check what line raises that error ?. Looks like that it's going to be when you execute your SQL query, in that case the credentials that you have defined on the connection object of your SQLQuery are not correct.
EDIT: As Remy Lebeau has suggested, Delphi already includes two functions to deal with conversions from strings not containing valid representations of floating values. The first one is StrToFloatDef (string to float with a default value for non-valid strings).
You will only need to change your code to :
...
PiePercentage := (StrToFloatDef(SGstats.Cells[1,iRow],0)/StrToFloatDef(SGstats.Cells[1,1],0))*100;
Series[0].Add(StrToFloatDef(SGstats.Cells[1, iRow],0), SGStats.Cells[0,iRow] + ', ' + FormatCurr('0.####',PiePercentage) + ' %', clteecolor);
...
I don't use it because it will not only consider as zeros all the empty strings, but also every other string with inconsistent contents, and in those cases I prefer to let the program raise an exception, so the user is going to be notified that the input values are not valid.
The other function that you could use is TryStrToFloat, that is going to try to do the conversion and return true or false if the conversion has been successful.
If you use this, you will need to change those two lines to :
var FirstCell, SecondCell: extended;
...
...
FirstCell := 0;
SecondCell := 0;
if not TryStrToFloat(SGstats.Cells[0,iRow], FirstCell) then
ShowMessage('Input Values not valid');
if not TryStrToFloat(SGstats.Cells[1,iRow], SecondCell) then
ShowMessage('Input Values not valid');
PiePercentage := (SecondCell/FirstCell)*100;
Series[0].Add(SecondCell, SGStats.Cells[0,iRow] + ', ' + FormatCurr('0.####',PiePercentage) + ' %', clteecolor);
...
I am building a stringlist from an ADO query, in the query it is much faster to return sorted results and then add them in order. this gives me an already sorted list and then calling either Sort or setting sorted true costs me time as the Quicksort algorithm does not preform well on an already sorted list. Is there some way to set the TStringList to use the Binary search without running the sort?
before you ask I don't have access to the CustomSort attribute.
I am not sure I understand what you are worried about, assuming the desired sort order of the StringList is the same as the ORDER BY of the AdoQuery.
Surely the thing to do is to set Sorted on your StringList to True while it is still empty and then insert the rows from the AdoQuery. That way, when the StringList is about to Add an entry, it will search for it using IndexOf, which will in turn use Find, which does a binary search, to check for duplicates. But using Add in this way does not involve a quicksort because the StringList is already treating itself as sorted.
In view of your comments and your own answer I ran the program below through the Line Timer profiler in NexusDB's Quality Suite. The result is that although there are detectable differences in execution speed using a binary search versus TStringList.IndexOf, they are nothing to do with the use (or not) of TStringList's QuickSort. Further, the difference is explicable by a subtle difference between how the binary search I used and the one in TStringList.Find work - see Update #2 below.
The program generates 200k 100-character strings and then inserts them into a StringList. The StringList is generated in two ways, first with Sorted set to True before any strings are added and then with Sorted set to True only after the strings have been added. StringList.IndexOf and your BinSearch is then used to look up each of the strings which has been added. The results are as follows:
Line Total Time Source
80 procedure Test;
119 0.000549 begin
120 2922.105618 StringList := GetList(True);
121 2877.101652 TestIndexOf;
122 1062.461975 TestBinSearch;
123 29.299069 StringList.Free;
124
125 2970.756283 StringList := GetList(False);
126 2943.510851 TestIndexOf;
127 1044.146265 TestBinSearch;
128 31.440766 StringList.Free;
129 end;
130
131 begin
132 Test;
133 end.
The problem I encountered is that your BinSearch never actually returns 1 and the number of failures is equal to the number of strings searched for. If you can fix this, I'll be happy to re-do the test.
program SortedStringList2;
[...]
const
Rows = 200000;
StrLen = 100;
function ZeroPad(Number : Integer; Len : Integer) : String;
begin
Result := IntToStr(Number);
if Length(Result) < Len then
Result := StringOfChar('0', Len - Length(Result)) + Result;
end;
function GetList(SortWhenEmpty : Boolean) : TStringList;
var
i : Integer;
begin
Result := TStringList.Create;
if SortWhenEmpty then
Result.Sorted := True;
for i := 1 to Rows do
Result.Add(ZeroPad(i, StrLen));
if not SortWhenEmpty then
Result.Sorted := True;
end;
Function BinSearch(slList: TStringList; sToFind : String) : integer;
var
i, j, k : integer;
begin
try
i := slList.Count div 2;
k := i;
if i = 0 then
begin
Result := -1;
// SpendLog('BinSearch List Empty, Exiting...');
exit;
end;
while slList.Strings[i] <> sToFind do
begin
if CompareText(slList.Strings[i], sToFind) < 0 then
begin
j := i;
k := k div 2;
i := i + k;
if j=i then
break;
end else
if CompareText(slList.Strings[i], sToFind) > 0 then
begin
j := i;
k := k div 2;
i := i - k;
if j=i then
break;
end else
break;
end;
if slList.Strings[i] = sToFind then
result := i
else
Result := -1;
except
//SpendLog('<BinSearch> Exception: ' + ExceptionMessage + ' At Line: ' + Analysis.LastSourcePos);
end;
end;
procedure Test;
var
i : Integer;
StringList : TStringList;
procedure TestIndexOf;
var
i : Integer;
Index : Integer;
Failures : Integer;
S : String;
begin
Failures := 0;
for i := 1 to Rows do begin
S := ZeroPad(i, StrLen);
Index := StringList.IndexOf(S);
if Index < 0 then
Inc(Failures);
end;
Assert(Failures = 0);
end;
procedure TestBinSearch;
var
i : Integer;
Index : Integer;
Failures : Integer;
S : String;
begin
Failures := 0;
for i := 1 to Rows do begin
S := ZeroPad(i, StrLen);
Index := BinSearch(StringList, S);
if Index < 0 then
Inc(Failures);
end;
//Assert(Failures = 0);
end;
begin
StringList := GetList(True);
TestIndexOf;
TestBinSearch;
StringList.Free;
StringList := GetList(False);
TestIndexOf;
TestBinSearch;
StringList.Free;
end;
begin
Test;
end.
Update I wrote my own implementation of the search algorithm in the Wikipedia article https://en.wikipedia.org/wiki/Binary_search_algorithm as follows:
function BinSearch(slList: TStringList; sToFind : String) : integer;
var
L, R, m : integer;
begin
L := 0;
R := slList.Count - 1;
if R < L then begin
Result := -1;
exit;
end;
m := (L + R) div 2;
while slList.Strings[m] <> sToFind do begin
m := (L + R) div 2;
if CompareText(slList.Strings[m], sToFind) < 0 then
L := m + 1
else
if CompareText(slList.Strings[m], sToFind) > 0 then
R := m - 1;
if L > R then
break;
end;
if slList.Strings[m] = sToFind then
Result := m
else
Result := -1;
end;
This seems to work correctly, and re-profiling the test app using this gave these results:
Line Total Time Source
113 procedure Test;
153 0.000490 begin
154 3020.588894 StringList := GetList(True);
155 2892.860499 TestIndexOf;
156 1143.722379 TestBinSearch;
157 29.612898 StringList.Free;
158
159 2991.241659 StringList := GetList(False);
160 2934.778847 TestIndexOf;
161 1113.911083 TestBinSearch;
162 30.069241 StringList.Free;
On that showing, a binary search clearly outperforms TStringList.IndexOf and contrary to my expectations it makes no real difference whether TStringList.Sorted is set to True before or after the strings are added.
Update#2 it turns out that the reason BinSearch is faster than TStringList.IndexOf is purely because BinSearch uses CompareText whereas TStringList.IndexOf uses AnsiCompareText (via .Find). If I change BinSearch to use AnsiCompareText, it becomes 1.6 times slower than TStringList.IndexOf!
I was about to suggest using an interposer class to directly change the FSorted field without calling its setter method which as a side effect calls the Sort method. But looking at the implementation of TStringList in Delphi 2007, I found that Find will always do a binary search without checking the Sorted property. This will, of course fail, if the list items aren't sorted, but in your case they are. So, as long as you remember to call Find rather than IndexOf, you don't need to do anything.
in the end I just hacked up a binary search to check the stringlist like an array:
Function BinSearch(slList: TStringList; sToFind : String) : integer;
var
i, j, k : integer;
begin
try
try
i := slList.Count div 2;
k := i;
if i = 0 then
begin
Result := -1;
SpendLog('BinSearch List Empty, Exiting...');
exit;
end;
while slList.Strings[i] <> sToFind do
begin
if CompareText(slList.Strings[i], sToFind) < 0 then
begin
j := i;
k := k div 2;
i := i + k;
if j=i then
break;
end else
if CompareText(slList.Strings[i], sToFind) > 0 then
begin
j := i;
k := k div 2;
i := i - k;
if j=i then
break;
end else
break;
end;
if slList.Strings[i] = sToFind then
result := i
else
Result := -1;
except
SpendLog('<BinSearch> Exception: ' + ExceptionMessage + ' At Line: ' + Analysis.LastSourcePos);
end;
finally
end;
end;
I'll clean this up later if needed.
The FireDAC sample project (demonstrating ArrayDML) c:\Users\Public\Documents\Embarcadero\Studio\19.0\Samples\Object Pascal\Database\FireDAC\Samples\Comp Layer\TFDQuery\ExecSQL\Batch\Batch.dproj compiles with two // W1058 Implicit string cast with potential data loss from string to rawbytestring warnings on the Params[2].AsBlobs assignments indicated with //W 1058:
procedure TfrmBatch.btnExecSQLClick(Sender: TObject);
var
i: Integer;
iTm: LongWord;
begin
qrySelect.Open;
qrySelect.ServerDeleteAll(True);
qrySelect.Close;
with qryBatch do
if cbxBatchExec.Checked then begin
Params.ArraySize := StrToInt(edtArraySize.Text);
iTm := GetTickCount;
for i := 0 to Params.ArraySize - 1 do begin
Params[0].AsIntegers[i] := i;
Params[1].AsStrings[i] := 'string' + IntToStr(i);
Params[1].Size := 20;
if cbxInsertBlob.Checked then
Params[2].AsBlobs[i] := 'blob' + IntToStr(i); // W1058
end;
Execute(Params.ArraySize);
iTm := GetTickCount - iTm;
end
else begin
Params.ArraySize := 1;
iTm := GetTickCount;
for i := 0 to StrToInt(edtArraySize.Text) - 1 do begin
Params[0].AsInteger := i;
Params[1].AsString := 'string' + IntToStr(i);
Params[1].Size := 20;
if cbxInsertBlob.Checked then
Params[2].AsBlob := 'blob' + IntToStr(i); // W1058
ExecSQL;
end;
iTm := GetTickCount - iTm;
end;
StatusBar1.SimpleText := 'Time executing is ' + FloatToStr(iTm / 1000.0) + ' sec.';
qrySelect.Open;
end;
What is the correct way to solve this? (Under FireDAC the AsBlobs has changed to TFDByteString = RawByteString under Windows). Both a cast as RawByteString() or a Params[2].Value assignment make the compiler warning go away but I'm unsure it this won't lead to potential problems...
If you decide storing binary BLOB data in a String type variable, you can lose them, and by adding typecast to RawByteString before that parameter value assignment you just say the compiler, that you agree with a potential data loss. There's nothing more than that.
Correct way is storing your BLOB data in RawByteString type variable for such parameter.
Is it possible, in delphi, that a procedure fires without being called?
I have two completly different procedure. First one is a click on popup menu. The second one is a function which i defined to split a string.
And i don't call my split method in my click of popup menu but it fires anyway and i can't find why. Debugger just says he can't read adress 00000001 but i don't even want him to read cause i don't call this procedure in any of my popup options. Does anyone have any idea of why it could fire by its own?
I can edit code if you want but idk it will be usefull as both procedure arent linked x)
CODE
procedure TBDDTool.pmDeleteColumnClick(Sender: TObject);
var
i: integer;
sListColNames : string;
begin
fileModified := true;
sListColNames := '';
//Increment undo number
Inc(undoNum);
if undoNum = 11 then
begin
for i := 0 to Length(UndoArray) - 1 do
begin
if i < Length(UndoArray)-1 then
UndoArray[i] := UndoArray[i+1];
end;
undoNum := UndoNum -1;
end;
//Add action to the array of undo actions
undoArray[undoNum] := 'Deleted column:' + IntToStr(sgFilePreview.Col)
+'$'+aSourceData[0,sgFilePreview.Col] + '#deleted';
pmUndo.Enabled := true;
if (Pos('#primarykeypk', aSourceData[0, sgFilePreview.Col]) <> 0) then
begin
aSourceData[0,sgFilePreview.Col] := COPY(aSourceData[0,sgFilePreview.Col], 0, Pos('#primarykey', aSourceData[0, sgFilePreview.Col])-1);
pmPrimaryKey.Enabled := true;
end;
if (Pos('#', aSourceData[0, sgFilePreview.Col]) <> 0) then
aSourceData[0,sgFilePreview.Col] := COPY(aSourceData[0,sgFilePreview.Col], 0, Pos('#', aSourceData[0, sgFilePreview.Col])-1);
for i := 0 to Length(aSourceData[0])-1 do
begin
if aSourceData[0,i] = sgFilePreview.Cells[sgFilePreview.Col, 0] then
begin
aSourceData[0,i] := aSourceData[0,i] + '#deleted';
Break;
end;
end;
//just set col width to 0 to hide it but we need the index
sgFilePreview.ColWidths[sgFilePreview.Col] := 0;
end;
//Custom split method
function TBDDTool.Explode(const Separator, s: String;
Limit: Integer): TStringDynArray;
var
SepLen: Integer;
F, P: PChar;
ALen, Index: Integer;
begin
SetLength(Result,0);
//if the word passed is empty there's no need to continue
if (S = '') or (Limit < 0) then Exit;
if Separator = '' then
begin
SetLength(Result, 1);
Result[0] := S;
Exit;
end;
//Set to the length of the separator
SepLen := Length(Separator);
ALen := Limit;
SetLength(Result, ALen);
Index := 0;
P := PChar(s);
While P^ <> #0 do
begin
F := P;
P := AnsiStrPos(P,PChar(Separator));
if (P = nil) OR ((Limit > 0) AND (Index = Limit -1)) then P := StrEnd(F);
if Index >= ALen then
begin
Inc(ALen,5);
SetLength(Result, ALen);
end;
SetString(Result[Index], F, P-F);
INC(Index);
if p^ <> #0 then Inc(P,SepLen);
end;
if index < ALen then SetLength(Result, Index);
end;
The explode functions is called when i click delet option (from a popup menu). But i don't call the explode function in my delete procedure. The break happens on while P^ <> #0 line
Is it possible, in delphi, that a procedure fires without being called?
Generally speak, it is not possible. If code executes, something in the system made it execute.
However, it is possible that you have somehow corrupted memory. That in turn may lead to you calling one function and the corruption leading to a different function being called.
In order to debug this I suggest that you first of all inspect the call stack when the unexpected function begins executing. That should tell you how the execution reached that point. If that's not enough to explain things, cut your code down to the bare minimum that produces the problem. It's harder to find problems when there's lots of code. By cutting down to a minimum, you'll make it easier to see what has gone wrong.
I'm playing around with the comp 1 pre release material, but I can't seem to asnwer this properly in Pascal compiling in delphi...
This question refers to the function RollBowlDie.
This function has no validation of the input value.
What you have to do....
Make a copy of the Skeleton Program. Add additional statements to the function RollBowlDie so that it ensures that the input BowlDieResult is in the range 1 to 6 before allowing the game to continue and outputs an error message if not.
Add further statements to the function RollBowlDie so that it also checks that the input
BowlDieResult does not cause the program to crash if it is the wrong data type and instead outputs an error message when this is detected.
Test the amended function to show that it does not allow inputs that are out of range.
Test the amended function to show that it does not crash if an incorrect data type is added.
This is the RollBowlDie function.
Function RollBowlDie(VirtualDiceGame : Boolean) : Integer;
Var
BowlDieResult : Integer;
Begin
If VirtualDiceGame
Then BowlDieResult := Random(6) + 1
Else
Begin
Writeln('Please roll the bowling die and then enter your result.');
Writeln;
Writeln('Enter 1 if the result is a 1');
Writeln('Enter 2 if the result is a 2');
Writeln('Enter 3 if the result is a 4');
Writeln('Enter 4 if the result is a 6');
Writeln('Enter 5 if the result is a 0');
Writeln('Enter 6 if the result is OUT');
Writeln;
Write('Result: ');
Readln(BowlDieResult);
Writeln;
End;
RollBowlDie := BowlDieResult;
End;
I have tried putting this in, but the message error message didnt come up, and the program crashed when trying in a letter.
Function RollBowlDie(VirtualDiceGame : Boolean) : Integer;
Var
BowlDieResult : Integer;
Begin
If VirtualDiceGame
Then BowlDieResult := Random(6) + 1
Else
Begin
Repeat
Writeln('Please roll the bowling die and then enter your result.');
Writeln;
Writeln('Enter 1 if the result is a 1');
Writeln('Enter 2 if the result is a 2');
Writeln('Enter 3 if the result is a 4');
Writeln('Enter 4 if the result is a 6');
Writeln('Enter 5 if the result is a 0');
Writeln('Enter 6 if the result is OUT');
Writeln;
Write('Result: ');
Try
Readln(BowlDieResult)
Except
Writeln('Not a valid number')
End;
Writeln;
Until (BowlDieResult >= 1) and (BowlDieResult <= 6);
End;
RollBowlDie := BowlDieResult;
End;
I's not sure how to solve the question, any help would be appreciated greatly!
Probably you need to read a string or a char-typed variable instead of an integer one, and then convert the string/char to integer in an controlled way.
Of course it crashes if you type in a letter ... you're specifically asking to
read an integer, and a letter isn't an integer.
Before commenting more on that issue, why not just say:
writeln ('Please enter the number rolled, or 0 if it is an OUT: ');
rather than having 6 writelns? Also, what if a 3 or 5 was rolled (you're only
giving (somewhat odd) directions for the values 1, 2, 4, 6, and 0 ... leaving
out 3 and 5. Keep in mind that you can't get a 0 from "BowlDieResult := Random(6) + 1".
How do you intend the user to indicate "stop" if you're looping until you have
a value between 1 and 6?
Back to the "how do I read a letter" question...
Use a variable of type "char" (or "packed array of char") to read arbitrary text ...
then, compare the character read to '1', '2', ..., '6', or (say) 'Q' (for Quit).
E.g.:
var
answer : char;
attempts : integer; {prevent infinite loop}
done : boolean;
attempts := 0;
saw_quit := false;
done := false; {loop until we get a good number or a QUIT command}
{Or until 9 attempts have been made to enter a #. }
while not done do
begin
writeln ('Please enter a number (1..6) or Q to quit: ');
readln (answer);
if answer in ['1'..'6'] then
begin {we got a number in range 1..6...}
BowlDieResult := ord (answer) - ord ('0'); {convert char to int}
done := true;
end
else if answer in ['Q', 'q'] then {upper or lower case :) }
begin
saw_quit := true;
done := true;
end
else
begin
writeln ('Sorry, that is not a number from 1 to 6 or a "Q"!');
attempts := attempts + 1;
if attempts > 9 then
begin
writeln ('Sorry, too many mistakes ... assuming QUIT');
saw_quit := true;
done := true;
end;
end;
end; {while not done}
Note: the above not tested for compilation ... I NEVER use Pascal's built-in I/O,
for performance and reliability reasons, so I'm rusty with it.
Note: see http://www.allegro.com/papers/htpp.html
for some philosophy of Pascal programming.
Stan