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