/[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 2679 by torben, Wed Aug 26 14:11:34 2015 UTC
# Line 9  uses Line 9  uses
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, Registry, ShellApi, ClipBrd, Buttons, wininet,
12    UITypes    UITypes,
13      PakkeshopLabels,
14      StBarC,
15      Math // DegToRad() bruges i PrintPakkeshopLabel
16    
17    
18    ;    ;
19    
# Line 58  type Line 62  type
62      DownloadButton03: TButton;      DownloadButton03: TButton;
63      Pakkeshoplevering1: TMenuItem;      Pakkeshoplevering1: TMenuItem;
64      PakkeshopText1: TStaticText;      PakkeshopText1: TStaticText;
65      PakkeshopNulstil: TButton;      btnNulstil: TButton;
66      Returpakkerfrapakkeshop1: TMenuItem;      Returpakkerfrapakkeshop1: TMenuItem;
67      Altidprintepakkelabel1: TMenuItem;      Altidprintepakkelabel1: TMenuItem;
68      chkAltidPrintLabel: TCheckBox;      chkAltidPrintLabel: TCheckBox;
# Line 88  type Line 92  type
92      PanelManglendePakker4: TPanel;      PanelManglendePakker4: TPanel;
93      PanelManglendePakker5: TPanel;      PanelManglendePakker5: TPanel;
94      PanelManglendePakker6: TPanel;      PanelManglendePakker6: TPanel;
95        menuIndlevering: TMenuItem;
96    
97    
98    function Explode(var a: TStrArray; Border, S: string): Integer;    function Explode(var a: TStrArray; Border, S: string): Integer;
99    function BarCodeValid (ACode: string): boolean;    function BarCodeValid (ACode: string): boolean;
100    function Sto_GetFmtFileVersion(const FileName: String = ''; const Fmt: String = '%d.%d.%d.%d'): String;    function Sto_GetFmtFileVersion(const FileName: String = ''): String;
101    function TColorToHex(Color : TColor) : string;    function TColorToHex(Color : TColor) : string;
102    function HexToTColor(sColor : string) : TColor;    function HexToTColor(sColor : string) : TColor;
103    function getProddato() : TDate;    function getProddato() : TDate;
# Line 146  type Line 151  type
151    procedure UploadButton01Click(Sender: TObject);    procedure UploadButton01Click(Sender: TObject);
152    procedure DownloadButton03Click(Sender: TObject);    procedure DownloadButton03Click(Sender: TObject);
153    procedure Pakkeshoplevering1Click(Sender: TObject);    procedure Pakkeshoplevering1Click(Sender: TObject);
154    procedure PakkeshopNulstilClick(Sender: TObject);    procedure btnNulstilClick(Sender: TObject);
155    procedure Returpakkerfrapakkeshop1Click(Sender: TObject);    procedure Returpakkerfrapakkeshop1Click(Sender: TObject);
156    procedure InitNatxpresslevering();    procedure InitNatxpresslevering();
157    procedure InitReturFraDao();    procedure InitReturFraDao();
# Line 161  type Line 166  type
166    procedure EKLoverforselClick(Sender: TObject);    procedure EKLoverforselClick(Sender: TObject);
167    procedure Uploadlogfil1Click(Sender: TObject);    procedure Uploadlogfil1Click(Sender: TObject);
168    procedure Manual1Click(Sender: TObject);    procedure Manual1Click(Sender: TObject);
   procedure CheckPrintQue(tjektype : string);  
169    procedure Timer1Timer(Sender: TObject);    procedure Timer1Timer(Sender: TObject);
170    procedure Scanogstjekkoden1Click(Sender: TObject);    procedure Scanogstjekkoden1Click(Sender: TObject);
171    procedure chkScanTjekkodeClick(Sender: TObject);    procedure chkScanTjekkodeClick(Sender: TObject);
# Line 181  type Line 185  type
185    procedure SletLogfiler(Path: string; FileList: TStrings);    procedure SletLogfiler(Path: string; FileList: TStrings);
186    procedure Manualgenerel1Click(Sender: TObject);    procedure Manualgenerel1Click(Sender: TObject);
187    procedure TjekkerUrls();    procedure TjekkerUrls();
188  // 20150310: start  
189    procedure RoundCornerOf(Control: TWinControl);    procedure RoundCornerOf(Control: TWinControl);
190      procedure menuIndleveringClick(Sender: TObject);
191    
192      procedure PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
193      procedure CheckPrintQue(tjektype : string);
194    
 // 20150310: slut  
195    
196    private    private
197      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 199  type
199      SkrivLog : String;      SkrivLog : String;
200      Sted : String;      Sted : String;
201      StedNavn : String;      StedNavn : String;
202      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;
203  // 29150330: start  // 29150330: start
204      UrlEKLoverforselPakkeshop : String;      UrlEKLoverforselPakkeshop : String;
205  // 20150330: slut  // 20150330: slut
# Line 248  type Line 254  type
254      BoghandlerStregkode, BoghandlerTjekkode : String;      BoghandlerStregkode, BoghandlerTjekkode : String;
255      TjekUrls : String;      TjekUrls : String;
256    
257        Barcode : TStBarcode;
258    
259            function CheckSumModulo10(const data:string):string;          { used for EAN 8/13 }            function CheckSumModulo10(const data:string):string;          { used for EAN 8/13 }
260    
261      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 = '');
# Line 266  type Line 274  type
274      { Public declarations }      { Public declarations }
275    end;    end;
276    
277          function GetPixelsPerInchX(): Integer;
278        function GetPixelsPerInchY(): Integer;
279    
280  var  var
281    MainForm: TMainForm;    MainForm: TMainForm;
282    
# Line 304  begin Line 315  begin
315      StaticTextManglendePakker.Caption := '';      StaticTextManglendePakker.Caption := '';
316  // 20150309: slut  // 20150309: slut
317    
318        Barcode := TStBarcode.Create(MainForm);//Dynamisk oprettelse af Barcode component
319    
320      PanelValg1.Color := clBtnFace;      PanelValg1.Color := clBtnFace;
321      if PanelValg1.Enabled = true then      if PanelValg1.Enabled = true then
322      begin      begin
# Line 546  begin Line 559  begin
559    PrinterstatusStaticText1.Caption := '';    PrinterstatusStaticText1.Caption := '';
560    PrinterstatusStaticText1.Color := MainForm.Color;    PrinterstatusStaticText1.Color := MainForm.Color;
561    
562    PakkeshopNulstil.BringToFront;    btnNulstil.BringToFront;
563    
564    RoundCornerOf(PanelManglendePakker1);    RoundCornerOf(PanelManglendePakker1);
565    RoundCornerOf(PanelManglendePakker2);    RoundCornerOf(PanelManglendePakker2);
# Line 588  begin Line 601  begin
601      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');
602      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');
603      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');
604    
605        UrlIndleveringsPakke := ReadString('Settings','UrlIndleveringsPakke','http://omdeling.info/webservices/pakkeshop/PakkekontrolIndleveringskode.php?sted=%s&pakkekode=%s');
606    
607    
608      LabelType := ReadInteger('Settings','LabelType',1);      LabelType := ReadInteger('Settings','LabelType',1);
609      FarveNormal := ReadString('Settings','FarveNormal','D8D8D8');      FarveNormal := ReadString('Settings','FarveNormal','D8D8D8');
610      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 642  begin
642    
643      if (SkrivLog = '1') then      if (SkrivLog = '1') then
644      begin      begin
645        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);
646        try        try
647          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
648          Uploadlogfil1.Enabled := true;          Uploadlogfil1.Enabled := true;
# Line 834  begin Line 851  begin
851        PanelValg5.Font.Color := clInactiveCaption;        PanelValg5.Font.Color := clInactiveCaption;
852        PanelValg6.Enabled := false;        PanelValg6.Enabled := false;
853        PanelValg6.Font.Color := clInactiveCaption;        PanelValg6.Font.Color := clInactiveCaption;
854          PanelValg7.Enabled := false;
855          PanelValg7.Font.Color := clInactiveCaption;
856    
857       // her skal vi også disable de menupunkter DBK ikke kan bruge       // her skal vi også disable de menupunkter DBK ikke kan bruge
858        ReturpakkerfraDAO1.Enabled := false;        ReturpakkerfraDAO1.Enabled := false;
859        Returpakkerfraboghandler1.Enabled := false;        Returpakkerfraboghandler1.Enabled := false;
# Line 870  begin Line 890  begin
890        PanelValg5.Font.Color := clInactiveCaption;        PanelValg5.Font.Color := clInactiveCaption;
891        PanelValg6.Enabled := false;        PanelValg6.Enabled := false;
892        PanelValg6.Font.Color := clInactiveCaption;        PanelValg6.Font.Color := clInactiveCaption;
893          PanelValg7.Enabled := false;
894          PanelValg7.Font.Color := clInactiveCaption;
895       // 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
896    
897        Automatiskvalg1.Enabled := false;        Automatiskvalg1.Enabled := false;
# Line 965  begin Line 987  begin
987             RutenummerST.Caption := '';             RutenummerST.Caption := '';
988             BoghandlerNavnST.Caption := 'Fejl i urls';             BoghandlerNavnST.Caption := 'Fejl i urls';
989             KommentarST.Caption := 'Se log vinduet';             KommentarST.Caption := 'Se log vinduet';
990             PakkeshopNulstil.Visible := true;             btnNulstil.Visible := true;
991             exit;             exit;
992          end;          end;
993      end      end
# Line 1134  begin Line 1156  begin
1156      Scanningtype := gemScanningtype;      Scanningtype := gemScanningtype;
1157    
1158      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');
1159      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion('',''));      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion(''));
1160    
1161  end;  end;
1162    
# Line 1214  begin Line 1236  begin
1236    
1237      if StregKode = 'Nulstil' then      if StregKode = 'Nulstil' then
1238      begin      begin
1239         PakkeshopNulstil.Click();         btnNulstil.Click();
1240         exit;         exit;
1241      end;      end;
1242    
1243      if PakkeshopNulstil.Visible then      if btnNulstil.Visible then
1244      begin      begin
1245        VisAlarmSkaerm( 'HUSK at klikke Nulstil før ny scanning...' );        VisAlarmSkaerm( 'HUSK at klikke Nulstil før ny scanning...' );
1246    
# Line 1543  begin Line 1565  begin
1565             BoghandlerStregkode := Stregkode;             BoghandlerStregkode := Stregkode;
1566             BoghandlerTjekkode := '';             BoghandlerTjekkode := '';
1567             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1568             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1569             Stregkode := '';             Stregkode := '';
1570             InitScreen();             InitScreen();
1571        end        end
# Line 1555  begin Line 1577  begin
1577             BoghandlerStregkode := Stregkode;             BoghandlerStregkode := Stregkode;
1578             BoghandlerTjekkode := '-1';             BoghandlerTjekkode := '-1';
1579             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1580             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1581             Stregkode := '';             Stregkode := '';
1582             InitScreen();             InitScreen();
1583        end        end
# Line 1589  begin Line 1611  begin
1611                MainForm.Color := HexToTColor(FarvePakkeshoplevering);                MainForm.Color := HexToTColor(FarvePakkeshoplevering);
1612             if (Pakkernormal1.Checked) then             if (Pakkernormal1.Checked) then
1613                MainForm.Color := HexToTColor(FarveNormal);                MainForm.Color := HexToTColor(FarveNormal);
1614             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1615           end           end
1616          else          else
1617           begin           begin
# Line 1621  begin Line 1643  begin
1643            // Hvis der var sql fejl i opdateringen skal dette fejlmeldes her            // Hvis der var sql fejl i opdateringen skal dette fejlmeldes her
1644            if Rutenummer = 'sql fejl' then            if Rutenummer = 'sql fejl' then
1645            begin   // Her skal komme en alarm og rød skærm            begin   // Her skal komme en alarm og rød skærm
1646               PlaySound(PWideChar(AlarmLyd));               VisAlarmSkaerm( 'SQL fejl: ' + Kommentar );
1647               //List1msg := 'SQL fejl: ' + Kommentar;  
              //ListBox1.Items.Insert(0,List1Msg);  
              MainForm.Color := clRed;  
              //KommentarST.Caption := List1msg;  
              PakkeshopNulstil.Visible := true;  
1648              exit;              exit;
1649            end;            end;
1650            if (Pakkernormal1.Checked or Budlevering1.Checked or PakkeshopLevering1.Checked) then            if (Pakkernormal1.Checked or Budlevering1.Checked or PakkeshopLevering1.Checked) then
# Line 1646  begin Line 1664  begin
1664              if (pakkeErScannet > 0) or (pakkeForkertSted > 0) or (tjekkodemangler > 0) then              if (pakkeErScannet > 0) or (pakkeForkertSted > 0) or (tjekkodemangler > 0) then
1665              begin              begin
1666                PlaySound(PWideChar(AlarmLyd));                PlaySound(PWideChar(AlarmLyd));
1667                PakkeshopNulstil.Visible := true;                btnNulstil.Visible := true;
1668                MainForm.Color := clRed;                MainForm.Color := clRed;
1669              end;              end;
1670           end;           end;
# Line 1661  begin Line 1679  begin
1679              begin              begin
1680                PlaySound(PWideChar(ScannetOkLyd));                PlaySound(PWideChar(ScannetOkLyd));
1681              end;              end;
1682              PakkeshopNulstil.Visible := false;              btnNulstil.Visible := false;
1683            end            end
1684            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then
1685            begin            begin
# Line 1674  begin Line 1692  begin
1692              begin              begin
1693                PlaySound(PWideChar(ScannetOkLyd));                PlaySound(PWideChar(ScannetOkLyd));
1694              end;              end;
1695              PakkeshopNulstil.Visible := false;              btnNulstil.Visible := false;
1696            end            end
1697            else if Copy(Kommentar,1,8) = 'OPRETTET' then            else if Copy(Kommentar,1,8) = 'OPRETTET' then
1698            begin            begin
# Line 1685  begin Line 1703  begin
1703            end            end
1704            else            else
1705            begin            begin
1706              MainForm.Color := clRed;              VisAlarmSkaerm('');
             PlaySound(PWideChar(AlarmLyd));  
             PakkeshopNulstil.Visible := true;  
1707            end;            end;
1708           if not PakkeshopNulstil.Visible then           if not btnNulstil.Visible then
1709            begin            begin
1710    
1711              If (Budlevering1.Checked) then              If (Budlevering1.Checked) then
# Line 2060  var Line 2076  var
2076    URLStr : String;    URLStr : String;
2077    pakkestorrelse : String;    pakkestorrelse : String;
2078    PrintNyLabelInteger : Integer;    PrintNyLabelInteger : Integer;
2079    
2080      PakkeshopLabel: TPakkeshopLabel;
2081  begin  begin
2082    if radioStorPakke.Checked then    if radioStorPakke.Checked then
2083    begin    begin
# Line 2069  begin Line 2087  begin
2087    begin    begin
2088      pakkestorrelse := 'Lille';      pakkestorrelse := 'Lille';
2089    end;    end;
2090    
2091    
2092    if Pakkernormal1.Checked then    if Pakkernormal1.Checked then
2093    begin    begin
2094       if (BoghandlerTjekkode = '') then       if (BoghandlerTjekkode = '') then
# Line 2097  begin Line 2117  begin
2117    begin    begin
2118       URLStr := Format(UrlReturPakkeshop,[Sted, PakkeNr]);       URLStr := Format(UrlReturPakkeshop,[Sted, PakkeNr]);
2119    end    end
2120      else if menuIndlevering.Checked then
2121      begin
2122        URLStr := Format(UrlIndleveringsPakke,[Sted, PakkeNr]);
2123      end
2124    else    else
2125    begin    begin
2126      exit;      exit;
# Line 2143  begin Line 2167  begin
2167          begin          begin
2168            PrintNyLabel := True;            PrintNyLabel := True;
2169          end;          end;
 // 20150310: start  
2170        end;        end;
 // 20150310: slut  
2171       end       end
2172        else if menuIndlevering.Checked then
2173        begin
2174    
2175    
2176    
2177    
2178         Kommentar := XMLDocument1.ChildNodes.FindNode('PakkeKontrol').ChildNodes.FindNode('Stregkodematch').Text;
2179         if (Kommentar = 'Ok') then
2180         begin
2181           PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label
2182           PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc
2183           RuteNummer := PakkeshopLabel.Koreliste;
2184    
2185           PrintPakkeshopLabel( PakkeshopLabel );
2186    
2187         end;
2188    
2189    
2190        end
2191      else      else
2192       begin       begin
2193        RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text;        RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text;
# Line 2179  begin Line 2220  begin
2220          PrintNyLabel := True;          PrintNyLabel := True;
2221        end;        end;
2222      end;      end;
2223    
2224    
2225      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
2226      begin      begin
2227        if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then        if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then
# Line 2338  begin Line 2381  begin
2381    
2382          PlaySound(PWideChar(AlarmLyd));          PlaySound(PWideChar(AlarmLyd));
2383          MainForm.Color := clRed;          MainForm.Color := clRed;
2384          PakkeshopNulstil.Visible := true;          btnNulstil.Visible := true;
2385    
2386       end       end
2387       else       else
# Line 2365  begin Line 2408  begin
2408            begin            begin
2409              PlaySound(PWideChar(AlarmLyd));              PlaySound(PWideChar(AlarmLyd));
2410              MainForm.Color := clRed;              MainForm.Color := clRed;
2411              PakkeshopNulstil.Visible := true;              btnNulstil.Visible := true;
2412            end;            end;
2413    
2414         end;         end;
# Line 2391  begin Line 2434  begin
2434            begin            begin
2435              PlaySound(PWideChar(AlarmLyd));              PlaySound(PWideChar(AlarmLyd));
2436              MainForm.Color := clRed;              MainForm.Color := clRed;
2437              PakkeshopNulstil.Visible := true;              btnNulstil.Visible := true;
2438            end;            end;
2439    
2440         end;         end;
# Line 2415  begin Line 2458  begin
2458                end;                end;
2459              end;              end;
2460        01 :  begin;        01 :  begin;
2461               if PrintNyLabel and ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then               if PrintNyLabel or ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then
2462                    // 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
2463                    // 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')
2464                begin                begin
# Line 2429  begin Line 2472  begin
2472                end;                end;
2473              end;              end;
2474        03 :  begin;        03 :  begin;
2475               if PrintNyLabel and ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then               if PrintNyLabel or ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then
2476                    // 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
2477                    // 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')
2478               begin               begin
# Line 3038  begin Line 3081  begin
3081      repeat      repeat
3082        if (SR.Attr <> faDirectory) then        if (SR.Attr <> faDirectory) then
3083        begin        begin
3084    
3085          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring
3086          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse
3087          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse
# Line 3077  begin Line 3121  begin
3121    end;    end;
3122  end;  end;
3123    
3124  procedure TMainForm.PakkeshopNulstilClick(Sender: TObject);  procedure TMainForm.btnNulstilClick(Sender: TObject);
3125  begin  begin
3126    PakkeshopStregkode := '';    PakkeshopStregkode := '';
3127    PakkeshopTjekkode := '';    PakkeshopTjekkode := '';
3128    PakkeshopNulstil.Visible := false;    btnNulstil.Visible := false;
3129    PakkeshopText1.Caption := 'Stregkode';    PakkeshopText1.Caption := 'Stregkode';
3130    BoghandlerStregkode := '';    BoghandlerStregkode := '';
3131    BoghandlerTjekkode := '';    BoghandlerTjekkode := '';
# Line 3231  begin Line 3275  begin
3275      // Her kommer en alarm og rød skærm      // Her kommer en alarm og rød skærm
3276      PlaySound(PWideChar(AlarmLyd));      PlaySound(PWideChar(AlarmLyd));
3277      MainForm.Color := clRed;      MainForm.Color := clRed;
3278      PakkeshopNulstil.Visible := true;      btnNulstil.Visible := true;
3279    end    end
3280    else    else
3281    begin    begin
# Line 3337  var Line 3381  var
3381   tekst, filversion : String;   tekst, filversion : String;
3382  begin  begin
3383    
3384    filversion := Sto_GetFmtFileVersion('','');    filversion := Sto_GetFmtFileVersion('');
3385    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';
3386    
3387    tekst := tekst+crlf+crlf;    tekst := tekst+crlf+crlf;
# Line 3472  begin Line 3516  begin
3516    end;    end;
3517  end;  end;
3518    
3519    procedure TMainForm.menuIndleveringClick(Sender: TObject);
3520    begin
3521      Scanningtype := '7';
3522      NulstilAutomatiskValg();
3523      InitIndleveringskode();
3524    end;
3525    
3526  procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject);  procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject);
3527  begin  begin
3528    
# Line 3504  end; Line 3555  end;
3555  procedure TMainForm.InitNatxpresslevering();  procedure TMainForm.InitNatxpresslevering();
3556  begin  begin
3557        AutomatiskTjekkodeStyring1.Enabled := true;        AutomatiskTjekkodeStyring1.Enabled := true;
3558        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3559        Pakkernormal1.Checked := true;        Pakkernormal1.Checked := true;
3560        InitForm(FarveNormal,TitelNormal,UrlNormal);        InitForm(FarveNormal,TitelNormal,UrlNormal);
3561        PanelValg1.Color := clGreen;        PanelValg1.Color := clGreen;
# Line 3537  procedure TMainForm.InitReturFraDao(); Line 3588  procedure TMainForm.InitReturFraDao();
3588  begin  begin
3589        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3590        ReturpakkerfraDAO1.Checked := true;        ReturpakkerfraDAO1.Checked := true;
3591        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3592        InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO);        InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO);
3593        PanelValg2.Color := clGreen;        PanelValg2.Color := clGreen;
3594        PanelValg2.Font.Color := clWhite;        PanelValg2.Font.Color := clWhite;
# Line 3564  procedure TMainForm.InitReturFraKunde(); Line 3615  procedure TMainForm.InitReturFraKunde();
3615  begin  begin
3616        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3617        Returpakkerfraboghandler1.Checked := true;        Returpakkerfraboghandler1.Checked := true;
3618        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3619        InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler);        InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler);
3620        PanelValg3.Color := clGreen;        PanelValg3.Color := clGreen;
3621        PanelValg3.Font.Color := clWhite;        PanelValg3.Font.Color := clWhite;
# Line 3590  procedure TMainForm.InitDirektelevering( Line 3641  procedure TMainForm.InitDirektelevering(
3641  begin  begin
3642        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3643        Budlevering1.Checked := true;        Budlevering1.Checked := true;
3644        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3645        InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering);        InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering);
3646        PanelValg4.Color := clGreen;        PanelValg4.Color := clGreen;
3647        PanelValg4.Font.Color := clWhite;        PanelValg4.Font.Color := clWhite;
# Line 3626  procedure TMainForm.InitPakkeshopleverin Line 3677  procedure TMainForm.InitPakkeshopleverin
3677  begin  begin
3678        AutomatiskTjekkodeStyring1.Enabled := true;        AutomatiskTjekkodeStyring1.Enabled := true;
3679        Pakkeshoplevering1.Checked := true;        Pakkeshoplevering1.Checked := true;
3680        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3681        InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering);        InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering);
3682        PanelValg5.Color := clGreen;        PanelValg5.Color := clGreen;
3683        PanelValg5.Font.Color := clWhite;        PanelValg5.Font.Color := clWhite;
# Line 3663  procedure TMainForm.InitReturFraPakkesho Line 3714  procedure TMainForm.InitReturFraPakkesho
3714  begin  begin
3715        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3716        Returpakkerfrapakkeshop1.Checked := true;        Returpakkerfrapakkeshop1.Checked := true;
3717        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3718        InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop);        InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop);
3719        PanelValg6.Color := clGreen;        PanelValg6.Color := clGreen;
3720        PanelValg6.Font.Color := clWhite;        PanelValg6.Font.Color := clWhite;
# Line 3703  end; Line 3754  end;
3754    
3755  procedure TMainForm.InitIndleveringskode();  procedure TMainForm.InitIndleveringskode();
3756  begin  begin
3757          menuIndlevering.Checked := true;
3758        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3759        Returpakkerfrapakkeshop1.Checked := true;  
3760        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3761        InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop);        InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop);
3762        PanelValg7.Color := clGreen;        PanelValg7.Color := clGreen;
3763        PanelValg7.Font.Color := clWhite;        PanelValg7.Font.Color := clWhite;
# Line 3783  end; Line 3835  end;
3835  ///   values.</param>  ///   values.</param>
3836  /// <returns>Formatted version number of file, '' if no version  /// <returns>Formatted version number of file, '' if no version
3837  ///   resource found.</returns>  ///   resource found.</returns>
3838  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = '';  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = ''): String;
   const Fmt: String = '%d.%d.%d.%d'): String;  
3839  var  var
3840    sFileName: String;    sFileName: String;
3841    iBufferSize: DWORD;    iBufferSize: DWORD;
3842    iDummy: DWORD;    iDummy: DWORD;
3843    pBuffer: Pointer;    pBuffer: Pointer;
3844    pFileInfo: Pointer;    pFileInfo: Pointer;
3845    iVer: array[1..4] of Word;    iVer: array[1..4] of Integer;
   S : String;  
3846  begin  begin
3847    // set default value    // set default value
3848    Result := '';    Result := '';
# Line 3817  begin Line 3867  begin
3867      finally      finally
3868        FreeMem(pBuffer);        FreeMem(pBuffer);
3869      end;      end;
3870    
3871      // format result string      // format result string
3872      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]]);
3873    
     // 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;  
3874    end;    end;
3875  end;  end;
3876    
# Line 3993  begin Line 4033  begin
4033           BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...';           BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...';
4034         end;         end;
4035         KommentarST.Caption := Kommentar;         KommentarST.Caption := Kommentar;
4036         PakkeshopNulstil.Visible := true;         btnNulstil.Visible := true;
4037      end;      end;
4038    
4039  end;  end;
# Line 4579  begin Line 4619  begin
4619    until S2 = '';    until S2 = '';
4620  end;  end;
4621    
4622    // ToDo: PrintPakkeshopLabel()
4623    procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
4624    var
4625      XForm, XFormOld: TXForm; //Bruges til rotate X-formation
4626      Angle: integer;
4627      gMode: integer;
4628      BarcodeArea: TRect;
4629      Dirigering: string;
4630    
4631    begin
4632        with Printer do
4633        begin
4634          BeginDoc();
4635    
4636    
4637          Canvas.Font.Size := 16;
4638          Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);
4639    
4640    
4641    
4642          Canvas.TextOut(25, 90, PakkeshopLabel.Navn );
4643          Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn );
4644          Canvas.TextOut(25, 180, PakkeshopLabel.Postnr );
4645    
4646    
4647          Canvas.Font.Size := 9;
4648          Canvas.TextOut(110, 240, 'Pakkeshop:');
4649          Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);
4650          Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);
4651          Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);
4652    
4653          Canvas.TextOut(350, 240, 'Afsender:');
4654          Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);
4655          Canvas.TextOut(350, 300, PakkeshopLabel.AfsenderAdresse);
4656          Canvas.TextOut(350, 330, PakkeshopLabel.AfsenderPostnr);
4657    
4658          Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr;
4659          if ( PakkeshopLabel.Koreliste <> '') then
4660          begin
4661            Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
4662          end;
4663    
4664    
4665          Canvas.Font.Size := 12;
4666          Canvas.TextOut(15, 370, Dirigering);
4667    
4668    
4669    
4670    
4671    
4672          //Tegn adskillelses linier
4673          Canvas.Pen.Width := 2;
4674          //Øverste linie
4675          Canvas.MoveTo(20,80);
4676          Canvas.LineTo(600,80);
4677    
4678          // Midterste linie
4679          Canvas.MoveTo( 20, 240);
4680          Canvas.LineTo(600, 240);
4681    
4682          //Nederste linie
4683          Canvas.MoveTo( 20, 370);
4684          Canvas.LineTo(600, 370);
4685    
4686    
4687          //Tegn skrå streger over afsender
4688          Canvas.Pen.Width := 1;
4689          Canvas.MoveTo(600, 250);
4690          Canvas.LineTo(350, 360);
4691          Canvas.MoveTo(600, 360);
4692          Canvas.LineTo(350, 250);
4693    
4694    
4695    
4696    
4697          // Resten af rutinen vedr genering og placering af Barcode
4698    
4699          BarCode.BarCodeType := bcCode128;
4700          BarCode.Code128Subset := csCodeC;
4701          BarCode.Code := PakkeshopLabel.Stregkode;
4702          BarCode.Validate(True);
4703    
4704          //Start X-formation
4705          //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
4706          GetWorldTransform(Canvas.Handle, XFormOld);
4707    
4708          Angle := 270;
4709          XForm.eM11 := Cos(DegToRad(Angle));
4710          XForm.eM12 := Sin(DegToRad(Angle));
4711          XForm.eM21 := -Sin(DegToRad(Angle));
4712          XForm.eM22 := Cos(DegToRad(Angle));
4713          XForm.eDx := 0;
4714          XForm.eDy := 0;
4715    
4716          gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
4717          SetWorldTransform(Canvas.Handle, XForm);
4718    
4719          // PaintToCanvasSize arbejder i Inches
4720          // Første pos argument bliver nu Y og skal være negativ for at rykke den ned
4721          //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre
4722    
4723          BarCode.PaintToCanvasSize(Printer.Canvas, -1.8, 3.3, 0.4);
4724    
4725    
4726          SetWorldTransform(Canvas.Handle, XFormOld);
4727          SetGraphicsMode(Canvas.Handle, gMode);
4728    
4729          EndDoc();
4730        end;
4731    
4732    
4733    end;
4734    
4735    function GetPixelsPerInchX(): Integer;
4736    begin
4737      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)
4738    end;
4739    
4740    function GetPixelsPerInchY(): Integer;
4741    begin
4742      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
4743    end;
4744    
4745    
4746  procedure TMainForm.IndlesManglendeScanninger();  procedure TMainForm.IndlesManglendeScanninger();
4747  var  var
4748    WebSvar : String;    WebSvar : String;
# Line 4934  var Line 5098  var
5098     idag, imorgen : TDateTime;     idag, imorgen : TDateTime;
5099     imorgenYmd : string;     imorgenYmd : string;
5100     logFilnavn : string;     logFilnavn : string;
5101      error : Integer;     //error : Integer;
5102    
5103  begin  begin
5104    if (SkrivLog = '1') then    if (SkrivLog = '1') then
# Line 5203  begin Line 5367  begin
5367    //ShowMessage('Ændring ikke tilladt');    //ShowMessage('Ændring ikke tilladt');
5368    // Her skal komme en 'rød skærm' alarm    // Her skal komme en 'rød skærm' alarm
5369    PlaySound(PWideChar(AlarmLyd));    PlaySound(PWideChar(AlarmLyd));
   
   ListBox1.Items.Insert(0, strMessage);  
5370    MainForm.Color := clRed;    MainForm.Color := clRed;
5371    
5372    
5373    RuteNummerST.Caption := '';    RuteNummerST.Caption := '';
5374    BoghandlerNavnST.Caption := '';    BoghandlerNavnST.Caption := '';
5375    KommentarST.Caption := strMessage;    btnNulstil.Visible := true;
5376    PakkeshopNulstil.Visible := true;  
5377      if (strMessage <> '') then
5378      begin
5379        ListBox1.Items.Insert(0, strMessage);
5380        KommentarST.Caption := strMessage;
5381      end;
5382    
5383  end;  end;
5384    
5385  function TMainForm.getProddato() : TDate;  function TMainForm.getProddato() : TDate;
# Line 5313  begin Line 5483  begin
5483    AReg.Free;    AReg.Free;
5484  end;  end;
5485    
5486    
5487    function TMainForm.CheckUrl(url:string):boolean;
5488    var
5489      hSession, hfile: hInternet;
5490      dwindex,dwcodelen :dword;
5491      dwcode:array[1..20] of char;
5492      res : pchar;
5493    begin
5494      if pos('http://',lowercase(url))=0 then
5495        url := 'http://'+url;
5496      Result := false;
5497      hSession := InternetOpen('InetURL:/1.0',
5498                                INTERNET_OPEN_TYPE_PRECONFIG,
5499                                nil,
5500                                nil,
5501                                0);
5502      if assigned(hsession) then
5503      begin
5504        hfile := InternetOpenUrl(hsession,
5505                                 pchar(url),
5506                                 nil,
5507                                 0,
5508                                 INTERNET_FLAG_RELOAD,
5509                                 0);
5510        dwIndex := 0;
5511        dwCodeLen := 10;
5512        HttpQueryInfo(hfile,
5513                      HTTP_QUERY_STATUS_CODE,
5514                      @dwcode,
5515                      dwcodeLen,
5516                      dwIndex);
5517        res := pchar(@dwcode);
5518        result:= (res ='200') or (res ='302');
5519        if assigned(hfile) then
5520          InternetCloseHandle(hfile);
5521        InternetCloseHandle(hsession);
5522      end;
5523    
5524    end;
5525    
5526    
5527    procedure TMainForm.RoundCornerOf(Control: TWinControl);
5528    var
5529       R: TRect;
5530       Rgn: HRGN;
5531    begin
5532       with Control do
5533       begin
5534         R := ClientRect;
5535    //     rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 20, 20) ;
5536         rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 25, 25) ;
5537    //     rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 30, 30) ;
5538         Perform(EM_GETRECT, 0, lParam(@r)) ;
5539         InflateRect(r, - 4, - 4) ;
5540         Perform(EM_SETRECTNP, 0, lParam(@r)) ;
5541         SetWindowRgn(Handle, rgn, True) ;
5542         Invalidate;
5543       end;
5544    end;
5545    
5546  procedure TMainForm.CheckPrintQue(tjektype : string);  procedure TMainForm.CheckPrintQue(tjektype : string);
5547  type  type
5548    TJobs  = array [0..1000] of JOB_INFO_1;    TJobs  = array [0..1000] of JOB_INFO_1;
# Line 5416  begin Line 5646  begin
5646    end;    end;
5647  end;  end;
5648    
 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  
5649    
5650  end.  end.
5651    
Legend:
Removed from v.2660  
changed lines
  Added in v.2679
  ViewVC Help
Powered by ViewVC 1.1.20