/[projects]/dao/DelphiScanner/LabelPrint.pas
ViewVC logotype

Diff of /dao/DelphiScanner/LabelPrint.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2705 by torben, Fri Sep 4 12:39:33 2015 UTC revision 3103 by torben, Tue Aug 23 06:58:31 2016 UTC
# Line 4  interface Line 4  interface
4    
5  uses  uses
6    ParentForm,    ParentForm,
7    PakkeshopLabels,    LabelData,
8    Configuration,    Configuration,
9    StBarc;    StBarc;
10    
# Line 16  type Line 16  type
16    
17      procedure CheckPrintQue(tjektype : string; PrinterNavn : String);      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 = '');      procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');
22    
23      procedure PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);      procedure PrintSimpelLabel( LabelData : TLabelData) ;
24    
25    
26        procedure PrintFuldPakkeLabel( PakkeshopLabel : TLabelData);
27    
28    
29      procedure PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn : String) ;      procedure PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn : String) ;
30    
31    
32      function GetPrinterCount() : Integer;      function GetPrinterCount() : Integer;
33    
34    private    private
# Line 30  type Line 37  type
37      var Config: TConfiguration;      var Config: TConfiguration;
38    
39    
40        procedure PrintZPL( ZplData : string);
41    
42        procedure PrintFuldPakkeLabelLille( PakkeshopLabel : TLabelData);
43        procedure PrintFuldPakkeLabelStor( PakkeshopLabel : TLabelData);
44    
45    
46      function SavePChar(p: PChar): PChar;      function SavePChar(p: PChar): PChar;
47      function GetCurrentPrinterHandle(): THandle;      function GetCurrentPrinterHandle(): THandle;
48    
# Line 44  uses Line 57  uses
57    WinSpool,    WinSpool,
58    Windows,    Windows,
59    SysUtils, //Format    SysUtils, //Format
60    Math, // DegToRad() bruges i PrintPakkeshopLabel    Math, // DegToRad() bruges i PrinTLabelData
61    Forms    Forms,
62      IdHTTP,
63      Graphics,
64      XMLDoc
65    ;    ;
66    
67    
# Line 107  begin Line 123  begin
123    with Printer do    with Printer do
124        begin        begin
125          BeginDoc;          BeginDoc;
126    
127          Canvas.Font.Size := Config.FontSizeRute;          Canvas.Font.Size := Config.FontSizeRute;
128          if (Length(RuteNummer) > 7) then          if (Length(RuteNummer) > 7) then
129          begin          begin
# Line 128  begin Line 145  begin
145          Canvas.TextOut(Config.XPosBoghandler, Config.YPosBoghandler, BoghandlerNavn);          Canvas.TextOut(Config.XPosBoghandler, Config.YPosBoghandler, BoghandlerNavn);
146          EndDoc;          EndDoc;
147        end;        end;
148    
149    
150    
151      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
152    
153  end;  end;
154    
155    
# Line 147  begin Line 169  begin
169  //            'Test'  skal vise alarmlinie, samt opdatere listbox1  //            'Test'  skal vise alarmlinie, samt opdatere listbox1
170  //            'Timer' skal kun vise alarmlinie  //            'Timer' skal kun vise alarmlinie
171    
172    if (PrinterNavn = 'Ingen') and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then  //  if (PrinterNavn = 'Ingen') and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then
173    begin  //  begin
174    //
175      parentForm.LogMessage( 'Der er fravalgt printer i dette program' );  //    parentForm.LogMessage( 'Der er fravalgt printer i dette program' );
176    end  //  end
177    else if (Printer.Printers.Count = 0) and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then  //  else
178      if (Printer.Printers.Count = 0) and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then
179    begin    begin
180      parentForm.LogMessage( 'Der er ikke installeret en printer på denne PC' );      parentForm.LogMessage( 'Der er ikke installeret en printer på denne PC' );
181    end    end
# Line 219  begin Line 242  begin
242          ClosePrinter(hPrinter);          ClosePrinter(hPrinter);
243      end;      end;
244    end;    end;
245    
246    
247      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
248    
249  end;  end;
250    
251    
252    procedure TLabelPrint.PrintLabel( Stregkode : String);
253    var
254      url: String;
255      response: String;
256    
257      httpClient: TIdHTTP;
258    
259      XMLDocument1: TXMLDocument;
260    
261      LabelData: TLabelData;
262    
263    
264    begin
265    
266      url := Format(Config.URLPrintLabel, [Stregkode] );
267    
268      httpClient := TIdHTTP.Create();
269      httpClient.ReadTimeout := 1000;//max 1 secound
270      httpClient.ConnectTimeout := 1000;
271    
272      response := httpClient.Get(url);
273      httpClient.Free();
274    
275    
276      XMLDocument1 := parentForm.GetXMLDocument();
277    
278      XMLDocument1.LoadFromXML(response);
279    
280      LabelData := TLabelData.Create(XMLDocument1);
281    
282      if LabelData.LabelType = 'zpl' then
283      begin
284        PrintZPL(LabelData.ZPL);
285      end
286      else if (LabelData.LabelType = 'simpel') then
287      begin
288        PrintSimpelLabel(LabelData);
289      end
290      else
291      begin
292        PrintFuldPakkeLabel(LabelData);
293      end;
294    
295    
296    
297    
298    
299    
300    
301    end;
302    
303  procedure TLabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');  procedure TLabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');
304  begin  begin
305      with Printer do      with Printer do
# Line 262  begin Line 340  begin
340    
341        EndDoc;        EndDoc;
342      end;      end;
343    
344    
345        Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
346    
347  end;  end;
348    
349    
350    procedure TLabelPrint.PrintFuldPakkeLabel( PakkeshopLabel : TLabelData);
351    begin
352      if (Config.LabelStor = 1) then
353      begin
354        PrintFuldPakkeLabelStor(  PakkeshopLabel );
355    
356      end
357      else
358      begin
359        PrintFuldPakkeLabelLille(  PakkeshopLabel );
360    
361      end;
362    
363    end;
364    
365  // ToDo: PrintPakkeshopLabel()  // Bruges til label der passer til 60x100
366  procedure TLabelPrint.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  procedure TLabelPrint.PrintFuldPakkeLabelLille( PakkeshopLabel : TLabelData);
367  var  var
368    XForm, XFormOld: TXForm; //Bruges til rotate X-formation    XForm, XFormOld: TXForm; //Bruges til rotate X-formation
369    Angle: integer;    Angle: integer;
# Line 280  begin Line 376  begin
376        BeginDoc();        BeginDoc();
377    
378    
379        Canvas.Font.Size := 16;        Canvas.Font.Size := 15;
380        Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);        Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);
381    
382    
383    
384        Canvas.TextOut(25, 90, PakkeshopLabel.Navn );        Canvas.TextOut(25, 90, PakkeshopLabel.Navn );
385        Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn );        Canvas.TextOut(25, 140, PakkeshopLabel.Vejnavn );
386        Canvas.TextOut(25, 180, PakkeshopLabel.Postnr );        Canvas.TextOut(25, 190, PakkeshopLabel.Postnr );
387    
388    
389        Canvas.Font.Size := 9;        Canvas.Font.Size := 9;
390        Canvas.TextOut(110, 240, 'Pakkeshop:');  
391        Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);  
392        Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);        // Skriv ikke 'Pakkeshop' overskrift hvis det er en shop2direkte
393        Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);        if (  PakkeshopLabel.PakkeshopNavn <> ''  ) then
394          begin
395            Canvas.TextOut(110, 240, 'Pakkeshop:');
396            Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);
397            Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);
398            Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);
399    
400          end;
401    
402    
403    
404        Canvas.TextOut(350, 240, 'Afsender:');        Canvas.TextOut(350, 240, 'Afsender:');
405        Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);        Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);
# Line 376  begin Line 481  begin
481      end;      end;
482    
483    
484      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
485    
486  end;  end;
487    
488    
489    // Bruges til label der passer til 100x150
490    procedure TLabelPrint.PrintFuldPakkeLabelStor( PakkeshopLabel : TLabelData);
491    var
492      XForm, XFormOld: TXForm; //Bruges til rotate X-formation
493      Angle: integer;
494      gMode: integer;
495      Dirigering: string;
496      BarcodeRect : TRect;
497    
498    begin
499        with Printer do
500        begin
501          BeginDoc();
502    
503    
504    
505          Canvas.Font.Style := [TFontStyle.fsBold];
506          Canvas.Font.Size := 16;
507          Canvas.TextOut(25,25, 'Code: ' + PakkeshopLabel.Tjekkode + '           '  + PakkeshopLabel.Overskrift);
508    
509    
510    
511          Canvas.TextOut(80, 220, PakkeshopLabel.Navn );
512          Canvas.TextOut(80, 270, PakkeshopLabel.Vejnavn );
513          Canvas.TextOut(80, 320, PakkeshopLabel.Postnr );
514    
515    
516          Canvas.Font.Size := 9;
517    
518    
519          // Skriv ikke 'Pakkeshop' overskrift hvis det er en shop2direkte
520          if (  PakkeshopLabel.PakkeshopNavn <> ''  ) then
521          begin
522            Canvas.TextOut(170, 460, 'Pakkeshop:');
523            Canvas.TextOut(170, 490, PakkeshopLabel.PakkeshopNavn);
524            Canvas.TextOut(170, 520, PakkeshopLabel.PakkeshopAddr);
525            Canvas.TextOut(170, 550, PakkeshopLabel.PakkeshopPostnr);
526    
527          end;
528    
529    
530    
531          Canvas.TextOut(550, 460, 'Afsender:');
532          Canvas.TextOut(550, 490, PakkeshopLabel.AfsenderNavn);
533          Canvas.TextOut(550, 520, PakkeshopLabel.AfsenderAdresse);
534          Canvas.TextOut(550, 550, PakkeshopLabel.AfsenderPostnr);
535    
536          Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr;
537          if ( PakkeshopLabel.Koreliste <> '') then
538          begin
539            Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
540          end;
541    
542    
543          Canvas.Font.Size := 12;
544          Canvas.TextOut(40, 680, Dirigering);
545    
546    
547    
548    
549    
550          //Tegn adskillelses linier
551          Canvas.Pen.Width := 2;
552          //Øverste linie
553          Canvas.MoveTo( 40, 180);
554          Canvas.LineTo(900, 180);
555    
556          // Midterste linie
557          Canvas.MoveTo( 40, 440);
558          Canvas.LineTo(900, 440);
559    
560          //Nederste linie
561          Canvas.MoveTo( 40, 640);
562          Canvas.LineTo(900, 640);
563    
564    
565          //Tegn skrå streger over afsender
566          Canvas.Pen.Width := 1;
567          Canvas.MoveTo(840, 450);
568          Canvas.LineTo(540, 590);
569          Canvas.MoveTo(840, 590);
570          Canvas.LineTo(540, 450);
571    
572    
573    
574          // Resten af rutinen vedr genering og placering af Barcode
575    
576          Barcode.Font.Size := 9;
577          Barcode.BarToSpaceRatio := 0.9;
578    
579    
580          BarCode.BarCodeType := bcCode128;
581          BarCode.Code128Subset := csCodeC;
582          BarCode.Code := PakkeshopLabel.Stregkode;
583          BarCode.Validate(True);
584    
585    
586    //      parentForm.Msg(       inttostr(            Barcode.Font.Size) );//Default 8
587    //      parentForm.Msg(       Double.ToString(      Barcode.BarNarrowToWideRatio) );//Default 2
588    //      parentForm.Msg(       Double.ToString(      Barcode.BarToSpaceRatio) );//Default 1
589    //      parentForm.Msg(  Double.ToString(BarCode.Width ) );//default 200
590    
591    
592          //Start X-formation
593          //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
594          GetWorldTransform(Canvas.Handle, XFormOld);
595    
596          Angle := 270;
597          XForm.eM11 := Cos(DegToRad(Angle));
598          XForm.eM12 := Sin(DegToRad(Angle));
599          XForm.eM21 := -Sin(DegToRad(Angle));
600          XForm.eM22 := Cos(DegToRad(Angle));
601          XForm.eDx := 0;
602          XForm.eDy := 0;
603    
604          gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
605          SetWorldTransform(Canvas.Handle, XForm);
606    
607          // PaintToCanvasSize arbejder i Inches
608          // Første pos argument bliver nu Y og skal være negativ for at rykke den ned
609          //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre
610    
611          BarCode.PaintToCanvasSize(Printer.Canvas, -2.7, 4.8, 0.5);
612    
613    
614    
615    
616          SetWorldTransform(Canvas.Handle, XFormOld);
617          SetGraphicsMode(Canvas.Handle, gMode);
618    
619          EndDoc();
620        end;
621    
622    
623      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
624    end;
625    
626  function TLabelPrint.SavePChar(p: PChar): PChar;  function TLabelPrint.SavePChar(p: PChar): PChar;
627  const  const
628    error: PChar = 'Nil';    error: PChar = 'Nil';
# Line 389  begin Line 633  begin
633      Result := p;      Result := p;
634  end;  end;
635    
636    // Online zpl viewer
637    
638    
639    procedure TLabelPrint.PrintZPL( ZplData : string);
640    var
641      ADevice, ADeviceName, ADevicePort: array[0..255]of Char;
642      PrinterHandle: THandle;
643      DocInfo: TDocInfo1;
644      dwJob: cardinal;
645      dwBytesWritten: cardinal;
646      AUtf8: UTF8string;
647      ADeviceMode: THandle;
648    
649    begin
650    
651    
652      Printer.GetPrinter(ADevice, ADeviceName, ADevicePort, ADeviceMode);
653    
654        if not OpenPrinter(ADevice, PrinterHandle, nil) then
655        begin
656          Exit;
657          parentForm.Msg('error on openprinter');
658        end;
659    
660         //Fill in the structure with info about this "document"
661      DocInfo.pDocName := PChar('Spooler Document Name');
662      DocInfo.pOutputFile := nil;
663      DocInfo.pDatatype := 'RAW';
664    
665       //Inform the spooler the document is beginning
666      dwJob := StartDocPrinter(PrinterHandle, 1, @DocInfo);
667      if dwJob = 0 then
668      begin
669        ClosePrinter(PrinterHandle);
670        PrinterHandle := 0;
671        Exit;
672      end;
673    
674      //Start a page
675      if not StartPagePrinter(PrinterHandle) then
676      begin
677        EndDocPrinter(PrinterHandle);
678        ClosePrinter(PrinterHandle);
679        PrinterHandle := 0;
680        Exit;
681      end;
682    
683      //your zebra code...
684      AUtf8 := UTF8string(ZplData);
685      WritePrinter(PrinterHandle, @AUtf8[1], Length(AUtf8), dwBytesWritten);
686    
687      //End the page
688      if not EndPagePrinter(PrinterHandle) then
689      begin
690        EndDocPrinter(PrinterHandle);
691        ClosePrinter(PrinterHandle);
692        PrinterHandle := 0;
693        Exit;
694      end;
695    
696      //Inform the spooler that the document is ending
697      if not EndDocPrinter(PrinterHandle) then
698      begin
699        ClosePrinter(PrinterHandle);
700        PrinterHandle := 0;
701        Exit;
702      end;
703    
704      //Tidy up the printer handle
705      ClosePrinter(PrinterHandle);
706      PrinterHandle := 0;
707    
708    end;
709    
710    procedure TLabelPrint.PrintSimpelLabel( LabelData : TLabelData) ;
711    begin
712      with Printer do
713          begin
714            BeginDoc;
715    
716            Canvas.Font.Size := Config.FontSizeRute;
717            if (Length(LabelData.SimpelLinie1) > 7) then
718            begin
719              Canvas.Font.Size := Config.FontSizeRuteLille;
720            end;
721            Canvas.TextOut(Config.XPosRute, Config.YPosRute, LabelData.SimpelLinie1);
722            Canvas.Font.Size := Config.FontSizeKommentar;
723            LabelData.SimpelLinie2 := StringReplace(LabelData.SimpelLinie2, #$A, ' - ', [rfReplaceAll, rfIgnoreCase]);
724            if (LabelData.SimpelLinie2 = 'Ok') or (LabelData.SimpelLinie2 = 'ALLEREDE SCANNET') then
725            begin
726              LabelData.SimpelLinie2 := '';
727            end;
728            if (LabelData.SimpelLinie3 = 'PAKKE ER SCANNET') then
729            begin
730              LabelData.SimpelLinie3 := '';
731            end;
732            Canvas.TextOut(Config.XPosKommentar, Config.YPosKommentar, LabelData.SimpelLinie2);
733            Canvas.Font.Size := Config.FontSizeBoghandler;
734            Canvas.TextOut(Config.XPosBoghandler, Config.YPosBoghandler, LabelData.SimpelLinie3);
735            EndDoc;
736          end;
737    
738    
739    
740      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
741    
742    end;
743    
744    
745    
746  function TLabelPrint.GetPrinterCount() : Integer;  function TLabelPrint.GetPrinterCount() : Integer;
747  begin  begin
Legend:
Removed from v.2705  
changed lines
  Added in v.3103
  ViewVC Help
Powered by ViewVC 1.1.20