dao/DelphiScanner/LabelPrint.pas

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 PrintLabel( Stregkode : String);

    procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');

    procedure PrintFuldPakkeLabel( PakkeshopLabel : TPakkeshopLabel);
    procedure PrintFuldPakkeLabelLille( PakkeshopLabel : TPakkeshopLabel);
    procedure PrintFuldPakkeLabelStor( 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,
  IdHTTP,
  Graphics
  ;


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;


  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;


begin

  url := Format(Config.URLPrintLabel, [Stregkode] );

  httpClient := TIdHTTP.Create();
  httpClient.ReadTimeout := 1000;//max 1 secound
  httpClient.ConnectTimeout := 1000;

  response := httpClient.Get(url);
  httpClient.Free();


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;


    Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725

end;


procedure TLabelPrint.PrintFuldPakkeLabel( PakkeshopLabel : TPakkeshopLabel);
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 : 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.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 : TPakkeshopLabel);
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
// 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.
1	torben	2705	unit LabelPrint;
2
3			interface
4
5			uses
6			ParentForm,
7			PakkeshopLabels,
8			Configuration,
9	torben	3047	StBarc;
10	torben	2705
11
12			type
13			TLabelPrint = class
14
15			constructor Create( p : IParentForm; var Configuration : TConfiguration; PrinterNavn: String);
16
17			procedure CheckPrintQue(tjektype : string; PrinterNavn : String);
18
19	torben	3077	procedure PrintLabel( Stregkode : String);
20
21	torben	2705	procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');
22
23	torben	3077	procedure PrintFuldPakkeLabel( PakkeshopLabel : TPakkeshopLabel);
24	torben	3088	procedure PrintFuldPakkeLabelLille( PakkeshopLabel : TPakkeshopLabel);
25			procedure PrintFuldPakkeLabelStor( PakkeshopLabel : TPakkeshopLabel);
26	torben	2705
27	torben	3077
28	torben	2705	procedure PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn : String) ;
29
30	torben	3038	procedure TestZpl();
31			procedure PrintZPL( ZplData : string);
32
33	torben	2705	function GetPrinterCount() : Integer;
34
35			private
36			parentForm : IParentForm;
37			Barcode : TStBarcode;
38			var Config: TConfiguration;
39
40
41			function SavePChar(p: PChar): PChar;
42			function GetCurrentPrinterHandle(): THandle;
43
44			end;
45
46			function GetPixelsPerInchX(): Integer;
47			function GetPixelsPerInchY(): Integer;
48
49			implementation
50			uses
51			Printers,
52			WinSpool,
53			Windows,
54			SysUtils, //Format
55			Math, // DegToRad() bruges i PrintPakkeshopLabel
56	torben	3077	Forms,
57	torben	3088	IdHTTP,
58			Graphics
59	torben	2705	;
60
61
62
63
64			function GetPixelsPerInchX(): Integer;
65			begin
66			Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)
67			end;
68
69			function GetPixelsPerInchY(): Integer;
70			begin
71			Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
72			end;
73
74
75
76			constructor TLabelPrint.Create( p : IParentForm; var Configuration : TConfiguration; PrinterNavn: String);
77			var
78			FormObj : TForm;
79			printerInd : integer;
80			begin
81			parentForm := p;
82			Config := Configuration;
83
84			FormObj := parentForm.GetFormObject();
85
86
87			Barcode := TStBarcode.Create(FormObj);//Dynamisk oprettelse af Barcode component
88
89
90			if PrinterNavn<> '' then
91			begin
92			printerInd := Printer.Printers.IndexOf(PrinterNavn);
93			if printerInd >= 0 then
94			begin
95			Printer.PrinterIndex := printerInd;
96			end;
97			end;
98
99			end;
100
101
102
103
104			function TLabelPrint.GetCurrentPrinterHandle(): THandle;
105			var
106			Device, Driver, Port: array[0..255] of Char;
107			hDeviceMode: THandle;
108			begin
109			Printer.GetPrinter(Device, Driver, Port, hDeviceMode);
110			if not OpenPrinter(@Device, Result, nil) then
111			RaiseLastWin32Error;
112			end;
113
114
115			procedure TLabelPrint.PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn : String) ;
116			begin
117			with Printer do
118			begin
119			BeginDoc;
120	torben	3086
121	torben	2705	Canvas.Font.Size := Config.FontSizeRute;
122			if (Length(RuteNummer) > 7) then
123			begin
124			Canvas.Font.Size := Config.FontSizeRuteLille;
125			end;
126			Canvas.TextOut(Config.XPosRute, Config.YPosRute, RuteNummer);
127			Canvas.Font.Size := Config.FontSizeKommentar;
128			Kommentar := StringReplace(Kommentar, #$A, ' - ', [rfReplaceAll, rfIgnoreCase]);
129			if (Kommentar = 'Ok') or (Kommentar = 'ALLEREDE SCANNET') then
130			begin
131			Kommentar := '';
132			end;
133			if (BoghandlerNavn = 'PAKKE ER SCANNET') then
134			begin
135			BoghandlerNavn := '';
136			end;
137			Canvas.TextOut(Config.XPosKommentar, Config.YPosKommentar, Kommentar); // Kan ikke lave linieskift (se tidligere kommentar om samme)
138			Canvas.Font.Size := Config.FontSizeBoghandler;
139			Canvas.TextOut(Config.XPosBoghandler, Config.YPosBoghandler, BoghandlerNavn);
140			EndDoc;
141			end;
142	torben	3086
143
144
145			Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
146
147	torben	2705	end;
148
149
150
151			procedure TLabelPrint.CheckPrintQue(tjektype : string; PrinterNavn : String);
152			type
153			TJobs = array [0..1000] of JOB_INFO_1;
154			PJobs = ^TJobs;
155			var
156			hPrinter: THandle;
157			bytesNeeded, numJobs, i: Cardinal;
158			pJ: PJobs;
159			printerTxt, statusTxt, dokumentTxt: String;
160			begin
161
162			// tjektype = 'Opstart' skal vise alarmlinie, samt opdatere listbox1
163			// 'Test' skal vise alarmlinie, samt opdatere listbox1
164			// 'Timer' skal kun vise alarmlinie
165
166			if (PrinterNavn = 'Ingen') and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then
167			begin
168
169			parentForm.LogMessage( 'Der er fravalgt printer i dette program' );
170			end
171			else if (Printer.Printers.Count = 0) and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then
172			begin
173			parentForm.LogMessage( 'Der er ikke installeret en printer p� denne PC' );
174			end
175			else
176			begin
177			hPrinter := GetCurrentPrinterHandle;
178			try
179			EnumJobs(hPrinter, 0, 1000, 1, nil, 0, bytesNeeded, numJobs);
180			pJ := AllocMem(bytesNeeded);
181			if not EnumJobs(hPrinter, 0, 1000, 1, pJ, bytesNeeded, bytesNeeded, numJobs) then
182			RaiseLastWin32Error;
183
184			if numJobs = 0 then
185			begin
186			if (tjektype = 'Test') then
187			begin
188			parentForm.LogMessage( printerTxt + ': Ingen dokumenter i k�' );
189
190			end;
191			parentForm.SetPrinterstatusText('', false);
192			end
193			else // s� er der k� til printeren
194			begin
195			printerTxt := SavePChar(pJ^[0].pPrinterName);
196			if (tjektype = 'Opstart') or (tjektype = 'Test') then
197			begin
198
199
200			parentForm.LogMessage( IntToStr(numJobs) + ' dokument(er) i k� til printer: ' + printerTxt );
201
202			end;
203			for i := 0 to Pred(numJobs) do
204			begin
205			printerTxt := SavePChar(pJ^[i].pPrinterName);
206			statusTxt := 'Ukendt';
207			if (IntToStr(pJ^[i].Status) = '0') then
208			statusTxt := 'Venter...';
209			if (IntToStr(pJ^[i].Status) = '4096') then
210			statusTxt := 'Printer...';
211			if (IntToStr(pJ^[i].Status) = '8210') then
212			statusTxt := 'Printerfejl';
213			if (IntToStr(pJ^[i].Status) = '8214') then
214			statusTxt := 'Sletter print...';
215
216			dokumentTxt := SavePChar(pJ^[i].pDocument);
217			if (dokumentTxt = '') then
218			dokumentTxt := 'Uden navn';
219
220			if (tjektype = 'Opstart') or (tjektype = 'Test') then
221			begin
222
223			parentForm.LogMessage( Format('Printer %s, Dokument %d: %s, Status (%d): %s', [printerTxt, i+1, dokumentTxt, pJ^[i].Status, statusTxt]) );
224
225			end;
226
227			if (i = 0) then
228			begin
229			parentForm.SetPrinterstatusText(printerTxt + ': ' + IntToStr(numJobs) + ' dokument(er) in k�. Dokument status: ' + statusTxt, (numJobs > 3) );
230			end;
231
232			end;
233			end
234			finally
235			ClosePrinter(hPrinter);
236			end;
237			end;
238	torben	3086
239
240			Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
241
242	torben	2705	end;
243
244
245	torben	3077	procedure TLabelPrint.PrintLabel( Stregkode : String);
246			var
247			url: String;
248			response: String;
249
250			httpClient: TIdHTTP;
251
252
253
254			begin
255
256	torben	3088	url := Format(Config.URLPrintLabel, [Stregkode] );
257
258	torben	3077	httpClient := TIdHTTP.Create();
259			httpClient.ReadTimeout := 1000;//max 1 secound
260			httpClient.ConnectTimeout := 1000;
261
262			response := httpClient.Get(url);
263			httpClient.Free();
264
265
266
267
268			end;
269
270	torben	2705	procedure TLabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');
271			begin
272			with Printer do
273			begin
274			BeginDoc;
275
276			Canvas.Font.Size := Config.FontSizeRuteLille;
277			if (kontrolKoreliste <> '') then
278			begin
279			Canvas.TextOut(Config.XPosRute, Config.YPosRute, kontrolKoreliste);
280			end
281			else
282			begin
283			Canvas.TextOut(Config.XPosRute, Config.YPosRute, RuteNummer);
284			end;
285			Canvas.Font.Size := Config.FontSizeKorelisteLille;
286			Canvas.TextOut(Config.XPosKoreliste, Config.YPosKoreliste, Koreliste);
287			if (Config.Sted = 'DBK') or (Config.Sted = '04') then
288			begin
289			Canvas.Font.Size := Config.FontSizeSorteringsfelt1;
290			Canvas.TextOut(Config.XPosSorteringsfelt1,Config.YPosSorteringsfelt1, DBKbane); // sorteringsoplysning 1
291			Canvas.Font.Size := Config.FontSizeSorteringsfelt1;
292			Canvas.TextOut(Config.XPosSorteringsfelt2, Config.YPosSorteringsfelt2, Leveringssted); // sorteringsoplysning 2
293			end;
294			Canvas.Font.Size := Config.FontSizeKommentar;
295
296			Kommentar := StringReplace(Kommentar, #$A, ' - ', [rfReplaceAll, rfIgnoreCase]);
297			Kommentar := StringReplace(Kommentar, 'PAKKE ER SCANNET', '', [rfReplaceAll, rfIgnoreCase]);
298
299			Canvas.TextOut(Config.XPosKommentar, Config.YPosKommentar, Kommentar); // Kan ikke lave linieskift (se tidligere kommentar om samme)
300			if SmsKode <> '' then
301			begin
302			Canvas.Font.Size := Config.FontSizeSmskode;
303			Canvas.TextOut(Config.XPosKommentar, Config.YPosSmskode, concat('CODE: ', SmsKode));
304			end;
305			Canvas.Font.Size := Config.FontSizeBoghandler;
306			Canvas.TextOut(Config.XPosBoghandler, Config.YPosBoghandler, BoghandlerNavn);
307
308			EndDoc;
309			end;
310	torben	3086
311
312			Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
313
314	torben	2705	end;
315
316
317	torben	3088	procedure TLabelPrint.PrintFuldPakkeLabel( PakkeshopLabel : TPakkeshopLabel);
318			begin
319	torben	3091	if (Config.LabelStor = 1) then
320			begin
321			PrintFuldPakkeLabelStor( PakkeshopLabel );
322	torben	2705
323	torben	3091	end
324			else
325			begin
326			PrintFuldPakkeLabelLille( PakkeshopLabel );
327
328			end;
329
330	torben	3088	end;
331
332			// Bruges til label der passer til 60x100
333			procedure TLabelPrint.PrintFuldPakkeLabelLille( PakkeshopLabel : TPakkeshopLabel);
334	torben	2705	var
335			XForm, XFormOld: TXForm; //Bruges til rotate X-formation
336			Angle: integer;
337			gMode: integer;
338			Dirigering: string;
339
340			begin
341			with Printer do
342			begin
343			BeginDoc();
344
345
346			Canvas.Font.Size := 16;
347			Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + ' ' + PakkeshopLabel.Overskrift);
348
349
350
351			Canvas.TextOut(25, 90, PakkeshopLabel.Navn );
352			Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn );
353			Canvas.TextOut(25, 180, PakkeshopLabel.Postnr );
354
355
356			Canvas.Font.Size := 9;
357	torben	2790
358
359			// Skriv ikke 'Pakkeshop' overskrift hvis det er en shop2direkte
360	torben	3077	if ( PakkeshopLabel.PakkeshopNavn <> '' ) then
361	torben	2790	begin
362			Canvas.TextOut(110, 240, 'Pakkeshop:');
363	torben	3077	Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);
364			Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);
365			Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);
366
367	torben	2790	end;
368
369
370	torben	2705
371			Canvas.TextOut(350, 240, 'Afsender:');
372			Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);
373			Canvas.TextOut(350, 300, PakkeshopLabel.AfsenderAdresse);
374			Canvas.TextOut(350, 330, PakkeshopLabel.AfsenderPostnr);
375
376			Dirigering := PakkeshopLabel.PakkeshopSted + ' \| ' + PakkeshopLabel.PakkeshopTurid + ' \| ' + PakkeshopLabel.PakkeshopNr;
377			if ( PakkeshopLabel.Koreliste <> '') then
378			begin
379			Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
380			end;
381
382
383			Canvas.Font.Size := 12;
384			Canvas.TextOut(15, 370, Dirigering);
385
386
387
388
389
390			//Tegn adskillelses linier
391			Canvas.Pen.Width := 2;
392			//�verste linie
393			Canvas.MoveTo(20,80);
394			Canvas.LineTo(600,80);
395
396			// Midterste linie
397			Canvas.MoveTo( 20, 240);
398			Canvas.LineTo(600, 240);
399
400			//Nederste linie
401			Canvas.MoveTo( 20, 370);
402			Canvas.LineTo(600, 370);
403
404
405			//Tegn skr� streger over afsender
406			Canvas.Pen.Width := 1;
407			Canvas.MoveTo(600, 250);
408			Canvas.LineTo(350, 360);
409			Canvas.MoveTo(600, 360);
410			Canvas.LineTo(350, 250);
411
412
413
414
415			// Resten af rutinen vedr genering og placering af Barcode
416
417			BarCode.BarCodeType := bcCode128;
418			BarCode.Code128Subset := csCodeC;
419			BarCode.Code := PakkeshopLabel.Stregkode;
420			BarCode.Validate(True);
421
422			//Start X-formation
423			//ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
424			GetWorldTransform(Canvas.Handle, XFormOld);
425
426			Angle := 270;
427			XForm.eM11 := Cos(DegToRad(Angle));
428			XForm.eM12 := Sin(DegToRad(Angle));
429			XForm.eM21 := -Sin(DegToRad(Angle));
430			XForm.eM22 := Cos(DegToRad(Angle));
431			XForm.eDx := 0;
432			XForm.eDy := 0;
433
434			gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
435			SetWorldTransform(Canvas.Handle, XForm);
436
437			// PaintToCanvasSize arbejder i Inches
438			// F�rste pos argument bliver nu Y og skal v�re negativ for at rykke den ned
439			//Anden pos er X og skal v�re positiv for at justere ind fra venstre mod h�jre
440
441			BarCode.PaintToCanvasSize(Printer.Canvas, -1.8, 3.3, 0.4);
442
443
444			SetWorldTransform(Canvas.Handle, XFormOld);
445			SetGraphicsMode(Canvas.Handle, gMode);
446
447			EndDoc();
448			end;
449
450
451	torben	3086	Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
452
453	torben	2705	end;
454
455
456	torben	3088	// Bruges til label der passer til 100x150
457			procedure TLabelPrint.PrintFuldPakkeLabelStor( PakkeshopLabel : TPakkeshopLabel);
458			var
459			XForm, XFormOld: TXForm; //Bruges til rotate X-formation
460			Angle: integer;
461			gMode: integer;
462			Dirigering: string;
463			BarcodeRect : TRect;
464
465			begin
466			with Printer do
467			begin
468			BeginDoc();
469
470
471
472			Canvas.Font.Style := [TFontStyle.fsBold];
473			Canvas.Font.Size := 16;
474			Canvas.TextOut(25,25, 'Code: ' + PakkeshopLabel.Tjekkode + ' ' + PakkeshopLabel.Overskrift);
475
476
477
478			Canvas.TextOut(80, 220, PakkeshopLabel.Navn );
479			Canvas.TextOut(80, 270, PakkeshopLabel.Vejnavn );
480			Canvas.TextOut(80, 320, PakkeshopLabel.Postnr );
481
482
483			Canvas.Font.Size := 9;
484
485
486			// Skriv ikke 'Pakkeshop' overskrift hvis det er en shop2direkte
487			if ( PakkeshopLabel.PakkeshopNavn <> '' ) then
488			begin
489			Canvas.TextOut(170, 460, 'Pakkeshop:');
490			Canvas.TextOut(170, 490, PakkeshopLabel.PakkeshopNavn);
491			Canvas.TextOut(170, 520, PakkeshopLabel.PakkeshopAddr);
492			Canvas.TextOut(170, 550, PakkeshopLabel.PakkeshopPostnr);
493
494			end;
495
496
497
498			Canvas.TextOut(550, 460, 'Afsender:');
499			Canvas.TextOut(550, 490, PakkeshopLabel.AfsenderNavn);
500			Canvas.TextOut(550, 520, PakkeshopLabel.AfsenderAdresse);
501			Canvas.TextOut(550, 550, PakkeshopLabel.AfsenderPostnr);
502
503			Dirigering := PakkeshopLabel.PakkeshopSted + ' \| ' + PakkeshopLabel.PakkeshopTurid + ' \| ' + PakkeshopLabel.PakkeshopNr;
504			if ( PakkeshopLabel.Koreliste <> '') then
505			begin
506			Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
507			end;
508
509
510			Canvas.Font.Size := 12;
511			Canvas.TextOut(40, 680, Dirigering);
512
513
514
515
516
517			//Tegn adskillelses linier
518			Canvas.Pen.Width := 2;
519			//�verste linie
520			Canvas.MoveTo( 40, 180);
521			Canvas.LineTo(900, 180);
522
523			// Midterste linie
524			Canvas.MoveTo( 40, 440);
525			Canvas.LineTo(900, 440);
526
527			//Nederste linie
528			Canvas.MoveTo( 40, 640);
529			Canvas.LineTo(900, 640);
530
531
532			//Tegn skr� streger over afsender
533			Canvas.Pen.Width := 1;
534			Canvas.MoveTo(840, 450);
535			Canvas.LineTo(540, 590);
536			Canvas.MoveTo(840, 590);
537			Canvas.LineTo(540, 450);
538
539
540
541			// Resten af rutinen vedr genering og placering af Barcode
542
543			Barcode.Font.Size := 9;
544			Barcode.BarToSpaceRatio := 0.9;
545
546
547			BarCode.BarCodeType := bcCode128;
548			BarCode.Code128Subset := csCodeC;
549			BarCode.Code := PakkeshopLabel.Stregkode;
550			BarCode.Validate(True);
551
552
553			// parentForm.Msg( inttostr( Barcode.Font.Size) );//Default 8
554			// parentForm.Msg( Double.ToString( Barcode.BarNarrowToWideRatio) );//Default 2
555			// parentForm.Msg( Double.ToString( Barcode.BarToSpaceRatio) );//Default 1
556			// parentForm.Msg( Double.ToString(BarCode.Width ) );//default 200
557
558
559			//Start X-formation
560			//ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
561			GetWorldTransform(Canvas.Handle, XFormOld);
562
563			Angle := 270;
564			XForm.eM11 := Cos(DegToRad(Angle));
565			XForm.eM12 := Sin(DegToRad(Angle));
566			XForm.eM21 := -Sin(DegToRad(Angle));
567			XForm.eM22 := Cos(DegToRad(Angle));
568			XForm.eDx := 0;
569			XForm.eDy := 0;
570
571			gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
572			SetWorldTransform(Canvas.Handle, XForm);
573
574			// PaintToCanvasSize arbejder i Inches
575			// F�rste pos argument bliver nu Y og skal v�re negativ for at rykke den ned
576			//Anden pos er X og skal v�re positiv for at justere ind fra venstre mod h�jre
577
578			BarCode.PaintToCanvasSize(Printer.Canvas, -2.7, 4.8, 0.5);
579
580
581
582
583			SetWorldTransform(Canvas.Handle, XFormOld);
584			SetGraphicsMode(Canvas.Handle, gMode);
585
586			EndDoc();
587			end;
588
589
590			Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
591			end;
592
593	torben	2705	function TLabelPrint.SavePChar(p: PChar): PChar;
594			const
595			error: PChar = 'Nil';
596			begin
597			if not Assigned(p) then
598			Result := error
599			else
600			Result := p;
601			end;
602
603	torben	3038	// Online zpl viewer
604			// http://labelary.com/viewer.html
605			procedure TLabelPrint.TestZpl();
606			var
607			zpl: string;
608			begin
609			zpl :=
610			'^XA'#13#10 +
611			'^PON'#13#10 +
612			'^FWN'#13#10 +
613	torben	2705
614	torben	3038	'^FX Top section with company logo, name and address.'#13#10 +
615			'^CF0,60'#13#10 +
616			'^FO50,50^GB100,100,100^FS'#13#10+
617			'^FO75,75^FR^GB100,100,100^FS'#13#10+
618			'^FO88,88^GB50,50,50^FS'#13#10+
619			'^FO220,50^FDInternational Shipping, Inc.^FS'#13#10+
620			'^CF0,40'#13#10+
621			'^FO220,100^FD1000 Shipping Lane^FS'#13#10+
622			'^FO220,135^FDShelbyville TN 38102^FS'#13#10+
623			'^FO220,170^FDUnited States (USA)^FS'#13#10+
624			'^FO50,250^GB700,1,3^FS'#13#10 +
625			'^XZ'#13#10
626			;
627
628			PrintZpl(zpl);
629			end;
630
631			procedure TLabelPrint.PrintZPL( ZplData : string);
632			var
633			ADevice, ADeviceName, ADevicePort: array[0..255]of Char;
634			PrinterHandle: THandle;
635			DocInfo: TDocInfo1;
636			dwJob: cardinal;
637			dwBytesWritten: cardinal;
638			AUtf8: UTF8string;
639			ADeviceMode: THandle;
640
641			begin
642
643
644			Printer.GetPrinter(ADevice, ADeviceName, ADevicePort, ADeviceMode);
645
646			if not OpenPrinter(ADevice, PrinterHandle, nil) then
647			begin
648			Exit;
649			parentForm.Msg('error on openprinter');
650			end;
651
652			//Fill in the structure with info about this "document"
653			DocInfo.pDocName := PChar('Spooler Document Name');
654			DocInfo.pOutputFile := nil;
655			DocInfo.pDatatype := 'RAW';
656
657			//Inform the spooler the document is beginning
658			dwJob := StartDocPrinter(PrinterHandle, 1, @DocInfo);
659			if dwJob = 0 then
660			begin
661			ClosePrinter(PrinterHandle);
662			PrinterHandle := 0;
663			Exit;
664			end;
665
666			//Start a page
667			if not StartPagePrinter(PrinterHandle) then
668			begin
669			EndDocPrinter(PrinterHandle);
670			ClosePrinter(PrinterHandle);
671			PrinterHandle := 0;
672			Exit;
673			end;
674
675			//your zebra code...
676			AUtf8 := UTF8string(ZplData);
677			WritePrinter(PrinterHandle, @AUtf8[1], Length(AUtf8), dwBytesWritten);
678
679			//End the page
680			if not EndPagePrinter(PrinterHandle) then
681			begin
682			EndDocPrinter(PrinterHandle);
683			ClosePrinter(PrinterHandle);
684			PrinterHandle := 0;
685			Exit;
686			end;
687
688			//Inform the spooler that the document is ending
689			if not EndDocPrinter(PrinterHandle) then
690			begin
691			ClosePrinter(PrinterHandle);
692			PrinterHandle := 0;
693			Exit;
694			end;
695
696			//Tidy up the printer handle
697			ClosePrinter(PrinterHandle);
698			PrinterHandle := 0;
699
700			end;
701
702
703	torben	2705	function TLabelPrint.GetPrinterCount() : Integer;
704			begin
705			Result := Printer.Printers.Count;
706			end;
707
708			end.