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


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