--- dao/DelphiScanner/Main.pas 2015/08/23 14:45:16 2660 +++ dao/DelphiScanner/Main.pas 2015/08/26 13:09:38 2677 @@ -9,7 +9,11 @@ Menus, ExtCtrls, ComCtrls, StrUtils, MMSystem, DateUtils, IdExplicitTLSClientServerBase, IdFTP, pngimage, GIFImg, IdException, Winspool, Registry, ShellApi, ClipBrd, Buttons, wininet, - UITypes + UITypes, + PakkeshopLabels, + StBarC, + Math // DegToRad() bruges i PrintPakkeshopLabel + ; @@ -58,7 +62,7 @@ DownloadButton03: TButton; Pakkeshoplevering1: TMenuItem; PakkeshopText1: TStaticText; - PakkeshopNulstil: TButton; + btnNulstil: TButton; Returpakkerfrapakkeshop1: TMenuItem; Altidprintepakkelabel1: TMenuItem; chkAltidPrintLabel: TCheckBox; @@ -88,11 +92,12 @@ PanelManglendePakker4: TPanel; PanelManglendePakker5: TPanel; PanelManglendePakker6: TPanel; + menuIndlevering: TMenuItem; function Explode(var a: TStrArray; Border, S: string): Integer; function BarCodeValid (ACode: string): boolean; - function Sto_GetFmtFileVersion(const FileName: String = ''; const Fmt: String = '%d.%d.%d.%d'): String; + function Sto_GetFmtFileVersion(const FileName: String = ''): String; function TColorToHex(Color : TColor) : string; function HexToTColor(sColor : string) : TColor; function getProddato() : TDate; @@ -146,7 +151,7 @@ procedure UploadButton01Click(Sender: TObject); procedure DownloadButton03Click(Sender: TObject); procedure Pakkeshoplevering1Click(Sender: TObject); - procedure PakkeshopNulstilClick(Sender: TObject); + procedure btnNulstilClick(Sender: TObject); procedure Returpakkerfrapakkeshop1Click(Sender: TObject); procedure InitNatxpresslevering(); procedure InitReturFraDao(); @@ -161,7 +166,6 @@ procedure EKLoverforselClick(Sender: TObject); procedure Uploadlogfil1Click(Sender: TObject); procedure Manual1Click(Sender: TObject); - procedure CheckPrintQue(tjektype : string); procedure Timer1Timer(Sender: TObject); procedure Scanogstjekkoden1Click(Sender: TObject); procedure chkScanTjekkodeClick(Sender: TObject); @@ -181,11 +185,13 @@ procedure SletLogfiler(Path: string; FileList: TStrings); procedure Manualgenerel1Click(Sender: TObject); procedure TjekkerUrls(); -// 20150310: start + procedure RoundCornerOf(Control: TWinControl); + procedure menuIndleveringClick(Sender: TObject); + procedure PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel); + procedure CheckPrintQue(tjektype : string); -// 20150310: slut private SpecialVersionSted, SpecialVersionScanningtype: String; // Bruges når programmet skal bruges udenfor DAO scanningssteder @@ -193,7 +199,7 @@ SkrivLog : String; Sted : String; StedNavn : String; - Url, UrlNormal, UrlReturDAO, UrlReturBoghandler, UrlBudlevering, UrlManglendeScanninger, UrlPakkeshoplevering, UrlReturPakkeshop, UrlPakkeshopManglendeScanninger, UrlPakkeshopManglendeReturScanninger,UrlEKLoverforsel : String; + Url, UrlNormal, UrlReturDAO, UrlReturBoghandler, UrlBudlevering, UrlManglendeScanninger, UrlPakkeshoplevering, UrlReturPakkeshop, UrlPakkeshopManglendeScanninger, UrlPakkeshopManglendeReturScanninger,UrlIndleveringsPakke,UrlEKLoverforsel : String; // 29150330: start UrlEKLoverforselPakkeshop : String; // 20150330: slut @@ -248,6 +254,10 @@ BoghandlerStregkode, BoghandlerTjekkode : String; TjekUrls : String; + Barcode : TStBarcode; + + PakkeshopLabel: TPakkeshopLabel; + function CheckSumModulo10(const data:string):string; { used for EAN 8/13 } procedure PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : String = ''); @@ -266,6 +276,9 @@ { Public declarations } end; + function GetPixelsPerInchX(): Integer; + function GetPixelsPerInchY(): Integer; + var MainForm: TMainForm; @@ -304,6 +317,8 @@ StaticTextManglendePakker.Caption := ''; // 20150309: slut + Barcode := TStBarcode.Create(MainForm);//Dynamisk oprettelse af Barcode component + PanelValg1.Color := clBtnFace; if PanelValg1.Enabled = true then begin @@ -546,7 +561,7 @@ PrinterstatusStaticText1.Caption := ''; PrinterstatusStaticText1.Color := MainForm.Color; - PakkeshopNulstil.BringToFront; + btnNulstil.BringToFront; RoundCornerOf(PanelManglendePakker1); RoundCornerOf(PanelManglendePakker2); @@ -588,6 +603,10 @@ UrlReturPakkeshop := ReadString('Settings','UrlReturPakkeshop','http://omdeling.info/webservices/pakkeshop/returpakkekontrol.php?sted=%s&stregkode=%s'); UrlPakkeshopManglendeScanninger := ReadString('Settings','UrlPakkeshopManglendeScanninger','http://omdeling.info/webservices/pakkeshop/pakkemanglendescanninger.php?sted=%s'); UrlPakkeshopManglendeReturScanninger := ReadString('Settings','UrlPakkeshopManglendeReturScanninger','http://omdeling.info/webservices/pakkeshop/pakkemanglendereturscanninger.php?sted=%s'); + + UrlIndleveringsPakke := ReadString('Settings','UrlIndleveringsPakke','http://omdeling.info/webservices/pakkeshop/PakkekontrolIndleveringskode.php?sted=%s&pakkekode=%s'); + + LabelType := ReadInteger('Settings','LabelType',1); FarveNormal := ReadString('Settings','FarveNormal','D8D8D8'); TitelNormal := ReadString('Settings','TitelNormal','Modtagelse af DAO NAT X-PRESS pakker'); @@ -625,7 +644,7 @@ if (SkrivLog = '1') then begin - 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); try SkrivScanningLogFil(logTekst); Uploadlogfil1.Enabled := true; @@ -834,6 +853,9 @@ PanelValg5.Font.Color := clInactiveCaption; PanelValg6.Enabled := false; PanelValg6.Font.Color := clInactiveCaption; + PanelValg7.Enabled := false; + PanelValg7.Font.Color := clInactiveCaption; + // her skal vi også disable de menupunkter DBK ikke kan bruge ReturpakkerfraDAO1.Enabled := false; Returpakkerfraboghandler1.Enabled := false; @@ -870,6 +892,8 @@ PanelValg5.Font.Color := clInactiveCaption; PanelValg6.Enabled := false; PanelValg6.Font.Color := clInactiveCaption; + PanelValg7.Enabled := false; + PanelValg7.Font.Color := clInactiveCaption; // her skal vi også disable de menupunkter Bladhusene (01, 02, 03 og 04) ikke kan bruge Automatiskvalg1.Enabled := false; @@ -965,7 +989,7 @@ RutenummerST.Caption := ''; BoghandlerNavnST.Caption := 'Fejl i urls'; KommentarST.Caption := 'Se log vinduet'; - PakkeshopNulstil.Visible := true; + btnNulstil.Visible := true; exit; end; end @@ -1134,7 +1158,7 @@ Scanningtype := gemScanningtype; SendInfoTilServer(Sted, Scanningtype, 'Begin', ''); - SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion('','')); + SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion('')); end; @@ -1214,11 +1238,11 @@ if StregKode = 'Nulstil' then begin - PakkeshopNulstil.Click(); + btnNulstil.Click(); exit; end; - if PakkeshopNulstil.Visible then + if btnNulstil.Visible then begin VisAlarmSkaerm( 'HUSK at klikke Nulstil før ny scanning...' ); @@ -1543,7 +1567,7 @@ BoghandlerStregkode := Stregkode; BoghandlerTjekkode := ''; PakkeshopText1.Caption := 'Stregkode'; - PakkeshopNulstil.Visible := false; + btnNulstil.Visible := false; Stregkode := ''; InitScreen(); end @@ -1555,7 +1579,7 @@ BoghandlerStregkode := Stregkode; BoghandlerTjekkode := '-1'; PakkeshopText1.Caption := 'Stregkode'; - PakkeshopNulstil.Visible := false; + btnNulstil.Visible := false; Stregkode := ''; InitScreen(); end @@ -1589,7 +1613,7 @@ MainForm.Color := HexToTColor(FarvePakkeshoplevering); if (Pakkernormal1.Checked) then MainForm.Color := HexToTColor(FarveNormal); - PakkeshopNulstil.Visible := false; + btnNulstil.Visible := false; end else begin @@ -1621,12 +1645,8 @@ // Hvis der var sql fejl i opdateringen skal dette fejlmeldes her if Rutenummer = 'sql fejl' then begin // Her skal komme en alarm og rød skærm - PlaySound(PWideChar(AlarmLyd)); - //List1msg := 'SQL fejl: ' + Kommentar; - //ListBox1.Items.Insert(0,List1Msg); - MainForm.Color := clRed; - //KommentarST.Caption := List1msg; - PakkeshopNulstil.Visible := true; + VisAlarmSkaerm( 'SQL fejl: ' + Kommentar ); + exit; end; if (Pakkernormal1.Checked or Budlevering1.Checked or PakkeshopLevering1.Checked) then @@ -1646,7 +1666,7 @@ if (pakkeErScannet > 0) or (pakkeForkertSted > 0) or (tjekkodemangler > 0) then begin PlaySound(PWideChar(AlarmLyd)); - PakkeshopNulstil.Visible := true; + btnNulstil.Visible := true; MainForm.Color := clRed; end; end; @@ -1661,7 +1681,7 @@ begin PlaySound(PWideChar(ScannetOkLyd)); end; - PakkeshopNulstil.Visible := false; + btnNulstil.Visible := false; end else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then begin @@ -1674,7 +1694,7 @@ begin PlaySound(PWideChar(ScannetOkLyd)); end; - PakkeshopNulstil.Visible := false; + btnNulstil.Visible := false; end else if Copy(Kommentar,1,8) = 'OPRETTET' then begin @@ -1685,11 +1705,9 @@ end else begin - MainForm.Color := clRed; - PlaySound(PWideChar(AlarmLyd)); - PakkeshopNulstil.Visible := true; + VisAlarmSkaerm(''); end; - if not PakkeshopNulstil.Visible then + if not btnNulstil.Visible then begin If (Budlevering1.Checked) then @@ -2069,6 +2087,8 @@ begin pakkestorrelse := 'Lille'; end; + + if Pakkernormal1.Checked then begin if (BoghandlerTjekkode = '') then @@ -2097,6 +2117,10 @@ begin URLStr := Format(UrlReturPakkeshop,[Sted, PakkeNr]); end + else if menuIndlevering.Checked then + begin + URLStr := Format(UrlIndleveringsPakke,[Sted, PakkeNr]); + end else begin exit; @@ -2143,10 +2167,26 @@ begin PrintNyLabel := True; end; -// 20150310: start end; -// 20150310: slut end + else if menuIndlevering.Checked then + begin + + + + + Kommentar := XMLDocument1.ChildNodes.FindNode('PakkeKontrol').ChildNodes.FindNode('Stregkodematch').Text; + if (Kommentar = 'Ok') then + begin + PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label + PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc + + PrintPakkeshopLabel( PakkeshopLabel ); + + end; + + + end else begin RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text; @@ -2179,6 +2219,8 @@ PrintNyLabel := True; end; end; + + if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then begin if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then @@ -2338,7 +2380,7 @@ PlaySound(PWideChar(AlarmLyd)); MainForm.Color := clRed; - PakkeshopNulstil.Visible := true; + btnNulstil.Visible := true; end else @@ -2365,7 +2407,7 @@ begin PlaySound(PWideChar(AlarmLyd)); MainForm.Color := clRed; - PakkeshopNulstil.Visible := true; + btnNulstil.Visible := true; end; end; @@ -2391,7 +2433,7 @@ begin PlaySound(PWideChar(AlarmLyd)); MainForm.Color := clRed; - PakkeshopNulstil.Visible := true; + btnNulstil.Visible := true; end; end; @@ -2415,7 +2457,7 @@ end; end; 01 : begin; - if PrintNyLabel and ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then + if PrintNyLabel or ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then // Ovenstående test er lidt speciel fordi der i programmet nogle steder er byttet rundt på rute og køreliste // Meningen er at der kun skal printes hvis der er forskel i kørelisterne eller ruterne - eller vi kommer fra test funktionen (Rutenr = 'Rutenr') begin @@ -2429,7 +2471,7 @@ end; end; 03 : begin; - if PrintNyLabel and ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then + if PrintNyLabel or ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then // Ovenstående test er lidt speciel fordi der i programmet nogle steder er byttet rundt på rute og køreliste // Meningen er at der kun skal printes hvis der er forskel i kørelisterne eller ruterne - eller vi kommer fra test funktionen (Rutenr = 'Rutenr') begin @@ -3038,6 +3080,7 @@ repeat if (SR.Attr <> faDirectory) then begin + dt := fileDateToDateTime(SR.Time); // finder filens timestamp for seneste ændring CreationTime := SR.FindData.ftCreationTime; // finder filens timestamp for oprettelse dtCreation := FileTime2DateTime(CreationTime); // finder filens timestamp for oprettelse @@ -3077,11 +3120,11 @@ end; end; -procedure TMainForm.PakkeshopNulstilClick(Sender: TObject); +procedure TMainForm.btnNulstilClick(Sender: TObject); begin PakkeshopStregkode := ''; PakkeshopTjekkode := ''; - PakkeshopNulstil.Visible := false; + btnNulstil.Visible := false; PakkeshopText1.Caption := 'Stregkode'; BoghandlerStregkode := ''; BoghandlerTjekkode := ''; @@ -3231,7 +3274,7 @@ // Her kommer en alarm og rød skærm PlaySound(PWideChar(AlarmLyd)); MainForm.Color := clRed; - PakkeshopNulstil.Visible := true; + btnNulstil.Visible := true; end else begin @@ -3337,7 +3380,7 @@ tekst, filversion : String; begin - filversion := Sto_GetFmtFileVersion('',''); + filversion := Sto_GetFmtFileVersion(''); tekst := 'Program til indscanning af pakker'+crlf+'Version '+filversion+crlf+crlf+'Udviklet af it afdelingen, DAO'; tekst := tekst+crlf+crlf; @@ -3472,6 +3515,13 @@ end; end; +procedure TMainForm.menuIndleveringClick(Sender: TObject); +begin + Scanningtype := '7'; + NulstilAutomatiskValg(); + InitIndleveringskode(); +end; + procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject); begin @@ -3504,7 +3554,7 @@ procedure TMainForm.InitNatxpresslevering(); begin AutomatiskTjekkodeStyring1.Enabled := true; - PakkeshopNulstil.Visible := false; + btnNulstil.Visible := false; Pakkernormal1.Checked := true; InitForm(FarveNormal,TitelNormal,UrlNormal); PanelValg1.Color := clGreen; @@ -3537,7 +3587,7 @@ begin AutomatiskTjekkodeStyring1.Enabled := false; ReturpakkerfraDAO1.Checked := true; - PakkeshopNulstil.Visible := false; + btnNulstil.Visible := false; InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO); PanelValg2.Color := clGreen; PanelValg2.Font.Color := clWhite; @@ -3564,7 +3614,7 @@ begin AutomatiskTjekkodeStyring1.Enabled := false; Returpakkerfraboghandler1.Checked := true; - PakkeshopNulstil.Visible := false; + btnNulstil.Visible := false; InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler); PanelValg3.Color := clGreen; PanelValg3.Font.Color := clWhite; @@ -3590,7 +3640,7 @@ begin AutomatiskTjekkodeStyring1.Enabled := false; Budlevering1.Checked := true; - PakkeshopNulstil.Visible := false; + btnNulstil.Visible := false; InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering); PanelValg4.Color := clGreen; PanelValg4.Font.Color := clWhite; @@ -3626,7 +3676,7 @@ begin AutomatiskTjekkodeStyring1.Enabled := true; Pakkeshoplevering1.Checked := true; - PakkeshopNulstil.Visible := false; + btnNulstil.Visible := false; InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering); PanelValg5.Color := clGreen; PanelValg5.Font.Color := clWhite; @@ -3663,7 +3713,7 @@ begin AutomatiskTjekkodeStyring1.Enabled := false; Returpakkerfrapakkeshop1.Checked := true; - PakkeshopNulstil.Visible := false; + btnNulstil.Visible := false; InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop); PanelValg6.Color := clGreen; PanelValg6.Font.Color := clWhite; @@ -3703,9 +3753,10 @@ procedure TMainForm.InitIndleveringskode(); begin + menuIndlevering.Checked := true; AutomatiskTjekkodeStyring1.Enabled := false; - Returpakkerfrapakkeshop1.Checked := true; - PakkeshopNulstil.Visible := false; + + btnNulstil.Visible := false; InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop); PanelValg7.Color := clGreen; PanelValg7.Font.Color := clWhite; @@ -3783,16 +3834,14 @@ /// values. /// Formatted version number of file, '' if no version /// resource found. -function TMainForm.Sto_GetFmtFileVersion(const FileName: String = ''; - const Fmt: String = '%d.%d.%d.%d'): String; +function TMainForm.Sto_GetFmtFileVersion(const FileName: String = ''): String; var sFileName: String; iBufferSize: DWORD; iDummy: DWORD; pBuffer: Pointer; pFileInfo: Pointer; - iVer: array[1..4] of Word; - S : String; + iVer: array[1..4] of Integer; begin // set default value Result := ''; @@ -3817,20 +3866,10 @@ finally FreeMem(pBuffer); end; + // format result string - 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]]); - // 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; end; end; @@ -3993,7 +4032,7 @@ BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...'; end; KommentarST.Caption := Kommentar; - PakkeshopNulstil.Visible := true; + btnNulstil.Visible := true; end; end; @@ -4579,6 +4618,130 @@ until S2 = ''; end; +// ToDo: PrintPakkeshopLabel() +procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel); +var + XForm, XFormOld: TXForm; //Bruges til rotate X-formation + Angle: integer; + gMode: integer; + BarcodeArea: TRect; + Dirigering: string; + +begin + with Printer do + begin + BeginDoc(); + + + Canvas.Font.Size := 16; + Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + ' ' + PakkeshopLabel.Overskrift); + + + + Canvas.TextOut(25, 90, PakkeshopLabel.Navn ); + Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn ); + Canvas.TextOut(25, 180, PakkeshopLabel.Postnr ); + + + Canvas.Font.Size := 9; + Canvas.TextOut(110, 240, 'Pakkeshop:'); + Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn); + Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr); + Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr); + + Canvas.TextOut(350, 240, 'Afsender:'); + Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn); + Canvas.TextOut(350, 300, PakkeshopLabel.AfsenderAdresse); + Canvas.TextOut(350, 330, PakkeshopLabel.AfsenderPostnr); + + Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr; + if ( PakkeshopLabel.Koreliste <> '') then + begin + Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste; + end; + + + Canvas.Font.Size := 12; + Canvas.TextOut(15, 370, Dirigering); + + + + + + //Tegn adskillelses linier + Canvas.Pen.Width := 2; + //Øverste linie + Canvas.MoveTo(20,80); + Canvas.LineTo(600,80); + + // Midterste linie + Canvas.MoveTo( 20, 240); + Canvas.LineTo(600, 240); + + //Nederste linie + Canvas.MoveTo( 20, 370); + Canvas.LineTo(600, 370); + + + //Tegn skrå streger over afsender + Canvas.Pen.Width := 1; + Canvas.MoveTo(600, 250); + Canvas.LineTo(350, 360); + Canvas.MoveTo(600, 360); + Canvas.LineTo(350, 250); + + + + + // Resten af rutinen vedr genering og placering af Barcode + + BarCode.BarCodeType := bcCode128; + BarCode.Code128Subset := csCodeC; + BarCode.Code := PakkeshopLabel.Stregkode; + BarCode.Validate(True); + + //Start X-formation + //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) ); + GetWorldTransform(Canvas.Handle, XFormOld); + + Angle := 270; + XForm.eM11 := Cos(DegToRad(Angle)); + XForm.eM12 := Sin(DegToRad(Angle)); + XForm.eM21 := -Sin(DegToRad(Angle)); + XForm.eM22 := Cos(DegToRad(Angle)); + XForm.eDx := 0; + XForm.eDy := 0; + + gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED); + SetWorldTransform(Canvas.Handle, XForm); + + // PaintToCanvasSize arbejder i Inches + // Første pos argument bliver nu Y og skal være negativ for at rykke den ned + //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre + + BarCode.PaintToCanvasSize(Printer.Canvas, -1.8, 3.3, 0.4); + + + SetWorldTransform(Canvas.Handle, XFormOld); + SetGraphicsMode(Canvas.Handle, gMode); + + EndDoc(); + end; + + +end; + +function GetPixelsPerInchX(): Integer; +begin + Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX) +end; + +function GetPixelsPerInchY(): Integer; +begin + Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY) +end; + + procedure TMainForm.IndlesManglendeScanninger(); var WebSvar : String; @@ -4934,7 +5097,7 @@ idag, imorgen : TDateTime; imorgenYmd : string; logFilnavn : string; - error : Integer; + //error : Integer; begin if (SkrivLog = '1') then @@ -5203,13 +5366,19 @@ //ShowMessage('Ændring ikke tilladt'); // Her skal komme en 'rød skærm' alarm PlaySound(PWideChar(AlarmLyd)); - - ListBox1.Items.Insert(0, strMessage); MainForm.Color := clRed; + + RuteNummerST.Caption := ''; BoghandlerNavnST.Caption := ''; - KommentarST.Caption := strMessage; - PakkeshopNulstil.Visible := true; + btnNulstil.Visible := true; + + if (strMessage <> '') then + begin + ListBox1.Items.Insert(0, strMessage); + KommentarST.Caption := strMessage; + end; + end; function TMainForm.getProddato() : TDate; @@ -5313,6 +5482,66 @@ AReg.Free; end; + +function TMainForm.CheckUrl(url:string):boolean; +var + hSession, hfile: hInternet; + dwindex,dwcodelen :dword; + dwcode:array[1..20] of char; + res : pchar; +begin + if pos('http://',lowercase(url))=0 then + url := 'http://'+url; + Result := false; + hSession := InternetOpen('InetURL:/1.0', + INTERNET_OPEN_TYPE_PRECONFIG, + nil, + nil, + 0); + if assigned(hsession) then + begin + hfile := InternetOpenUrl(hsession, + pchar(url), + nil, + 0, + INTERNET_FLAG_RELOAD, + 0); + dwIndex := 0; + dwCodeLen := 10; + HttpQueryInfo(hfile, + HTTP_QUERY_STATUS_CODE, + @dwcode, + dwcodeLen, + dwIndex); + res := pchar(@dwcode); + result:= (res ='200') or (res ='302'); + if assigned(hfile) then + InternetCloseHandle(hfile); + InternetCloseHandle(hsession); + end; + +end; + + +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; + procedure TMainForm.CheckPrintQue(tjektype : string); type TJobs = array [0..1000] of JOB_INFO_1; @@ -5416,65 +5645,6 @@ end; end; -function TMainForm.CheckUrl(url:string):boolean; -var - hSession, hfile, hRequest: hInternet; - dwindex,dwcodelen :dword; - dwcode:array[1..20] of char; - res : pchar; -begin - if pos('http://',lowercase(url))=0 then - url := 'http://'+url; - Result := false; - hSession := InternetOpen('InetURL:/1.0', - INTERNET_OPEN_TYPE_PRECONFIG, - nil, - nil, - 0); - if assigned(hsession) then - begin - hfile := InternetOpenUrl(hsession, - pchar(url), - nil, - 0, - INTERNET_FLAG_RELOAD, - 0); - dwIndex := 0; - dwCodeLen := 10; - HttpQueryInfo(hfile, - HTTP_QUERY_STATUS_CODE, - @dwcode, - dwcodeLen, - dwIndex); - res := pchar(@dwcode); - result:= (res ='200') or (res ='302'); - if assigned(hfile) then - InternetCloseHandle(hfile); - InternetCloseHandle(hsession); - end; - -end; - -// 20150310: start -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; -// 20150310: slut end.