unit LabelPrint; interface uses ParentForm, LabelData, Configuration, StBarc; type TLabelPrint = class constructor Create( p : IParentForm; var Configuration : TConfiguration; PrinterNavn: String); procedure CheckPrintQue(tjektype : string; PrinterNavn : String); procedure PrintLabel( Stregkode : String); procedure PrintTestLabel(); function GetPrinterCount() : Integer; private parentForm : IParentForm; Barcode : TStBarcode; var Config: TConfiguration; procedure PrintZPL( ZplData : string); procedure PrintLabelData( LabelData : TLabelData); procedure PrintSimpelLabel( LabelData : TLabelData) ; procedure PrintFuldPakkeLabel( PakkeshopLabel : TLabelData); procedure PrintFuldPakkeLabelLille( PakkeshopLabel : TLabelData); procedure PrintFuldPakkeLabelStor( PakkeshopLabel : TLabelData); procedure SendTilPrinter_old(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = ''); procedure PrintDaodirekteLabel_old( RuteNummer, Kommentar, BoghandlerNavn : String) ; 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 PrinTLabelData Forms, IdHTTP, Graphics, XMLDoc ; 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_old( 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; Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725 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; Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725 end; procedure TLabelPrint.PrintLabel( Stregkode : String); var url: String; response: String; httpClient: TIdHTTP; XMLDocument1: TXMLDocument; LabelData: TLabelData; begin url := Format(Config.URLPrintLabel, [Stregkode] ); httpClient := TIdHTTP.Create(); httpClient.ReadTimeout := 1000;//max 1 secound httpClient.ConnectTimeout := 1000; response := httpClient.Get(url); httpClient.Free(); XMLDocument1 := parentForm.GetXMLDocument(); XMLDocument1.LoadFromXML(response); LabelData := TLabelData.Create(XMLDocument1); PrintLabelData(LabelData); LabelData.Free(); end; procedure TLabelPrint.PrintTestLabel(); var LabelData : TLabelData; begin LabelData := TLabelData.Create(nil); LabelData.LabelType := 'simpel'; LabelData.SimpelLinie1 := 'Test Label'; LabelData.SimpelLinie2 := 'Test Label'; LabelData.SimpelLinie3 := 'Test Label'; PrintLabelData(Labeldata); LabelData.Free(); end; procedure TLabelPrint.PrintLabelData( LabelData : TLabelData); begin if LabelData.LabelType = 'zpl' then begin PrintZPL(LabelData.ZPL); end else if (LabelData.LabelType = 'simpel') then begin PrintSimpelLabel(LabelData); end else begin PrintFuldPakkeLabel(LabelData); end; end; procedure TLabelPrint.SendTilPrinter_old(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; Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725 end; procedure TLabelPrint.PrintFuldPakkeLabel( PakkeshopLabel : TLabelData); begin if (Config.LabelStor = 1) then begin PrintFuldPakkeLabelStor( PakkeshopLabel ); end else begin PrintFuldPakkeLabelLille( PakkeshopLabel ); end; end; // Bruges til label der passer til 60x100 procedure TLabelPrint.PrintFuldPakkeLabelLille( PakkeshopLabel : TLabelData); var XForm, XFormOld: TXForm; //Bruges til rotate X-formation Angle: integer; gMode: integer; Dirigering: string; begin with Printer do begin BeginDoc(); Canvas.Font.Size := 15; Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + ' ' + PakkeshopLabel.Overskrift); Canvas.TextOut(25, 90, PakkeshopLabel.Navn ); Canvas.TextOut(25, 140, PakkeshopLabel.Vejnavn ); Canvas.TextOut(25, 190, PakkeshopLabel.Postnr ); Canvas.Font.Size := 9; // Skriv ikke 'Pakkeshop' overskrift hvis det er en shop2direkte if ( PakkeshopLabel.PakkeshopNavn <> '' ) then begin Canvas.TextOut(110, 240, 'Pakkeshop:'); Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn); Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr); Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr); end; 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; Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725 end; // Bruges til label der passer til 100x150 procedure TLabelPrint.PrintFuldPakkeLabelStor( PakkeshopLabel : TLabelData); var XForm, XFormOld: TXForm; //Bruges til rotate X-formation Angle: integer; gMode: integer; Dirigering: string; BarcodeRect : TRect; begin with Printer do begin BeginDoc(); Canvas.Font.Style := [TFontStyle.fsBold]; Canvas.Font.Size := 16; Canvas.TextOut(25,25, 'Code: ' + PakkeshopLabel.Tjekkode + ' ' + PakkeshopLabel.Overskrift); Canvas.TextOut(80, 220, PakkeshopLabel.Navn ); Canvas.TextOut(80, 270, PakkeshopLabel.Vejnavn ); Canvas.TextOut(80, 320, PakkeshopLabel.Postnr ); Canvas.Font.Size := 9; // Skriv ikke 'Pakkeshop' overskrift hvis det er en shop2direkte if ( PakkeshopLabel.PakkeshopNavn <> '' ) then begin Canvas.TextOut(170, 460, 'Pakkeshop:'); Canvas.TextOut(170, 490, PakkeshopLabel.PakkeshopNavn); Canvas.TextOut(170, 520, PakkeshopLabel.PakkeshopAddr); Canvas.TextOut(170, 550, PakkeshopLabel.PakkeshopPostnr); end; Canvas.TextOut(550, 460, 'Afsender:'); Canvas.TextOut(550, 490, PakkeshopLabel.AfsenderNavn); Canvas.TextOut(550, 520, PakkeshopLabel.AfsenderAdresse); Canvas.TextOut(550, 550, 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(40, 680, Dirigering); //Tegn adskillelses linier Canvas.Pen.Width := 2; //Øverste linie Canvas.MoveTo( 40, 180); Canvas.LineTo(900, 180); // Midterste linie Canvas.MoveTo( 40, 440); Canvas.LineTo(900, 440); //Nederste linie Canvas.MoveTo( 40, 640); Canvas.LineTo(900, 640); //Tegn skrå streger over afsender Canvas.Pen.Width := 1; Canvas.MoveTo(840, 450); Canvas.LineTo(540, 590); Canvas.MoveTo(840, 590); Canvas.LineTo(540, 450); // Resten af rutinen vedr genering og placering af Barcode Barcode.Font.Size := 9; Barcode.BarToSpaceRatio := 0.9; BarCode.BarCodeType := bcCode128; BarCode.Code128Subset := csCodeC; BarCode.Code := PakkeshopLabel.Stregkode; BarCode.Validate(True); // parentForm.Msg( inttostr( Barcode.Font.Size) );//Default 8 // parentForm.Msg( Double.ToString( Barcode.BarNarrowToWideRatio) );//Default 2 // parentForm.Msg( Double.ToString( Barcode.BarToSpaceRatio) );//Default 1 // parentForm.Msg( Double.ToString(BarCode.Width ) );//default 200 //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, -2.7, 4.8, 0.5); SetWorldTransform(Canvas.Handle, XFormOld); SetGraphicsMode(Canvas.Handle, gMode); EndDoc(); end; Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725 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 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; procedure TLabelPrint.PrintSimpelLabel( LabelData : TLabelData) ; begin with Printer do begin BeginDoc; Canvas.Font.Size := 20; Canvas.TextOut(10, 20, LabelData.SimpelLinie1); Canvas.TextOut(10, 120, LabelData.SimpelLinie2); Canvas.TextOut(10, 220, LabelData.SimpelLinie3); EndDoc; end; Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725 end; function TLabelPrint.GetPrinterCount() : Integer; begin Result := Printer.Printers.Count; end; end.