142 lines
5.3 KiB
ObjectPascal
142 lines
5.3 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is JclOtExceptionForm.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Florent Ouchet }
|
|
{ [outchy att users dott sourceforge dott net] }
|
|
{ Portions created by Florent Ouchet are Copyright (C) of Florent Ouchet. }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Unit owner: Florent Ouchet }
|
|
{ Last modified: $Date: 2005/12/16 23:46:25 $ }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
unit JclOtaExceptionForm;
|
|
|
|
interface
|
|
|
|
{$I jcl.inc}
|
|
{$I crossplatform.inc}
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
|
|
Dialogs, StdCtrls,
|
|
JclOtaUtils;
|
|
|
|
type
|
|
TJclExpertExceptionForm = class(TForm)
|
|
MemoDetails: TMemo;
|
|
LabelURL: TLabel;
|
|
MemoCallStack: TMemo;
|
|
ButtonClose: TButton;
|
|
procedure LabelURLClick(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
protected
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
public
|
|
procedure ShowException(AExceptionObj: TObject);
|
|
function Execute: Boolean;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
uses
|
|
TypInfo, ShellApi,
|
|
{$IFDEF MSWINDOWS}
|
|
JclDebug,
|
|
{$ENDIF MSWINDOWS}
|
|
JclOtaResources;
|
|
|
|
procedure TJclExpertExceptionForm.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
|
|
// Fixing the Window Ghosting "bug"
|
|
Params.Style := params.Style or WS_POPUP;
|
|
if Assigned(Screen.ActiveForm) then
|
|
Params.WndParent := Screen.ActiveForm.Handle
|
|
else if Assigned (Application.MainForm) then
|
|
Params.WndParent := Application.MainForm.Handle
|
|
else
|
|
Params.WndParent := Application.Handle;
|
|
end;
|
|
|
|
function TJclExpertExceptionForm.Execute: Boolean;
|
|
begin
|
|
Result := ShowModal = mrOk;
|
|
end;
|
|
|
|
procedure TJclExpertExceptionForm.FormCreate(Sender: TObject);
|
|
begin
|
|
Caption := RsReportFormCaption;
|
|
MemoDetails.Lines.Text := RsExceptionDetails;
|
|
LabelURL.Caption := RsReportCaption;
|
|
ButtonClose.Caption := RsReportClose;
|
|
end;
|
|
|
|
procedure TJclExpertExceptionForm.LabelURLClick(Sender: TObject);
|
|
begin
|
|
ShellExecute(Handle, 'open', PChar(RsReportURL), '', '', SW_SHOW); // do not localize
|
|
end;
|
|
|
|
procedure TJclExpertExceptionForm.ShowException(AExceptionObj: TObject);
|
|
var
|
|
AStackInfoList: TJclStackInfoList;
|
|
begin
|
|
MemoCallStack.Lines.Clear;
|
|
|
|
try
|
|
if Assigned(AExceptionObj) then
|
|
MemoCallStack.Lines.Add(RsDetailsExceptionName + AExceptionObj.ClassName);
|
|
|
|
if AExceptionObj is Exception then
|
|
begin
|
|
MemoCallStack.Lines.Add(RsDetailsExceptionMessage + Exception(AExceptionObj).Message);
|
|
{$IFDEF MSWINDOWS}
|
|
if (AExceptionObj is EJclExpertException) then
|
|
with EJclExpertException(AExceptionObj) do
|
|
if Assigned(StackInfo) then
|
|
begin
|
|
StackInfo.AddToStrings(MemoCallStack.Lines, True, True, True, True);
|
|
Exit;
|
|
end;
|
|
{$ENDIF MSWINDOWS}
|
|
end;
|
|
|
|
{$IFDEF MSWINDOWS}
|
|
AStackInfoList := JclCreateStackList(False, 0, nil);
|
|
try
|
|
AStackInfoList.AddToStrings(MemoCallStack.Lines, True, True, True, True);
|
|
finally
|
|
AStackInfoList.Free;
|
|
end;
|
|
{$ENDIF MSWINDOWS}
|
|
except
|
|
MemoCallStack.Lines.Add(RsErrorWhileFormatting);
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|
|
// History:
|
|
|
|
// $Log: JclOtaExceptionForm.pas,v $
|
|
// Revision 1.1 2005/12/16 23:46:25 outchy
|
|
// Added expert stack form.
|
|
// Added code to display call stack on expert exception.
|
|
// Fixed package extension for D2006.
|
|
// |