GetCursorPos issues in Windows 8.1 with scaling

I have an application which is written in Delphi 5 and has been working well for years.
I now have a problem on systems running windows 8.1 with high definition screens where scaling is set higher than 100%.
Part of the application allows the user to select the color of individual pixels on an image.
To make it easier I use a zoom box which displays a zoomed section of the main image.
When the cursor is over the main image, a smaller zoomed image with a crosshair is displayed.
When screen scaling is active and greater than 100%, the zoom box no longer displays the area surrounding the cursor position but an area to the upper left that seems to be relative to the 0,0 point of the screen.

Here is the code I am using.
Thanks in advance for your help.

{code}
procedure TAutoFillForm.Timer1Timer(Sender: TObject);
var
  Srect,Drect,DisplayArea:TRect;
  iWidth,iHeight,DmX,DmY:Integer;
  iTmpX,iTmpY:Real;
  C:TCanvas;
  hDesktop: Hwnd;
  CursorPosition,ImageLoc:TPoint;
  Col,CrossHairCol:TColor;
  MaxWidth,MaxHeight,iTop,iLeft:Integer;
     DC: HDC;
      ImageRect:Trect;
    begin

 If not IsIconic(Application.Handle) then begin
 hDesktop:=GetDesktopWindow;

  GetCursorPos(CursorPosition);

    ImageLoc:=Image1.ClientToScreen(Point(0,0));
   // Label9.Caption:= 'Cursor X = '+ IntToStr(CursorPosition.x) + ' : Cursor Y = '+ IntToStr(CursorPosition.Y) + ' : ScreenDPI = ' + IntToStr(ScreenDPI) + ' DPI = '  + IntToStr(Screen.PixelsPerInch) + ' Image X = ' + IntToStr(ImageLoc.x) + ' Image Y = ' + IntToStr(ImageLoc.y);


  MaxWidth:=Image1.Width;


  MaxHeight:=Image1.Height;

       	DisplayArea:=Rect(ImageLoc.x,ImageLoc.y,ImageLoc.x+MaxWidth,ImageLoc.y+MaxHeight);


  If  (PtInRect(DisplayArea,CursorPosition)) and ( CheckBox2.Checked) then
  begin


    If Image2.Visible=False then Image2.Visible:=True;

 	 iWidth:=Image2.Width;
		 iHeight:=Image2.Height;
    Drect:=Rect(0,0,iWidth,iHeight);

    iTmpX:=iWidth / (TrackBar1.Position * 4 );
    iTmpY:=iHeight / (TrackBar1.Position * 4);

    GetCursorPos(CursorPosition);
    Srect:=Rect(CursorPosition.x,CursorPosition.y,CursorPosition.x,CursorPosition.y);

    InflateRect(Srect,Round(iTmpX),Round(iTmpY));

    // move Srect if outside visible area of the screen
    If Srect.Left<0 then OffsetRect(Srect,-Srect.Left,0);
    If Srect.Top<0 then OffsetRect(Srect,0,-Srect.Top);
    If Srect.Right>Screen.DesktopWidth then OffsetRect(Srect,-(Srect.Right-Screen.DesktopWidth),0);
    If Srect.Bottom>Screen.DesktopHeight then OffsetRect(Srect,0,-(Srect.Bottom-Screen.DesktopHeight));
   

   C:=TCanvas.Create;
   try
    C.Handle:=GetDC(0);

     Image2.Canvas.CopyRect(Drect,C,Srect);
    finally
      ReleaseDC(hDesktop, C.Handle);
      C.Free;
    end;
    If CheckBox2.Checked=True then begin // show crosshair
    	with Image2.Canvas do begin
         DC := CreateDC('DISPLAY',nil,nil,nil);
        Col := GetPixel(DC,CursorPosition.X,CursorPosition.Y);
        DeleteDC(DC);
        CrossHairCol:=MainForm.VisibleContrast(Col);  // set color to be visible over current area
        Image2.Canvas.Pen.Color:= CrossHairCol;

        DmX:=TrackBar1.Position  * 2 * (CursorPosition.X-Srect.Left) ;
        DmY:=TrackBar1.Position * 2  * (CursorPosition.Y-Srect.Top) ;
   		 MoveTo(DmX - (iWidth div 8),DmY); // -
   		 LineTo(DmX + (iWidth div 8),DmY); // -
    		 MoveTo(DmX,DmY - (iHeight div 8)); // |
   		 LineTo(DmX,DmY + (iHeight div 8)); // |
      end; // with image1.Canvas
    end; // show crosshair
  	Application.ProcessMessages;
	end // Cursor not inside area
   else begin  // cursor inside area

   	If Image2.Visible=True then Image2.Visible:=False;
  end;
 end; // IsIconic
end;

{code}
0
Owen
7/19/2015 3:04:34 AM
embarcadero.delphi.graphics 928 articles. 0 followers. Follow

0 Replies
938 Views

Similar Articles

[PageSpeed] 26

Reply:

Similar Artilces:

Errors using hotmail after latest major update: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.8) Gecko/20061025 Firefox/1.5.0.8
Name: William Green Email: wjgreen_at_hotmail.com Product: Firefox Summary: Errors using hotmail after latest major update: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.8) Gecko/20061025 Firefox/1.5.0.8 Comments: After I installed the latest update and rebooted, every time I go to open an email in hotmail.com (this does NOT occur in other email sites I use), I get the following three Alert messages that I have to click through to get to my email: [object XPCNativeWrapper [object HTMLBodyElement]] [object XPCNativeWrapper [object HTMLScriptElement]] TypeError: d...

Buying a new Windows 8.1 laptop with Windows 8.1 installed
When buying a new laptop from one of the major manufacturers, like Dell or Lenovo, with Windows 8.1 installed, is it possible to set it up with just a Local Account and not a Microsoft Account? -- Chris On 11/2/2013 11:28 AM, Chris wrote: > When buying a new laptop from one of the major > manufacturers, like Dell or Lenovo, with Windows 8.1 > installed, is it possible to set it up with just a Local > Account and not a Microsoft Account? Yes, look here; http://www.techrepublic.com/blog/windows-and-office/quick-tip-change-to-a-local-account-in-windows-81/ On 11/2/201...

perl debugger+taint mode issue in 5.10.0, 5.10.1 5.12.1, no issue in 5.8.8
--001636832e82416c9f048ce9a23b Content-Type: text/plain; charset=ISO-8859-1 Hi All, I got the scenario where perl debugger with taint mode is failing. I am using below .pm amd .xs file for testing $ cat *Mytest.pm* #!/usr/bin/perl -wT package Mytest; use XSLoader (); BEGIN { XSLoader::load('Mytest'); } BEGIN { XSLoader::load('Mytest'); my $var = defined($0)? UNDEFINE : 1; } sub func_test { glob("check"); return 1; } 1; $ cat *Mytest.xs* #include "EXTERN.h" #include "perl.h" #include "XSUB...

eDirectory 8.8.1 issue/SLES 10 issue
I'm having a problem with eDirectory that hopefully someone can point me in the right direction on. The ndslogin command only works when I use the -h parameter now, instead of just specifying the tree name. I've installed eDirectory 8.8.1 on a SLES 10 linux server. Firewall is off. OpenSLP test with slpinfo shows services available. [I've tried novell SLP with the same outcome.] Could see the tree through ConsoleOne and login that way locally off the server, but now it doesn't work. I'm getting an additional error: -634 (Target server doesn't have a copy...

superreview requested: [Bug 362139] bump SeaMonkey versions to 1.0.7/1.1 on 1.8.0/1.8 branches, localeVersion to 1.8.1 on 1.8 branch : [Attachment 246922] 1.8 patch: SeaMonkey version -> 1.1, localeVe
Robert Kaiser <kairo@kairo.at> has asked neil@parkwaycc.co.uk <neil@httl.net> for superreview: Bug 362139: bump SeaMonkey versions to 1.0.7/1.1 on 1.8.0/1.8 branches, localeVersion to 1.8.1 on 1.8 branch https://bugzilla.mozilla.org/show_bug.cgi?id=362139 Attachment 246922: 1.8 patch: SeaMonkey version -> 1.1, localeVersion -> 1.8.1 https://bugzilla.mozilla.org/attachment.cgi?id=246922&action=edit ------- Additional Comments from Robert Kaiser <kairo@kairo.at> ...and here's the 1.8 branch patch, setting SeaMonkey version to 1.1 for final, and locale...

superreview granted: [Bug 362139] bump SeaMonkey versions to 1.0.7/1.1 on 1.8.0/1.8 branches, localeVersion to 1.8.1 on 1.8 branch : [Attachment 246922] 1.8 patch: SeaMonkey version -> 1.1, localeVers
neil@parkwaycc.co.uk <neil@httl.net> has granted Robert Kaiser <kairo@kairo.at>'s request for superreview: Bug 362139: bump SeaMonkey versions to 1.0.7/1.1 on 1.8.0/1.8 branches, localeVersion to 1.8.1 on 1.8 branch https://bugzilla.mozilla.org/show_bug.cgi?id=362139 Attachment 246922: 1.8 patch: SeaMonkey version -> 1.1, localeVersion -> 1.8.1 https://bugzilla.mozilla.org/attachment.cgi?id=246922&action=edit ...

Some issues and suggestions in windows 8.1
--001a1134e7b6e5fc2c050b9cca09 Content-Type: text/plain; charset=UTF-8 Hi, I think these things can be useful to a newcomer like me: 1) I've installed the rakudo-star 2014.12.1 on windows 8.1. When I tried to lauch a perl6 program with perl6 I have a "command not found" error. It's because the rakudo star directory (C:\rakudo\bin) is not in the PATH environment variable. Is there the possibility to modify this variable when someone install rakudo? 2) When I try to debug a program with "perl6-debug-m example.pl" the debugger gives me this error: ===...

Scaling of menus in Windows 8.1
When scaled to 150% in Windows 8.1 settings, other elements scale properly but the menu looks cramped as compared to standard Windows applications. The font is correct but the menu items are spaced too near to each other. Can this be corrected by some native API call? I'm using C++ Builder XE4. Proper scaling is desired so that on smaller touch devices like tablets, the menus can be properly handled. Thanks, Sanjay > {quote:title=Sanjay Kanade wrote:}{quote} > When scaled to 150% in Windows 8.1 settings, other elements scale properly but the menu looks cramped as compared t...

Some issues and suggestions in windows 8.1
--001a1134e7b6e5fc2c050b9cca09 Content-Type: text/plain; charset=UTF-8 Hi, I think these things can be useful to a newcomer like me: 1) I've installed the rakudo-star 2014.12.1 on windows 8.1. When I tried to lauch a perl6 program with perl6 I have a "command not found" error. It's because the rakudo star directory (C:\rakudo\bin) is not in the PATH environment variable. Is there the possibility to modify this variable when someone install rakudo? 2) When I try to debug a program with "perl6-debug-m example.pl" the debugger gives me this error: ===...

Delphi XE2 in Windows 8.1
I have Delphi XE2 installed on Windows7 and it works fine. Now I installed Delphi XE2 also on Windows 8.1, and it compiles fine as 32 and also as 64 bit, but when try to run 64 bit application I can run it only without debugging (Shift+Ctrl+F9) but when I select Run (F9) Delphi reports error: Disconnected session, (or something very similar). Running 32 bit applications works without problems in both ways. Any help would be appreciated. Andrej > {quote:title=Andrej Mrvar wrote:}{quote} > I have Delphi XE2 installed on Windows7 and it works fine. > > Now I insta...

superreview granted: [Bug 362139] bump SeaMonkey versions to 1.0.7/1.1 on 1.8.0/1.8 branches, localeVersion to 1.8.1 on 1.8 branch : [Attachment 246921] 1.8.0 patch: SeaMonkey version -> 1.0.7
neil@parkwaycc.co.uk <neil@httl.net> has granted Robert Kaiser <kairo@kairo.at>'s request for superreview: Bug 362139: bump SeaMonkey versions to 1.0.7/1.1 on 1.8.0/1.8 branches, localeVersion to 1.8.1 on 1.8 branch https://bugzilla.mozilla.org/show_bug.cgi?id=362139 Attachment 246921: 1.8.0 patch: SeaMonkey version -> 1.0.7 https://bugzilla.mozilla.org/attachment.cgi?id=246921&action=edit ...

superreview requested: [Bug 362139] bump SeaMonkey versions to 1.0.7/1.1 on 1.8.0/1.8 branches, localeVersion to 1.8.1 on 1.8 branch : [Attachment 246921] 1.8.0 patch: SeaMonkey version -> 1.0.7
Robert Kaiser <kairo@kairo.at> has asked neil@parkwaycc.co.uk <neil@httl.net> for superreview: Bug 362139: bump SeaMonkey versions to 1.0.7/1.1 on 1.8.0/1.8 branches, localeVersion to 1.8.1 on 1.8 branch https://bugzilla.mozilla.org/show_bug.cgi?id=362139 Attachment 246921: 1.8.0 patch: SeaMonkey version -> 1.0.7 https://bugzilla.mozilla.org/attachment.cgi?id=246921&action=edit ------- Additional Comments from Robert Kaiser <kairo@kairo.at> This is the 1.8.0 branch patch for bumping SeaMonkey version to 1.0.7 ...

Mozilla/5.0 (Windows; U; Windows NT 5.1; de; rv:1.8.1.11) Gecko/20071127 Firefox/2.0.0.11
Name: Greul, Albert Email: albertdotgreulatgooglemaildotcom Product: Firefox Summary: Mozilla/5.0 (Windows; U; Windows NT 5.1; de; rv:1.8.1.11) Gecko/20071127 Firefox/2.0.0.11 Comments: Hallo zusammen, habe soeben das Neue update installiert. Seit diesem Zeitpunkt funktioniert die Druckerkommunikation zwischen Laptop und Drucker über mein W-Lan nicht mehr!! Vorher funktionierte alles tadellos. Bitte um Beseitigung des Problems. Es grüßt Sie(noch)freundlich Albert Greul Browser Details: Mozilla/5.0 (Windows; U; Windows NT 5.1; de; rv:1.8.1.11) Gec...

Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.2) Gecko/20070219 Firefox/2.0.0.2
Name: R. Bijster Product: Firefox Summary: Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.2) Gecko/20070219 Firefox/2.0.0.2 Comments: I want to report that Windowsbrowser V 6.0.2900_SP2, 12 seconds faster started then FireFoxbrowser. Browser Details: Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.2) Gecko/20070219 Firefox/2.0.0.2 ...

Web resources about - GetCursorPos issues in Windows 8.1 with scaling - embarcadero.delphi.graphics

New Malware Found Hiding Inside Image Files
Dell SecureWorks CTU researchers say Stegoloader is third example in a year of malware using digital steganography as a detection countermeasure. ...

Malwr - Malware Analysis by Cuckoo Sandbox
Submit malware for free analysis with Cuckoo Sandbox

function start() term.clear() os.pullEvent = os.pullEventRaw term.setTextCo - Pastebin.com
function start()term.clear()os.pullEvent = os.pullEventRawterm.setTextColor(colors.green)term.setCursorPos(15, 1)print("Admin Monitor System ...

Stegoloader: A Stealthy Information Stealer
Stegoloader has a modular design and uses digital steganography to hide its main module’s code inside a Portable Network Graphics (PNG) image ...

Antivirus scan for a31ed901abcacd61a09a84157887fc4a189d3fe3e3573c24e776bac8d5bb8a0f at 2014-05-29 17:49:56 ...
× Cookies are disabled! This site requires cookies to be enabled to work properly Community Statistics Documentation FAQ About Join our community ...

Antivirus scan for c4e99fdcd40bee6eb6ce85167969348d at 2014-03-09 17:04:36 UTC - VirusTotal
× Cookies are disabled! This site requires cookies to be enabled to work properly Community Statistics Documentation FAQ About Join our community ...

Resources last updated: 12/3/2015 11:11:54 PM