unit LabelPrint; interface uses ParentForm, PakkeshopLabels, Configuration, StBarc; type TLabelPrint = class constructor Create( p : IParentForm; var Configuration : TConfiguration; PrinterNavn: String); procedure CheckPrintQue(tjektype : string; PrinterNavn : String); procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = ''); procedure PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel); procedure PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn : String) ; procedure TestZpl(); procedure PrintZPL( ZplData : string); function GetPrinterCount() : Integer; private parentForm : IParentForm; Barcode : TStBarcode; var Config: TConfiguration; function SavePChar(p: PChar): PChar; function GetCurrentPrinterHandle(): THandle; end; function GetPixelsPerInchX(): Integer; function GetPixelsPerInchY(): Integer; implementation uses Printers, WinSpool, Windows, SysUtils, //Format Math, // DegToRad() bruges i PrintPakkeshopLabel Forms ; function GetPixelsPerInchX(): Integer; begin Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX) end; function GetPixelsPerInchY(): Integer; begin Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY) end; constructor TLabelPrint.Create( p : IParentForm; var Configuration : TConfiguration; PrinterNavn: String); var FormObj : TForm; printerInd : integer; begin parentForm := p; Config := Configuration; FormObj := parentForm.GetFormObject(); Barcode := TStBarcode.Create(FormObj);//Dynamisk oprettelse af Barcode component if PrinterNavn<> '' then begin printerInd := Printer.Printers.IndexOf(PrinterNavn); if printerInd >= 0 then begin Printer.PrinterIndex := printerInd; end; end; end; function TLabelPrint.GetCurrentPrinterHandle(): THandle; var Device, Driver, Port: array[0..255] of Char; hDeviceMode: THandle; begin Printer.GetPrinter(Device, Driver, Port, hDeviceMode); if not OpenPrinter(@Device, Result, nil) then RaiseLastWin32Error; end; procedure TLabelPrint.PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn : String) ; begin with Printer do begin BeginDoc; Canvas.Font.Size := Config.FontSizeRute; if (Length(RuteNummer) > 7) then begin Canvas.Font.Size := Config.FontSizeRuteLille; end; Canvas.TextOut(Config.XPosRute, Config.YPosRute, RuteNummer); Canvas.Font.Size := Config.FontSizeKommentar; Kommentar := StringReplace(Kommentar, #$A, ' - ', [rfReplaceAll, rfIgnoreCase]); if (Kommentar = 'Ok') or (Kommentar = 'ALLEREDE SCANNET') then begin Kommentar := ''; end; if (BoghandlerNavn = 'PAKKE ER SCANNET') then begin BoghandlerNavn := ''; end; Canvas.TextOut(Config.XPosKommentar, Config.YPosKommentar, Kommentar); // Kan ikke lave linieskift (se tidligere kommentar om samme) Canvas.Font.Size := Config.FontSizeBoghandler; Canvas.TextOut(Config.XPosBoghandler, Config.YPosBoghandler, BoghandlerNavn); EndDoc; end; end; procedure TLabelPrint.CheckPrintQue(tjektype : string; PrinterNavn : String); type TJobs = array [0..1000] of JOB_INFO_1; PJobs = ^TJobs; var hPrinter: THandle; bytesNeeded, numJobs, i: Cardinal; pJ: PJobs; printerTxt, statusTxt, dokumentTxt: String; begin // tjektype = 'Opstart' skal vise alarmlinie, samt opdatere listbox1 // 'Test' skal vise alarmlinie, samt opdatere listbox1 // 'Timer' skal kun vise alarmlinie if (PrinterNavn = 'Ingen') and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then begin parentForm.LogMessage( 'Der er fravalgt printer i dette program' ); end else if (Printer.Printers.Count = 0) and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then begin parentForm.LogMessage( 'Der er ikke installeret en printer på denne PC' ); end else begin hPrinter := GetCurrentPrinterHandle; try EnumJobs(hPrinter, 0, 1000, 1, nil, 0, bytesNeeded, numJobs); pJ := AllocMem(bytesNeeded); if not EnumJobs(hPrinter, 0, 1000, 1, pJ, bytesNeeded, bytesNeeded, numJobs) then RaiseLastWin32Error; if numJobs = 0 then begin if (tjektype = 'Test') then begin parentForm.LogMessage( printerTxt + ': Ingen dokumenter i kø' ); end; parentForm.SetPrinterstatusText('', false); end else // så er der kø til printeren begin printerTxt := SavePChar(pJ^[0].pPrinterName); if (tjektype = 'Opstart') or (tjektype = 'Test') then begin parentForm.LogMessage( IntToStr(numJobs) + ' dokument(er) i kø til printer: ' + printerTxt ); end; for i := 0 to Pred(numJobs) do begin printerTxt := SavePChar(pJ^[i].pPrinterName); statusTxt := 'Ukendt'; if (IntToStr(pJ^[i].Status) = '0') then statusTxt := 'Venter...'; if (IntToStr(pJ^[i].Status) = '4096') then statusTxt := 'Printer...'; if (IntToStr(pJ^[i].Status) = '8210') then statusTxt := 'Printerfejl'; if (IntToStr(pJ^[i].Status) = '8214') then statusTxt := 'Sletter print...'; dokumentTxt := SavePChar(pJ^[i].pDocument); if (dokumentTxt = '') then dokumentTxt := 'Uden navn'; if (tjektype = 'Opstart') or (tjektype = 'Test') then begin parentForm.LogMessage( Format('Printer %s, Dokument %d: %s, Status (%d): %s', [printerTxt, i+1, dokumentTxt, pJ^[i].Status, statusTxt]) ); end; if (i = 0) then begin parentForm.SetPrinterstatusText(printerTxt + ': ' + IntToStr(numJobs) + ' dokument(er) in kø. Dokument status: ' + statusTxt, (numJobs > 3) ); end; end; end finally ClosePrinter(hPrinter); end; end; end; procedure TLabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = ''); begin with Printer do begin BeginDoc; Canvas.Font.Size := Config.FontSizeRuteLille; if (kontrolKoreliste <> '') then begin Canvas.TextOut(Config.XPosRute, Config.YPosRute, kontrolKoreliste); end else begin Canvas.TextOut(Config.XPosRute, Config.YPosRute, RuteNummer); end; Canvas.Font.Size := Config.FontSizeKorelisteLille; Canvas.TextOut(Config.XPosKoreliste, Config.YPosKoreliste, Koreliste); if (Config.Sted = 'DBK') or (Config.Sted = '04') then begin Canvas.Font.Size := Config.FontSizeSorteringsfelt1; Canvas.TextOut(Config.XPosSorteringsfelt1,Config.YPosSorteringsfelt1, DBKbane); // sorteringsoplysning 1 Canvas.Font.Size := Config.FontSizeSorteringsfelt1; Canvas.TextOut(Config.XPosSorteringsfelt2, Config.YPosSorteringsfelt2, Leveringssted); // sorteringsoplysning 2 end; Canvas.Font.Size := Config.FontSizeKommentar; Kommentar := StringReplace(Kommentar, #$A, ' - ', [rfReplaceAll, rfIgnoreCase]); Kommentar := StringReplace(Kommentar, 'PAKKE ER SCANNET', '', [rfReplaceAll, rfIgnoreCase]); Canvas.TextOut(Config.XPosKommentar, Config.YPosKommentar, Kommentar); // Kan ikke lave linieskift (se tidligere kommentar om samme) if SmsKode <> '' then begin Canvas.Font.Size := Config.FontSizeSmskode; Canvas.TextOut(Config.XPosKommentar, Config.YPosSmskode, concat('CODE: ', SmsKode)); end; Canvas.Font.Size := Config.FontSizeBoghandler; Canvas.TextOut(Config.XPosBoghandler, Config.YPosBoghandler, BoghandlerNavn); EndDoc; end; end; // ToDo: PrintPakkeshopLabel() procedure TLabelPrint.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel); var XForm, XFormOld: TXForm; //Bruges til rotate X-formation Angle: integer; gMode: integer; Dirigering: string; begin with Printer do begin BeginDoc(); Canvas.Font.Size := 16; Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + ' ' + PakkeshopLabel.Overskrift); Canvas.TextOut(25, 90, PakkeshopLabel.Navn ); Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn ); Canvas.TextOut(25, 180, PakkeshopLabel.Postnr ); Canvas.Font.Size := 9; // Skriv ikke 'Pakkeshop' overskrift hvis det er en shop2direkte if ( (PakkeshopLabel.Shop2Direkte = '') OR (PakkeshopLabel.Shop2Direkte = '0') ) then begin Canvas.TextOut(110, 240, 'Pakkeshop:'); end; Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn); Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr); Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr); Canvas.TextOut(350, 240, 'Afsender:'); Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn); Canvas.TextOut(350, 300, PakkeshopLabel.AfsenderAdresse); Canvas.TextOut(350, 330, PakkeshopLabel.AfsenderPostnr); Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr; if ( PakkeshopLabel.Koreliste <> '') then begin Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste; end; Canvas.Font.Size := 12; Canvas.TextOut(15, 370, Dirigering); //Tegn adskillelses linier Canvas.Pen.Width := 2; //Øverste linie Canvas.MoveTo(20,80); Canvas.LineTo(600,80); // Midterste linie Canvas.MoveTo( 20, 240); Canvas.LineTo(600, 240); //Nederste linie Canvas.MoveTo( 20, 370); Canvas.LineTo(600, 370); //Tegn skrå streger over afsender Canvas.Pen.Width := 1; Canvas.MoveTo(600, 250); Canvas.LineTo(350, 360); Canvas.MoveTo(600, 360); Canvas.LineTo(350, 250); // Resten af rutinen vedr genering og placering af Barcode BarCode.BarCodeType := bcCode128; BarCode.Code128Subset := csCodeC; BarCode.Code := PakkeshopLabel.Stregkode; BarCode.Validate(True); //Start X-formation //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) ); GetWorldTransform(Canvas.Handle, XFormOld); Angle := 270; XForm.eM11 := Cos(DegToRad(Angle)); XForm.eM12 := Sin(DegToRad(Angle)); XForm.eM21 := -Sin(DegToRad(Angle)); XForm.eM22 := Cos(DegToRad(Angle)); XForm.eDx := 0; XForm.eDy := 0; gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED); SetWorldTransform(Canvas.Handle, XForm); // PaintToCanvasSize arbejder i Inches // Første pos argument bliver nu Y og skal være negativ for at rykke den ned //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre BarCode.PaintToCanvasSize(Printer.Canvas, -1.8, 3.3, 0.4); SetWorldTransform(Canvas.Handle, XFormOld); SetGraphicsMode(Canvas.Handle, gMode); EndDoc(); end; end; function TLabelPrint.SavePChar(p: PChar): PChar; const error: PChar = 'Nil'; begin if not Assigned(p) then Result := error else Result := p; end; // Online zpl viewer // http://labelary.com/viewer.html procedure TLabelPrint.TestZpl(); var zpl: string; begin zpl := '^XA'#13#10 + '^PON'#13#10 + '^FWN'#13#10 + '^FX Top section with company logo, name and address.'#13#10 + '^CF0,60'#13#10 + '^FO50,50^GB100,100,100^FS'#13#10+ '^FO75,75^FR^GB100,100,100^FS'#13#10+ '^FO88,88^GB50,50,50^FS'#13#10+ '^FO220,50^FDInternational Shipping, Inc.^FS'#13#10+ '^CF0,40'#13#10+ '^FO220,100^FD1000 Shipping Lane^FS'#13#10+ '^FO220,135^FDShelbyville TN 38102^FS'#13#10+ '^FO220,170^FDUnited States (USA)^FS'#13#10+ '^FO50,250^GB700,1,3^FS'#13#10 + '^XZ'#13#10 ; PrintZpl(zpl); end; procedure TLabelPrint.PrintZPL( ZplData : string); var ADevice, ADeviceName, ADevicePort: array[0..255]of Char; PrinterHandle: THandle; DocInfo: TDocInfo1; dwJob: cardinal; dwBytesWritten: cardinal; AUtf8: UTF8string; ADeviceMode: THandle; begin Printer.GetPrinter(ADevice, ADeviceName, ADevicePort, ADeviceMode); if not OpenPrinter(ADevice, PrinterHandle, nil) then begin Exit; parentForm.Msg('error on openprinter'); end; //Fill in the structure with info about this "document" DocInfo.pDocName := PChar('Spooler Document Name'); DocInfo.pOutputFile := nil; DocInfo.pDatatype := 'RAW'; //Inform the spooler the document is beginning dwJob := StartDocPrinter(PrinterHandle, 1, @DocInfo); if dwJob = 0 then begin ClosePrinter(PrinterHandle); PrinterHandle := 0; Exit; end; //Start a page if not StartPagePrinter(PrinterHandle) then begin EndDocPrinter(PrinterHandle); ClosePrinter(PrinterHandle); PrinterHandle := 0; Exit; end; //your zebra code... AUtf8 := UTF8string(ZplData); WritePrinter(PrinterHandle, @AUtf8[1], Length(AUtf8), dwBytesWritten); //End the page if not EndPagePrinter(PrinterHandle) then begin EndDocPrinter(PrinterHandle); ClosePrinter(PrinterHandle); PrinterHandle := 0; Exit; end; //Inform the spooler that the document is ending if not EndDocPrinter(PrinterHandle) then begin ClosePrinter(PrinterHandle); PrinterHandle := 0; Exit; end; //Tidy up the printer handle ClosePrinter(PrinterHandle); PrinterHandle := 0; end; function TLabelPrint.GetPrinterCount() : Integer; begin Result := Printer.Printers.Count; end; end.