/[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 2683 by torben, Wed Aug 26 19:56:26 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 210  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 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 514  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 553  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 634  begin Line 602  begin
602    
603      if (SkrivLog = '1') then      if (SkrivLog = '1') then
604      begin      begin
605        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);
606        try        try
607          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
608          Uploadlogfil1.Enabled := true;          Uploadlogfil1.Enabled := true;
# Line 777  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 792  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 803  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 1148  begin Line 1128  begin
1128      Scanningtype := gemScanningtype;      Scanningtype := gemScanningtype;
1129    
1130      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');
1131      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion('',''));      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion(''));
1132    
1133  end;  end;
1134    
# Line 1600  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 1662  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 1675  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 1800  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 2068  var Line 2048  var
2048    URLStr : String;    URLStr : String;
2049    pakkestorrelse : String;    pakkestorrelse : String;
2050    PrintNyLabelInteger : Integer;    PrintNyLabelInteger : Integer;
2051    
2052      PakkeshopLabel: TPakkeshopLabel;
2053  begin  begin
2054    if radioStorPakke.Checked then    if radioStorPakke.Checked then
2055    begin    begin
# Line 2170  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 2325  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 2381  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 3070  begin Line 3053  begin
3053      repeat      repeat
3054        if (SR.Attr <> faDirectory) then        if (SR.Attr <> faDirectory) then
3055        begin        begin
3056    
3057          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring
3058          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse
3059          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse
# Line 3131  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 3331  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 3369  var Line 3324  var
3324   tekst, filversion : String;   tekst, filversion : String;
3325  begin  begin
3326    
3327    filversion := Sto_GetFmtFileVersion('','');    filversion := Sto_GetFmtFileVersion('');
3328    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';
3329    
3330    tekst := tekst+crlf+crlf;    tekst := tekst+crlf+crlf;
# Line 3391  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 3823  end; Line 3778  end;
3778  ///   values.</param>  ///   values.</param>
3779  /// <returns>Formatted version number of file, '' if no version  /// <returns>Formatted version number of file, '' if no version
3780  ///   resource found.</returns>  ///   resource found.</returns>
3781  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = '';  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = ''): String;
   const Fmt: String = '%d.%d.%d.%d'): String;  
3782  var  var
3783    sFileName: String;    sFileName: String;
3784    iBufferSize: DWORD;    iBufferSize: DWORD;
3785    iDummy: DWORD;    iDummy: DWORD;
3786    pBuffer: Pointer;    pBuffer: Pointer;
3787    pFileInfo: Pointer;    pFileInfo: Pointer;
3788    iVer: array[1..4] of Word;    iVer: array[1..4] of Integer;
   S : String;  
3789  begin  begin
3790    // set default value    // set default value
3791    Result := '';    Result := '';
# Line 3857  begin Line 3810  begin
3810      finally      finally
3811        FreeMem(pBuffer);        FreeMem(pBuffer);
3812      end;      end;
3813    
3814      // format result string      // format result string
3815      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]]);
3816    
     // 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;  
3817    end;    end;
3818  end;  end;
3819    
# Line 4057  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 4065  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 4605  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: Færdiggør implementationen  // ToDo: PrintPakkeshopLabel()
4514  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
4515    var
4516      XForm, XFormOld: TXForm; //Bruges til rotate X-formation
4517      Angle: integer;
4518      gMode: integer;
4519      BarcodeArea: TRect;
4520      Dirigering: string;
4521    
4522  begin  begin
4523      with Printer do      with Printer do
4524      begin      begin
4525        BeginDoc();        BeginDoc();
       Canvas.Font.Size := FontSizeRuteLille;  
4526    
       Canvas.Font.Size := FontSizeKorelisteLille;  
       Canvas.TextOut(XPosKoreliste,YPosKoreliste, PakkeshopLabel.Navn);  
4527    
4528          Canvas.Font.Size := 16;
4529          Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);
4530    
4531    
4532    
4533          Canvas.TextOut(25, 90, PakkeshopLabel.Navn );
4534          Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn );
4535          Canvas.TextOut(25, 180, PakkeshopLabel.Postnr );
4536    
4537    
4538          Canvas.Font.Size := 9;
4539          Canvas.TextOut(110, 240, 'Pakkeshop:');
4540          Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);
4541          Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);
4542          Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);
4543    
4544          Canvas.TextOut(350, 240, 'Afsender:');
4545          Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);
4546          Canvas.TextOut(350, 300, PakkeshopLabel.AfsenderAdresse);
4547          Canvas.TextOut(350, 330, PakkeshopLabel.AfsenderPostnr);
4548    
4549          Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr;
4550          if ( PakkeshopLabel.Koreliste <> '') then
4551          begin
4552            Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
4553          end;
4554    
4555    
4556          Canvas.Font.Size := 12;
4557          Canvas.TextOut(15, 370, Dirigering);
4558    
4559    
4560    
4561    
4562    
4563          //Tegn adskillelses linier
4564          Canvas.Pen.Width := 2;
4565          //Øverste linie
4566          Canvas.MoveTo(20,80);
4567          Canvas.LineTo(600,80);
4568    
4569          // Midterste linie
4570          Canvas.MoveTo( 20, 240);
4571          Canvas.LineTo(600, 240);
4572    
4573          //Nederste linie
4574          Canvas.MoveTo( 20, 370);
4575          Canvas.LineTo(600, 370);
4576    
4577    
4578          //Tegn skrå streger over afsender
4579          Canvas.Pen.Width := 1;
4580          Canvas.MoveTo(600, 250);
4581          Canvas.LineTo(350, 360);
4582          Canvas.MoveTo(600, 360);
4583          Canvas.LineTo(350, 250);
4584    
4585    
4586    
4587    
4588          // Resten af rutinen vedr genering og placering af Barcode
4589    
4590          BarCode.BarCodeType := bcCode128;
4591          BarCode.Code128Subset := csCodeC;
4592          BarCode.Code := PakkeshopLabel.Stregkode;
4593          BarCode.Validate(True);
4594    
4595          //Start X-formation
4596          //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
4597          GetWorldTransform(Canvas.Handle, XFormOld);
4598    
4599          Angle := 270;
4600          XForm.eM11 := Cos(DegToRad(Angle));
4601          XForm.eM12 := Sin(DegToRad(Angle));
4602          XForm.eM21 := -Sin(DegToRad(Angle));
4603          XForm.eM22 := Cos(DegToRad(Angle));
4604          XForm.eDx := 0;
4605          XForm.eDy := 0;
4606    
4607          gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
4608          SetWorldTransform(Canvas.Handle, XForm);
4609    
4610          // PaintToCanvasSize arbejder i Inches
4611          // Første pos argument bliver nu Y og skal være negativ for at rykke den ned
4612          //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre
4613    
4614          BarCode.PaintToCanvasSize(Printer.Canvas, -1.8, 3.3, 0.4);
4615    
4616    
4617          SetWorldTransform(Canvas.Handle, XFormOld);
4618          SetGraphicsMode(Canvas.Handle, gMode);
4619    
4620        EndDoc();        EndDoc();
4621      end;      end;
4622    
4623    
4624    end;
4625    
4626    function GetPixelsPerInchX(): Integer;
4627    begin
4628      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)
4629    end;
4630    
4631    function GetPixelsPerInchY(): Integer;
4632    begin
4633      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
4634  end;  end;
4635    
4636    
# Line 4802  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 4992  var Line 4989  var
4989     idag, imorgen : TDateTime;     idag, imorgen : TDateTime;
4990     imorgenYmd : string;     imorgenYmd : string;
4991     logFilnavn : string;     logFilnavn : string;
4992      error : Integer;     //error : Integer;
4993    
4994  begin  begin
4995    if (SkrivLog = '1') then    if (SkrivLog = '1') then
# Line 5084  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 5161  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 5380  end; Line 5377  end;
5377    
5378  function TMainForm.CheckUrl(url:string):boolean;  function TMainForm.CheckUrl(url:string):boolean;
5379  var  var
5380    hSession, hfile, hRequest: hInternet;    hSession, hfile: hInternet;
5381    dwindex,dwcodelen :dword;    dwindex,dwcodelen :dword;
5382    dwcode:array[1..20] of char;    dwcode:array[1..20] of char;
5383    res : pchar;    res : pchar;
# Line 5418  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.2668  
changed lines
  Added in v.2683
  ViewVC Help
Powered by ViewVC 1.1.20