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