Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Обработка событий

Автор: mrVerus 30.11.2009, 08:27

Доброго времени суток! Подскажите как научить свой созданный обьект откликатся на события7

Автор: mrVerus 30.11.2009, 09:07

Если поподробние, создаются несколько объектов одного класса, при перемещении мыши они должны откликатся на это событие. Как это можно реализовать7

Автор: former 30.11.2009, 09:50

Цитата(mrVerus @ 30.11.2009, 09:07

)

Если класс самописный, то необходимо в нем создать события OnMouseMove (посмотри исходник любого компонента, у которого есть такое событие). Если класс стандартный и у него нет такого события, то создавай наследника с таким событием.

Автор: mrVerus 30.11.2009, 09:55

Код


type
  TMyObj = class(TObject)
  X:Integer;
  Y:Integer;
  Color:TColor;
  procedure Draw;
  Constructor Create;
  procedure move(mx,my:integer);
   {Destructor  Destroy;}
  end;

Автор: amsoft 30.11.2009, 10:46

может сделать наследника от TControl

Автор: mrVerus 1.12.2009, 07:18

Мне нужен обьект этого класса, так как мне научить его откликатся на события7
Пожалуйста помогоите

Автор: Frees 1.12.2009, 07:32

Цитата(mrVerus @ 1.12.2009, 10:18

)

так как мне научить его откликатся на события7

почитать учебник...или статью
http://www.rsdn.ru/article/Delphi/makecomponents.xml

Автор: mrVerus 1.12.2009, 08:32

Что здесь не верно

Код


type
TNotifyEvent = procedure(Sender: TObject; var AValue: Integer) of object;
  TMyObj = class(TControl)
  procedure Draw;
  procedure move(mx,my:integer);
  Public
  id:integer;
  X:Integer;
  Y:Integer;
  flagmove:boolean ;
  Color:TColor;
    Constructor Create(AOwner:TComponent); override;
  protected
  procedure WndProc(var Message: TMessage); override;

  {procedure GetMouseMove(cX,cY:integer);
  procedure GetMouseDown(cX,cY:integer; MouseBtn:TMouseButton);
  procedure GetMouseUp(cX,cY:integer; MouseBtn:TMouseButton);
  procedure ButtonDown(var Msg : TWMMouse); message WM_RBUTTONDOWN;}
  {Destructor  Destroy;}
  end;


procedure TMyObj.WndProc(var Message: TMessage);
begin
{if Assigned(FOnClick) then
 FOnClick(Self);}
 {if (self.X<cx) and (self.X+30>cx)and
(self.y<cy) and (self.Y+30>cy) then}

Color:=cllime;
Draw;
end;

Автор: sCreator 1.12.2009, 11:23

Неверно почти все Там ничего почти не видно. ( посмотреть бы саму реализацию, а пока будем делать предположения).
Думаю нестоит переопределять TNotifyEvent , если нужно напиши TMyNotifyEvent .

Первоначально твой класс рисует что то на конкретной канве и может перемещать свой рисунок.
При этом ни канва ни объект на чьей канве рисуется ему не передается, значит строго задан.
И в цепочке обработки событий он не участвует.
Сделал Ты его от TControl и прописал владельца ( Owner ) - только владелец если упрощенно отвечает за своевременное уничтожение принадлежащих ему компонентов.
А вот назначение свойства TControl.Parent уже покажет на чьей канве он расположен.
Далее есть еще BoundsRect определяющее размеры и положение твоего объекта на канве. И Visible показывающее рисуется он или нет. Enabled - показывающее принимает ли он события.
Вот на основании этих свойств Parent ( TWinControl ) и будет передавать ( или нет ) ему сообщения.
Посмотри в модуле Controls

Код


procedure TWinControl.WndProc(var Message: TMessage);
//.......
    WM_MOUSEFIRST..WM_MOUSELAST:
      if IsControlMouseMsg(TWMMouse(Message)) then
      begin
        { Check HandleAllocated because IsControlMouseMsg might have freed the
          window if user code executed something like Parent := nil. }
        if (Message.Result = 0) and HandleAllocated then
          DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam);
        Exit;
      end;

а также TWinControl.IsControlMouseMsg и TWinControl.ControlAtPos
Там механизм и условия передачи от Парента к Контролу расписаны.

Ну а дальше немного переделать его рисование с учетом выше названных свойств на канве Парента.

Автор: sCreator 1.12.2009, 11:52

Порядок дальнейшей доделки, думаю, такой:
- наследуй его от TGraphicControl
- реализуй функцию procedure Paint; override; ( перенеси из Draw )
  ( там должно быть рисование с учетом положения ( ClientRect) на канве предоставляемой TGraphicControl )
- Draw у тебя будет просто вызывать Repaint
- move(mx,my:integer) должно просто изменять BoundsRect   и возможно вызывать Repaint

- присваиваешь Parent
- задаешь размеры ( BoundsRect   или по отдельности Left, Top и т.д. )
- делаешь видимым ( Visible := True )
- Enabled вроде бы по умолчанию включено

пробуешь ловить события ( можешь прикрепить обработчики к OnMouseDown например или переписать ( override ) методы procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); dynamic;

Поправил - в Paint надо использовать ClientRect

Вот простейшая реализация:

Код


unit MyDDraw;

interface

uses
  Classes, Controls, Graphics;

type
  TMyDDraw = class(TGraphicControl)
  private
    FColor: TColor;
  protected
    procedure Paint; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); dynamic;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published 

  end;

implementation

{ TMyDDraw }

constructor TMyDDraw.Create(AOwner: TComponent);
begin
  inherited;
  FColor := clMaroon;
  Width := 40;
  Height := 40;
end;

destructor TMyDDraw.Destroy;
begin

  inherited;
end;

procedure TMyDDraw.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  FColor := clGreen;
  Repaint;
end;

procedure TMyDDraw.MouseMove(Shift: TShiftState; X, Y: Integer);
begin

end;

procedure TMyDDraw.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  FColor := clMaroon;
  Left := Left + 20;
  Top := Top + 20;
  Repaint;
end;

procedure TMyDDraw.Paint;
var
  tmpBrush: TBrushRecall;
begin
  inherited;
  tmpBrush := TBrushRecall.Create(Canvas.Brush);
  try
    Canvas.Brush.Color := FColor;
    Canvas.FillRect(ClientRect);
  finally
    tmpBrush.Free;
  end;

end;

end.

Использовать

Код


procedure TDSTestForm.FormShow(Sender: TObject);
var
  md: TMyDDraw;
begin
  md := TMyDDraw.Create(self);
  md.Parent := Self;
  md.Visible := true;
end;