roman-info01 » 13.03.2013 11:15:08
Решил задачу так:
procedure TmainForm.mainTimerTimer(Sender: TObject);
var
Control: TControl;
P: TPoint;
begin
P:=mouse.CursorPos;
Control := FindDragTarget(P, True);
if Assigned(Control) then mainForm.Caption := Control.Name;
end;
Таймер поставил на 500
Вроде работает...
Данный код определяет какой элемент находится под мышкой
Добавлено спустя 1 час 1 минуту 20 секунд:
В общем выкладываю, что получилось.
А получилось вот чего:
1. Создать компонент TLabel
2. Получать, какой компонент под мышкой
3. Перемещать компонент
unit main;
//{$mode objfpc}{$H+}
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
ExtCtrls, StdCtrls, ComCtrls, Buttons;
type
{ TmainForm }
TmainForm = class(TForm)
MenuItem1: TMenuItem;
MenuItem10: TMenuItem;
MenuItem11: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
MenuItem7: TMenuItem;
MenuItem8: TMenuItem;
MenuItem9: TMenuItem;
nmMainMenu: TMainMenu;
mainTimer: TTimer;
mainToolBar: TToolBar;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
procedure mainTimerTimer(Sender: TObject);
procedure MenuItem6Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
procedure mnCreateLabel(nmLabelName:String); // Создать надпись
// Обработчики мыши для TLabel
procedure newLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure newLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure newLabelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
end;
var
mainForm: TmainForm;
comp_name:string; // Имя выбранного компонента
comp_class:string; // Класс выбранного компонента
dx,dy: integer;
Move: boolean;
implementation
{$R *.lfm}
{ TmainForm }
// ************** TLabel ************************
// Создать надпись
procedure TmainForm.mnCreateLabel(nmLabelName:String);
var
newLabel:TLabel;
begin
newLabel:=TLabel.Create(self); // Создать новый объект TLabel
newLabel.Parent:=mainForm; // Родительский объект
newLabel.Left:=50; // Первоначальное положение
newLabel.Top:=60;
newLabel.AutoSize:=true; // Авторазмер
newLabel.Caption:='Новая надпись'; // Надпись по умолчанию
newLabel.Name:=nmLabelName; // Присвоить имя
newLabel.Visible:=true; // Показать
// Обработчики событий мыши
newLabel.OnMouseDown:=newLabelMouseDown;
newLabel.OnMouseMove:=newLabelMouseMove;
newLabel.OnMouseUp:=newLabelMouseUp;
end;
// Обработчики мыши для TLabel
procedure TmainForm.newLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Move := false;
end;
procedure TmainForm.newLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button <> mbLeft then exit;
dx := X;
dy := Y;
move := true;
(Sender as TControl).BringToFront;
end;
procedure TmainForm.newLabelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
P:TPoint;
begin
if move then
begin
// Обработка перемещения
with (Sender as TControl)do
SetBounds(Left + X - dx, Top + Y - dy, Width, Height);
end;
end;
// *****************************************
procedure TmainForm.MenuItem6Click(Sender: TObject);
begin
// Создать надпись
mnCreateLabel('nmLabel1');
end;
procedure TmainForm.mainTimerTimer(Sender: TObject);
var
Control: TControl;
P: TPoint;
begin
try
P:=mouse.CursorPos;
Control := FindDragTarget(P, True);
if Assigned(Control) then
begin
comp_name := Control.Name;
comp_class :=Control.ClassName;
end;
except
// Если ошибка
end;
end;
end.