MessageBox不显示???大家来帮忙看看,在线等,可加分(100分)

  • 主题发起人 主题发起人 zhenxin0603
  • 开始时间 开始时间
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_ShowElement:DWORD; //此为系统全局的一个消息值,用于消息广播时使用

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
v:DWORD;
d:PDWORD;
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
m:DWORD;
procedure TForm1.Button1Click(Sender: TObject);
begin
MapControl1.init(10000);
// Application.MessageBox('asdfasd','')
end;

procedure TForm1.Button2Click(Sender: TObject);
var
v:DWORD;
d:PDWORD;
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.
 
[red]var
CM_ShowElement:DWORD; //此为系统全局的一个消息值,用于消息广播时使用[/red]

消息应该定义成常量
 
我的最后边用 RegisterWindowsMessage 给你值了,是定死的
 
另外,除了不显示MessageBox以外,其它都正常啊
再说,在执行Init的时候,CM_ShowElement还没用的着吧?
 
你设置断点调试一下。看看哪里出了问题
看用:
Application.MessageBox('asdfasd','ss',MB_OK)
或者:
 MessageBox(0,'asdfasd','ss',MB_OK)
能显示吗?
 
注,执行Init的时候,如果创建的元素为10 100 1000 都没问题,MessageBox也能显示
改成10000的时候就不显了,在我的机器上
是不是消息处理方面有问题?或者是因为数量太多,处理不过来了
但在实际应用中,10000个元素应该不算很大吧
 
to happycyp
设了,在没执行init之前,都管用,在执行init之后,执行到Messagebox就直接到下句了,什么反应也没有
 
我曾经遇到过这种不显示的问题

你用

Windows.MessageBox(handle,'提示内容','标题',mb_ok)

应该就好了
 
to lawler
application.messagebox 里边调用的就是windows.messagebox 啊
 
呵呵,发现问题了,每程序不能超过10000个句柄
 
User对象资源受限的结果
谢谢大家,分了
 
多人接受答案了。
 
后退
顶部