procedure SetSeitenGrosse(Papier: Integer; SeitenBreite, SeitenHoehe: Integer);
var
 Device: array[0..255] of char;
 Driver: array[0..255] of char;
 Port: array[0..255] of char;
 hDMode: THandle;
 PDMode: PDEVMODE;  
begin
 Printer.PrinterIndex := Printer.PrinterIndex;
 Printer.GetPrinter(Device, Driver, Port, hDMode);
 if hDMode <> 0 then
 begin
   pDMode := GlobalLock(hDMode);
   if pDMode <> nil then begin
     pDMode^.dmFields := pDMode^.dmFields or
                         DM_PAPERSIZE or
                         DM_PAPERWIDTH or
                         DM_PAPERLENGTH;
     pDMode^.dmPaperSize := Papier;
     pDMode^.dmPaperWidth := SeitenBreite * 10;
     pDMode^.dmPaperLength := SeitenHoehe * 10;
     if Papier <> DMPAPER_A4 then
     begin
       pDMode^.dmFields := pDMode^.dmFields or DMBIN_AUTO;
       pDMode^.dmDefaultSource := DMBIN_AUTO;
     end else
     begin
       pDMode^.dmFields := pDMode^.dmFields or DMBIN_CASSETTE;
       pDMode^.dmDefaultSource := DMBIN_CASSETTE;
     end;

     GlobalUnlock(hDMode);
   end;
 end;
end;

procedure EtiketteBeschriften(const AStr: string; ACanvas: TCanvas; ARec: TRect; AbstX, AbstY: Integer);
var
 Rec: TRect;
begin
 Rec.Left := ARec.Left + AbstX;
 Rec.Right := ARec.Right - AbstX;
 Rec.Top := ARec.Top + AbstY;
 Rec.Bottom := ARec.Bottom - AbstY;
 ACanvas.Font.Name := FontName;
 ACanvas.Font.Style := Form1.FontStyle;
 ACanvas.Brush.Color := clWhite;
 ACanvas.Font.Size := Form1.EtiketteFontSize;
 DrawText(ACanvas.Handle, PChar(AStr),Length(AStr),Rec,DT_LEFT or DT_TOP);
end;

procedure FormulareDrucken;
var
 XPixProInch,YPixProInch: Integer;

 function XmmToPrn(MassX: Double): Integer;
 begin
   Result := Round(XPixProInch / 25.4 * MassX);
 end;
 function YmmToPrn(MassY: Double): Integer;
 begin
   Result := Round(YPixProInch / 25.4 * MassY);
 end;

var
 AbstandOben, AbstandLinks: Integer;
 EtiketteNr: Integer;
 i: Integer;
 Etikette: TEtikette;
 NextEtikette: TEtikette;
 Formular, NextFormular: TPaintBox;
 Rec, tmpRec: TRect;
 tmpStr: string;
 DateStr: string;
begin
 Printer.Orientation := poPortrait;
 XPixProInch := GetDeviceCaps(Printer.Handle,LOGPIXELSX);
 YPixProInch := GetDeviceCaps(Printer.Handle,LOGPIXELSY);
 AbstandOben := GetDeviceCaps(Printer.Handle,PHYSICALOFFSETY);
 AbstandLinks := GetDeviceCaps(Printer.Handle,PHYSICALOFFSETX);

 EtiketteNr := 0;
 NextFormular := nil;
 DateStr := DateToStr(Date);
 if PrinterSupportsDuplex then
   ZweiseitigDruckAus;

 SetSeitenGrosse(DMPAPER_USER, Form1.UpDownBBreite.Position, Form1.UpDownBHoehe.Position);
 Printer.BeginDoc;
 try
   with Form1 do
   begin
     for i := 0 to ListView1.Items.Count - 1 do
     begin
       if ListView1.Items[i].Checked then
       begin
         Etikette := TEtikette(EtikettenList.Items[EtiketteNr]^);
         Formular := TPaintBox(Etikette.PBox);
         Rec := TRect(Etikette.mmRect);
         Rec.Left := XmmToPrn(Rec.Left + KorrLinks) - AbstandLinks;
         Rec.Right := XmmToPrn(Rec.Right + KorrLinks) - AbstandLinks;
         Rec.Bottom := YmmToPrn(Rec.Bottom + KorrOben) - AbstandOben;
         Rec.Top := YmmToPrn(Rec.Top + KorrOben) - AbstandOben;
         if RectDrucken then
           Printer.Canvas.Rectangle(Rec);

         tmpStr := 'Nr.:'+ListView1.Items[i].Caption+'; '+
                   ListView1.Items[i].SubItems.Strings[0]+
                   #10#13+'Duplo:'+ListView1.Items[i].SubItems.Strings[1]+
                   '    Wkz.Type:'+ListView1.Items[i].SubItems[2]+
                   #10#13+'L1:'+ListView1.Items[i].SubItems.Strings[3]+
                   '  L1Korr:'+ListView1.Items[i].SubItems.Strings[4]+
                   #10#13+'R1:'+ListView1.Items[i].SubItems.Strings[5]+
                   '   R1Korr: '+ListView1.Items[i].SubItems.Strings[6]+
                   #10#13+'V.St.Z:'+ListView1.Items[i].SubItems.Strings[11]+
                   ' R.St.Z:'+ListView1.Items[i].SubItems.Strings[12];

         EtiketteBeschriften(tmpStr,Printer.Canvas,Rec,XmmToPrn(1.5),YmmToPrn(1.5));

         tmpRec.Bottom := Rec.Bottom-YmmToPrn(3);
         tmpRec.Top := tmpRec.Bottom-Printer.Canvas.TextHeight('W')+YmmToPrn(0.2);
         tmpRec.Left := Rec.Left + XmmToPrn(2);
         tmpRec.Right := tmpRec.Left + Printer.Canvas.TextWidth('BAZ-'+EdMaschinenNr.Text)+XmmToPrn(0.1);
         DrawText(Printer.Canvas.Handle,PChar('BAZ-'+EdMaschinenNr.Text),
                  Length('BAZ-'+EdMaschinenNr.Text),tmpRec,
                  DT_LEFT or DT_BOTTOM or DT_WORDBREAK);

         tmpRec.Right := Rec.Right - XmmToPrn(4);
         tmpRec.Left :=tmpRec.Right-Printer.Canvas.TextWidth(DateStr)-XmmToPrn(2);

         DrawText(Printer.Canvas.Handle,PChar(DateStr),Length(DateStr),tmpRec,
                  DT_LEFT or DT_BOTTOM or DT_WORDBREAK);

         if EtiketteNr < EtikettenList.Count - 1 then
         begin
           NextEtikette := TEtikette(EtikettenList.Items[EtiketteNr+1]^);
           NextFormular := TPaintBox(NextEtikette.PBox);
         end;
         if NextFormular <> Formular then
           Printer.NewPage;

         Inc(EtiketteNr);
         if EtiketteNr > EtikettenList.Count - 1 then
           Break;
       end;
     end;
   end;
 finally
   Printer.EndDoc;
 end;

end;