home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic 4 Unleashed
/
Visual_Basic_4_Unleashed_SAMS_Publishing_1995.iso
/
repease
/
dmo_dlp1.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-07-21
|
33KB
|
912 lines
unit Dmo_dlp1;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Menus;
{$I rep.pas ReportEase Plus constant and type declaration unit}
type
Tmain = class(TForm)
MainMenu1: TMainMenu;
Edit1: TMenuItem;
Run1: TMenuItem;
procedure Edit1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Run1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
main: Tmain;
{******************************************************************************
Global Constants for the Demo program
******************************************************************************}
const
MAX_FORMS =100;
MAX_FILES =2;
MAX_FIELDS =15;
ITEM_WIDTH =40;
{******************************************************************************
Global Structures for the Demo program
******************************************************************************}
type
StrDataFile = record { data file definition}
name: string[13]; { file name}
TotalFields: Integer;
end;
StrDataField = record { data field definition}
ShortName: string[15]; { data field nam}
FullName: string[35]; { field name with file prefi}
width: Integer; { display width of the fiel}
FieldType: Integer; { field type, see form.h file}
DecPlaces: Integer; { decimal places for numeric/floating field}
end;
StrBitmap = record { needed to use Windows API which use the BITMAP structure}
bmType: Integer;
bmWidth: Integer;
bmHeight: Integer;
bmWidthBytes: Integer;
bmPlanes: Byte;
bmBitsPixel: Byte;
bmBits: Pointer;
end;
{******************************************************************************
Global Variables for the Demo program
******************************************************************************}
var
FormParm: StrForm; { form designer argument structure}
RepParm: StrRep; { report executer argument structure}
FormName: array [0..MAX_FORMS+1] of string[NAME_WIDTH+2]; { list of avialable form name}
FormFile: array [0..MAX_FORMS+1] of string[13]; { list of avialable form file}
TotalForms, NewReport: Integer;
SelectedForm: Integer; { index of the selected form to edit or run }
GetSortField: WordBool;
CurFile: Integer; { currently selected data file}
CurField: Integer; { currently selected data field}
DataField: array [0..MAX_FILES, 0..MAX_FIELDS] of StrDataField;
DataFile: array [0..MAX_FILES] of StrDataFile;
{ fields to display a bitm}
logo: TBitmap; { bitmap object }
hLogoBM: THandle; { customer logo bitmap}
{*******************************************************************
Program Function declarations
*******************************************************************}
function GetFormSelection(var CurFile: string; FormEdit: WordBool): Integer;
procedure CallEditor;
Procedure GetFormFiles(template: string);
Procedure RunReport;
Procedure PrepareFile;
function ReadFields(idx: Integer): WordBool;
function ExtractField(line: pChar;var idx: integer;LineLen: Integer;var CharReturn: string): WordBool;
Procedure PrintRecords(field: PStrField; TotalFields: Integer);
function PStrTrim(InString: string): string;
{*******************************************************************
Callback Function declarations
*******************************************************************}
function UserFieldSelection(hWnd: THandle; var field: StrField; SortFieldNo: Integer): WordBool;export;
function VerifyField(var field: StrField; SortFieldNo: Integer): WordBool;export;
function MsgCallback(hWnd: THandle; msg: Integer): LongInt; export;
function DrawPicture(hDC: THandle; PictId, FileId, FieldId: Integer; var rect: TRect): WordBool; export;
implementation
uses dmo_dlp2,dmo_dlp3,dmo_dlp4;
{$R *.DFM}
{$I rep_prot.pas ReportEase Plus function prototypes}
procedure Tmain.FormCreate(Sender: TObject);
var
i: Integer;
begin
{ Initialize the form designer argument structure}
FormParm.open:=FALSE; { all windows closed in the beginnin}
FormParm.x:=0; { Initial X position of FORM edit windo}
FormParm.y:=0; { Initial Y position of FORM edit windo}
FormParm.width:=GetSystemMetrics(SM_CXSCREEN); { Initial edit window widt}
FormParm.height:=(GetSystemMetrics(SM_CYSCREEN)*9) div 10; { Initial edit window heigh}
FormParm.ShowMenu:=TRUE; { display men}
FormParm.ShowVerBar:=TRUE; { display vertical scroll ba}
FormParm.ShowHorBar:=TRUE; { display horizontal scroll bar (N/A with word wrap}
StrCopy(addr(FormParm.FileName),''); { Text file name if the input type is 'F}
FormParm.hInst:=hInstance; { Current application instant handl}
FormParm.hPrevInst:=hPrevInst; { Previous application instant handl}
FormParm.hParentWnd:=handle; { let this be the parent of the editor windo}
FormParm.style:=WS_OVERLAPPEDWINDOW; { Editor window styl}
StrCopy(addr(FormParm.DataSetName),'CUSTOMER');
{***** pass the pointer to the call back routine}
{ The field selection and verification routines must be included in the
export section of your applications definition file }
FormParm.UserSelection:=@UserFieldSelection; { field selection routin}
FormParm.VerifyField:=@VerifyField; { field verification routin}
{**** copy the parameters to the RepParam structure *******}
RepParm.hInst:=FormParm.hInst;
RepParm.hPrevInst:=FormParm.hPrevInst;
RepParm.hParentWnd:=FormParm.hParentWnd;
RepParm.style:=FormParm.style;
StrCopy(addr(RepParm.SwapDir),''); { screen page swap location}
RepParm.DrawPicture:=@DrawPicture; { picture drawing routine}
{********** read field name for the files *****************}
DataFile[0].name:='CUSTOMER';
DataFile[1].name:='SALES';
for i:=0 to MAX_FILES-1 do
begin
if (ReadFields(i)=False) then exit;
end;
{ load the customer logo bitmap}
logo:=TBitmap.Create;
logo.LoadFromFile('logo.bmp');
hLogoBM:=logo.handle;
if (hLogoBM = 0) then
begin
ShowMessage('Error loading the logo bitmap');
exit;
end;
end;
procedure Tmain.Edit1Click(Sender: TObject);
begin
if (FormParm.open) then ShowMessage('A Form Editor Window Already Open!')
else CallEditor; { call the form editor}
end;
{ ***********************************************************************
Select the form to edit and call the form editor
*************************************************************************}
procedure CallEditor;
var
ResultValue: Integer;
FormFileName: string;
TempString: string[80];
begin
if (GetFormSelection(FormFileName,TRUE)>=0) then { select a form file}
begin
{*** let form designer use the default fonts ******}
StrPCopy(FormParm.FileName,FormFileName);
FormParm.FontTypeFace[0]:=#0; { default font type faces for report}
ResultValue:=form(FormParm); { call the form editor }
RepSetMsgCallback(@MsgCallback);{set a callback function to receive the close message}
if (ResultValue<>0) then { print error if any }
begin
TempString:=format('Error calling the form editor, code: %d',[ResultValue]);
ShowMessage(TempString);
end;
end;
end;
{******************************************************************************
GetFormSelection:
Shows available report forms and let user select one.
In form edit mode, the user has two additional selections to
create a new report form.
******************************************************************************}
Function GetFormSelection(var CurFile: string; FormEdit: WordBool): Integer;
var
select: integer;
begin
TotalForms:=0;
CurFile:=' ';
GetFormFiles('*.FP'); { get the report form file}
if (FormEdit) then { allow the user to create new form}
begin
NewReport:=TotalForms; { append the new report selectio}
TotalForms:=TotalForms+1;
FormName[NewReport]:='New Report Form';
FormFile[NewReport]:=' ';
end
else NewReport:=TotalForms;
{***** show the file seletion box and let user select a file ***}
SelectedForm:=-1;
FormSel.ShowModal;
if (SelectedForm >= 0) then
begin
CurFile:='';
if (SelectedForm<>NewReport) then CurFile:=FormFile[SelectedForm]; { pass the file name}
end;
result:=SelectedForm;
end;
{******************************************************************************
GetFormFiles:
This routine scans the current directory for the files matching the
specified template.
******************************************************************************}
Procedure GetFormFiles(template: string);
var
done: Integer;
hdr: StrFormHdr;
blk: TSearchRec;
InFile : file;
BytesRead: Integer;
begin
done:=findfirst(template,faReadOnly,blk);
while(done=0) do
begin
if (TotalForms=MAX_FORMS) then break;
FormFile[TotalForms]:=blk.Name; { store the fiel name }
done:=findnext(blk); { get the next fill}
{*************** get the form name **************************}
AssignFile(InFile,FormFile[TotalForms]);
Reset(InFile,1);
BlockRead(InFile,hdr,sizeof(hdr),BytesRead);
CloseFile(InFile);
if (BytesRead<>sizeof(hdr)) or (hdr.FormSign<>FORM_SIGN ) then continue;
FormName[TotalForms]:=StrPas(hdr.name);
TotalForms := TotalForms + 1;
end;
end;
{*****************************************************************************
ReadFields:
Read the field definitions for a file. The argument specifies the index
into the DataFile structure.
The field definitions are stored in files with the extension .DF, whereas
the data is stored in the files with the extension .DB.
*****************************************************************************}
function ReadFields(idx: Integer): WordBool;
var
name: string[64];
line,CharReturn: string;
CurLen,CurField,LineIdx: Integer;
iStream: Text;
CLine: array [0..255] of char;
begin
CurField:=0;
name:=DataFile[idx].name + '.DF'; { add file extension}
AssignFile(iStream,name);
Reset(iStream);
while true do
begin
if (eof(iStream)) then break; { end of file}
{$I-}
Readln(iStream, line);
{$I+}
if (IOResult>0) then
begin
line:=format('Error while reading file %s ',[name]);
ShowMessage(line);
result:=FALSE;
exit;
end;
LineIdx:=0; { prepare to scan the lin}
CurLen:=length(line);
{ extract the field nam}
StrPCopy(CLine,line);
if (ExtractField(CLine,LineIdx,CurLen,CharReturn) = FALSE) then { extract field nam}
begin
line:=format('Invalid format, file: %s, field name',[name]);
ShowMessage(line);
result:=FALSE;
exit;
end;
{StringTrim(CharReturn); { trim spac}
DataField[idx][CurField].ShortName:=CharReturn;
DataField[idx][CurField].FullName:=DataFile[idx].name + '->' + CharReturn;
{ extract the field widt}
if (ExtractField(CLine,LineIdx,CurLen,CharReturn) = False) then { extract field nam}
begin
line:=format('Invalid format, file: %s, field width',[name]);
ShowMessage(line);
result:=FALSE;
exit;
end;
DataField[idx][CurField].width:=StrToInt(CharReturn);
{ extract the field typ}
if (ExtractField(CLine,LineIdx,CurLen,CharReturn) = False) then { extract field nam}
begin
line:=format('Invalid format, file: %s, field type',[name]);
ShowMessage(line);
result:=FALSE;
exit;
end;
if (CharReturn[1]='T') then DataField[idx][CurField].FieldType:=TYPE_TEXT
else if (CharReturn[1]='N') then DataField[idx][CurField].FieldType:=TYPE_NUM
else if (CharReturn[1]='F') then DataField[idx][CurField].FieldType:=TYPE_DBL
else if (CharReturn[1]='D') then DataField[idx][CurField].FieldType:=TYPE_DATE
else if (CharReturn[1]='L') then DataField[idx][CurField].FieldType:=TYPE_LOGICAL
else if (CharReturn[1]='P') then DataField[idx][CurField].FieldType:=TYPE_PICT
else
begin
line:=format('Invalid format, file: %s, field type(a)',[name]);
ShowMessage(line);
result:=FALSE;
exit;
end;
{ extract the default decimal place}
if (ExtractField(CLine,LineIdx,CurLen,CharReturn) = False) then { extract field nam}
begin
line:=format('Invalid format, file: %s, field DecPlaces',[name]);
ShowMessage(line);
result:=FALSE;
exit;
end;
DataField[idx][CurField].DecPlaces:=StrToInt(CharReturn);
CurField:=CurField+1;
end;
{END FILE}
CloseFile(iStream);
DataFile[idx].TotalFields:=CurField;
result:=TRUE;
end;
{******************************************************************************
ExtractField:
This routine scans a text line to extract the next field.
The fields are assumed to be of character type.
******************************************************************************}
function ExtractField(line: pChar;var idx: integer;LineLen: Integer;var CharReturn: string): WordBool;
var
quote,comma,SaveChar,space: char;
ptr: pChar;
TempString: array [0..255] of char;
i,j: Integer;
begin
result:=False; { Initialize the result value}
quote:='"';
comma:=',';
space:=' ';
i:=idx;
while ((i<LineLen) and (line[i]=space)) do i := i+1; { go past the space}
if (i>=LineLen) then exit; { past the end of the lin}
if (line[i]=quote) then
begin
i := i+1; { skip over the first quot}
ptr:=StrScan(addr(line[i]),quote);
if (ptr=nil) then exit;
j:=1;
while ((ptr[j]<>',') and (ptr[j]<>#0)) do j:=j+1;{ locate the next comm}
SaveChar:=ptr[0]; { extract the strin}
ptr[0]:=#0;
StrECopy(TempString,addr(line[i]));
ptr[0]:=SaveChar;
idx:=i+strlen(TempString)+1+j; { index to the next field }
end
else
begin
ptr:=StrScan(addr(line[i]),comma);
if (nil=ptr) then ptr:=addr(line[LineLen]); { field spans the end of the lin}
SaveChar:=ptr[0]; { extract the strin}
ptr[0]:=#0;
strECopy(TempString,addr(line[i]));
ptr[0]:=SaveChar;
idx:=i+strlen(TempString)+1; { index to the next field }
end;
CharReturn:=StrPas(TempString);
result:=TRUE;
end;
{*******************************************************************
Report Executer Interface
*******************************************************************}
procedure Tmain.Run1Click(Sender: TObject);
begin
if (FormParm.open) then ShowMessage('A Form Editor Window Already Open!')
else RunReport; { call the report executer}
end;
{*****************************************************************************
RunReport: The following routines demonstrate the process of calling the
report executor.
*****************************************************************************}
Procedure RunReport;
var
FormFileName: string;
begin
if (GetFormSelection(FormFileName,FALSE)>=0) then { select a form file}
begin
{******** Initialize the argument parameters *************}
StrPCopy(RepParm.FileName,FormFileName);
RepParm.device:='A'; { ask user}
RepParm.x:=FormParm.x; { specify the window coordinates for screen outpu}
RepParm.y:=FormParm.y; { these fields needed only for screen outpu}
RepParm.width:=FormParm.width;
RepParm.height:=FormParm.height;
if (RepInit(RepParm)<>0) then exit;{ Intialize the repor}
PrepareFile; { sort and join files if needed }
PrintRecords(RepParm.field,RepParm.TotalFields); { read and print each recor}
RepExit; { print footers and exi}
end;
end;
{*****************************************************************************
PrepareFile: Sort and join the CUSTOMER and SALES files if needed.
*****************************************************************************}
function FileJoin(InputFile1: pChar; CommonField1: integer; InputFile2: pChar; CommonField2: Integer;
OutputFile: pChar): Integer; far; external 'util';
function FileSort(InputFile: pChar; FieldCount: Integer; SortFields: Pointer): Integer; far;
external 'util';
Procedure PrepareFile;
var
i: Integer;
SalesFileUsed: WordBool;
SortKey: Array [0..9] of Integer;
InputFile1,InputFile2,OutputFile: array [0..79] of char;
CString1, CString2: array [0..79] of char;
begin
{ Sort the Customer.DB file}
StrPCopy(InputFile1,DataFile[0].name + '.DB');
for i:=0 to RepParm.TotalSortFields-1 do { extract each sort fiel}
begin
SortKey[i]:=RepParm.SortField^[i].FieldId+1;
end;
FileSort(InputFile1,RepParm.TotalSortFields,addr(SortKey));
{ the output is in the CUSTOMER.SRT file}
{ Determine if the sales file is use}
SalesFileUsed:=FALSE;
for i:=0 to RepParm.TotalFields-1 do
begin
if (RepParm.field^[i].FileId=1) then { id =0 is customer file, and }
begin { id=1 is the sales file, }
{ see the UserFieldSeletion routine }
SalesFileUsed:=TRUE;
break;
end;
end;
if (SalesFileUsed) then { join SALES file with CUSTOMER FIL}
begin
StrPCopy(InputFile1,DataFile[0].name + '.SRT');{ first file}
StrPCopy(InputFile2,DataFile[1].name + '.DB'); {second file}
StrPCopy(OutputFile,DataFile[0].name + '.SRT');{ output file}
FileJoin(InputFile1,1,InputFile2,1,OutputFile);
{ customer and sales file have field number 1 in common. The output
is stored in the "CUSTOMER.SRT file.}
end;
end;
{*****************************************************************************
PrintRecords:
This routine follows these step:
1. Open the data set file.
2. For each record of data set:
a. Initialize the fields in the field structure. IMPORTANT: Initialize
only the fields where source := SRC_APPL. All other fields are
for internal use of ReportEase.
b. Parse each field from the data record and stuff into the
field structure. One field may be stuffed in more than one
place in field structure. Stuff only those structure fields where
source := SRC_APPL
c. Call the RepRec routine to print this record.
This routine returns a TRUE value after all records are printed. If
the user hit escape during printing, then the return result will be a FALSE
value.
*****************************************************************************}
Procedure PrintRecords(field: PStrField; TotalFields: Integer);
var
iStream: Text;
i,CurLen,FileNo,FieldNo,RecNo,LineIdx: Integer;
DataSetName: string[64];
line,TempString: string[255];
CString1: array [0..255] of char;
CLine: array [0..1000] of char;
EndOfLine: WordBool;
label READ_LINE;
label END_FILE;
begin
RecNo:=1;
{** open the data set file ***}
DataSetName:=DataFile[0].name + '.SRT';
AssignFile(iStream,DataSetName);
Reset(iStream);
READ_LINE:
if (eof(iStream)) then goto END_FILE; {end of file}
CLine[0]:=#0; { reset the line buffer }
CurLen:=0;
EndOfLine:=False;
{ Read a text line - accomodate for lines longer than 255 }
while (True) do
begin
Read(iStream,line);
StrPCopy(Addr(CLine[CurLen]),line);
CurLen := CurLen + length(line);
if (eoln(iStream)) then
begin
ReadLn(iStream,line); {go past new line character}
break;
end;
end;
{********* initialize the field structure *************}
for i:=0 to TotalFields-1 do
begin
if (field^[i].source=SRC_APPL) then
begin
if (field^[i].FieldType=TYPE_TEXT) then field^[i].CharData[0]:=#0;
if (field^[i].FieldType=TYPE_NUM) then field^[i].NumData:=0;
if (field^[i].FieldType=TYPE_PICT) then field^[i].NumData:=0;
if (field^[i].FieldType=TYPE_DBL) then field^[i].DblData:=0;
end;
end;
{*********** parse the record to get each field ********}
FileNo:=0;
FieldNo:=0;
LineIdx:=0; { prepare to scan the lin}
while (TRUE) do
begin
{ extract the field}
if (ExtractField(CLine,LineIdx,CurLen,TempString)=False) then break;
if (FileNo>=MAX_FILES) then
begin
line:=format('Too many fields in the data record number: %d',[RecNo]);
ShowMessage(line);
goto END_FILE;
end;
{ stuff this field into the field structur}
for i:=0 to TotalFields-1 do
begin
if ((field^[i].source=SRC_APPL)
and (field^[i].FileId=FileNo) and (field^[i].FieldId=FieldNo)) then
begin
if (field^[i].FieldType=TYPE_TEXT) then
begin
StrPCopy(CString1,TempString);
if (strlen(CString1)>field^[i].width) then CString1[field^[i].width]:=#0; { truncate oversize data}
StrCopy(field^[i].CharData,CString1);
end;
if (field^[i].FieldType=TYPE_NUM) then
field^[i].NumData:=StrToInt(PStrTrim(TempString));
if (field^[i].FieldType=TYPE_DBL) then
field^[i].DblData:=StrToFloat(PStrTrim(TempString));
if (field^[i].FieldType=TYPE_DATE) then
field^[i].NumData:=StrToInt(PStrTrim(TempString)); { date in YYMMDD or YYYYMMDD}
if (field^[i].FieldType=TYPE_PICT) then
field^[i].NumData:=StrToInt(PStrTrim(TempString)); { date in YYMMDD or YYYYMMDD}
if (field^[i].FieldType=TYPE_LOGICAL) then
begin
if ((TempString[1]='Y') or (TempString[1]='y'))
then field^[i].NumData:=1
else field^[i].NumData:=0;
end;
end;
end;
{ advance to the next field number}
FieldNo := FieldNo + 1;
if (FieldNo>=DataFile[FileNo].TotalFields) then
begin
FieldNo:=0;
FileNo := FileNo + 1;
end;
end;
if (RepRec<>0) then goto END_FILE; { print this record}
RecNo := RecNo + 1;
goto READ_LINE;
END_FILE:
CloseFile(iStream);
end;
{************************************************************************
Callback function
*************************************************************************}
{******** trap REP_CLOSE message ************}
function MsgCallback(hWnd: THandle; msg: Integer): LongInt;
begin
if (msg=REP_CLOSE) then FormParm.open:=FALSE;
end;
{*****************************************************************************
UserFieldSelection:
This routine is called by the FORM_FLD module to allow user to select
a data field. This routine can be programmed by your application in
any way as long as it returns the data about the selected field using
the argument pointer. If the user chose not to select a field after all,
the function should return with a FALSE value. Otherwise it should return
with a TRUE value.
In this routine, we will allow the user to first select a file, and
then select a field from the chosen file. The required data about the
selected field is filled into the 'field' structure. Your program may
also optionally fill other remaining 'field' structure variables.
The first parameter contains the handle of the Form Editor window.
The third parameter specifies the sort field number if this field will
be used for section breaks. If your application will not sort on all
fields, you can restrict the fields that can be selected by the user.
For non-sort fields, this paramter is set to 0. In this demo program,
we will allow only the fields from the primary file (CUSTOMER) to be
used as sort fields.
*****************************************************************************}
function UserFieldSelection(hWnd: THandle; var field: StrField; SortFieldNo: Integer): WordBool;
begin
result:=False;
CurFile:=-1;
CurField:=-1;
if (SortFieldNo=0) then GetSortField:=FALSE else GetSortField:=TRUE;
while CurField<0 do
begin
if (SortFieldNo=0) then
begin
FileSel.ShowModal; { let user select a data file}
if (CurFile<0) then exit;
end
else CurFile:=0; { Allow sort fields only from the customer fil}
{ SELECT FIELD}
FieldSel.ShowModal; { select a data field}
if ((CurField<0) and (GetSortField)) then exit;
end;
{ fill the required 'field' variable}
StrPCopy(field.name,DataField[CurFile][CurField].FullName); { field nam}
field.FieldType:=DataField[CurFile][CurField].FieldType; { alpha/num et}
field.width:=DataField[CurFile][CurField].width; { display widt}
field.DecPlaces:=DataField[CurFile][CurField].DecPlaces; { decimal places for displa}
{ specify new paragraph indicator field. Used only for a word/wrap
text type field}
field.ParaChar[0]:='|';
{***** fill up these OPTIONAL fields also. This information will be
used by our report executer demo program to identfy the
fields quickly. ****}
field.FileId:=CurFile; { Information onl}
field.FieldId:=CurField; { information onl}
result:=True;
end;
{*****************************************************************************
VerifyField:
This routine is called by the FORM1 module to validate a field. The field
name is given by the 'name' variable in the StrField structure. It
contains the full name including the file prefix (if your application allows
it). The input field is always in the upper case. The required data about the
current field is filled into the 'field' structure. Your program may
also optionally fill other remaining 'field' structure variables.
The second argument indicates if the field can be
used as a sort field. This parameter indicates the sort field number.
1 indicates the first sort field, 2 the second, ... A zero for this
field indicates a non-sort field. In this demo program, we will allow
only the fields from the primary file (CUSTOMER) to be used as sort fields.
The function returns TRUE if the field is valid, otherwise it returns
a FALSE value.
*****************************************************************************}
function VerifyField(var field: StrField; SortFieldNo: Integer): WordBool;
var
MaxFiles: Integer;
begin
result:=False;
if (SortFieldNo=0) then MaxFiles:=MAX_FILES
else MaxFiles:=1; { allow sort fields from the customer file onl}
for CurFile:=0 to MaxFiles-1 do
begin
for CurField:=0 to DataFile[CurFile].TotalFields-1 do
begin
if DataField[CurFile][CurField].FullName=StrPas(field.name) then
begin
{ fill up the mandatory data *}
field.FieldType:=DataField[CurFile][CurField].FieldType; { alpha/num et}
field.width:=DataField[CurFile][CurField].width; { display widt}
field.DecPlaces:=DataField[CurFile][CurField].DecPlaces; { decimal places for displa}
{***** fill up these OPTIONAL fields also. This information will be
used by our report executer demo program to identfy the
fields quickly. ****}
field.FileId:=CurFile; { Information onl}
field.FieldId:=CurField; { information onl}
result:=TRUE;
exit;
end;
if result then exit;
end;
if result then exit;
end;
result:=FALSE; { not a valid fiel}
end;
{*****************************************************************************
DrawPicture:
This routine is called by the report executor to draw a specified
picture type field. The first argument specifies the device context
of the reporting device. If the report output is directed to a printer,
this device context belongs to a printer, otherwise it specifies a
device context for a metafile. You application should draw the picture
on this device context within the specified rectangle (last argument).
The device context is in ANISOTROPIC mode. The resolution in the X and
Y direction is given by the UNITS_PER_INCH constant.
The second argument is the picture id. The third and fourth arguments
are the file and field id for the picture field.
The function returns TRUE if successful.
In this demo program, this routine draws a logo for a given picture id.
This program uses only one bitmap, and draws different part of the same
bitmap for different picture id.
*****************************************************************************}
function DrawPicture(hDC: THandle; PictId, FileId, FieldId: Integer; var rect: TRect): WordBool;
var
bm: StrBitmap;
SourceWidth,SourceX: Integer;
begin
result:=FALSE;
{ get the bitmap informati}
GetObject(hLogoBM,sizeof(StrBitmap),addr(bm));
{ Select part of the bitmap to display for this picture }
SourceWidth:=bm.bmWidth div 10; { divide picture into 10 equal parts}
if (PictId<1) then PictId:=1;
if (PictId>10) then PictId:=10;
SourceX:=SourceWidth*(PictId-1);
{ copy the bitmap}
StretchBlt(hDC,rect.left,rect.top,rect.right-rect.left,rect.bottom-rect.top,
logo.canvas.handle,SourceX,0,SourceWidth,bm.bmHeight,SRCCOPY);
result:=TRUE;
end;
{*******************************************************************
Helper routines
*******************************************************************}
{***********************************************************************
Trim the spaces from the left and right of a string
***********************************************************************}
function PStrTrim(InString: string): string;
var
i,len: Integer;
begin
{ trim the spaces from the beginning of the string}
len:=length(InString);
for i:=1 to len do
begin
if (InString[i]<>' ') then break;
end;
if (i>1) then delete(InString,1,i-1);
{trim the spaces from the end of the string }
len:=length(InString);
for i:=len downto 0 do
begin
if (InString[i]<>' ') then break;
end;
if (i<len) then delete(InString,i+1,len-i);
result:=InString;
end;
end.