/[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 2662 by torben, Sun Aug 23 15:06:19 2015 UTC revision 2678 by torben, Wed Aug 26 13:20:47 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 1642  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 1657  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 1670  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 1683  begin Line 1705  begin
1705            begin            begin
1706              VisAlarmSkaerm('');              VisAlarmSkaerm('');
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 2054  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 2063  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 2091  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 2137  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    
2184           PrintPakkeshopLabel( PakkeshopLabel );
2185    
2186         end;
2187    
2188    
2189        end
2190      else      else
2191       begin       begin
2192        RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text;        RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text;
# Line 2173  begin Line 2219  begin
2219          PrintNyLabel := True;          PrintNyLabel := True;
2220        end;        end;
2221      end;      end;
2222    
2223    
2224      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
2225      begin      begin
2226        if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then        if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then
# Line 2332  begin Line 2380  begin
2380    
2381          PlaySound(PWideChar(AlarmLyd));          PlaySound(PWideChar(AlarmLyd));
2382          MainForm.Color := clRed;          MainForm.Color := clRed;
2383          PakkeshopNulstil.Visible := true;          btnNulstil.Visible := true;
2384    
2385       end       end
2386       else       else
# Line 2359  begin Line 2407  begin
2407            begin            begin
2408              PlaySound(PWideChar(AlarmLyd));              PlaySound(PWideChar(AlarmLyd));
2409              MainForm.Color := clRed;              MainForm.Color := clRed;
2410              PakkeshopNulstil.Visible := true;              btnNulstil.Visible := true;
2411            end;            end;
2412    
2413         end;         end;
# Line 2385  begin Line 2433  begin
2433            begin            begin
2434              PlaySound(PWideChar(AlarmLyd));              PlaySound(PWideChar(AlarmLyd));
2435              MainForm.Color := clRed;              MainForm.Color := clRed;
2436              PakkeshopNulstil.Visible := true;              btnNulstil.Visible := true;
2437            end;            end;
2438    
2439         end;         end;
# Line 3032  begin Line 3080  begin
3080      repeat      repeat
3081        if (SR.Attr <> faDirectory) then        if (SR.Attr <> faDirectory) then
3082        begin        begin
3083    
3084          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring
3085          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse
3086          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse
# Line 3071  begin Line 3120  begin
3120    end;    end;
3121  end;  end;
3122    
3123  procedure TMainForm.PakkeshopNulstilClick(Sender: TObject);  procedure TMainForm.btnNulstilClick(Sender: TObject);
3124  begin  begin
3125    PakkeshopStregkode := '';    PakkeshopStregkode := '';
3126    PakkeshopTjekkode := '';    PakkeshopTjekkode := '';
3127    PakkeshopNulstil.Visible := false;    btnNulstil.Visible := false;
3128    PakkeshopText1.Caption := 'Stregkode';    PakkeshopText1.Caption := 'Stregkode';
3129    BoghandlerStregkode := '';    BoghandlerStregkode := '';
3130    BoghandlerTjekkode := '';    BoghandlerTjekkode := '';
# Line 3225  begin Line 3274  begin
3274      // Her kommer en alarm og rød skærm      // Her kommer en alarm og rød skærm
3275      PlaySound(PWideChar(AlarmLyd));      PlaySound(PWideChar(AlarmLyd));
3276      MainForm.Color := clRed;      MainForm.Color := clRed;
3277      PakkeshopNulstil.Visible := true;      btnNulstil.Visible := true;
3278    end    end
3279    else    else
3280    begin    begin
# Line 3331  var Line 3380  var
3380   tekst, filversion : String;   tekst, filversion : String;
3381  begin  begin
3382    
3383    filversion := Sto_GetFmtFileVersion('','');    filversion := Sto_GetFmtFileVersion('');
3384    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';
3385    
3386    tekst := tekst+crlf+crlf;    tekst := tekst+crlf+crlf;
# Line 3466  begin Line 3515  begin
3515    end;    end;
3516  end;  end;
3517    
3518    procedure TMainForm.menuIndleveringClick(Sender: TObject);
3519    begin
3520      Scanningtype := '7';
3521      NulstilAutomatiskValg();
3522      InitIndleveringskode();
3523    end;
3524    
3525  procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject);  procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject);
3526  begin  begin
3527    
# Line 3498  end; Line 3554  end;
3554  procedure TMainForm.InitNatxpresslevering();  procedure TMainForm.InitNatxpresslevering();
3555  begin  begin
3556        AutomatiskTjekkodeStyring1.Enabled := true;        AutomatiskTjekkodeStyring1.Enabled := true;
3557        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3558        Pakkernormal1.Checked := true;        Pakkernormal1.Checked := true;
3559        InitForm(FarveNormal,TitelNormal,UrlNormal);        InitForm(FarveNormal,TitelNormal,UrlNormal);
3560        PanelValg1.Color := clGreen;        PanelValg1.Color := clGreen;
# Line 3531  procedure TMainForm.InitReturFraDao(); Line 3587  procedure TMainForm.InitReturFraDao();
3587  begin  begin
3588        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3589        ReturpakkerfraDAO1.Checked := true;        ReturpakkerfraDAO1.Checked := true;
3590        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3591        InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO);        InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO);
3592        PanelValg2.Color := clGreen;        PanelValg2.Color := clGreen;
3593        PanelValg2.Font.Color := clWhite;        PanelValg2.Font.Color := clWhite;
# Line 3558  procedure TMainForm.InitReturFraKunde(); Line 3614  procedure TMainForm.InitReturFraKunde();
3614  begin  begin
3615        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3616        Returpakkerfraboghandler1.Checked := true;        Returpakkerfraboghandler1.Checked := true;
3617        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3618        InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler);        InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler);
3619        PanelValg3.Color := clGreen;        PanelValg3.Color := clGreen;
3620        PanelValg3.Font.Color := clWhite;        PanelValg3.Font.Color := clWhite;
# Line 3584  procedure TMainForm.InitDirektelevering( Line 3640  procedure TMainForm.InitDirektelevering(
3640  begin  begin
3641        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3642        Budlevering1.Checked := true;        Budlevering1.Checked := true;
3643        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3644        InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering);        InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering);
3645        PanelValg4.Color := clGreen;        PanelValg4.Color := clGreen;
3646        PanelValg4.Font.Color := clWhite;        PanelValg4.Font.Color := clWhite;
# Line 3620  procedure TMainForm.InitPakkeshopleverin Line 3676  procedure TMainForm.InitPakkeshopleverin
3676  begin  begin
3677        AutomatiskTjekkodeStyring1.Enabled := true;        AutomatiskTjekkodeStyring1.Enabled := true;
3678        Pakkeshoplevering1.Checked := true;        Pakkeshoplevering1.Checked := true;
3679        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3680        InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering);        InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering);
3681        PanelValg5.Color := clGreen;        PanelValg5.Color := clGreen;
3682        PanelValg5.Font.Color := clWhite;        PanelValg5.Font.Color := clWhite;
# Line 3657  procedure TMainForm.InitReturFraPakkesho Line 3713  procedure TMainForm.InitReturFraPakkesho
3713  begin  begin
3714        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3715        Returpakkerfrapakkeshop1.Checked := true;        Returpakkerfrapakkeshop1.Checked := true;
3716        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3717        InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop);        InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop);
3718        PanelValg6.Color := clGreen;        PanelValg6.Color := clGreen;
3719        PanelValg6.Font.Color := clWhite;        PanelValg6.Font.Color := clWhite;
# Line 3697  end; Line 3753  end;
3753    
3754  procedure TMainForm.InitIndleveringskode();  procedure TMainForm.InitIndleveringskode();
3755  begin  begin
3756          menuIndlevering.Checked := true;
3757        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3758        Returpakkerfrapakkeshop1.Checked := true;  
3759        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3760        InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop);        InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop);
3761        PanelValg7.Color := clGreen;        PanelValg7.Color := clGreen;
3762        PanelValg7.Font.Color := clWhite;        PanelValg7.Font.Color := clWhite;
# Line 3777  end; Line 3834  end;
3834  ///   values.</param>  ///   values.</param>
3835  /// <returns>Formatted version number of file, '' if no version  /// <returns>Formatted version number of file, '' if no version
3836  ///   resource found.</returns>  ///   resource found.</returns>
3837  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = '';  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = ''): String;
   const Fmt: String = '%d.%d.%d.%d'): String;  
3838  var  var
3839    sFileName: String;    sFileName: String;
3840    iBufferSize: DWORD;    iBufferSize: DWORD;
3841    iDummy: DWORD;    iDummy: DWORD;
3842    pBuffer: Pointer;    pBuffer: Pointer;
3843    pFileInfo: Pointer;    pFileInfo: Pointer;
3844    iVer: array[1..4] of Word;    iVer: array[1..4] of Integer;
   S : String;  
3845  begin  begin
3846    // set default value    // set default value
3847    Result := '';    Result := '';
# Line 3811  begin Line 3866  begin
3866      finally      finally
3867        FreeMem(pBuffer);        FreeMem(pBuffer);
3868      end;      end;
3869    
3870      // format result string      // format result string
3871      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]]);
3872    
     // 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;  
3873    end;    end;
3874  end;  end;
3875    
# Line 3987  begin Line 4032  begin
4032           BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...';           BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...';
4033         end;         end;
4034         KommentarST.Caption := Kommentar;         KommentarST.Caption := Kommentar;
4035         PakkeshopNulstil.Visible := true;         btnNulstil.Visible := true;
4036      end;      end;
4037    
4038  end;  end;
# Line 4573  begin Line 4618  begin
4618    until S2 = '';    until S2 = '';
4619  end;  end;
4620    
4621    // ToDo: PrintPakkeshopLabel()
4622    procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
4623    var
4624      XForm, XFormOld: TXForm; //Bruges til rotate X-formation
4625      Angle: integer;
4626      gMode: integer;
4627      BarcodeArea: TRect;
4628      Dirigering: string;
4629    
4630    begin
4631        with Printer do
4632        begin
4633          BeginDoc();
4634    
4635    
4636          Canvas.Font.Size := 16;
4637          Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);
4638    
4639    
4640    
4641          Canvas.TextOut(25, 90, PakkeshopLabel.Navn );
4642          Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn );
4643          Canvas.TextOut(25, 180, PakkeshopLabel.Postnr );
4644    
4645    
4646          Canvas.Font.Size := 9;
4647          Canvas.TextOut(110, 240, 'Pakkeshop:');
4648          Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);
4649          Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);
4650          Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);
4651    
4652          Canvas.TextOut(350, 240, 'Afsender:');
4653          Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);
4654          Canvas.TextOut(350, 300, PakkeshopLabel.AfsenderAdresse);
4655          Canvas.TextOut(350, 330, PakkeshopLabel.AfsenderPostnr);
4656    
4657          Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr;
4658          if ( PakkeshopLabel.Koreliste <> '') then
4659          begin
4660            Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
4661          end;
4662    
4663    
4664          Canvas.Font.Size := 12;
4665          Canvas.TextOut(15, 370, Dirigering);
4666    
4667    
4668    
4669    
4670    
4671          //Tegn adskillelses linier
4672          Canvas.Pen.Width := 2;
4673          //Øverste linie
4674          Canvas.MoveTo(20,80);
4675          Canvas.LineTo(600,80);
4676    
4677          // Midterste linie
4678          Canvas.MoveTo( 20, 240);
4679          Canvas.LineTo(600, 240);
4680    
4681          //Nederste linie
4682          Canvas.MoveTo( 20, 370);
4683          Canvas.LineTo(600, 370);
4684    
4685    
4686          //Tegn skrå streger over afsender
4687          Canvas.Pen.Width := 1;
4688          Canvas.MoveTo(600, 250);
4689          Canvas.LineTo(350, 360);
4690          Canvas.MoveTo(600, 360);
4691          Canvas.LineTo(350, 250);
4692    
4693    
4694    
4695    
4696          // Resten af rutinen vedr genering og placering af Barcode
4697    
4698          BarCode.BarCodeType := bcCode128;
4699          BarCode.Code128Subset := csCodeC;
4700          BarCode.Code := PakkeshopLabel.Stregkode;
4701          BarCode.Validate(True);
4702    
4703          //Start X-formation
4704          //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
4705          GetWorldTransform(Canvas.Handle, XFormOld);
4706    
4707          Angle := 270;
4708          XForm.eM11 := Cos(DegToRad(Angle));
4709          XForm.eM12 := Sin(DegToRad(Angle));
4710          XForm.eM21 := -Sin(DegToRad(Angle));
4711          XForm.eM22 := Cos(DegToRad(Angle));
4712          XForm.eDx := 0;
4713          XForm.eDy := 0;
4714    
4715          gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
4716          SetWorldTransform(Canvas.Handle, XForm);
4717    
4718          // PaintToCanvasSize arbejder i Inches
4719          // Første pos argument bliver nu Y og skal være negativ for at rykke den ned
4720          //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre
4721    
4722          BarCode.PaintToCanvasSize(Printer.Canvas, -1.8, 3.3, 0.4);
4723    
4724    
4725          SetWorldTransform(Canvas.Handle, XFormOld);
4726          SetGraphicsMode(Canvas.Handle, gMode);
4727    
4728          EndDoc();
4729        end;
4730    
4731    
4732    end;
4733    
4734    function GetPixelsPerInchX(): Integer;
4735    begin
4736      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)
4737    end;
4738    
4739    function GetPixelsPerInchY(): Integer;
4740    begin
4741      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
4742    end;
4743    
4744    
4745  procedure TMainForm.IndlesManglendeScanninger();  procedure TMainForm.IndlesManglendeScanninger();
4746  var  var
4747    WebSvar : String;    WebSvar : String;
# Line 4928  var Line 5097  var
5097     idag, imorgen : TDateTime;     idag, imorgen : TDateTime;
5098     imorgenYmd : string;     imorgenYmd : string;
5099     logFilnavn : string;     logFilnavn : string;
5100      error : Integer;     //error : Integer;
5101    
5102  begin  begin
5103    if (SkrivLog = '1') then    if (SkrivLog = '1') then
# Line 5202  begin Line 5371  begin
5371    
5372    RuteNummerST.Caption := '';    RuteNummerST.Caption := '';
5373    BoghandlerNavnST.Caption := '';    BoghandlerNavnST.Caption := '';
5374    PakkeshopNulstil.Visible := true;    btnNulstil.Visible := true;
5375    
5376    if (strMessage <> '') then    if (strMessage <> '') then
5377    begin    begin
# Line 5313  begin Line 5482  begin
5482    AReg.Free;    AReg.Free;
5483  end;  end;
5484    
5485    
5486    function TMainForm.CheckUrl(url:string):boolean;
5487    var
5488      hSession, hfile: hInternet;
5489      dwindex,dwcodelen :dword;
5490      dwcode:array[1..20] of char;
5491      res : pchar;
5492    begin
5493      if pos('http://',lowercase(url))=0 then
5494        url := 'http://'+url;
5495      Result := false;
5496      hSession := InternetOpen('InetURL:/1.0',
5497                                INTERNET_OPEN_TYPE_PRECONFIG,
5498                                nil,
5499                                nil,
5500                                0);
5501      if assigned(hsession) then
5502      begin
5503        hfile := InternetOpenUrl(hsession,
5504                                 pchar(url),
5505                                 nil,
5506                                 0,
5507                                 INTERNET_FLAG_RELOAD,
5508                                 0);
5509        dwIndex := 0;
5510        dwCodeLen := 10;
5511        HttpQueryInfo(hfile,
5512                      HTTP_QUERY_STATUS_CODE,
5513                      @dwcode,
5514                      dwcodeLen,
5515                      dwIndex);
5516        res := pchar(@dwcode);
5517        result:= (res ='200') or (res ='302');
5518        if assigned(hfile) then
5519          InternetCloseHandle(hfile);
5520        InternetCloseHandle(hsession);
5521      end;
5522    
5523    end;
5524    
5525    
5526    procedure TMainForm.RoundCornerOf(Control: TWinControl);
5527    var
5528       R: TRect;
5529       Rgn: HRGN;
5530    begin
5531       with Control do
5532       begin
5533         R := ClientRect;
5534    //     rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 20, 20) ;
5535         rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 25, 25) ;
5536    //     rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 30, 30) ;
5537         Perform(EM_GETRECT, 0, lParam(@r)) ;
5538         InflateRect(r, - 4, - 4) ;
5539         Perform(EM_SETRECTNP, 0, lParam(@r)) ;
5540         SetWindowRgn(Handle, rgn, True) ;
5541         Invalidate;
5542       end;
5543    end;
5544    
5545  procedure TMainForm.CheckPrintQue(tjektype : string);  procedure TMainForm.CheckPrintQue(tjektype : string);
5546  type  type
5547    TJobs  = array [0..1000] of JOB_INFO_1;    TJobs  = array [0..1000] of JOB_INFO_1;
# Line 5416  begin Line 5645  begin
5645    end;    end;
5646  end;  end;
5647    
 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  
5648    
5649  end.  end.
5650    
Legend:
Removed from v.2662  
changed lines
  Added in v.2678
  ViewVC Help
Powered by ViewVC 1.1.20