{* * * BatchPdf.dpr * * To run this program, open command-prompt window and run this program with * filename parameter * * ex) BatchPdf.exe batchpdf.pdf *} program BatchPdf; {$MODE ObjFPC}{$H+} {$modeswitch nestedprocvars} {$APPTYPE CONSOLE} uses SysUtils, Classes, PdfDoc, PdfTypes, PdfFonts, DB, LCSVUtils, BufDataset; const CSVFILE = 'customer.csv'; var FDoc: TPdfDoc; FFileName: string; FOutFile: TFileStream; FPage: integer; FQuery: TBufDataset; procedure SetupDataset; var Stream: TFileStream; procedure Newrecord(L: TStringList); begin fQuery.AppendRecord([StrToIntDef(L[0], 0), L[1], L[2], L[3], L[4], L[5]]); end; begin FQuery := TBufDataset.Create(nil); FQuery.FieldDefs.Add('CustNo', ftInteger); FQuery.FieldDefs.Add('Company', ftString, 70); FQuery.FieldDefs.Add('State', ftString, 30); FQuery.FieldDefs.Add('City', ftString, 30); FQuery.FieldDefs.Add('Addr1', ftString, 70); FQuery.FieldDefs.Add('Phone', ftString, 15); FQuery.CreateDataset; // csv data generated from http://www.generatedata.com Stream := TFileStream.Create(CSVFILE, fmOpenRead); try LCSVUtils.LoadFromCSVStream(Stream, @Newrecord); FQuery.First; finally Stream.Free; end; end; procedure TextOut(X, Y: Single; S: string); begin with FDoc.Canvas do begin BeginText; MoveTextPoint(X, Y); ShowText(S); EndText; end; end; procedure DrawLine(X1, Y1, X2, Y2, Width: Single); begin with FDoc.Canvas do begin MoveTo(X1, Y1); LineTo(X2, Y2); Stroke; end; end; procedure WriteHeader; var s: string; w: integer; begin // writing the headline of the pages with FDoc.Canvas do begin // setting font SetFont('Arial-BoldItalic', 16); // printing text. TextOut(90, 770, CSVFILE); SetFont('Arial-BoldItalic', 9); S := FormatDateTime('YYYY/MM/DD', Date); w := Round(TextWidth(S)); // writing header text. TextOut(530 - w, 770, S); SetRGBStrokeColor($00008800); DrawLine(90, 765, 530, 765, 1.5); end; end; procedure WriteFooter; var w: Single; s: string; begin with FDoc.Canvas do begin // Setting font and print text with center align SetFont('Times-Roman', 8); DrawLine(90, 70, 530, 70, 1.5); s := 'Page ' + IntToStr(FPage); w := TextWidth(s); TextOut((PageWidth - w) / 2, 55, S); end; end; procedure WriteRow(YPos: Single); var i: integer; s: string; begin // printing the detail lines with FDoc.Canvas do begin if not FQuery.Eof then begin TextOut(95, YPos - 15, FQuery.FieldByName('CustNo').AsString); s := FQuery.FieldByName('Company').AsString; // calculate the number of the charactor which can be contained in the // width of the frame. i := MeasureText(s, 130); TextOut(135, YPos - 15, Copy(s, 1, i)); s := FQuery.FieldByName('State').AsString + FQuery.FieldByName('City').AsString + FQuery.FieldByName('Addr1').AsString; i := MeasureText(s, 175); TextOut(275, YPos - 15, Copy(s, 1, i)); TextOut(455, YPos - 15, FQuery.FieldByName('Phone').AsString); FQuery.Next; end; end; end; procedure WritePage; var i: integer; XPos, YPos: Single; begin with FDoc.Canvas do begin // writing the outline SetLineWidth(1.5); Rectangle(90, 80, 440, 680); Stroke; // writing the horizontal lines. YPos := 760; SetLineWidth(0.75); for i := 0 to 32 do begin YPos := YPos - 20; MoveTo(90, YPos); LineTo(530, YPos); Stroke; end; // writing the header of the text. SetLineWidth(1); SetFont('Times-Roman', 10.5); XPos := 90; TextOut(XPos + 5, 745, 'NO.'); XPos := 130; DrawLine(XPos, 760, XPos, 80, 1); TextOut(XPos + 5, 745, 'Company'); XPos := 270; DrawLine(XPos, 760, XPos, 80, 1); TextOut(XPos + 5, 745, 'Address'); XPos := 450; DrawLine(XPos, 760, XPos, 80, 1); TextOut(XPos + 5, 745, 'Phone'); XPos := 530; DrawLine(XPos, 760, XPos, 80, 1); // setting the font for the detail lines. SetFont('Arial', 10.5); end; // printing the detail lines with 20 dot height. YPos := 740; for i := 0 to 32 do begin WriteRow(YPos); YPos := YPos - 20; end; end; begin if ParamCount > 0 then FFileName := ParamStr(1) else begin Writeln('Usage: bachpdf '); Halt(2); end; if not FileExists(CSVFILE) then begin WriteLn('file ',CSVFILE,' not found in program directory'); Halt(3); end; // create output-filestream. FOutFile := TFileStream.Create(FFileName, fmCreate); FPage := 1; // create TQuery object and set properties. Writeln('BatchPdf opening database..'); SetupDataset; with FQuery do try // create TPdfDoc object. Writeln('BatchPdf creating document..'); FDoc := TPdfDoc.Create; with FDoc do try // create a new document. NewDoc; // printind page from the result of the query. while not FQuery.Eof do begin AddPage; WriteHeader; WritePage; WriteFooter; inc(FPage); end; // save the pdf-document to the file-stream. Writeln('BatchPdf saving document..'); FDoc.SaveToStream(FOutFile); finally FDoc.Free; end; Close; Writeln('BatchPdf end..'); finally Free; FOutFile.Free; end; end.