/[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 2681 by torben, Wed Aug 26 18:53:11 2015 UTC revision 2682 by torben, Wed Aug 26 19:52:38 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 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 561  begin Line 537  begin
537    
538    btnNulstil.BringToFront;    btnNulstil.BringToFront;
539    
540    RoundCornerOf(PanelManglendePakker1);    TUtils.RoundCornerOf(PanelManglendePakker1);
541    RoundCornerOf(PanelManglendePakker2);    TUtils.RoundCornerOf(PanelManglendePakker2);
542    RoundCornerOf(PanelManglendePakker3);    TUtils.RoundCornerOf(PanelManglendePakker3);
543    RoundCornerOf(PanelManglendePakker4);    TUtils.RoundCornerOf(PanelManglendePakker4);
544    RoundCornerOf(PanelManglendePakker5);    TUtils.RoundCornerOf(PanelManglendePakker5);
545    RoundCornerOf(PanelManglendePakker6);    TUtils.RoundCornerOf(PanelManglendePakker6);
546    
547    
548    // 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 1622  begin Line 1598  begin
1598             BoghandlerTjekkode := Stregkode;             BoghandlerTjekkode := Stregkode;
1599             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1600             if (PakkeshopLevering1.Checked) then             if (PakkeshopLevering1.Checked) then
1601                MainForm.Color := HexToTColor(FarvePakkeshoplevering);                MainForm.Color := TUtils.HexToTColor(FarvePakkeshoplevering);
1602             if (Pakkernormal1.Checked) then             if (Pakkernormal1.Checked) then
1603                MainForm.Color := HexToTColor(FarveNormal);                MainForm.Color := TUtils.HexToTColor(FarveNormal);
1604             btnNulstil.Visible := false;             btnNulstil.Visible := false;
1605           end           end
1606          else          else
# Line 1684  begin Line 1660  begin
1660           end;           end;
1661            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
1662            begin            begin
1663              MainForm.Color := HexToTColor(Farve);              MainForm.Color := TUtils.HexToTColor(Farve);
1664              if Storepakker1.Checked then              if Storepakker1.Checked then
1665              begin              begin
1666                PlaySound(PWideChar(ScannetOkStorLyd));                PlaySound(PWideChar(ScannetOkStorLyd));
# Line 1697  begin Line 1673  begin
1673            end            end
1674            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then
1675            begin            begin
1676              MainForm.Color := HexToTColor(Farve);              MainForm.Color := TUtils.HexToTColor(Farve);
1677              if Storepakker1.Checked then              if Storepakker1.Checked then
1678              begin              begin
1679                PlaySound(PWideChar(ScannetOkStorLyd));                PlaySound(PWideChar(ScannetOkStorLyd));
# Line 1822  begin Line 1798  begin
1798            if (pos('/', wrkAntal) > 0) then  // både pakker idag og senere            if (pos('/', wrkAntal) > 0) then  // både pakker idag og senere
1799            begin            begin
1800              wrkAntal := wrkAntal + '/';   // tilføjer '/' sidst i feltet af hensyn til split funktionen              wrkAntal := wrkAntal + '/';   // tilføjer '/' sidst i feltet af hensyn til split funktionen
1801              wrkAntalIdag := StrToInt(split(wrkAntal, '/', 2));              wrkAntalIdag := StrToInt( TUtils.split(wrkAntal, '/', 2));
1802  //            ShowMessage(SPLIT('data/another/yet/again/more/','/',3));  //            ShowMessage(SPLIT('data/another/yet/again/more/','/',3));
1803  //            ShowMessage(SPLIT('data/another/','/',3));  //            ShowMessage(SPLIT('data/another/','/',3));
1804  //            ShowMessage(SPLIT('data/another','/',3));  //            ShowMessage(SPLIT('data/another','/',3));
1805              wrkAntalSenere := StrToInt(split(wrkAntal, '/', 3));              wrkAntalSenere := StrToInt( TUtils.split(wrkAntal, '/', 3));
1806            end            end
1807            else     // kun idag            else     // kun idag
1808            begin            begin
# Line 2350  pakkeForkertSted : Integer; Line 2326  pakkeForkertSted : Integer;
2326    nytRuteNummer, nyFarve : String;    nytRuteNummer, nyFarve : String;
2327  begin  begin
2328    if Budlevering1.Checked then    if Budlevering1.Checked then
2329       RuteNummerST.Color := HexToTColor(Farve);       RuteNummerST.Color := TUtils.HexToTColor(Farve);
2330    
2331    pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);    pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);
2332    if pakkeErScannet = 0 then    if pakkeErScannet = 0 then
# Line 2406  begin Line 2382  begin
2382            PrintNyLabel := true;            PrintNyLabel := true;
2383            RuteNummerST.Caption := RuteNummer+' -> ny rute: '+nytRuteNummer;            RuteNummerST.Caption := RuteNummer+' -> ny rute: '+nytRuteNummer;
2384            nyFarve := Farve;            nyFarve := Farve;
2385            RuteNummerST.Color := HexToTColor(nyFarve);            RuteNummerST.Color := TUtils.HexToTColor(nyFarve);
2386            List1msg := TimeToStr(now) + '; ' + RuteNummer+' -> ny rute: '+nytRuteNummer;            List1msg := TimeToStr(now) + '; ' + RuteNummer+' -> ny rute: '+nytRuteNummer;
2387            RuteNummer := nytRuteNummer;            RuteNummer := nytRuteNummer;
2388            ListBox1.Items.Insert(0,List1Msg);            ListBox1.Items.Insert(0,List1Msg);
# Line 3157  begin Line 3133  begin
3133  //  MainForm.Color := HexToTColor(Farve);  //  MainForm.Color := HexToTColor(Farve);
3134    if Farve <> '' then    if Farve <> '' then
3135    begin    begin
3136       MainForm.Color := HexToTColor(Farve);       MainForm.Color := TUtils.HexToTColor(Farve);
3137  // 20150312: start  // 20150312: start
3138  (*  (*
3139    end    end
# Line 3357  begin Line 3333  begin
3333    end;    end;
3334  end;  end;
3335    
3336  {  
  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;  
3337    
3338  procedure TMainForm.Om1Click(Sender: TObject);  procedure TMainForm.Om1Click(Sender: TObject);
3339  const  const
# Line 3417  begin Line 3364  begin
3364          end          end
3365          else          else
3366          begin          begin
3367            tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+Sted+')';            tekst := tekst+crlf+crlf+'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+Sted+')';
3368          end;          end;
3369      end      end
3370      else      else
3371      begin      begin
3372        tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+SpecialVersionSted+')';        tekst := tekst+crlf+crlf+'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+SpecialVersionSted+')';
3373      end;      end;
3374    end;    end;
3375    
# Line 4071  begin Line 4018  begin
4018    else    else
4019      MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);      MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);
4020  }  }
4021    Svar := 'Beregnet: '+CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1))+', Indtastet: '+Barcode;    Svar := 'Beregnet: ' + TUtils.CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1))+', Indtastet: '+Barcode;
4022    
4023    MessageBox(Handle, PWideChar(Svar), 'Stregkode', MB_OK);    MessageBox(Handle, PWideChar(Svar), 'Stregkode', MB_OK);
4024    CheckCode();    CheckCode();
# Line 4079  end; Line 4026  end;
4026    
4027  end;  end;
4028    
 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;  
4029    
4030  //  //
4031  // Bladhus ***  // Bladhus ***
# Line 4619  begin Line 4527  begin
4527      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
4528  end;  end;
4529    
 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;  
4530    
4531  // ToDo: PrintPakkeshopLabel()  // ToDo: PrintPakkeshopLabel()
4532  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
# Line 4922  var Line 4817  var
4817  //                    stregkoderMedTjekkodeArray[linienr] := stregkode;  //                    stregkoderMedTjekkodeArray[linienr] := stregkode;
4818                    if (pos(' ', stregkode) > 0) then                    if (pos(' ', stregkode) > 0) then
4819                    begin                    begin
4820                      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
4821                    end                    end
4822                    else                    else
4823                    begin                    begin
# Line 5204  begin Line 5099  begin
5099          ReadLn(SomeTxtFile, buffer) ;          ReadLn(SomeTxtFile, buffer) ;
5100          S := buffer;          S := buffer;
5101          SetLength(A,0);          SetLength(A,0);
5102          Explode(A, ';', S);          TUtils.Explode(A, ';', S);
5103          if (length(A) < 2) then          if (length(A) < 2) then
5104          begin          begin
5105            Explode(A, ',', S);            TUtils.Explode(A, ',', S);
5106          end;          end;
5107            if (length(A) > 1) then            if (length(A) > 1) then
5108            begin            begin
# Line 5281  begin Line 5176  begin
5176          ReadLn(SomeTxtFile, buffer) ;          ReadLn(SomeTxtFile, buffer) ;
5177          S := buffer;          S := buffer;
5178          SetLength(A,0);          SetLength(A,0);
5179          Explode(A, ';', S);          TUtils.Explode(A, ';', S);
5180          if (length(A) < 3) then          if (length(A) < 3) then
5181          begin          begin
5182            Explode(A, ',', S);            TUtils.Explode(A, ',', S);
5183          end;          end;
5184          if (A[0]=imorgenYmd) then          if (A[0]=imorgenYmd) then
5185          begin          begin
# Line 5538  begin Line 5433  begin
5433  end;  end;
5434    
5435    
 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;  
   
5436  procedure TMainForm.CheckPrintQue(tjektype : string);  procedure TMainForm.CheckPrintQue(tjektype : string);
5437  type  type
5438    TJobs  = array [0..1000] of JOB_INFO_1;    TJobs  = array [0..1000] of JOB_INFO_1;
Legend:
Removed from v.2681  
changed lines
  Added in v.2682
  ViewVC Help
Powered by ViewVC 1.1.20