report.pas

扫描软件

unit Report;
interface
uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls;
type










gstrasterisks : string;//----------------------------------------------------------
gstrdashes : string;








// left unchanged ==> public const info_in_file = 'the information has been captured in the file ';//----------------------------------------------------------




// left unchanged ==> public const line_length = 78           ;//print out line length.
// left unchanged ==> public const stritemno_length = 5       ;//column to hold line numbers.

public sub printreportheader(intfilenumber as integer, strheader as string, _
strsymbol : string,;







strleft : string;
strright : string;

writeln t #intfilenumber, ''//** strings
writeln t #intfilenumber, strsymbol
strleft := left(strsymbol, 1) + ' ';
strright := strheader;
call printreportwrapline(intfilenumber, strleft, strright, '\')
writeln t #intfilenumber, strsymbol

do until intfollowinglines = 0
writeln t #intfilenumber, ''
intfollowinglines := intfollowinglines - 1;
end; //End for For or Do => Next/Loop

end;

public sub printreportinitialheader(intfilenumber as integer, _
strreportfilefullpath : string);





strversion : string;




strversion := 'version ' + app.major & '.' & app.minor & '.' & app.revision;//----------------------------------------------------------




writeln t #intfilenumber, gstrasterisks//----------------------------------------------------------
writeln t #intfilenumber, '* ' + app.title
writeln t #intfilenumber, '*    ' + strversion
writeln t #intfilenumber, '*    ' + app.legalcopyright




call printreportwrapline(intfilenumber, '*    installed in:  ', gstrappdirectory, '\')//----------------------------------------------------------




writeln t #intfilenumber, gstrasterisks//----------------------------------------------------------
writeln t #intfilenumber, ''
writeln t #intfilenumber, gstrasterisks
writeln t #intfilenumber, '* report information'
writeln t #intfilenumber, '*    date:  ' + format$(now, 'long date')
writeln t #intfilenumber, '*    time:  ' + format$(now, 'h:mm:ss am/pm')




call printreportwrapline(intfilenumber, '*    name:  ', strreportfilefullpath, '\')//----------------------------------------------------------
writeln t #intfilenumber, gstrasterisks
writeln t #intfilenumber, ''

end;

public sub printreportwrapline(intfilenumber as integer, strleft as string, _
strright : string,;





intlinecounter : integer;
intstartposition : integer;
intsymbolposition : integer;

strleftlegend : string;
strpartialstring : string;
strworkingstring : string;

// try-except block should come here!!! => on error resume next






if  len(strleft) + len(strright) <= line_length  then
begin
writeln t #intfilenumber, strleft + strright//----------------------------------------------------------
// left unchanged ==> exit;
end; //Main if block






intlinecounter := 1;//----------------------------------------------------------
strworkingstring := strright;




do while strworkingstring <> ''//----------------------------------------------------------





if  len(strworkingstring) + len(strleft) > line_length  then
begin
strpartialstring := left(strworkingstring, line_length - len(strleft));//------------------------------------------------------









intstartposition := 1;//--------------------------------------------------
// left unchanged ==> do;
intsymbolposition := instr(intstartposition, strpartialstring, strsymbol);
if  intsymbolposition > 0  then
begin
intstartposition := intsymbolposition + 1;
end; //Main if block
loop until intsymbolposition = 0
strpartialstring := trim$(left(strworkingstring, intstartposition - 1));




else //------------------------------------------------------
strpartialstring := trim$(strworkingstring);
strworkingstring := '';
end; //Main if block





if  intlinecounter = 1  then
begin
strleftlegend := strleft;//------------------------------------------------------
intlinecounter := intlinecounter + 1;
else 
strleftlegend := left(strleft, 1) + space$(len(strleft) - 1);
end; //Main if block





writeln t #intfilenumber, strleftlegend + strpartialstring//------------------------------------------------------
if  strworkingstring <> ''  then
begin
strworkingstring := mid(strworkingstring, intstartposition);
end; //Main if block
end; //End for For or Do => Next/Loop

end;



end.