/[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 2700 by torben, Thu Sep 3 14:53:37 2015 UTC revision 2792 by torben, Sun Dec 6 15:23:50 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      Generics.Collections
30    
31    ;    ;
32    
33  type  type
34    TMainForm = class(TForm)    TMainForm = class(TForm, IParentForm)
35      StregkodeST: TStaticText;      StregkodeST: TStaticText;
36      RuteNummerST: TStaticText;      RuteNummerST: TStaticText;
37      BoghandlerNavnST: TStaticText;      BoghandlerNavnST: TStaticText;
# Line 92  type Line 105  type
105      PanelManglendePakker5: TPanel;      PanelManglendePakker5: TPanel;
106      PanelManglendePakker6: TPanel;      PanelManglendePakker6: TPanel;
107      menuIndlevering: TMenuItem;      menuIndlevering: TMenuItem;
108        chkForstorTilDirekte: TCheckBox;
109    
110    
111    
112    function getProddato() : TDate;    function getProddato() : TDate;
113    function getProddag() : String;    function getProddag() : String;
114    function retRutenummer(rutenummer : String) : String;    function retRutenummer(rutenummer : String) : String;
   function GetCurrentPrinterHandle() : THandle;  
   function SavePChar(p: PChar): PChar;  
115    
116    procedure PlaySound(filename : PWideChar);    procedure PlaySound(filename : PWideChar);
117    procedure StartScreen();    procedure StartScreen();
# Line 174  type Line 188  type
188    procedure SletLogfiler(Path: string; FileList: TStrings);    procedure SletLogfiler(Path: string; FileList: TStrings);
189    procedure Manualgenerel1Click(Sender: TObject);    procedure Manualgenerel1Click(Sender: TObject);
190    procedure TjekkerUrls();    procedure TjekkerUrls();
191      procedure TjekkerEnkeltUrl(UrlNavn: String; Url: String; var urlFejl: integer);
192    
193    procedure menuIndleveringClick(Sender: TObject);    procedure menuIndleveringClick(Sender: TObject);
194    
195    procedure PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  
196    procedure CheckPrintQue(tjektype : string);  
197    
198      //Nedarvet fra IParentForm
199      procedure LogMessage( msg : string);
200      procedure SetPrinterstatusText( txt: string; alert: boolean);
201      function GetFormObject() : TForm;
202    
203    
204    private    private
# Line 188  type Line 208  type
208      Sted : String;      Sted : String;
209      StedNavn : String;      StedNavn : String;
210      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;
211  // 29150330: start  
212      UrlEKLoverforselPakkeshop : String;      UrlEKLoverforselPakkeshop : String;
213  // 20150330: slut  
214      UrlFindPakketype, UrlSendPrograminfo: String;      UrlFindPakketype, UrlSendPrograminfo: String;
215      Scanningtype, TestFunktionen, Pakketype, SporgEfterBoghandler : String;      Scanningtype, TestFunktionen, Pakketype, SporgEfterBoghandler : String;
216      ScanTjekkode : String;      ScanTjekkode : String;
217      ScanTjekkodeAutomatik : string;      ScanTjekkodeAutomatik : string;
218      Farve, FarveNormal, FarveReturDAO, FarveReturBoghandler, FarveBudlevering, FarvePakkeshoplevering, FarveReturPakkeshop, FarveIndlevering : String;      Farve, FarveNormal, FarveReturDAO, FarveReturBoghandler, FarveBudlevering, FarvePakkeshoplevering, FarveReturPakkeshop, FarveIndlevering : String;
219      Titel, TitelNormal, TitelReturDAO, TitelReturBoghandler, TitelBudlevering, TitelPakkeshoplevering, TitelReturPakkeshop, TitelIndlevering : String;      Titel, TitelNormal, TitelReturDAO, TitelReturBoghandler, TitelBudlevering, TitelPakkeshoplevering, TitelReturPakkeshop, TitelIndlevering : String;
220      LabelType : integer;  
221      AlarmLyd : String;      AlarmLyd : String;
222      ScannetOkLyd : String;      ScannetOkLyd : String;
223      ScannetOkStorLyd : String;      ScannetOkStorLyd : String;
# Line 206  type Line 226  type
226    
227      PrinterNavn : String;      PrinterNavn : String;
228      TjekPrinter : String;      TjekPrinter : String;
229      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;  
230      Org_RuteNummerST, Org_BoghandlerNavnST, Org_KommentarST : String;      Org_RuteNummerST, Org_BoghandlerNavnST, Org_KommentarST : String;
231      BladhusSted : Integer;      BladhusSted : Integer;
232      BladhusStedKode : Array of string;      BladhusStedKode : Array of string;
# Line 241  type Line 239  type
239      PakkeshopStregkode, PakkeshopTjekkode : String;      PakkeshopStregkode, PakkeshopTjekkode : String;
240      BoghandlerStregkode, BoghandlerTjekkode : String;      BoghandlerStregkode, BoghandlerTjekkode : String;
241      TjekUrls : String;      TjekUrls : String;
242        Config : TConfiguration;
243    
     Barcode : TStBarcode;  
244    
245        LabelPrint: TLabelPrint;
246    
247      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 = '');
248      procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');  
249      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 = '');
250      procedure CheckCode();      procedure CheckCode();
251      procedure IndlesManglendeScanninger();      procedure IndlesManglendeScanninger();
# Line 261  type Line 260  type
260      { Public declarations }      { Public declarations }
261    end;    end;
262    
       function GetPixelsPerInchX(): Integer;  
     function GetPixelsPerInchY(): Integer;  
263    
264  var  var
265    MainForm: TMainForm;    MainForm: TMainForm;
# Line 278  implementation Line 275  implementation
275  {$R *.dfm}  {$R *.dfm}
276    
277    
278    //FormCreate kaldes før InitForm
279    
280  procedure TMainForm.InitForm(Farve,Titel,Url : String);  procedure TMainForm.InitForm(Farve,Titel,Url : String);
281  begin  begin
282    
 // 20150309: startr  
283      StaticTextManglendePakker.Caption := '';      StaticTextManglendePakker.Caption := '';
 // 20150309: slut  
284    
     Barcode := TStBarcode.Create(MainForm);//Dynamisk oprettelse af Barcode component  
285    
286      PanelValg1.Color := clBtnFace;      PanelValg1.Color := clBtnFace;
287      if PanelValg1.Enabled = true then      if PanelValg1.Enabled = true then
# Line 454  begin Line 450  begin
450        end;        end;
451      end;      end;
452    
453    
454  end;  end;
455    
456  procedure TMainForm.Altidprintepakkelabel1Click(Sender: TObject);  procedure TMainForm.Altidprintepakkelabel1Click(Sender: TObject);
# Line 499  begin Line 496  begin
496       PanelValgA.Font.Color := clWhite;       PanelValgA.Font.Color := clWhite;
497  end;  end;
498    
499    
500    //InitForm kaldes før FormCreate
501  procedure TMainForm.FormCreate(Sender: TObject);  procedure TMainForm.FormCreate(Sender: TObject);
502  const  const
503    crlf = Chr(13) + Chr(10) ;  // Carriage return & Linefeed    crlf = Chr(13) + Chr(10) ;  // Carriage return & Linefeed
504  var  var
   printerInd : integer;  
505    gemScanningtype : String;    gemScanningtype : String;
506    
507  begin  begin
508    
509    
510    // Initierer nogle variabler    // Initierer nogle variabler
511    BladhusSted := 00;    BladhusSted := 00;
512    Application.ShowHint := True;    Application.ShowHint := True;
# Line 534  begin Line 534  begin
534    MainForm.ClientWidth := 1000;    MainForm.ClientWidth := 1000;
535    MainForm.ClientHeight := 750;    MainForm.ClientHeight := 750;
536    
537      Config := TConfiguration.Create();
538      Config.ReadFromInifile( TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) );    //ToDo: clean up duplicate ini ref
539      Config.Sted := Sted;
540    
541    // Læser parametre fra ini filen    // Læser parametre fra ini filen
542    with TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) do    with TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) do
543    try    try
544    
545    
546      SkrivLog := ReadString('Settings','SkrivLog','0');      SkrivLog := ReadString('Settings','SkrivLog','0');
547      Sted := ReadString('Settings','Sted','');      Sted := ReadString('Settings','Sted','');
548      StedNavn := ReadString('Settings','Stednavn','');      StedNavn := ReadString('Settings','Stednavn','');
# Line 562  begin Line 568  begin
568    
569    
570    
     LabelType := ReadInteger('Settings','LabelType',1);  
571      FarveNormal := ReadString('Settings','FarveNormal','D8D8D8');      FarveNormal := ReadString('Settings','FarveNormal','D8D8D8');
572      TitelNormal := ReadString('Settings','TitelNormal','Modtagelse af DAO NAT X-PRESS pakker');      TitelNormal := ReadString('Settings','TitelNormal','Modtagelse af DAO NAT X-PRESS pakker');
573      FarveReturDAO := ReadString('Settings','FarveReturDAO','A9F5A9');      FarveReturDAO := ReadString('Settings','FarveReturDAO','A9F5A9');
# Line 621  begin Line 626  begin
626        PanelValgA.Font.Color := clWhite;        PanelValgA.Font.Color := clWhite;
627      end;      end;
628    
629      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;  
630    
631      if SporgEfterBoghandler = '1' then      if SporgEfterBoghandler = '1' then
632      begin      begin
# Line 791  begin Line 728  begin
728        PanelValg2.Font.Color := clInactiveCaption;        PanelValg2.Font.Color := clInactiveCaption;
729        PanelValg3.Enabled := false;        PanelValg3.Enabled := false;
730        PanelValg3.Font.Color := clInactiveCaption;        PanelValg3.Font.Color := clInactiveCaption;
731        PanelValg6.Enabled := false;        //PanelValg6.Enabled := false;
732        PanelValg6.Font.Color := clInactiveCaption;        //PanelValg6.Font.Color := clInactiveCaption;
733    
734       // her skal vi også disable de menupunkter BK ikke kan bruge       // her skal vi også disable de menupunkter BK ikke kan bruge
735        ReturpakkerfraDAO1.Enabled := false;        ReturpakkerfraDAO1.Enabled := false;
736        Returpakkerfraboghandler1.Enabled := false;        Returpakkerfraboghandler1.Enabled := false;
737        Returpakkerfrapakkeshop1.Enabled := false;  
738          //Returpakkerfrapakkeshop1.Enabled := false;
739    
740        if SpecialVersionScanningtype = 'A' then        if SpecialVersionScanningtype = 'A' then
741        begin        begin
742           Scanningtype := '1';           Scanningtype := '1';
# Line 1051  begin Line 991  begin
991      end;      end;
992    
993    
     if (PrinterNavn <> '') then  
     begin  
        printerInd := Printer.Printers.IndexOf(printerNavn);  
        if printerInd >= 0 then  
           Printer.PrinterIndex := printerInd;  
     end;  
994    
995      CheckPrintQue('Opstart');  
996        LabelPrint := TLabelPrint.Create( self, Config, PrinterNavn );
997        LabelPrint.CheckPrintQue('Opstart', PrinterNavn);
998    
999    finally    finally
1000      Free;      Free;
# Line 1443  begin Line 1379  begin
1379        Pakkescanningtype := Scanningtype;        Pakkescanningtype := Scanningtype;
1380      end;      end;
1381    
1382      if (   (Pakkescanningtype = '1') and (PanelValg1.Enabled = false)      if (   ( (Pakkescanningtype = '1') and (PanelValg1.Enabled = false) )
1383          or (Pakkescanningtype = '2') and (PanelValg2.Enabled = false)          or ( (Pakkescanningtype = '2') and (PanelValg2.Enabled = false) )
1384          or (Pakkescanningtype = '3') and (PanelValg3.Enabled = false)          or ( (Pakkescanningtype = '3') and (PanelValg3.Enabled = false) )
1385          or (Pakkescanningtype = '4') and (PanelValg4.Enabled = false)          or ( (Pakkescanningtype = '4') and (PanelValg4.Enabled = false) )
1386          or (Pakkescanningtype = '5') and (PanelValg5.Enabled = false)          or ( (Pakkescanningtype = '5') and (PanelValg5.Enabled = false) )
1387          or (Pakkescanningtype = '6') and (PanelValg6.Enabled = false)  ) then          or ( (Pakkescanningtype = '6') and (PanelValg6.Enabled = false) ) ) then
1388      begin   // Her skal komme en alarm og rød skærm      begin   // Her skal komme en alarm og rød skærm
1389          VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );          VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
1390    
1391         exit;         exit;
1392      end;      end;
1393    
1394      if Automatiskvalg1.Checked and (Length(Stregkode) > 8) then      if (Automatiskvalg1.Checked and (Length(Stregkode) > 8) ) then
1395      begin      begin
1396        GemStregkode := Stregkode;        GemStregkode := Stregkode;
1397        if Pakketype = 'NatXpress' then        if Pakketype = 'NatXpress' then
# Line 1489  begin Line 1425  begin
1425        else        else
1426            begin            begin
1427            // Her skal komme en alarm og rød skærm            // Her skal komme en alarm og rød skærm
1428              VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );              //VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
1429                 VisAlarmSkaerm( Stregkode + ' kan ikke bruges med automatisk valg' );
1430    
1431               exit;               exit;
1432            end;            end;
# Line 1600  begin Line 1537  begin
1537    
1538      if not PakkeshopLevering1.Checked and not Pakkernormal1.Checked or (PakkeshopLevering1.Checked and (PakkeshopStregkode <> '') and (PakkeshopTjekkode <> '')) or (Pakkernormal1.Checked and (Scanogstjekkoden1.Checked and (BoghandlerStregkode <> '') and (BoghandlerTjekkode <> '') or not Scanogstjekkoden1.Checked)) then      if not PakkeshopLevering1.Checked and not Pakkernormal1.Checked or (PakkeshopLevering1.Checked and (PakkeshopStregkode <> '') and (PakkeshopTjekkode <> '')) or (Pakkernormal1.Checked and (Scanogstjekkoden1.Checked and (BoghandlerStregkode <> '') and (BoghandlerTjekkode <> '') or not Scanogstjekkoden1.Checked)) then
1539      begin      begin
1540    
1541         if PakkeshopLevering1.Checked and (PakkeshopStregkode <> '') and (PakkeshopTjekkode <> '') then         if PakkeshopLevering1.Checked and (PakkeshopStregkode <> '') and (PakkeshopTjekkode <> '') then
1542            StregKode := PakkeshopStregkode;            StregKode := PakkeshopStregkode;
1543         if Pakkernormal1.Checked and ((BoghandlerStregkode <> '') and (BoghandlerTjekkode <> '') or not Scanogstjekkoden1.Checked) then         if Pakkernormal1.Checked and ((BoghandlerStregkode <> '') and (BoghandlerTjekkode <> '') or not Scanogstjekkoden1.Checked) then
# Line 1674  begin Line 1612  begin
1612            begin            begin
1613              VisAlarmSkaerm('');              VisAlarmSkaerm('');
1614            end;            end;
1615    
1616           if not btnNulstil.Visible then           if not btnNulstil.Visible then
1617            begin            begin
1618    
# Line 1766  var Line 1705  var
1705    
1706    
1707  begin  begin
1708      if Budlevering1.Checked or Pakkeshoplevering1.Checked or Returpakkerfrapakkeshop1.Checked or Pakkernormal1.Checked then      if Budlevering1.Checked or Pakkeshoplevering1.Checked or Returpakkerfrapakkeshop1.Checked or Pakkernormal1.Checked or menuIndlevering.Checked then
1709      begin      begin
1710        for i := ListBox2.items.count-1 downto 0 do        for i := ListBox2.items.count-1 downto 0 do
1711          if pos(StregKode,ListBox2.items[i]) <> 0 then          if pos(StregKode,ListBox2.items[i]) <> 0 then
# Line 1885  begin Line 1824  begin
1824                PanelManglendePakker6.Visible := false;                PanelManglendePakker6.Visible := false;
1825              end;              end;
1826            end;            end;
1827  // 20150310: slut  
1828            ListBox2.items.delete(i);            ListBox2.items.delete(i);
1829          end;          end;
1830      end;      end;
# Line 1921  begin Line 1860  begin
1860    Sprgefterboghandlernummer1.Enabled := false;    Sprgefterboghandlernummer1.Enabled := false;
1861    ListBox1.Visible := true;    ListBox1.Visible := true;
1862  //  TestFunktionen := '1';  //  TestFunktionen := '1';
1863  // 20150317: start  
 (*  
   if TestFunktionen = '1' then  
     begin  
       Testforbindelsen1.Visible := true;  
       Testprinter1.Visible := true;  
       Testlyd1.Visible := true;  
       Testlyd2.Visible := true;  
     end  
   else if TestFunktionen = '2' then  
     begin  
       Testforbindelsen1.Enabled := false;  
       Testprinter1.Enabled := false;  
       Testlyd1.Enabled := false;  
       Testlyd2.Enabled := false;  
     end  
   else  
     begin  
       Testforbindelsen1.Visible := false;  
       Testprinter1.Visible := false;  
       Testlyd1.Visible := false;  
       Testlyd2.Visible := false;  
     end;  
   Testprinter1.Visible := false;  
   AlarmLyd := 'Sounds\Alarm.wav';  
   if not FileExists(AlarmLyd) then  
     begin  
       AlarmLyd := '';  
     end;  
   ScannetOkLyd := 'Sounds\Ok.wav';  
   if not FileExists(ScannetOkLyd) then  
     begin  
       ScannetOkLyd := '';  
     end;  
   ScannetOkStorLyd := 'Sounds\Ok_stor.wav';  
   if not FileExists(ScannetOkStorLyd) then  
     begin  
       ScannetOkStorLyd := '';  
     end;  
 *)  
 // 20150317: slut  
1864    if Budlevering1.Checked then    if Budlevering1.Checked then
1865    begin    begin
1866      IndlesScanningLogFil();      IndlesScanningLogFil();
# Line 2149  begin Line 2048  begin
2048       begin       begin
2049         PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label         PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label
2050         PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc         PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc
2051         RuteNummer := PakkeshopLabel.Koreliste;         RuteNummer := PakkeshopLabel.Koreliste + '  ->  ' +  PakkeshopLabel.PakkeshopTurid;
2052           Stregkode := PakkeshopLabel.Stregkode;
2053    
2054         PrintPakkeshopLabel( PakkeshopLabel );         LabelPrint.PrintPakkeshopLabel( PakkeshopLabel );
2055    
2056       end;       end;
2057    
# Line 2283  begin Line 2183  begin
2183        List1msg := List1msg + '; ' + Stregkode + ' (' + BoghandlerTjekkode + ')' + '; ' + Kommentar;        List1msg := List1msg + '; ' + Stregkode + ' (' + BoghandlerTjekkode + ')' + '; ' + Kommentar;
2184      end;      end;
2185    end;    end;
2186      if menuIndlevering.Checked then
2187      begin
2188        List1Msg := Stregkode;
2189      end;
2190    
2191    
2192    ListBox1.Items.Insert(0,List1Msg);    ListBox1.Items.Insert(0,List1Msg);
2193    logTekst := RightStr(List1Msg, Length(List1Msg)-10);    logTekst := RightStr(List1Msg, Length(List1Msg)-10);
2194    SkrivScanningLogFil(logTekst);    SkrivScanningLogFil(logTekst);
# Line 2423  begin Line 2329  begin
2329               if PrintNyLabel or (RuteNummer = 'Rutenr') then               if PrintNyLabel or (RuteNummer = 'Rutenr') then
2330  // 20150304: slut  // 20150304: slut
2331                begin                begin
2332                  SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);                  LabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
2333                end;                end;
2334              end;              end;
2335        01 :  begin;        01 :  begin;
# Line 2431  begin Line 2337  begin
2337                    // 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
2338                    // 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')
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        02 :  begin;        02 :  begin;
2344                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
2345                begin                begin
2346                  SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);                  LabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
2347                end;                end;
2348              end;              end;
2349        03 :  begin;        03 :  begin;
# Line 2445  begin Line 2351  begin
2351                    // 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
2352                    // 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')
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        04 :  begin;        04 :  begin;
2358                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
2359                begin                begin
2360                  SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);                  LabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
2361                end;                end;
2362              end;              end;
2363        else        else
# Line 2487  begin Line 2393  begin
2393        end;        end;
2394        logTekst := logTekst + ' for '+BoghandlerNavn;        logTekst := logTekst + ' for '+BoghandlerNavn;
2395        SkrivScanningLogFil(logTekst);        SkrivScanningLogFil(logTekst);
2396        with Printer do  
2397        begin        LabelPrint.PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn) ;
2398          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;  
2399      end;      end;
2400    end;    end;
2401    
2402  end;  end;
2403    
 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;  
2404    
2405    
2406  procedure TMainForm.radioStorPakkeClick(Sender: TObject);  procedure TMainForm.radioStorPakkeClick(Sender: TObject);
# Line 2644  begin Line 2490  begin
2490    //UpdateScreen('', '', 'Tjekker forbindelsen...', '', '');    // virker ikke    //UpdateScreen('', '', 'Tjekker forbindelsen...', '', '');    // virker ikke
2491    ShowMessage('Tjekker data forbindelse til serveren.' + crlf + 'Det kan godt tage nogle minutter.' + crlf + 'Resultatet af testen vises i skærmbilledet...');    ShowMessage('Tjekker data forbindelse til serveren.' + crlf + 'Det kan godt tage nogle minutter.' + crlf + 'Resultatet af testen vises i skærmbilledet...');
2492    
2493          // Tjekker urls    try
2494          logTekst := 'Tjekker urls.';      // Tjekker urls
2495          ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);      logTekst := 'Tjekker urls.';
2496          SkrivScanningLogFil(logTekst);      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
2497        SkrivScanningLogFil(logTekst);
2498    
         // Tjekker UrlNormal  
         if PanelValg1.Enabled = true then  
         begin  
           if TUtils.CheckUrl(UrlNormal) then  
           begin  
             logTekst := 'UrlNormal accepteret: ' + UrlNormal;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlNormal svarer ikke: ' + UrlNormal;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               TjekUrls := '-';   // markerer at der var fejl  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2499    
         // Tjekker UrlReturDAO  
         if PanelValg2.Enabled = true then  
         begin  
           if TUtils.CheckUrl(UrlReturDAO) then  
           begin  
             logTekst := 'UrlReturDAO accepteret: ' + UrlReturDAO;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlReturDAO svarer ikke: ' + UrlReturDAO;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2500    
2501          // Tjekker UrlReturBoghandler      // Tjekker UrlNormal
2502          if PanelValg3.Enabled = true then      if PanelValg1.Enabled = true then
2503          begin      begin
2504            if TUtils.CheckUrl(UrlReturBoghandler) then        TjekkerEnkeltUrl('UrlNormal', UrlNormal, urlFejl);
2505            begin      end;
             logTekst := 'UrlReturBoghandler accepteret: ' + UrlReturBoghandler;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlReturDAO svarer ikke: ' + UrlReturDAO;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2506    
2507          // Tjekker UrlBudlevering      // Tjekker UrlReturDAO
2508          if PanelValg4.Enabled = true then      if PanelValg2.Enabled = true then
2509          begin      begin
2510            if TUtils.CheckUrl(UrlBudlevering) then        TjekkerEnkeltUrl('UrlReturDAO', UrlReturDAO, urlFejl);
2511            begin      end;
             logTekst := 'UrlBudlevering accepteret: ' + UrlBudlevering;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlBudlevering svarer ikke: ' + UrlBudlevering;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2512    
2513          // Tjekker UrlPakkeshoplevering      // Tjekker UrlReturBoghandler
2514          if PanelValg5.Enabled = true then      if PanelValg3.Enabled = true then
2515          begin      begin
2516            if TUtils.CheckUrl(UrlPakkeshoplevering) then        TjekkerEnkeltUrl('UrlReturBoghandler', UrlReturBoghandler, urlFejl);
2517            begin      end;
             logTekst := 'UrlPakkeshoplevering accepteret: ' + UrlPakkeshoplevering;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlPakkeshoplevering svarer ikke: ' + UrlPakkeshoplevering;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2518    
2519          // Tjekker UrlReturPakkeshop      // Tjekker UrlBudlevering
2520          if PanelValg6.Enabled = true then      if PanelValg4.Enabled = true then
2521          begin      begin
2522            if TUtils.CheckUrl(UrlReturPakkeshop) then        TjekkerEnkeltUrl('UrlBudlevering', UrlBudlevering, urlFejl);
2523            begin      end;
             logTekst := 'UrlReturPakkeshop accepteret: ' + UrlReturPakkeshop;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlReturPakkeshop svarer ikke: ' + UrlReturPakkeshop;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2524    
2525          // Tjekker UrlManglendeScanninger      // Tjekker UrlPakkeshoplevering
2526          if (PanelValg1.Enabled = true)      if PanelValg5.Enabled = true then
2527          or (PanelValg4.Enabled = true) then      begin
2528          begin        TjekkerEnkeltUrl('UrlPakkeshoplevering', UrlPakkeshoplevering, urlFejl);
2529            if TUtils.CheckUrl(UrlManglendeScanninger) then      end;
           begin  
             logTekst := 'UrlManglendeScanninger accepteret: ' + UrlManglendeScanninger;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlManglendeScanninger svarer ikke: ' + UrlManglendeScanninger;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2530    
2531          // Tjekker UrlPakkeshopManglendeScanninger      // Tjekker UrlReturPakkeshop
2532          if PanelValg5.Enabled = true then      if PanelValg6.Enabled = true then
2533          begin      begin
2534            if TUtils.CheckUrl(UrlPakkeshopManglendeScanninger) then        TjekkerEnkeltUrl('UrlReturPakkeshop', UrlReturPakkeshop, urlFejl);
2535            begin      end;
             logTekst := 'UrlPakkeshopManglendeScanninger accepteret: ' + UrlPakkeshopManglendeScanninger;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlPakkeshopManglendeScanninger svarer ikke: ' + UrlPakkeshopManglendeScanninger;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2536    
2537          // Tjekker UrlPakkeshopManglendeReturScanninger      // Tjekker UrlManglendeScanninger
2538          if PanelValg6.Enabled = true then      if (PanelValg1.Enabled = true) or (PanelValg4.Enabled = true) then
2539          begin      begin
2540            if TUtils.CheckUrl(UrlPakkeshopManglendeReturScanninger) then        TjekkerEnkeltUrl('UrlManglendeScanninger', UrlManglendeScanninger, urlFejl);
2541            begin      end;
             logTekst := 'UrlPakkeshopManglendeReturScanninger accepteret: ' + UrlPakkeshopManglendeReturScanninger;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlPakkeshopManglendeReturScanninger svarer ikke: ' + UrlPakkeshopManglendeReturScanninger;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2542    
2543         // Tjekker UrlIndleveringsPakke og UrlIndleveringsPakkeManglendeScanninger      // Tjekker UrlPakkeshopManglendeScanninger
2544          if PanelValg7.Enabled = true then      if PanelValg5.Enabled = true then
2545          begin      begin
2546            if TUtils.CheckUrl(UrlIndleveringsPakke) then        TjekkerEnkeltUrl('UrlPakkeshopManglendeScanninger', UrlPakkeshopManglendeScanninger, urlFejl);
2547            begin      end;
             logTekst := 'UrlIndleveringsPakke accepteret: ' + UrlIndleveringsPakke;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlIndleveringsPakke svarer ikke: ' + UrlIndleveringsPakke;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
2548    
2549            if TUtils.CheckUrl(UrlIndleveringsPakkeManglendeScanninger) then      // Tjekker UrlPakkeshopManglendeReturScanninger
2550            begin      if PanelValg6.Enabled = true then
2551              logTekst := 'UrlIndleveringsPakkeManglendeScanninger accepteret: ' + UrlIndleveringsPakkeManglendeScanninger;      begin
2552              SkrivScanningLogFil(logTekst);        TjekkerEnkeltUrl('UrlPakkeshopManglendeReturScanninger', UrlPakkeshopManglendeReturScanninger, urlFejl);
2553            end      end;
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlIndleveringsPakkeManglendeScanninger svarer ikke: ' + UrlIndleveringsPakkeManglendeScanninger;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2554    
2555          // Tjekker UrlEKLoverforsel     // Tjekker UrlIndleveringsPakke og UrlIndleveringsPakkeManglendeScanninger
2556          if PanelValg1.Enabled = true then      if PanelValg7.Enabled = true then
2557          begin      begin
2558            if TUtils.CheckUrl(UrlEKLoverforsel) then        TjekkerEnkeltUrl('UrlIndleveringsPakke', UrlIndleveringsPakke, urlFejl);
2559            begin        TjekkerEnkeltUrl('UrlIndleveringsPakkeManglendeScanninger', UrlIndleveringsPakkeManglendeScanninger, urlFejl);
2560              logTekst := 'UrlEKLoverforsel accepteret: ' + UrlEKLoverforsel;      end;
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlEKLoverforsel svarer ikke: ' + UrlEKLoverforsel;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2561    
2562        // Tjekker UrlEKLoverforsel
2563        if PanelValg1.Enabled = true then
2564        begin
2565          TjekkerEnkeltUrl('UrlEKLoverforsel', UrlEKLoverforsel, urlFejl);
2566        end;
2567    
         // Tjekker UrlEKLoverforselPakkeshop  
         if PanelValg5.Enabled = true then  
         begin  
           if TUtils.CheckUrl(UrlEKLoverforselPakkeshop) then  
           begin  
             logTekst := 'UrlEKLoverforselPakkeshop accepteret: ' + UrlEKLoverforselPakkeshop;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlEKLoverforselPakkeshop svarer ikke: ' + UrlEKLoverforselPakkeshop;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2568    
2569        // Tjekker UrlEKLoverforselPakkeshop
2570        if PanelValg5.Enabled = true then
2571        begin
2572          TjekkerEnkeltUrl('UrlEKLoverforselPakkeshop', UrlEKLoverforselPakkeshop, urlFejl);
2573        end;
2574    
         // Tjekker UrlFindPakketype  
         if TUtils.CheckUrl(UrlFindPakketype) then  
         begin  
           logTekst := 'UrlFindPakketype accepteret: ' + UrlFindPakketype;  
           SkrivScanningLogFil(logTekst);  
         end  
         else  
         begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlFindPakketype svarer ikke: ' + UrlFindPakketype;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
         end;  
2575    
2576          // Tjekker UrlSendPrograminfo      // Tjekker UrlFindPakketype
2577          if TUtils.CheckUrl(UrlSendPrograminfo) then      TjekkerEnkeltUrl('UrlFindPakketype', UrlFindPakketype, urlFejl);
         begin  
           logTekst := 'UrlSendPrograminfo accepteret: ' + UrlSendPrograminfo;  
           SkrivScanningLogFil(logTekst);  
         end  
         else  
         begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlSendPrograminfo svarer ikke: ' + UrlSendPrograminfo;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
         end;  
2578    
2579          if urlFejl > 0 then      // Tjekker UrlSendPrograminfo
2580          begin      TjekkerEnkeltUrl('UrlSendPrograminfo', UrlSendPrograminfo, urlFejl);
2581            TjekUrls := '-';   // markerer at der var fejl  
2582          end  
2583          else  
2584          begin      logTekst := 'urls er ok';
2585            logTekst := 'urls er ok';      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
2586            ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);      SkrivScanningLogFil(logTekst);
2587            SkrivScanningLogFil(logTekst);  
2588          end;    Except
2589        TjekUrls := '-';   // markerer at der var fejl
2590    
2591      end;
2592    end;
2593    
2594    procedure TMainForm.TjekkerEnkeltUrl(UrlNavn: String; Url: String; var urlFejl: integer);
2595    const
2596      crlf = Chr(13) + Chr(10) ;  // Carriage return & Linefeed
2597    begin
2598      if TUtils.CheckUrl(Url) then
2599    
2600      begin
2601        logTekst := UrlNavn + ' accepteret: ' + Url;
2602        SkrivScanningLogFil(logTekst);
2603      end
2604      else
2605      begin
2606        inc(urlFejl);   // Optæller antal fejl
2607        logTekst := UrlNavn + ' svarer ikke: ' + Url;
2608        ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
2609        if TjekUrls = '1' then
2610        begin
2611          logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';
2612        end;
2613    
2614        SkrivScanningLogFil(logTekst);
2615    
2616        if TjekUrls = '1' then
2617        begin
2618          ShowMessage(logTekst);
2619          UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut
2620          Application.Terminate;
2621    
2622          raise Exception.Create('UrlFejl');
2623    
2624        end;
2625      end;
2626    
2627  end;  end;
2628    
2629    
2630    
2631  procedure TMainForm.SletLogfiler(Path: string; FileList: TStrings);  procedure TMainForm.SletLogfiler(Path: string; FileList: TStrings);
2632  var  var
2633    SR: TSearchRec;    SR: TSearchRec;
# Line 3155  begin Line 2707  begin
2707    if Farve <> '' then    if Farve <> '' then
2708    begin    begin
2709       MainForm.Color := TUtils.HexToTColor(Farve);       MainForm.Color := TUtils.HexToTColor(Farve);
 // 20150312: start  
 (*  
   end  
   else  
   begin  
      ShowMessage('Programmet afbrydes...');  
      UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
      Application.Terminate;  
 *)  
 // 20150312: slut  
2710    end;    end;
2711    if (Budlevering1.Checked) then    if (Budlevering1.Checked) then
2712    begin    begin
# Line 3308  begin Line 2850  begin
2850    Falsk := False;    Falsk := False;
2851    
2852    
2853    if (Printer.Printers.Count = 0) then    if (LabelPrint.GetPrinterCount() = 0) then
2854    begin    begin
2855      ShowMessage('Der er ikke installeret en printer på denne PC.');      ShowMessage('Der er ikke installeret en printer på denne PC.');
2856    end    end
# Line 3323  begin Line 2865  begin
2865      DBKbane := '999';      DBKbane := '999';
2866      Leveringssted := 'XXX';      Leveringssted := 'XXX';
2867      PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, Falsk);      PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, Falsk);
2868      CheckPrintQue('Test');      LabelPrint.CheckPrintQue('Test', PrinterNavn);
2869    end;    end;
2870    FocusControl(StregkodeST);    FocusControl(StregkodeST);
2871  end;  end;
# Line 3332  procedure TMainForm.Timer1Timer(Sender: Line 2874  procedure TMainForm.Timer1Timer(Sender:
2874  begin  begin
2875    if (TjekPrinter = '1') then    if (TjekPrinter = '1') then
2876    begin    begin
2877      CheckPrintQue('Timer');      LabelPrint.CheckPrintQue('Timer', PrinterNavn);
2878    end    end
2879    else    else
2880    begin    begin
# Line 3546  begin Line 3088  begin
3088        BtnEKLoverforsel.Enabled := true;        BtnEKLoverforsel.Enabled := true;
3089        InitLillePakke();        InitLillePakke();
3090        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3091    
3092          chkForstorTilDirekte.Checked := false;
3093          chkForstorTilDirekte.Enabled := false;
3094    
3095        if BladhusSted = 0 then        if BladhusSted = 0 then
3096        begin        begin
3097          IndlesScanningLogFil();          IndlesScanningLogFil();
# Line 3577  begin Line 3123  begin
3123        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3124        ListBox2.Items.Clear;        ListBox2.Items.Clear;
3125        BtnEKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3126    
3127          chkForstorTilDirekte.Checked := false;
3128          chkForstorTilDirekte.Enabled := false;
3129    
3130        InitLillePakke();        InitLillePakke();
3131  end;  end;
3132    
# Line 3603  begin Line 3153  begin
3153        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3154        ListBox2.Items.Clear;        ListBox2.Items.Clear;
3155        BtnEKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3156    
3157          chkForstorTilDirekte.Checked := false;
3158          chkForstorTilDirekte.Enabled := false;
3159    
3160        InitLillePakke();        InitLillePakke();
3161  end;  end;
3162    
# Line 3634  begin Line 3188  begin
3188        BtnEKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3189        IdFTP1.Passive := true;        IdFTP1.Passive := true;
3190        IdFTP1.PassiveUseControlHost := true;        IdFTP1.PassiveUseControlHost := true;
3191    
3192          chkForstorTilDirekte.Checked := false;
3193          chkForstorTilDirekte.Enabled := true;
3194    
3195        if (BladhusSted = 0) or (BladhusSted = 2) or (BladhusSted = 3) then        if (BladhusSted = 0) or (BladhusSted = 2) or (BladhusSted = 3) then
3196        begin        begin
3197            IndlesScanningLogFil();            IndlesScanningLogFil();
# Line 3669  begin Line 3227  begin
3227    
3228        BtnEKLoverforsel.Enabled := true;        BtnEKLoverforsel.Enabled := true;
3229    
3230          chkForstorTilDirekte.Checked := false;
3231          chkForstorTilDirekte.Enabled := true;
3232    
3233        InitLillePakke();        InitLillePakke();
3234        IndlesScanningLogFil();        IndlesScanningLogFil();
3235        if BladhusSted = 0 then        if BladhusSted = 0 then
# Line 3704  begin Line 3265  begin
3265        BtnDownloadKontrolfil.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3266        BtnOpdaterListen.Enabled := true;        BtnOpdaterListen.Enabled := true;
3267        BtnEKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3268    
3269          chkForstorTilDirekte.Checked := false;
3270          chkForstorTilDirekte.Enabled := false;
3271    
3272    
3273        InitLillePakke();        InitLillePakke();
3274        IndlesScanningLogFil();        IndlesScanningLogFil();
3275        if BladhusSted = 0 then        if BladhusSted = 0 then
# Line 3751  begin Line 3317  begin
3317        BtnDownloadKontrolfil.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3318        BtnOpdaterListen.Enabled := true;        BtnOpdaterListen.Enabled := true;
3319        BtnEKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3320    
3321          chkForstorTilDirekte.Checked := false;
3322          chkForstorTilDirekte.Enabled := false;
3323    
3324    
3325        InitLillePakke();        InitLillePakke();
3326        IndlesScanningLogFil();        IndlesScanningLogFil();
3327        if BladhusSted = 0 then        if BladhusSted = 0 then
# Line 3876  begin Line 3447  begin
3447      SkrivScanningLogFil(logTekst);      SkrivScanningLogFil(logTekst);
3448      StedKode := Sted;      StedKode := Sted;
3449      URLStr := Format(UrlEKLoverforsel,[StedKode,Sted]);      URLStr := Format(UrlEKLoverforsel,[StedKode,Sted]);
3450  // 20150330: start  
3451      if PanelValg5.Color = clGreen then      if PanelValg5.Color = clGreen then
3452      begin      begin
3453        URLStr := Format(UrlEKLoverforselPakkeshop,[StedKode,Sted]);        URLStr := Format(UrlEKLoverforselPakkeshop,[StedKode,Sted]);
3454      end;      end;
3455  // 20150330: slut  
3456    
3457      try      try
3458      //raise EIdConnClosedGracefully.Create('test');   // KUN TIL TEST      //raise EIdConnClosedGracefully.Create('test');   // KUN TIL TEST
# Line 4483  begin Line 4054  begin
4054  end;  end;
4055    
4056    
 // 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;  
   
4057    
4058  procedure TMainForm.IndlesManglendeScanninger();  procedure TMainForm.IndlesManglendeScanninger();
4059  var  var
# Line 4616  var Line 4065  var
4065    stregkode, modtagernavn, modtageradresse, kommentar : string;    stregkode, modtagernavn, modtageradresse, kommentar : string;
4066    pakketype, tjekkodestatus : String;    pakketype, tjekkodestatus : String;
4067    pakketypeix, antalLiniefelter, antalFelterFundet, linienr : Integer;    pakketypeix, antalLiniefelter, antalFelterFundet, linienr : Integer;
4068    pakketyper : TStrings;    //pakketyper : TStrings;
4069      pakketyper : TDictionary<String, Integer>;
4070      tmpAntal : Integer;
4071    
4072    
4073    
4074    antlin : Integer;    antlin : Integer;
4075    
4076    antlinIdag, antlinSenere : Integer;    antlinIdag, antlinSenere : Integer;
4077    
4078    XmlFelter : TStrings;    //XmlFelter : TStrings;
4079      XmlFelter : TDictionary<String, Integer>;
4080    
4081   begin   begin
4082      XmlFelter := TStringList.Create;  
4083      pakketyper := TStringList.Create;  
4084        XmlFelter := TDictionary<String, Integer>.Create;
4085        pakketyper := TDictionary<String, Integer>.Create;
4086    
4087      linienr := 0;      linienr := 0;
4088      ListBox2.Clear;      ListBox2.Clear;
4089      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Henter oversigt over pakker der endnu ikke er modtaget');      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Henter oversigt over pakker der endnu ikke er modtaget');
# Line 4640  var Line 4098  var
4098          StedKode := Sted;          StedKode := Sted;
4099        end;        end;
4100    
4101          Application.Processmessages; //Ugly Hack to improve User Experience when switching modes
4102    
4103    
4104    
4105      if (Scanningtype = '7') then      if (Scanningtype = '7') then
# Line 4699  var Line 4159  var
4159            if Node.NodeType = ntElement then begin            if Node.NodeType = ntElement then begin
4160              if Node.NodeName = 'Stregkode' then              if Node.NodeName = 'Stregkode' then
4161              begin              begin
4162                 antlin := antlin + 1;                 Inc(antlin);
4163                 // 20150306: start                 // 20150306: start
4164                if not VarIsNull(Node.NodeValue) then                if not VarIsNull(Node.NodeValue) then
4165                begin                begin
4166                   if (pos('(', Node.NodeValue) = 0) then                   if (pos('(', Node.NodeValue) = 0) then
4167                   begin                   begin
4168                     antlinIdag := antlinIdag + 1;                     Inc(antlinIdag);
4169                   end                   end
4170                   else                   else
4171                   begin                   begin
4172                     antlinSenere := antlinSenere + 1;                     Inc(antlinSenere);
4173                   end;                   end;
4174                end;                end;
4175                 // 20150306: slut                 // 20150306: slut
4176              end;              end;
4177            end;            end;
4178            if (XmlFelter.values[Node.NodeName] <> '') then            if ( XmlFelter.ContainsKey(Node.NodeName) ) then
4179                  XmlFelter.values[Node.NodeName] := IntToStr(StrToInt(XmlFelter.values[Node.NodeName]) + 1)                begin
4180                    XmlFelter.TryGetValue(Node.NodeName, tmpAntal);
4181                    XmlFelter.AddOrSetValue(Node.NodeName, tmpAntal + 1);
4182                  end
4183                else                else
4184                  XmlFelter.values[Node.NodeName] := '1';                begin
4185                    XmlFelter.Add(Node.NodeName, 1);
4186                  end;
4187    
4188        end;        end;
4189        antalLiniefelter := XmlFelter.Count;        antalLiniefelter := XmlFelter.Count;
# Line 4726  var Line 4191  var
4191        SetLength(stregkoderMedTjekkodeArray, 0);    // reset fra tidligere brug        SetLength(stregkoderMedTjekkodeArray, 0);    // reset fra tidligere brug
4192        SetLength(stregkoderMedTjekkodeArray, antlin);  // sæt antal elementer i array        SetLength(stregkoderMedTjekkodeArray, antlin);  // sæt antal elementer i array
4193    
4194    
4195          Application.Processmessages; //Ugly Hack to improve User Experience when switching modes
4196    
4197        logTekst := 'Der er ' + IntToStr(antlin) + ' pakker, der endnu ikke er modtaget';        logTekst := 'Der er ' + IntToStr(antlin) + ' pakker, der endnu ikke er modtaget';
4198        if (antlinSenere > 0) then        if (antlinSenere > 0) then
4199        begin        begin
# Line 4761  var Line 4229  var
4229                if not VarIsNull(Node.NodeValue) then                if not VarIsNull(Node.NodeValue) then
4230                  pakketype := Node.NodeValue;                  pakketype := Node.NodeValue;
4231                  antalFelterFundet := antalFelterFundet + 1;                  antalFelterFundet := antalFelterFundet + 1;
4232                if (pakketyper.values[pakketype] <> '') then                if ( pakketyper.ContainsKey(pakketype) ) then
4233                  pakketyper.values[pakketype] := IntToStr(StrToInt(pakketyper.values[pakketype]) + 1)                begin
4234                    pakketyper.TryGetValue(pakketype, tmpAntal);
4235                    pakketyper.AddOrSetValue(pakketype, tmpAntal + 1);
4236                  end
4237                else                else
4238                  pakketyper.values[pakketype] := '1';                  pakketyper.Add(pakketype, 1);
4239              end;              end;
4240              if Node.NodeName = 'TjekkodeStatus' then begin              if Node.NodeName = 'TjekkodeStatus' then begin
4241                if not VarIsNull(Node.NodeValue) then                if not VarIsNull(Node.NodeValue) then
# Line 4772  var Line 4243  var
4243                  antalFelterFundet := antalFelterFundet + 1;                  antalFelterFundet := antalFelterFundet + 1;
4244                  if (tjekkodestatus = '-1') then                  if (tjekkodestatus = '-1') then
4245                  begin                  begin
4246  // 20150306: start  
 //                    stregkoderMedTjekkodeArray[linienr] := stregkode;  
4247                    if (pos(' ', stregkode) > 0) then                    if (pos(' ', stregkode) > 0) then
4248                    begin                    begin
4249                      stregkoderMedTjekkodeArray[linienr] := TUtils.split(stregkode, ' ', 2);  // Fjerner lige en evt. fremtidig dato fra feltet                      stregkoderMedTjekkodeArray[linienr] := TUtils.split(stregkode, ' ', 2);  // Fjerner lige en evt. fremtidig dato fra feltet
# Line 4800  var Line 4270  var
4270              end;              end;
4271            end;            end;
4272        end;        end;
       for pakketypeix := 0 to pakketyper.Count-1 do  
         begin  
           ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + ' '+pakketyper[pakketypeix]+' pakke(r) ikke modtaget');  
         end;  
4273    
4274          // Free up the list object        Application.Processmessages; //Ugly Hack to improve User Experience when switching modes
4275    
4276    
4277          for pakketype in pakketyper.Keys do
4278          begin
4279            pakketyper.TryGetValue(pakketype, tmpAntal);
4280            ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + pakketype + ' ' + IntToStr(tmpAntal) + ' pakke(r) ikke modtaget');
4281          end;
4282    
4283            // Free up the dictionary object
4284        pakketyper.Free;        pakketyper.Free;
4285    
4286    
4287    
4288  //      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Der er '+IntToStr(antlin)+' pakker, der endnu ikke er modtaget.');  //      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Der er '+IntToStr(antlin)+' pakker, der endnu ikke er modtaget.');
4289        logTekst := 'Der er ' + IntToStr(antlin) + ' pakker, der endnu ikke er modtaget';        logTekst := 'Der er ' + IntToStr(antlin) + ' pakker, der endnu ikke er modtaget';
4290        if (antlinSenere > 0) then        if (antlinSenere > 0) then
# Line 5307  begin Line 4785  begin
4785    result := svar;    result := svar;
4786  end;  end;
4787    
 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;  
4788    
4789  procedure TMainForm.Scanogstjekkoden1Click(Sender: TObject);  procedure TMainForm.Scanogstjekkoden1Click(Sender: TObject);
4790  begin  begin
# Line 5341  end; Line 4800  end;
4800    
4801    
4802    
4803    //Nedarvet fra IParentForm
4804    procedure TMainForm.LogMessage( msg : string);
4805    begin
4806      ListBox1.Items.Insert(0, msg);
4807      SkrivScanningLogFil(msg);
4808    end;
4809    
4810    
4811    //Nedarvet fra IParentForm
4812    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;  
4813  begin  begin
4814    
4815  // tjektype = 'Opstart' skal vise alarmlinie, samt opdatere listbox1    PrinterstatusStaticText1.Caption := txt;
4816  //            '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  
4817    begin    begin
4818      printerTxt := 'Der er ikke installeret en printer på denne PC';      PrinterstatusStaticText1.Font.Color := clBlack;
4819      ListBox1.Items.Insert(0,printerTxt);      PrinterstatusStaticText1.Color := MainForm.Color;
4820      SkrivScanningLogFil(printerTxt);      PrinterstatusStaticText1.Transparent := True;
4821    end    end
4822    else    else
4823    begin    begin
4824      hPrinter := GetCurrentPrinterHandle;      PrinterstatusStaticText1.Font.Color := clRed;
4825      try      PrinterstatusStaticText1.Color := clWhite;
4826        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;  
4827    end;    end;
4828  end;  end;
4829    
4830    //Nedarvet fra IParentForm
4831    function TMainForm.GetFormObject() : TForm;
4832    begin
4833      Result := self;
4834    end;
4835    
4836  end.  end.
4837    
Legend:
Removed from v.2700  
changed lines
  Added in v.2792
  ViewVC Help
Powered by ViewVC 1.1.20