/[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 2678 by torben, Wed Aug 26 13:20:47 2015 UTC revision 2683 by torben, Wed Aug 26 19:56:26 2015 UTC
# Line 12  uses Line 12  uses
12    UITypes,    UITypes,
13    PakkeshopLabels,    PakkeshopLabels,
14    StBarC,    StBarC,
15    Math // DegToRad() bruges i PrintPakkeshopLabel    Math, // DegToRad() bruges i PrintPakkeshopLabel
16      Utils
17    
18    ;    ;
19    
20  type  type
   TStrArray = array of string;  
21    TMainForm = class(TForm)    TMainForm = class(TForm)
22      StregkodeST: TStaticText;      StregkodeST: TStaticText;
23      RuteNummerST: TStaticText;      RuteNummerST: TStaticText;
# Line 95  type Line 94  type
94      menuIndlevering: TMenuItem;      menuIndlevering: TMenuItem;
95    
96    
   function Explode(var a: TStrArray; Border, S: string): Integer;  
   function BarCodeValid (ACode: string): boolean;  
97    function Sto_GetFmtFileVersion(const FileName: String = ''): String;    function Sto_GetFmtFileVersion(const FileName: String = ''): String;
98    function TColorToHex(Color : TColor) : string;  
   function HexToTColor(sColor : string) : TColor;  
99    function getProddato() : TDate;    function getProddato() : TDate;
100    function getProddag() : String;    function getProddag() : String;
101    function retRutenummer(rutenummer : String) : String;    function retRutenummer(rutenummer : String) : String;
# Line 107  type Line 103  type
103    function SavePChar(p: PChar): PChar;    function SavePChar(p: PChar): PChar;
104    function AdobeReaderExists(): Boolean;    function AdobeReaderExists(): Boolean;
105    function FileTime2DateTime(FileTime: TFileTime): TDateTime;    function FileTime2DateTime(FileTime: TFileTime): TDateTime;
   function split(input: string; schar: Char; s: Integer): string;  
106    function CheckUrl(url:string):boolean;    function CheckUrl(url:string):boolean;
107    
108    procedure PlaySound(filename : PWideChar);    procedure PlaySound(filename : PWideChar);
# Line 186  type Line 181  type
181    procedure Manualgenerel1Click(Sender: TObject);    procedure Manualgenerel1Click(Sender: TObject);
182    procedure TjekkerUrls();    procedure TjekkerUrls();
183    
   procedure RoundCornerOf(Control: TWinControl);  
184    procedure menuIndleveringClick(Sender: TObject);    procedure menuIndleveringClick(Sender: TObject);
185    
186    procedure PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);    procedure PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
# Line 213  type Line 207  type
207      AlarmLyd : String;      AlarmLyd : String;
208      ScannetOkLyd : String;      ScannetOkLyd : String;
209      ScannetOkStorLyd : String;      ScannetOkStorLyd : String;
210  // 20150317: start  
211      ScannetOkTilTjekkodeLyd : String;      ScannetOkTilTjekkodeLyd : String;
212  // 20150317: slut  
213      PrinterNavn : String;      PrinterNavn : String;
214      TjekPrinter : String;      TjekPrinter : String;
215      XPosRute : integer;      XPosRute : integer;
# Line 256  type Line 250  type
250    
251      Barcode : TStBarcode;      Barcode : TStBarcode;
252    
           function CheckSumModulo10(const data:string):string;          { used for EAN 8/13 }  
253    
254      procedure PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : String = '');      procedure PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : String = '');
255      procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');      procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');
# Line 290  var Line 283  var
283  implementation  implementation
284  {$R *.dfm}  {$R *.dfm}
285    
 function TMainForm.TColorToHex(Color : TColor) : string;  
 begin  
    Result :=  
      IntToHex(GetRValue(Color), 2) +  
      IntToHex(GetGValue(Color), 2) +  
      IntToHex(GetBValue(Color), 2) ;  
 end;  
   
 function TMainForm.HexToTColor(sColor : string) : TColor;  
 begin  
    Result :=  
      RGB(  
        StrToInt('$'+Copy(sColor, 1, 2)),  
        StrToInt('$'+Copy(sColor, 3, 2)),  
        StrToInt('$'+Copy(sColor, 5, 2))  
      ) ;  
 end;  
286    
287  procedure TMainForm.InitForm(Farve,Titel,Url : String);  procedure TMainForm.InitForm(Farve,Titel,Url : String);
288  begin  begin
# Line 413  begin Line 389  begin
389    
390      StartScreen();      StartScreen();
391      MainForm.Caption := Titel;      MainForm.Caption := Titel;
392      MainForm.Color := HexToTColor(Farve);      MainForm.Color := TUtils.HexToTColor(Farve);
393      MainForm.Farve := Farve;      MainForm.Farve := Farve;
394      MainForm.Titel := Titel;      MainForm.Titel := Titel;
395      MainForm.Url := Url;      MainForm.Url := Url;
# Line 473  begin Line 449  begin
449          end          end
450          else          else
451          begin          begin
452            logTekst := 'Speciel version til: '+split(Titel, ':', 2)+' ('+Sted+')';            logTekst := 'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+Sted+')';
453          end;          end;
454          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
455        end        end
456        else        else
457        begin        begin
458          logTekst := 'Speciel version til: '+split(Titel, ':', 2)+' ('+SpecialVersionSted+')';          logTekst := 'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+SpecialVersionSted+')';
459          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
460        end;        end;
461      end;      end;
# Line 522  end; Line 498  end;
498    
499  procedure TMainForm.Automatiskvalg1Click(Sender: TObject);  procedure TMainForm.Automatiskvalg1Click(Sender: TObject);
500  begin  begin
 // 20150317: start  
 (*  
   if Automatiskvalg1.Checked then  
   begin  
      AutomatiskValg1.Checked := true;  
      PanelValgA.Color := clGreen;  
      PanelValgA.Font.Color := clWhite;  
   end  
   else  
   begin  
      AutomatiskValg1.Checked := false;  
      PanelValgA.Color := clBtnFace;  
      PanelValgA.Font.Color := clWindowText;  
   end;  
 *)  
501  // Skal ikke toggle men bare sætte funktionen on  // Skal ikke toggle men bare sætte funktionen on
502  // Fravælges ved at vælge en scanningstype  // Fravælges ved at vælge en scanningstype
503       AutomatiskValg1.Checked := true;       AutomatiskValg1.Checked := true;
504       PanelValgA.Color := clGreen;       PanelValgA.Color := clGreen;
505       PanelValgA.Font.Color := clWhite;       PanelValgA.Font.Color := clWhite;
 // 20150317: slut  
506  end;  end;
507    
508  procedure TMainForm.FormCreate(Sender: TObject);  procedure TMainForm.FormCreate(Sender: TObject);
# Line 561  begin Line 521  begin
521    
522    btnNulstil.BringToFront;    btnNulstil.BringToFront;
523    
524    RoundCornerOf(PanelManglendePakker1);    TUtils.RoundCornerOf(PanelManglendePakker1);
525    RoundCornerOf(PanelManglendePakker2);    TUtils.RoundCornerOf(PanelManglendePakker2);
526    RoundCornerOf(PanelManglendePakker3);    TUtils.RoundCornerOf(PanelManglendePakker3);
527    RoundCornerOf(PanelManglendePakker4);    TUtils.RoundCornerOf(PanelManglendePakker4);
528    RoundCornerOf(PanelManglendePakker5);    TUtils.RoundCornerOf(PanelManglendePakker5);
529    RoundCornerOf(PanelManglendePakker6);    TUtils.RoundCornerOf(PanelManglendePakker6);
530    
531    
532    // Hvis mappen Docs eksisterer kan vi vælge Manual i menuen Hjælp    // Hvis mappen Docs eksisterer kan vi vælge Manual i menuen Hjælp
# Line 785  begin Line 745  begin
745      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)
746      // *************************** //      // *************************** //
747    
748    {$IfDef STED_BK}
749        SpecialVersionSted := 'BK';
750    {$EndIf}
751    {$IfDef STED_DBK}
752        SpecialVersionSted := 'DBK';
753    {$EndIf}
754    {$IfDef STED_FD}
755        SpecialVersionSted := 'FD';
756    {$EndIf}
757    {$IfDef STED_NS}
758        SpecialVersionSted := 'NS';
759    {$EndIf}
760    
761    
762      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
763      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)
764      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
# Line 800  begin Line 774  begin
774      // Hvis specialversion er valgt (SpecialVersionSted er sat til en værdi ovenfor)      // Hvis specialversion er valgt (SpecialVersionSted er sat til en værdi ovenfor)
775      // ændrer vi Sted og Scanningtype her:      // ændrer vi Sted og Scanningtype her:
776    
 // 20150313: start  
777      if SpecialVersionSted = 'NS' then      if SpecialVersionSted = 'NS' then
778      begin      begin
779         SpecialVersionSted := '01';         SpecialVersionSted := '01';
# Line 811  begin Line 784  begin
784         SpecialVersionSted := '03';         SpecialVersionSted := '03';
785         SpecialVersionScanningtype := '4';         SpecialVersionScanningtype := '4';
786      end;      end;
 // 20150313: slut  
787    
788      if SpecialVersionSted = 'BK' then      if SpecialVersionSted = 'BK' then
789      begin      begin
# Line 1608  begin Line 1580  begin
1580             BoghandlerTjekkode := Stregkode;             BoghandlerTjekkode := Stregkode;
1581             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1582             if (PakkeshopLevering1.Checked) then             if (PakkeshopLevering1.Checked) then
1583                MainForm.Color := HexToTColor(FarvePakkeshoplevering);                MainForm.Color := TUtils.HexToTColor(FarvePakkeshoplevering);
1584             if (Pakkernormal1.Checked) then             if (Pakkernormal1.Checked) then
1585                MainForm.Color := HexToTColor(FarveNormal);                MainForm.Color := TUtils.HexToTColor(FarveNormal);
1586             btnNulstil.Visible := false;             btnNulstil.Visible := false;
1587           end           end
1588          else          else
# Line 1670  begin Line 1642  begin
1642           end;           end;
1643            if ( Pakkernormal1.Checked and (pakkeErScannet = 0) and (pakkeForkertSted = 0) and (tjekkodemangler = 0) and (RuteNummerST.Caption <> 'Ukendt') ) or (Copy(Kommentar,1,2) = 'Ok') then            if ( Pakkernormal1.Checked and (pakkeErScannet = 0) and (pakkeForkertSted = 0) and (tjekkodemangler = 0) and (RuteNummerST.Caption <> 'Ukendt') ) or (Copy(Kommentar,1,2) = 'Ok') then
1644            begin            begin
1645              MainForm.Color := HexToTColor(Farve);              MainForm.Color := TUtils.HexToTColor(Farve);
1646              if Storepakker1.Checked then              if Storepakker1.Checked then
1647              begin              begin
1648                PlaySound(PWideChar(ScannetOkStorLyd));                PlaySound(PWideChar(ScannetOkStorLyd));
# Line 1683  begin Line 1655  begin
1655            end            end
1656            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then
1657            begin            begin
1658              MainForm.Color := HexToTColor(Farve);              MainForm.Color := TUtils.HexToTColor(Farve);
1659              if Storepakker1.Checked then              if Storepakker1.Checked then
1660              begin              begin
1661                PlaySound(PWideChar(ScannetOkStorLyd));                PlaySound(PWideChar(ScannetOkStorLyd));
# Line 1808  begin Line 1780  begin
1780            if (pos('/', wrkAntal) > 0) then  // både pakker idag og senere            if (pos('/', wrkAntal) > 0) then  // både pakker idag og senere
1781            begin            begin
1782              wrkAntal := wrkAntal + '/';   // tilføjer '/' sidst i feltet af hensyn til split funktionen              wrkAntal := wrkAntal + '/';   // tilføjer '/' sidst i feltet af hensyn til split funktionen
1783              wrkAntalIdag := StrToInt(split(wrkAntal, '/', 2));              wrkAntalIdag := StrToInt( TUtils.split(wrkAntal, '/', 2));
1784  //            ShowMessage(SPLIT('data/another/yet/again/more/','/',3));  //            ShowMessage(SPLIT('data/another/yet/again/more/','/',3));
1785  //            ShowMessage(SPLIT('data/another/','/',3));  //            ShowMessage(SPLIT('data/another/','/',3));
1786  //            ShowMessage(SPLIT('data/another','/',3));  //            ShowMessage(SPLIT('data/another','/',3));
1787              wrkAntalSenere := StrToInt(split(wrkAntal, '/', 3));              wrkAntalSenere := StrToInt( TUtils.split(wrkAntal, '/', 3));
1788            end            end
1789            else     // kun idag            else     // kun idag
1790            begin            begin
# Line 2180  begin Line 2152  begin
2152       begin       begin
2153         PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label         PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label
2154         PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc         PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc
2155           RuteNummer := PakkeshopLabel.Koreliste;
2156    
2157         PrintPakkeshopLabel( PakkeshopLabel );         PrintPakkeshopLabel( PakkeshopLabel );
2158    
# Line 2335  pakkeForkertSted : Integer; Line 2308  pakkeForkertSted : Integer;
2308    nytRuteNummer, nyFarve : String;    nytRuteNummer, nyFarve : String;
2309  begin  begin
2310    if Budlevering1.Checked then    if Budlevering1.Checked then
2311       RuteNummerST.Color := HexToTColor(Farve);       RuteNummerST.Color := TUtils.HexToTColor(Farve);
2312    
2313    pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);    pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);
2314    if pakkeErScannet = 0 then    if pakkeErScannet = 0 then
# Line 2391  begin Line 2364  begin
2364            PrintNyLabel := true;            PrintNyLabel := true;
2365            RuteNummerST.Caption := RuteNummer+' -> ny rute: '+nytRuteNummer;            RuteNummerST.Caption := RuteNummer+' -> ny rute: '+nytRuteNummer;
2366            nyFarve := Farve;            nyFarve := Farve;
2367            RuteNummerST.Color := HexToTColor(nyFarve);            RuteNummerST.Color := TUtils.HexToTColor(nyFarve);
2368            List1msg := TimeToStr(now) + '; ' + RuteNummer+' -> ny rute: '+nytRuteNummer;            List1msg := TimeToStr(now) + '; ' + RuteNummer+' -> ny rute: '+nytRuteNummer;
2369            RuteNummer := nytRuteNummer;            RuteNummer := nytRuteNummer;
2370            ListBox1.Items.Insert(0,List1Msg);            ListBox1.Items.Insert(0,List1Msg);
# Line 3142  begin Line 3115  begin
3115  //  MainForm.Color := HexToTColor(Farve);  //  MainForm.Color := HexToTColor(Farve);
3116    if Farve <> '' then    if Farve <> '' then
3117    begin    begin
3118       MainForm.Color := HexToTColor(Farve);       MainForm.Color := TUtils.HexToTColor(Farve);
3119  // 20150312: start  // 20150312: start
3120  (*  (*
3121    end    end
# Line 3342  begin Line 3315  begin
3315    end;    end;
3316  end;  end;
3317    
3318  {  
  VERY fast split function  
  this function returns part of a string based on  
  constant defineable delimiters, such as ";". So  
  SPLIT('this is a test ',' ',3) = 'is' or  
  SPLIT('data;another;yet;again;more;',';',4) = 'yet'  
   
  Split function shifts index integer by two to  
  be compatible with commonly used PD split function  
  gpl 2004 / Juhani Suhonen  
 }  
 function TMainForm.split(input: string; schar: Char; s: Integer): string;  
 var  
   c: array of Integer;  
   b, t: Integer;  
 begin  
   Dec(s, 2);  // for compatibility with very old & slow split function  
   t := 0;     // variable T needs to be initialized...  
   setlength(c, Length(input));  
   for b := 0 to pred(High(c)) do  
   begin  
     c[b + 1] := posex(schar, input, succ(c[b]));  
     // BREAK LOOP if posex looped (position before previous)  
     // or wanted position reached..  
     if (c[b + 1] < c[b]) or (s < t) then break  
     else  
       Inc(t);  
   end;  
   Result := Copy(input, succ(c[s]), pred(c[s + 1] - c[s]));  
 end;  
3319    
3320  procedure TMainForm.Om1Click(Sender: TObject);  procedure TMainForm.Om1Click(Sender: TObject);
3321  const  const
# Line 3402  begin Line 3346  begin
3346          end          end
3347          else          else
3348          begin          begin
3349            tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+Sted+')';            tekst := tekst+crlf+crlf+'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+Sted+')';
3350          end;          end;
3351      end      end
3352      else      else
3353      begin      begin
3354        tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+SpecialVersionSted+')';        tekst := tekst+crlf+crlf+'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+SpecialVersionSted+')';
3355      end;      end;
3356    end;    end;
3357    
# Line 4056  begin Line 4000  begin
4000    else    else
4001      MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);      MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);
4002  }  }
4003    Svar := 'Beregnet: '+CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1))+', Indtastet: '+Barcode;    Svar := 'Beregnet: ' + TUtils.CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1))+', Indtastet: '+Barcode;
4004    
4005    MessageBox(Handle, PWideChar(Svar), 'Stregkode', MB_OK);    MessageBox(Handle, PWideChar(Svar), 'Stregkode', MB_OK);
4006    CheckCode();    CheckCode();
# Line 4064  end; Line 4008  end;
4008    
4009  end;  end;
4010    
 function TMainForm.BarCodeValid (ACode: string): boolean;  
 var  
    I: integer;  
    SumOdd, SumEven: integer;  
    ADigit, AChecksumDigit: integer;  
 begin  
    SumOdd := 0;  
    SumEven := 0;  
    for I := 1 to (Length (ACode) - 1) do begin  
       ADigit := StrToIntDef (ACode [I], 0);  
       if (I MOD 2 = 0) then begin  
          SumEven := SumEven + ADigit;  
       end else begin  
          SumOdd := SumOdd + ADigit;  
       end; {if}  
    end; {for}  
    AChecksumDigit := StrToIntDef (ACode [Length (ACode)], 0);  
    Result := ((SumOdd*3 + SumEven + AChecksumDigit) MOD 10 = 0);  
 end; {--BarCodeValid--}  
   
 { used for EAN 8/13 }  
 function TMainForm.CheckSumModulo10(const data:string):string;  
         var i,fak,sum : Integer;  
 begin  
         sum := 0;  
         fak := Length(data);  
         for i:=1 to Length(data) do  
         begin  
                 if (fak mod 2) = 0 then  
                         sum := sum + (StrToInt(data[i])*1)  
                 else  
                         sum := sum + (StrToInt(data[i])*3);  
                 dec(fak);  
         end;  
         if (sum mod 10) = 0 then  
                 result := data+'0'  
         else  
                 result := data+IntToStr(10-(sum mod 10));  
 end;  
4011    
4012  //  //
4013  // Bladhus ***  // Bladhus ***
# Line 4604  begin Line 4509  begin
4509      ListBox1.SetFocus;  // for at flytte fokus væk fra download knappen så denne ikke aktiveres ved scanning / indtastning af stregkode      ListBox1.SetFocus;  // for at flytte fokus væk fra download knappen så denne ikke aktiveres ved scanning / indtastning af stregkode
4510  end;  end;
4511    
 function TMainForm.Explode(var a: TStrArray; Border, S: string): Integer;  
 var  
   S2: string;  
 begin  
   Result  := 0;  
   S2 := S + Border;  
   repeat  
     SetLength(A, Length(A) + 1);  
     a[Result] := Copy(S2, 0,Pos(Border, S2) - 1);  
     Delete(S2, 1,Length(a[Result] + Border));  
     Inc(Result);  
   until S2 = '';  
 end;  
4512    
4513  // ToDo: PrintPakkeshopLabel()  // ToDo: PrintPakkeshopLabel()
4514  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
# Line 4907  var Line 4799  var
4799  //                    stregkoderMedTjekkodeArray[linienr] := stregkode;  //                    stregkoderMedTjekkodeArray[linienr] := stregkode;
4800                    if (pos(' ', stregkode) > 0) then                    if (pos(' ', stregkode) > 0) then
4801                    begin                    begin
4802                      stregkoderMedTjekkodeArray[linienr] := split(stregkode, ' ', 2);  // Fjerner lige en evt. fremtidig dato fra feltet                      stregkoderMedTjekkodeArray[linienr] := TUtils.split(stregkode, ' ', 2);  // Fjerner lige en evt. fremtidig dato fra feltet
4803                    end                    end
4804                    else                    else
4805                    begin                    begin
# Line 5189  begin Line 5081  begin
5081          ReadLn(SomeTxtFile, buffer) ;          ReadLn(SomeTxtFile, buffer) ;
5082          S := buffer;          S := buffer;
5083          SetLength(A,0);          SetLength(A,0);
5084          Explode(A, ';', S);          TUtils.Explode(A, ';', S);
5085          if (length(A) < 2) then          if (length(A) < 2) then
5086          begin          begin
5087            Explode(A, ',', S);            TUtils.Explode(A, ',', S);
5088          end;          end;
5089            if (length(A) > 1) then            if (length(A) > 1) then
5090            begin            begin
# Line 5266  begin Line 5158  begin
5158          ReadLn(SomeTxtFile, buffer) ;          ReadLn(SomeTxtFile, buffer) ;
5159          S := buffer;          S := buffer;
5160          SetLength(A,0);          SetLength(A,0);
5161          Explode(A, ';', S);          TUtils.Explode(A, ';', S);
5162          if (length(A) < 3) then          if (length(A) < 3) then
5163          begin          begin
5164            Explode(A, ',', S);            TUtils.Explode(A, ',', S);
5165          end;          end;
5166          if (A[0]=imorgenYmd) then          if (A[0]=imorgenYmd) then
5167          begin          begin
# Line 5523  begin Line 5415  begin
5415  end;  end;
5416    
5417    
 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;  
   
5418  procedure TMainForm.CheckPrintQue(tjektype : string);  procedure TMainForm.CheckPrintQue(tjektype : string);
5419  type  type
5420    TJobs  = array [0..1000] of JOB_INFO_1;    TJobs  = array [0..1000] of JOB_INFO_1;
Legend:
Removed from v.2678  
changed lines
  Added in v.2683
  ViewVC Help
Powered by ViewVC 1.1.20