User-defined procedures are also built and declared by the user in a particular script. They can be declared at the beginning of the script window, above the first line of the initial skeleton that is provided by the script engine,

The basic structure of a user-defined procedure is the same as that of the initial skeleton that is provided by the script engine.

While a user-defined procedure can have arguments, it is not always the case, as is illustrated below.

procedure ProcedureName;
begin
// This procedure outputs a message to the Statelake Logs
LogInfo(‘Output from ProcedureWithNoArguments’);
end;

Where there are arguments, each argument is declared as a name and data type pair (named pair or couplet), separated by a colon. Successive argument declarations are separated by semi-colons, while the argument list is wrapped in parentheses ( ). As above, these parentheses can be omitted if there are no arguments. When the procedure is called, each argument declaration is replaced by a variable, or by an expression, and successive arguments are separated by commas.

procedure CustomBuilt(MyMessage:string;Index,Count:integer);

If an argument declaration is prefixed by the var keyword, then the value of that argument will be available to the script fragment that called the procedure, after the procedure has been executed. It must be represented by a declared variable when the procedure is called – it cannot be an expression, because an expression cannot receive a value back from the procedure.

procedure CustomBuilt(var MyMessage:string;Index,Count:integer);

Without this var keyword, an argument’s value is only for input to the procedure and any changes to its value will not be passed back out.

A user-defined procedure can have its own variables, declared between the procedure declaration line and the begin line, as described in the Declaring A Variable section, found in Variables.

Here are a few examples of different user-defined procedures, and their use . . . .

Test_CopyFile

A user-defined procedure that has no arguments.

procedure Test_CopyFile;
var
vFilePath, vFileName: string;
vCopiedOK: boolean;
begin
//split full file name into path and name portions ...
vFilePath := ExtractFilePath(Source.FileCon.CurrentFileName);
vFileName := ExtractFileName(Source.FileCon.CurrentFileName);
//place a copy of the file in a different directory ...
vCopiedOK := Source.FileCon.CopyFile(vFilePath + 'SpareCopy\', vFileName + '.copy');
if vCopiedOK then
LogInfo('Source file has been copied')
else
LogError('Error creating copy of file');
end;

DoLogInfo

A simple user-defined procedure with a single straight forward argument.

procedure DoLogInfo(const aActivityStr: string);
var
vInfoStr: string;
begin
vInfoStr := aActivityStr;
vInfoStr := vInfoStr + ' [Rec ' + IntToStr(SALESORD_HDR.RecordPosition);
vInfoStr := vInfoStr + ' of ' + IntToStr(SALESORD_HDR.RecordCount);
vInfoStr := vInfoStr + '; BOF=' + BoolToFloString(SALESORD_HDR.BOF);
vInfoStr := vInfoStr + '; EOF=' + BoolToFloString(SALESORD_HDR.EOF);
vInfoStr := vInfoStr + '; SEQNO=' + SALESORD_HDR['SEQNO'].AsString + ']';
LogInfo(vInfoStr);
end;
 
procedure ScriptEvent (var Value : variant);
var
vDataSet: TFloClientDataSet;
vInfoStr: string;
begin
LogInfo(''); // blank line
DoLogInfo('DataView opened');
SALESORD_HDR.Prior;
DoLogInfo('After .Prior after opening');
SALESORD_HDR.Last;
DoLogInfo('After .Last');
SALESORD_HDR.Next;
DoLogInfo('After .Next after .Last');
SALESORD_HDR.First;
DoLogInfo('After .First after .Next after .Last');
 
//and so on . . .
LogInfo('');
end;

Assert_FormatFloat_Integer

This user-defined procedure has several arguments.

procedure Assert_FormatFloat_Integer(const i: integer; const s, a: string);
var
// i: integer; //Integer value to be formatted
// s: string; //Format Specifier
// a: string; //Asserted output from FormatFloat function, for i and s
ff: string; //i formatted as per s
begin
ff := FormatFloat(s, i);
if (ff = a) then
LogInfo(Trim(IntToStr(i)) + ' via ' + s + ' outputs as ' + ff)
else
LogInfo(Trim(IntToStr(i)) + ' via ' + s + ' outputs as ' + ff + '; ** NOT ** as ' + a);
end;
 
procedure ScriptEvent (var Value : variant);
begin
//Examples for FormatFloat ...
LogInfo('');
Assert_FormatFloat_Integer(1, '#', '1');
Assert_FormatFloat_Integer(1, '0', '1');
LogInfo('');
//And so on . . .
end;

RemoveNonKeyboardChars

This user-defined procedure uses a var, and strips out any non-keyboard characters from the supplied string.

procedure RemoveNonKeyboardChars(var MyString:string);
var
OutStr : string;
C : integer;
begin
OutStr := '';
For C := 1 to length(MyString) do
begin
If ((Ord(MyString[c]) >= 32) and (Ord(MyString[c]) <= 126)) then
OutStr := OutStr + MyString[c];
//Else character is not a keyboard character, therefore SKIP
end;
MyString := OutStr; //Return the amended string
end;
 
procedure ScriptEvent (var Value : variant);
var
WhatName : string;
WhatName2 : string;
begin
LogInfo('');
WhatName := 'Line1 x βæ©';
WhatName2 := WhatName;
RemoveNonKeyboardChars(WhatName2);
LogInfo('Non-keyboard string is >>'+WhatName+'<<');
LogInfo('Keyboard string is >>'+WhatName2+'<<');
LogInfo('');
end;

ProcedureWithTwoArguments

A user-defined procedure with a var as one of two arguments.

procedure ProcedureWithTwoArguments(aValue1 : integer; var aValue2 : string);
var
MyProcVar : integer;
begin
aValue1 := aValue1 + 1; //not a “var” argument, so this changed value will not be returned ...
MyProcVar := aValue1; //... but within this procedure the changed value can be used
// whereas the returned value of “var” argument aValue2 will hold any change
aValue2 := aValue2 + ‘->’ + IntToStr(MyProcVar);
end;
 
procedure OnMapEvent(var Value:Variant); //FIELD1
var
myOneWayArgVar: integer;
myVarArgVar: string;
begin
myOneWayArgVar := 42;
myOneWayArgVar := myOneWayArgVar + 1; //now 43 within this OnMapEvent procedure
myVarArgVar := ‘abc’;
LogInfo(IntToStr(myOneWayArgVar) + ‘:’ + myVarArgVar); // outputs ’43:abc’
ProcedureWithTwoArguments(myOneWayArgVar, myVarArgVar);
LogInfo(IntToStr(myOneWayArgVar) + ‘:’ + myVarArgVar); // outputs ’43:abc->44’
end;

CompareRounding

This procedure allows you to compare the results from different numeric functions.

procedure CompareRounding(aValue: extended; aDigit: integer);
var
vInfoStr : string;
begin
vInfoStr := '';
//Select the vInfoStr line you want to COMPARE .... this time is Round2UP ....
//vInfoStr := vInfoStr + '( '+FloatToStr(aValue) + ',' + IntToStr(aDigit) + ') ->>> Int value of ' + FloatToStr(Int(aValue, aDigit)) + '; ';
//vInfoStr := vInfoStr + '( '+FloatToStr(aValue) + ',' + IntToStr(aDigit) + ') ->>> Trunc value of ' + FloatToStr(Trunc(aValue, aDigit)) + '; ';
//vInfoStr := vInfoStr + '( '+FloatToStr(aValue) + ',' + IntToStr(aDigit) + ') ->>> Round value of ' + FloatToStr(Round(aValue, aDigit)) + '; ';
//vInfoStr := vInfoStr + '( '+FloatToStr(aValue) + ',' + IntToStr(aDigit) + ') ->>> Round2 value of ' + FloatToStr(Round2(aValue, aDigit)) + '; ';
vInfoStr := vInfoStr + '( '+FloatToStr(aValue) + ',' + IntToStr(aDigit) + ') ->>> Round2UP value of ' + FloatToStr(Round2Up(aValue, aDigit)) + '; ';
//vInfoStr := vInfoStr + '( '+FloatToStr(aValue) + ',' + IntToStr(aDigit) + ') ->>> Round2BR value of ' + FloatToStr(Round2Up(aValue, aDigit)) + '; ';
LogInfo(vInfoStr);
end;
 
procedure ScriptEvent (var Value : variant);
begin
//Start the comparison between the specified core value to "x" decimal places, to the type selected
CompareRounding( 3.4 , 0);
CompareRounding( 3.5 , 0);
CompareRounding( 3.6 , 0);
CompareRounding( 4.4 , 0);
CompareRounding( 4.5 , 0);
CompareRounding( 4.6 , 0);
CompareRounding( 123.454 , 2);
CompareRounding( 123.455 , 2);
CompareRounding( 123.456 , 2);
CompareRounding( 123.4545, 3);
CompareRounding( 123.4546, 3);
CompareRounding( 123.4547, 3);
CompareRounding( 123.4548, 3);
CompareRounding( 123.4565, 3);
CompareRounding( 123.464 , 2);
CompareRounding( 123.465 , 2);
CompareRounding( 123.466 , 2);
CompareRounding( 123.455 , 2);
CompareRounding( 65.51 , 2);
CompareRounding( 8622.143 , 2);
CompareRounding( 7.74 , 2);
CompareRounding( 5.0 , 2);
CompareRounding(745.454,2);
CompareRounding(745.455,2);
CompareRounding(745.456,2);
CompareRounding(745.4566,2);
CompareRounding(745.4558,3);
CompareRounding(745.4553,3);
CompareRounding(745.554,2);
CompareRounding(745.555,2);
CompareRounding(745.556,2);
CompareRounding(745.5558,3);
CompareRounding(745.5553,3);
CompareRounding(745.5558,2);
CompareRounding(745.5553,2);
CompareRounding( 123.261 , 2);
CompareRounding( 123.262 , 2);
CompareRounding( 123.263 , 2);
CompareRounding( 123.264 , 2);
CompareRounding( 123.265 , 2);
CompareRounding( 123.266 , 2);
CompareRounding( 123.267 , 2);
CompareRounding( 123.268 , 2);
CompareRounding( 123.269 2);
CompareRounding( 123.371 , 2);
CompareRounding( 123.372 , 2);
CompareRounding( 123.373 , 2);
CompareRounding( 123.374 , 2);
CompareRounding( 123.375 , 2);
CompareRounding( 123.376 , 2);
CompareRounding( 123.377 , 2);
CompareRounding( 123.378 , 2);
CompareRounding( 123.379 , 2);
CompareRounding( 745.456 , 2);
CompareRounding( 123.376 , 2);
end;