Delphi表单编程，GUI无响应!! [英] Delphi Form Programming, GUI not responding!!
本文介绍了Delphi表单编程，GUI无响应!!的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
unit Unit_hook;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Grids;
type
TCALLBACKPROC = function(strDataType:PWideChar; strDocument:PWideChar;strDriverName:PWideChar;strMachineName:PWideChar;strPrintername:PWideChar;
strParameters:PWideChar;strPrintProcessor:PWideChar; JobId:Integer;PagesPrinted:Integer; Size:Integer; status:Integer; TotalPages:Integer;SizeHigh:LongInt; dmColor:ShortInt; dmPaperLength:ShortInt; dmPaperSize:ShortInt; dmPaperWidth:ShortInt):HRESULT stdcall;
type
TSetCallbackFunc = procedure(_proc:TCALLBACKPROC) stdcall;
var
fnSetCallback : TSetCallbackFunc;
type
Tfrmhook = class(TForm)
sg: TStringGrid;
Panel1: TPanel;
btLoad: TButton;
btUnload: TButton;
procedure btLoadClick(Sender: TObject);
procedure btUnloadClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmhook: Tfrmhook;
m_hDll: HMODULE;
myString: String;
mystrDataType:PChar;
mystrDocument:PChar;
mystrDriverName:PChar;
mystrMachineName:PChar;
mystrPrintername:PChar;
mystrParameters:PChar;
mystrPrintProcessor:PChar;
myJobId:Integer;
myPagesPrinted:Integer;
mySize:Integer;
mystatus:Integer;
myTotalPages:Integer;
mySizeHigh:LongInt;
mydmColor:ShortInt;
mydmPaperLength:ShortInt;
mydmPaperSize:ShortInt;
mydmPaperWidth:ShortInt;
implementation
{$R *.dfm}
function CallbackProc(strDataType:PWideChar; strDocument:PWideChar;strDriverName:PWideChar;strMachineName:PWideChar;strPrintername:PWideChar;strParameters: PWideChar;strPrintProcessor:PWideChar; JobId:Integer;PagesPrinted:Integer; Size:Integer; status:Integer; TotalPages:Integer;
SizeHigh:LongInt; dmColor:ShortInt; dmPaperLength:ShortInt; dmPaperSize:ShortInt; dmPaperWidth:ShortInt):HRESULT stdcall;
var
i : integer;
begin
MessageBox(0, 'cbk proc', 'cbk proc', MB_OK);
{
myString := 'DataType = ' + strDataType + #13#10 + 'Document = ' +strDocument+ #13#10 + 'DriverName = '+ strDriverName + #13#10 + 'MachineName = ' + strMachineName
+ #13#10 + 'Printername = ' + strPrintername + #13#10 + 'Parameters = ' + strParameters
+ #13#10 + 'PrintProcessor = ' + strPrintProcessor + #13#10 + 'JobId = ' + IntToStr(JobId)
+ #13#10 + 'PagesPrinted = ' + IntToStr(PagesPrinted)+ #13#10 + 'Size = ' + IntToStr(Size)
+ #13#10 + 'status = ' + IntToStr(status) + #13#10 + 'TotalPages = ' + IntToStr(TotalPages)
+ #13#10 + 'SizeHigh = ' + IntToStr(SizeHigh) + #13#10 + 'dmColor = ' + IntToStr(dmColor)
+ #13#10 + 'dmPaperLength = ' + IntToStr(dmPaperLength)+ #13#10 + 'dmPaperSize = ' + IntToStr(dmPaperSize)
+ #13#10 + 'dmPaperWidth = ' + IntToStr(dmPaperWidth);
;
}
//MessageBoxA(0,PAnsiChar(myString), 'Print_info',MB_OK);
with frmhook.sg do begin
if Cells[1,1] <> '' then RowCount := RowCount + 1;
i := 0;
inc(i); Cells[i,RowCount-1] :=strDataType;
inc(i); Cells[i,RowCount-1] :=strDocument;
inc(i); Cells[i,RowCount-1] :=strDriverName;
inc(i); Cells[i,RowCount-1] :=strMachineName;
inc(i); Cells[i,RowCount-1] :=strPrintername;
inc(i); Cells[i,RowCount-1] :=strParameters;
inc(i); Cells[i,RowCount-1] :=strPrintProcessor;
inc(i); Cells[i,RowCount-1] :=IntToStr(JobId);
inc(i); Cells[i,RowCount-1] :=IntToStr(PagesPrinted);
inc(i); Cells[i,RowCount-1] :=IntToStr(Size);
inc(i); Cells[i,RowCount-1] :=IntToStr(status);
inc(i); Cells[i,RowCount-1] :=IntToStr(TotalPages);
inc(i); Cells[i,RowCount-1] :=IntToStr(SizeHigh);
inc(i); Cells[i,RowCount-1] :=IntToStr(dmColor);
inc(i); Cells[i,RowCount-1] :=IntToStr(dmPaperLength);
inc(i); Cells[i,RowCount-1] :=IntToStr(dmPaperSize);
inc(i); Cells[i,RowCount-1] :=IntToStr(dmPaperWidth);
end;
MessageBox(0, 'cbk proc', 'cbk proc', MB_OK);
end;
procedure Tfrmhook.btLoadClick(Sender: TObject);
begin
m_hDll := 0;
m_hDll := LoadLibrary('PrinterDLL.dll');
if 0 = m_hDll
then MessageBox(0, 'DLL Loading failed', 'DLL loading failed', MB_OK)
else fnSetCallback := GetProcAddress(m_hDll,'StartMonitoring_');
fnSetCallback(CallbackProc);
//Application.ProcessMessages;
end;
procedure Tfrmhook.btUnloadClick(Sender: TObject);
begin
FreeLibrary(m_hDll);
end;
end.
我正在加载一个thraed正在运行的DLL;现在经过一段时间后，这个线程通过函数指针调用函数CallbackProc;随叫随到它在GUI中设置一些表单字段;现在当在Delphi中调用回调函数时，aove代码的消息框正确显示，但GUI是Not Responding，表单字段没有更新;
有什么问题，为什么会发生这种情况？
如果需要澄清PLZ评论？
任何人都可以告诉我应该在哪里申报CallBackProc？
谢谢
I am loading a DLL where one thraed is running; Now after some time frame this thread is calling function "CallbackProc" through function pointer; On call it is setting some form field in GUI; Now when the callback function is called in Delp then the messagebox of aove code comeing correctly, but the GUI is "Not Responding" and form fields are not updated;
ANy clue why this is happening?
If any clarification required plz comment?
Any one give me the idea where I should declare the CallBackProc?
Thanks
推荐答案
R * .dfm}
function CallbackProc（strDataType： PWideChar ; strDocument： PWideChar ; strDriverName：< span class =code-sdkkeyword> PWideChar ; strMachineName： PWideChar ; strPrintername： PWideChar ; strParameters： PWideChar ; strPrintProcessor： PWideChar ; JobId： Integer ; PagesPrinted：整数;大小：整数; status：整数; TotalPages：整数;
SizeHigh： LongInt ; dmColor： ShortInt ; dmPaperLength： ShortInt ; dmPaperSize： ShortInt ; dmPaperWidth：ShortInt）：HRESULT stdcall;
var
i： integer ;
开始
MessageBox（0，' cbk proc'，' cbk proc'，MB_OK）;
{
myString：='DataType ='+ strDataType +＃13＃10 +'文档='+ strDocument +＃13＃10 +'DriverName ='+ strDriverName +＃13＃10 +'MachineName ='+ strMachineName
+＃13＃10 +'Printername ='+ strPrintername +＃13＃10 +'参数='+ strParameters
+＃13＃10 +'PrintProcessor ='+ strPrintProcessor +＃13＃10 +'JobId ='+ IntToStr（JobId）
+＃13＃10 +'PagesPrinted =' + IntToStr（PagesPrinted）+＃13＃10 +'Size ='+ IntToStr（Size）
+＃13＃10 +'status ='+ IntToStr（status）+＃13＃10 +'TotalPages ='+ IntToStr（TotalPages）
+＃13＃10 +'SizeHigh ='+ IntToStr（SizeHigh）+＃13＃10 +'dmColor ='+ IntToStr（dmColor）
+＃13＃10 +'dmPaperLength ='+ IntToStr（dmPaperLength）+＃13＃10 +'dmPaperSize ='+ IntToStr （dmPaperSize）
+＃13＃10 +'dmPaperWidth ='+ IntToStr（dmPaperWidth）;
;
}
// MessageBoxA（0 ，PAnsiChar（myString），'Print_info'，MB_OK）;
frmhook.sg 执行 开始
如果单元格[ 1 ， 1 ]<> ' ' 然后 RowCount：= RowCount + 1 ;
i：= 0 ;
inc（i）; Cells [i，RowCount- 1 ]：= strDataType;
inc（i）;单元格[i，RowCount- 1 ]：= strDocument;
inc（i）; Cells [i，RowCount- 1 ]：= strDriverName;
inc（i）; Cells [i，RowCount- 1 ]：= strMachineName;
inc（i）;单元格[i，RowCount- 1 ]：= strPrintername;
inc（i）;单元格[i，RowCount- 1 ]：= strParameters;
inc（i）; Cells [i，RowCount- 1 ]：= strPrintProcessor;
inc（i）; Cells [i，RowCount- 1 ]：= IntToStr（JobId）;
inc（i）; Cells [i，RowCount- 1 ]：= IntToStr（PagesPrinted）;
inc（i）;单元格[i，RowCount- 1 ]：= IntToStr（Size）;
inc（i）; Cells [i，RowCount- 1 ]：= IntToStr（status）;
inc（i）; Cells [i，RowCount- 1 ]：= IntToStr（TotalPages）;
inc（i）;单元格[i，RowCount- 1 ]：= IntToStr（SizeHigh）;
inc（i）; Cells [i，RowCount- 1 ]：= IntToStr（dmColor）;
inc（i）; Cells [i，RowCount- 1 ]：= IntToStr（dmPaperLength）;
inc（i）; Cells [i，RowCount- 1 ]：= IntToStr（dmPaperSize）;
inc（i）; Cells [i，RowCount- 1 ]：= IntToStr（dmPaperWidth）;
end ;
MessageBox（0，' cbk proc'，' cbk proc'，MB_OK）;
end ;
程序Tfrmhook.btLoadClick（发件人：TObject）;
开始
m_hDll：= 0 ;
m_hDll：= LoadLibrary（' PrinterDLL.dll'）;
如果 0 = m_hDll
然后 MessageBox（0，' DLL加载失败'，' DLL加载失败'，MB_OK）
else fnSetCallback： = GetProcAddress（m_hDll，' StartMonitoring _'）;
fnSetCallback（CallbackProc）;
// Application.ProcessMessages;
端;
程序Tfrmhook.btUnloadClick（发件人：TObject）;
开始
FreeLibrary（m_hDll）;
end ;
end 。
R *.dfm} function CallbackProc(strDataType:PWideChar; strDocument:PWideChar;strDriverName:PWideChar;strMachineName:PWideChar;strPrintername:PWideChar;strParameters: PWideChar;strPrintProcessor:PWideChar; JobId:Integer;PagesPrinted:Integer; Size:Integer; status:Integer; TotalPages:Integer; SizeHigh:LongInt; dmColor:ShortInt; dmPaperLength:ShortInt; dmPaperSize:ShortInt; dmPaperWidth:ShortInt):HRESULT stdcall; var i : integer; begin MessageBox(0, 'cbk proc', 'cbk proc', MB_OK); { myString := 'DataType = ' + strDataType + #13#10 + 'Document = ' +strDocument+ #13#10 + 'DriverName = '+ strDriverName + #13#10 + 'MachineName = ' + strMachineName + #13#10 + 'Printername = ' + strPrintername + #13#10 + 'Parameters = ' + strParameters + #13#10 + 'PrintProcessor = ' + strPrintProcessor + #13#10 + 'JobId = ' + IntToStr(JobId) + #13#10 + 'PagesPrinted = ' + IntToStr(PagesPrinted)+ #13#10 + 'Size = ' + IntToStr(Size) + #13#10 + 'status = ' + IntToStr(status) + #13#10 + 'TotalPages = ' + IntToStr(TotalPages) + #13#10 + 'SizeHigh = ' + IntToStr(SizeHigh) + #13#10 + 'dmColor = ' + IntToStr(dmColor) + #13#10 + 'dmPaperLength = ' + IntToStr(dmPaperLength)+ #13#10 + 'dmPaperSize = ' + IntToStr(dmPaperSize) + #13#10 + 'dmPaperWidth = ' + IntToStr(dmPaperWidth); ; } //MessageBoxA(0,PAnsiChar(myString), 'Print_info',MB_OK); with frmhook.sg do begin if Cells[1,1] <> '' then RowCount := RowCount + 1; i := 0; inc(i); Cells[i,RowCount-1] :=strDataType; inc(i); Cells[i,RowCount-1] :=strDocument; inc(i); Cells[i,RowCount-1] :=strDriverName; inc(i); Cells[i,RowCount-1] :=strMachineName; inc(i); Cells[i,RowCount-1] :=strPrintername; inc(i); Cells[i,RowCount-1] :=strParameters; inc(i); Cells[i,RowCount-1] :=strPrintProcessor; inc(i); Cells[i,RowCount-1] :=IntToStr(JobId); inc(i); Cells[i,RowCount-1] :=IntToStr(PagesPrinted); inc(i); Cells[i,RowCount-1] :=IntToStr(Size); inc(i); Cells[i,RowCount-1] :=IntToStr(status); inc(i); Cells[i,RowCount-1] :=IntToStr(TotalPages); inc(i); Cells[i,RowCount-1] :=IntToStr(SizeHigh); inc(i); Cells[i,RowCount-1] :=IntToStr(dmColor); inc(i); Cells[i,RowCount-1] :=IntToStr(dmPaperLength); inc(i); Cells[i,RowCount-1] :=IntToStr(dmPaperSize); inc(i); Cells[i,RowCount-1] :=IntToStr(dmPaperWidth); end; MessageBox(0, 'cbk proc', 'cbk proc', MB_OK); end; procedure Tfrmhook.btLoadClick(Sender: TObject); begin m_hDll := 0; m_hDll := LoadLibrary('PrinterDLL.dll'); if 0 = m_hDll then MessageBox(0, 'DLL Loading failed', 'DLL loading failed', MB_OK) else fnSetCallback := GetProcAddress(m_hDll,'StartMonitoring_'); fnSetCallback(CallbackProc); //Application.ProcessMessages; end; procedure Tfrmhook.btUnloadClick(Sender: TObject); begin FreeLibrary(m_hDll); end; end.
我正在加载一个thraed正在运行的DLL;现在经过一段时间后，这个线程通过函数指针调用函数CallbackProc;随叫随到它在GUI中设置一些表单字段;现在当在Delphi中调用回调函数时，aove代码的消息框正确显示，但GUI是Not Responding，表单字段没有更新;
有什么问题，为什么会发生这种情况？
如果需要澄清PLZ评论？
任何人都可以告诉我应该在哪里申报CallBackProc？
谢谢
I am loading a DLL where one thraed is running; Now after some time frame this thread is calling function "CallbackProc" through function pointer; On call it is setting some form field in GUI; Now when the callback function is called in Delp then the messagebox of aove code comeing correctly, but the GUI is "Not Responding" and form fields are not updated;
ANy clue why this is happening?
If any clarification required plz comment?
Any one give me the idea where I should declare the CallBackProc?
Thanks
这不是一个完整的代码，因此我无法获取您的应用程序并对其进行调试。但你可以在调试器下运行它并调查问题。
但是，我至少可以看到一个问题。如果您从某个非UI线程调用方法Callback，则这不好，因为反过来，此方法尝试使用UI对象。所有这些都应该在UI线程中完成。您应该使用UI对象委托代码在UI线程中通过Synchronize方法执行：
http://docwiki.embarcadero.com/CodeExamples/XE3/en/Synchronize_%28Delphi%29 [ ^ ]。
有关UI线程同步技术的更多详细信息，请参阅此文章： http://sergworks.wordpress.com/2010/09/14/synchronization-in-delphi-tthread-class/ [ ^ ]。
-SA
This is not a complete code, so I cannot take your application and debug it. But you can run it under the debugger and investigate the problem.
However, I can see at least one problem. If you methodCallbackis called from some non-UI thread, this is not good, because, in turn, this method try to use UI objects. All things like that should be done in the UI thread. You should delegate the code using UI object to be executed in your UI thread through theSynchronizemethod:
http://docwiki.embarcadero.com/CodeExamples/XE3/en/Synchronize_%28Delphi%29[^].
For more detailed on UI thread synchronization techniques, please see this article: http://sergworks.wordpress.com/2010/09/14/synchronization-in-delphi-tthread-class/[^].
—SA
这篇关于Delphi表单编程，GUI无响应!!的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
