/[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 3091 by torben, Tue Aug 16 21:06:46 2016 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 18  type Line 18  type
18    
19      procedure PrintLabel( Stregkode : String);      procedure PrintLabel( Stregkode : String);
20    
     procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');  
21    
22      procedure PrintFuldPakkeLabel( PakkeshopLabel : TPakkeshopLabel);      procedure PrintTestLabel();
     procedure PrintFuldPakkeLabelLille( PakkeshopLabel : TPakkeshopLabel);  
     procedure PrintFuldPakkeLabelStor( PakkeshopLabel : TPakkeshopLabel);  
23    
24    
25      procedure PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn : String) ;      function GetPrinterCount() : Integer;
26    
     procedure TestZpl();  
     procedure PrintZPL( ZplData : string);  
27    
     function GetPrinterCount() : Integer;  
28    
29    private    private
30      parentForm : IParentForm;      parentForm : IParentForm;
# Line 38  type Line 32  type
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 52  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,    IdHTTP,
66    Graphics    Graphics,
67      XMLDoc
68    ;    ;
69    
70    
# Line 112  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
# Line 163  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 249  var Line 259  var
259    
260    httpClient: TIdHTTP;    httpClient: TIdHTTP;
261    
262      XMLDocument1: TXMLDocument;
263    
264      LabelData: TLabelData;
265    
266    
267  begin  begin
# Line 263  begin Line 276  begin
276    httpClient.Free();    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;  end;
304    
305  procedure TLabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');  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;
320    
321    
322    
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 314  begin Line 367  begin
367  end;  end;
368    
369    
370  procedure TLabelPrint.PrintFuldPakkeLabel( PakkeshopLabel : TPakkeshopLabel);  procedure TLabelPrint.PrintFuldPakkeLabel( PakkeshopLabel : TLabelData);
371  begin  begin
372    if (Config.LabelStor = 1) then    if (Config.LabelStor = 1) then
373    begin    begin
# Line 330  begin Line 383  begin
383  end;  end;
384    
385  // Bruges til label der passer til 60x100  // Bruges til label der passer til 60x100
386  procedure TLabelPrint.PrintFuldPakkeLabelLille( PakkeshopLabel : TPakkeshopLabel);  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 343  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;
# Line 454  end; Line 507  end;
507    
508    
509  // Bruges til label der passer til 100x150  // Bruges til label der passer til 100x150
510  procedure TLabelPrint.PrintFuldPakkeLabelStor( PakkeshopLabel : TPakkeshopLabel);  procedure TLabelPrint.PrintFuldPakkeLabelStor( PakkeshopLabel : TLabelData);
511  var  var
512    XForm, XFormOld: TXForm; //Bruges til rotate X-formation    XForm, XFormOld: TXForm; //Bruges til rotate X-formation
513    Angle: integer;    Angle: integer;
# Line 601  begin Line 654  begin
654  end;  end;
655    
656  // 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  
   ;  
657    
   PrintZpl(zpl);  
 end;  
658    
659  procedure TLabelPrint.PrintZPL( ZplData : string);  procedure TLabelPrint.PrintZPL( ZplData : string);
660  var  var
# Line 699  begin Line 727  begin
727    
728  end;  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.3091  
changed lines
  Added in v.3129
  ViewVC Help
Powered by ViewVC 1.1.20