/[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 2668 by torben, Tue Aug 25 16:34:41 2015 UTC revision 2682 by torben, Wed Aug 26 19:52:38 2015 UTC
# Line 10  uses Line 10  uses
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    PakkeshopLabels,
14      StBarC,
15      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 92  type Line 94  type
94      menuIndlevering: TMenuItem;      menuIndlevering: TMenuItem;
95    
96    
97    function Explode(var a: TStrArray; Border, S: string): Integer;    function Sto_GetFmtFileVersion(const FileName: String = ''): String;
98    function BarCodeValid (ACode: string): boolean;  
   function Sto_GetFmtFileVersion(const FileName: String = ''; const Fmt: String = '%d.%d.%d.%d'): String;  
   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 104  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 183  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 251  type Line 248  type
248      BoghandlerStregkode, BoghandlerTjekkode : String;      BoghandlerStregkode, BoghandlerTjekkode : String;
249      TjekUrls : String;      TjekUrls : String;
250    
251      PakkeshopLabel: TPakkeshopLabel;      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 271  type Line 267  type
267      { Public declarations }      { Public declarations }
268    end;    end;
269    
270          function GetPixelsPerInchX(): Integer;
271        function GetPixelsPerInchY(): Integer;
272    
273  var  var
274    MainForm: TMainForm;    MainForm: TMainForm;
275    
# Line 284  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 309  begin Line 291  begin
291      StaticTextManglendePakker.Caption := '';      StaticTextManglendePakker.Caption := '';
292  // 20150309: slut  // 20150309: slut
293    
294        Barcode := TStBarcode.Create(MainForm);//Dynamisk oprettelse af Barcode component
295    
296      PanelValg1.Color := clBtnFace;      PanelValg1.Color := clBtnFace;
297      if PanelValg1.Enabled = true then      if PanelValg1.Enabled = true then
298      begin      begin
# Line 405  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 465  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 553  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 634  begin Line 618  begin
618    
619      if (SkrivLog = '1') then      if (SkrivLog = '1') then
620      begin      begin
621        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);
622        try        try
623          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
624          Uploadlogfil1.Enabled := true;          Uploadlogfil1.Enabled := true;
# Line 777  begin Line 761  begin
761      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)
762      // *************************** //      // *************************** //
763    
764    {$IfDef STED_BK}
765        SpecialVersionSted := 'BK';
766    {$EndIf}
767    {$IfDef STED_DBK}
768        SpecialVersionSted := 'DBK';
769    {$EndIf}
770    {$IfDef STED_FD}
771        SpecialVersionSted := 'FD';
772    {$EndIf}
773    {$IfDef STED_NS}
774        SpecialVersionSted := 'NS';
775    {$EndIf}
776    
777    
778      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
779      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)
780      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
# Line 1148  begin Line 1146  begin
1146      Scanningtype := gemScanningtype;      Scanningtype := gemScanningtype;
1147    
1148      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');
1149      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion('',''));      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion(''));
1150    
1151  end;  end;
1152    
# Line 1600  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 1662  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 1675  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 1800  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 2068  var Line 2066  var
2066    URLStr : String;    URLStr : String;
2067    pakkestorrelse : String;    pakkestorrelse : String;
2068    PrintNyLabelInteger : Integer;    PrintNyLabelInteger : Integer;
2069    
2070      PakkeshopLabel: TPakkeshopLabel;
2071  begin  begin
2072    if radioStorPakke.Checked then    if radioStorPakke.Checked then
2073    begin    begin
# Line 2170  begin Line 2170  begin
2170       begin       begin
2171         PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label         PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label
2172         PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc         PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc
2173           RuteNummer := PakkeshopLabel.Koreliste;
2174    
2175         PrintPakkeshopLabel( PakkeshopLabel );         PrintPakkeshopLabel( PakkeshopLabel );
2176    
# Line 2325  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 2381  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 3070  begin Line 3071  begin
3071      repeat      repeat
3072        if (SR.Attr <> faDirectory) then        if (SR.Attr <> faDirectory) then
3073        begin        begin
3074    
3075          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring
3076          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse
3077          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse
# Line 3131  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 3331  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 3369  var Line 3342  var
3342   tekst, filversion : String;   tekst, filversion : String;
3343  begin  begin
3344    
3345    filversion := Sto_GetFmtFileVersion('','');    filversion := Sto_GetFmtFileVersion('');
3346    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';
3347    
3348    tekst := tekst+crlf+crlf;    tekst := tekst+crlf+crlf;
# Line 3391  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 3823  end; Line 3796  end;
3796  ///   values.</param>  ///   values.</param>
3797  /// <returns>Formatted version number of file, '' if no version  /// <returns>Formatted version number of file, '' if no version
3798  ///   resource found.</returns>  ///   resource found.</returns>
3799  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = '';  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = ''): String;
   const Fmt: String = '%d.%d.%d.%d'): String;  
3800  var  var
3801    sFileName: String;    sFileName: String;
3802    iBufferSize: DWORD;    iBufferSize: DWORD;
3803    iDummy: DWORD;    iDummy: DWORD;
3804    pBuffer: Pointer;    pBuffer: Pointer;
3805    pFileInfo: Pointer;    pFileInfo: Pointer;
3806    iVer: array[1..4] of Word;    iVer: array[1..4] of Integer;
   S : String;  
3807  begin  begin
3808    // set default value    // set default value
3809    Result := '';    Result := '';
# Line 3857  begin Line 3828  begin
3828      finally      finally
3829        FreeMem(pBuffer);        FreeMem(pBuffer);
3830      end;      end;
3831    
3832      // format result string      // format result string
3833      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]]);
3834    
     // 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;  
3835    end;    end;
3836  end;  end;
3837    
# Line 4057  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 4065  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 4605  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: Færdiggør implementationen  // ToDo: PrintPakkeshopLabel()
4532  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
4533    var
4534      XForm, XFormOld: TXForm; //Bruges til rotate X-formation
4535      Angle: integer;
4536      gMode: integer;
4537      BarcodeArea: TRect;
4538      Dirigering: string;
4539    
4540  begin  begin
4541      with Printer do      with Printer do
4542      begin      begin
4543        BeginDoc();        BeginDoc();
       Canvas.Font.Size := FontSizeRuteLille;  
4544    
4545        Canvas.Font.Size := FontSizeKorelisteLille;  
4546        Canvas.TextOut(XPosKoreliste,YPosKoreliste, PakkeshopLabel.Navn);        Canvas.Font.Size := 16;
4547          Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);
4548    
4549    
4550    
4551          Canvas.TextOut(25, 90, PakkeshopLabel.Navn );
4552          Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn );
4553          Canvas.TextOut(25, 180, PakkeshopLabel.Postnr );
4554    
4555    
4556          Canvas.Font.Size := 9;
4557          Canvas.TextOut(110, 240, 'Pakkeshop:');
4558          Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);
4559          Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);
4560          Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);
4561    
4562          Canvas.TextOut(350, 240, 'Afsender:');
4563          Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);
4564          Canvas.TextOut(350, 300, PakkeshopLabel.AfsenderAdresse);
4565          Canvas.TextOut(350, 330, PakkeshopLabel.AfsenderPostnr);
4566    
4567          Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr;
4568          if ( PakkeshopLabel.Koreliste <> '') then
4569          begin
4570            Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
4571          end;
4572    
4573    
4574          Canvas.Font.Size := 12;
4575          Canvas.TextOut(15, 370, Dirigering);
4576    
4577    
4578    
4579    
4580    
4581          //Tegn adskillelses linier
4582          Canvas.Pen.Width := 2;
4583          //Øverste linie
4584          Canvas.MoveTo(20,80);
4585          Canvas.LineTo(600,80);
4586    
4587          // Midterste linie
4588          Canvas.MoveTo( 20, 240);
4589          Canvas.LineTo(600, 240);
4590    
4591          //Nederste linie
4592          Canvas.MoveTo( 20, 370);
4593          Canvas.LineTo(600, 370);
4594    
4595    
4596          //Tegn skrå streger over afsender
4597          Canvas.Pen.Width := 1;
4598          Canvas.MoveTo(600, 250);
4599          Canvas.LineTo(350, 360);
4600          Canvas.MoveTo(600, 360);
4601          Canvas.LineTo(350, 250);
4602    
4603    
4604    
4605    
4606          // Resten af rutinen vedr genering og placering af Barcode
4607    
4608          BarCode.BarCodeType := bcCode128;
4609          BarCode.Code128Subset := csCodeC;
4610          BarCode.Code := PakkeshopLabel.Stregkode;
4611          BarCode.Validate(True);
4612    
4613          //Start X-formation
4614          //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
4615          GetWorldTransform(Canvas.Handle, XFormOld);
4616    
4617          Angle := 270;
4618          XForm.eM11 := Cos(DegToRad(Angle));
4619          XForm.eM12 := Sin(DegToRad(Angle));
4620          XForm.eM21 := -Sin(DegToRad(Angle));
4621          XForm.eM22 := Cos(DegToRad(Angle));
4622          XForm.eDx := 0;
4623          XForm.eDy := 0;
4624    
4625          gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
4626          SetWorldTransform(Canvas.Handle, XForm);
4627    
4628          // PaintToCanvasSize arbejder i Inches
4629          // Første pos argument bliver nu Y og skal være negativ for at rykke den ned
4630          //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre
4631    
4632          BarCode.PaintToCanvasSize(Printer.Canvas, -1.8, 3.3, 0.4);
4633    
4634    
4635          SetWorldTransform(Canvas.Handle, XFormOld);
4636          SetGraphicsMode(Canvas.Handle, gMode);
4637    
4638        EndDoc();        EndDoc();
4639      end;      end;
4640    
4641    
4642    end;
4643    
4644    function GetPixelsPerInchX(): Integer;
4645    begin
4646      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)
4647    end;
4648    
4649    function GetPixelsPerInchY(): Integer;
4650    begin
4651      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
4652  end;  end;
4653    
4654    
# Line 4802  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 4992  var Line 5007  var
5007     idag, imorgen : TDateTime;     idag, imorgen : TDateTime;
5008     imorgenYmd : string;     imorgenYmd : string;
5009     logFilnavn : string;     logFilnavn : string;
5010      error : Integer;     //error : Integer;
5011    
5012  begin  begin
5013    if (SkrivLog = '1') then    if (SkrivLog = '1') then
# Line 5084  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 5161  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 5380  end; Line 5395  end;
5395    
5396  function TMainForm.CheckUrl(url:string):boolean;  function TMainForm.CheckUrl(url:string):boolean;
5397  var  var
5398    hSession, hfile, hRequest: hInternet;    hSession, hfile: hInternet;
5399    dwindex,dwcodelen :dword;    dwindex,dwcodelen :dword;
5400    dwcode:array[1..20] of char;    dwcode:array[1..20] of char;
5401    res : pchar;    res : pchar;
# Line 5418  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.2668  
changed lines
  Added in v.2682
  ViewVC Help
Powered by ViewVC 1.1.20