/[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 3088 by torben, Mon Aug 15 15:56:50 2016 UTC
# 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 PrintFuldPakkeLabel( PakkeshopLabel : TPakkeshopLabel);
24        procedure PrintFuldPakkeLabelLille( PakkeshopLabel : TPakkeshopLabel);
25        procedure PrintFuldPakkeLabelStor( PakkeshopLabel : TPakkeshopLabel);
26    
27    
28      procedure PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn : String) ;      procedure PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn : String) ;
29    
30        procedure TestZpl();
31        procedure PrintZPL( ZplData : string);
32    
33      function GetPrinterCount() : Integer;      function GetPrinterCount() : Integer;
34    
35    private    private
# Line 45  uses Line 53  uses
53    Windows,    Windows,
54    SysUtils, //Format    SysUtils, //Format
55    Math, // DegToRad() bruges i PrintPakkeshopLabel    Math, // DegToRad() bruges i PrintPakkeshopLabel
56    Forms    Forms,
57      IdHTTP,
58      Graphics
59    ;    ;
60    
61    
# Line 107  begin Line 117  begin
117    with Printer do    with Printer do
118        begin        begin
119          BeginDoc;          BeginDoc;
120    
121          Canvas.Font.Size := Config.FontSizeRute;          Canvas.Font.Size := Config.FontSizeRute;
122          if (Length(RuteNummer) > 7) then          if (Length(RuteNummer) > 7) then
123          begin          begin
# Line 128  begin Line 139  begin
139          Canvas.TextOut(Config.XPosBoghandler, Config.YPosBoghandler, BoghandlerNavn);          Canvas.TextOut(Config.XPosBoghandler, Config.YPosBoghandler, BoghandlerNavn);
140          EndDoc;          EndDoc;
141        end;        end;
142    
143    
144    
145      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
146    
147  end;  end;
148    
149    
# Line 219  begin Line 235  begin
235          ClosePrinter(hPrinter);          ClosePrinter(hPrinter);
236      end;      end;
237    end;    end;
238    
239    
240      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
241    
242  end;  end;
243    
244    
245    procedure TLabelPrint.PrintLabel( Stregkode : String);
246    var
247      url: String;
248      response: String;
249    
250      httpClient: TIdHTTP;
251    
252    
253    
254    begin
255    
256      url := Format(Config.URLPrintLabel, [Stregkode] );
257    
258      httpClient := TIdHTTP.Create();
259      httpClient.ReadTimeout := 1000;//max 1 secound
260      httpClient.ConnectTimeout := 1000;
261    
262      response := httpClient.Get(url);
263      httpClient.Free();
264    
265    
266    
267    
268    end;
269    
270  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 = '');
271  begin  begin
272      with Printer do      with Printer do
# Line 262  begin Line 307  begin
307    
308        EndDoc;        EndDoc;
309      end;      end;
310    
311    
312        Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
313    
314  end;  end;
315    
316    
317    procedure TLabelPrint.PrintFuldPakkeLabel( PakkeshopLabel : TPakkeshopLabel);
318    begin
319      PrintFuldPakkeLabelStor(  PakkeshopLabel );
320    
321  // ToDo: PrintPakkeshopLabel()  end;
322  procedure TLabelPrint.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  
323    // Bruges til label der passer til 60x100
324    procedure TLabelPrint.PrintFuldPakkeLabelLille( PakkeshopLabel : TPakkeshopLabel);
325  var  var
326    XForm, XFormOld: TXForm; //Bruges til rotate X-formation    XForm, XFormOld: TXForm; //Bruges til rotate X-formation
327    Angle: integer;    Angle: integer;
# Line 291  begin Line 345  begin
345    
346    
347        Canvas.Font.Size := 9;        Canvas.Font.Size := 9;
348        Canvas.TextOut(110, 240, 'Pakkeshop:');  
349        Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);  
350        Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);        // Skriv ikke 'Pakkeshop' overskrift hvis det er en shop2direkte
351        Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);        if (  PakkeshopLabel.PakkeshopNavn <> ''  ) then
352          begin
353            Canvas.TextOut(110, 240, 'Pakkeshop:');
354            Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);
355            Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);
356            Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);
357    
358          end;
359    
360    
361    
362        Canvas.TextOut(350, 240, 'Afsender:');        Canvas.TextOut(350, 240, 'Afsender:');
363        Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);        Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);
# Line 376  begin Line 439  begin
439      end;      end;
440    
441    
442      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
443    
444  end;  end;
445    
446    
447    // Bruges til label der passer til 100x150
448    procedure TLabelPrint.PrintFuldPakkeLabelStor( PakkeshopLabel : TPakkeshopLabel);
449    var
450      XForm, XFormOld: TXForm; //Bruges til rotate X-formation
451      Angle: integer;
452      gMode: integer;
453      Dirigering: string;
454      BarcodeRect : TRect;
455    
456    begin
457        with Printer do
458        begin
459          BeginDoc();
460    
461    
462    
463          Canvas.Font.Style := [TFontStyle.fsBold];
464          Canvas.Font.Size := 16;
465          Canvas.TextOut(25,25, 'Code: ' + PakkeshopLabel.Tjekkode + '           '  + PakkeshopLabel.Overskrift);
466    
467    
468    
469          Canvas.TextOut(80, 220, PakkeshopLabel.Navn );
470          Canvas.TextOut(80, 270, PakkeshopLabel.Vejnavn );
471          Canvas.TextOut(80, 320, PakkeshopLabel.Postnr );
472    
473    
474          Canvas.Font.Size := 9;
475    
476    
477          // Skriv ikke 'Pakkeshop' overskrift hvis det er en shop2direkte
478          if (  PakkeshopLabel.PakkeshopNavn <> ''  ) then
479          begin
480            Canvas.TextOut(170, 460, 'Pakkeshop:');
481            Canvas.TextOut(170, 490, PakkeshopLabel.PakkeshopNavn);
482            Canvas.TextOut(170, 520, PakkeshopLabel.PakkeshopAddr);
483            Canvas.TextOut(170, 550, PakkeshopLabel.PakkeshopPostnr);
484    
485          end;
486    
487    
488    
489          Canvas.TextOut(550, 460, 'Afsender:');
490          Canvas.TextOut(550, 490, PakkeshopLabel.AfsenderNavn);
491          Canvas.TextOut(550, 520, PakkeshopLabel.AfsenderAdresse);
492          Canvas.TextOut(550, 550, PakkeshopLabel.AfsenderPostnr);
493    
494          Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr;
495          if ( PakkeshopLabel.Koreliste <> '') then
496          begin
497            Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
498          end;
499    
500    
501          Canvas.Font.Size := 12;
502          Canvas.TextOut(40, 680, Dirigering);
503    
504    
505    
506    
507    
508          //Tegn adskillelses linier
509          Canvas.Pen.Width := 2;
510          //Øverste linie
511          Canvas.MoveTo( 40, 180);
512          Canvas.LineTo(900, 180);
513    
514          // Midterste linie
515          Canvas.MoveTo( 40, 440);
516          Canvas.LineTo(900, 440);
517    
518          //Nederste linie
519          Canvas.MoveTo( 40, 640);
520          Canvas.LineTo(900, 640);
521    
522    
523          //Tegn skrå streger over afsender
524          Canvas.Pen.Width := 1;
525          Canvas.MoveTo(840, 450);
526          Canvas.LineTo(540, 590);
527          Canvas.MoveTo(840, 590);
528          Canvas.LineTo(540, 450);
529    
530    
531    
532          // Resten af rutinen vedr genering og placering af Barcode
533    
534          Barcode.Font.Size := 9;
535          Barcode.BarToSpaceRatio := 0.9;
536    
537    
538          BarCode.BarCodeType := bcCode128;
539          BarCode.Code128Subset := csCodeC;
540          BarCode.Code := PakkeshopLabel.Stregkode;
541          BarCode.Validate(True);
542    
543    
544    //      parentForm.Msg(       inttostr(            Barcode.Font.Size) );//Default 8
545    //      parentForm.Msg(       Double.ToString(      Barcode.BarNarrowToWideRatio) );//Default 2
546    //      parentForm.Msg(       Double.ToString(      Barcode.BarToSpaceRatio) );//Default 1
547    //      parentForm.Msg(  Double.ToString(BarCode.Width ) );//default 200
548    
549    
550          //Start X-formation
551          //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
552          GetWorldTransform(Canvas.Handle, XFormOld);
553    
554          Angle := 270;
555          XForm.eM11 := Cos(DegToRad(Angle));
556          XForm.eM12 := Sin(DegToRad(Angle));
557          XForm.eM21 := -Sin(DegToRad(Angle));
558          XForm.eM22 := Cos(DegToRad(Angle));
559          XForm.eDx := 0;
560          XForm.eDy := 0;
561    
562          gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
563          SetWorldTransform(Canvas.Handle, XForm);
564    
565          // PaintToCanvasSize arbejder i Inches
566          // Første pos argument bliver nu Y og skal være negativ for at rykke den ned
567          //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre
568    
569          BarCode.PaintToCanvasSize(Printer.Canvas, -2.7, 4.8, 0.5);
570    
571    
572    
573    
574          SetWorldTransform(Canvas.Handle, XFormOld);
575          SetGraphicsMode(Canvas.Handle, gMode);
576    
577          EndDoc();
578        end;
579    
580    
581      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
582    end;
583    
584  function TLabelPrint.SavePChar(p: PChar): PChar;  function TLabelPrint.SavePChar(p: PChar): PChar;
585  const  const
586    error: PChar = 'Nil';    error: PChar = 'Nil';
# Line 389  begin Line 591  begin
591      Result := p;      Result := p;
592  end;  end;
593    
594    // Online zpl viewer
595    // http://labelary.com/viewer.html
596    procedure TLabelPrint.TestZpl();
597    var
598      zpl: string;
599    begin
600      zpl :=
601    '^XA'#13#10 +
602    '^PON'#13#10 +
603    '^FWN'#13#10 +
604    
605    '^FX Top section with company logo, name and address.'#13#10 +
606    '^CF0,60'#13#10 +
607    '^FO50,50^GB100,100,100^FS'#13#10+
608    '^FO75,75^FR^GB100,100,100^FS'#13#10+
609    '^FO88,88^GB50,50,50^FS'#13#10+
610    '^FO220,50^FDInternational Shipping, Inc.^FS'#13#10+
611    '^CF0,40'#13#10+
612    '^FO220,100^FD1000 Shipping Lane^FS'#13#10+
613    '^FO220,135^FDShelbyville TN 38102^FS'#13#10+
614    '^FO220,170^FDUnited States (USA)^FS'#13#10+
615    '^FO50,250^GB700,1,3^FS'#13#10 +
616    '^XZ'#13#10
617      ;
618    
619      PrintZpl(zpl);
620    end;
621    
622    procedure TLabelPrint.PrintZPL( ZplData : string);
623    var
624      ADevice, ADeviceName, ADevicePort: array[0..255]of Char;
625      PrinterHandle: THandle;
626      DocInfo: TDocInfo1;
627      dwJob: cardinal;
628      dwBytesWritten: cardinal;
629      AUtf8: UTF8string;
630      ADeviceMode: THandle;
631    
632    begin
633    
634    
635      Printer.GetPrinter(ADevice, ADeviceName, ADevicePort, ADeviceMode);
636    
637        if not OpenPrinter(ADevice, PrinterHandle, nil) then
638        begin
639          Exit;
640          parentForm.Msg('error on openprinter');
641        end;
642    
643         //Fill in the structure with info about this "document"
644      DocInfo.pDocName := PChar('Spooler Document Name');
645      DocInfo.pOutputFile := nil;
646      DocInfo.pDatatype := 'RAW';
647    
648       //Inform the spooler the document is beginning
649      dwJob := StartDocPrinter(PrinterHandle, 1, @DocInfo);
650      if dwJob = 0 then
651      begin
652        ClosePrinter(PrinterHandle);
653        PrinterHandle := 0;
654        Exit;
655      end;
656    
657      //Start a page
658      if not StartPagePrinter(PrinterHandle) then
659      begin
660        EndDocPrinter(PrinterHandle);
661        ClosePrinter(PrinterHandle);
662        PrinterHandle := 0;
663        Exit;
664      end;
665    
666      //your zebra code...
667      AUtf8 := UTF8string(ZplData);
668      WritePrinter(PrinterHandle, @AUtf8[1], Length(AUtf8), dwBytesWritten);
669    
670      //End the page
671      if not EndPagePrinter(PrinterHandle) then
672      begin
673        EndDocPrinter(PrinterHandle);
674        ClosePrinter(PrinterHandle);
675        PrinterHandle := 0;
676        Exit;
677      end;
678    
679      //Inform the spooler that the document is ending
680      if not EndDocPrinter(PrinterHandle) then
681      begin
682        ClosePrinter(PrinterHandle);
683        PrinterHandle := 0;
684        Exit;
685      end;
686    
687      //Tidy up the printer handle
688      ClosePrinter(PrinterHandle);
689      PrinterHandle := 0;
690    
691    end;
692    
693    
694  function TLabelPrint.GetPrinterCount() : Integer;  function TLabelPrint.GetPrinterCount() : Integer;
695  begin  begin

Legend:
Removed from v.2705  
changed lines
  Added in v.3088

  ViewVC Help
Powered by ViewVC 1.1.20