/[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 2676 by torben, Tue Aug 25 16:34:41 2015 UTC revision 2677 by torben, Wed Aug 26 13:09: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    
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        Barcode : TStBarcode;
258    
259      PakkeshopLabel: TPakkeshopLabel;      PakkeshopLabel: TPakkeshopLabel;
260    
261            function CheckSumModulo10(const data:string):string;          { used for EAN 8/13 }            function CheckSumModulo10(const data:string):string;          { used for EAN 8/13 }
# Line 271  type Line 276  type
276      { Public declarations }      { Public declarations }
277    end;    end;
278    
279          function GetPixelsPerInchX(): Integer;
280        function GetPixelsPerInchY(): Integer;
281    
282  var  var
283    MainForm: TMainForm;    MainForm: TMainForm;
284    
# Line 309  begin Line 317  begin
317      StaticTextManglendePakker.Caption := '';      StaticTextManglendePakker.Caption := '';
318  // 20150309: slut  // 20150309: slut
319    
320        Barcode := TStBarcode.Create(MainForm);//Dynamisk oprettelse af Barcode component
321    
322      PanelValg1.Color := clBtnFace;      PanelValg1.Color := clBtnFace;
323      if PanelValg1.Enabled = true then      if PanelValg1.Enabled = true then
324      begin      begin
# Line 634  begin Line 644  begin
644    
645      if (SkrivLog = '1') then      if (SkrivLog = '1') then
646      begin      begin
647        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);
648        try        try
649          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
650          Uploadlogfil1.Enabled := true;          Uploadlogfil1.Enabled := true;
# Line 1148  begin Line 1158  begin
1158      Scanningtype := gemScanningtype;      Scanningtype := gemScanningtype;
1159    
1160      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');
1161      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion('',''));      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion(''));
1162    
1163  end;  end;
1164    
# Line 3070  begin Line 3080  begin
3080      repeat      repeat
3081        if (SR.Attr <> faDirectory) then        if (SR.Attr <> faDirectory) then
3082        begin        begin
3083    
3084          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring
3085          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse
3086          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse
# Line 3369  var Line 3380  var
3380   tekst, filversion : String;   tekst, filversion : String;
3381  begin  begin
3382    
3383    filversion := Sto_GetFmtFileVersion('','');    filversion := Sto_GetFmtFileVersion('');
3384    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';
3385    
3386    tekst := tekst+crlf+crlf;    tekst := tekst+crlf+crlf;
# Line 3823  end; Line 3834  end;
3834  ///   values.</param>  ///   values.</param>
3835  /// <returns>Formatted version number of file, '' if no version  /// <returns>Formatted version number of file, '' if no version
3836  ///   resource found.</returns>  ///   resource found.</returns>
3837  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = '';  function TMainForm.Sto_GetFmtFileVersion(const FileName: String = ''): String;
   const Fmt: String = '%d.%d.%d.%d'): String;  
3838  var  var
3839    sFileName: String;    sFileName: String;
3840    iBufferSize: DWORD;    iBufferSize: DWORD;
3841    iDummy: DWORD;    iDummy: DWORD;
3842    pBuffer: Pointer;    pBuffer: Pointer;
3843    pFileInfo: Pointer;    pFileInfo: Pointer;
3844    iVer: array[1..4] of Word;    iVer: array[1..4] of Integer;
   S : String;  
3845  begin  begin
3846    // set default value    // set default value
3847    Result := '';    Result := '';
# Line 3857  begin Line 3866  begin
3866      finally      finally
3867        FreeMem(pBuffer);        FreeMem(pBuffer);
3868      end;      end;
3869    
3870      // format result string      // format result string
3871      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]]);
3872    
     // 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;  
3873    end;    end;
3874  end;  end;
3875    
# Line 4619  begin Line 4618  begin
4618    until S2 = '';    until S2 = '';
4619  end;  end;
4620    
4621  // ToDo: Færdiggør implementationen  // ToDo: PrintPakkeshopLabel()
4622  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
4623    var
4624      XForm, XFormOld: TXForm; //Bruges til rotate X-formation
4625      Angle: integer;
4626      gMode: integer;
4627      BarcodeArea: TRect;
4628      Dirigering: string;
4629    
4630  begin  begin
4631      with Printer do      with Printer do
4632      begin      begin
4633        BeginDoc();        BeginDoc();
       Canvas.Font.Size := FontSizeRuteLille;  
4634    
4635        Canvas.Font.Size := FontSizeKorelisteLille;  
4636        Canvas.TextOut(XPosKoreliste,YPosKoreliste, PakkeshopLabel.Navn);        Canvas.Font.Size := 16;
4637          Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);
4638    
4639    
4640    
4641          Canvas.TextOut(25, 90, PakkeshopLabel.Navn );
4642          Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn );
4643          Canvas.TextOut(25, 180, PakkeshopLabel.Postnr );
4644    
4645    
4646          Canvas.Font.Size := 9;
4647          Canvas.TextOut(110, 240, 'Pakkeshop:');
4648          Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);
4649          Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);
4650          Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);
4651    
4652          Canvas.TextOut(350, 240, 'Afsender:');
4653          Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);
4654          Canvas.TextOut(350, 300, PakkeshopLabel.AfsenderAdresse);
4655          Canvas.TextOut(350, 330, PakkeshopLabel.AfsenderPostnr);
4656    
4657          Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr;
4658          if ( PakkeshopLabel.Koreliste <> '') then
4659          begin
4660            Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
4661          end;
4662    
4663    
4664          Canvas.Font.Size := 12;
4665          Canvas.TextOut(15, 370, Dirigering);
4666    
4667    
4668    
4669    
4670    
4671          //Tegn adskillelses linier
4672          Canvas.Pen.Width := 2;
4673          //Øverste linie
4674          Canvas.MoveTo(20,80);
4675          Canvas.LineTo(600,80);
4676    
4677          // Midterste linie
4678          Canvas.MoveTo( 20, 240);
4679          Canvas.LineTo(600, 240);
4680    
4681          //Nederste linie
4682          Canvas.MoveTo( 20, 370);
4683          Canvas.LineTo(600, 370);
4684    
4685    
4686          //Tegn skrå streger over afsender
4687          Canvas.Pen.Width := 1;
4688          Canvas.MoveTo(600, 250);
4689          Canvas.LineTo(350, 360);
4690          Canvas.MoveTo(600, 360);
4691          Canvas.LineTo(350, 250);
4692    
4693    
4694    
4695    
4696          // Resten af rutinen vedr genering og placering af Barcode
4697    
4698          BarCode.BarCodeType := bcCode128;
4699          BarCode.Code128Subset := csCodeC;
4700          BarCode.Code := PakkeshopLabel.Stregkode;
4701          BarCode.Validate(True);
4702    
4703          //Start X-formation
4704          //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
4705          GetWorldTransform(Canvas.Handle, XFormOld);
4706    
4707          Angle := 270;
4708          XForm.eM11 := Cos(DegToRad(Angle));
4709          XForm.eM12 := Sin(DegToRad(Angle));
4710          XForm.eM21 := -Sin(DegToRad(Angle));
4711          XForm.eM22 := Cos(DegToRad(Angle));
4712          XForm.eDx := 0;
4713          XForm.eDy := 0;
4714    
4715          gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
4716          SetWorldTransform(Canvas.Handle, XForm);
4717    
4718          // PaintToCanvasSize arbejder i Inches
4719          // Første pos argument bliver nu Y og skal være negativ for at rykke den ned
4720          //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre
4721    
4722          BarCode.PaintToCanvasSize(Printer.Canvas, -1.8, 3.3, 0.4);
4723    
4724    
4725          SetWorldTransform(Canvas.Handle, XFormOld);
4726          SetGraphicsMode(Canvas.Handle, gMode);
4727    
4728        EndDoc();        EndDoc();
4729      end;      end;
4730    
4731    
4732    end;
4733    
4734    function GetPixelsPerInchX(): Integer;
4735    begin
4736      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)
4737    end;
4738    
4739    function GetPixelsPerInchY(): Integer;
4740    begin
4741      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
4742  end;  end;
4743    
4744    
# Line 4992  var Line 5097  var
5097     idag, imorgen : TDateTime;     idag, imorgen : TDateTime;
5098     imorgenYmd : string;     imorgenYmd : string;
5099     logFilnavn : string;     logFilnavn : string;
5100      error : Integer;     //error : Integer;
5101    
5102  begin  begin
5103    if (SkrivLog = '1') then    if (SkrivLog = '1') then
# Line 5380  end; Line 5485  end;
5485    
5486  function TMainForm.CheckUrl(url:string):boolean;  function TMainForm.CheckUrl(url:string):boolean;
5487  var  var
5488    hSession, hfile, hRequest: hInternet;    hSession, hfile: hInternet;
5489    dwindex,dwcodelen :dword;    dwindex,dwcodelen :dword;
5490    dwcode:array[1..20] of char;    dwcode:array[1..20] of char;
5491    res : pchar;    res : pchar;
Legend:
Removed from v.2676  
changed lines
  Added in v.2677
  ViewVC Help
Powered by ViewVC 1.1.20