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