VPF::Как узнать над каким компонентом находится курсор

Yanis

Дата 29.3.2006, 08:22 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111

Нацарапал пример с панелями. надеюсь аналогия станет ясна:

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure AddRect(cl:TColor);
    procedure EventPanelMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure EventPanelClick(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

uses Math;

{$R *.dfm}

procedure TForm1.AddRect(cl:TColor);
  function GetPanelCount: Integer;
  begin
    for Result := 0 to Form1.ComponentCount-1 do
      if (Form1.Components[Result] is TPanel) then
        Continue
      else
        Break;
  end;
var
  p: TPanel;
begin
  p := TPanel.Create(Form1);
  with p do
    begin
      Top := RandomRange(0, Form1.Height-Height);
      Left := RandomRange(0, Form1.Width-Width);

      Color := cl;
      Parent := Form1;
      ParentBackground := False;

      OnClick := EventPanelClick;
      OnMouseMove := EventPanelMove;

      Name := 'Panel_'+IntToStr(GetPanelCount);
    end;
end;

{ TForm1 }

procedure TForm1.EventPanelClick(Sender: TObject);
begin
  ShowMessage('Color '+ColorToString((Sender as TPanel).Color));
end;

procedure TForm1.EventPanelMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Caption := (Sender as TPanel).Name+'.Color = '+ColorToString((Sender as TPanel).Color);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  AddRect(clRed);
  AddRect(clGreen);
  AddRect(clBlue);
end;

end.

--------------------

*щёлк*

Rennigth

Дата 29.3.2006, 09:53 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1708
Регистрация: 21.6.2004
Где: Moscow

Репутация: 49
Всего: 76

Цитата(Vardoulacha @ 29.3.2006, 07:41

)

сейчас пробую сделать через БД (хранение координат каждой Image)

Прошу тебя как человека, не делай так...

Вот пример с эвентом на MouseMove

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
  private
    procedure MouseMoveEvent(ASender: TObject; AShift: TShiftState; X, Y: Integer);
  public
    constructor Create(AOwner: TComponent); override;
  end;

var
  Form1: TForm1;

implementation

function CreateImage(AParent: TWinControl; APos: TPoint;
  AMoveEvent: TMouseMoveEvent): TImage;

  function GetBitmap: TBitmap;
  begin
    Result := TBitmap.Create;
    Result.Height := 10;
    Result.Width := 10;
    Result.Canvas.Brush.Color := clRed;
    Result.Canvas.FillRect(Rect(0,0,10,10));
  end;

begin
  Result := TImage.Create(nil);
  Result.Parent := AParent;
  Result.Left := APos.X;
  Result.Top := APos.Y;
  Result.Picture.Bitmap.Assign(GetBitmap);
  Result.Stretch:=True;
  Result.Hint:= IntToStr(APos.X) + '^' + IntToStr(APos.X);
  Result.ShowHint := True;
  Result.OnMouseMove := AMoveEvent;
end;

{$R *.dfm}

{ TForm1 }

constructor TForm1.Create(AOwner: TComponent);
var
  i: Integer;
begin
  inherited;
  for i := 0 to 9 do
    CreateImage(Self, Point(i * 50, i * 50), MouseMoveEvent);

end;

procedure TForm1.MouseMoveEvent(ASender: TObject; AShift: TShiftState; X,
  Y: Integer);
begin
  if Assigned(ASender) then
    Caption := TControl(ASender).Hint;
end;

end.

Добавлено @ 10:00
это с ControlAtPos

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
  private
    procedure MouseMoveEvent(ASender: TObject; AShift: TShiftState; X, Y: Integer);
  public
    constructor Create(AOwner: TComponent); override;
  end;

var
  Form1: TForm1;

implementation

function CreateImage(AParent: TWinControl; APos: TPoint;
  AMoveEvent: TMouseMoveEvent): TImage;

  function GetBitmap: TBitmap;
  begin
    Result := TBitmap.Create;
    Result.Height := 10;
    Result.Width := 10;
    Result.Canvas.Brush.Color := clRed;
    Result.Canvas.FillRect(Rect(0,0,10,10));
  end;

begin
  Result := TImage.Create(nil);
  Result.Parent := AParent;
  Result.Left := APos.X;
  Result.Top := APos.Y;
  Result.Picture.Bitmap.Assign(GetBitmap);
  Result.Stretch:=True;
  Result.Hint:= IntToStr(APos.X) + '^' + IntToStr(APos.X);
  Result.ShowHint := True;
  Result.OnMouseMove := AMoveEvent;
end;

{$R *.dfm}

{ TForm1 }

constructor TForm1.Create(AOwner: TComponent);
var
  i: Integer;
begin
  inherited;
  for i := 0 to 9 do
    CreateImage(Self, Point(i * 50, i * 50), MouseMoveEvent);
  OnMouseMove := MouseMoveEvent;

end;

procedure TForm1.MouseMoveEvent(ASender: TObject; AShift: TShiftState; X,
  Y: Integer);
var
  lControl: TControl;
begin
  lControl := ControlAtPos(ScreenToClient(Mouse.CursorPos), True, True);
  if Assigned(lControl) then
    Caption := lControl.Hint;
end;
end.

--------------------

(* Honesta mors turpi vita potior *)

Vardoulacha

Дата 29.3.2006, 11:25 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 184
Регистрация: 11.8.2005

Репутация: нет
Всего: 8

Yanis, Rennigth

черт все ваши примеры рабочие smile

логично не правда ли, седня вечером буду прикручивать к своим нуждам и завтра отпишусь какой вариант выбрал

P.S. хотел вам репутацию поднять, но оказалось что мне для этого нужно 100 постов, поэтому выскажусь так: огромное вам спасибо

P.S.S. пока топик не закрывайте я свой код отпишу

Vardoulacha

Дата 30.3.2006, 05:34 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 184
Регистрация: 11.8.2005

Репутация: нет
Всего: 8

вообщем я сделал вот так (Yanis спасибо за код, твой код мне подошел больше, Rennigth твои коды тоже рабочие но мне как то не подошли)

Код


unit Unit1;

interface

uses
    //...

type
  TMainForm = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure MouseMoveEvent(Asender: TObject; AShift: TShiftState; X, Y: Integer);
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure CreateImage(AName, AFile, AHint: String; APos: TPoint);
var
  Img: TImage;
begin
  Img:=TImage.Create(nil);
  Img.Name:=AName;
  Img.Parent:=MainForm;
  Img.Left:=APos.X*30+8;
  Img.Top:=APos.Y*30+8;
  Img.Width:=30;
  Img.Height:=30;
  Img.Picture.LoadFromFile(AFile);
  Img.Stretch:=True;
  Img.Hint:=AHint;
  Img.ShowHint:=True;
  Img.OnMouseMove:=MainForm.MouseMoveEvent;
end;

procedure TMainForm.MouseMoveEvent(Asender: TObject; AShift: TShiftState; X, Y: Integer);
begin
  if Assigned(ASender) then Label1.Caption:=TControl(ASender).Name;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  i: integer;
begin
  for i:=1 to 3
  CreateImage('img'+i, 'img'+i+'.bmp', 'Типа Хинт :)', Point(50, i+50));
end;

end.

вдруг кому еще текое же пригодится smile

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »