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