/[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 2680 by torben, Wed Aug 26 18:53:11 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 768  begin Line 785  begin
785      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)
786      // *************************** //      // *************************** //
787    
788    {$IfDef STED_BK}
789        SpecialVersionSted := 'BK';
790    {$EndIf}
791    {$IfDef STED_DBK}
792        SpecialVersionSted := 'DBK';
793    {$EndIf}
794    {$IfDef STED_FD}
795        SpecialVersionSted := 'FD';
796    {$EndIf}
797    {$IfDef STED_NS}
798        SpecialVersionSted := 'NS';
799    {$EndIf}
800    
801    
802      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
803      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)
804      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
# Line 834  begin Line 865  begin
865        PanelValg5.Font.Color := clInactiveCaption;        PanelValg5.Font.Color := clInactiveCaption;
866        PanelValg6.Enabled := false;        PanelValg6.Enabled := false;
867        PanelValg6.Font.Color := clInactiveCaption;        PanelValg6.Font.Color := clInactiveCaption;
868          PanelValg7.Enabled := false;
869          PanelValg7.Font.Color := clInactiveCaption;
870    
871       // her skal vi også disable de menupunkter DBK ikke kan bruge       // her skal vi også disable de menupunkter DBK ikke kan bruge
872        ReturpakkerfraDAO1.Enabled := false;        ReturpakkerfraDAO1.Enabled := false;
873        Returpakkerfraboghandler1.Enabled := false;        Returpakkerfraboghandler1.Enabled := false;
# Line 870  begin Line 904  begin
904        PanelValg5.Font.Color := clInactiveCaption;        PanelValg5.Font.Color := clInactiveCaption;
905        PanelValg6.Enabled := false;        PanelValg6.Enabled := false;
906        PanelValg6.Font.Color := clInactiveCaption;        PanelValg6.Font.Color := clInactiveCaption;
907          PanelValg7.Enabled := false;
908          PanelValg7.Font.Color := clInactiveCaption;
909       // 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
910    
911        Automatiskvalg1.Enabled := false;        Automatiskvalg1.Enabled := false;
# Line 965  begin Line 1001  begin
1001             RutenummerST.Caption := '';             RutenummerST.Caption := '';
1002             BoghandlerNavnST.Caption := 'Fejl i urls';             BoghandlerNavnST.Caption := 'Fejl i urls';
1003             KommentarST.Caption := 'Se log vinduet';             KommentarST.Caption := 'Se log vinduet';
1004             PakkeshopNulstil.Visible := true;             btnNulstil.Visible := true;
1005             exit;             exit;
1006          end;          end;
1007      end      end
# Line 1134  begin Line 1170  begin
1170      Scanningtype := gemScanningtype;      Scanningtype := gemScanningtype;
1171    
1172      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');
1173      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion('',''));      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion(''));
1174    
1175  end;  end;
1176    
# Line 1214  begin Line 1250  begin
1250    
1251      if StregKode = 'Nulstil' then      if StregKode = 'Nulstil' then
1252      begin      begin
1253         PakkeshopNulstil.Click();         btnNulstil.Click();
1254         exit;         exit;
1255      end;      end;
1256    
1257      if PakkeshopNulstil.Visible then      if btnNulstil.Visible then
1258      begin      begin
1259        VisAlarmSkaerm( 'HUSK at klikke Nulstil før ny scanning...' );        VisAlarmSkaerm( 'HUSK at klikke Nulstil før ny scanning...' );
1260    
# Line 1543  begin Line 1579  begin
1579             BoghandlerStregkode := Stregkode;             BoghandlerStregkode := Stregkode;
1580             BoghandlerTjekkode := '';             BoghandlerTjekkode := '';
1581             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1582             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1583             Stregkode := '';             Stregkode := '';
1584             InitScreen();             InitScreen();
1585        end        end
# Line 1555  begin Line 1591  begin
1591             BoghandlerStregkode := Stregkode;             BoghandlerStregkode := Stregkode;
1592             BoghandlerTjekkode := '-1';             BoghandlerTjekkode := '-1';
1593             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1594             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1595             Stregkode := '';             Stregkode := '';
1596             InitScreen();             InitScreen();
1597        end        end
# Line 1589  begin Line 1625  begin
1625                MainForm.Color := HexToTColor(FarvePakkeshoplevering);                MainForm.Color := HexToTColor(FarvePakkeshoplevering);
1626             if (Pakkernormal1.Checked) then             if (Pakkernormal1.Checked) then
1627                MainForm.Color := HexToTColor(FarveNormal);                MainForm.Color := HexToTColor(FarveNormal);
1628             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1629           end           end
1630          else          else
1631           begin           begin
# Line 1621  begin Line 1657  begin
1657            // Hvis der var sql fejl i opdateringen skal dette fejlmeldes her            // Hvis der var sql fejl i opdateringen skal dette fejlmeldes her
1658            if Rutenummer = 'sql fejl' then            if Rutenummer = 'sql fejl' then
1659            begin   // Her skal komme en alarm og rød skærm            begin   // Her skal komme en alarm og rød skærm
1660               PlaySound(PWideChar(AlarmLyd));               VisAlarmSkaerm( 'SQL fejl: ' + Kommentar );
1661               //List1msg := 'SQL fejl: ' + Kommentar;  
              //ListBox1.Items.Insert(0,List1Msg);  
              MainForm.Color := clRed;  
              //KommentarST.Caption := List1msg;  
              PakkeshopNulstil.Visible := true;  
1662              exit;              exit;
1663            end;            end;
1664            if (Pakkernormal1.Checked or Budlevering1.Checked or PakkeshopLevering1.Checked) then            if (Pakkernormal1.Checked or Budlevering1.Checked or PakkeshopLevering1.Checked) then
# Line 1646  begin Line 1678  begin
1678              if (pakkeErScannet > 0) or (pakkeForkertSted > 0) or (tjekkodemangler > 0) then              if (pakkeErScannet > 0) or (pakkeForkertSted > 0) or (tjekkodemangler > 0) then
1679              begin              begin
1680                PlaySound(PWideChar(AlarmLyd));                PlaySound(PWideChar(AlarmLyd));
1681                PakkeshopNulstil.Visible := true;                btnNulstil.Visible := true;
1682                MainForm.Color := clRed;                MainForm.Color := clRed;
1683              end;              end;
1684           end;           end;
# Line 1661  begin Line 1693  begin
1693              begin              begin
1694                PlaySound(PWideChar(ScannetOkLyd));                PlaySound(PWideChar(ScannetOkLyd));
1695              end;              end;
1696              PakkeshopNulstil.Visible := false;              btnNulstil.Visible := false;
1697            end            end
1698            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then
1699            begin            begin
# Line 1674  begin Line 1706  begin
1706              begin              begin
1707                PlaySound(PWideChar(ScannetOkLyd));                PlaySound(PWideChar(ScannetOkLyd));
1708              end;              end;
1709              PakkeshopNulstil.Visible := false;              btnNulstil.Visible := false;
1710            end            end
1711            else if Copy(Kommentar,1,8) = 'OPRETTET' then            else if Copy(Kommentar,1,8) = 'OPRETTET' then
1712            begin            begin
# Line 1685  begin Line 1717  begin
1717            end            end
1718            else            else
1719            begin            begin
1720              MainForm.Color := clRed;              VisAlarmSkaerm('');
             PlaySound(PWideChar(AlarmLyd));  
             PakkeshopNulstil.Visible := true;  
1721            end;            end;
1722           if not PakkeshopNulstil.Visible then           if not btnNulstil.Visible then
1723            begin            begin
1724    
1725              If (Budlevering1.Checked) then              If (Budlevering1.Checked) then
# Line 2060  var Line 2090  var
2090    URLStr : String;    URLStr : String;
2091    pakkestorrelse : String;    pakkestorrelse : String;
2092    PrintNyLabelInteger : Integer;    PrintNyLabelInteger : Integer;
2093    
2094      PakkeshopLabel: TPakkeshopLabel;
2095  begin  begin
2096    if radioStorPakke.Checked then    if radioStorPakke.Checked then
2097    begin    begin
# Line 2069  begin Line 2101  begin
2101    begin    begin
2102      pakkestorrelse := 'Lille';      pakkestorrelse := 'Lille';
2103    end;    end;
2104    
2105    
2106    if Pakkernormal1.Checked then    if Pakkernormal1.Checked then
2107    begin    begin
2108       if (BoghandlerTjekkode = '') then       if (BoghandlerTjekkode = '') then
# Line 2097  begin Line 2131  begin
2131    begin    begin
2132       URLStr := Format(UrlReturPakkeshop,[Sted, PakkeNr]);       URLStr := Format(UrlReturPakkeshop,[Sted, PakkeNr]);
2133    end    end
2134      else if menuIndlevering.Checked then
2135      begin
2136        URLStr := Format(UrlIndleveringsPakke,[Sted, PakkeNr]);
2137      end
2138    else    else
2139    begin    begin
2140      exit;      exit;
# Line 2143  begin Line 2181  begin
2181          begin          begin
2182            PrintNyLabel := True;            PrintNyLabel := True;
2183          end;          end;
 // 20150310: start  
2184        end;        end;
 // 20150310: slut  
2185       end       end
2186        else if menuIndlevering.Checked then
2187        begin
2188    
2189    
2190    
2191    
2192         Kommentar := XMLDocument1.ChildNodes.FindNode('PakkeKontrol').ChildNodes.FindNode('Stregkodematch').Text;
2193         if (Kommentar = 'Ok') then
2194         begin
2195           PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label
2196           PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc
2197           RuteNummer := PakkeshopLabel.Koreliste;
2198    
2199           PrintPakkeshopLabel( PakkeshopLabel );
2200    
2201         end;
2202    
2203    
2204        end
2205      else      else
2206       begin       begin
2207        RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text;        RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text;
# Line 2179  begin Line 2234  begin
2234          PrintNyLabel := True;          PrintNyLabel := True;
2235        end;        end;
2236      end;      end;
2237    
2238    
2239      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
2240      begin      begin
2241        if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then        if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then
# Line 2338  begin Line 2395  begin
2395    
2396          PlaySound(PWideChar(AlarmLyd));          PlaySound(PWideChar(AlarmLyd));
2397          MainForm.Color := clRed;          MainForm.Color := clRed;
2398          PakkeshopNulstil.Visible := true;          btnNulstil.Visible := true;
2399    
2400       end       end
2401       else       else
# Line 2365  begin Line 2422  begin
2422            begin            begin
2423              PlaySound(PWideChar(AlarmLyd));              PlaySound(PWideChar(AlarmLyd));
2424              MainForm.Color := clRed;              MainForm.Color := clRed;
2425              PakkeshopNulstil.Visible := true;              btnNulstil.Visible := true;
2426            end;            end;
2427    
2428         end;         end;
# Line 2391  begin Line 2448  begin
2448            begin            begin
2449              PlaySound(PWideChar(AlarmLyd));              PlaySound(PWideChar(AlarmLyd));
2450              MainForm.Color := clRed;              MainForm.Color := clRed;
2451              PakkeshopNulstil.Visible := true;              btnNulstil.Visible := true;
2452            end;            end;
2453    
2454         end;         end;
# Line 2415  begin Line 2472  begin
2472                end;                end;
2473              end;              end;
2474        01 :  begin;        01 :  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 2429  begin Line 2486  begin
2486                end;                end;
2487              end;              end;
2488        03 :  begin;        03 :  begin;
2489               if PrintNyLabel and ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then               if PrintNyLabel or ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then
2490                    // 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
2491                    // 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')
2492               begin               begin
# Line 3038  begin Line 3095  begin
3095      repeat      repeat
3096        if (SR.Attr <> faDirectory) then        if (SR.Attr <> faDirectory) then
3097        begin        begin
3098    
3099          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring
3100          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse
3101          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse
# Line 3077  begin Line 3135  begin
3135    end;    end;
3136  end;  end;
3137    
3138  procedure TMainForm.PakkeshopNulstilClick(Sender: TObject);  procedure TMainForm.btnNulstilClick(Sender: TObject);
3139  begin  begin
3140    PakkeshopStregkode := '';    PakkeshopStregkode := '';
3141    PakkeshopTjekkode := '';    PakkeshopTjekkode := '';
3142    PakkeshopNulstil.Visible := false;    btnNulstil.Visible := false;
3143    PakkeshopText1.Caption := 'Stregkode';    PakkeshopText1.Caption := 'Stregkode';
3144    BoghandlerStregkode := '';    BoghandlerStregkode := '';
3145    BoghandlerTjekkode := '';    BoghandlerTjekkode := '';
# Line 3231  begin Line 3289  begin
3289      // Her kommer en alarm og rød skærm      // Her kommer en alarm og rød skærm
3290      PlaySound(PWideChar(AlarmLyd));      PlaySound(PWideChar(AlarmLyd));
3291      MainForm.Color := clRed;      MainForm.Color := clRed;
3292      PakkeshopNulstil.Visible := true;      btnNulstil.Visible := true;
3293    end    end
3294    else    else
3295    begin    begin
# Line 3337  var Line 3395  var
3395   tekst, filversion : String;   tekst, filversion : String;
3396  begin  begin
3397    
3398    filversion := Sto_GetFmtFileVersion('','');    filversion := Sto_GetFmtFileVersion('');
3399    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';
3400    
3401    tekst := tekst+crlf+crlf;    tekst := tekst+crlf+crlf;
# Line 3472  begin Line 3530  begin
3530    end;    end;
3531  end;  end;
3532    
3533    procedure TMainForm.menuIndleveringClick(Sender: TObject);
3534    begin
3535      Scanningtype := '7';
3536      NulstilAutomatiskValg();
3537      InitIndleveringskode();
3538    end;
3539    
3540  procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject);  procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject);
3541  begin  begin
3542    
# Line 3504  end; Line 3569  end;
3569  procedure TMainForm.InitNatxpresslevering();  procedure TMainForm.InitNatxpresslevering();
3570  begin  begin
3571        AutomatiskTjekkodeStyring1.Enabled := true;        AutomatiskTjekkodeStyring1.Enabled := true;
3572        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3573        Pakkernormal1.Checked := true;        Pakkernormal1.Checked := true;
3574        InitForm(FarveNormal,TitelNormal,UrlNormal);        InitForm(FarveNormal,TitelNormal,UrlNormal);
3575        PanelValg1.Color := clGreen;        PanelValg1.Color := clGreen;
# Line 3537  procedure TMainForm.InitReturFraDao(); Line 3602  procedure TMainForm.InitReturFraDao();
3602  begin  begin
3603        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3604        ReturpakkerfraDAO1.Checked := true;        ReturpakkerfraDAO1.Checked := true;
3605        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3606        InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO);        InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO);
3607        PanelValg2.Color := clGreen;        PanelValg2.Color := clGreen;
3608        PanelValg2.Font.Color := clWhite;        PanelValg2.Font.Color := clWhite;
# Line 3564  procedure TMainForm.InitReturFraKunde(); Line 3629  procedure TMainForm.InitReturFraKunde();
3629  begin  begin
3630        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3631        Returpakkerfraboghandler1.Checked := true;        Returpakkerfraboghandler1.Checked := true;
3632        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3633        InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler);        InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler);
3634        PanelValg3.Color := clGreen;        PanelValg3.Color := clGreen;
3635        PanelValg3.Font.Color := clWhite;        PanelValg3.Font.Color := clWhite;
# Line 3590  procedure TMainForm.InitDirektelevering( Line 3655  procedure TMainForm.InitDirektelevering(
3655  begin  begin
3656        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3657        Budlevering1.Checked := true;        Budlevering1.Checked := true;
3658        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3659        InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering);        InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering);
3660        PanelValg4.Color := clGreen;        PanelValg4.Color := clGreen;
3661        PanelValg4.Font.Color := clWhite;        PanelValg4.Font.Color := clWhite;
# Line 3626  procedure TMainForm.InitPakkeshopleverin Line 3691  procedure TMainForm.InitPakkeshopleverin
3691  begin  begin
3692        AutomatiskTjekkodeStyring1.Enabled := true;        AutomatiskTjekkodeStyring1.Enabled := true;
3693        Pakkeshoplevering1.Checked := true;        Pakkeshoplevering1.Checked := true;
3694        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3695        InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering);        InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering);
3696        PanelValg5.Color := clGreen;        PanelValg5.Color := clGreen;
3697        PanelValg5.Font.Color := clWhite;        PanelValg5.Font.Color := clWhite;
# Line 3663  procedure TMainForm.InitReturFraPakkesho Line 3728  procedure TMainForm.InitReturFraPakkesho
3728  begin  begin
3729        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3730        Returpakkerfrapakkeshop1.Checked := true;        Returpakkerfrapakkeshop1.Checked := true;
3731        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3732        InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop);        InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop);
3733        PanelValg6.Color := clGreen;        PanelValg6.Color := clGreen;
3734        PanelValg6.Font.Color := clWhite;        PanelValg6.Font.Color := clWhite;
# Line 3703  end; Line 3768  end;
3768    
3769  procedure TMainForm.InitIndleveringskode();  procedure TMainForm.InitIndleveringskode();
3770  begin  begin
3771          menuIndlevering.Checked := true;
3772        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3773        Returpakkerfrapakkeshop1.Checked := true;  
3774        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3775        InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop);        InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop);
3776        PanelValg7.Color := clGreen;        PanelValg7.Color := clGreen;
3777        PanelValg7.Font.Color := clWhite;        PanelValg7.Font.Color := clWhite;
# Line 3783  end; Line 3849  end;
3849  ///   values.</param>  ///   values.</param>
3850  /// <returns>Formatted version number of file, '' if no version  /// <returns>Formatted version number of file, '' if no version
3851  ///   resource found.</returns>  ///   resource found.</returns>
3852  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = '';  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = ''): String;
   const Fmt: String = '%d.%d.%d.%d'): String;  
3853  var  var
3854    sFileName: String;    sFileName: String;
3855    iBufferSize: DWORD;    iBufferSize: DWORD;
3856    iDummy: DWORD;    iDummy: DWORD;
3857    pBuffer: Pointer;    pBuffer: Pointer;
3858    pFileInfo: Pointer;    pFileInfo: Pointer;
3859    iVer: array[1..4] of Word;    iVer: array[1..4] of Integer;
   S : String;  
3860  begin  begin
3861    // set default value    // set default value
3862    Result := '';    Result := '';
# Line 3817  begin Line 3881  begin
3881      finally      finally
3882        FreeMem(pBuffer);        FreeMem(pBuffer);
3883      end;      end;
3884    
3885      // format result string      // format result string
3886      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]]);
3887    
     // 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;  
3888    end;    end;
3889  end;  end;
3890    
# Line 3993  begin Line 4047  begin
4047           BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...';           BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...';
4048         end;         end;
4049         KommentarST.Caption := Kommentar;         KommentarST.Caption := Kommentar;
4050         PakkeshopNulstil.Visible := true;         btnNulstil.Visible := true;
4051      end;      end;
4052    
4053  end;  end;
# Line 4579  begin Line 4633  begin
4633    until S2 = '';    until S2 = '';
4634  end;  end;
4635    
4636    // ToDo: PrintPakkeshopLabel()
4637    procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
4638    var
4639      XForm, XFormOld: TXForm; //Bruges til rotate X-formation
4640      Angle: integer;
4641      gMode: integer;
4642      BarcodeArea: TRect;
4643      Dirigering: string;
4644    
4645    begin
4646        with Printer do
4647        begin
4648          BeginDoc();
4649    
4650    
4651          Canvas.Font.Size := 16;
4652          Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);
4653    
4654    
4655    
4656          Canvas.TextOut(25, 90, PakkeshopLabel.Navn );
4657          Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn );
4658          Canvas.TextOut(25, 180, PakkeshopLabel.Postnr );
4659    
4660    
4661          Canvas.Font.Size := 9;
4662          Canvas.TextOut(110, 240, 'Pakkeshop:');
4663          Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);
4664          Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);
4665          Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);
4666    
4667          Canvas.TextOut(350, 240, 'Afsender:');
4668          Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);
4669          Canvas.TextOut(350, 300, PakkeshopLabel.AfsenderAdresse);
4670          Canvas.TextOut(350, 330, PakkeshopLabel.AfsenderPostnr);
4671    
4672          Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr;
4673          if ( PakkeshopLabel.Koreliste <> '') then
4674          begin
4675            Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
4676          end;
4677    
4678    
4679          Canvas.Font.Size := 12;
4680          Canvas.TextOut(15, 370, Dirigering);
4681    
4682    
4683    
4684    
4685    
4686          //Tegn adskillelses linier
4687          Canvas.Pen.Width := 2;
4688          //Øverste linie
4689          Canvas.MoveTo(20,80);
4690          Canvas.LineTo(600,80);
4691    
4692          // Midterste linie
4693          Canvas.MoveTo( 20, 240);
4694          Canvas.LineTo(600, 240);
4695    
4696          //Nederste linie
4697          Canvas.MoveTo( 20, 370);
4698          Canvas.LineTo(600, 370);
4699    
4700    
4701          //Tegn skrå streger over afsender
4702          Canvas.Pen.Width := 1;
4703          Canvas.MoveTo(600, 250);
4704          Canvas.LineTo(350, 360);
4705          Canvas.MoveTo(600, 360);
4706          Canvas.LineTo(350, 250);
4707    
4708    
4709    
4710    
4711          // Resten af rutinen vedr genering og placering af Barcode
4712    
4713          BarCode.BarCodeType := bcCode128;
4714          BarCode.Code128Subset := csCodeC;
4715          BarCode.Code := PakkeshopLabel.Stregkode;
4716          BarCode.Validate(True);
4717    
4718          //Start X-formation
4719          //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
4720          GetWorldTransform(Canvas.Handle, XFormOld);
4721    
4722          Angle := 270;
4723          XForm.eM11 := Cos(DegToRad(Angle));
4724          XForm.eM12 := Sin(DegToRad(Angle));
4725          XForm.eM21 := -Sin(DegToRad(Angle));
4726          XForm.eM22 := Cos(DegToRad(Angle));
4727          XForm.eDx := 0;
4728          XForm.eDy := 0;
4729    
4730          gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
4731          SetWorldTransform(Canvas.Handle, XForm);
4732    
4733          // PaintToCanvasSize arbejder i Inches
4734          // Første pos argument bliver nu Y og skal være negativ for at rykke den ned
4735          //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre
4736    
4737          BarCode.PaintToCanvasSize(Printer.Canvas, -1.8, 3.3, 0.4);
4738    
4739    
4740          SetWorldTransform(Canvas.Handle, XFormOld);
4741          SetGraphicsMode(Canvas.Handle, gMode);
4742    
4743          EndDoc();
4744        end;
4745    
4746    
4747    end;
4748    
4749    function GetPixelsPerInchX(): Integer;
4750    begin
4751      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)
4752    end;
4753    
4754    function GetPixelsPerInchY(): Integer;
4755    begin
4756      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
4757    end;
4758    
4759    
4760  procedure TMainForm.IndlesManglendeScanninger();  procedure TMainForm.IndlesManglendeScanninger();
4761  var  var
4762    WebSvar : String;    WebSvar : String;
# Line 4934  var Line 5112  var
5112     idag, imorgen : TDateTime;     idag, imorgen : TDateTime;
5113     imorgenYmd : string;     imorgenYmd : string;
5114     logFilnavn : string;     logFilnavn : string;
5115      error : Integer;     //error : Integer;
5116    
5117  begin  begin
5118    if (SkrivLog = '1') then    if (SkrivLog = '1') then
# Line 5203  begin Line 5381  begin
5381    //ShowMessage('Ændring ikke tilladt');    //ShowMessage('Ændring ikke tilladt');
5382    // Her skal komme en 'rød skærm' alarm    // Her skal komme en 'rød skærm' alarm
5383    PlaySound(PWideChar(AlarmLyd));    PlaySound(PWideChar(AlarmLyd));
   
   ListBox1.Items.Insert(0, strMessage);  
5384    MainForm.Color := clRed;    MainForm.Color := clRed;
5385    
5386    
5387    RuteNummerST.Caption := '';    RuteNummerST.Caption := '';
5388    BoghandlerNavnST.Caption := '';    BoghandlerNavnST.Caption := '';
5389    KommentarST.Caption := strMessage;    btnNulstil.Visible := true;
5390    PakkeshopNulstil.Visible := true;  
5391      if (strMessage <> '') then
5392      begin
5393        ListBox1.Items.Insert(0, strMessage);
5394        KommentarST.Caption := strMessage;
5395      end;
5396    
5397  end;  end;
5398    
5399  function TMainForm.getProddato() : TDate;  function TMainForm.getProddato() : TDate;
# Line 5313  begin Line 5497  begin
5497    AReg.Free;    AReg.Free;
5498  end;  end;
5499    
5500    
5501    function TMainForm.CheckUrl(url:string):boolean;
5502    var
5503      hSession, hfile: hInternet;
5504      dwindex,dwcodelen :dword;
5505      dwcode:array[1..20] of char;
5506      res : pchar;
5507    begin
5508      if pos('http://',lowercase(url))=0 then
5509        url := 'http://'+url;
5510      Result := false;
5511      hSession := InternetOpen('InetURL:/1.0',
5512                                INTERNET_OPEN_TYPE_PRECONFIG,
5513                                nil,
5514                                nil,
5515                                0);
5516      if assigned(hsession) then
5517      begin
5518        hfile := InternetOpenUrl(hsession,
5519                                 pchar(url),
5520                                 nil,
5521                                 0,
5522                                 INTERNET_FLAG_RELOAD,
5523                                 0);
5524        dwIndex := 0;
5525        dwCodeLen := 10;
5526        HttpQueryInfo(hfile,
5527                      HTTP_QUERY_STATUS_CODE,
5528                      @dwcode,
5529                      dwcodeLen,
5530                      dwIndex);
5531        res := pchar(@dwcode);
5532        result:= (res ='200') or (res ='302');
5533        if assigned(hfile) then
5534          InternetCloseHandle(hfile);
5535        InternetCloseHandle(hsession);
5536      end;
5537    
5538    end;
5539    
5540    
5541    procedure TMainForm.RoundCornerOf(Control: TWinControl);
5542    var
5543       R: TRect;
5544       Rgn: HRGN;
5545    begin
5546       with Control do
5547       begin
5548         R := ClientRect;
5549    //     rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 20, 20) ;
5550         rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 25, 25) ;
5551    //     rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 30, 30) ;
5552         Perform(EM_GETRECT, 0, lParam(@r)) ;
5553         InflateRect(r, - 4, - 4) ;
5554         Perform(EM_SETRECTNP, 0, lParam(@r)) ;
5555         SetWindowRgn(Handle, rgn, True) ;
5556         Invalidate;
5557       end;
5558    end;
5559    
5560  procedure TMainForm.CheckPrintQue(tjektype : string);  procedure TMainForm.CheckPrintQue(tjektype : string);
5561  type  type
5562    TJobs  = array [0..1000] of JOB_INFO_1;    TJobs  = array [0..1000] of JOB_INFO_1;
# Line 5416  begin Line 5660  begin
5660    end;    end;
5661  end;  end;
5662    
 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  
5663    
5664  end.  end.
5665    
Legend:
Removed from v.2660  
changed lines
  Added in v.2680
  ViewVC Help
Powered by ViewVC 1.1.20