/[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 2660 by torben, Sun Aug 23 14:45:16 2015 UTC revision 2685 by torben, Thu Aug 27 12:31:30 2015 UTC
# Line 8  uses Line 8  uses
8    IdTCPClient, IdHTTP, xmldom, XMLIntf, msxmldom, XMLDoc, IniFiles, AppEvnts,    IdTCPClient, IdHTTP, xmldom, XMLIntf, msxmldom, XMLDoc, IniFiles, AppEvnts,
9    Menus, ExtCtrls, ComCtrls, StrUtils, MMSystem, DateUtils,    Menus, ExtCtrls, ComCtrls, StrUtils, MMSystem, DateUtils,
10    IdExplicitTLSClientServerBase, IdFTP, pngimage, GIFImg, IdException,    IdExplicitTLSClientServerBase, IdFTP, pngimage, GIFImg, IdException,
11    Winspool, Registry, ShellApi, ClipBrd, Buttons, wininet,    Winspool, ShellApi, ClipBrd, Buttons, wininet,
12    UITypes    UITypes,
13      PakkeshopLabels,
14      StBarC,
15      Math, // DegToRad() bruges i PrintPakkeshopLabel
16      Utils
17    
18    ;    ;
19    
20  type  type
   TStrArray = array of string;  
21    TMainForm = class(TForm)    TMainForm = class(TForm)
22      StregkodeST: TStaticText;      StregkodeST: TStaticText;
23      RuteNummerST: TStaticText;      RuteNummerST: TStaticText;
# Line 58  type Line 61  type
61      DownloadButton03: TButton;      DownloadButton03: TButton;
62      Pakkeshoplevering1: TMenuItem;      Pakkeshoplevering1: TMenuItem;
63      PakkeshopText1: TStaticText;      PakkeshopText1: TStaticText;
64      PakkeshopNulstil: TButton;      btnNulstil: TButton;
65      Returpakkerfrapakkeshop1: TMenuItem;      Returpakkerfrapakkeshop1: TMenuItem;
66      Altidprintepakkelabel1: TMenuItem;      Altidprintepakkelabel1: TMenuItem;
67      chkAltidPrintLabel: TCheckBox;      chkAltidPrintLabel: TCheckBox;
# Line 88  type Line 91  type
91      PanelManglendePakker4: TPanel;      PanelManglendePakker4: TPanel;
92      PanelManglendePakker5: TPanel;      PanelManglendePakker5: TPanel;
93      PanelManglendePakker6: TPanel;      PanelManglendePakker6: TPanel;
94        menuIndlevering: TMenuItem;
95    
96    
97    function Explode(var a: TStrArray; Border, S: string): Integer;    function Sto_GetFmtFileVersion(const FileName: String = ''): String;
98    function BarCodeValid (ACode: string): boolean;  
   function Sto_GetFmtFileVersion(const FileName: String = ''; const Fmt: String = '%d.%d.%d.%d'): String;  
   function TColorToHex(Color : TColor) : string;  
   function HexToTColor(sColor : string) : TColor;  
99    function getProddato() : TDate;    function getProddato() : TDate;
100    function getProddag() : String;    function getProddag() : String;
101    function retRutenummer(rutenummer : String) : String;    function retRutenummer(rutenummer : String) : String;
102    function GetCurrentPrinterHandle() : THandle;    function GetCurrentPrinterHandle() : THandle;
103    function SavePChar(p: PChar): PChar;    function SavePChar(p: PChar): PChar;
104    function AdobeReaderExists(): Boolean;  
105    function FileTime2DateTime(FileTime: TFileTime): TDateTime;    function FileTime2DateTime(FileTime: TFileTime): TDateTime;
   function split(input: string; schar: Char; s: Integer): string;  
106    function CheckUrl(url:string):boolean;    function CheckUrl(url:string):boolean;
107    
108    procedure PlaySound(filename : PWideChar);    procedure PlaySound(filename : PWideChar);
# Line 146  type Line 146  type
146    procedure UploadButton01Click(Sender: TObject);    procedure UploadButton01Click(Sender: TObject);
147    procedure DownloadButton03Click(Sender: TObject);    procedure DownloadButton03Click(Sender: TObject);
148    procedure Pakkeshoplevering1Click(Sender: TObject);    procedure Pakkeshoplevering1Click(Sender: TObject);
149    procedure PakkeshopNulstilClick(Sender: TObject);    procedure btnNulstilClick(Sender: TObject);
150    procedure Returpakkerfrapakkeshop1Click(Sender: TObject);    procedure Returpakkerfrapakkeshop1Click(Sender: TObject);
151    procedure InitNatxpresslevering();    procedure InitNatxpresslevering();
152    procedure InitReturFraDao();    procedure InitReturFraDao();
# Line 161  type Line 161  type
161    procedure EKLoverforselClick(Sender: TObject);    procedure EKLoverforselClick(Sender: TObject);
162    procedure Uploadlogfil1Click(Sender: TObject);    procedure Uploadlogfil1Click(Sender: TObject);
163    procedure Manual1Click(Sender: TObject);    procedure Manual1Click(Sender: TObject);
   procedure CheckPrintQue(tjektype : string);  
164    procedure Timer1Timer(Sender: TObject);    procedure Timer1Timer(Sender: TObject);
165    procedure Scanogstjekkoden1Click(Sender: TObject);    procedure Scanogstjekkoden1Click(Sender: TObject);
166    procedure chkScanTjekkodeClick(Sender: TObject);    procedure chkScanTjekkodeClick(Sender: TObject);
# Line 181  type Line 180  type
180    procedure SletLogfiler(Path: string; FileList: TStrings);    procedure SletLogfiler(Path: string; FileList: TStrings);
181    procedure Manualgenerel1Click(Sender: TObject);    procedure Manualgenerel1Click(Sender: TObject);
182    procedure TjekkerUrls();    procedure TjekkerUrls();
 // 20150310: start  
   procedure RoundCornerOf(Control: TWinControl);  
183    
184      procedure menuIndleveringClick(Sender: TObject);
185    
186      procedure PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
187      procedure CheckPrintQue(tjektype : string);
188    
 // 20150310: slut  
189    
190    private    private
191      SpecialVersionSted, SpecialVersionScanningtype: String;    // Bruges når programmet skal bruges udenfor DAO scanningssteder      SpecialVersionSted, SpecialVersionScanningtype: String;    // Bruges når programmet skal bruges udenfor DAO scanningssteder
# Line 193  type Line 193  type
193      SkrivLog : String;      SkrivLog : String;
194      Sted : String;      Sted : String;
195      StedNavn : String;      StedNavn : String;
196      Url, UrlNormal, UrlReturDAO, UrlReturBoghandler, UrlBudlevering, UrlManglendeScanninger, UrlPakkeshoplevering, UrlReturPakkeshop, UrlPakkeshopManglendeScanninger, UrlPakkeshopManglendeReturScanninger,UrlEKLoverforsel : String;      Url, UrlNormal, UrlReturDAO, UrlReturBoghandler, UrlBudlevering, UrlManglendeScanninger, UrlPakkeshoplevering, UrlReturPakkeshop, UrlPakkeshopManglendeScanninger, UrlPakkeshopManglendeReturScanninger,UrlIndleveringsPakke,UrlEKLoverforsel : String;
197  // 29150330: start  // 29150330: start
198      UrlEKLoverforselPakkeshop : String;      UrlEKLoverforselPakkeshop : String;
199  // 20150330: slut  // 20150330: slut
# Line 207  type Line 207  type
207      AlarmLyd : String;      AlarmLyd : String;
208      ScannetOkLyd : String;      ScannetOkLyd : String;
209      ScannetOkStorLyd : String;      ScannetOkStorLyd : String;
210  // 20150317: start  
211      ScannetOkTilTjekkodeLyd : String;      ScannetOkTilTjekkodeLyd : String;
212  // 20150317: slut  
213      PrinterNavn : String;      PrinterNavn : String;
214      TjekPrinter : String;      TjekPrinter : String;
215      XPosRute : integer;      XPosRute : integer;
# Line 248  type Line 248  type
248      BoghandlerStregkode, BoghandlerTjekkode : String;      BoghandlerStregkode, BoghandlerTjekkode : String;
249      TjekUrls : String;      TjekUrls : String;
250    
251            function CheckSumModulo10(const data:string):string;          { used for EAN 8/13 }      Barcode : TStBarcode;
252    
253    
254      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 = '');
255      procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');      procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');
# Line 266  type Line 267  type
267      { Public declarations }      { Public declarations }
268    end;    end;
269    
270          function GetPixelsPerInchX(): Integer;
271        function GetPixelsPerInchY(): Integer;
272    
273  var  var
274    MainForm: TMainForm;    MainForm: TMainForm;
275    
# Line 279  var Line 283  var
283  implementation  implementation
284  {$R *.dfm}  {$R *.dfm}
285    
 function TMainForm.TColorToHex(Color : TColor) : string;  
 begin  
    Result :=  
      IntToHex(GetRValue(Color), 2) +  
      IntToHex(GetGValue(Color), 2) +  
      IntToHex(GetBValue(Color), 2) ;  
 end;  
   
 function TMainForm.HexToTColor(sColor : string) : TColor;  
 begin  
    Result :=  
      RGB(  
        StrToInt('$'+Copy(sColor, 1, 2)),  
        StrToInt('$'+Copy(sColor, 3, 2)),  
        StrToInt('$'+Copy(sColor, 5, 2))  
      ) ;  
 end;  
286    
287  procedure TMainForm.InitForm(Farve,Titel,Url : String);  procedure TMainForm.InitForm(Farve,Titel,Url : String);
288  begin  begin
# Line 304  begin Line 291  begin
291      StaticTextManglendePakker.Caption := '';      StaticTextManglendePakker.Caption := '';
292  // 20150309: slut  // 20150309: slut
293    
294        Barcode := TStBarcode.Create(MainForm);//Dynamisk oprettelse af Barcode component
295    
296      PanelValg1.Color := clBtnFace;      PanelValg1.Color := clBtnFace;
297      if PanelValg1.Enabled = true then      if PanelValg1.Enabled = true then
298      begin      begin
# Line 400  begin Line 389  begin
389    
390      StartScreen();      StartScreen();
391      MainForm.Caption := Titel;      MainForm.Caption := Titel;
392      MainForm.Color := HexToTColor(Farve);      MainForm.Color := TUtils.HexToTColor(Farve);
393      MainForm.Farve := Farve;      MainForm.Farve := Farve;
394      MainForm.Titel := Titel;      MainForm.Titel := Titel;
395      MainForm.Url := Url;      MainForm.Url := Url;
# Line 460  begin Line 449  begin
449          end          end
450          else          else
451          begin          begin
452            logTekst := 'Speciel version til: '+split(Titel, ':', 2)+' ('+Sted+')';            logTekst := 'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+Sted+')';
453          end;          end;
454          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
455        end        end
456        else        else
457        begin        begin
458          logTekst := 'Speciel version til: '+split(Titel, ':', 2)+' ('+SpecialVersionSted+')';          logTekst := 'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+SpecialVersionSted+')';
459          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
460        end;        end;
461      end;      end;
# Line 509  end; Line 498  end;
498    
499  procedure TMainForm.Automatiskvalg1Click(Sender: TObject);  procedure TMainForm.Automatiskvalg1Click(Sender: TObject);
500  begin  begin
 // 20150317: start  
 (*  
   if Automatiskvalg1.Checked then  
   begin  
      AutomatiskValg1.Checked := true;  
      PanelValgA.Color := clGreen;  
      PanelValgA.Font.Color := clWhite;  
   end  
   else  
   begin  
      AutomatiskValg1.Checked := false;  
      PanelValgA.Color := clBtnFace;  
      PanelValgA.Font.Color := clWindowText;  
   end;  
 *)  
501  // Skal ikke toggle men bare sætte funktionen on  // Skal ikke toggle men bare sætte funktionen on
502  // Fravælges ved at vælge en scanningstype  // Fravælges ved at vælge en scanningstype
503       AutomatiskValg1.Checked := true;       AutomatiskValg1.Checked := true;
504       PanelValgA.Color := clGreen;       PanelValgA.Color := clGreen;
505       PanelValgA.Font.Color := clWhite;       PanelValgA.Font.Color := clWhite;
 // 20150317: slut  
506  end;  end;
507    
508  procedure TMainForm.FormCreate(Sender: TObject);  procedure TMainForm.FormCreate(Sender: TObject);
# Line 546  begin Line 519  begin
519    PrinterstatusStaticText1.Caption := '';    PrinterstatusStaticText1.Caption := '';
520    PrinterstatusStaticText1.Color := MainForm.Color;    PrinterstatusStaticText1.Color := MainForm.Color;
521    
522    PakkeshopNulstil.BringToFront;    btnNulstil.BringToFront;
523    
524    RoundCornerOf(PanelManglendePakker1);    TUtils.RoundCornerOf(PanelManglendePakker1);
525    RoundCornerOf(PanelManglendePakker2);    TUtils.RoundCornerOf(PanelManglendePakker2);
526    RoundCornerOf(PanelManglendePakker3);    TUtils.RoundCornerOf(PanelManglendePakker3);
527    RoundCornerOf(PanelManglendePakker4);    TUtils.RoundCornerOf(PanelManglendePakker4);
528    RoundCornerOf(PanelManglendePakker5);    TUtils.RoundCornerOf(PanelManglendePakker5);
529    RoundCornerOf(PanelManglendePakker6);    TUtils.RoundCornerOf(PanelManglendePakker6);
530    
531    
532    // Hvis mappen Docs eksisterer kan vi vælge Manual i menuen Hjælp    // Hvis mappen Docs eksisterer kan vi vælge Manual i menuen Hjælp
# Line 588  begin Line 561  begin
561      UrlReturPakkeshop := ReadString('Settings','UrlReturPakkeshop','http://omdeling.info/webservices/pakkeshop/returpakkekontrol.php?sted=%s&stregkode=%s');      UrlReturPakkeshop := ReadString('Settings','UrlReturPakkeshop','http://omdeling.info/webservices/pakkeshop/returpakkekontrol.php?sted=%s&stregkode=%s');
562      UrlPakkeshopManglendeScanninger := ReadString('Settings','UrlPakkeshopManglendeScanninger','http://omdeling.info/webservices/pakkeshop/pakkemanglendescanninger.php?sted=%s');      UrlPakkeshopManglendeScanninger := ReadString('Settings','UrlPakkeshopManglendeScanninger','http://omdeling.info/webservices/pakkeshop/pakkemanglendescanninger.php?sted=%s');
563      UrlPakkeshopManglendeReturScanninger := ReadString('Settings','UrlPakkeshopManglendeReturScanninger','http://omdeling.info/webservices/pakkeshop/pakkemanglendereturscanninger.php?sted=%s');      UrlPakkeshopManglendeReturScanninger := ReadString('Settings','UrlPakkeshopManglendeReturScanninger','http://omdeling.info/webservices/pakkeshop/pakkemanglendereturscanninger.php?sted=%s');
564    
565        UrlIndleveringsPakke := ReadString('Settings','UrlIndleveringsPakke','http://omdeling.info/webservices/pakkeshop/PakkekontrolIndleveringskode.php?sted=%s&pakkekode=%s');
566    
567    
568      LabelType := ReadInteger('Settings','LabelType',1);      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');
# Line 625  begin Line 602  begin
602    
603      if (SkrivLog = '1') then      if (SkrivLog = '1') then
604      begin      begin
605        logTekst := 'Program start (Version: ' + Sto_GetFmtFileVersion('','') + ') Dato: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss',now);        logTekst := 'Program start (Version: ' + Sto_GetFmtFileVersion('') + ') Dato: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss',now);
606        try        try
607          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
608          Uploadlogfil1.Enabled := true;          Uploadlogfil1.Enabled := true;
# Line 768  begin Line 745  begin
745      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)
746      // *************************** //      // *************************** //
747    
748    {$IfDef STED_BK}
749        SpecialVersionSted := 'BK';
750    {$EndIf}
751    {$IfDef STED_DBK}
752        SpecialVersionSted := 'DBK';
753    {$EndIf}
754    {$IfDef STED_FD}
755        SpecialVersionSted := 'FD';
756    {$EndIf}
757    {$IfDef STED_NS}
758        SpecialVersionSted := 'NS';
759    {$EndIf}
760    
761    
762      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
763      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)
764      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
# Line 783  begin Line 774  begin
774      // Hvis specialversion er valgt (SpecialVersionSted er sat til en værdi ovenfor)      // Hvis specialversion er valgt (SpecialVersionSted er sat til en værdi ovenfor)
775      // ændrer vi Sted og Scanningtype her:      // ændrer vi Sted og Scanningtype her:
776    
 // 20150313: start  
777      if SpecialVersionSted = 'NS' then      if SpecialVersionSted = 'NS' then
778      begin      begin
779         SpecialVersionSted := '01';         SpecialVersionSted := '01';
# Line 794  begin Line 784  begin
784         SpecialVersionSted := '03';         SpecialVersionSted := '03';
785         SpecialVersionScanningtype := '4';         SpecialVersionScanningtype := '4';
786      end;      end;
 // 20150313: slut  
787    
788      if SpecialVersionSted = 'BK' then      if SpecialVersionSted = 'BK' then
789      begin      begin
# Line 834  begin Line 823  begin
823        PanelValg5.Font.Color := clInactiveCaption;        PanelValg5.Font.Color := clInactiveCaption;
824        PanelValg6.Enabled := false;        PanelValg6.Enabled := false;
825        PanelValg6.Font.Color := clInactiveCaption;        PanelValg6.Font.Color := clInactiveCaption;
826          PanelValg7.Enabled := false;
827          PanelValg7.Font.Color := clInactiveCaption;
828    
829       // her skal vi også disable de menupunkter DBK ikke kan bruge       // her skal vi også disable de menupunkter DBK ikke kan bruge
830        ReturpakkerfraDAO1.Enabled := false;        ReturpakkerfraDAO1.Enabled := false;
831        Returpakkerfraboghandler1.Enabled := false;        Returpakkerfraboghandler1.Enabled := false;
# Line 870  begin Line 862  begin
862        PanelValg5.Font.Color := clInactiveCaption;        PanelValg5.Font.Color := clInactiveCaption;
863        PanelValg6.Enabled := false;        PanelValg6.Enabled := false;
864        PanelValg6.Font.Color := clInactiveCaption;        PanelValg6.Font.Color := clInactiveCaption;
865          PanelValg7.Enabled := false;
866          PanelValg7.Font.Color := clInactiveCaption;
867       // her skal vi også disable de menupunkter Bladhusene (01, 02, 03 og 04) ikke kan bruge       // her skal vi også disable de menupunkter Bladhusene (01, 02, 03 og 04) ikke kan bruge
868    
869        Automatiskvalg1.Enabled := false;        Automatiskvalg1.Enabled := false;
# Line 965  begin Line 959  begin
959             RutenummerST.Caption := '';             RutenummerST.Caption := '';
960             BoghandlerNavnST.Caption := 'Fejl i urls';             BoghandlerNavnST.Caption := 'Fejl i urls';
961             KommentarST.Caption := 'Se log vinduet';             KommentarST.Caption := 'Se log vinduet';
962             PakkeshopNulstil.Visible := true;             btnNulstil.Visible := true;
963             exit;             exit;
964          end;          end;
965      end      end
# Line 1134  begin Line 1128  begin
1128      Scanningtype := gemScanningtype;      Scanningtype := gemScanningtype;
1129    
1130      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');
1131      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion('',''));      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion(''));
1132    
1133  end;  end;
1134    
# Line 1214  begin Line 1208  begin
1208    
1209      if StregKode = 'Nulstil' then      if StregKode = 'Nulstil' then
1210      begin      begin
1211         PakkeshopNulstil.Click();         btnNulstil.Click();
1212         exit;         exit;
1213      end;      end;
1214    
1215      if PakkeshopNulstil.Visible then      if btnNulstil.Visible then
1216      begin      begin
1217        VisAlarmSkaerm( 'HUSK at klikke Nulstil før ny scanning...' );        VisAlarmSkaerm( 'HUSK at klikke Nulstil før ny scanning...' );
1218    
# Line 1543  begin Line 1537  begin
1537             BoghandlerStregkode := Stregkode;             BoghandlerStregkode := Stregkode;
1538             BoghandlerTjekkode := '';             BoghandlerTjekkode := '';
1539             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1540             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1541             Stregkode := '';             Stregkode := '';
1542             InitScreen();             InitScreen();
1543        end        end
# Line 1555  begin Line 1549  begin
1549             BoghandlerStregkode := Stregkode;             BoghandlerStregkode := Stregkode;
1550             BoghandlerTjekkode := '-1';             BoghandlerTjekkode := '-1';
1551             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1552             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1553             Stregkode := '';             Stregkode := '';
1554             InitScreen();             InitScreen();
1555        end        end
# Line 1586  begin Line 1580  begin
1580             BoghandlerTjekkode := Stregkode;             BoghandlerTjekkode := Stregkode;
1581             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1582             if (PakkeshopLevering1.Checked) then             if (PakkeshopLevering1.Checked) then
1583                MainForm.Color := HexToTColor(FarvePakkeshoplevering);                MainForm.Color := TUtils.HexToTColor(FarvePakkeshoplevering);
1584             if (Pakkernormal1.Checked) then             if (Pakkernormal1.Checked) then
1585                MainForm.Color := HexToTColor(FarveNormal);                MainForm.Color := TUtils.HexToTColor(FarveNormal);
1586             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1587           end           end
1588          else          else
1589           begin           begin
# Line 1621  begin Line 1615  begin
1615            // Hvis der var sql fejl i opdateringen skal dette fejlmeldes her            // Hvis der var sql fejl i opdateringen skal dette fejlmeldes her
1616            if Rutenummer = 'sql fejl' then            if Rutenummer = 'sql fejl' then
1617            begin   // Her skal komme en alarm og rød skærm            begin   // Her skal komme en alarm og rød skærm
1618               PlaySound(PWideChar(AlarmLyd));               VisAlarmSkaerm( 'SQL fejl: ' + Kommentar );
1619               //List1msg := 'SQL fejl: ' + Kommentar;  
              //ListBox1.Items.Insert(0,List1Msg);  
              MainForm.Color := clRed;  
              //KommentarST.Caption := List1msg;  
              PakkeshopNulstil.Visible := true;  
1620              exit;              exit;
1621            end;            end;
1622            if (Pakkernormal1.Checked or Budlevering1.Checked or PakkeshopLevering1.Checked) then            if (Pakkernormal1.Checked or Budlevering1.Checked or PakkeshopLevering1.Checked) then
# Line 1646  begin Line 1636  begin
1636              if (pakkeErScannet > 0) or (pakkeForkertSted > 0) or (tjekkodemangler > 0) then              if (pakkeErScannet > 0) or (pakkeForkertSted > 0) or (tjekkodemangler > 0) then
1637              begin              begin
1638                PlaySound(PWideChar(AlarmLyd));                PlaySound(PWideChar(AlarmLyd));
1639                PakkeshopNulstil.Visible := true;                btnNulstil.Visible := true;
1640                MainForm.Color := clRed;                MainForm.Color := clRed;
1641              end;              end;
1642           end;           end;
1643            if ( Pakkernormal1.Checked and (pakkeErScannet = 0) and (pakkeForkertSted = 0) and (tjekkodemangler = 0) and (RuteNummerST.Caption <> 'Ukendt') ) or (Copy(Kommentar,1,2) = 'Ok') then            if ( Pakkernormal1.Checked and (pakkeErScannet = 0) and (pakkeForkertSted = 0) and (tjekkodemangler = 0) and (RuteNummerST.Caption <> 'Ukendt') ) or (Copy(Kommentar,1,2) = 'Ok') then
1644            begin            begin
1645              MainForm.Color := HexToTColor(Farve);              MainForm.Color := TUtils.HexToTColor(Farve);
1646              if Storepakker1.Checked then              if Storepakker1.Checked then
1647              begin              begin
1648                PlaySound(PWideChar(ScannetOkStorLyd));                PlaySound(PWideChar(ScannetOkStorLyd));
# Line 1661  begin Line 1651  begin
1651              begin              begin
1652                PlaySound(PWideChar(ScannetOkLyd));                PlaySound(PWideChar(ScannetOkLyd));
1653              end;              end;
1654              PakkeshopNulstil.Visible := false;              btnNulstil.Visible := false;
1655            end            end
1656            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then
1657            begin            begin
1658              MainForm.Color := HexToTColor(Farve);              MainForm.Color := TUtils.HexToTColor(Farve);
1659              if Storepakker1.Checked then              if Storepakker1.Checked then
1660              begin              begin
1661                PlaySound(PWideChar(ScannetOkStorLyd));                PlaySound(PWideChar(ScannetOkStorLyd));
# Line 1674  begin Line 1664  begin
1664              begin              begin
1665                PlaySound(PWideChar(ScannetOkLyd));                PlaySound(PWideChar(ScannetOkLyd));
1666              end;              end;
1667              PakkeshopNulstil.Visible := false;              btnNulstil.Visible := false;
1668            end            end
1669            else if Copy(Kommentar,1,8) = 'OPRETTET' then            else if Copy(Kommentar,1,8) = 'OPRETTET' then
1670            begin            begin
# Line 1685  begin Line 1675  begin
1675            end            end
1676            else            else
1677            begin            begin
1678              MainForm.Color := clRed;              VisAlarmSkaerm('');
             PlaySound(PWideChar(AlarmLyd));  
             PakkeshopNulstil.Visible := true;  
1679            end;            end;
1680           if not PakkeshopNulstil.Visible then           if not btnNulstil.Visible then
1681            begin            begin
1682    
1683              If (Budlevering1.Checked) then              If (Budlevering1.Checked) then
# Line 1792  begin Line 1780  begin
1780            if (pos('/', wrkAntal) > 0) then  // både pakker idag og senere            if (pos('/', wrkAntal) > 0) then  // både pakker idag og senere
1781            begin            begin
1782              wrkAntal := wrkAntal + '/';   // tilføjer '/' sidst i feltet af hensyn til split funktionen              wrkAntal := wrkAntal + '/';   // tilføjer '/' sidst i feltet af hensyn til split funktionen
1783              wrkAntalIdag := StrToInt(split(wrkAntal, '/', 2));              wrkAntalIdag := StrToInt( TUtils.split(wrkAntal, '/', 2));
1784  //            ShowMessage(SPLIT('data/another/yet/again/more/','/',3));  //            ShowMessage(SPLIT('data/another/yet/again/more/','/',3));
1785  //            ShowMessage(SPLIT('data/another/','/',3));  //            ShowMessage(SPLIT('data/another/','/',3));
1786  //            ShowMessage(SPLIT('data/another','/',3));  //            ShowMessage(SPLIT('data/another','/',3));
1787              wrkAntalSenere := StrToInt(split(wrkAntal, '/', 3));              wrkAntalSenere := StrToInt( TUtils.split(wrkAntal, '/', 3));
1788            end            end
1789            else     // kun idag            else     // kun idag
1790            begin            begin
# Line 2060  var Line 2048  var
2048    URLStr : String;    URLStr : String;
2049    pakkestorrelse : String;    pakkestorrelse : String;
2050    PrintNyLabelInteger : Integer;    PrintNyLabelInteger : Integer;
2051    
2052      PakkeshopLabel: TPakkeshopLabel;
2053  begin  begin
2054    if radioStorPakke.Checked then    if radioStorPakke.Checked then
2055    begin    begin
# Line 2069  begin Line 2059  begin
2059    begin    begin
2060      pakkestorrelse := 'Lille';      pakkestorrelse := 'Lille';
2061    end;    end;
2062    
2063    
2064    if Pakkernormal1.Checked then    if Pakkernormal1.Checked then
2065    begin    begin
2066       if (BoghandlerTjekkode = '') then       if (BoghandlerTjekkode = '') then
# Line 2097  begin Line 2089  begin
2089    begin    begin
2090       URLStr := Format(UrlReturPakkeshop,[Sted, PakkeNr]);       URLStr := Format(UrlReturPakkeshop,[Sted, PakkeNr]);
2091    end    end
2092      else if menuIndlevering.Checked then
2093      begin
2094        URLStr := Format(UrlIndleveringsPakke,[Sted, PakkeNr]);
2095      end
2096    else    else
2097    begin    begin
2098      exit;      exit;
# Line 2143  begin Line 2139  begin
2139          begin          begin
2140            PrintNyLabel := True;            PrintNyLabel := True;
2141          end;          end;
 // 20150310: start  
2142        end;        end;
 // 20150310: slut  
2143       end       end
2144        else if menuIndlevering.Checked then
2145        begin
2146    
2147    
2148    
2149    
2150         Kommentar := XMLDocument1.ChildNodes.FindNode('PakkeKontrol').ChildNodes.FindNode('Stregkodematch').Text;
2151         if (Kommentar = 'Ok') then
2152         begin
2153           PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label
2154           PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc
2155           RuteNummer := PakkeshopLabel.Koreliste;
2156    
2157           PrintPakkeshopLabel( PakkeshopLabel );
2158    
2159         end;
2160    
2161    
2162        end
2163      else      else
2164       begin       begin
2165        RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text;        RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text;
# Line 2179  begin Line 2192  begin
2192          PrintNyLabel := True;          PrintNyLabel := True;
2193        end;        end;
2194      end;      end;
2195    
2196    
2197      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
2198      begin      begin
2199        if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then        if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then
# Line 2293  pakkeForkertSted : Integer; Line 2308  pakkeForkertSted : Integer;
2308    nytRuteNummer, nyFarve : String;    nytRuteNummer, nyFarve : String;
2309  begin  begin
2310    if Budlevering1.Checked then    if Budlevering1.Checked then
2311       RuteNummerST.Color := HexToTColor(Farve);       RuteNummerST.Color := TUtils.HexToTColor(Farve);
2312    
2313    pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);    pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);
2314    if pakkeErScannet = 0 then    if pakkeErScannet = 0 then
# Line 2338  begin Line 2353  begin
2353    
2354          PlaySound(PWideChar(AlarmLyd));          PlaySound(PWideChar(AlarmLyd));
2355          MainForm.Color := clRed;          MainForm.Color := clRed;
2356          PakkeshopNulstil.Visible := true;          btnNulstil.Visible := true;
2357    
2358       end       end
2359       else       else
# Line 2349  begin Line 2364  begin
2364            PrintNyLabel := true;            PrintNyLabel := true;
2365            RuteNummerST.Caption := RuteNummer+' -> ny rute: '+nytRuteNummer;            RuteNummerST.Caption := RuteNummer+' -> ny rute: '+nytRuteNummer;
2366            nyFarve := Farve;            nyFarve := Farve;
2367            RuteNummerST.Color := HexToTColor(nyFarve);            RuteNummerST.Color := TUtils.HexToTColor(nyFarve);
2368            List1msg := TimeToStr(now) + '; ' + RuteNummer+' -> ny rute: '+nytRuteNummer;            List1msg := TimeToStr(now) + '; ' + RuteNummer+' -> ny rute: '+nytRuteNummer;
2369            RuteNummer := nytRuteNummer;            RuteNummer := nytRuteNummer;
2370            ListBox1.Items.Insert(0,List1Msg);            ListBox1.Items.Insert(0,List1Msg);
# Line 2365  begin Line 2380  begin
2380            begin            begin
2381              PlaySound(PWideChar(AlarmLyd));              PlaySound(PWideChar(AlarmLyd));
2382              MainForm.Color := clRed;              MainForm.Color := clRed;
2383              PakkeshopNulstil.Visible := true;              btnNulstil.Visible := true;
2384            end;            end;
2385    
2386         end;         end;
# Line 2391  begin Line 2406  begin
2406            begin            begin
2407              PlaySound(PWideChar(AlarmLyd));              PlaySound(PWideChar(AlarmLyd));
2408              MainForm.Color := clRed;              MainForm.Color := clRed;
2409              PakkeshopNulstil.Visible := true;              btnNulstil.Visible := true;
2410            end;            end;
2411    
2412         end;         end;
# Line 2415  begin Line 2430  begin
2430                end;                end;
2431              end;              end;
2432        01 :  begin;        01 :  begin;
2433               if PrintNyLabel and ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then               if PrintNyLabel or ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then
2434                    // 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
2435                    // 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')
2436                begin                begin
# Line 2429  begin Line 2444  begin
2444                end;                end;
2445              end;              end;
2446        03 :  begin;        03 :  begin;
2447               if PrintNyLabel and ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then               if PrintNyLabel or ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then
2448                    // 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
2449                    // 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')
2450               begin               begin
# Line 3038  begin Line 3053  begin
3053      repeat      repeat
3054        if (SR.Attr <> faDirectory) then        if (SR.Attr <> faDirectory) then
3055        begin        begin
3056    
3057          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring
3058          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse
3059          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse
# Line 3077  begin Line 3093  begin
3093    end;    end;
3094  end;  end;
3095    
3096  procedure TMainForm.PakkeshopNulstilClick(Sender: TObject);  procedure TMainForm.btnNulstilClick(Sender: TObject);
3097  begin  begin
3098    PakkeshopStregkode := '';    PakkeshopStregkode := '';
3099    PakkeshopTjekkode := '';    PakkeshopTjekkode := '';
3100    PakkeshopNulstil.Visible := false;    btnNulstil.Visible := false;
3101    PakkeshopText1.Caption := 'Stregkode';    PakkeshopText1.Caption := 'Stregkode';
3102    BoghandlerStregkode := '';    BoghandlerStregkode := '';
3103    BoghandlerTjekkode := '';    BoghandlerTjekkode := '';
# Line 3099  begin Line 3115  begin
3115  //  MainForm.Color := HexToTColor(Farve);  //  MainForm.Color := HexToTColor(Farve);
3116    if Farve <> '' then    if Farve <> '' then
3117    begin    begin
3118       MainForm.Color := HexToTColor(Farve);       MainForm.Color := TUtils.HexToTColor(Farve);
3119  // 20150312: start  // 20150312: start
3120  (*  (*
3121    end    end
# Line 3231  begin Line 3247  begin
3247      // Her kommer en alarm og rød skærm      // Her kommer en alarm og rød skærm
3248      PlaySound(PWideChar(AlarmLyd));      PlaySound(PWideChar(AlarmLyd));
3249      MainForm.Color := clRed;      MainForm.Color := clRed;
3250      PakkeshopNulstil.Visible := true;      btnNulstil.Visible := true;
3251    end    end
3252    else    else
3253    begin    begin
# Line 3299  begin Line 3315  begin
3315    end;    end;
3316  end;  end;
3317    
3318  {  
  VERY fast split function  
  this function returns part of a string based on  
  constant defineable delimiters, such as ";". So  
  SPLIT('this is a test ',' ',3) = 'is' or  
  SPLIT('data;another;yet;again;more;',';',4) = 'yet'  
   
  Split function shifts index integer by two to  
  be compatible with commonly used PD split function  
  gpl 2004 / Juhani Suhonen  
 }  
 function TMainForm.split(input: string; schar: Char; s: Integer): string;  
 var  
   c: array of Integer;  
   b, t: Integer;  
 begin  
   Dec(s, 2);  // for compatibility with very old & slow split function  
   t := 0;     // variable T needs to be initialized...  
   setlength(c, Length(input));  
   for b := 0 to pred(High(c)) do  
   begin  
     c[b + 1] := posex(schar, input, succ(c[b]));  
     // BREAK LOOP if posex looped (position before previous)  
     // or wanted position reached..  
     if (c[b + 1] < c[b]) or (s < t) then break  
     else  
       Inc(t);  
   end;  
   Result := Copy(input, succ(c[s]), pred(c[s + 1] - c[s]));  
 end;  
3319    
3320  procedure TMainForm.Om1Click(Sender: TObject);  procedure TMainForm.Om1Click(Sender: TObject);
3321  const  const
# Line 3337  var Line 3324  var
3324   tekst, filversion : String;   tekst, filversion : String;
3325  begin  begin
3326    
3327    filversion := Sto_GetFmtFileVersion('','');    filversion := Sto_GetFmtFileVersion('');
3328    tekst := 'Program til indscanning af pakker'+crlf+'Version '+filversion+crlf+crlf+'Udviklet af it afdelingen, DAO';    tekst := 'Program til indscanning af pakker'+crlf+'Version '+filversion+crlf+crlf+'Udviklet af it afdelingen, DAO';
3329    
3330    tekst := tekst+crlf+crlf;    tekst := tekst+crlf+crlf;
# Line 3359  begin Line 3346  begin
3346          end          end
3347          else          else
3348          begin          begin
3349            tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+Sted+')';            tekst := tekst+crlf+crlf+'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+Sted+')';
3350          end;          end;
3351      end      end
3352      else      else
3353      begin      begin
3354        tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+SpecialVersionSted+')';        tekst := tekst+crlf+crlf+'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+SpecialVersionSted+')';
3355      end;      end;
3356    end;    end;
3357    
# Line 3432  begin Line 3419  begin
3419    
3420    if FileExists(fileName) then    if FileExists(fileName) then
3421    begin    begin
3422      if AdobeReaderExists then      if TUtils.AdobeReaderExists then
3423      begin      begin
3424        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);
3425        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);
# Line 3456  begin Line 3443  begin
3443    
3444    if FileExists(fileName) then    if FileExists(fileName) then
3445    begin    begin
3446      if AdobeReaderExists then      if TUtils.AdobeReaderExists then
3447      begin      begin
3448        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);
3449        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);
# Line 3472  begin Line 3459  begin
3459    end;    end;
3460  end;  end;
3461    
3462    procedure TMainForm.menuIndleveringClick(Sender: TObject);
3463    begin
3464      Scanningtype := '7';
3465      NulstilAutomatiskValg();
3466      InitIndleveringskode();
3467    end;
3468    
3469  procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject);  procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject);
3470  begin  begin
3471    
# Line 3504  end; Line 3498  end;
3498  procedure TMainForm.InitNatxpresslevering();  procedure TMainForm.InitNatxpresslevering();
3499  begin  begin
3500        AutomatiskTjekkodeStyring1.Enabled := true;        AutomatiskTjekkodeStyring1.Enabled := true;
3501        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3502        Pakkernormal1.Checked := true;        Pakkernormal1.Checked := true;
3503        InitForm(FarveNormal,TitelNormal,UrlNormal);        InitForm(FarveNormal,TitelNormal,UrlNormal);
3504        PanelValg1.Color := clGreen;        PanelValg1.Color := clGreen;
# Line 3537  procedure TMainForm.InitReturFraDao(); Line 3531  procedure TMainForm.InitReturFraDao();
3531  begin  begin
3532        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3533        ReturpakkerfraDAO1.Checked := true;        ReturpakkerfraDAO1.Checked := true;
3534        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3535        InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO);        InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO);
3536        PanelValg2.Color := clGreen;        PanelValg2.Color := clGreen;
3537        PanelValg2.Font.Color := clWhite;        PanelValg2.Font.Color := clWhite;
# Line 3564  procedure TMainForm.InitReturFraKunde(); Line 3558  procedure TMainForm.InitReturFraKunde();
3558  begin  begin
3559        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3560        Returpakkerfraboghandler1.Checked := true;        Returpakkerfraboghandler1.Checked := true;
3561        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3562        InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler);        InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler);
3563        PanelValg3.Color := clGreen;        PanelValg3.Color := clGreen;
3564        PanelValg3.Font.Color := clWhite;        PanelValg3.Font.Color := clWhite;
# Line 3590  procedure TMainForm.InitDirektelevering( Line 3584  procedure TMainForm.InitDirektelevering(
3584  begin  begin
3585        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3586        Budlevering1.Checked := true;        Budlevering1.Checked := true;
3587        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3588        InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering);        InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering);
3589        PanelValg4.Color := clGreen;        PanelValg4.Color := clGreen;
3590        PanelValg4.Font.Color := clWhite;        PanelValg4.Font.Color := clWhite;
# Line 3626  procedure TMainForm.InitPakkeshopleverin Line 3620  procedure TMainForm.InitPakkeshopleverin
3620  begin  begin
3621        AutomatiskTjekkodeStyring1.Enabled := true;        AutomatiskTjekkodeStyring1.Enabled := true;
3622        Pakkeshoplevering1.Checked := true;        Pakkeshoplevering1.Checked := true;
3623        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3624        InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering);        InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering);
3625        PanelValg5.Color := clGreen;        PanelValg5.Color := clGreen;
3626        PanelValg5.Font.Color := clWhite;        PanelValg5.Font.Color := clWhite;
# Line 3663  procedure TMainForm.InitReturFraPakkesho Line 3657  procedure TMainForm.InitReturFraPakkesho
3657  begin  begin
3658        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3659        Returpakkerfrapakkeshop1.Checked := true;        Returpakkerfrapakkeshop1.Checked := true;
3660        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3661        InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop);        InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop);
3662        PanelValg6.Color := clGreen;        PanelValg6.Color := clGreen;
3663        PanelValg6.Font.Color := clWhite;        PanelValg6.Font.Color := clWhite;
# Line 3703  end; Line 3697  end;
3697    
3698  procedure TMainForm.InitIndleveringskode();  procedure TMainForm.InitIndleveringskode();
3699  begin  begin
3700          menuIndlevering.Checked := true;
3701        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3702        Returpakkerfrapakkeshop1.Checked := true;  
3703        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3704        InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop);        InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop);
3705        PanelValg7.Color := clGreen;        PanelValg7.Color := clGreen;
3706        PanelValg7.Font.Color := clWhite;        PanelValg7.Font.Color := clWhite;
# Line 3783  end; Line 3778  end;
3778  ///   values.</param>  ///   values.</param>
3779  /// <returns>Formatted version number of file, '' if no version  /// <returns>Formatted version number of file, '' if no version
3780  ///   resource found.</returns>  ///   resource found.</returns>
3781  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = '';  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = ''): String;
   const Fmt: String = '%d.%d.%d.%d'): String;  
3782  var  var
3783    sFileName: String;    sFileName: String;
3784    iBufferSize: DWORD;    iBufferSize: DWORD;
3785    iDummy: DWORD;    iDummy: DWORD;
3786    pBuffer: Pointer;    pBuffer: Pointer;
3787    pFileInfo: Pointer;    pFileInfo: Pointer;
3788    iVer: array[1..4] of Word;    iVer: array[1..4] of Integer;
   S : String;  
3789  begin  begin
3790    // set default value    // set default value
3791    Result := '';    Result := '';
# Line 3817  begin Line 3810  begin
3810      finally      finally
3811        FreeMem(pBuffer);        FreeMem(pBuffer);
3812      end;      end;
3813    
3814      // format result string      // format result string
3815      Result := Format(Fmt, [iVer[1], iVer[2], iVer[3], iVer[4]]);      Result := Format('%d.%d.%d.%d', [iVer[1], iVer[2], iVer[3], iVer[4]]);
3816    
     // Hvorfor virker ovenstående ikke ???  
     S := '';  
     Str(iVer[1], Result);  
     S := S+Result+'.';  
     Str(iVer[2], Result);  
     S := S+Result+'.';  
     Str(iVer[3], Result);  
     S := S+Result+'.';  
     Str(iVer[4], Result);  
     S := S+Result+'';  
     Result := S;  
3817    end;    end;
3818  end;  end;
3819    
# Line 3993  begin Line 3976  begin
3976           BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...';           BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...';
3977         end;         end;
3978         KommentarST.Caption := Kommentar;         KommentarST.Caption := Kommentar;
3979         PakkeshopNulstil.Visible := true;         btnNulstil.Visible := true;
3980      end;      end;
3981    
3982  end;  end;
# Line 4017  begin Line 4000  begin
4000    else    else
4001      MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);      MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);
4002  }  }
4003    Svar := 'Beregnet: '+CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1))+', Indtastet: '+Barcode;    Svar := 'Beregnet: ' + TUtils.CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1))+', Indtastet: '+Barcode;
4004    
4005    MessageBox(Handle, PWideChar(Svar), 'Stregkode', MB_OK);    MessageBox(Handle, PWideChar(Svar), 'Stregkode', MB_OK);
4006    CheckCode();    CheckCode();
# Line 4025  end; Line 4008  end;
4008    
4009  end;  end;
4010    
 function TMainForm.BarCodeValid (ACode: string): boolean;  
 var  
    I: integer;  
    SumOdd, SumEven: integer;  
    ADigit, AChecksumDigit: integer;  
 begin  
    SumOdd := 0;  
    SumEven := 0;  
    for I := 1 to (Length (ACode) - 1) do begin  
       ADigit := StrToIntDef (ACode [I], 0);  
       if (I MOD 2 = 0) then begin  
          SumEven := SumEven + ADigit;  
       end else begin  
          SumOdd := SumOdd + ADigit;  
       end; {if}  
    end; {for}  
    AChecksumDigit := StrToIntDef (ACode [Length (ACode)], 0);  
    Result := ((SumOdd*3 + SumEven + AChecksumDigit) MOD 10 = 0);  
 end; {--BarCodeValid--}  
   
 { used for EAN 8/13 }  
 function TMainForm.CheckSumModulo10(const data:string):string;  
         var i,fak,sum : Integer;  
 begin  
         sum := 0;  
         fak := Length(data);  
         for i:=1 to Length(data) do  
         begin  
                 if (fak mod 2) = 0 then  
                         sum := sum + (StrToInt(data[i])*1)  
                 else  
                         sum := sum + (StrToInt(data[i])*3);  
                 dec(fak);  
         end;  
         if (sum mod 10) = 0 then  
                 result := data+'0'  
         else  
                 result := data+IntToStr(10-(sum mod 10));  
 end;  
4011    
4012  //  //
4013  // Bladhus ***  // Bladhus ***
# Line 4565  begin Line 4509  begin
4509      ListBox1.SetFocus;  // for at flytte fokus væk fra download knappen så denne ikke aktiveres ved scanning / indtastning af stregkode      ListBox1.SetFocus;  // for at flytte fokus væk fra download knappen så denne ikke aktiveres ved scanning / indtastning af stregkode
4510  end;  end;
4511    
4512  function TMainForm.Explode(var a: TStrArray; Border, S: string): Integer;  
4513    // ToDo: PrintPakkeshopLabel()
4514    procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
4515  var  var
4516    S2: string;    XForm, XFormOld: TXForm; //Bruges til rotate X-formation
4517      Angle: integer;
4518      gMode: integer;
4519      Dirigering: string;
4520    
4521    begin
4522        with Printer do
4523        begin
4524          BeginDoc();
4525    
4526    
4527          Canvas.Font.Size := 16;
4528          Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);
4529    
4530    
4531    
4532          Canvas.TextOut(25, 90, PakkeshopLabel.Navn );
4533          Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn );
4534          Canvas.TextOut(25, 180, PakkeshopLabel.Postnr );
4535    
4536    
4537          Canvas.Font.Size := 9;
4538          Canvas.TextOut(110, 240, 'Pakkeshop:');
4539          Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);
4540          Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);
4541          Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);
4542    
4543          Canvas.TextOut(350, 240, 'Afsender:');
4544          Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);
4545          Canvas.TextOut(350, 300, PakkeshopLabel.AfsenderAdresse);
4546          Canvas.TextOut(350, 330, PakkeshopLabel.AfsenderPostnr);
4547    
4548          Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr;
4549          if ( PakkeshopLabel.Koreliste <> '') then
4550          begin
4551            Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
4552          end;
4553    
4554    
4555          Canvas.Font.Size := 12;
4556          Canvas.TextOut(15, 370, Dirigering);
4557    
4558    
4559    
4560    
4561    
4562          //Tegn adskillelses linier
4563          Canvas.Pen.Width := 2;
4564          //Øverste linie
4565          Canvas.MoveTo(20,80);
4566          Canvas.LineTo(600,80);
4567    
4568          // Midterste linie
4569          Canvas.MoveTo( 20, 240);
4570          Canvas.LineTo(600, 240);
4571    
4572          //Nederste linie
4573          Canvas.MoveTo( 20, 370);
4574          Canvas.LineTo(600, 370);
4575    
4576    
4577          //Tegn skrå streger over afsender
4578          Canvas.Pen.Width := 1;
4579          Canvas.MoveTo(600, 250);
4580          Canvas.LineTo(350, 360);
4581          Canvas.MoveTo(600, 360);
4582          Canvas.LineTo(350, 250);
4583    
4584    
4585    
4586    
4587          // Resten af rutinen vedr genering og placering af Barcode
4588    
4589          BarCode.BarCodeType := bcCode128;
4590          BarCode.Code128Subset := csCodeC;
4591          BarCode.Code := PakkeshopLabel.Stregkode;
4592          BarCode.Validate(True);
4593    
4594          //Start X-formation
4595          //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
4596          GetWorldTransform(Canvas.Handle, XFormOld);
4597    
4598          Angle := 270;
4599          XForm.eM11 := Cos(DegToRad(Angle));
4600          XForm.eM12 := Sin(DegToRad(Angle));
4601          XForm.eM21 := -Sin(DegToRad(Angle));
4602          XForm.eM22 := Cos(DegToRad(Angle));
4603          XForm.eDx := 0;
4604          XForm.eDy := 0;
4605    
4606          gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
4607          SetWorldTransform(Canvas.Handle, XForm);
4608    
4609          // PaintToCanvasSize arbejder i Inches
4610          // Første pos argument bliver nu Y og skal være negativ for at rykke den ned
4611          //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre
4612    
4613          BarCode.PaintToCanvasSize(Printer.Canvas, -1.8, 3.3, 0.4);
4614    
4615    
4616          SetWorldTransform(Canvas.Handle, XFormOld);
4617          SetGraphicsMode(Canvas.Handle, gMode);
4618    
4619          EndDoc();
4620        end;
4621    
4622    
4623    end;
4624    
4625    function GetPixelsPerInchX(): Integer;
4626  begin  begin
4627    Result  := 0;    Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)
   S2 := S + Border;  
   repeat  
     SetLength(A, Length(A) + 1);  
     a[Result] := Copy(S2, 0,Pos(Border, S2) - 1);  
     Delete(S2, 1,Length(a[Result] + Border));  
     Inc(Result);  
   until S2 = '';  
4628  end;  end;
4629    
4630    function GetPixelsPerInchY(): Integer;
4631    begin
4632      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
4633    end;
4634    
4635    
4636  procedure TMainForm.IndlesManglendeScanninger();  procedure TMainForm.IndlesManglendeScanninger();
4637  var  var
4638    WebSvar : String;    WebSvar : String;
# Line 4744  var Line 4798  var
4798  //                    stregkoderMedTjekkodeArray[linienr] := stregkode;  //                    stregkoderMedTjekkodeArray[linienr] := stregkode;
4799                    if (pos(' ', stregkode) > 0) then                    if (pos(' ', stregkode) > 0) then
4800                    begin                    begin
4801                      stregkoderMedTjekkodeArray[linienr] := 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
4802                    end                    end
4803                    else                    else
4804                    begin                    begin
# Line 4934  var Line 4988  var
4988     idag, imorgen : TDateTime;     idag, imorgen : TDateTime;
4989     imorgenYmd : string;     imorgenYmd : string;
4990     logFilnavn : string;     logFilnavn : string;
4991      error : Integer;     //error : Integer;
4992    
4993  begin  begin
4994    if (SkrivLog = '1') then    if (SkrivLog = '1') then
# Line 5026  begin Line 5080  begin
5080          ReadLn(SomeTxtFile, buffer) ;          ReadLn(SomeTxtFile, buffer) ;
5081          S := buffer;          S := buffer;
5082          SetLength(A,0);          SetLength(A,0);
5083          Explode(A, ';', S);          TUtils.Explode(A, ';', S);
5084          if (length(A) < 2) then          if (length(A) < 2) then
5085          begin          begin
5086            Explode(A, ',', S);            TUtils.Explode(A, ',', S);
5087          end;          end;
5088            if (length(A) > 1) then            if (length(A) > 1) then
5089            begin            begin
# Line 5103  begin Line 5157  begin
5157          ReadLn(SomeTxtFile, buffer) ;          ReadLn(SomeTxtFile, buffer) ;
5158          S := buffer;          S := buffer;
5159          SetLength(A,0);          SetLength(A,0);
5160          Explode(A, ';', S);          TUtils.Explode(A, ';', S);
5161          if (length(A) < 3) then          if (length(A) < 3) then
5162          begin          begin
5163            Explode(A, ',', S);            TUtils.Explode(A, ',', S);
5164          end;          end;
5165          if (A[0]=imorgenYmd) then          if (A[0]=imorgenYmd) then
5166          begin          begin
# Line 5203  begin Line 5257  begin
5257    //ShowMessage('Ændring ikke tilladt');    //ShowMessage('Ændring ikke tilladt');
5258    // Her skal komme en 'rød skærm' alarm    // Her skal komme en 'rød skærm' alarm
5259    PlaySound(PWideChar(AlarmLyd));    PlaySound(PWideChar(AlarmLyd));
   
   ListBox1.Items.Insert(0, strMessage);  
5260    MainForm.Color := clRed;    MainForm.Color := clRed;
5261    
5262    
5263    RuteNummerST.Caption := '';    RuteNummerST.Caption := '';
5264    BoghandlerNavnST.Caption := '';    BoghandlerNavnST.Caption := '';
5265    KommentarST.Caption := strMessage;    btnNulstil.Visible := true;
5266    PakkeshopNulstil.Visible := true;  
5267      if (strMessage <> '') then
5268      begin
5269        ListBox1.Items.Insert(0, strMessage);
5270        KommentarST.Caption := strMessage;
5271      end;
5272    
5273  end;  end;
5274    
5275  function TMainForm.getProddato() : TDate;  function TMainForm.getProddato() : TDate;
# Line 5301  begin Line 5361  begin
5361    end;    end;
5362  end;  end;
5363    
5364  function TMainForm.AdobeReaderExists: Boolean;  
5365    
5366    
5367    function TMainForm.CheckUrl(url:string):boolean;
5368  var  var
5369    AReg: TRegistry;    hSession, hfile: hInternet;
5370      dwindex,dwcodelen :dword;
5371      dwcode:array[1..20] of char;
5372      res : pchar;
5373  begin  begin
5374    result:= false;    if pos('http://',lowercase(url))=0 then
5375    AReg := TRegistry.Create;      url := 'http://'+url;
5376    AReg.RootKey := HKEY_LOCAL_MACHINE;    Result := false;
5377    if AReg.KeyExists('\SOFTWARE\Adobe\Acrobat Reader') then    hSession := InternetOpen('InetURL:/1.0',
5378      result:= True;                              INTERNET_OPEN_TYPE_PRECONFIG,
5379    AReg.Free;                              nil,
5380                                nil,
5381                                0);
5382      if assigned(hsession) then
5383      begin
5384        hfile := InternetOpenUrl(hsession,
5385                                 pchar(url),
5386                                 nil,
5387                                 0,
5388                                 INTERNET_FLAG_RELOAD,
5389                                 0);
5390        dwIndex := 0;
5391        dwCodeLen := 10;
5392        HttpQueryInfo(hfile,
5393                      HTTP_QUERY_STATUS_CODE,
5394                      @dwcode,
5395                      dwcodeLen,
5396                      dwIndex);
5397        res := pchar(@dwcode);
5398        result:= (res ='200') or (res ='302');
5399        if assigned(hfile) then
5400          InternetCloseHandle(hfile);
5401        InternetCloseHandle(hsession);
5402      end;
5403    
5404  end;  end;
5405    
5406    
5407  procedure TMainForm.CheckPrintQue(tjektype : string);  procedure TMainForm.CheckPrintQue(tjektype : string);
5408  type  type
5409    TJobs  = array [0..1000] of JOB_INFO_1;    TJobs  = array [0..1000] of JOB_INFO_1;
# Line 5416  begin Line 5507  begin
5507    end;    end;
5508  end;  end;
5509    
 function TMainForm.CheckUrl(url:string):boolean;  
 var  
   hSession, hfile, hRequest: hInternet;  
   dwindex,dwcodelen :dword;  
   dwcode:array[1..20] of char;  
   res : pchar;  
 begin  
   if pos('http://',lowercase(url))=0 then  
     url := 'http://'+url;  
   Result := false;  
   hSession := InternetOpen('InetURL:/1.0',  
                             INTERNET_OPEN_TYPE_PRECONFIG,  
                             nil,  
                             nil,  
                             0);  
   if assigned(hsession) then  
   begin  
     hfile := InternetOpenUrl(hsession,  
                              pchar(url),  
                              nil,  
                              0,  
                              INTERNET_FLAG_RELOAD,  
                              0);  
     dwIndex := 0;  
     dwCodeLen := 10;  
     HttpQueryInfo(hfile,  
                   HTTP_QUERY_STATUS_CODE,  
                   @dwcode,  
                   dwcodeLen,  
                   dwIndex);  
     res := pchar(@dwcode);  
     result:= (res ='200') or (res ='302');  
     if assigned(hfile) then  
       InternetCloseHandle(hfile);  
     InternetCloseHandle(hsession);  
   end;  
   
 end;  
   
 // 20150310: start  
 procedure TMainForm.RoundCornerOf(Control: TWinControl);  
 var  
    R: TRect;  
    Rgn: HRGN;  
 begin  
    with Control do  
    begin  
      R := ClientRect;  
 //     rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 20, 20) ;  
      rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 25, 25) ;  
 //     rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 30, 30) ;  
      Perform(EM_GETRECT, 0, lParam(@r)) ;  
      InflateRect(r, - 4, - 4) ;  
      Perform(EM_SETRECTNP, 0, lParam(@r)) ;  
      SetWindowRgn(Handle, rgn, True) ;  
      Invalidate;  
    end;  
 end;  
 // 20150310: slut  
5510    
5511  end.  end.
5512    
Legend:
Removed from v.2660  
changed lines
  Added in v.2685
  ViewVC Help
Powered by ViewVC 1.1.20