Pascal Script Examples
Example of the month (design by contract)
Example of Stream and Store manipulation
Example of procedural OODesign
Example of prime number generator) and Beginners Choice
PHP كود :
http://wiki.lazarus.freepascal.org/Pascal_Script_Examples
Example of the month (design by contract)
PHP كود :
program LottoGeneratorService;
// lotto generator as servicelevel design by contract
// all globals should be eliminated, funcproof is LOTRANGE = 6 and sum of 21!
const LOTNUMB = 6;
LOTRANGE = 45;
type
TLottoList = array[1..LOTNUMB] of byte;
T_Status =(success, failure, pending);
function initArray(var larray: TLottoList): boolean;
var i: byte;
begin
for i:= 1 to LOTNUMB do
larray[i]:= 0;
result:= true
end;
procedure putNumbers(vrange: byte; var larray: TLottoList);
var ti, z, myrand, sum: byte;
dup: boolean;
begin
ti:= 1;
sum:= 0;
Randomize;
//precondition set by validation
if vrange < LOTNUMB then vrange:= 6;
repeat
myrand:= Random(vrange)+ 1;
dup:= false;
for z:= 1 to LOTNUMB do
if (larray[z] = myrand) then dup:= true;
if (not dup) then begin
larray[ti]:= myrand;
ti:= ti + 1;
sum:= sum + myrand
end;
//postcondition & proof
until ti = LOTNUMB + 1
writeln('sum of numbers: ' + intToStr(sum))
end;
procedure viewNumbers(larray: TLottoList);
var i: byte;
begin
for i:= 1 to LOTNUMB do
writeln(inttostr(i) +': '+inttostr(larray[i]))
end;
function startLottoService(lotrange: byte): T_Status;
var larray: TLottoList;
begin
result:= failure;
if initArray(larray) then begin
putNumbers(LOTRANGE, larray)
viewNumbers(larray);
result:= success
end;
end;
// main script
begin
//vlotrange:= strtoint(readln('how great is the range ?'));
if startLottoService(lotrange) = success then
writeln('lotto service get at: ' + Now) else
writeln('bad news from service: ' + Now)
end.
Example of Stream and Store manipulation
PHP كود :
//converts a text to a stream in a memo component
//the memo is the output file, loc's =44
program TextfromFile;
procedure stringtofile(acontent, afilename:string);
var fls: TFileStream;
begin
fls:= TFileStream.Create(afilename, fmOpenWrite or fmCreate);
try
// no no acontent[1]
fls.Write(acontent,length(acontent));
finally
fls.Free;
end
end;
function fileToString(afilename: string; var returnString: string): boolean;
var fls: TFileStream;
begin
result:= false;
if not fileExists(afilename) then exit;
fls:= TFileStream.Create(afilename, fmOpenRead or fmShareCompat);
try
if fls.size > 0 then begin
SetLength(returnString, fls.Size);
fls.Read(returnString,fls.Size);
result:= true;
end
finally
fls.Free;
end
end;
//main
var mystring: string;
begin
//clrscr;
if fileToString('readmefirst_maxbox.txt',mystring) then
showmessage(mystring)
//memo2.text:= mystring
end.
Example of procedural OODesign
PHP كود :
program OOP_design;
//example with objects and exception handling
//open a file, add a line, save to another file, show the result on the screen
//solution to pas_oodesign5.txt
//shows with .loadFromFile polymorphie
//add a second parameter file 'filename' at last in getFiletoStr(); loc's=57
function getFiletoStr(strObj: TStringList): TStringList;
begin
//strObj.loadfromfile()
result:= strObj;
with result do begin
clear;
loadFromFile('firstdemo.txt');
end
end;
procedure showFileonMemo(myfile: string);
var
Mst: TMemoryStream;
begin
Mst:= TMemoryStream.Create;
try
Mst.LoadFromFile(myfile);
Mst.Seek(0,0);
Memo2.Lines.LoadFromStream(Mst);
finally
Mst.Free;
end;
end;
//main topic
begin
//constructor
with getFileToStr(TStringList.create) do begin
//myFileStr:= getFileToStr(myFilestr);
add('new line in list');
SaveToFile('firstdemo2.txt')
showFileonMemo('firstdemo2.txt');
//destructor
Free;
end
end.
Example of prime number generator) and Beginners Choice
PHP كود :
program Primtester_2;
// simple primtester between range for perfomance- and filehandling
// has a function and procedure, no globals, locs = 62
// to teach the function with or without brake shows perfomance!
var
mylist: TStringlist;
beforetime, aftertime: string;
//timedelta: integer;
function checkPrim(acti: integer): boolean;
var
j: Integer;
isprim: boolean;
begin
isprim:= true;
for j:= 2 to round(sqrt(acti)) do
if ((acti mod j) = 0) then begin
isprim:= false
break
end;
result:= isprim;
end;
procedure testPrimNumbers(from_range, to_range: integer);
var acti, count: integer;
begin
count:= 0;
mylist:= TStringlist.create;
for acti:= from_range to to_range do begin
inc(acti)
//writeln('debug count'+inttostr(acti))
if checkprim(acti) then begin
inc(count)
mylist.add(inttostr(count) +':'+inttoStr(acti))
//writeln(inttostr(count) +':'+ inttostr(acti))
end
end
//insert new lines to an existing file-list
{mylist.LoadFromFile('primetest3.txt');}
//add a string to the end of list
{sl.Add('hell\*/bell');}
end;
//main script
begin
//irange:= strtoint(readln('how great is the range ?'));
//check time performance
beforetime:= now;
testPrimNumbers(20, 10000);
aftertime:= now;
writeln('start: '+ beforetime)
writeln('stop: ' + aftertime)
mylist.add(memo2.text)
mylist.savetoFile('primetest7.txt')
memo2.lines.loadfromFile('primetest7.txt')
mylist.free;
//orthogonal and idempotent
end.