Delphi Mouse.curpos, похоже, возвращает неправильные координаты - PullRequest
0 голосов
/ 09 апреля 2020

У меня есть приложение формы VCL с tedit, которое будет использовать FindVCLWindow (Mouse.CursorPos), чтобы воздействовать на элемент управления, если он находится под мышью. Когда я щелкаю левой кнопкой мыши на тэдите, моя программа возвращает nil для результата, и причиной, по-видимому, является mouse.curpos, отправленный в функцию. В своем тесте я использовал размер формы 500+ x 500+ и расположил его в координатах экрана 100,100. Tedit расположен на 100,100 и имеет размер и отображается на 100,50. Когда я указываю на редактирование, mouse.curpos возвращается как 1093,67, а ScreentoClient(Mouse.CursorPos) - 901, -141. Любой набор координат пропускает прямоугольник tedit в обоих направлениях. Очевидно, что эти места находятся за пределами tedit прямоугольника, хотя я щелкнул внутри его прямоугольника. Я предполагал, что координаты мыши используют экранные координаты, но я не могу понять, что они делают. Как мне решить эту проблему?

ПРИМЕР: 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.
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...