1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:

{
                   TEasyPrint - Der einfache Drucker
                --------------------------------------
Diese Unit stellt die Klasse TEasyPrinter zur Verfügung. Sie ist konzipiert,
einfach und logisch Textformatierungen vorzunehmen und zu drucken, oder einen
Text schnell und ohne Fragen zu Papier zu bringen.
ToDo Liste:
-Druckerauswahl
-Buchstaben/Wortweise Farbänderungen
-alles wenn möglich noch weiter vereinfachen
-Anregungen umsetzen! (Ich waaarte *fg*)


©by JayEff alias Jan-Felix Walter   (Verletze ich hier was...? o.o)
}

unit EasyPrint;

interface

uses
  Classes, Graphics, Printers, Windows, StrUtils,SysUtils;

type TEasyPrinter=class
  private

  public
  Pos:TPoint;    //der Punkt, an dem der Text anfängt
  Lines:TStrings; //Zu druckender Text (nur bei Print, nicht bei QuickPrt
  TextColor:TColor; //Textfarbe *fg*
  MarkerColor:TColor; //Hintergrundfarbe des Textes
  Copies:integer; //Anzahl
  FontFace:TFontName; //Schriftart
  TextSize:integer; //Schriftgröße
  procedure AddTStrings(s:TStrings); //einfach nur AddLines...
  procedure ChangeTextColor(r,g,b:Byte); //Textfarbe ändern (nur Print, zeilenweise!)
  procedure ChangeMarkerColor(r,g,b:Byte); //Hintergrundfarbe ändern (nur Print, Zeilenweise!)
  procedure NoMarker; //Hintergrundfare auf weis setzen
  procedure QuickPrt(s:TSTrings); //Schwarz auf Weis mit FontFace und TextSize drucken
  procedure Print; //Druckprozedur die Lines druckt. Interpretiert Farb-, und Hintergrundfarbänderungen!
  constructor Create;
  end;
implementation

constructor TEasyPrinter.Create;
begin
TextSize:=8;
Pos.X:=100;
Pos.Y:=200;
FontFace:='Courier';
Lines:=TStringList.Create;
Printer.Canvas.Brush.Color:=clwhite;
Printer.Canvas.Font.Color:=clblack;
Printer.Copies:=1;
MarkerColor:=RGB(255,255,128);
TextColor:=clBlack;
Copies:=1;
end;

procedure TEasyPrinter.ChangeMarkerColor(r,g,b:Byte);
begin
Lines.Add(#254);
Lines.Add(IntToStr(r));
Lines.Add(IntToStr(g));
Lines.Add(IntToStr(b));
end;

procedure TEasyPrinter.NoMarker;
begin
Lines.Add(#253);
end;

procedure TEasyPrinter.AddTStrings(s:TStrings);
begin
Lines.AddStrings(s);
end;

procedure TEasyPrinter.ChangeTextColor(r,g,b:Byte);
begin
Lines.Add(#255);
Lines.Add(IntToStr(r));
Lines.Add(IntToStr(g));
Lines.Add(IntToStr(b));
end;

procedure TEasyPrinter.Print;//Bezieht alle ChageTextColor undsoweiter mit ein. Hiermit lassen sich einzelne Zeilen hervorheben, nicht aber einzelne wörter.
var
  i:integer;
  r,g,b:Byte;

begin
i:=0;
Lines.Add('');
Printer.Copies:=Copies;
Printer.BeginDoc;
Printer.Canvas.Font.Color:=TextColor;
Printer.Canvas.Font.Name:=FontFace;
Printer.Canvas.Font.Size:=TextSize;
while Lines[i]<>'' do
begin
Case Lines[i][1] of
#255:
    begin
      Lines.Delete(i);
      r:=StrToInt(Lines[i]);
      Lines.Delete(i);
      g:=StrToInt(Lines[i]);
      Lines.Delete(i);
      b:=StrToInt(Lines[i]);
      Lines.Delete(i);
      Dec(i);
      Printer.Canvas.Font.Color:=RGB(r,g,b);
    end;
#254:
    begin
      Lines.Delete(i);
      r:=StrToInt(Lines[i]);
      Lines.Delete(i);
      g:=StrToInt(Lines[i]);
      Lines.Delete(i);
      b:=StrToInt(Lines[i]);
      Lines.Delete(i);
      Dec(i);
      Printer.Canvas.Brush.Color:=RGB(r,g,b);
    end;
#253:
    begin
      Printer.Canvas.Brush.Color:=clWhite;
      Lines.Delete(i);
      Dec(i);
    end else Printer.Canvas.TextOut(Pos.x,(45*i+Pos.Y),Lines[i]);
end;
Inc(i);
end;
Printer.EndDoc;
end;

procedure TEasyPrinter.QuickPrt(s:TStrings); //Druckt s einmal schwarz auf weis. Egal welche einstellungen Vorher vorgenommen wurden. Diese werden nicht überschrieben.
var
  i :integer;
begin
Printer.BeginDoc;
Printer.Canvas.Font.Name:=FontFace;
Printer.Canvas.Font.Size:=TextSize;
Printer.Canvas.Font.Color:=clblack;
i:=0;
while s[i]<>'' do begin
Printer.Canvas.TextOut(100,(45*i+200),s[i]);
inc(i);
end;
Printer.EndDoc;
end;
end.					

1:
2:
3:
4:
5:
6:

while s[i]<>'' do begin  
Printer.Canvas.TextOut(100,(45*i+200),s[i]);  
inc(i);  
end;  
Printer.EndDoc;  
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:

begin
  ...
  while s[i]<>'' do 
    begin  
      Printer.Canvas.TextOut(100,(45*i+200),s[i]);  
      inc(i);  
    end;  
  Printer.EndDoc;  
end;					

1:
2:
3:
4:

for i:=0 to s.count-1 do
  begin
    ...
  end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

  private
    Flines: Tstrings;
    procedure Setlines(const Value: Tstrings);
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
    property lines:Tstrings read Flines write Setlines;
  end;

procedure TEasyPrinter.Setlines(const Value: Tstrings);
begin
  Flines.assign(Value);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

procedure TForm1.Button2Click(Sender: TObject);
Var sl:Tstrings;
begin
  sl:=TStringList.Create;
  ListBox2.Items.add('Test');
  sl:=ListBox2.Items;    //1)
  //sl.assign(ListBox2.Items); //Einträge kopieren
  ListBox2.Items.add('hoppla');
  //und Ergebnis anzeigen
  ListBox3.Items.Assign(sl);

  sl.free; //wenn 1) aktiv, siehst du beim beenden eine AV, da sl 
           //auf die listbox.items zeigt und du damit diese freigibst, 
           //und wenn beim Programmende dann nochmal versucht wird, 
           //die Listbox items freizugeben, schepperts.
end;					

1:

SetMapMode(Printer.Canvas.Handle,MM_LOMETRIC);					

1:
2:
3:

Hallo ein test
Dies ist zeile2
und dashier zeile 3					

1:
2:
3:

und dashier zeile 3
Dies ist zeile2
Hallo ein test					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:

{************************************************************}
{                                                            }
{              AdressDBXML - Druck-Klasse (0.3.1)            }
{                                                            }
{               Copyright (c) 2004 Michael Puff              }
{                                                            }
{  When I die I want 'Hello, world' carved on my headstone.  }
{                                                            }
{************************************************************}

{*************************************************************

  History:

    - 2004-08-21 - 0.1
      erste Version
    - 2004-08-24 - 0.2
      um 'Telefonliste' drucken erweitert
    - 2004-09-27 - 0.3
      Von Pixel auf Millimeter umgestellt (MapMode MM_LOMETRIC)
      Seitenlayout verbessert
    - 2004-09-30 - 0.3.1
      Setzen der Schriftarten verbessert
      Unit kommentiert

**************************************************************}

unit Print;

interface

uses
  Windows, SysUtils, Dialogs, Printers, Constants, Main, Kontakt;

type
  TPrint = class(TObject)
  private
    FHorzSize: Integer;
    FVerSize: Integer;
    FTitle: string;
    FHeaderLeft: string;
    FHeaderRight: string;
    FFooterLeft: string;
    FFooterCenter: string;
    FColCount: Integer;
    FColWidth: Integer;
    FRecordsPerPage: Integer;
    FLinesPerPage: Integer;

    procedure SetTitle(Title: string);
    procedure SetHeaderLeft(Headerleft: string);
    procedure SetHeaderRight(HeaderRight: string);
    procedure SetFooterLeft(Footerleft: string);
    procedure SetFootCenter(FooterCenter: string);
    procedure SetColCount(ColCount: Cardinal);
    procedure SetColWidth(ColWidth: Cardinal);
    procedure SetRecordsPerPage(RecordsPerPage: Cardinal);
    procedure SetLinesPerPage(LinesPerPage: Cardinal);

    function ReplaceTokens(s: string): string;

    function MakeFont(Font: string; Size: Integer; Weight: Integer): HFONT;
    procedure PrintHeader(hDC: THandle; Lineheight: Integer);
    procedure PrintFooter(hDC: THandle; LineHeight: Integer; Page: Integer);
    function PrintContact(hDC: THandle; Left, Top, LineHeight: Integer; Contact:
      TContactRec): Integer;
    function PrintTelephoneListContact(hDC: THandle; Contact: TContactRec;
      Left, Top, LineHeight: Integer): Integer;
  public
    constructor Create;
    property Title: string write SetTitle;
    property HeaderLeft: string write SetHeaderleft;
    property HeaderRight: string write SetHeaderRight;
    property FooterLeft: string write SetFooterLeft;
    property FooterCenter: string write SetFootCenter;
    property ColCount: cardinal write SetColCount;
    property ColWidth: Cardinal write SetColWidth;
    property RecordsPerPage: Cardinal write SetRecordsPerPage;
    property LinesPerPage: Cardinal write SetLinesPerPage;
    procedure PrintCurrentRecord(PrintDialog: TPrintDialog; Contact:
      TContactRec);
    procedure PrintAllRecords(PrintDialog: TPrintDialog; Contacts:
      TContactList);
    procedure PrintTelephoneList(PrintDialog: TPrintDialog; Contacts:
      TContactList);
  end;

var
  TokenArray: array[0..1] of string = ('%DATE%', '%TIME%');

implementation

constructor TPrint.Create;
begin
  inherited Create;
  FColCount := COLS;
  FColWidth := COL_WIDTH * 10;
  FRecordsPerPage := RPP;
  FLinesPerPage := LPP;
end;

////////////////////////////////////////////////////////////////////////////////
//
//  TPrint.SetXXX
//
//    Setter für private Felder
//

procedure TPrint.SetTitle(Title: string);
begin
  FTitle := Title;
end;

procedure TPrint.SetHeaderLeft(HeaderLeft: string);
begin
  FHeaderLeft := HeaderLeft;
end;

procedure TPrint.SetHeaderRight(HeaderRight: string);
begin
  FHeaderRight := HeaderRight;
end;

procedure TPrint.SetFooterLeft(FooterLeft: string);
begin
  FFooterLeft := FooterLeft;
end;

procedure TPrint.SetFootCenter(FooterCenter: string);
begin
  FFooterCenter := FooterCenter;
end;

procedure TPrint.SetColCount(ColCount: Cardinal);
begin
  FColCount := ColCount;
end;

procedure TPrint.SetColWidth(ColWidth: Cardinal);
begin
  FColWidth := ColWidth * 10;
end;

procedure TPrint.SetRecordsPerPage(RecordsPerPage: Cardinal);
begin
  FRecordsPerPage := RecordsPerPage
end;

procedure TPrint.SetLinesPerPage(LinesPerPage: Cardinal);
begin
  FLinesPerPage := LinesPerPage;
end;

////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
//
//  TPrint.ReplaceTokens
//
//    Token %DATE% und %TIME% im String ersetzten
//

function TPrint.ReplaceTokens(s: string): string;
var
  Dummy: string;
begin
  dummy := StringReplace(s, TokenArray[0], DateToStr(now), [rfReplaceALL]);
  dummy := StringReplace(dummy, TokenArray[1], TimeToStr(now), [rfReplaceALL]);
  result := dummy;
end;

////////////////////////////////////////////////////////////////////////////////
//
//  TPrint.MakeFont
//
//    eigene Schrift erzeugen. Rückgabewert ist ein Font-GDI Objekt
//

function TPrint.MakeFont(Font: string; Size: Integer; Weight: Integer): HFONT;
begin
  result := CreateFont(Size, 0, 0, 0, Weight, 0, 0, 0, ANSI_CHARSET,
    OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
    DEFAULT_PITCH, PChar(Font));
end;

////////////////////////////////////////////////////////////////////////////////
//
//  TPrint.PrintHeader
//
//    SeitenHeader
//

procedure TPrint.PrintHeader(hDC: THandle; LineHeight: Integer);
var
  rec: TRect;
  MyFont: HFONT;
  OldFont: HFONT;
  s: string;
begin
  // logische Einheit auf 0,1 mm umstellen
  // Ursprung unten links
  // x positiv nach rechts
  // y negativ nach oben
  SetMapMode(hDC, MM_LOMETRIC);
  // Rechteck für Drawtext setzten
  rec.Top := -TOPBORDER * SCALE;
  rec.Left := LEFTBORDER * SCALE;
  rec.Bottom := -(TOPBORDER * SCALE) - Lineheight;
  rec.Right := (FHorzSize - RIGHTBORDER) * SCALE;
  // Token ersetzten
  s := ReplaceTokens(FTitle);
  // fette Schrift für Titel selektieren
  MyFont := MakeFont(FONTNAME, FONTSIZE, 700);
  OldFont := SelectObject(hDC, MyFont);
  DrawText(hDC, PChar(s), length(s), rec, DT_CENTER);
  // Schrift zurücksetzen und GDI Objekt löschen
  SelectObject(hDC, OldFont);
  DeleteObject(MyFont);
  s := ReplaceTokens(FHeaderleft);
  // normale Schrift für Rest selektieren
  MyFont := MakeFont(FONTNAME, FONTSIZE, 400);
  OldFont := SelectObject(HDC, MyFont);
  DrawText(hDC, PChar(s), length(s), rec, DT_LEFT);
  s := ReplaceTokens(FHeaderRight);
  DrawText(hDC, PChar(s), length(s), rec, DT_RIGHT);
  // Schrift zurücksetzen und GDI Objekt löschen
  SelectObject(hDC, OldFont);
  DeleteObject(MyFont);
end;

////////////////////////////////////////////////////////////////////////////////
//
//  TPrint.PrintFooter
//
//    SeitenFooter
//

procedure TPrint.PrintFooter(hDC: THandle; LineHeight: Integer; Page: Integer);
var
  rec: TRect;
  MyFont: HFONT;
  OldFont: HFONT;
begin
  // siehe Methode PrintHeader
  SetMapMode(hDC, MM_LOMETRIC);
  rec.Top := -((FVerSize - BOTTOMBORDER) * SCALE); // - LineHeight;
  rec.Left := LEFTBORDER * SCALE;
  rec.Right := (FHorzSize - RIGHTBORDER) * SCALE;
  rec.Bottom := -((FVerSize - BOTTOMBORDER) * SCALE) - LineHeight * 2;
  // Schrift selektieren
  MyFont := MakeFont(FONTNAME, FONTSIZE, 400);
  OldFont := SelectObject(HDC, MyFont);
  DrawText(hDC, PChar(FFooterLeft), length(FFooterLeft), rec, DT_LEFT);
  DrawText(hDC, PChar(FFooterCenter), length(FFooterCenter), rec, DT_CENTER);
  DrawText(hDC, PChar(IntToStr(Page)), length(IntToStr(Page)), rec, DT_RIGHT);
  // Schrift deselektieren und GDI Objekt löschen
  SelectObject(hDC, OldFont);
  DeleteObject(MyFont);
end;

////// Druck-Routinen für Datensätze ///////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
//
//  TPrint.PrintContact
//
//    einzelnen Kontakt drucken
//    -> alle Datensätze Drucken und ausgewählte Datensätze drucken
//    Rückgabewert: Unterkante Rechteck für letztes Drawtext
//

function TPrint.PrintContact(hDC: THandle; Left, Top, LineHeight: Integer;
  Contact: TContactRec): Integer;
var
  rec: TRect;
  MyFont: HFONT;
  OldFont: HFONT;
  s: string;
begin
  // siehe Methode PrintHeader
  SetMapMode(hDC, MM_LOMETRIC);
  // Rechteck für Drawtext erste Zeile ermitteln
  rec.Top := -Top;
  rec.Left := Left;
  rec.Bottom := -Top - Lineheight;
  rec.Right := (FHorzSize - RIGHTBORDER) * SCALE;
  // Datensatz drucken
  // fette Schrift
  MyFont := MakeFont(FONTNAME, FONTSIZE, 700);
  OldFont := SelectObject(hDC, MyFont);
  s := 'Name: ' + Contact.Firma + ' ' + Contact.Name + ' ' + Contact.Vorname;
  DrawText(hDC, PChar(s), length(s), rec, 0);
  // zurücksetzten und GDI Objekt löschen
  SelectObject(hDC, OldFont);
  DeleteObject(MyFont);
  // Top und Bottom für nächste Zeile ermitteln:
  // vorherigen Werte - Zeilenhöhe
  rec.Top := rec.Top - Lineheight;
  rec.Bottom := rec.Bottom - Lineheight;
  // normale Schrift einsetzten
  // und Rest drucken
  MyFont := MakeFont(FONTNAME, FONTSIZE, 400);
  OldFont := SelectObject(hDC, MyFont);
  s := 'Strasse: ' + Contact.Strasse;
  DrawText(hDC, PChar(s), length(s), rec, 0);
  rec.Top := rec.Top - Lineheight;
  rec.Bottom := rec.Bottom - Lineheight;
  s := 'Ort: ' + Contact.PLZ + ' ' + Contact.Ort;
  DrawText(hDC, PChar(s), length(s), rec, 0);
  rec.Top := rec.Top - Lineheight;
  rec.Bottom := rec.Bottom - Lineheight;
  s := 'Land: ' + Contact.Land;
  DrawText(hDC, PChar(s), length(s), rec, 0);
  rec.Top := rec.Top - Lineheight;
  rec.Bottom := rec.Bottom - Lineheight;
  s := 'Telefon 1: ' + Contact.Telefon1;
  DrawText(hDC, PChar(s), length(s), rec, 0);
  rec.Top := rec.Top - Lineheight;
  rec.Bottom := rec.Bottom - Lineheight;
  s := 'Telefon 2: ' + Contact.Telefon2;
  DrawText(hDC, PChar(s), length(s), rec, 0);
  rec.Top := rec.Top - Lineheight;
  rec.Bottom := rec.Bottom - Lineheight;
  s := 'Fax: ' + Contact.Fax;
  DrawText(hDC, PChar(s), length(s), rec, 0);
  rec.Top := rec.Top - Lineheight;
  rec.Bottom := rec.Bottom - Lineheight;
  s := 'E-Mail 1: ' + Contact.EMail1;
  DrawText(hDC, PChar(s), length(s), rec, 0);
  rec.Top := rec.Top - Lineheight;
  rec.Bottom := rec.Bottom - Lineheight;
  s := 'E-Mail 2: ' + Contact.EMail2;
  DrawText(hDC, PChar(s), length(s), rec, 0);
  rec.Top := rec.Top - Lineheight;
  rec.Bottom := rec.Bottom - Lineheight;
  s := 'Geburtsdatum: ' + Contact.GebDat;
  DrawText(hDC, PChar(s), length(s), rec, 0);
  //Schrift deselektieren und GDI Objekt löschen
  SelectObject(hDC, OldFont);
  DeleteObject(MyFont);
  // Rückgabewert: Unterkante Rechteck für Drawtext
  result := -rec.Bottom;
end;

////////////////////////////////////////////////////////////////////////////////
//
//  TPrint.PrintTelephoneListContact
//
//    Telefonliste drucken (Name und Telefonnumer 1 und 2
//

function TPrint.PrintTelephoneListContact(hDC: THandle; Contact: TContactRec;
  Left, Top, LineHeight: Integer): Integer;
var
  rec: TRect;
  MyFont: HFont;
  OldFont: HFONT;
  s: string;
begin
  // siehe Methode PrintHeader
  SetMapMode(hDC, MM_LOMETRIC);
  rec.Left := LEFTBORDER * SCALE;
  rec.Right := (FHorzSize - RIGHTBORDER) * SCALE;
  rec.Top := Top;
  rec.Bottom := Top - Lineheight;
  // Namensstring zusammenbauen
  with Contact do
  begin
    { Firma }
    if (Name <> '') and (Vorname <> '') and (Firma <> '') then
      s := Firma + ' (' + Name + ', ' + Vorname + ')';
    if (Name <> '') and (Vorname = '') and (Firma <> '') then
      s := Firma + ' (' + Name + ')';
    if (Name = '') and (Vorname = '') and (Firma <> '') then
      s := Firma;
    if (Name = '') and (Vorname <> '') and (Firma <> '') then
      s := Firma;
    { private }
    if (Name <> '') and (Vorname <> '') and (Firma = '') then
      s := Name + ', ' + Vorname;
    if (Name <> '') and (Vorname = '') and (Firma = '') then
      s := Name;
    if (Name = '') and (Vorname <> '') and (Firma = '') then
      s := Vorname;
  end;
  // Schrift setzen
  MyFont := MakeFont(FONTNAME, FONTSIZE, 400);
  OldFont := SelectObject(hDC, MyFont);
  // drucken
  DrawText(hDC, PChar(s), length(s), rec, 0);
  rec.Left := rec.Left + FColWidth;
  s := Contact.Telefon1;
  DrawText(hDC, PChar(s), length(s), rec, 0);
  rec.Left := rec.Left + FColWidth;
  s := Contact.Telefon2;
  DrawText(hDC, PChar(s), length(s), rec, 0);
  result := rec.Bottom;
  // Schrift deselektieren und GDI Objekt löschen
  SelectObject(hDC, OldFont);
  DeleteObject(MyFont);
end;

////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
//
//  TPrint.PrintCurrentRecord
//
//    aktuelle Kontakt drucken
//    ruft PrintContact auf
//

procedure TPrint.PrintCurrentRecord(PrintDialog: TPrintDialog; Contact:
  TContactRec);
var
  MyFont: HFONT;
  OldFont: HFONT;
  tm: TTEXTMETRIC;
  Lineheight: Integer;
resourcestring
  rsTitle = 'Datensatz von: ';
begin
  if PrintDialog.Execute then
  begin
    with Printer do
    begin
      Title := APPNAME;
      // Printjob beginnen
      BeginDoc;
      // gewünsche Schrift erstellen und in den HDC selektieren für GetTextMetrics
      MyFont := MakeFont(FONTNAME, FONTSIZE, 400);
      OldFont := SelectObject(Canvas.Handle, MyFont);
      GetTextMetrics(Canvas.Handle, tm);
      // wieder deselektieren (Formatierung geschiet in PrintContact)
      SelectObject(Canvas.Handle, OldFont);
      DeleteObject(MyFont);
      // Zeilenhöhe, Blattbreite und -höhe ermitteln. Werte in mm
      LineHeight := (tm.tmHeight + tm.tmExternalLeading);
      FHorzSize := GetDeviceCaps(Canvas.Handle, HORZSIZE);
      FVerSize := GetDeviceCaps(Canvas.Handle, VERTSIZE);
      // SeitenHkopf, Kontakt und Seitenfuß drucken
      PrintHeader(Canvas.Handle, LineHeight);
      PrintContact(Canvas.Handle, LEFTBORDER * SCALE, LineHeight * 6,
        LineHeight,
        Contact);
      // Printjob beenden
      EndDoc;
    end;
  end;
end;

procedure TPrint.PrintAllRecords(PrintDialog: TPrintDialog; Contacts:
  TContactList);
var
  MyFont: HFONT;
  OldFont: HFONT;
  tm: TTEXTMETRIC;
  LineHeight: Integer;
  i: Integer; // Zähler für Schleife über Datensätze
  n: Integer; // Zähler für Schleife über Spalten
  Top, Dummy: Integer;
  Max: Integer; // maximale Anzahl Datensätze
  Page: Integer;
begin
  if PrintDialog.Execute then
  begin
    with Printer do
    begin
      Title := APPNAME;
      // Printjob beginnen
      BeginDoc;
      // gewünsche Schrift erstellen und in den HDC selektieren für GetTextMetrics
      MyFont := MakeFont(FONTNAME, FONTSIZE, 400);
      OldFont := SelectObject(Canvas.Handle, MyFont);
      GetTextMetrics(Canvas.Handle, tm);
      // wieder deselektieren (Formatierung geschiet in PrintContact)
      SelectObject(Canvas.Handle, OldFont);
      DeleteObject(MyFont);
      // Zeilenhöhe, Blattbreite und -höhe ermitteln. Werte in mm
      LineHeight := tm.tmHeight + tm.tmExternalLeading;
      FHorzSize := GetDeviceCaps(Canvas.Handle, HORZSIZE);
      FVerSize := GetDeviceCaps(Canvas.Handle, VERTSIZE);
      // Seitenkopf und Seitenfuß auf erste Seite drucken
      PrintHeader(Canvas.Handle, LineHeight);
      Page := 1;
      PrintFooter(Canvas.Handle, LineHeight, Page);
      // 8 Zeilen Abstand zum oberen bedruckbaren Bereich
      Dummy := LineHeight * 8;
      Top := Dummy;
      i := 0;
      Max := length(Contacts);
      // Schleife über Anzahl Datensätze
      while i < Max do
      begin
        // Schleife über Anzahl Spalten
        for n := 0 to FColCount - 1 do
        begin
          // alle Kontakte gedruckt -> aus for-Schleife raus
          if i >= length(Contacts) then
            break;
          // letzte Druckausgabeposition des Datensatzes merken
          Dummy := PrintContact(Canvas.Handle, (n * FColWidth + 250), Top,
            LineHeight, Contacts[i]);
          inc(i);
          if i <> 0 then
          begin
            // i modulo Spalten = 0 -> drei Spalten gedruckt
            // zwei Zeilen runtergehen
            if (i mod FColCount = 0) then
              Top := Dummy + 2 * LineHeight;
          end;
        end;
        // Anzahl der Kontakte pro Seite erreicht -> neue Seite anfangen
        if (i mod FRecordsPerPage = 0) then
        begin
          // neue Seite
          NewPage;
          // Seitenkopf drucken
          PrintHeader(Canvas.Handle, LineHeight);
          // Seitennummer erhöhen
          Inc(Page);
          // Seitenfuß drucken
          PrintFooter(Canvas.Handle, LineHeight, Page);
          // wieder 8 Zeilen vom oberen bedruckbaren Bereich runtergehen
          // für ersten Kontakt auf der nächsten Seite
          Top := LineHeight * 8;
        end;
      end;
      // Printjob zu ende
      EndDoc;
    end;
  end;
end;

procedure TPrint.PrintTelephoneList(PrintDialog: TPrintDialog; Contacts:
  TContactList);
var
  OldFont: HFONT;
  MyFont: HFONT;
  tm: TTextMetric;
  LineHeight: Integer;
  Page: Integer;
  i: Integer;
  Top: Integer;
begin
  if PrintDialog.Execute then
  begin
    with Printer do
    begin
      Title := APPNAME;
      BeginDoc;
      // gewünsche Schrift erstellen und in den HDC selektieren für GetTextMetrics
      MyFont := MakeFont(FONTNAME, FONTSIZE, 400);
      OldFont := SelectObject(Canvas.Handle, MyFont);
      GetTextMetrics(Canvas.Handle, tm);
      // wieder deselektieren (Formatierung geschiet in PrintTelephoneList)
      SelectObject(Canvas.Handle, OldFont);
      DeleteObject(MyFont);
      // Zeilenhöhe, Blattbreite und -höhe berechnen
      LineHeight := tm.tmHeight + tm.tmExternalLeading;
      FHorzSize := GetDeviceCaps(Canvas.Handle, HORZSIZE);
      FVerSize := GetDeviceCaps(Canvas.Handle, VERTSIZE);
      // gleiche Spiel wie bei Methode PrintAllRecords
      PrintHeader(Canvas.Handle, LineHeight);
      Page := 1;
      PrintFooter(Canvas.Handle, LineHeight, Page);
      Top := -LineHeight * 6;
      for i := 0 to length(Contacts) - 1 do
      begin
        // Kontakte untereinander weg drucken
        Top := PrintTelephoneListContact(Canvas.Handle, Contacts[i], LEFTBORDER,
          Top, LineHeight);
        // neue Seite, wenn gewünschte Anzahl Zeilen erreciht ist
        if (i <> 0) and (i mod FLinesPerPage = 0) then
        begin
          NewPage;
          PrintHeader(Canvas.Handle, LineHeight);
          Inc(Page);
          PrintFooter(Canvas.Handle, LineHeight, Page);
          Top := LineHeight * 6;
        end;
      end;
      EndDoc;
    end;
  end;
end;

end.