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
|
{********[ SOURCE FILE OF GRAPHICAL FREE VISION ]**********}
{ }
{ System independent GRAPHICAL clone of GADGETS.PAS }
{ }
{ Interface Copyright (c) 1992 Borland International }
{ }
{ Copyright (c) 1999 by Leon de Boer }
{ ldeboer@attglobal.net - primary e-mail address }
{ ldeboer@starwon.com.au - backup e-mail address }
{ }
{****************[ 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) }
{ - FPC 0.9912+ (32 Bit) }
{ OS2 - Virtual Pascal 1.0+ (32 Bit) }
{ }
{*******************[ DOCUMENTATION ]**********************}
{ }
{ This unit had to be for GFV due to some problems with }
{ the original Borland International implementation. }
{ }
{ First it used the DOS unit for it's time calls in the }
{ TClockView object. Since this unit can not be compiled }
{ under WIN/NT/OS2 we use a new unit TIME.PAS which was }
{ created and works under these O/S. }
{ }
{ Second the HeapView object accessed MemAvail from in }
{ the Draw call. As GFV uses heap memory during the Draw }
{ call the OldMem value always met the test condition in }
{ the update procedure. The consequence was the view }
{ would continually redraw. By moving the memavail call }
{ the update procedure this eliminates this problem. }
{ }
{ Finally the original object relied on the font char }
{ blocks being square to erase it's entire view area as }
{ it used a simple writeline call in the Draw method. }
{ Under GFV font blocks are not necessarily square and }
{ so both objects had their Draw routines rewritten. As }
{ the Draw had to be redone it was done in the GFV split }
{ drawing method to accelerate the graphical speed. }
{ }
{******************[ REVISION HISTORY ]********************}
{ Version Date Fix }
{ ------- --------- --------------------------------- }
{ 1.00 12 Nov 99 First multi platform release }
{**********************************************************}
UNIT Gadgets;
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
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 FVConsts, Time, Objects, Drivers, Views, App; { Standard GFV units }
{***************************************************************************}
{ PUBLIC OBJECT DEFINITIONS }
{***************************************************************************}
{---------------------------------------------------------------------------}
{ THeapView OBJECT - ANCESTOR VIEW OBJECT }
{---------------------------------------------------------------------------}
TYPE
THeapViewMode=(HVNormal,HVComma,HVKb,HVMb);
THeapView = OBJECT (TView)
Mode : THeapViewMode;
OldMem: LongInt; { Last memory count }
constructor Init(var Bounds: TRect);
constructor InitComma(var Bounds: TRect);
constructor InitKb(var Bounds: TRect);
constructor InitMb(var Bounds: TRect);
PROCEDURE Update;
PROCEDURE Draw; Virtual;
Function Comma ( N : LongInt ) : String;
END;
PHeapView = ^THeapView; { Heapview pointer }
{---------------------------------------------------------------------------}
{ TClockView OBJECT - ANCESTOR VIEW OBJECT }
{---------------------------------------------------------------------------}
TYPE
TClockView = OBJECT (TView)
am : Char;
Refresh : Byte; { Refresh rate }
LastTime: Longint; { Last time displayed }
TimeStr : String[10]; { Time string }
CONSTRUCTOR Init (Var Bounds: TRect);
FUNCTION FormatTimeStr (H, M, S: Word): String; Virtual;
PROCEDURE Update; Virtual;
PROCEDURE Draw; Virtual;
END;
PClockView = ^TClockView; { Clockview ptr }
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
IMPLEMENTATION
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
{***************************************************************************}
{ OBJECT METHODS }
{***************************************************************************}
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ THeapView OBJECT METHODS }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
constructor THeapView.Init(var Bounds: TRect);
begin
inherited Init(Bounds);
mode:=HVNormal;
OldMem := 0;
end;
constructor THeapView.InitComma(var Bounds: TRect);
begin
inherited Init(Bounds);
mode:=HVComma;
OldMem := 0;
end;
constructor THeapView.InitKb(var Bounds: TRect);
begin
inherited Init(Bounds);
mode:=HVKb;
OldMem := 0;
end;
constructor THeapView.InitMb(var Bounds: TRect);
begin
inherited Init(Bounds);
mode:=HVMb;
OldMem := 0;
end;
{--THeapView----------------------------------------------------------------}
{ Update -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE THeapView.Update;
var
status : TFPCHeapStatus;
BEGIN
status:=GetFPCHeapStatus;
If (OldMem <> status.CurrHeapUsed) Then Begin { Memory differs }
OldMem := status.CurrHeapUsed; { Hold memory avail }
DrawView; { Now redraw }
End;
END;
{--THeapView----------------------------------------------------------------}
{ Draw -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE THeapView.Draw;
VAR
C : Byte;
S : String;
B : TDrawBuffer;
begin
case mode of
HVNormal :
Str(OldMem:Size.X, S);
HVComma :
S:=Comma(OldMem);
HVKb :
begin
Str(OldMem shr 10:Size.X-1, S);
S:=S+'K';
end;
HVMb :
begin
Str(OldMem shr 20:Size.X-1, S);
S:=S+'M';
end;
end;
C:=GetColor(2);
MoveChar(B,' ',C,Size.X);
MoveStr(B,S,C);
WriteLine(0,0,Size.X,1,B);
END;
Function THeapView.Comma ( n : LongInt) : String;
Var
num, loc : Byte;
s : String;
t : String;
Begin
Str (n,s);
Str (n:Size.X,t);
num := length(s) div 3;
if (length(s) mod 3) = 0 then dec (num);
delete (t,1,num);
loc := length(t)-2;
while num > 0 do
Begin
Insert (',',t,loc);
dec (num);
dec (loc,3);
End;
Comma := t;
End;
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ TClockView OBJECT METHODS }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{--TClockView---------------------------------------------------------------}
{ Init -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB }
{---------------------------------------------------------------------------}
CONSTRUCTOR TClockView.Init (Var Bounds: TRect);
BEGIN
Inherited Init(Bounds); { Call ancestor }
FillChar(LastTime, SizeOf(LastTime), #$FF); { Fill last time }
TimeStr := ''; { Empty time string }
Refresh := 1; { Refresh per second }
END;
{--TClockView---------------------------------------------------------------}
{ FormatStr -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB }
{---------------------------------------------------------------------------}
FUNCTION TClockView.FormatTimeStr (H, M, S: Word): String;
VAR Hs, Ms, Ss: String;
BEGIN
Str(H, Hs); { Convert hour string }
While (Length(Hs) < 2) Do Hs := '0' + Hs; { Add lead zero's }
Str(M, Ms); { Convert min string }
While (Length(Ms) < 2) Do Ms := '0' + Ms; { Add lead zero's }
Str(S, Ss); { Convert sec string }
While (Length(Ss) < 2) Do Ss := '0' + Ss; { Add lead zero's }
FormatTimeStr := Hs + ':'+ Ms + ':' + Ss; { Return string }
END;
{--TClockView---------------------------------------------------------------}
{ Update -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TClockView.Update;
VAR Hour, Min, Sec, Sec100: Word;
BEGIN
GetTime(Hour, Min, Sec, Sec100); { Get current time }
If (Abs(Sec - LastTime) >= Refresh) Then Begin { Refresh time elapsed }
LastTime := Sec; { Hold second }
TimeStr := FormatTimeStr(Hour, Min, Sec); { Create time string }
DrawView; { Now redraw }
End;
END;
{--TClockView---------------------------------------------------------------}
{ DrawBackGround -> Platforms DOS/DPMI/WIN/NT/OS2 - Updated 12Nov99 LdB }
{---------------------------------------------------------------------------}
PROCEDURE TClockView.Draw;
VAR
C : Byte;
B : TDrawBuffer;
BEGIN
C:=GetColor(2);
MoveChar(B,' ',C,Size.X);
MoveStr(B,TimeStr,C);
WriteLine(0,0,Size.X,1,B);
END;
END.
|
