Delphi Mouse.curpos appears to be returning incorrect coordinates

走远了吗. 提交于 2020-04-17 22:44:07

问题


I have a VCL form application with a tedit that will use FindVCLWindow (Mouse.CursorPos) to act upon a the control if it is beneath the mouse. When I left click on the tedit, my program returns nil for the result and the reason appears to be the mouse.curpos sent in the function. In my test I used a form size of 500+ x 500+ and located it at screen coordinates 100,100. The Tedit is located at 100,100 and is sized and displayed at 100,50. When I point at the edit, the mouse.curpos is returned as 1093,67 and the ScreentoClient(Mouse.CursorPos) is 901,-141. Either coordinate set misses the tedit rectangle in both directions. Clearly these locations are outside of the tedit rectangle although I clicked inside its rectangle. I had assumed that the mouse coordinates use screen coordinates, but I cannot make sense of what it is doing. How do I resolve this?

EXAMPLE: MessageTest.dfm

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Message Test'
  ClientHeight = 461
  ClientWidth = 484
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 102
    Top = 51
    Width = 60
    Height = 25
    Caption = 'Label1'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -21
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
  end
  object Edit1: TEdit
    Left = 100
    Top = 100
    Width = 100
    Height = 50
    AutoSize = False
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -21
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
    TabOrder = 0
    Text = 'Edit1'
  end
  object Button1: TButton
    Left = 102
    Top = 184
    Width = 75
    Height = 25
    Caption = 'Test'
    TabOrder = 1
    OnClick = Button1Click
  end
end

messageTest_u.pas

unit MessageTest_u;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

const
  WM_LOSEFOCUS = WM_USER + 2000;  //testing value
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure AppMessage(var Msg: TMsg; var Handled: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
  msgStr: String;
  pos : tpoint;
  FormTop, FormLeft, EditTop, EditLeft, EditWidth, EditHeight : integer;
  tmpControl : tWinControl;
begin
//  if Msg.hwnd = Application.Handle then  begin
    if Msg.message = WM_LOSEFOCUS then begin
      showMessage ('WM_LOSEFOCUS Received');
      Handled := True;
    end;

    if Msg.message = WM_LBUTTONDOWN then begin
      formTop := form1.Top;
      formLeft := form1.Left;
      editTop := Edit1.Top;
      editLeft := edit1.Left;
      editWidth := Edit1.Width;
      editHeight := Edit1.Height;

      pos := ScreentoClient(Mouse.CursorPos);
      tmpControl := FindVCLWindow (Mouse.CursorPos);
      if (tmpControl = nil) then begin
        if (tmpControl.canfocus = false) then begin // definitely outside of a tedit
          showMessage ('WM_LBUTTONDOWN Received');
          ActiveControl := nil;
          Handled := True;
        end;
      end;
    end;
  { For all other messages, Handled remains False }
  { so that other message handlers can respond. }
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  PostMessage(Application.Handle, WM_LOSEFOCUS, 0, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
  Form1.top := 100;
  form1.left := 100;
  edit1.top := 100;
  edit1.left := 100;
end;

end.

来源:https://stackoverflow.com/questions/61129468/delphi-mouse-curpos-appears-to-be-returning-incorrect-coordinates

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!