关于控件事件...在线等待,解决立即放分。 (100分)

  • 主题发起人 主题发起人 desertsmoke
  • 开始时间 开始时间
unit RJ;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, ExtCtrls, Graphics;

type
TMyPortStyle = ( psDown , psUp );
TRJ = class(TPanel)
TimerAlarm:TTimer;
ImageShow:TImage;
private
{ Private declarations }
//FOnImageClick :TMouseEvent;
boolAlarm :Boolean; //Alarm属性的响应变量
boolDirection :Boolean; //Direction属性的响应变量
colorAlarmColor :TColor; //AlarmColor属性的响应变量
boolNowAlarm :Boolean; //控制TimerAlarm组件不被多次创建的变量
colorBackgroundColor:TColor; //BackgroundColor属性的响应变量
FPortStyle :TMyPortStyle;
procedure SetAlarm(AlarmNow:Boolean); //Alarm属性的响应函数
procedure SetDirection(DireNow:Boolean); //Direction属性的响应函数
procedure SetAlarmColor(AlarmColor:TColor);//AlarmColor属性的响应函数
procedure Wmsize(var message:Tmessage);message wm_size;//组件大小变化时的消息响应函数
procedure TimerAnswer(Sender:TObject); //Tiemr1组件的定时相应函数
procedure SetBackgroundColor(BackgroundColor:Tcolor); //BackgroundColor属性的响应函数
Procedure SetPortStyle(PS:TMyPortStyle); //PortStyle属性的响应函数
Procedure ImageOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,Y: Integer);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner:TComponent);override; //重载Create函数
//constructor TImage.Create(AOwner: TComponent);
//constructor TShape2.Create(AOwner: TComponent);OverRide;
procedure ChangeImage(ImageName:String); //更换图片的方法
published
{ Published declarations }
property Direction : Boolean read boolDirection write SetDirection; //纵横指定
property Alarm : Boolean read boolAlarm write SetAlarm; //告警指定
property AlarmColor : TColor read colorAlarmColor write SetAlarmColor;//告警颜色指定
property BackgroundColor : Tcolor read colorBackgroundColor write SetBackgroundColor;//背景颜色指定
property PortStyle : TMyPortStyle read FPortStyle write SetPortStyle default psDown;
//Property OnImageClick : TMouseEvent read FOnImageClick write FOnImageClick;
end;

procedure Register;
{$R RJ.res}
implementation

procedure Register;
begin
RegisterComponents('PanelVCL', [TRJ]);
end;

{函数功能:重载Create函数}
constructor TRJ.Create(AOwner:TComponent);
begin
inherited Create(AOwner);

//组件原始外观
Height:=103;
Width:=104;
BevelOuter:=bvnone;
BevelInner:=bvnone;
//初始化各属性
boolAlarm:=False;
colorAlarmColor:=clRed;
colorBackgroundColor:=Color;

//创建Image组件
ImageShow:=TImage.Create(self);
ImageShow.Parent:=self;
ImageShow.Top:=2;
ImageShow.Left:=2;
ImageShow.Height:=99;
ImageShow.Width:=100;
ImageShow.Stretch:=true;
ImageShow.Picture.Bitmap.Handle:=LoadBitmap(HInstance,'RJV');
ImageShow.Show;
//ImageShow.OnClick := OnClick;
ImageShow.OnMouseDown := ImageOnMouseDown;
boolNowAlarm:=False;//设置控制告警的全局变量
boolDirection:=False;

end;

{函数功能:实现缩放功能}
procedure TRJ.Wmsize(var message:TMessage);
begin
inherited;

if (Height > 0)and(Width > 0) then
begin
ImageShow.Height:=Height-4;
ImageShow.Width:=Width-4;
end;
end;

{函数功能:实现告警指定功能,响应Alarm属性
参数说明:对组件属性Alarm的赋值}
procedure TRJ.SetAlarm(AlarmNow:Boolean);
begin
//若第一次进行告警,创建TimerAlarm组件
if boolNowAlarm = False then
begin
TimerAlarm:=TTimer.Create(self);
TimerAlarm.Interval:=1000;
TimerAlarm.OnTimer:=TimerAnswer;
boolNowAlarm:=True;
end;
TimerAlarm.Enabled:=AlarmNow;
BoolAlarm:=AlarmNow;

//停止告警时背景色改为原始背景色
if AlarmNow = False then
Color:=colorBackgroundColor;

end;

{函数功能:TimerAlarm组件的定时响应函数,实现变色}
procedure TRJ.TimerAnswer(Sender:TObject);
begin
if Color = colorBackgroundColor then
Color:=colorAlarmColor
else
Color:=colorBackgroundColor;

end;

{函数功能:设置告警颜色,响应AlarmColor属性
参数说明:对组件属性AlarmColor的赋值}
procedure TRJ.SetAlarmColor(AlarmColor:TColor);
begin
colorAlarmColor:=AlarmColor;
end;

{函数功能:设置背景颜色,响应BackgroundColor属性
参数说明:对组件属性BackgroundColor的赋值}
procedure TRJ.SetBackgroundColor(BackgroundColor:TColor);
begin
colorBackgroundColor:=BackgroundColor;
Color:=colorBackgroundColor;

end;

{函数功能:为用户提供更改图片的方法
参数说明:用户自行应用的res文件中的Bitmap图形名}
procedure TRJ.ChangeImage(ImageName:String);
var
x:pchar;
begin
x:=pchar(ImageName);
ImageShow.Picture.Bitmap.Handle:=LoadBitmap(HInstance,x);
end;

procedure TRJ.SetDirection(DireNow:Boolean);
begin
if DireNow <> boolDirection then
begin
boolDirection:=DireNow;
if DireNow = True then
ImageShow.Picture.Bitmap.Handle:=LoadBitmap(HInstance,'RJH')
else
ImageShow.Picture.Bitmap.Handle:=LoadBitmap(HInstance,'RJV');
end;
end;

procedure TRJ.SetPortStyle(PS: TMyPortStyle);
var
ImgStr:string;
begin
FportStyle := PS;
if PS=psDown then
ImgStr := 'RJV'
else
ImgStr := 'RJV1';
ChangeImage(ImgStr);
end;

procedure TRJ.ImageOnMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
SendMessage(Parent.Handle, WM_LButtonDown, 0, x shl 16+y)
end;

end.
 
to:LeeChange
ImageShow还是不能触发TRJ的OnMouseDown事件!
请测试
procedure TForm1.RJ1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
showmessage('a');
end;
 
sorry
procedure TRJ.ImageOnMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
SendMessage(Handle, WM_LButtonDown, 0, x shl 16+y)
end;

 
to:LeeChange
还是不能触发,请留下Mail,我把资源文件一起发给你.
 
跟踪进去看看,SendMessage有没有被执行?
 
o, 试试这个:
procedure TRJ.ImageOnMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
// 调用父类的MouseDown虚拟方法
MouseDown(Button, Shift, ImageShow.Left + X, ImageShow.Top + y);
end;
 
LeeChange的方法对于非窗口控件是不行的,因为他们没有句柄,而调用父类的MouseDown则无论对于窗口控件还是非窗口控件都是可用的。
 
to Traveller:
TRJ继承自TPanel,难道大虾认为TPanel没有句柄?
其实有最流氓的办法,只不过我是希望用正统的办法解决问题.
 
呵呵~~谢谢Traveller!组件开发方面有什么好的书、资料什么的,给我推荐一下
谢谢LeeChange、AIHUA
 
关于组件开发的书少之又少。
不过基础是面对语言,还有就是参考VCL

《D4技术内幕》第二部分 第6,7章 有!
 
to LeeChange:
我并没有说你的方法不行,我只是告诉你它的局限而已。有通用的方法还是优先使用通用的方法。
to Desertsmoke:
如果英语水平不太差的话就阅读一下Delphi自带的帮助,我主要就是这样学的,我英语很次,不过看了几年之后读起来也很容易了。
另一方面VCL的源码以及Delphi的Demo比任何参考书都有权威性,有时间可以阅读一下,开始读的时候还眼花缭乱,后来就上瘾了 :D
《D4技术内幕》是一本极好的书,可惜我以前买的丢了,555~~~
另外,李维的书层次一般都比较高,可以买来参考。
不过主要的还是实践啦,比如你提的问题我还没见到什么书里提过,呵呵。有问题就来这里问吧,给我发mail也可以。
 
to:LeeChange
Sorry!我结贴有点快了!但是如有其它方法解决的话,我也不会吝啬再开一贴的,主要是
希望通过跟大家交流,使自己有所进步
——站在巨人的肩膀上....(有点唐僧的味道?!呵呵~~)
to:Traveller
英语水平差有字典啊!《D4技术内幕》我有电子版的,真没怎么看!你要的话我Mail给你。
to:AIHUA
以后大家有什么好的心得,资料什么的,公开来交流交流。我的这部分程序结束后我会做一
个总结——关于控件的动态创建等(虽然可能价值不大),但希望能给大家一点借鉴!

 
好,谢谢啦,电子版有多大啊?
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部