/[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 2680 by torben, Wed Aug 26 18:53:11 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    
17    
18    ;    ;
19    
# Line 94  type Line 97  type
97    
98    function Explode(var a: TStrArray; Border, S: string): Integer;    function Explode(var a: TStrArray; Border, S: string): Integer;
99    function BarCodeValid (ACode: string): boolean;    function BarCodeValid (ACode: string): boolean;
100    function Sto_GetFmtFileVersion(const FileName: String = ''; const Fmt: String = '%d.%d.%d.%d'): String;    function Sto_GetFmtFileVersion(const FileName: String = ''): String;
101    function TColorToHex(Color : TColor) : string;    function TColorToHex(Color : TColor) : string;
102    function HexToTColor(sColor : string) : TColor;    function HexToTColor(sColor : string) : TColor;
103    function getProddato() : TDate;    function getProddato() : TDate;
# Line 251  type Line 254  type
254      BoghandlerStregkode, BoghandlerTjekkode : String;      BoghandlerStregkode, BoghandlerTjekkode : String;
255      TjekUrls : String;      TjekUrls : String;
256    
257      PakkeshopLabel: TPakkeshopLabel;      Barcode : TStBarcode;
258    
259            function CheckSumModulo10(const data:string):string;          { used for EAN 8/13 }            function CheckSumModulo10(const data:string):string;          { used for EAN 8/13 }
260    
# Line 271  type Line 274  type
274      { Public declarations }      { Public declarations }
275    end;    end;
276    
277          function GetPixelsPerInchX(): Integer;
278        function GetPixelsPerInchY(): Integer;
279    
280  var  var
281    MainForm: TMainForm;    MainForm: TMainForm;
282    
# Line 309  begin Line 315  begin
315      StaticTextManglendePakker.Caption := '';      StaticTextManglendePakker.Caption := '';
316  // 20150309: slut  // 20150309: slut
317    
318        Barcode := TStBarcode.Create(MainForm);//Dynamisk oprettelse af Barcode component
319    
320      PanelValg1.Color := clBtnFace;      PanelValg1.Color := clBtnFace;
321      if PanelValg1.Enabled = true then      if PanelValg1.Enabled = true then
322      begin      begin
# Line 634  begin Line 642  begin
642    
643      if (SkrivLog = '1') then      if (SkrivLog = '1') then
644      begin      begin
645        logTekst := 'Program start (Version: ' + Sto_GetFmtFileVersion('','') + ') Dato: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss',now);        logTekst := 'Program start (Version: ' + Sto_GetFmtFileVersion('') + ') Dato: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss',now);
646        try        try
647          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
648          Uploadlogfil1.Enabled := true;          Uploadlogfil1.Enabled := true;
# Line 777  begin Line 785  begin
785      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)
786      // *************************** //      // *************************** //
787    
788    {$IfDef STED_BK}
789        SpecialVersionSted := 'BK';
790    {$EndIf}
791    {$IfDef STED_DBK}
792        SpecialVersionSted := 'DBK';
793    {$EndIf}
794    {$IfDef STED_FD}
795        SpecialVersionSted := 'FD';
796    {$EndIf}
797    {$IfDef STED_NS}
798        SpecialVersionSted := 'NS';
799    {$EndIf}
800    
801    
802      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
803      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)
804      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
# Line 1148  begin Line 1170  begin
1170      Scanningtype := gemScanningtype;      Scanningtype := gemScanningtype;
1171    
1172      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');
1173      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion('',''));      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion(''));
1174    
1175  end;  end;
1176    
# Line 2068  var Line 2090  var
2090    URLStr : String;    URLStr : String;
2091    pakkestorrelse : String;    pakkestorrelse : String;
2092    PrintNyLabelInteger : Integer;    PrintNyLabelInteger : Integer;
2093    
2094      PakkeshopLabel: TPakkeshopLabel;
2095  begin  begin
2096    if radioStorPakke.Checked then    if radioStorPakke.Checked then
2097    begin    begin
# Line 2170  begin Line 2194  begin
2194       begin       begin
2195         PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label         PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label
2196         PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc         PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc
2197           RuteNummer := PakkeshopLabel.Koreliste;
2198    
2199         PrintPakkeshopLabel( PakkeshopLabel );         PrintPakkeshopLabel( PakkeshopLabel );
2200    
# Line 3070  begin Line 3095  begin
3095      repeat      repeat
3096        if (SR.Attr <> faDirectory) then        if (SR.Attr <> faDirectory) then
3097        begin        begin
3098    
3099          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring
3100          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse
3101          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse
# Line 3369  var Line 3395  var
3395   tekst, filversion : String;   tekst, filversion : String;
3396  begin  begin
3397    
3398    filversion := Sto_GetFmtFileVersion('','');    filversion := Sto_GetFmtFileVersion('');
3399    tekst := 'Program til indscanning af pakker'+crlf+'Version '+filversion+crlf+crlf+'Udviklet af it afdelingen, DAO';    tekst := 'Program til indscanning af pakker'+crlf+'Version '+filversion+crlf+crlf+'Udviklet af it afdelingen, DAO';
3400    
3401    tekst := tekst+crlf+crlf;    tekst := tekst+crlf+crlf;
# Line 3823  end; Line 3849  end;
3849  ///   values.</param>  ///   values.</param>
3850  /// <returns>Formatted version number of file, '' if no version  /// <returns>Formatted version number of file, '' if no version
3851  ///   resource found.</returns>  ///   resource found.</returns>
3852  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = '';  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = ''): String;
   const Fmt: String = '%d.%d.%d.%d'): String;  
3853  var  var
3854    sFileName: String;    sFileName: String;
3855    iBufferSize: DWORD;    iBufferSize: DWORD;
3856    iDummy: DWORD;    iDummy: DWORD;
3857    pBuffer: Pointer;    pBuffer: Pointer;
3858    pFileInfo: Pointer;    pFileInfo: Pointer;
3859    iVer: array[1..4] of Word;    iVer: array[1..4] of Integer;
   S : String;  
3860  begin  begin
3861    // set default value    // set default value
3862    Result := '';    Result := '';
# Line 3857  begin Line 3881  begin
3881      finally      finally
3882        FreeMem(pBuffer);        FreeMem(pBuffer);
3883      end;      end;
3884    
3885      // format result string      // format result string
3886      Result := Format(Fmt, [iVer[1], iVer[2], iVer[3], iVer[4]]);      Result := Format('%d.%d.%d.%d', [iVer[1], iVer[2], iVer[3], iVer[4]]);
3887    
     // Hvorfor virker ovenstående ikke ???  
     S := '';  
     Str(iVer[1], Result);  
     S := S+Result+'.';  
     Str(iVer[2], Result);  
     S := S+Result+'.';  
     Str(iVer[3], Result);  
     S := S+Result+'.';  
     Str(iVer[4], Result);  
     S := S+Result+'';  
     Result := S;  
3888    end;    end;
3889  end;  end;
3890    
# Line 4619  begin Line 4633  begin
4633    until S2 = '';    until S2 = '';
4634  end;  end;
4635    
4636  // ToDo: Færdiggør implementationen  // ToDo: PrintPakkeshopLabel()
4637  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
4638    var
4639      XForm, XFormOld: TXForm; //Bruges til rotate X-formation
4640      Angle: integer;
4641      gMode: integer;
4642      BarcodeArea: TRect;
4643      Dirigering: string;
4644    
4645  begin  begin
4646      with Printer do      with Printer do
4647      begin      begin
4648        BeginDoc();        BeginDoc();
       Canvas.Font.Size := FontSizeRuteLille;  
4649    
4650        Canvas.Font.Size := FontSizeKorelisteLille;  
4651        Canvas.TextOut(XPosKoreliste,YPosKoreliste, PakkeshopLabel.Navn);        Canvas.Font.Size := 16;
4652          Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);
4653    
4654    
4655    
4656          Canvas.TextOut(25, 90, PakkeshopLabel.Navn );
4657          Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn );
4658          Canvas.TextOut(25, 180, PakkeshopLabel.Postnr );
4659    
4660    
4661          Canvas.Font.Size := 9;
4662          Canvas.TextOut(110, 240, 'Pakkeshop:');
4663          Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);
4664          Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);
4665          Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);
4666    
4667          Canvas.TextOut(350, 240, 'Afsender:');
4668          Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);
4669          Canvas.TextOut(350, 300, PakkeshopLabel.AfsenderAdresse);
4670          Canvas.TextOut(350, 330, PakkeshopLabel.AfsenderPostnr);
4671    
4672          Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr;
4673          if ( PakkeshopLabel.Koreliste <> '') then
4674          begin
4675            Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
4676          end;
4677    
4678    
4679          Canvas.Font.Size := 12;
4680          Canvas.TextOut(15, 370, Dirigering);
4681    
4682    
4683    
4684    
4685    
4686          //Tegn adskillelses linier
4687          Canvas.Pen.Width := 2;
4688          //Øverste linie
4689          Canvas.MoveTo(20,80);
4690          Canvas.LineTo(600,80);
4691    
4692          // Midterste linie
4693          Canvas.MoveTo( 20, 240);
4694          Canvas.LineTo(600, 240);
4695    
4696          //Nederste linie
4697          Canvas.MoveTo( 20, 370);
4698          Canvas.LineTo(600, 370);
4699    
4700    
4701          //Tegn skrå streger over afsender
4702          Canvas.Pen.Width := 1;
4703          Canvas.MoveTo(600, 250);
4704          Canvas.LineTo(350, 360);
4705          Canvas.MoveTo(600, 360);
4706          Canvas.LineTo(350, 250);
4707    
4708    
4709    
4710    
4711          // Resten af rutinen vedr genering og placering af Barcode
4712    
4713          BarCode.BarCodeType := bcCode128;
4714          BarCode.Code128Subset := csCodeC;
4715          BarCode.Code := PakkeshopLabel.Stregkode;
4716          BarCode.Validate(True);
4717    
4718          //Start X-formation
4719          //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
4720          GetWorldTransform(Canvas.Handle, XFormOld);
4721    
4722          Angle := 270;
4723          XForm.eM11 := Cos(DegToRad(Angle));
4724          XForm.eM12 := Sin(DegToRad(Angle));
4725          XForm.eM21 := -Sin(DegToRad(Angle));
4726          XForm.eM22 := Cos(DegToRad(Angle));
4727          XForm.eDx := 0;
4728          XForm.eDy := 0;
4729    
4730          gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
4731          SetWorldTransform(Canvas.Handle, XForm);
4732    
4733          // PaintToCanvasSize arbejder i Inches
4734          // Første pos argument bliver nu Y og skal være negativ for at rykke den ned
4735          //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre
4736    
4737          BarCode.PaintToCanvasSize(Printer.Canvas, -1.8, 3.3, 0.4);
4738    
4739    
4740          SetWorldTransform(Canvas.Handle, XFormOld);
4741          SetGraphicsMode(Canvas.Handle, gMode);
4742    
4743        EndDoc();        EndDoc();
4744      end;      end;
4745    
4746    
4747    end;
4748    
4749    function GetPixelsPerInchX(): Integer;
4750    begin
4751      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)
4752    end;
4753    
4754    function GetPixelsPerInchY(): Integer;
4755    begin
4756      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
4757  end;  end;
4758    
4759    
# Line 4992  var Line 5112  var
5112     idag, imorgen : TDateTime;     idag, imorgen : TDateTime;
5113     imorgenYmd : string;     imorgenYmd : string;
5114     logFilnavn : string;     logFilnavn : string;
5115      error : Integer;     //error : Integer;
5116    
5117  begin  begin
5118    if (SkrivLog = '1') then    if (SkrivLog = '1') then
# Line 5380  end; Line 5500  end;
5500    
5501  function TMainForm.CheckUrl(url:string):boolean;  function TMainForm.CheckUrl(url:string):boolean;
5502  var  var
5503    hSession, hfile, hRequest: hInternet;    hSession, hfile: hInternet;
5504    dwindex,dwcodelen :dword;    dwindex,dwcodelen :dword;
5505    dwcode:array[1..20] of char;    dwcode:array[1..20] of char;
5506    res : pchar;    res : pchar;
Legend:
Removed from v.2668  
changed lines
  Added in v.2680
  ViewVC Help
Powered by ViewVC 1.1.20