EasyConfig/ErrorDialog.pas at master · DeepKit/EasyConfig · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
unit ErrorDialog;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.Buttons, Vcl.Imaging.pngimage, Vcl.Imaging.jpeg, Vcl.Imaging.GIFImg,
  System.UITypes;

type
  TfrmErrorDialog = class(TForm)
    pnlTop: TPanel;
    lblTitle: TLabel;
    imgIcon: TImage;
    pnlBottom: TPanel;
    btnOK: TButton;
    btnDetails: TButton;
    pnlClient: TPanel;
    memMessage: TMemo;
    memDetails: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure btnDetailsClick(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
  private
    FExpanded: Boolean;
    FOriginalHeight: Integer;

    procedure SetExpanded(const Value: Boolean);
    procedure UpdateDetailsButton;
  public
    class procedure ShowError(const Title, Message: string; E: Exception = nil);
    class procedure ShowWarning(const Title, Message: string);
    class procedure ShowInfo(const Title, Message: string);

    property Expanded: Boolean read FExpanded write SetExpanded;
  end;

var
  frmErrorDialog: TfrmErrorDialog;

implementation

{$R *.dfm}

procedure TfrmErrorDialog.btnDetailsClick(Sender: TObject);
begin
  Expanded := not Expanded;
end;

procedure TfrmErrorDialog.btnOKClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmErrorDialog.FormCreate(Sender: TObject);
begin
  FOriginalHeight := Height;
  memDetails.Visible := False;
  FExpanded := False;
  UpdateDetailsButton;
end;

class procedure TfrmErrorDialog.ShowError(const Title, Message: string; E: Exception);
var
  Dialog: TfrmErrorDialog;
  Details: string;
begin
  Dialog := TfrmErrorDialog.Create(Application);
  try
    Dialog.Caption := '错误';
    Dialog.lblTitle.Caption := Title;
    Dialog.memMessage.Text := Message;

    // 设置错误图标
    Dialog.imgIcon.Picture.Bitmap.LoadFromResourceName(HInstance, 'ERROR_ICON');

    // 设置详细信息
    if Assigned(E) then
    begin
      Details := '异常类型: ' + E.ClassName + #13#10 +
                 '异常消息: ' + E.Message + #13#10 +
                 '堆栈跟踪: ' + #13#10;

      // 如果有堆栈跟踪信息，添加到详细信息中
      if E is Exception then
        Details := Details + E.StackTrace;

      Dialog.memDetails.Text := Details;
      Dialog.btnDetails.Visible := True;
    end
    else
      Dialog.btnDetails.Visible := False;

    Dialog.ShowModal;
  finally
    Dialog.Free;
  end;
end;

class procedure TfrmErrorDialog.ShowInfo(const Title, Message: string);
var
  Dialog: TfrmErrorDialog;
begin
  Dialog := TfrmErrorDialog.Create(Application);
  try
    Dialog.Caption := '信息';
    Dialog.lblTitle.Caption := Title;
    Dialog.memMessage.Text := Message;

    // 设置信息图标
    Dialog.imgIcon.Picture.Bitmap.LoadFromResourceName(HInstance, 'INFO_ICON');

    Dialog.btnDetails.Visible := False;
    Dialog.ShowModal;
  finally
    Dialog.Free;
  end;
end;

class procedure TfrmErrorDialog.ShowWarning(const Title, Message: string);
var
  Dialog: TfrmErrorDialog;
begin
  Dialog := TfrmErrorDialog.Create(Application);
  try
    Dialog.Caption := '警告';
    Dialog.lblTitle.Caption := Title;
    Dialog.memMessage.Text := Message;

    // 设置警告图标
    Dialog.imgIcon.Picture.Bitmap.LoadFromResourceName(HInstance, 'WARNING_ICON');

    Dialog.btnDetails.Visible := False;
    Dialog.ShowModal;
  finally
    Dialog.Free;
  end;
end;

procedure TfrmErrorDialog.SetExpanded(const Value: Boolean);
begin
  if FExpanded <> Value then
  begin
    FExpanded := Value;

    if FExpanded then
    begin
      // 展开详细信息
      Height := FOriginalHeight + 200;
      memDetails.Visible := True;
    end
    else
    begin
      // 收起详细信息
      Height := FOriginalHeight;
      memDetails.Visible := False;
    end;

    UpdateDetailsButton;
  end;
end;

procedure TfrmErrorDialog.UpdateDetailsButton;
begin
  if FExpanded then
    btnDetails.Caption := '隐藏详细信息 <<'
  else
    btnDetails.Caption := '显示详细信息 >>';
end;

end.