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
173
174
175
176
177
178
179
180
181
|
unit tiDialogs;
{$mode objfpc}{$H+}
{
TODO:
* Port tiProcessing and tiEndProcessing
}
interface
uses
Classes
,SysUtils
,Variants
;
// Call showMessage, but accepts a variant. Good for debugging.
procedure tiShowMessage(const AArray: Array of Const); overload;
procedure tiShowMessage(const AValue: variant); overload;
// Show the contents of a TStringList - for debugging
procedure tiShowStringList(const pStringList: TStringList; const pHeading: string = 'Show string list');
// Show the contents of a TStrings - for debugging
procedure tiShowStrings(const AStrings: TStrings; const pHeading: string = 'Show strings');
// Show a long string - for debugging
procedure tiShowString(const AStr: string; const pHeading: string = 'Show string');
// Show a variant array of variants - for debugging
procedure tiShowVariant(AValue: Variant; pHeading: string = 'Show variant');
// Show the contents of a stream
procedure tiShowStream(const AValue: TStream; const pHeading: string = 'Show stream');
// Show a <Yes>, <No> dialog box, and return true if <Yes> was selected
function tiAppConfirmation(const AMessage: string): boolean; overload;
function tiAppConfirmation(const AMessage: string; const AValues: array of const): boolean; overload;
// Show a message
procedure tiAppMessage(const AMessage: string);
// Show a warning
procedure tiAppWarning(const AMessage: string);
// Show a error message
procedure tiAppError(const AMessage: string);
implementation
uses
fpgfx
,gui_form
,gui_memo
,tiGUIINI
,tiUtils
,gui_dialogs
;
procedure tiShowMessage(const AArray: array of const);
const
BoolChars: array[Boolean] of Char = ('F', 'T');
var
i: Integer;
lsLine: string;
begin
lsLine := '';
for I := 0 to High(AArray) do begin
if lsLine <> '' then
lsLine := lsLine + Cr;
with AArray[i] do
case VType of
vtInteger: lsLine := lsLine + IntToStr(VInteger);
vtBoolean: lsLine := lsLine + BoolChars[VBoolean];
vtChar: lsLine := lsLine + VChar;
vtExtended: lsLine := lsLine + FloatToStr(VExtended^);
vtString: lsLine := lsLine + VString^;
vtPChar: lsLine := lsLine + VPChar;
vtObject: lsLine := lsLine + VObject.ClassName;
vtClass: lsLine := lsLine + VClass.ClassName;
vtAnsiString: lsLine := lsLine + string(VAnsiString);
vtCurrency: lsLine := lsLine + CurrToStr(VCurrency^);
vtVariant: lsLine := lsLine + string(VVariant^);
vtInt64: lsLine := lsLine + IntToStr(VInt64^);
end;
end;
tiShowMessage(lsLine);
end;
procedure tiShowMessage(const AValue: variant);
begin
ShowMessage(VarToStr(AValue));
end;
procedure tiShowStringList(const pStringList: TStringList; const pHeading: string);
begin
tiShowStrings(pStringList, pHeading);
end;
procedure tiShowStrings(const AStrings: TStrings; const pHeading: string);
var
lForm: TfpgForm;
lMemo: TfpgMemo;
begin
lForm := TfpgForm.Create(nil);
lMemo := TfpgMemo.Create(lForm);
try
lForm.WindowTitle := pHeading;
lForm.WindowPosition := wpScreenCenter;
lForm.Name := 'FormShowStrings';
lMemo.Lines.Assign(AStrings);
lMemo.FontDesc := 'Courier New-10';
gGUIINI.ReadFormState(lForm);
lMemo.SetPosition(0, 0, lForm.Width, lForm.Height);
lMemo.Align := alClient;
lForm.ShowModal;
gGUIINI.WriteFormState(lForm);
finally
lForm.free;
end;
end;
procedure tiShowString(const AStr: string; const pHeading: string);
var
lSL: TStringList;
begin
lSL := TStringList.Create;
try
lSL.Text := AStr;
tiShowStringList(lSL, pHeading);
finally
lSL.Free;
end;
end;
procedure tiShowVariant(AValue: Variant; pHeading: string);
var
ls: string;
begin
ls := tiVariantArrayToString(AValue);
tiShowString(ls, pHeading);
end;
procedure tiShowStream(const AValue: TStream; const pHeading: string);
var
lStringStream: TStringStream;
begin
lStringStream := TStringStream.Create('');
try
AValue.Position := 0;
lStringStream.CopyFrom(AValue, AValue.Size);
tiShowString(lStringStream.DataString, pHeading);
finally
lStringStream.Free;
end;
end;
function tiAppConfirmation(const AMessage: string): boolean;
begin
Result := TfpgMessageDialog.Question('', AMessage) = mbYes
end;
function tiAppConfirmation(const AMessage: string;
const AValues: array of const): boolean;
begin
Result := tiAppConfirmation(Format(AMessage, AValues));
end;
procedure tiAppMessage(const AMessage: string);
begin
TfpgMessageDialog.Information('', AMessage);
end;
procedure tiAppWarning(const AMessage: string);
begin
TfpgMessageDialog.Warning('', AMessage);
end;
procedure tiAppError(const AMessage: string);
begin
TfpgMessageDialog.Critical('', AMessage);
end;
end.
|
