procedure TForm1.Button1Click(Sender: TObject);
var
di : DOCINFO;
pd : TPrintDlg;
iTotalLines, yChar, iCharsPerLine, iLinesPerPage, iTotalPages, iPage, iLine, iLineNum, iColCopy : Integer;
tm : TTEXTMETRIC;
begin
ZeroMemory(@pd, sizeof(TPrintDlg));
pd.lStructSize := sizeof(TPrintDlg);
pd.hWndOwner :=
Handle;
pd.Flags := PD_ALLPAGES
or PD_COLLATE
or PD_RETURNDC
or PD_NOSELECTION;
pd.nCopies := 1;
if PrintDlg(pd) = TRUE
then
begin
iTotalLines := Memo1.Lines.Count;
GetTextMetrics(pd.hDC, tm);
yChar := tm.tmHeight + tm.tmExternalLeading;
iCharsPerLine := GetDeviceCaps(pd.hDC, HORZRES)
div tm.tmAveCharWidth;
iLinesPerPage := GetDeviceCaps(pd.hDC, VERTRES)
div yChar;
iTotalPages := (iTotalLines + iLinesPerPage - 1)
div iLinesPerPage;
StaticText1.Caption := '
Zeichen pro Zeile: '+IntToStr(iCharsPerLine)+'
| Zeilen pro Seite: '+IntToStr(iLinesperpage)+
'
| Seiten: '+IntToStr(iTotalPages);
ZeroMemory(@di, sizeof(DOCINFO));
di.cbSize := sizeof(DOCINFO);
di.lpszDocName := '
Test';
if StartDoc(pd.hDC, di) > 0
then
begin
for iColCopy := 0
to pd.nCopies
do
begin
for iPage := 0
to iTotalPages-1
do
begin
for iLine := 0
to iLinesPerpage-1
do
begin
iLineNum := iLinesPerpage*iPage+iLine;
if iLineNum > iTotalLines
then exit;
TextOut(pd.hDC, 0, yChar*iLine, pointer(Memo1.Lines.Strings[iLine]),
length(Memo1.Lines.Strings[iLine]));
Caption := '
Zeilennummer: '+IntToStr(iLine+1)+'
- '+'
Seite: '+IntToStr(iPage+1);
Application.ProcessMessages;
end;
if EndPage(pd.hDC) < 0
then exit;
end;
end;
end;
ShowMessage('
Fertig!');
EndDoc(pd.hDC);
end;
end;