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 >
Pascal/Delphi Source File  |  1995-07-21  |  33KB  |  912 lines
  1. unit Dmo_dlp1;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Menus;
  8.  
  9. {$I rep.pas ReportEase Plus constant and type declaration unit}
  10.  
  11. type
  12.   Tmain = class(TForm)
  13.     MainMenu1: TMainMenu;
  14.     Edit1: TMenuItem;
  15.     Run1: TMenuItem;
  16.     procedure Edit1Click(Sender: TObject);
  17.     procedure FormCreate(Sender: TObject);
  18.     procedure Run1Click(Sender: TObject);
  19.   private
  20.     { Private declarations }
  21.   public
  22.     { Public declarations }
  23.   end;
  24.  
  25. var
  26.   main: Tmain;
  27.  
  28. {******************************************************************************
  29.                       Global Constants for the Demo program
  30. ******************************************************************************}
  31.  
  32. const
  33.  
  34.   MAX_FORMS   =100;
  35.   MAX_FILES   =2;
  36.   MAX_FIELDS  =15;
  37.  
  38.   ITEM_WIDTH  =40;
  39.  
  40. {******************************************************************************
  41.                       Global Structures for the Demo program
  42. ******************************************************************************}
  43. type
  44.     StrDataFile = record          { data file definition}
  45.        name: string[13];          { file name}
  46.        TotalFields: Integer;
  47.     end;
  48.  
  49.  
  50.     StrDataField = record         { data field definition}
  51.        ShortName: string[15];     { data field nam}
  52.        FullName: string[35];      { field name with file prefi}
  53.        width: Integer;            { display width of the fiel}
  54.        FieldType: Integer;        { field type, see form.h file}
  55.        DecPlaces: Integer;        { decimal places for numeric/floating field}
  56.     end;
  57.  
  58.     StrBitmap = record            { needed to use Windows API which use the BITMAP structure}
  59.       bmType: Integer;
  60.       bmWidth: Integer;
  61.       bmHeight: Integer;
  62.       bmWidthBytes: Integer;
  63.       bmPlanes: Byte;
  64.       bmBitsPixel: Byte;
  65.       bmBits: Pointer;
  66.     end;
  67.  
  68.  
  69. {******************************************************************************
  70.                       Global Variables for the Demo program
  71. ******************************************************************************}
  72. var
  73.    FormParm: StrForm;                          { form designer argument structure}
  74.    RepParm: StrRep;                            { report executer argument structure}
  75.  
  76.    FormName: array [0..MAX_FORMS+1] of string[NAME_WIDTH+2]; { list of avialable form name}
  77.    FormFile: array [0..MAX_FORMS+1] of string[13]; { list of avialable form file}
  78.  
  79.    TotalForms, NewReport: Integer;
  80.    SelectedForm:  Integer;  { index of the selected form to edit or run }
  81.  
  82.    GetSortField: WordBool;
  83.    CurFile: Integer;         { currently selected data file}
  84.    CurField: Integer;        { currently selected data field}
  85.  
  86.  
  87.    DataField: array [0..MAX_FILES, 0..MAX_FIELDS] of StrDataField;
  88.    DataFile: array [0..MAX_FILES] of StrDataFile;
  89.  
  90.    { fields to display a bitm}
  91.  
  92.     logo: TBitmap;                  { bitmap object }
  93.     hLogoBM: THandle;               { customer logo bitmap}
  94.  
  95. {*******************************************************************
  96.     Program Function declarations
  97.  *******************************************************************}
  98. function GetFormSelection(var CurFile: string; FormEdit: WordBool): Integer;
  99. procedure CallEditor;
  100. Procedure GetFormFiles(template: string);
  101. Procedure RunReport;
  102. Procedure PrepareFile;
  103. function ReadFields(idx: Integer): WordBool;
  104. function ExtractField(line: pChar;var idx: integer;LineLen: Integer;var CharReturn: string): WordBool;
  105. Procedure PrintRecords(field: PStrField; TotalFields: Integer);
  106. function PStrTrim(InString: string): string;
  107.  
  108. {*******************************************************************
  109.     Callback Function declarations
  110.  *******************************************************************}
  111. function UserFieldSelection(hWnd: THandle; var field: StrField; SortFieldNo: Integer): WordBool;export;
  112. function VerifyField(var field: StrField; SortFieldNo: Integer): WordBool;export;
  113. function MsgCallback(hWnd: THandle; msg: Integer): LongInt; export;
  114. function DrawPicture(hDC: THandle; PictId, FileId, FieldId: Integer; var rect: TRect): WordBool; export;
  115.  
  116.  
  117. implementation
  118.  
  119. uses dmo_dlp2,dmo_dlp3,dmo_dlp4;
  120.  
  121. {$R *.DFM}
  122.  
  123. {$I rep_prot.pas ReportEase Plus function prototypes}
  124.  
  125. procedure Tmain.FormCreate(Sender: TObject);
  126. var
  127.     i: Integer;
  128. begin
  129.    { Initialize the form designer argument structure}
  130.     FormParm.open:=FALSE;           { all windows closed in the beginnin}
  131.     FormParm.x:=0;                  { Initial X position of FORM edit windo}
  132.     FormParm.y:=0;                  { Initial Y position of FORM edit windo}
  133.     FormParm.width:=GetSystemMetrics(SM_CXSCREEN);        { Initial edit window widt}
  134.     FormParm.height:=(GetSystemMetrics(SM_CYSCREEN)*9) div 10; { Initial edit window heigh}
  135.     FormParm.ShowMenu:=TRUE;        { display men}
  136.     FormParm.ShowVerBar:=TRUE;      { display vertical scroll ba}
  137.     FormParm.ShowHorBar:=TRUE;      { display horizontal scroll bar (N/A with word wrap}
  138.     StrCopy(addr(FormParm.FileName),''); { Text file name if the input type is 'F}
  139.     FormParm.hInst:=hInstance;      { Current application instant handl}
  140.     FormParm.hPrevInst:=hPrevInst;  { Previous application instant handl}
  141.     FormParm.hParentWnd:=handle;    { let this be the parent of the editor windo}
  142.     FormParm.style:=WS_OVERLAPPEDWINDOW; {  Editor window styl}
  143.     StrCopy(addr(FormParm.DataSetName),'CUSTOMER');
  144.  
  145.  
  146.     {***** pass the pointer to the call back routine}
  147.     { The field selection and verification routines must be included in the
  148.         export section of your applications definition file }
  149.  
  150.  
  151.     FormParm.UserSelection:=@UserFieldSelection; { field selection routin}
  152.     FormParm.VerifyField:=@VerifyField;          { field verification routin}
  153.  
  154.  
  155.  
  156.     {**** copy the parameters to the RepParam structure *******}
  157.     RepParm.hInst:=FormParm.hInst;
  158.     RepParm.hPrevInst:=FormParm.hPrevInst;
  159.     RepParm.hParentWnd:=FormParm.hParentWnd;
  160.     RepParm.style:=FormParm.style;
  161.     StrCopy(addr(RepParm.SwapDir),'');  { screen page swap location}
  162.  
  163.     RepParm.DrawPicture:=@DrawPicture; { picture drawing routine}
  164.  
  165.     {********** read field name for the files *****************}
  166.     DataFile[0].name:='CUSTOMER';
  167.     DataFile[1].name:='SALES';
  168.  
  169.     for i:=0 to MAX_FILES-1 do
  170.     begin
  171.        if (ReadFields(i)=False) then exit;
  172.     end;
  173.  
  174.     { load the customer logo bitmap}
  175.     logo:=TBitmap.Create;
  176.     logo.LoadFromFile('logo.bmp');
  177.     hLogoBM:=logo.handle;
  178.     if (hLogoBM = 0) then
  179.     begin
  180.       ShowMessage('Error loading the logo bitmap');
  181.       exit;
  182.     end;
  183.  
  184.  
  185. end;
  186.  
  187. procedure Tmain.Edit1Click(Sender: TObject);
  188. begin
  189.    if (FormParm.open) then ShowMessage('A Form Editor Window Already Open!')
  190.    else CallEditor;     { call the form editor}
  191. end;
  192.  
  193.  
  194. { ***********************************************************************
  195.    Select the form to edit and call the form editor
  196. *************************************************************************}
  197. procedure CallEditor;
  198. var
  199.     ResultValue: Integer;
  200.     FormFileName: string;
  201.     TempString: string[80];
  202. begin
  203.  
  204.     if (GetFormSelection(FormFileName,TRUE)>=0) then {  select a form file}
  205.     begin
  206.        {*** let form designer use the default fonts ******}
  207.        StrPCopy(FormParm.FileName,FormFileName);
  208.        FormParm.FontTypeFace[0]:=#0;   { default font type faces for report}
  209.  
  210.        ResultValue:=form(FormParm);    { call the form editor }
  211.        RepSetMsgCallback(@MsgCallback);{set a callback function to receive the close message}
  212.  
  213.        if (ResultValue<>0) then       { print error if any }
  214.        begin
  215.           TempString:=format('Error calling the form editor, code: %d',[ResultValue]);
  216.           ShowMessage(TempString);
  217.        end;
  218.     end;
  219. end;
  220.  
  221. {******************************************************************************
  222.     GetFormSelection:
  223.     Shows available report forms and let user select one.
  224.     In form edit mode, the user has two additional selections to
  225.     create a new report form.
  226. ******************************************************************************}
  227. Function GetFormSelection(var CurFile: string; FormEdit: WordBool): Integer;
  228. var
  229.      select: integer;
  230. begin
  231.  
  232.      TotalForms:=0;
  233.  
  234.      CurFile:=' ';
  235.  
  236.      GetFormFiles('*.FP');          { get the report form file}
  237.  
  238.      if (FormEdit) then                { allow the user to create new form}
  239.      begin
  240.          NewReport:=TotalForms;      { append the new report selectio}
  241.          TotalForms:=TotalForms+1;
  242.          FormName[NewReport]:='New Report Form';
  243.          FormFile[NewReport]:=' ';
  244.      end
  245.      else NewReport:=TotalForms;
  246.  
  247.      {***** show the file seletion box and let user select a file ***}
  248.      SelectedForm:=-1;
  249.      FormSel.ShowModal;
  250.     
  251.      if (SelectedForm >= 0) then
  252.      begin
  253.         CurFile:='';
  254.         if (SelectedForm<>NewReport) then CurFile:=FormFile[SelectedForm];  { pass the file name}
  255.      end;
  256.  
  257.      result:=SelectedForm;
  258. end;
  259. {******************************************************************************
  260.     GetFormFiles:
  261.     This routine scans the current directory for the files matching the
  262.     specified template.
  263. ******************************************************************************}
  264. Procedure GetFormFiles(template: string);
  265. var
  266.     done: Integer;
  267.     hdr: StrFormHdr;
  268.     blk: TSearchRec;
  269.     InFile : file;
  270.     BytesRead: Integer;
  271. begin
  272.  
  273.     done:=findfirst(template,faReadOnly,blk);
  274.  
  275.     while(done=0) do
  276.     begin
  277.        if (TotalForms=MAX_FORMS) then break;
  278.  
  279.        FormFile[TotalForms]:=blk.Name;   { store the fiel name }
  280.        done:=findnext(blk);              { get the next fill}
  281.  
  282.        {*************** get the form name **************************}
  283.        AssignFile(InFile,FormFile[TotalForms]);
  284.        Reset(InFile,1);
  285.  
  286.        BlockRead(InFile,hdr,sizeof(hdr),BytesRead);
  287.        CloseFile(InFile);
  288.  
  289.        if (BytesRead<>sizeof(hdr)) or (hdr.FormSign<>FORM_SIGN ) then continue;
  290.  
  291.        FormName[TotalForms]:=StrPas(hdr.name);
  292.        TotalForms := TotalForms + 1;
  293.     end;
  294. end;
  295.  
  296. {*****************************************************************************
  297.     ReadFields:
  298.     Read the field definitions for a file.  The argument specifies the index
  299.     into the DataFile structure.
  300.     The field definitions are stored in files with the extension .DF, whereas
  301.     the data is stored in the files with the extension .DB.
  302. *****************************************************************************}
  303. function ReadFields(idx: Integer): WordBool;
  304. var
  305.     name: string[64];
  306.     line,CharReturn: string;
  307.     CurLen,CurField,LineIdx: Integer;
  308.     iStream: Text;
  309.     CLine: array [0..255] of char;
  310.  
  311. begin
  312.  
  313.     CurField:=0;
  314.     name:=DataFile[idx].name + '.DF';  { add file extension}
  315.  
  316.     AssignFile(iStream,name);
  317.     Reset(iStream);
  318.  
  319.     while true do
  320.     begin
  321.  
  322.     if (eof(iStream)) then break;  { end of file}
  323.     {$I-}
  324.     Readln(iStream, line);
  325.     {$I+}
  326.  
  327.     if (IOResult>0) then
  328.     begin
  329.        line:=format('Error while reading file %s ',[name]);
  330.        ShowMessage(line);
  331.        result:=FALSE;
  332.        exit;
  333.     end;
  334.  
  335.     LineIdx:=0;                       { prepare to scan the lin}
  336.     CurLen:=length(line);
  337.  
  338.     { extract the field nam}
  339.     StrPCopy(CLine,line);
  340.     if (ExtractField(CLine,LineIdx,CurLen,CharReturn) = FALSE) then { extract field nam}
  341.     begin
  342.        line:=format('Invalid format, file: %s, field name',[name]);
  343.        ShowMessage(line);
  344.        result:=FALSE;
  345.        exit;
  346.     end;
  347.  
  348.     {StringTrim(CharReturn);              { trim spac}
  349.     DataField[idx][CurField].ShortName:=CharReturn;
  350.     DataField[idx][CurField].FullName:=DataFile[idx].name + '->' + CharReturn;
  351.  
  352.     { extract the field widt}
  353.     if (ExtractField(CLine,LineIdx,CurLen,CharReturn) = False) then { extract field nam}
  354.     begin
  355.        line:=format('Invalid format, file: %s, field width',[name]);
  356.        ShowMessage(line);
  357.        result:=FALSE;
  358.        exit;
  359.     end;
  360.     DataField[idx][CurField].width:=StrToInt(CharReturn);
  361.  
  362.     { extract the field typ}
  363.     if (ExtractField(CLine,LineIdx,CurLen,CharReturn) = False) then { extract field nam}
  364.     begin
  365.        line:=format('Invalid format, file: %s, field type',[name]);
  366.        ShowMessage(line);
  367.        result:=FALSE;
  368.        exit;
  369.     end;
  370.  
  371.     if      (CharReturn[1]='T') then DataField[idx][CurField].FieldType:=TYPE_TEXT
  372.     else if (CharReturn[1]='N') then DataField[idx][CurField].FieldType:=TYPE_NUM
  373.     else if (CharReturn[1]='F') then DataField[idx][CurField].FieldType:=TYPE_DBL
  374.     else if (CharReturn[1]='D') then DataField[idx][CurField].FieldType:=TYPE_DATE
  375.     else if (CharReturn[1]='L') then DataField[idx][CurField].FieldType:=TYPE_LOGICAL
  376.     else if (CharReturn[1]='P') then DataField[idx][CurField].FieldType:=TYPE_PICT
  377.     else
  378.     begin
  379.        line:=format('Invalid format, file: %s, field type(a)',[name]);
  380.        ShowMessage(line);
  381.        result:=FALSE;
  382.        exit;
  383.     end;
  384.  
  385.     { extract the default decimal place}
  386.     if (ExtractField(CLine,LineIdx,CurLen,CharReturn) = False) then { extract field nam}
  387.     begin
  388.        line:=format('Invalid format, file: %s, field DecPlaces',[name]);
  389.        ShowMessage(line);
  390.        result:=FALSE;
  391.        exit;
  392.     end;
  393.     DataField[idx][CurField].DecPlaces:=StrToInt(CharReturn);
  394.  
  395.     CurField:=CurField+1;
  396.  
  397.     end;
  398.  
  399.     {END FILE}
  400.     CloseFile(iStream);
  401.     DataFile[idx].TotalFields:=CurField;
  402.  
  403.     result:=TRUE;
  404. end;
  405.  
  406. {******************************************************************************
  407.     ExtractField:
  408.     This routine scans a text line to extract the next field.
  409.     The fields are assumed to be of character type.
  410. ******************************************************************************}
  411. function ExtractField(line: pChar;var idx: integer;LineLen: Integer;var CharReturn: string): WordBool;
  412. var
  413.   quote,comma,SaveChar,space: char;
  414.   ptr: pChar;
  415.   TempString: array [0..255] of char;
  416.   i,j: Integer;
  417. begin
  418.  
  419.     result:=False;                        { Initialize the result value}
  420.     quote:='"';
  421.     comma:=',';
  422.     space:=' ';
  423.  
  424.     i:=idx;
  425.     while ((i<LineLen) and (line[i]=space)) do i := i+1;  { go past the space}
  426.  
  427.     if (i>=LineLen) then exit;             { past the end of the lin}
  428.  
  429.     if (line[i]=quote) then
  430.     begin
  431.        i := i+1;                                 { skip over the first quot}
  432.        ptr:=StrScan(addr(line[i]),quote);
  433.        if (ptr=nil) then exit;
  434.  
  435.        j:=1;
  436.        while ((ptr[j]<>',') and (ptr[j]<>#0)) do j:=j+1;{ locate the next comm}
  437.  
  438.        SaveChar:=ptr[0];                     { extract the strin}
  439.        ptr[0]:=#0;
  440.        StrECopy(TempString,addr(line[i]));
  441.        ptr[0]:=SaveChar;
  442.        idx:=i+strlen(TempString)+1+j;         { index to the next field      }
  443.     end
  444.     else
  445.     begin
  446.        ptr:=StrScan(addr(line[i]),comma);
  447.        if (nil=ptr) then ptr:=addr(line[LineLen]);  { field spans the end of the lin}
  448.  
  449.        SaveChar:=ptr[0];                     { extract the strin}
  450.        ptr[0]:=#0;
  451.        strECopy(TempString,addr(line[i]));
  452.        ptr[0]:=SaveChar;
  453.        idx:=i+strlen(TempString)+1;           { index to the next field      }
  454.     end;
  455.  
  456.     CharReturn:=StrPas(TempString);
  457.  
  458.     result:=TRUE;
  459. end;
  460.  
  461.  
  462. {*******************************************************************
  463.     Report Executer Interface
  464.  *******************************************************************}
  465. procedure Tmain.Run1Click(Sender: TObject);
  466. begin
  467.    if (FormParm.open) then ShowMessage('A Form Editor Window Already Open!')
  468.    else RunReport;     { call the report executer}
  469.  
  470. end;
  471.  
  472. {*****************************************************************************
  473.     RunReport: The following routines demonstrate the process of calling the
  474.     report executor.
  475. *****************************************************************************}
  476. Procedure RunReport;
  477. var
  478.    FormFileName: string;
  479. begin
  480.  
  481.    if (GetFormSelection(FormFileName,FALSE)>=0) then { select a form file}
  482.    begin
  483.  
  484.        {******** Initialize the argument parameters *************}
  485.        StrPCopy(RepParm.FileName,FormFileName);
  486.        RepParm.device:='A';            { ask user}
  487.  
  488.        RepParm.x:=FormParm.x;          { specify the window coordinates for screen outpu}
  489.        RepParm.y:=FormParm.y;          { these fields needed only for screen outpu}
  490.        RepParm.width:=FormParm.width;
  491.        RepParm.height:=FormParm.height;
  492.  
  493.        if (RepInit(RepParm)<>0) then exit;{ Intialize the repor}
  494.  
  495.        PrepareFile;                    { sort and join files if needed  }
  496.  
  497.        PrintRecords(RepParm.field,RepParm.TotalFields);  { read and print each recor}
  498.  
  499.        RepExit;                         { print footers and exi}
  500.    end;
  501.  
  502. end;
  503.  
  504. {*****************************************************************************
  505.     PrepareFile:  Sort and join the CUSTOMER and SALES files if needed.
  506. *****************************************************************************}
  507. function FileJoin(InputFile1: pChar; CommonField1: integer; InputFile2: pChar; CommonField2: Integer;
  508.                   OutputFile: pChar): Integer; far; external 'util';
  509. function FileSort(InputFile: pChar; FieldCount: Integer; SortFields: Pointer): Integer; far;
  510.                   external 'util';
  511.  
  512. Procedure PrepareFile;
  513. var
  514.     i: Integer;
  515.     SalesFileUsed: WordBool;
  516.     SortKey: Array [0..9] of Integer;
  517.     InputFile1,InputFile2,OutputFile: array [0..79] of char;
  518.     CString1, CString2: array [0..79] of char;
  519. begin
  520.  
  521.     { Sort the Customer.DB file}
  522.     StrPCopy(InputFile1,DataFile[0].name + '.DB');
  523.  
  524.     for i:=0 to RepParm.TotalSortFields-1 do { extract each sort fiel}
  525.     begin
  526.        SortKey[i]:=RepParm.SortField^[i].FieldId+1;
  527.     end;
  528.  
  529.     FileSort(InputFile1,RepParm.TotalSortFields,addr(SortKey));
  530.                          { the output is in the CUSTOMER.SRT file}
  531.  
  532.     { Determine if the sales file is use}
  533.     SalesFileUsed:=FALSE;
  534.     for i:=0 to RepParm.TotalFields-1 do
  535.     begin
  536.        if (RepParm.field^[i].FileId=1) then  { id =0 is customer file, and }
  537.        begin                                { id=1 is the sales file,      }
  538.                                             { see the UserFieldSeletion routine }
  539.            SalesFileUsed:=TRUE;
  540.            break;
  541.        end;
  542.     end;
  543.  
  544.     if (SalesFileUsed) then                     { join SALES file with CUSTOMER FIL}
  545.     begin
  546.         StrPCopy(InputFile1,DataFile[0].name + '.SRT');{ first file}
  547.         StrPCopy(InputFile2,DataFile[1].name + '.DB'); {second file}
  548.         StrPCopy(OutputFile,DataFile[0].name + '.SRT');{ output file}
  549.  
  550.         FileJoin(InputFile1,1,InputFile2,1,OutputFile);
  551.  
  552.         { customer and sales file have field number 1 in common. The output
  553.         is stored in the "CUSTOMER.SRT file.}
  554.     end;
  555.  
  556. end;
  557.  
  558. {*****************************************************************************
  559.     PrintRecords:
  560.     This routine follows these step:
  561.     1. Open the data set file.
  562.     2. For each record of data set:
  563.          a. Initialize the fields in the field structure.  IMPORTANT:  Initialize
  564.             only the fields where source := SRC_APPL.  All other fields are
  565.             for internal use of ReportEase.
  566.          b. Parse each field from the data record and stuff into the
  567.             field structure.  One field may be stuffed in more than one
  568.             place in field structure.  Stuff only those structure fields where
  569.             source := SRC_APPL
  570.          c. Call the RepRec routine to print this record.
  571.  
  572.     This routine returns a TRUE value after all records are printed.  If
  573.     the user hit escape during printing, then the return result will be a FALSE
  574.     value.
  575. *****************************************************************************}
  576. Procedure PrintRecords(field: PStrField; TotalFields: Integer);
  577. var
  578.     iStream: Text;
  579.     i,CurLen,FileNo,FieldNo,RecNo,LineIdx: Integer;
  580.     DataSetName: string[64];
  581.     line,TempString: string[255];
  582.     CString1: array [0..255] of char;
  583.     CLine: array [0..1000] of char;
  584.     EndOfLine: WordBool;
  585.  
  586. label READ_LINE;
  587. label END_FILE;
  588. begin
  589.     RecNo:=1;
  590.  
  591.     {** open the data set file ***}
  592.     DataSetName:=DataFile[0].name + '.SRT';
  593.  
  594.     AssignFile(iStream,DataSetName);
  595.     Reset(iStream);
  596.  
  597.     READ_LINE:
  598.  
  599.     if (eof(iStream)) then goto END_FILE;   {end of file}
  600.  
  601.     CLine[0]:=#0;              { reset the line buffer }
  602.     CurLen:=0;
  603.     EndOfLine:=False;
  604.  
  605.     { Read a text line - accomodate for lines longer than 255 }
  606.     while (True) do
  607.     begin
  608.        Read(iStream,line);
  609.        StrPCopy(Addr(CLine[CurLen]),line);
  610.        CurLen := CurLen + length(line);
  611.        if (eoln(iStream)) then
  612.        begin
  613.           ReadLn(iStream,line);   {go past new line character}
  614.           break;
  615.        end;
  616.     end;
  617.  
  618.     
  619.     {********* initialize the field structure *************}
  620.     for i:=0 to TotalFields-1 do
  621.     begin
  622.        if (field^[i].source=SRC_APPL) then
  623.        begin
  624.           if (field^[i].FieldType=TYPE_TEXT)  then field^[i].CharData[0]:=#0;
  625.           if (field^[i].FieldType=TYPE_NUM)   then field^[i].NumData:=0;
  626.           if (field^[i].FieldType=TYPE_PICT)  then field^[i].NumData:=0;
  627.           if (field^[i].FieldType=TYPE_DBL)   then field^[i].DblData:=0;
  628.        end;
  629.     end;
  630.  
  631.     {*********** parse the record to get each field ********}
  632.     FileNo:=0;
  633.     FieldNo:=0;
  634.     LineIdx:=0;                         { prepare to scan the lin}
  635.  
  636.     while (TRUE) do
  637.     begin
  638.        { extract the field}
  639.        if (ExtractField(CLine,LineIdx,CurLen,TempString)=False) then break;
  640.  
  641.        if (FileNo>=MAX_FILES) then
  642.        begin
  643.           line:=format('Too many fields in the data record number: %d',[RecNo]);
  644.           ShowMessage(line);
  645.           goto END_FILE;
  646.        end;
  647.  
  648.        { stuff this field into the field structur}
  649.        for i:=0 to TotalFields-1 do
  650.        begin
  651.           if ((field^[i].source=SRC_APPL)
  652.                    and (field^[i].FileId=FileNo) and (field^[i].FieldId=FieldNo)) then
  653.           begin
  654.              if (field^[i].FieldType=TYPE_TEXT) then
  655.              begin
  656.                  StrPCopy(CString1,TempString);
  657.                  if (strlen(CString1)>field^[i].width) then CString1[field^[i].width]:=#0; { truncate oversize data}
  658.                  StrCopy(field^[i].CharData,CString1);
  659.              end;
  660.              if (field^[i].FieldType=TYPE_NUM) then
  661.                  field^[i].NumData:=StrToInt(PStrTrim(TempString));
  662.              if (field^[i].FieldType=TYPE_DBL) then
  663.                  field^[i].DblData:=StrToFloat(PStrTrim(TempString));
  664.              if (field^[i].FieldType=TYPE_DATE) then
  665.                  field^[i].NumData:=StrToInt(PStrTrim(TempString)); { date in YYMMDD or YYYYMMDD}
  666.              if (field^[i].FieldType=TYPE_PICT) then
  667.                  field^[i].NumData:=StrToInt(PStrTrim(TempString)); { date in YYMMDD or YYYYMMDD}
  668.              if (field^[i].FieldType=TYPE_LOGICAL) then
  669.              begin
  670.                 if ((TempString[1]='Y') or (TempString[1]='y'))
  671.                 then field^[i].NumData:=1
  672.                 else field^[i].NumData:=0;
  673.              end;
  674.           end;
  675.        end;
  676.  
  677.        { advance to the next field number}
  678.        FieldNo := FieldNo + 1;
  679.        if (FieldNo>=DataFile[FileNo].TotalFields) then
  680.        begin
  681.           FieldNo:=0;
  682.           FileNo := FileNo + 1;
  683.        end;
  684.  
  685.     end;
  686.  
  687.     if (RepRec<>0)  then goto END_FILE;     { print this record}
  688.  
  689.     RecNo := RecNo + 1;
  690.  
  691.     goto READ_LINE;
  692.  
  693.     END_FILE:
  694.     CloseFile(iStream);
  695.  
  696. end;
  697.  
  698.  
  699. {************************************************************************
  700.           Callback function
  701. *************************************************************************}
  702.  
  703. {******** trap REP_CLOSE message ************}
  704. function MsgCallback(hWnd: THandle; msg: Integer): LongInt;
  705. begin
  706.    if (msg=REP_CLOSE) then FormParm.open:=FALSE;
  707. end;
  708.  
  709. {*****************************************************************************
  710.     UserFieldSelection:
  711.     This routine is called by the FORM_FLD module to allow user to select
  712.     a data field.  This routine can be programmed by your application in
  713.     any way as long as it returns the data about the selected field using
  714.     the argument pointer.  If the user chose not to select a field after all,
  715.     the function should return with a FALSE value. Otherwise it should return
  716.     with a TRUE value.
  717.  
  718.     In this routine, we will allow the user to first select a file, and
  719.     then select a field from the chosen file.  The required data about the
  720.     selected field is filled into the 'field' structure. Your program may
  721.     also optionally fill other remaining 'field' structure variables.
  722.  
  723.     The first parameter contains the handle of the Form Editor window.
  724.     The third parameter specifies the sort field number if this field will
  725.     be used for section breaks. If your application will not sort on all
  726.     fields,  you can restrict the fields that can be selected by the user.
  727.     For non-sort fields, this paramter is set to 0.  In this demo program,
  728.     we will allow only the fields from the primary file (CUSTOMER) to be
  729.     used as sort fields.
  730. *****************************************************************************}
  731. function UserFieldSelection(hWnd: THandle; var field: StrField; SortFieldNo: Integer): WordBool;
  732. begin
  733.  
  734.     result:=False;
  735.     CurFile:=-1;
  736.     CurField:=-1;
  737.     if (SortFieldNo=0) then GetSortField:=FALSE else GetSortField:=TRUE;
  738.  
  739.     while CurField<0 do
  740.     begin
  741.       if (SortFieldNo=0) then
  742.       begin
  743.           FileSel.ShowModal;   { let user select a data file}
  744.           if (CurFile<0) then exit;
  745.       end
  746.       else CurFile:=0;                         { Allow sort fields only from the customer fil}
  747.  
  748.       { SELECT FIELD}
  749.       FieldSel.ShowModal;  { select a data field}
  750.  
  751.       if ((CurField<0) and (GetSortField)) then exit;
  752.     end;
  753.  
  754.     { fill the required 'field' variable}
  755.  
  756.     StrPCopy(field.name,DataField[CurFile][CurField].FullName); { field nam}
  757.     field.FieldType:=DataField[CurFile][CurField].FieldType;             { alpha/num et}
  758.     field.width:=DataField[CurFile][CurField].width;           { display widt}
  759.     field.DecPlaces:=DataField[CurFile][CurField].DecPlaces;   { decimal places for displa}
  760.  
  761.  
  762.     { specify new paragraph indicator field.  Used only for a word/wrap
  763.       text type field}
  764.     field.ParaChar[0]:='|';
  765.  
  766.     {***** fill up these OPTIONAL fields also. This information will be
  767.             used by our report executer demo program to identfy the
  768.             fields quickly.  ****}
  769.  
  770.     field.FileId:=CurFile;                    { Information onl}
  771.     field.FieldId:=CurField;                  { information onl}
  772.  
  773.     result:=True;
  774. end;
  775.  
  776. {*****************************************************************************
  777.     VerifyField:
  778.     This routine is called by the FORM1 module to validate a field.  The field
  779.     name is given by the 'name' variable in the StrField structure.  It
  780.     contains the full name including the file prefix (if your application allows
  781.     it). The input field is always in the upper case. The required data about the
  782.     current field is filled into the 'field' structure. Your program may
  783.     also optionally fill other remaining 'field' structure variables.
  784.  
  785.     The second argument indicates if the field can be
  786.     used as a sort field.  This parameter indicates the sort field number.
  787.     1 indicates the first sort field, 2 the second, ... A zero for this
  788.     field indicates a non-sort field.  In this demo program, we will allow
  789.     only the fields from the primary file (CUSTOMER) to be used as sort fields.
  790.  
  791.     The function returns TRUE if the field is valid, otherwise it returns
  792.     a FALSE value.
  793. *****************************************************************************}
  794. function VerifyField(var field: StrField; SortFieldNo: Integer): WordBool;
  795. var
  796.    MaxFiles: Integer;
  797. begin
  798.     result:=False;
  799.  
  800.     if (SortFieldNo=0)  then MaxFiles:=MAX_FILES
  801.                         else MaxFiles:=1;         { allow sort fields from the customer file onl}
  802.  
  803.     for CurFile:=0 to MaxFiles-1 do
  804.     begin
  805.        for CurField:=0 to DataFile[CurFile].TotalFields-1 do
  806.        begin
  807.          if DataField[CurFile][CurField].FullName=StrPas(field.name) then
  808.          begin
  809.             { fill up the mandatory data *}
  810.             field.FieldType:=DataField[CurFile][CurField].FieldType;             { alpha/num et}
  811.             field.width:=DataField[CurFile][CurField].width;           { display widt}
  812.             field.DecPlaces:=DataField[CurFile][CurField].DecPlaces;   { decimal places for displa}
  813.  
  814.             {***** fill up these OPTIONAL fields also. This information will be
  815.                     used by our report executer demo program to identfy the
  816.                     fields quickly.  ****}
  817.  
  818.             field.FileId:=CurFile;                    { Information onl}
  819.             field.FieldId:=CurField;                  { information onl}
  820.  
  821.             result:=TRUE;
  822.             exit;
  823.          end;
  824.          if result then exit;
  825.        end;
  826.        if result then exit;
  827.     end;
  828.  
  829.     result:=FALSE;                                     { not a valid fiel}
  830. end;
  831. {*****************************************************************************
  832.     DrawPicture:
  833.     This routine is called by the report executor to draw a specified
  834.     picture type field.  The first argument specifies the device context
  835.     of the reporting device.  If the report output is directed to a printer,
  836.     this device context belongs to a printer, otherwise it specifies a 
  837.     device context for a metafile.  You application should draw the picture
  838.     on this device context within the specified rectangle (last argument).
  839.  
  840.     The device context is in ANISOTROPIC mode.  The resolution in the X and
  841.     Y direction is given by the UNITS_PER_INCH constant.
  842.  
  843.     The second argument is the picture id.  The third and fourth arguments
  844.     are the file and field id for the picture field.
  845.  
  846.     The function returns TRUE if successful.
  847.  
  848.     In this demo program, this routine draws a logo for a given picture id.
  849.     This program uses only one bitmap, and draws different part of the same
  850.     bitmap for different picture id.
  851.  
  852. *****************************************************************************}
  853. function DrawPicture(hDC: THandle; PictId, FileId, FieldId: Integer; var rect: TRect): WordBool;
  854. var
  855.     bm: StrBitmap;
  856.     SourceWidth,SourceX: Integer;
  857. begin
  858.     result:=FALSE;
  859.  
  860.     { get the bitmap informati}
  861.     GetObject(hLogoBM,sizeof(StrBitmap),addr(bm));
  862.  
  863.     { Select part of the bitmap to display for this picture }
  864.     SourceWidth:=bm.bmWidth div 10;          { divide picture into 10 equal parts}
  865.     if (PictId<1)  then PictId:=1;
  866.     if (PictId>10) then PictId:=10;
  867.     SourceX:=SourceWidth*(PictId-1);
  868.  
  869.     { copy the bitmap}
  870.  
  871.     StretchBlt(hDC,rect.left,rect.top,rect.right-rect.left,rect.bottom-rect.top,
  872.                    logo.canvas.handle,SourceX,0,SourceWidth,bm.bmHeight,SRCCOPY);
  873.  
  874.     result:=TRUE;
  875. end;
  876.  
  877.  
  878. {*******************************************************************
  879.     Helper routines
  880.  *******************************************************************}
  881.  
  882. {***********************************************************************
  883.      Trim the spaces from the left and right of a string
  884.  ***********************************************************************}
  885. function PStrTrim(InString: string): string;
  886. var
  887.   i,len: Integer;
  888. begin
  889.   { trim the spaces from the beginning of the string}
  890.   len:=length(InString);
  891.  
  892.   for i:=1 to len do
  893.   begin
  894.     if (InString[i]<>' ') then break;
  895.   end;
  896.   if (i>1) then delete(InString,1,i-1);
  897.  
  898.   {trim the spaces from the end of the string }
  899.   len:=length(InString);
  900.  
  901.   for i:=len downto 0 do
  902.   begin
  903.      if (InString[i]<>' ') then break;
  904.   end;
  905.  
  906.   if (i<len) then delete(InString,i+1,len-i);
  907.  
  908.   result:=InString;
  909. end;
  910.  
  911. end.
  912.