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
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
|
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
{ }
{ System independent GRAPHICAL clone of MSGBOX.PAS }
{ }
{ Interface Copyright (c) 1992 Borland International }
{ }
{ Copyright (c) 1996, 1997, 1998, 1999 by Leon de Boer }
{ ldeboer@attglobal.net - primary e-mail addr }
{ ldeboer@starwon.com.au - backup e-mail addr }
{ }
{****************[ THIS CODE IS FREEWARE ]*****************}
{ }
{ This sourcecode is released for the purpose to }
{ promote the pascal language on all platforms. You may }
{ redistribute it and/or modify with the following }
{ DISCLAIMER. }
{ }
{ This SOURCE CODE is distributed "AS IS" WITHOUT }
{ WARRANTIES AS TO PERFORMANCE OF MERCHANTABILITY OR }
{ ANY OTHER WARRANTIES WHETHER EXPRESSED OR IMPLIED. }
{ }
{*****************[ SUPPORTED PLATFORMS ]******************}
{ 16 and 32 Bit compilers }
{ DOS - Turbo Pascal 7.0 + (16 Bit) }
{ DPMI - Turbo Pascal 7.0 + (16 Bit) }
{ - FPC 0.9912+ (GO32V2) (32 Bit) }
{ WINDOWS - Turbo Pascal 7.0 + (16 Bit) }
{ - Delphi 1.0+ (16 Bit) }
{ WIN95/NT - Delphi 2.0+ (32 Bit) }
{ - Virtual Pascal 2.0+ (32 Bit) }
{ - Speedsoft Sybil 2.0+ (32 Bit) }
{ OS2 - Virtual Pascal 1.0+ (32 Bit) }
{ - Speedsoft Sybil 2.0+ (32 Bit) }
{ }
{******************[ REVISION HISTORY ]********************}
{ Version Date Fix }
{ ------- --------- --------------------------------- }
{ 1.00 12 Jun 96 Initial DOS/DPMI code released. }
{ 1.10 18 Oct 97 Code converted to GUI & TEXT mode. }
{ 1.20 18 Jul 97 Windows conversion added. }
{ 1.30 29 Aug 97 Platform.inc sort added. }
{ 1.40 22 Oct 97 Delphi3 32 bit code added. }
{ 1.50 05 May 98 Virtual pascal 2.0 code added. }
{ 1.60 30 Sep 99 Complete recheck preformed }
{**********************************************************}
UNIT MsgBox;
{2.0 compatibility}
{$ifdef VER2_0}
{$macro on}
{$define resourcestring := const}
{$endif}
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
INTERFACE
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{====Include file to sort compiler platform out =====================}
{$I Platform.inc}
{====================================================================}
{==== Compiler directives ===========================================}
{$IFNDEF PPC_FPC}{ FPC doesn't support these switches }
{$F-} { Near calls are okay }
{$A+} { Word Align Data }
{$B-} { Allow short circuit boolean evaluations }
{$O+} { This unit may be overlaid }
{$G+} { 286 Code optimization - if you're on an 8088 get a real computer }
{$P-} { Normal string variables }
{$N-} { No 80x87 code generation }
{$E+} { Emulation is on }
{$ENDIF}
{$X+} { Extended syntax is ok }
{$R-} { Disable range checking }
{$S-} { Disable Stack Checking }
{$I-} { Disable IO Checking }
{$Q-} { Disable Overflow Checking }
{$V-} { Turn off strict VAR strings }
{====================================================================}
USES objects, dialogs; { Standard GFV units }
{***************************************************************************}
{ PUBLIC CONSTANTS }
{***************************************************************************}
{---------------------------------------------------------------------------}
{ MESSAGE BOX CLASSES }
{---------------------------------------------------------------------------}
CONST
mfWarning = $0000; { Display a Warning box }
mfError = $0001; { Dispaly a Error box }
mfInformation = $0002; { Display an Information Box }
mfConfirmation = $0003; { Display a Confirmation Box }
mfInsertInApp = $0080; { Insert message box into }
{ app instead of the Desktop }
{---------------------------------------------------------------------------}
{ MESSAGE BOX BUTTON FLAGS }
{---------------------------------------------------------------------------}
CONST
mfYesButton = $0100; { Yes button into the dialog }
mfNoButton = $0200; { No button into the dialog }
mfOKButton = $0400; { OK button into the dialog }
mfCancelButton = $0800; { Cancel button into the dialog }
mfYesNoCancel = mfYesButton + mfNoButton + mfCancelButton;
{ Yes, No, Cancel dialog }
mfOKCancel = mfOKButton + mfCancelButton;
{ Standard OK, Cancel dialog }
var
MsgBoxTitles: array[0..3] of string[40];
{***************************************************************************}
{ INTERFACE ROUTINES }
{***************************************************************************}
procedure InitMsgBox;
procedure DoneMsgBox;
{ Init initializes the message box display system's text strings. Init is
called by TApplication.Init after a successful call to Resource.Init or
Resource.Load. }
{-MessageBox---------------------------------------------------------
MessageBox displays the given string in a standard sized dialog box.
Before the dialog is displayed the Msg and Params are passed to FormatStr.
The resulting string is displayed as a TStaticText view in the dialog.
30Sep99 LdB
---------------------------------------------------------------------}
FUNCTION MessageBox (Const Msg: String; Params: Pointer;
AOptions: Word): Word;
{-MessageBoxRect-----------------------------------------------------
MessageBoxRec allows the specification of a TRect for the message box
to occupy.
30Sep99 LdB
---------------------------------------------------------------------}
FUNCTION MessageBoxRect (Var R: TRect; Const Msg: String; Params: Pointer;
AOptions: Word): Word;
{-MessageBoxRectDlg--------------------------------------------------
MessageBoxRecDlg allows the specification of a TRect for the message box
to occupy plus the dialog window (to allow different dialog window types).
---------------------------------------------------------------------}
FUNCTION MessageBoxRectDlg (Dlg: PDialog; Var R: TRect; Const Msg: String;
Params: Pointer; AOptions: Word): Word;
{-InputBox-----------------------------------------------------------
InputBox displays a simple dialog that allows user to type in a string
30Sep99 LdB
---------------------------------------------------------------------}
FUNCTION InputBox (Const Title, ALabel: String; Var S: String;
Limit: Byte): Word;
{-InputBoxRect-------------------------------------------------------
InputBoxRect is like InputBox but allows the specification of a rectangle.
30Sep99 LdB
---------------------------------------------------------------------}
FUNCTION InputBoxRect (Var Bounds: TRect; Const Title, ALabel: String;
Var S: String; Limit: Byte): Word;
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
USES Drivers, Views, App{, Resource}; { Standard GFV units }
{***************************************************************************}
{ INTERFACE ROUTINES }
{***************************************************************************}
const
Commands: array[0..3] of word =
(cmYes, cmNo, cmOK, cmCancel);
var
ButtonName: array[0..3] of string[40];
resourcestring sConfirm='Confirm';
sError='Error';
sInformation='Information';
sWarning='Warning';
{---------------------------------------------------------------------------}
{ MessageBox -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
FUNCTION MessageBox(Const Msg: String; Params: Pointer; AOptions: Word): Word;
VAR R: TRect;
BEGIN
R.Assign(0, 0, 40, 9); { Assign area }
If (AOptions AND mfInsertInApp = 0) Then { Non app insert }
R.Move((Desktop^.Size.X - R.B.X) DIV 2,
(Desktop^.Size.Y - R.B.Y) DIV 2) Else { Calculate position }
R.Move((Application^.Size.X - R.B.X) DIV 2,
(Application^.Size.Y - R.B.Y) DIV 2); { Calculate position }
MessageBox := MessageBoxRect(R, Msg, Params,
AOptions); { Create message box }
END;
FUNCTION MessageBoxRectDlg (Dlg: PDialog; Var R: TRect; Const Msg: String;
Params: Pointer; AOptions: Word): Word;
VAR I, X, ButtonCount: Integer; S: String; Control: PView;
ButtonList: Array[0..4] Of PView;
BEGIN
With Dlg^ Do Begin
FormatStr(S, Msg, Params^); { Format the message }
Control := New(PStaticText, Init(R, S)); { Create static text }
Insert(Control); { Insert the text }
X := -2; { Set initial value }
ButtonCount := 0; { Clear button count }
For I := 0 To 3 Do
If (AOptions AND ($0100 SHL I) <> 0) Then Begin
R.Assign(0, 0, 10, 2); { Assign screen area }
Control := New(PButton, Init(R, ButtonName[I],
Commands[i], bfNormal)); { Create button }
Inc(X, Control^.Size.X + 2); { Adjust position }
ButtonList[ButtonCount] := Control; { Add to button list }
Inc(ButtonCount); { Inc button count }
End;
X := (Size.X - X) SHR 1; { Calc x position }
If (ButtonCount > 0) Then
For I := 0 To ButtonCount - 1 Do Begin { For each button }
Control := ButtonList[I]; { Transfer button }
Insert(Control); { Insert button }
Control^.MoveTo(X, Size.Y - 3); { Position button }
Inc(X, Control^.Size.X + 2); { Adjust position }
End;
SelectNext(False); { Select first button }
End;
If (AOptions AND mfInsertInApp = 0) Then
MessageBoxRectDlg := DeskTop^.ExecView(Dlg) Else { Execute dialog }
MessageBoxRectDlg := Application^.ExecView(Dlg); { Execute dialog }
end;
{---------------------------------------------------------------------------}
{ MessageBoxRect -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
FUNCTION MessageBoxRect(Var R: TRect; Const Msg: String; Params: Pointer;
AOptions: Word): Word;
var
Dialog: PDialog;
BEGIN
Dialog := New (PDialog, Init (R, MsgBoxTitles [AOptions
AND $3])); { Create dialog }
with Dialog^ do
R.Assign(3, 2, Size.X - 2, Size.Y - 3); { Assign area for text }
MessageBoxRect := MessageBoxRectDlg (Dialog, R, Msg, Params, AOptions);
Dispose (Dialog, Done); { Dispose of dialog }
END;
{---------------------------------------------------------------------------}
{ InputBox -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
FUNCTION InputBox(Const Title, ALabel: String; Var S: String;
Limit: Byte): Word;
VAR R: TRect;
BEGIN
R.Assign(0, 0, 60, 8); { Assign screen area }
R.Move((Desktop^.Size.X - R.B.X) DIV 2,
(Desktop^.Size.Y - R.B.Y) DIV 2); { Position area }
InputBox := InputBoxRect(R, Title, ALabel, S,
Limit); { Create input box }
END;
{---------------------------------------------------------------------------}
{ InputBoxRect -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 30Sep99 LdB }
{---------------------------------------------------------------------------}
FUNCTION InputBoxRect(Var Bounds: TRect; Const Title, ALabel: String;
Var S: String; Limit: Byte): Word;
VAR C: Word; R: TRect; Control: PView; Dialog: PDialog;
BEGIN
Dialog := New(PDialog, Init(Bounds, Title)); { Create dialog }
With Dialog^ Do Begin
R.Assign(4 + CStrLen(ALabel), 2, Size.X - 3, 3); { Assign screen area }
Control := New(PInputLine, Init(R, Limit)); { Create input line }
Insert(Control); { Insert input line }
R.Assign(2, 2, 3 + CStrLen(ALabel), 3); { Assign screen area }
Insert(New(PLabel, Init(R, ALabel, Control))); { Insert label }
R.Assign(Size.X - 24, Size.Y - 4, Size.X - 14,
Size.Y - 2); { Assign screen area }
Insert(New(PButton, Init(R, 'O~K~', cmOk,
bfDefault))); { Insert okay button }
Inc(R.A.X, 12); { New start x position }
Inc(R.B.X, 12); { New end x position }
Insert(New(PButton, Init(R, 'Cancel', cmCancel,
bfNormal))); { Insert cancel button }
Inc(R.A.X, 12); { New start x position }
Inc(R.B.X, 12); { New end x position }
SelectNext(False); { Select first button }
End;
Dialog^.SetData(S); { Set data in dialog }
C := DeskTop^.ExecView(Dialog); { Execute the dialog }
If (C <> cmCancel) Then Dialog^.GetData(S); { Get data from dialog }
Dispose(Dialog, Done); { Dispose of dialog }
InputBoxRect := C; { Return execute result }
END;
procedure InitMsgBox;
begin
ButtonName[0] := slYes;
ButtonName[1] := slNo;
ButtonName[2] := slOk;
ButtonName[3] := slCancel;
MsgBoxTitles[0] := sWarning;
MsgBoxTitles[1] := sError;
MsgBoxTitles[2] := sInformation;
MsgBoxTitles[3] := sConfirm;
end;
procedure DoneMsgBox;
begin
end;
END.
|
