Форум: "Основная";
Текущий архив: 2002.12.02;
Скачать: [xml.tar.bz2];

Вниз

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

← →
llserge1   (2002-11-22 18:39) [0]

Если кому не трудно, перепишите пожалуйста эту программу так, чтобы получилась компонента типа 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.


---

← →
LongIsland   (2002-11-22 18:50) [1]

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.

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

---

← →
llserge1   (2002-11-22 19:04) [2]

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

If WindowFromPoint(pt)<>form1.Handle Then

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

---

← →
TTCustomDelphiMaster   (2002-11-22 19:32) [3]

Для примера:
Юрий Зотов © (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;

---

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

> TTCustomDelphiMaster © (22.11.02 19:32)

Не спорю.

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

---

← →
TTCustomDelphiMaster   (2002-11-22 21:39) [5]

LongIsland

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

---

← →
LongIsland   (2002-11-22 21:46) [6]

> TTCustomDelphiMaster © (22.11.02 21:39)

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

---

← →
Anatoly Podgoretsky   (2002-11-22 21:54) [7]

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

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2002.12.02;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.008 c