/[projects]/dao/DelphiScanner/Main.pas
ViewVC logotype

Diff of /dao/DelphiScanner/Main.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2704 by torben, Fri Sep 4 09:56:58 2015 UTC revision 2705 by torben, Fri Sep 4 12:39:33 2015 UTC
# Line 1  Line 1 
1  unit Main;  unit Main;
2    
3    // ToDo: flyt PrinterNavn til hhv Configuration lg lad TLabelPrint om al håndtering heraf
4    // ToDo: flyt flere parametre til TConfiguration
5    
6    // ToDo: FormKeyPress() trænger til en seriøs oprydning / refactoring
7    // ToDo: flyt mere funktionalitet fra interface layer til application layer klasser
8    // ToDo: vil det give mening at bruge State Pattern ? Så der er en class per scanningstype ?
9    // ToDo: alternativt kan man bruge en Enum til de forskellige typer
10    // ToDo: en enklere måde at håndtere capabilities på de forskellige scannings steder
11    
12    
13  interface  interface
14    
15  uses  uses
16    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
17    Dialogs, StdCtrls, Printers, IdBaseComponent, IdComponent, IdTCPConnection,    Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
18    IdTCPClient, IdHTTP, xmldom, XMLIntf, msxmldom, XMLDoc, IniFiles, AppEvnts,    IdTCPClient, IdHTTP, xmldom, XMLIntf, msxmldom, XMLDoc, IniFiles, AppEvnts,
19    Menus, ExtCtrls, ComCtrls, StrUtils, MMSystem, DateUtils,    Menus, ExtCtrls, ComCtrls, StrUtils, MMSystem, DateUtils,
20    IdExplicitTLSClientServerBase, IdFTP, pngimage, GIFImg, IdException,    IdExplicitTLSClientServerBase, IdFTP, IdException,
21    Winspool, ShellApi, ClipBrd, Buttons, wininet,    ShellApi, ClipBrd, Buttons, wininet,
22    UITypes,    UITypes,
23    PakkeshopLabels,    PakkeshopLabels,
24    StBarC,    Utils,
25    Math, // DegToRad() bruges i PrintPakkeshopLabel    ParentForm,
26    Utils    LabelPrint,
27      Configuration,
28      Vcl.Imaging.pngimage
29    
30    ;    ;
31    
32  type  type
33    TMainForm = class(TForm)    TMainForm = class(TForm, IParentForm)
34      StregkodeST: TStaticText;      StregkodeST: TStaticText;
35      RuteNummerST: TStaticText;      RuteNummerST: TStaticText;
36      BoghandlerNavnST: TStaticText;      BoghandlerNavnST: TStaticText;
# Line 93  type Line 105  type
105      PanelManglendePakker6: TPanel;      PanelManglendePakker6: TPanel;
106      menuIndlevering: TMenuItem;      menuIndlevering: TMenuItem;
107    
108    
109    
110    function getProddato() : TDate;    function getProddato() : TDate;
111    function getProddag() : String;    function getProddag() : String;
112    function retRutenummer(rutenummer : String) : String;    function retRutenummer(rutenummer : String) : String;
   function GetCurrentPrinterHandle() : THandle;  
   function SavePChar(p: PChar): PChar;  
113    
114    procedure PlaySound(filename : PWideChar);    procedure PlaySound(filename : PWideChar);
115    procedure StartScreen();    procedure StartScreen();
# Line 178  type Line 190  type
190    
191    procedure menuIndleveringClick(Sender: TObject);    procedure menuIndleveringClick(Sender: TObject);
192    
193    procedure PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  
194    procedure CheckPrintQue(tjektype : string);  
195    
196      //Nedarvet fra IParentForm
197      procedure LogMessage( msg : string);
198      procedure SetPrinterstatusText( txt: string; alert: boolean);
199      function GetFormObject() : TForm;
200    
201    
202    private    private
# Line 189  type Line 206  type
206      Sted : String;      Sted : String;
207      StedNavn : String;      StedNavn : String;
208      Url, UrlNormal, UrlReturDAO, UrlReturBoghandler, UrlBudlevering, UrlManglendeScanninger, UrlPakkeshoplevering, UrlReturPakkeshop, UrlPakkeshopManglendeScanninger, UrlPakkeshopManglendeReturScanninger,UrlIndleveringsPakke,UrlIndleveringsPakkeManglendeScanninger,UrlEKLoverforsel : String;      Url, UrlNormal, UrlReturDAO, UrlReturBoghandler, UrlBudlevering, UrlManglendeScanninger, UrlPakkeshoplevering, UrlReturPakkeshop, UrlPakkeshopManglendeScanninger, UrlPakkeshopManglendeReturScanninger,UrlIndleveringsPakke,UrlIndleveringsPakkeManglendeScanninger,UrlEKLoverforsel : String;
209  // 29150330: start  
210      UrlEKLoverforselPakkeshop : String;      UrlEKLoverforselPakkeshop : String;
211  // 20150330: slut  
212      UrlFindPakketype, UrlSendPrograminfo: String;      UrlFindPakketype, UrlSendPrograminfo: String;
213      Scanningtype, TestFunktionen, Pakketype, SporgEfterBoghandler : String;      Scanningtype, TestFunktionen, Pakketype, SporgEfterBoghandler : String;
214      ScanTjekkode : String;      ScanTjekkode : String;
215      ScanTjekkodeAutomatik : string;      ScanTjekkodeAutomatik : string;
216      Farve, FarveNormal, FarveReturDAO, FarveReturBoghandler, FarveBudlevering, FarvePakkeshoplevering, FarveReturPakkeshop, FarveIndlevering : String;      Farve, FarveNormal, FarveReturDAO, FarveReturBoghandler, FarveBudlevering, FarvePakkeshoplevering, FarveReturPakkeshop, FarveIndlevering : String;
217      Titel, TitelNormal, TitelReturDAO, TitelReturBoghandler, TitelBudlevering, TitelPakkeshoplevering, TitelReturPakkeshop, TitelIndlevering : String;      Titel, TitelNormal, TitelReturDAO, TitelReturBoghandler, TitelBudlevering, TitelPakkeshoplevering, TitelReturPakkeshop, TitelIndlevering : String;
218      LabelType : integer;  
219      AlarmLyd : String;      AlarmLyd : String;
220      ScannetOkLyd : String;      ScannetOkLyd : String;
221      ScannetOkStorLyd : String;      ScannetOkStorLyd : String;
# Line 207  type Line 224  type
224    
225      PrinterNavn : String;      PrinterNavn : String;
226      TjekPrinter : String;      TjekPrinter : String;
227      XPosRute : integer;  
     YPosRute : integer;  
     FontSizeRute : integer;  
     FontSizeRuteLille : integer;  
     XPosKommentar : integer;  
     YPosKommentar : integer;  
     FontSizeKommentar : integer;  
     XPosBoghandler : integer;  
     YPosBoghandler : integer;  
     FontSizeBoghandler : integer;  
     XPosKoreliste : integer;  
     YPosKoreliste : integer;  
     FontSizeKoreliste : integer;  
     FontSizeKorelisteLille : integer;  
     XPosSorteringsfelt1 : integer;  
     YPosSorteringsfelt1 : integer;  
     FontSizeSorteringsfelt1 : integer;  
     XPosSorteringsfelt2 : integer;  
     YPosSorteringsfelt2 : integer;  
     FontSizeSorteringsfelt2 : integer;  
     XPosSmskode : integer;  
     YPosSmskode : integer;  
     FontSizeSmskode : integer;  
228      Org_RuteNummerST, Org_BoghandlerNavnST, Org_KommentarST : String;      Org_RuteNummerST, Org_BoghandlerNavnST, Org_KommentarST : String;
229      BladhusSted : Integer;      BladhusSted : Integer;
230      BladhusStedKode : Array of string;      BladhusStedKode : Array of string;
# Line 242  type Line 237  type
237      PakkeshopStregkode, PakkeshopTjekkode : String;      PakkeshopStregkode, PakkeshopTjekkode : String;
238      BoghandlerStregkode, BoghandlerTjekkode : String;      BoghandlerStregkode, BoghandlerTjekkode : String;
239      TjekUrls : String;      TjekUrls : String;
240        Config : TConfiguration;
241    
     Barcode : TStBarcode;  
242    
243        LabelPrint: TLabelPrint;
244    
245      procedure PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : String = '');      procedure PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : String = '');
246      procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');  
247      procedure HentPakkeInfoFraServer(const Sted, PakkeNr : String; var RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel: Boolean; BoghandlerNummer : String = '');      procedure HentPakkeInfoFraServer(const Sted, PakkeNr : String; var RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel: Boolean; BoghandlerNummer : String = '');
248      procedure CheckCode();      procedure CheckCode();
249      procedure IndlesManglendeScanninger();      procedure IndlesManglendeScanninger();
# Line 262  type Line 258  type
258      { Public declarations }      { Public declarations }
259    end;    end;
260    
       function GetPixelsPerInchX(): Integer;  
     function GetPixelsPerInchY(): Integer;  
261    
262  var  var
263    MainForm: TMainForm;    MainForm: TMainForm;
# Line 279  implementation Line 273  implementation
273  {$R *.dfm}  {$R *.dfm}
274    
275    
276    //FormCreate kaldes før InitForm
277    
278  procedure TMainForm.InitForm(Farve,Titel,Url : String);  procedure TMainForm.InitForm(Farve,Titel,Url : String);
279  begin  begin
280    
   
281      StaticTextManglendePakker.Caption := '';      StaticTextManglendePakker.Caption := '';
282    
283    
     Barcode := TStBarcode.Create(MainForm);//Dynamisk oprettelse af Barcode component  
   
284      PanelValg1.Color := clBtnFace;      PanelValg1.Color := clBtnFace;
285      if PanelValg1.Enabled = true then      if PanelValg1.Enabled = true then
286      begin      begin
# Line 455  begin Line 448  begin
448        end;        end;
449      end;      end;
450    
451    
452  end;  end;
453    
454  procedure TMainForm.Altidprintepakkelabel1Click(Sender: TObject);  procedure TMainForm.Altidprintepakkelabel1Click(Sender: TObject);
# Line 500  begin Line 494  begin
494       PanelValgA.Font.Color := clWhite;       PanelValgA.Font.Color := clWhite;
495  end;  end;
496    
497    
498    //InitForm kaldes før FormCreate
499  procedure TMainForm.FormCreate(Sender: TObject);  procedure TMainForm.FormCreate(Sender: TObject);
500  const  const
501    crlf = Chr(13) + Chr(10) ;  // Carriage return & Linefeed    crlf = Chr(13) + Chr(10) ;  // Carriage return & Linefeed
502  var  var
   printerInd : integer;  
503    gemScanningtype : String;    gemScanningtype : String;
504    
505  begin  begin
506    
507    
508    // Initierer nogle variabler    // Initierer nogle variabler
509    BladhusSted := 00;    BladhusSted := 00;
510    Application.ShowHint := True;    Application.ShowHint := True;
# Line 535  begin Line 532  begin
532    MainForm.ClientWidth := 1000;    MainForm.ClientWidth := 1000;
533    MainForm.ClientHeight := 750;    MainForm.ClientHeight := 750;
534    
535      Config := TConfiguration.Create();
536      Config.ReadFromInifile( TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) );    //ToDo: clean up duplicate ini ref
537      Config.Sted := Sted;
538    
539    // Læser parametre fra ini filen    // Læser parametre fra ini filen
540    with TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) do    with TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) do
541    try    try
542    
543    
544      SkrivLog := ReadString('Settings','SkrivLog','0');      SkrivLog := ReadString('Settings','SkrivLog','0');
545      Sted := ReadString('Settings','Sted','');      Sted := ReadString('Settings','Sted','');
546      StedNavn := ReadString('Settings','Stednavn','');      StedNavn := ReadString('Settings','Stednavn','');
# Line 563  begin Line 566  begin
566    
567    
568    
     LabelType := ReadInteger('Settings','LabelType',1);  
569      FarveNormal := ReadString('Settings','FarveNormal','D8D8D8');      FarveNormal := ReadString('Settings','FarveNormal','D8D8D8');
570      TitelNormal := ReadString('Settings','TitelNormal','Modtagelse af DAO NAT X-PRESS pakker');      TitelNormal := ReadString('Settings','TitelNormal','Modtagelse af DAO NAT X-PRESS pakker');
571      FarveReturDAO := ReadString('Settings','FarveReturDAO','A9F5A9');      FarveReturDAO := ReadString('Settings','FarveReturDAO','A9F5A9');
# Line 622  begin Line 624  begin
624        PanelValgA.Font.Color := clWhite;        PanelValgA.Font.Color := clWhite;
625      end;      end;
626    
627      if LabelType = 0 then  
     begin  
        XPosRute := ReadInteger('RuteBred','XPos',1);  
        YPosRute := ReadInteger('RuteBred','YPos',1);  
        FontSizeRute := ReadInteger('RuteBred','FontSize',72);  
        FontSizeRuteLille := ReadInteger('RuteBred','FontSizeLille',20);  
        XPosKommentar := ReadInteger('KommentarBred','XPos',1);  
        YPosKommentar := ReadInteger('KommentarBred','YPos',250);  
        FontSizeKommentar := ReadInteger('KommentarBred','FontSize',16);  
        XPosBoghandler := ReadInteger('BoghandlerBred','XPos',1);  
        YPosBoghandler := ReadInteger('BoghandlerBred','YPos',400);  
        FontSizeBoghandler := ReadInteger('BoghandlerBred','FontSize',16);  
        XPosKoreliste := ReadInteger('KorelisteSmal','XPos',1);  
        YPosKoreliste := ReadInteger('KorelisteSmal','YPos',100);  
        FontSizeKoreliste := ReadInteger('KorelisteSmal','FontSize',72);  
        FontSizeKorelisteLille := ReadInteger('KorelisteSmal','FontSizeLille',20);  
        XPosSorteringsfelt1 := ReadInteger('Sorteringsfelt1Smal','XPos',700);  
        YPosSorteringsfelt1 := ReadInteger('Sorteringsfelt1Smal','YPos',100);  
        FontSizeSorteringsfelt1 := ReadInteger('Sorteringsfelt1Smal','FontSize',16);  
        XPosSorteringsfelt2 := ReadInteger('Sorteringsfelt2Smal','XPos',700);  
        YPosSorteringsfelt2 := ReadInteger('Sorteringsfelt2Smal','YPos',150);  
        FontSizeSorteringsfelt2 := ReadInteger('Sorteringsfelt2Smal','FontSize',16);  
        XPosSmskode := ReadInteger('SmskodeSmal','XPos',1);  
        YPosSmskode := ReadInteger('SmskodeSmal','YPos',300);  
        FontSizeSmskode := ReadInteger('SmskodeSmal','FontSize',32);  
     end  
     else  
     begin  
        XPosRute := ReadInteger('RuteSmal','XPos',1);  
        YPosRute := ReadInteger('RuteSmal','YPos',1);  
        FontSizeRute := ReadInteger('RuteSmal','FontSize',72);  
        FontSizeRuteLille := ReadInteger('RuteSmal','FontSizeLille',20);  
        XPosKommentar := ReadInteger('KommentarSmal','XPos',1);  
        YPosKommentar := ReadInteger('KommentarSmal','YPos',250);  
        FontSizeKommentar := ReadInteger('KommentarSmal','FontSize',16);  
        XPosBoghandler := ReadInteger('BoghandlerSmal','XPos',1);  
        YPosBoghandler := ReadInteger('BoghandlerSmal','YPos',400);  
        FontSizeBoghandler := ReadInteger('BoghandlerSmal','FontSize',16);  
        XPosKoreliste := ReadInteger('KorelisteSmal','XPos',1);  
        YPosKoreliste := ReadInteger('KorelisteSmal','YPos',100);  
        FontSizeKoreliste := ReadInteger('KorelisteSmal','FontSize',72);  
        FontSizeKorelisteLille := ReadInteger('KorelisteSmal','FontSizeLille',20);  
        XPosSorteringsfelt1 := ReadInteger('Sorteringsfelt1Smal','XPos',700);  
        YPosSorteringsfelt1 := ReadInteger('Sorteringsfelt1Smal','YPos',100);  
        FontSizeSorteringsfelt1 := ReadInteger('Sorteringsfelt1Smal','FontSize',16);  
        XPosSorteringsfelt2 := ReadInteger('Sorteringsfelt2Smal','XPos',700);  
        YPosSorteringsfelt2 := ReadInteger('Sorteringsfelt2Smal','YPos',150);  
        FontSizeSorteringsfelt2 := ReadInteger('Sorteringsfelt2Smal','FontSize',16);  
        XPosSmskode := ReadInteger('SmskodeSmal','XPos',1);  
        YPosSmskode := ReadInteger('SmskodeSmal','YPos',300);  
        FontSizeSmskode := ReadInteger('SmskodeSmal','FontSize',32);  
        if LabelType = 2 then // test på alm. printer kræver at XY-positionerne ganges med 3  
        begin  
           XPosRute := XPosRute * 3;  
           YPosRute := YPosRute * 3;  
           XPosKommentar := XPosKommentar * 3;  
           YPosKommentar := YPosKommentar * 3;  
           XPosBoghandler := XPosBoghandler * 3;  
           YPosBoghandler := YPosBoghandler * 3;  
           XPosKoreliste := XPosKoreliste * 3;  
           YPosKoreliste := YPosKoreliste * 3;  
           XPosSorteringsfelt1 := XPosSorteringsfelt1 * 3;  
           YPosSorteringsfelt1 := YPosSorteringsfelt1 * 3;  
           XPosSorteringsfelt2 := XPosSorteringsfelt2 * 3;  
           YPosSorteringsfelt2 := YPosSorteringsfelt2 * 3;  
           XPosSmskode := XPosSmskode * 3;  
           YPosSmskode := YPosSmskode * 3;  
        end;  
     end;  
628    
629      if SporgEfterBoghandler = '1' then      if SporgEfterBoghandler = '1' then
630      begin      begin
# Line 1052  begin Line 986  begin
986      end;      end;
987    
988    
     if (PrinterNavn <> '') then  
     begin  
        printerInd := Printer.Printers.IndexOf(printerNavn);  
        if printerInd >= 0 then  
           Printer.PrinterIndex := printerInd;  
     end;  
989    
990      CheckPrintQue('Opstart');  
991        LabelPrint := TLabelPrint.Create( self, Config, PrinterNavn );
992        LabelPrint.CheckPrintQue('Opstart', PrinterNavn);
993    
994    finally    finally
995      Free;      Free;
# Line 2115  begin Line 2045  begin
2045         RuteNummer := PakkeshopLabel.Koreliste + '  ->  ' +  PakkeshopLabel.PakkeshopTurid;         RuteNummer := PakkeshopLabel.Koreliste + '  ->  ' +  PakkeshopLabel.PakkeshopTurid;
2046         Stregkode := PakkeshopLabel.Stregkode;         Stregkode := PakkeshopLabel.Stregkode;
2047    
2048         PrintPakkeshopLabel( PakkeshopLabel );         LabelPrint.PrintPakkeshopLabel( PakkeshopLabel );
2049    
2050       end;       end;
2051    
# Line 2393  begin Line 2323  begin
2323               if PrintNyLabel or (RuteNummer = 'Rutenr') then               if PrintNyLabel or (RuteNummer = 'Rutenr') then
2324  // 20150304: slut  // 20150304: slut
2325                begin                begin
2326                  SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);                  LabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
2327                end;                end;
2328              end;              end;
2329        01 :  begin;        01 :  begin;
# Line 2401  begin Line 2331  begin
2331                    // Ovenstående test er lidt speciel fordi der i programmet nogle steder er byttet rundt på rute og køreliste                    // Ovenstående test er lidt speciel fordi der i programmet nogle steder er byttet rundt på rute og køreliste
2332                    // Meningen er at der kun skal printes hvis der er forskel i kørelisterne eller ruterne - eller vi kommer fra test funktionen (Rutenr = 'Rutenr')                    // Meningen er at der kun skal printes hvis der er forskel i kørelisterne eller ruterne - eller vi kommer fra test funktionen (Rutenr = 'Rutenr')
2333                begin                begin
2334                  SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);                  LabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
2335                end;                end;
2336              end;              end;
2337        02 :  begin;        02 :  begin;
2338                if PrintNyLabel or (RuteNummer = 'Rutenr') then   // Hvis RuteNummer = 'Rutenr' er vi igang med en printer test                if PrintNyLabel or (RuteNummer = 'Rutenr') then   // Hvis RuteNummer = 'Rutenr' er vi igang med en printer test
2339                begin                begin
2340                  SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);                  LabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
2341                end;                end;
2342              end;              end;
2343        03 :  begin;        03 :  begin;
# Line 2415  begin Line 2345  begin
2345                    // Ovenstående test er lidt speciel fordi der i programmet nogle steder er byttet rundt på rute og køreliste                    // Ovenstående test er lidt speciel fordi der i programmet nogle steder er byttet rundt på rute og køreliste
2346                    // Meningen er at der kun skal printes hvis der er forskel i kørelisterne eller ruterne - eller vi kommer fra test funktionen (Rutenr = 'Rutenr')                    // Meningen er at der kun skal printes hvis der er forskel i kørelisterne eller ruterne - eller vi kommer fra test funktionen (Rutenr = 'Rutenr')
2347               begin               begin
2348                  SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);                  LabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
2349               end;               end;
2350              end;              end;
2351        04 :  begin;        04 :  begin;
2352                if PrintNyLabel or (RuteNummer = 'Rutenr') then   // Hvis RuteNummer = 'Rutenr' er vi igang med en printer test                if PrintNyLabel or (RuteNummer = 'Rutenr') then   // Hvis RuteNummer = 'Rutenr' er vi igang med en printer test
2353                begin                begin
2354                  SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);                  LabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
2355                end;                end;
2356              end;              end;
2357        else        else
# Line 2457  begin Line 2387  begin
2387        end;        end;
2388        logTekst := logTekst + ' for '+BoghandlerNavn;        logTekst := logTekst + ' for '+BoghandlerNavn;
2389        SkrivScanningLogFil(logTekst);        SkrivScanningLogFil(logTekst);
2390        with Printer do  
2391        begin        LabelPrint.PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn) ;
2392          BeginDoc;        
         Canvas.Font.Size := FontSizeRute;  
         if (Length(RuteNummer) > 7) then  
         begin  
           Canvas.Font.Size := FontSizeRuteLille;  
         end;  
         Canvas.TextOut(XPosRute,YPosRute, RuteNummer);  
         Canvas.Font.Size := FontSizeKommentar;  
         Kommentar := StringReplace(Kommentar, #$A, ' - ', [rfReplaceAll, rfIgnoreCase]);  
         if (Kommentar = 'Ok') or (Kommentar = 'ALLEREDE SCANNET') then  
         begin  
           Kommentar := '';  
         end;  
         if (BoghandlerNavn = 'PAKKE ER SCANNET') then  
         begin  
           BoghandlerNavn := '';  
         end;  
         Canvas.TextOut(XPosKommentar,YPosKommentar, Kommentar);  // Kan ikke lave linieskift (se tidligere kommentar om samme)  
         Canvas.Font.Size := FontSizeBoghandler;  
         Canvas.TextOut(XPosBoghandler,YPosBoghandler, BoghandlerNavn);  
         EndDoc;  
       end;  
2393      end;      end;
2394    end;    end;
2395    
2396  end;  end;
2397    
 procedure TMainForm.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');  
 begin  
     with Printer do  
     begin  
       BeginDoc;  
       Canvas.Font.Size := FontSizeRuteLille;  
       if (kontrolKoreliste <> '') then  
       begin  
         Canvas.TextOut(XPosRute,YPosRute, kontrolKoreliste);  
       end  
       else  
       begin  
         Canvas.TextOut(XPosRute,YPosRute, RuteNummer);  
       end;  
       Canvas.Font.Size := FontSizeKorelisteLille;  
       Canvas.TextOut(XPosKoreliste,YPosKoreliste, Koreliste);  
       if (Sted = 'DBK') or (Sted = '04') then  
       begin  
         Canvas.Font.Size := FontSizeSorteringsfelt1;  
         Canvas.TextOut(XPosSorteringsfelt1,YPosSorteringsfelt1, DBKbane);   // sorteringsoplysning 1  
         Canvas.Font.Size := FontSizeSorteringsfelt1;  
         Canvas.TextOut(XPosSorteringsfelt2,YPosSorteringsfelt2, Leveringssted);   // sorteringsoplysning 2  
       end;  
       Canvas.Font.Size := FontSizeKommentar;  
   
       Kommentar := StringReplace(Kommentar, #$A, ' - ', [rfReplaceAll, rfIgnoreCase]);  
       Kommentar := StringReplace(Kommentar, 'PAKKE ER SCANNET', '', [rfReplaceAll, rfIgnoreCase]);  
   
       Canvas.TextOut(XPosKommentar,YPosKommentar, Kommentar);  // Kan ikke lave linieskift (se tidligere kommentar om samme)  
       if SmsKode <> '' then  
       begin  
         Canvas.Font.Size := FontSizeSmskode;  
         Canvas.TextOut(XPosKommentar,YPosSmskode, concat('CODE: ', SmsKode));  
       end;  
       Canvas.Font.Size := FontSizeBoghandler;  
       Canvas.TextOut(XPosBoghandler,YPosBoghandler, BoghandlerNavn);  
       EndDoc;  
     end;  
 end;  
2398    
2399    
2400  procedure TMainForm.radioStorPakkeClick(Sender: TObject);  procedure TMainForm.radioStorPakkeClick(Sender: TObject);
# Line 2974  begin Line 2844  begin
2844    Falsk := False;    Falsk := False;
2845    
2846    
2847    if (Printer.Printers.Count = 0) then    if (LabelPrint.GetPrinterCount() = 0) then
2848    begin    begin
2849      ShowMessage('Der er ikke installeret en printer på denne PC.');      ShowMessage('Der er ikke installeret en printer på denne PC.');
2850    end    end
# Line 2989  begin Line 2859  begin
2859      DBKbane := '999';      DBKbane := '999';
2860      Leveringssted := 'XXX';      Leveringssted := 'XXX';
2861      PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, Falsk);      PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, Falsk);
2862      CheckPrintQue('Test');      LabelPrint.CheckPrintQue('Test', PrinterNavn);
2863    end;    end;
2864    FocusControl(StregkodeST);    FocusControl(StregkodeST);
2865  end;  end;
# Line 2998  procedure TMainForm.Timer1Timer(Sender: Line 2868  procedure TMainForm.Timer1Timer(Sender:
2868  begin  begin
2869    if (TjekPrinter = '1') then    if (TjekPrinter = '1') then
2870    begin    begin
2871      CheckPrintQue('Timer');      LabelPrint.CheckPrintQue('Timer', PrinterNavn);
2872    end    end
2873    else    else
2874    begin    begin
# Line 4149  begin Line 4019  begin
4019  end;  end;
4020    
4021    
 // ToDo: PrintPakkeshopLabel()  
 procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  
 var  
   XForm, XFormOld: TXForm; //Bruges til rotate X-formation  
   Angle: integer;  
   gMode: integer;  
   Dirigering: string;  
   
 begin  
     with Printer do  
     begin  
       BeginDoc();  
   
   
       Canvas.Font.Size := 16;  
       Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);  
   
   
   
       Canvas.TextOut(25, 90, PakkeshopLabel.Navn );  
       Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn );  
       Canvas.TextOut(25, 180, PakkeshopLabel.Postnr );  
   
   
       Canvas.Font.Size := 9;  
       Canvas.TextOut(110, 240, 'Pakkeshop:');  
       Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);  
       Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);  
       Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);  
   
       Canvas.TextOut(350, 240, 'Afsender:');  
       Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);  
       Canvas.TextOut(350, 300, PakkeshopLabel.AfsenderAdresse);  
       Canvas.TextOut(350, 330, PakkeshopLabel.AfsenderPostnr);  
   
       Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr;  
       if ( PakkeshopLabel.Koreliste <> '') then  
       begin  
         Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;  
       end;  
   
   
       Canvas.Font.Size := 12;  
       Canvas.TextOut(15, 370, Dirigering);  
   
   
   
   
   
       //Tegn adskillelses linier  
       Canvas.Pen.Width := 2;  
       //Øverste linie  
       Canvas.MoveTo(20,80);  
       Canvas.LineTo(600,80);  
   
       // Midterste linie  
       Canvas.MoveTo( 20, 240);  
       Canvas.LineTo(600, 240);  
   
       //Nederste linie  
       Canvas.MoveTo( 20, 370);  
       Canvas.LineTo(600, 370);  
   
   
       //Tegn skrå streger over afsender  
       Canvas.Pen.Width := 1;  
       Canvas.MoveTo(600, 250);  
       Canvas.LineTo(350, 360);  
       Canvas.MoveTo(600, 360);  
       Canvas.LineTo(350, 250);  
   
   
   
   
       // Resten af rutinen vedr genering og placering af Barcode  
   
       BarCode.BarCodeType := bcCode128;  
       BarCode.Code128Subset := csCodeC;  
       BarCode.Code := PakkeshopLabel.Stregkode;  
       BarCode.Validate(True);  
   
       //Start X-formation  
       //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );  
       GetWorldTransform(Canvas.Handle, XFormOld);  
   
       Angle := 270;  
       XForm.eM11 := Cos(DegToRad(Angle));  
       XForm.eM12 := Sin(DegToRad(Angle));  
       XForm.eM21 := -Sin(DegToRad(Angle));  
       XForm.eM22 := Cos(DegToRad(Angle));  
       XForm.eDx := 0;  
       XForm.eDy := 0;  
   
       gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);  
       SetWorldTransform(Canvas.Handle, XForm);  
   
       // PaintToCanvasSize arbejder i Inches  
       // Første pos argument bliver nu Y og skal være negativ for at rykke den ned  
       //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre  
   
       BarCode.PaintToCanvasSize(Printer.Canvas, -1.8, 3.3, 0.4);  
   
   
       SetWorldTransform(Canvas.Handle, XFormOld);  
       SetGraphicsMode(Canvas.Handle, gMode);  
   
       EndDoc();  
     end;  
   
   
 end;  
   
 function GetPixelsPerInchX(): Integer;  
 begin  
   Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)  
 end;  
   
 function GetPixelsPerInchY(): Integer;  
 begin  
   Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)  
 end;  
   
4022    
4023  procedure TMainForm.IndlesManglendeScanninger();  procedure TMainForm.IndlesManglendeScanninger();
4024  var  var
# Line 4972  begin Line 4720  begin
4720    result := svar;    result := svar;
4721  end;  end;
4722    
 function TMainForm.GetCurrentPrinterHandle: THandle;  
 var  
   Device, Driver, Port: array[0..255] of Char;  
   hDeviceMode: THandle;  
 begin  
   Printer.GetPrinter(Device, Driver, Port, hDeviceMode);  
   if not OpenPrinter(@Device, Result, nil) then  
     RaiseLastWin32Error;  
 end;  
   
 function TMainForm.SavePChar(p: PChar): PChar;  
 const  
   error: PChar = 'Nil';  
 begin  
   if not Assigned(p) then  
     Result := error  
   else  
     Result := p;  
 end;  
4723    
4724  procedure TMainForm.Scanogstjekkoden1Click(Sender: TObject);  procedure TMainForm.Scanogstjekkoden1Click(Sender: TObject);
4725  begin  begin
# Line 5006  end; Line 4735  end;
4735    
4736    
4737    
4738    //Nedarvet fra IParentForm
4739    procedure TMainForm.LogMessage( msg : string);
4740    begin
4741      ListBox1.Items.Insert(0, msg);
4742      SkrivScanningLogFil(msg);
4743    end;
4744    
4745    
4746    //Nedarvet fra IParentForm
4747    procedure TMainForm.SetPrinterstatusText( txt: string; alert: boolean);
 procedure TMainForm.CheckPrintQue(tjektype : string);  
 type  
   TJobs  = array [0..1000] of JOB_INFO_1;  
   PJobs = ^TJobs;  
 var  
   hPrinter: THandle;  
   bytesNeeded, numJobs, i: Cardinal;  
   pJ: PJobs;  
   printerTxt, statusTxt, dokumentTxt: String;  
4748  begin  begin
4749    
4750  // tjektype = 'Opstart' skal vise alarmlinie, samt opdatere listbox1    PrinterstatusStaticText1.Caption := txt;
4751  //            'Test'  skal vise alarmlinie, samt opdatere listbox1    if (alert) then
 //            'Timer' skal kun vise alarmlinie  
   
   if (PrinterNavn = 'Ingen') and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then  
   begin  
     printerTxt := 'Der er fravalgt printer i dette program';  
     ListBox1.Items.Insert(0,printerTxt);  
     SkrivScanningLogFil(printerTxt);  
   end  
   else if (Printer.Printers.Count = 0) and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then  
4752    begin    begin
4753      printerTxt := 'Der er ikke installeret en printer på denne PC';      PrinterstatusStaticText1.Font.Color := clBlack;
4754      ListBox1.Items.Insert(0,printerTxt);      PrinterstatusStaticText1.Color := MainForm.Color;
4755      SkrivScanningLogFil(printerTxt);      PrinterstatusStaticText1.Transparent := True;
4756    end    end
4757    else    else
4758    begin    begin
4759      hPrinter := GetCurrentPrinterHandle;      PrinterstatusStaticText1.Font.Color := clRed;
4760      try      PrinterstatusStaticText1.Color := clWhite;
4761        EnumJobs(hPrinter, 0, 1000, 1, nil, 0, bytesNeeded, numJobs);      PrinterstatusStaticText1.Transparent := true;
       pJ := AllocMem(bytesNeeded);  
       if not EnumJobs(hPrinter, 0, 1000, 1, pJ, bytesNeeded, bytesNeeded, numJobs) then  
         RaiseLastWin32Error;  
   
       if numJobs = 0 then  
       begin  
         if (tjektype = 'Test') then  
         begin  
           logTekst := printerTxt + ': Ingen dokumenter i kø';  
           ListBox1.Items.Insert(0,logTekst);  
           SkrivScanningLogFil(logTekst);  
         end;  
         PrinterstatusStaticText1.Caption := '';  
         PrinterstatusStaticText1.Color := MainForm.Color;  
       end  
       else   // så er der kø til printeren  
       begin  
         printerTxt := SavePChar(pJ^[0].pPrinterName);  
         if (tjektype = 'Opstart') or (tjektype = 'Test') then  
         begin  
           logTekst := IntToStr(numJobs) + ' dokument(er) i kø til printer: ' + printerTxt;  
           ListBox1.Items.Insert(0,logTekst);  
           SkrivScanningLogFil(logTekst);  
         end;  
         for i := 0 to Pred(numJobs) do  
         begin  
           printerTxt := SavePChar(pJ^[i].pPrinterName);  
           statusTxt := 'Ukendt';  
           if (IntToStr(pJ^[i].Status) = '0') then  
             statusTxt := 'Venter...';  
           if (IntToStr(pJ^[i].Status) = '4096') then  
             statusTxt := 'Printer...';  
           if (IntToStr(pJ^[i].Status) = '8210') then  
             statusTxt := 'Printerfejl';  
           if (IntToStr(pJ^[i].Status) = '8214') then  
             statusTxt := 'Sletter print...';  
   
           dokumentTxt := SavePChar(pJ^[i].pDocument);  
           if (dokumentTxt = '') then  
             dokumentTxt := 'Uden navn';  
   
           if (tjektype = 'Opstart') or (tjektype = 'Test') then  
           begin  
             logTekst := Format('Printer %s, Dokument %d: %s, Status (%d): %s',  
                                     [printerTxt, i+1, dokumentTxt, pJ^[i].Status, statusTxt]);  
             ListBox1.Items.Insert(0,logTekst);  
             SkrivScanningLogFil(logTekst);  
           end;  
   
           if (i = 0) then  
           begin  
             PrinterstatusStaticText1.Caption := printerTxt + ': ' + IntToStr(numJobs) + ' dokument(er) in kø. Dokument status: ' + statusTxt;  
             PrinterstatusStaticText1.Font.Color := clBlack;  
             PrinterstatusStaticText1.Color := MainForm.Color;  
             PrinterstatusStaticText1.Transparent := True;  
             if (numJobs > 3) then  
             begin  
               PrinterstatusStaticText1.Font.Color := clRed;  
               PrinterstatusStaticText1.Color := clWhite;  
               PrinterstatusStaticText1.Transparent := true;  
             end;  
           end;  
   
         end;  
       end  
       finally  
         ClosePrinter(hPrinter);  
     end;  
4762    end;    end;
4763  end;  end;
4764    
4765    //Nedarvet fra IParentForm
4766    function TMainForm.GetFormObject() : TForm;
4767    begin
4768      Result := self;
4769    end;
4770    
4771  end.  end.
4772    

Legend:
Removed from v.2704  
changed lines
  Added in v.2705

  ViewVC Help
Powered by ViewVC 1.1.20