delphi的坑

1、delphi FormPaint 事件失效不起作用问题(版本Xe10.1)

当窗体的 borderStyle设置为 bsNone时,并且窗体上的pannel 覆盖了 整个窗体 (Align 设置为:alClient)本事件将失效

2、PeekMessage 失效问题

与Application.ProcessMessages;共用会丢失 消息列队中的数据 造成消息无法接收

-------------------------附代码------------------------------------------

---------------------------------pas------------------------------------

unit Unt_ThreadMsg;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
TMyThread = class(TThread)
protected
procedure Execute; override;
public
bStatus:Boolean;//线程状态
sMsg:string;//线程消息
constructor Create(CreateSuspended: Boolean); overload;//构造函数
destructor Destroy; override;//析构函数
end;

TFrm_ThreadMsg = class(TForm)
BtnStartThread: TButton;
MemoMsg: TMemo;
BtnSendMsg: TButton;
procedure BtnStartThreadClick(Sender: TObject);
procedure BtnSendMsgClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
myThread:TMyThread;
public
{ Public declarations }
end;


var
Frm_ThreadMsg: TFrm_ThreadMsg;

implementation

{$R *.dfm}

{$REGION '延时函数'}
procedure SafeSleep(MSecs:LongInt);
var
FirstTickCount,Now:LongInt;
begin
FirstTickCount:=GetTickCount();
repeat
Application.ProcessMessages;
Now:=GetTickCount();
until (Now - FirstTickCount >=MSecs)or(Now<FirstTickCount);
end;
{$ENDREGION}


{$REGION '线程创建'}
constructor TMyThread.Create(CreateSuspended: Boolean);
begin
sMsg:='';
try
inherited Create(CreateSuspended);
except
on e:Exception do
begin
sMsg:='ThreadCreateException:'+e.Message;
end;
end;
end;
{$ENDREGION}

{$REGION '析构函数'}
destructor TMyThread.Destroy;
begin
try
inherited;
except

end;
end;
{$ENDREGION}

{$REGION '线程执行'}
procedure TMyThread.execute;
var
msg: TMsg;//线程消息
iRun:Integer;
begin
try
bStatus:=True;
iRun:=0;
while not Terminated do
begin
Application.ProcessMessages;//加上这句 PeekMessage 就会丢失消息
//if PeekMessage(Msg,0, 0, 0, PM_NOREMOVE) then //这种就一直收到消息 需配合 GetMessage(Msg,0, 0,0); 清除消息
if PeekMessage(Msg,0, 0, 0, PM_REMOVE) then//这种 接收到消息后删除消息列表
//if GetMessage(Msg,0, 0,0) then //这种堵塞接收消息 不收到消息不往下跑
begin
//GetMessage(Msg,0, 0,0);
//记录接收到的消息
Frm_ThreadMsg.MemoMsg.Lines.Add('接收系统消息:'+IntToStr(Msg.message));
//Continue;
if Msg.message=1024 then //线程退出消息
begin
Break;
end
end;
iRun:=iRun mod 100;
Frm_ThreadMsg.MemoMsg.Lines.Add('线程执行中:'+IntToStr(iRun));
inc(iRun);
Sleep(1000);
//SafeSleep(1000);
//SafeSleep(1);
end;
except
on e:Exception do
begin
sMsg:='线程执行异常:'+e.Message;
bStatus:=False;
end;
end;
end;
{$ENDREGION}

{function ThreadSendMsg(p: Pointer): integer;
var
iMsg:Integer;//消息
i:Integer;//循环用
begin
try
for i := 1 to 10 do
begin
iMsg:=1024+i;
Frm_ThreadMsg.MemoMsg.Lines.Add('发送系统消息:'+IntToStr(iMsg));
PostThreadMessage(Frm_ThreadMsg.myThread.ThreadID,iMsg,0,0);
//SafeSleep(20);
Application.ProcessMessages;
end;
finally

end;
end;}

{$REGION '发送消息'}
procedure TFrm_ThreadMsg.BtnSendMsgClick(Sender: TObject);
var
iMsg:Integer;//消息
i:Integer;//循环用
//handel:THandle;
//tThID:TThreadID;
begin
try
//iMsg:=0;
for i := 1 to 10 do
begin
iMsg:=1024+i;
PostThreadMessage(myThread.ThreadID,iMsg,0,0);
//SendThreadMessage(myThread.ThreadID,iMsg,0,0);
MemoMsg.Lines.Add('发送系统消息:'+IntToStr(iMsg));
//SafeSleep(100);
//Sleep(1000);
Application.ProcessMessages;
end;
//handel:=BeginThread(nil, 0, ThreadSendMsg, nil, 0, tThID);
except
on e:Exception do
begin
ShowMessage('BtnSendMsgClickException:'+e.Message);
end;
end;
end;
{$ENDREGION}

{$REGION '启动线程'}
procedure TFrm_ThreadMsg.BtnStartThreadClick(Sender: TObject);
begin
try
myThread:=TMyThread.Create(true);
if myThread.Suspended then
myThread.Suspended := False;
except
on e:Exception do
begin
ShowMessage('启动线程异常:'+e.Message);
end;
end;
end;
{$ENDREGION}

{$REGION '画面销毁'}
procedure TFrm_ThreadMsg.FormDestroy(Sender: TObject);
begin
try
myThread.Terminate;
WaitForSingleObject(myThread.Handle,INFINITE);
FreeAndNil(myThread);
Application.Terminate;
except
on e:Exception do
begin
ShowMessage('FormDestroyException:'+e.Message);
end;
end;
end;
{$ENDREGION}


end.

-----------------------------------------------------------dfm---------------------------------------------------------------------

object Frm_ThreadMsg: TFrm_ThreadMsg
Left = 0
Top = 0
Caption = #32447#31243#28040#24687#27979#35797
ClientHeight = 576
ClientWidth = 894
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object BtnStartThread: TButton
Left = 192
Top = 456
Width = 75
Height = 73
Caption = #21551#21160#32447#31243
TabOrder = 0
OnClick = BtnStartThreadClick
end
object MemoMsg: TMemo
Left = 40
Top = 56
Width = 809
Height = 345
TabOrder = 1
end
object BtnSendMsg: TButton
Left = 574
Top = 456
Width = 75
Height = 73
Caption = #21457#36865#28040#24687
TabOrder = 2
OnClick = BtnSendMsgClick
end
end

posted on 2023-08-10 10:12  金宝的博客  阅读(118)  评论(0)    收藏  举报

导航