| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Помогите начинающему создать свою компоненту

llserge1 ©   (2002-11-22 18:39:00) 

Если кому не трудно, перепишите пожалуйста эту программу так, чтобы получилась компонента типа TMyLabel


unit Unit1;

interface

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

type
TForm1 = class(TForm)
Label1: TLabel;
Timer1: TTimer;
procedure Label1MouseEnter(Sender: TObject);
procedure Label1MouseLeave(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Label1MouseEnter(Sender: TObject);
begin
label1.font.Color:=clred;
timer1.Enabled:=true;
end;

procedure TForm1.Label1MouseLeave(Sender: TObject);
begin
label1.font.Color:=clblack;
timer1.Enabled:=false;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
Var Pt:Tpoint;
begin
GetCursorPos(Pt);
If WindowFromPoint(pt)<>form1.Handle Then
Begin
label1.font.Color:=clblack;
Timer1.Enabled:=False;
end;
end;

end.


---

Anatoly Podgoretsky   (2002-11-22 21:54:00) [1]

Папа с мамой виноваты

---

LongIsland   (2002-11-22 21:46:00) [2]

> TTCustomDelphiMaster © (22.11.02 21:39)

Нет вопросов:-) Но почему???:-)

---

TTCustomDelphiMaster   (2002-11-22 21:39:00) [3]

LongIsland

Это вам не исходники. Это Юрий Зотов © !!! :)

---

LongIsland   (2002-11-22 21:34:00) [4]

> TTCustomDelphiMaster © (22.11.02 19:32)

Не спорю.

Но вот что интересно: сколько не рылся в исходниках VCL, такого не видел. Или я чего-то не допонимаю?

---

TTCustomDelphiMaster   (2002-11-22 19:32:00) [5]

Для примера:
Юрий Зотов © (25.09.02 20:56)
1. В обработчиках сообщений нет вызыовов inherited. Подозркваю, что дело может быть в этом (разорвана "родная" цепочка передачи сообшений Parent"ам, что нарушает механизмы VCL).

2. Если делать грамотно, то нужно вводить методы диспетчеризации. Они позволяют наследникам класса безопасно встроить свой код в цепочку обработки события.

TMyImage = class(TImage)
private
FOnMouseEnter: TNotifyEvent;
FOnMouseLeave: TNotifyEvent;
procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
protected
procedure DoMouseEnter; dynamic;
procedure DoMouseLeave; dynamic;
published
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;

procedure TMyImage.CMMouseEnter(var Msg: TMessage);
begin
inheried;
DoMouseEnter
end;

procedure TMyImage.CMMouseLeave(var Msg: TMessage);
begin
inherited;
DoMouseLeave
end;

procedure TMyImage.DoMouseEnter;
begin
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self)
end;

procedure TMyImage.DoMouseLeave;
begin
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self)
end;

---

llserge1   (2002-11-22 19:04:00) [6]

Спасибо, но есть один момент в TMyLabel.OnTimer(Sender: TObject);

If WindowFromPoint(pt)<>form1.Handle Then

Ведь form1.Handle еще как бы нет

---

LongIsland   (2002-11-22 18:50:00) [7]

unit Unit1;

interface

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

type
TMyLabel = class(Label)

private
Timer1: TTimer;
procedure MouseEnter(Sender: TObject); override;
procedure MouseLeave(Sender: TObject); override;
procedure OnTimer(Sender: TObject);
end;

implementation

{$R *.dfm}

procedure TMyLabel.MouseEnter(Sender: TObject);
begin
inherited;
font.Color:=clred;
timer1.Enabled:=true;
end;

procedure TForm1.Label1MouseLeave(Sender: TObject);
begin
inherited;
font.Color:=clblack;
timer1.Enabled:=false;
end;

procedure TMyLabel.OnTimer(Sender: TObject);
Var Pt:Tpoint;
begin
GetCursorPos(Pt);
If WindowFromPoint(pt)<>form1.Handle Then
Begin
font.Color:=clblack;
Timer1.Enabled:=False;
end;
end;

end.

Что-то похожее. Исправлял на скорую руку под порядочным градусом:-) А вообже, почитай статью на этом сайте по этому поводу

---

Наверх