/[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 3038 by torben, Tue May 31 11:50:42 2016 UTC revision 3131 by torben, Thu Oct 20 07:31:23 2016 UTC
# Line 4  interface Line 4  interface
4    
5  uses  uses
6    ParentForm,    ParentForm,
7    PakkeshopLabels,    LabelData,
8    Configuration,    Configuration,
9    StBarc,    StBarc;
   PrtRaw;  
10    
11    
12  type  type
# Line 17  type Line 16  type
16    
17      procedure CheckPrintQue(tjektype : string; PrinterNavn : String);      procedure CheckPrintQue(tjektype : string; PrinterNavn : String);
18    
19      procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');      procedure PrintLabel( Stregkode : String);
20    
     procedure PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  
21    
22      procedure PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn : String) ;      procedure PrintTestLabel();
23    
     procedure TestZpl();  
     procedure PrintZPL( ZplData : string);  
24    
25      function GetPrinterCount() : Integer;      function GetPrinterCount() : Integer;
26    
27    
28    
29    private    private
30      parentForm : IParentForm;      parentForm : IParentForm;
31      Barcode : TStBarcode;      Barcode : TStBarcode;
32      var Config: TConfiguration;      var Config: TConfiguration;
33    
34    
35    
36        procedure PrintZPL( ZplData : string);
37    
38        procedure PrintLabelData( LabelData : TLabelData);
39        procedure PrintSimpelLabel( LabelData : TLabelData) ;
40    
41        procedure PrintFuldPakkeLabel( PakkeshopLabel : TLabelData);
42        procedure PrintFuldPakkeLabelLille( PakkeshopLabel : TLabelData);
43        procedure PrintFuldPakkeLabelStor( PakkeshopLabel : TLabelData);
44    
45        procedure SendTilPrinter_old(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');
46        procedure PrintDaodirekteLabel_old( RuteNummer, Kommentar, BoghandlerNavn : String) ;
47    
48    
49    
50      function SavePChar(p: PChar): PChar;      function SavePChar(p: PChar): PChar;
51      function GetCurrentPrinterHandle(): THandle;      function GetCurrentPrinterHandle(): THandle;
52    
# Line 48  uses Line 61  uses
61    WinSpool,    WinSpool,
62    Windows,    Windows,
63    SysUtils, //Format    SysUtils, //Format
64    Math, // DegToRad() bruges i PrintPakkeshopLabel    Math, // DegToRad() bruges i PrinTLabelData
65    Forms    Forms,
66      IdHTTP,
67      Graphics,
68      XMLDoc
69    ;    ;
70    
71    
# Line 106  begin Line 122  begin
122  end;  end;
123    
124    
125  procedure TLabelPrint.PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn : String) ;  procedure TLabelPrint.PrintDaodirekteLabel_old( RuteNummer, Kommentar, BoghandlerNavn : String) ;
126  begin  begin
127    with Printer do    with Printer do
128        begin        begin
129          BeginDoc;          BeginDoc;
130    
131          Canvas.Font.Size := Config.FontSizeRute;          Canvas.Font.Size := Config.FontSizeRute;
132          if (Length(RuteNummer) > 7) then          if (Length(RuteNummer) > 7) then
133          begin          begin
# Line 132  begin Line 149  begin
149          Canvas.TextOut(Config.XPosBoghandler, Config.YPosBoghandler, BoghandlerNavn);          Canvas.TextOut(Config.XPosBoghandler, Config.YPosBoghandler, BoghandlerNavn);
150          EndDoc;          EndDoc;
151        end;        end;
152    
153    
154    
155      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
156    
157  end;  end;
158    
159    
# Line 151  begin Line 173  begin
173  //            'Test'  skal vise alarmlinie, samt opdatere listbox1  //            'Test'  skal vise alarmlinie, samt opdatere listbox1
174  //            'Timer' skal kun vise alarmlinie  //            'Timer' skal kun vise alarmlinie
175    
176    if (PrinterNavn = 'Ingen') and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then  //  if (PrinterNavn = 'Ingen') and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then
177    begin  //  begin
178    //
179      parentForm.LogMessage( 'Der er fravalgt printer i dette program' );  //    parentForm.LogMessage( 'Der er fravalgt printer i dette program' );
180    end  //  end
181    else if (Printer.Printers.Count = 0) and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then  //  else
182      if (Printer.Printers.Count = 0) and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then
183    begin    begin
184      parentForm.LogMessage( 'Der er ikke installeret en printer på denne PC' );      parentForm.LogMessage( 'Der er ikke installeret en printer på denne PC' );
185    end    end
# Line 223  begin Line 246  begin
246          ClosePrinter(hPrinter);          ClosePrinter(hPrinter);
247      end;      end;
248    end;    end;
249    
250    
251      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
252    
253  end;  end;
254    
255    
256  procedure TLabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');  procedure TLabelPrint.PrintLabel( Stregkode : String);
257    var
258      url: String;
259      response: String;
260    
261      httpClient: TIdHTTP;
262    
263      XMLDocument1: TXMLDocument;
264    
265      LabelData: TLabelData;
266    
267    
268    begin
269    
270      url := Format(Config.URLPrintLabel, [Stregkode] );
271    
272      httpClient := TIdHTTP.Create();
273      httpClient.ReadTimeout := 1000;//max 1 secound
274      httpClient.ConnectTimeout := 1000;
275    
276      response := httpClient.Get(url);
277      httpClient.Free();
278    
279    
280      XMLDocument1 := parentForm.GetXMLDocument();
281    
282      XMLDocument1.LoadFromXML(response);
283    
284      LabelData := TLabelData.Create(XMLDocument1);
285      PrintLabelData(LabelData);
286      LabelData.Free();
287    
288    
289    end;
290    
291    procedure TLabelPrint.PrintTestLabel();
292    var
293      LabelData : TLabelData;
294    begin
295      LabelData := TLabelData.Create(nil);
296      LabelData.LabelType := 'simpel';
297      LabelData.SimpelLinie1 := 'Test Label';
298      LabelData.SimpelLinie2 := 'Test Label';
299      LabelData.SimpelLinie3 := 'Test Label';
300    
301      PrintLabelData(Labeldata);
302    
303      LabelData.Free();
304    end;
305    
306    procedure TLabelPrint.PrintLabelData( LabelData : TLabelData);
307    begin
308      if LabelData.LabelType = 'zpl' then
309      begin
310        PrintZPL(LabelData.ZPL);
311      end
312      else if (LabelData.LabelType = 'simpel') then
313      begin
314        PrintSimpelLabel(LabelData);
315      end
316      else
317      begin
318        PrintFuldPakkeLabel(LabelData);
319      end;
320    end;
321    
322    
323    
324    procedure TLabelPrint.SendTilPrinter_old(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');
325  begin  begin
326      with Printer do      with Printer do
327      begin      begin
# Line 266  begin Line 361  begin
361    
362        EndDoc;        EndDoc;
363      end;      end;
364    
365    
366        Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
367    
368  end;  end;
369    
370    
371    procedure TLabelPrint.PrintFuldPakkeLabel( PakkeshopLabel : TLabelData);
372    begin
373      if (Config.LabelStor = 1) then
374      begin
375        PrintFuldPakkeLabelStor(  PakkeshopLabel );
376    
377      end
378      else
379      begin
380        PrintFuldPakkeLabelLille(  PakkeshopLabel );
381    
382  // ToDo: PrintPakkeshopLabel()    end;
383  procedure TLabelPrint.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  
384    end;
385    
386    // Bruges til label der passer til 60x100
387    procedure TLabelPrint.PrintFuldPakkeLabelLille( PakkeshopLabel : TLabelData);
388  var  var
389    XForm, XFormOld: TXForm; //Bruges til rotate X-formation    XForm, XFormOld: TXForm; //Bruges til rotate X-formation
390    Angle: integer;    Angle: integer;
# Line 284  begin Line 397  begin
397        BeginDoc();        BeginDoc();
398    
399    
400        Canvas.Font.Size := 16;        Canvas.Font.Size := 15;
401        Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);        Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);
402    
403    
404    
405        Canvas.TextOut(25, 90, PakkeshopLabel.Navn );        Canvas.TextOut(25, 90, PakkeshopLabel.Navn );
406        Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn );        Canvas.TextOut(25, 140, PakkeshopLabel.Vejnavn );
407        Canvas.TextOut(25, 180, PakkeshopLabel.Postnr );        Canvas.TextOut(25, 190, PakkeshopLabel.Postnr );
408    
409    
410        Canvas.Font.Size := 9;        Canvas.Font.Size := 9;
411    
412    
413        // Skriv ikke 'Pakkeshop' overskrift hvis det er en shop2direkte        // Skriv ikke 'Pakkeshop' overskrift hvis det er en shop2direkte
414        if (  (PakkeshopLabel.Shop2Direkte = '') OR (PakkeshopLabel.Shop2Direkte = '0')  ) then        if (  PakkeshopLabel.PakkeshopNavn <> ''  ) then
415        begin        begin
416          Canvas.TextOut(110, 240, 'Pakkeshop:');          Canvas.TextOut(110, 240, 'Pakkeshop:');
417            Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);
418            Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);
419            Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);
420    
421        end;        end;
422    
423    
       Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);  
       Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);  
       Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);  
424    
425        Canvas.TextOut(350, 240, 'Afsender:');        Canvas.TextOut(350, 240, 'Afsender:');
426        Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);        Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);
# Line 388  begin Line 502  begin
502      end;      end;
503    
504    
505      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
506    
507  end;  end;
508    
509    
510    // Bruges til label der passer til 100x150
511    procedure TLabelPrint.PrintFuldPakkeLabelStor( PakkeshopLabel : TLabelData);
512    var
513      XForm, XFormOld: TXForm; //Bruges til rotate X-formation
514      Angle: integer;
515      gMode: integer;
516      Dirigering: string;
517      BarcodeRect : TRect;
518    
519    begin
520        with Printer do
521        begin
522          BeginDoc();
523    
524    
525    
526          Canvas.Font.Style := [TFontStyle.fsBold];
527          Canvas.Font.Size := 16;
528          Canvas.TextOut(25,25, 'Code: ' + PakkeshopLabel.Tjekkode + '           '  + PakkeshopLabel.Overskrift);
529    
530    
531    
532          Canvas.TextOut(80, 220, PakkeshopLabel.Navn );
533          Canvas.TextOut(80, 270, PakkeshopLabel.Vejnavn );
534          Canvas.TextOut(80, 320, PakkeshopLabel.Postnr );
535    
536    
537          Canvas.Font.Size := 9;
538    
539    
540          // Skriv ikke 'Pakkeshop' overskrift hvis det er en shop2direkte
541          if (  PakkeshopLabel.PakkeshopNavn <> ''  ) then
542          begin
543            Canvas.TextOut(170, 460, 'Pakkeshop:');
544            Canvas.TextOut(170, 490, PakkeshopLabel.PakkeshopNavn);
545            Canvas.TextOut(170, 520, PakkeshopLabel.PakkeshopAddr);
546            Canvas.TextOut(170, 550, PakkeshopLabel.PakkeshopPostnr);
547    
548          end;
549    
550    
551    
552          Canvas.TextOut(550, 460, 'Afsender:');
553          Canvas.TextOut(550, 490, PakkeshopLabel.AfsenderNavn);
554          Canvas.TextOut(550, 520, PakkeshopLabel.AfsenderAdresse);
555          Canvas.TextOut(550, 550, PakkeshopLabel.AfsenderPostnr);
556    
557          Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr;
558          if ( PakkeshopLabel.Koreliste <> '') then
559          begin
560            Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
561          end;
562    
563    
564          Canvas.Font.Size := 12;
565          Canvas.TextOut(40, 680, Dirigering);
566    
567    
568    
569    
570    
571          //Tegn adskillelses linier
572          Canvas.Pen.Width := 2;
573          //Øverste linie
574          Canvas.MoveTo( 40, 180);
575          Canvas.LineTo(900, 180);
576    
577          // Midterste linie
578          Canvas.MoveTo( 40, 440);
579          Canvas.LineTo(900, 440);
580    
581          //Nederste linie
582          Canvas.MoveTo( 40, 640);
583          Canvas.LineTo(900, 640);
584    
585    
586          //Tegn skrå streger over afsender
587          Canvas.Pen.Width := 1;
588          Canvas.MoveTo(840, 450);
589          Canvas.LineTo(540, 590);
590          Canvas.MoveTo(840, 590);
591          Canvas.LineTo(540, 450);
592    
593    
594    
595          // Resten af rutinen vedr genering og placering af Barcode
596    
597          Barcode.Font.Size := 9;
598          Barcode.BarToSpaceRatio := 0.9;
599    
600    
601          BarCode.BarCodeType := bcCode128;
602          BarCode.Code128Subset := csCodeC;
603          BarCode.Code := PakkeshopLabel.Stregkode;
604          BarCode.Validate(True);
605    
606    
607    //      parentForm.Msg(       inttostr(            Barcode.Font.Size) );//Default 8
608    //      parentForm.Msg(       Double.ToString(      Barcode.BarNarrowToWideRatio) );//Default 2
609    //      parentForm.Msg(       Double.ToString(      Barcode.BarToSpaceRatio) );//Default 1
610    //      parentForm.Msg(  Double.ToString(BarCode.Width ) );//default 200
611    
612    
613          //Start X-formation
614          //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
615          GetWorldTransform(Canvas.Handle, XFormOld);
616    
617          Angle := 270;
618          XForm.eM11 := Cos(DegToRad(Angle));
619          XForm.eM12 := Sin(DegToRad(Angle));
620          XForm.eM21 := -Sin(DegToRad(Angle));
621          XForm.eM22 := Cos(DegToRad(Angle));
622          XForm.eDx := 0;
623          XForm.eDy := 0;
624    
625          gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
626          SetWorldTransform(Canvas.Handle, XForm);
627    
628          // PaintToCanvasSize arbejder i Inches
629          // Første pos argument bliver nu Y og skal være negativ for at rykke den ned
630          //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre
631    
632          BarCode.PaintToCanvasSize(Printer.Canvas, -2.7, 4.8, 0.5);
633    
634    
635    
636    
637          SetWorldTransform(Canvas.Handle, XFormOld);
638          SetGraphicsMode(Canvas.Handle, gMode);
639    
640          EndDoc();
641        end;
642    
643    
644      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
645    end;
646    
647  function TLabelPrint.SavePChar(p: PChar): PChar;  function TLabelPrint.SavePChar(p: PChar): PChar;
648  const  const
649    error: PChar = 'Nil';    error: PChar = 'Nil';
# Line 402  begin Line 655  begin
655  end;  end;
656    
657  // Online zpl viewer  // 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  
   ;  
658    
   PrintZpl(zpl);  
 end;  
659    
660  procedure TLabelPrint.PrintZPL( ZplData : string);  procedure TLabelPrint.PrintZPL( ZplData : string);
661  var  var
# Line 500  begin Line 728  begin
728    
729  end;  end;
730    
731    procedure TLabelPrint.PrintSimpelLabel( LabelData : TLabelData) ;
732    begin
733      with Printer do
734          begin
735            BeginDoc;
736    
737            Canvas.Font.Size := 20;
738            Canvas.TextOut(10, 20, LabelData.SimpelLinie1);
739            Canvas.TextOut(10, 120, LabelData.SimpelLinie2);
740            Canvas.TextOut(10, 220, LabelData.SimpelLinie3);
741    
742            EndDoc;
743          end;
744    
745    
746    
747      Printers.SetPrinter( TPrinter.Create() ).Free();//Work around for KB3177725
748    
749    end;
750    
751    
752    
753  function TLabelPrint.GetPrinterCount() : Integer;  function TLabelPrint.GetPrinterCount() : Integer;
754  begin  begin
Legend:
Removed from v.3038  
changed lines
  Added in v.3131
  ViewVC Help
Powered by ViewVC 1.1.20