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