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 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
  ;


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 := Config.BaseURL + '/BogpakkeKontrol/PrintLabel.php?stregkode=' + Trim(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;


// ToDo: PrintPakkeshopLabel()
procedure TLabelPrint.PrintFuldPakkeLabel( 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;


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