You've already forked lazarus-ccr
applications
bindings
components
ZVDateTimeCtrls
acs
beepfp
chelper
cmdline
colorpalette
csvdocument
epiktimer
fpsound
fpspreadsheet
freetypepascal
geckoport
gradcontrols
iosdesigner
iphonelazext
jujiboutils
jvcllaz
kcontrols
lazbarcodes
manualdock
mplayer
multithreadprocs
nvidia-widgets
onguard
orpheus
powerpdf
Example
ConsoleProgramDemo
BatchPdf.dof
BatchPdf.dpr
BatchPdf.res
DBExample
DBImage
FontDemo
JpegImageExample
KylixDemo
LineDemo
MakeDoc
MultiSizePagesDemo
OpenActionExample
PageLayoutModeExample
ViewerPreferenceExample
BatchPdf.pdf
DBImage.pdf
DbExample.pdf
FontExample.pdf
JpegImageExample.pdf
LineExample.pdf
MultiSizePages.pdf
LazarusExamples
xpm
PRAnnotation.pas
PRJpegImage.pas
PReport.pas
PdfDoc.pas
PdfFonts.pas
PdfGBFonts.pas
PdfImages.pas
PdfJPFonts.pas
PdfJpCMap.pas
PdfJpegImage.pas
PdfTypes.pas
PowerPdf.dcr
PowerPdf.lrs
PowerPdf.pas
PowerPdfRef.pdf
lgpl.txt
pack_powerpdf.cfg
pack_powerpdf.dof
pack_powerpdf.dpk
pack_powerpdf.dsk
pack_powerpdf.lpk
pack_powerpdf.pas
pack_powerpdf.res
readme-lazarus.txt
readme.txt
rgbgraphics
richmemo
richview
rtfview
rx
smnetgradient
spktoolbar
svn
tdi
thtmlport
tparadoxdataset
tvplanit
virtualtreeview
virtualtreeview-new
xdev_toolkit
zlibar
examples
lclbindings
wst
242 lines
4.8 KiB
ObjectPascal
242 lines
4.8 KiB
ObjectPascal
![]() |
{*
|
||
|
*
|
||
|
* BatchPdf.dpr
|
||
|
*
|
||
|
* To run this program, open command-prompt window and run this program with
|
||
|
* filename parameter
|
||
|
*
|
||
|
* ex) BatchPdf.exe batchpdf.pdf
|
||
|
*}
|
||
|
|
||
|
program BatchPdf;
|
||
|
{$APPTYPE CONSOLE}
|
||
|
uses
|
||
|
SysUtils,
|
||
|
Classes,
|
||
|
PdfDoc,
|
||
|
PdfTypes,
|
||
|
PdfFonts,
|
||
|
DB,
|
||
|
DBTables;
|
||
|
|
||
|
var
|
||
|
FDoc: TPdfDoc;
|
||
|
FFileName: string;
|
||
|
FOutFile: TFileStream;
|
||
|
FPage: integer;
|
||
|
FQuery: TQuery;
|
||
|
|
||
|
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, 'Customer.DB');
|
||
|
|
||
|
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 <pdf-filename>');
|
||
|
Halt(2);
|
||
|
end;
|
||
|
|
||
|
// create output-filestream.
|
||
|
FOutFile := TFileStream.Create(FFileName, fmCreate);
|
||
|
|
||
|
FPage := 1;
|
||
|
|
||
|
// create TQuery object and set properties.
|
||
|
FQuery := TQuery.Create(nil);
|
||
|
with FQuery do
|
||
|
try
|
||
|
Writeln('BatchPdf opening database..');
|
||
|
DatabaseName := 'DBDEMOS';
|
||
|
SQL.Text := 'SELECT CustNo, Company, State, City, Addr1, Phone from Customer';
|
||
|
Open;
|
||
|
|
||
|
// 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.
|