📄 uafrmerrorhandler.pas
字号:
unit uaFrmErrorHandler;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Buttons, StdCtrls,UAUnits,UADataPacket;
type
TFrmErrorHandler = class(TForm)
P_Title: TPanel;
Splitter1: TSplitter;
P_Detail: TPanel;
sbtn_Ignore: TSpeedButton;
sbtn_Abort: TSpeedButton;
Label1: TLabel;
Label2: TLabel;
sbtn_Before: TSpeedButton;
sbtn_Next: TSpeedButton;
Mm_ErrorDesc: TMemo;
edt_ServerError: TEdit;
edt_UAErrorCode: TEdit;
edt_UAErrorOBj: TEdit;
sbtn_Send: TSpeedButton;
sbtn_Details: TSpeedButton;
Image1: TImage;
lb_Msg: TLabel;
procedure FormActivate(Sender: TObject);
procedure sbtn_DetailsClick(Sender: TObject);
procedure sbtn_AbortClick(Sender: TObject);
procedure sbtn_SendClick(Sender: TObject);
procedure sbtn_IgnoreClick(Sender: TObject);
procedure sbtn_NextClick(Sender: TObject);
procedure sbtn_BeforeClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
OriginalHeight: Integer;
protected
FUAErrors:TList;
FErrorParam:TErrorParam;
FUAErrorProcType:TUAErrorProcType;
procedure ChangeDetail(bVisible:Boolean);
procedure DisplayErrorMsg;
public
{ Public declarations }
procedure InitErrors(UAErrors:TList);
property UAErrorProcType:TUAErrorProcType read FUAErrorProcType;
end;
var
FrmErrorHandler: TFrmErrorHandler;
implementation
{$R *.dfm}
procedure TFrmErrorHandler.ChangeDetail(bVisible: Boolean);
begin
with P_Detail do
begin
Visible := not Visible;
if Visible then
begin
Self.Height := Self.Height + OriginalHeight;
sbtn_Details.Caption := '<< &Details';
end
else
begin
Self.Height := Self.Height - OriginalHeight;
sbtn_Details.Caption := '&Details >>';
end
end;
end;
procedure TFrmErrorHandler.DisplayErrorMsg;
begin
if Assigned(FErrorParam) then
begin
edt_ServerError.Text := '';
edt_UAErrorCode.Text := '';
Mm_ErrorDesc.Lines.Clear;
edt_UAErrorOBj.Text := '';
/// - ----To Display All
edt_UAErrorCode.Text := IntToStr(FErrorParam.ErrorCode);
// Mm_ErrorDesc.Lines.Add(FErrorParam.ErrorMsg);
Mm_ErrorDesc.Lines.Add(FErrorParam.ErrorContext);
edt_ServerError.Text := FErrorParam.ErrorMsg;
edt_UAErrorOBj.Text := IntToStr(FErrorParam.ErrorMask);
end;
end;
procedure TFrmErrorHandler.FormActivate(Sender: TObject);
begin
Caption := 'UA Error';
// Image1.Picture.Icon.Handle := LoadIcon(0,IDI_WINLOGO);
OriginalHeight := Height-(ClientHeight-P_Detail.Top);
ChangeDetail(true);
sbtn_Before.Enabled := false;
end;
procedure TFrmErrorHandler.InitErrors(UAErrors:TList);
begin
FUAErrors := UAErrors;
if FUAErrors.Count <> 0 then
FErrorParam := TErrorParam(FUAErrors.First);
DisplayErrorMsg;
end;
procedure TFrmErrorHandler.sbtn_DetailsClick(Sender: TObject);
begin
ChangeDetail(true);
end;
procedure TFrmErrorHandler.sbtn_AbortClick(Sender: TObject);
begin
FUAErrorProcType := eptAbort;
ModalResult := mrOk;
end;
procedure TFrmErrorHandler.sbtn_SendClick(Sender: TObject);
begin
FUAErrorProcType := eptSend;
ModalResult := mrOk;
end;
procedure TFrmErrorHandler.sbtn_IgnoreClick(Sender: TObject);
begin
FUAErrorProcType := eptIgnore;
ModalResult := mrOk;
end;
procedure TFrmErrorHandler.sbtn_NextClick(Sender: TObject);
var
Idx:integer;
begin
if not Assigned(FErrorParam) then Exit;
Idx := FUAErrors.IndexOf(FErrorParam);
// Position out of range : be sure catch exception message
if FUAErrors.Count > Idx + 1 then
begin
FErrorParam := TErrorParam(FUAErrors.Items[Idx +1]);
sbtn_Before.Enabled := true;
end;
if FUAErrors.IndexOf(FErrorParam) = FUAErrors.Count -1 then
begin
sbtn_Next.Enabled := false;
sbtn_Before.Enabled := true;
end;
DisplayErrorMsg;
end;
procedure TFrmErrorHandler.sbtn_BeforeClick(Sender: TObject);
var
Idx:integer;
begin
if not Assigned(FErrorParam) then Exit;
Idx := FUAErrors.IndexOf(FErrorParam);
// Position out of range : be sure catch exception message
if Idx - 1 > -1 then
begin
FErrorParam := TErrorParam(FUAErrors.Items[Idx -1]);
sbtn_Next.Enabled := true;
end;
if FUAErrors.IndexOf(FErrorParam) = 0 then
begin
sbtn_Next.Enabled := true;
sbtn_Before.Enabled := false;
end;
DisplayErrorMsg;
end;
procedure TFrmErrorHandler.FormCreate(Sender: TObject);
begin
lb_Msg.Caption := '';
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -