Z
zhenxin0603
Unregistered / Unconfirmed
GUEST, unregistred user!
我自己写了个控件代码附后 unit2.pas
另有一个测试单元,代码附后 unit1.pas
现在的问题是:
直接运行程序后,点击窗体上的button4 执行application.messagebox 没问题
而在点击button1设用控件的init 初始化建立若干个BaseElement时后,再点button4却不显示messagebox了,为什么?
unit Unit2;
interface
uses
Controls, Windows, Messages, Classes;
type
TMapControl = class;
{ TBaseElement }
TBaseElement = class(TPersistent) //元素基类,
private
vHandle:HWND; //元素句柄
procedure WndProc(var Message); virtual; //处理消息用的
procedure MainWndProc(var Message: TMessage);
private
vMapControl:TMapControl;
FText: string;
FPoint: TPoint;
procedure SetPoint(const Value: TPoint);
procedure SetText(const Value: string);
procedure Show;virtual;
protected
property Text:string read FText write SetText;
property Point:TPoint read FPoint write SetPoint;
public
// constructor Create(Owner:TComponent);overload;override;
constructor Create(Owner:TMapControl);overload;
constructor Create(Owner:TMapControl;vPoint:TPoint;vText:String);overload;
destructor Destroy; override;
published
end;
{ TMapControl }
TMapControl= class(TGraphicControl)
private
vElements:TStrings;
procedure ClearElements;
procedure FreeElements(Element:TBaseElement);
protected
procedure Paint; override;
procedure WndProc(var Message: TMessage); override;
public
procedure init(num:Integer);
procedure Display;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
procedure Register;
implementation
uses
SysUtils, Forms, Graphics;
procedure Register;
begin
// RegisterClass(TBaseElement);
RegisterComponents('Standard',[TMapControl]);
end;
{ TBaseElement }
var
CM_ShowElementWORD; //此为系统全局的一个消息值,用于消息广播时使用
constructor TBaseElement.Create(Owner:TMapControl);
begin
// create(TComponent(Owner));
vMapControl:=Owner;
end;
constructor TBaseElement.Create(Owner: TMapControl; vPoint: TPoint;
vText: String);
begin
Create(Owner);
Text:=vText;
Point:=vPoint;
vHandle:=AllocateHWnd(MainWndProc);
end;
{constructor TBaseElement.Create(Owner: TComponent);
begin
inherited;
end; }
destructor TBaseElement.Destroy;
begin
DeallocateHWnd(vHandle);
inherited;
end;
procedure TBaseElement.MainWndProc(var Message: TMessage);
begin
try
WndProc(Message);
except
Application.HandleException(Self);
end;
end;
procedure TBaseElement.SetPoint(const Value: TPoint);
begin
FPoint := Value;
end;
procedure TBaseElement.SetText(const Value: string);
begin
FText := Value;
end;
procedure TBaseElement.Show;
begin
vMapControl.Canvas.TextOut(FPoint.X,FPoint.Y,FText);
end;
procedure TBaseElement.WndProc(var Message);
begin
if tmessage(Message).Msg= CM_ShowElement then
begin
show;
end ;
end;
{ TMapControl }
procedure TMapControl.ClearElements;
var
i:integer;
begin
for i:=0 to vElements.Count-1 do
begin
vElements.Objects.Free;
end;
vElements.Clear;
end;
constructor TMapControl.Create(AOwner: TComponent);
begin
inherited;
vElements:=TStringList.Create;
end;
destructor TMapControl.Destroy;
begin
ClearElements;
vElements.Free;
inherited;
end;
procedure TMapControl.Display; //发送消息广播
var
vWORD;
dDWORD;
begin
Canvas.FillRect(ClientRect);
v:=BSM_ALLCOMPONENTS +BSM_APPLICATIONS ;
d:=@v;
BroadcastSystemMessage(BSF_POSTMESSAGE ,d,CM_ShowElement,0,0)
//SendMessage(Parent.Handle,WM_ShowElement,0,0)
end;
procedure TMapControl.FreeElements(Element: TBaseElement);
var
i:Integer;
begin
i:=vElements.IndexOfObject(Element);
if i>=0 then
begin
vElements.Delete(i);
vElements.Free;
end;
end;
procedure TMapControl.init(num: Integer);
var
i:integer;
begin
ClearElements;
for i:=1 to num do
vElements.AddObject(IntToStr(i),
TBaseElement.Create(Self,Point(random(Width),random(Height)),IntToStr(i)))
end;
procedure TMapControl.Paint;
begin
inherited Paint;
Canvas.FrameRect(ClientRect);
end;
procedure TMapControl.WndProc(var Message: TMessage);
begin
inherited;
end;
initialization
CM_ShowElement:=RegisterWindowMessage('pangpang');
finalization
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Unit2;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
MapControl1: TMapControl;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
protected
procedure WndProc(var Message: TMessage); override;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
mWORD;
procedure TForm1.Button1Click(Sender: TObject);
begin
MapControl1.init(10000);
// Application.MessageBox('asdfasd','')
end;
procedure TForm1.Button2Click(Sender: TObject);
var
vWORD;
dDWORD;
r:Integer;
begin
v:=BSM_ALLCOMPONENTS ;
d:=@v;
r:=BroadcastSystemMessage(BSF_FORCEIFHUNG ,d,m,0,0);
Caption :=IntToStr(r);
end;
procedure TForm1.WndProc(var Message: TMessage);
begin
inherited;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
MapControl1.Display;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Application.MessageBox('asdfasd','')
end;
end.
另有一个测试单元,代码附后 unit1.pas
现在的问题是:
直接运行程序后,点击窗体上的button4 执行application.messagebox 没问题
而在点击button1设用控件的init 初始化建立若干个BaseElement时后,再点button4却不显示messagebox了,为什么?
unit Unit2;
interface
uses
Controls, Windows, Messages, Classes;
type
TMapControl = class;
{ TBaseElement }
TBaseElement = class(TPersistent) //元素基类,
private
vHandle:HWND; //元素句柄
procedure WndProc(var Message); virtual; //处理消息用的
procedure MainWndProc(var Message: TMessage);
private
vMapControl:TMapControl;
FText: string;
FPoint: TPoint;
procedure SetPoint(const Value: TPoint);
procedure SetText(const Value: string);
procedure Show;virtual;
protected
property Text:string read FText write SetText;
property Point:TPoint read FPoint write SetPoint;
public
// constructor Create(Owner:TComponent);overload;override;
constructor Create(Owner:TMapControl);overload;
constructor Create(Owner:TMapControl;vPoint:TPoint;vText:String);overload;
destructor Destroy; override;
published
end;
{ TMapControl }
TMapControl= class(TGraphicControl)
private
vElements:TStrings;
procedure ClearElements;
procedure FreeElements(Element:TBaseElement);
protected
procedure Paint; override;
procedure WndProc(var Message: TMessage); override;
public
procedure init(num:Integer);
procedure Display;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
procedure Register;
implementation
uses
SysUtils, Forms, Graphics;
procedure Register;
begin
// RegisterClass(TBaseElement);
RegisterComponents('Standard',[TMapControl]);
end;
{ TBaseElement }
var
CM_ShowElementWORD; //此为系统全局的一个消息值,用于消息广播时使用
constructor TBaseElement.Create(Owner:TMapControl);
begin
// create(TComponent(Owner));
vMapControl:=Owner;
end;
constructor TBaseElement.Create(Owner: TMapControl; vPoint: TPoint;
vText: String);
begin
Create(Owner);
Text:=vText;
Point:=vPoint;
vHandle:=AllocateHWnd(MainWndProc);
end;
{constructor TBaseElement.Create(Owner: TComponent);
begin
inherited;
end; }
destructor TBaseElement.Destroy;
begin
DeallocateHWnd(vHandle);
inherited;
end;
procedure TBaseElement.MainWndProc(var Message: TMessage);
begin
try
WndProc(Message);
except
Application.HandleException(Self);
end;
end;
procedure TBaseElement.SetPoint(const Value: TPoint);
begin
FPoint := Value;
end;
procedure TBaseElement.SetText(const Value: string);
begin
FText := Value;
end;
procedure TBaseElement.Show;
begin
vMapControl.Canvas.TextOut(FPoint.X,FPoint.Y,FText);
end;
procedure TBaseElement.WndProc(var Message);
begin
if tmessage(Message).Msg= CM_ShowElement then
begin
show;
end ;
end;
{ TMapControl }
procedure TMapControl.ClearElements;
var
i:integer;
begin
for i:=0 to vElements.Count-1 do
begin
vElements.Objects.Free;
end;
vElements.Clear;
end;
constructor TMapControl.Create(AOwner: TComponent);
begin
inherited;
vElements:=TStringList.Create;
end;
destructor TMapControl.Destroy;
begin
ClearElements;
vElements.Free;
inherited;
end;
procedure TMapControl.Display; //发送消息广播
var
vWORD;
dDWORD;
begin
Canvas.FillRect(ClientRect);
v:=BSM_ALLCOMPONENTS +BSM_APPLICATIONS ;
d:=@v;
BroadcastSystemMessage(BSF_POSTMESSAGE ,d,CM_ShowElement,0,0)
//SendMessage(Parent.Handle,WM_ShowElement,0,0)
end;
procedure TMapControl.FreeElements(Element: TBaseElement);
var
i:Integer;
begin
i:=vElements.IndexOfObject(Element);
if i>=0 then
begin
vElements.Delete(i);
vElements.Free;
end;
end;
procedure TMapControl.init(num: Integer);
var
i:integer;
begin
ClearElements;
for i:=1 to num do
vElements.AddObject(IntToStr(i),
TBaseElement.Create(Self,Point(random(Width),random(Height)),IntToStr(i)))
end;
procedure TMapControl.Paint;
begin
inherited Paint;
Canvas.FrameRect(ClientRect);
end;
procedure TMapControl.WndProc(var Message: TMessage);
begin
inherited;
end;
initialization
CM_ShowElement:=RegisterWindowMessage('pangpang');
finalization
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Unit2;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
MapControl1: TMapControl;
Button3: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
protected
procedure WndProc(var Message: TMessage); override;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
mWORD;
procedure TForm1.Button1Click(Sender: TObject);
begin
MapControl1.init(10000);
// Application.MessageBox('asdfasd','')
end;
procedure TForm1.Button2Click(Sender: TObject);
var
vWORD;
dDWORD;
r:Integer;
begin
v:=BSM_ALLCOMPONENTS ;
d:=@v;
r:=BroadcastSystemMessage(BSF_FORCEIFHUNG ,d,m,0,0);
Caption :=IntToStr(r);
end;
procedure TForm1.WndProc(var Message: TMessage);
begin
inherited;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
MapControl1.Display;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Application.MessageBox('asdfasd','')
end;
end.