gpt4 book ai didi

Delphi在全局异常中的屏幕截图

转载 作者:行者123 更新时间:2023-12-03 15:52:52 25 4
gpt4 key购买 nike

我正在开发一个组件,使用Delphi 2006,该组件检索系统信息并写入文件。要求是我必须在组件中合并一个全局异常处理程序,这样当异常发生时,它将被捕获,并向用户显示我的自定义消息。

  procedure Tmy.GlobalExceptionHandlerThis(Sender : TObject; E : Exception );
begin
//catch the exception and show the message
TakeScreenShotAndSaveInapplicationFolder;
MessageDlg('Exception has Occured , Detail '+E.Message,mtError,[mbOK],0);
end;

这工作正常,但根据要求我必须捕获错误屏幕截图(这是为了直观地找到弹出异常的表单)

所以我这样做了,并从 delphigeist.com 获取屏幕截图代码:

procedure TakeScreenShotAndSaveInapplicationFolder;
var
thisBitmap: TBitmap;
sDate : string;
begin
DateSeparator :='_';
TimeSeparator:='_';
sDate :=DateTimeToStr(now);
thisBitmap := TBitmap.Create;
ScreenshotArea(thisBitmap, Screen.DesktopRect, True);
thisBitmap.SaveToFile(ExtractFilePath(Application.ExeName)+sDate+'.jpg');
FreeAndNil(thisBitmap);
end;

问题:

当异常发生时,我也想截取消息的屏幕截图,但使用我的代码会发生这种情况

enter image description here

谁能告诉我怎样才能得到这样的屏幕截图?这是沿着表单获取消息

enter image description here

MessageDlg('发生异常,详细信息' + E.Message,mtError,[mbOK],0);是模态的,所以在消息之后我无法拍摄屏幕截图。在我也不能之前,那么什么时候可以在出现异常信息时截屏呢?

procedure Tmy.GlobalExceptionHandlerThis(Sender : TObject; E : Exception );
begin
//catch the exception and show the message
TakeScreenShotAndSaveInapplicationFolder;
MessageDlg('Exception has Occured , Detail '+E.Message,mtError,[mbOK],0);
TakeScreenShotAndSaveInapplicationFolder;
end;

最佳答案

修改this message box (Windows.MessageBox 的包装器),如下所示:

{ TAwMessageBox }

type
TAwMessageBox = class(TObject)
private
FCaption: String;
FFlags: Cardinal;
FHookProc: TFarProc;
FText: String;
FWndHook: HHOOK;
function Execute: Integer;
procedure HookProc(var Message: THookMessage);
end;

function TAwMessageBox.Execute: Integer;
begin
try
try
FHookProc := MakeHookInstance(HookProc);
FWndHook := SetWindowsHookEx(WH_CALLWNDPROCRET, FHookProc, 0,
GetCurrentThreadID);
Result := Application.MessageBox(PChar(FText), PChar(FCaption), FFlags);
finally
if FWndHook <> 0 then
UnhookWindowsHookEx(FWndHook);
if FHookProc <> nil then
FreeHookInstance(FHookProc);
end;
except
Result := 0;
end;
end;

procedure TAwMessageBox.HookProc(var Message: THookMessage);
var
Data: PCWPRetStruct;
Title: array[0..255] of Char;
begin
with Message do
if nCode < 0 then
Result := CallNextHookEx(FWndHook, nCode, wParam, lParam)
else
Result := 0;
if Message.nCode = HC_ACTION then
begin
Data := PCWPRetStruct(Message.lParam);
if (Data.message = WM_ACTIVATE) and (LoWord(Data.wParam) = WA_INACTIVE) then
begin
ZeroMemory(@Title, SizeOf(Title));
GetWindowText(Data.hwnd, @Title, SizeOf(Title));
if String(Title) = FCaption then
begin
TakeScreenShotAndSaveInapplicationFolder;
UnhookWindowsHookEx(FWndHook);
FWndHook := 0;
FreeHookInstance(FHookProc);
FHookProc := nil;
end;
end;
end;
end;

function MsgBox(const Text: String; Flags: Cardinal;
const Caption: String): Integer;
begin
with TAwMessageBox.Create do
try
FCaption := Caption;
FFlags := Flags;
FText := Text;
Result := Execute;
finally
Free;
end;
end;

测试代码和屏幕截图:

procedure TForm1.ApplicationEvents1Exception(Sender: TObject; E: Exception);
begin
MsgBox('Exception has occured. Details:'#13#10#13#10 + E.Message,
MB_OK or MB_ICONERROR, 'Error');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
raise Exception.Create('Test exception');
end;

Screen shot

关于Delphi在全局异常中的屏幕截图,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/10209165/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com