Category : Files from Magazines
Archive   : NOV92_1.ZIP
Filename : TVTIME.ASC

 
Output of file : TVTIME.ASC contained in archive : NOV92_1.ZIP
_EXTENDING TURBO VISION_
by Scott Nichol

[LISTING ONE]


{***********************************************************************}
{ BIOSTICK.PAS }
{ }
{ Support for BIOS tick counter. The new BIOS tick event is of class }
{ evMetaBroadcast, command cmBiosTick. The Event.InfoLong field }
{ contains the tick counter value at the time of the event. The }
{ current value can be obtained using the GetBiosTicks function. }
{ Because this event is generated on a cooperative rather than }
{ preemptive basis, there may not be an event generated for every }
{ tick of the counter. Nor should any assumptions be made about the }
{ accuracy of the periodicity of the event: the nominal periodicity }
{ of 55 milliseconds will only be obtained when no other events are }
{ generated and cmBiosTick handling takes under 55 milliseconds. }
{***********************************************************************}

{$R-,S-}

unit
BiosTick;

interface

uses
Drivers;

procedure GetBiosTickEvent(var Event: TEvent);
function GetBiosTicks: LongInt;

implementation

uses
Cmds;

var
BiosTicks: LongInt absolute $40:$6c;

procedure GetBiosTickEvent(var Event: TEvent);
const
OldTicks: LongInt = 0;
begin
if BiosTicks <> OldTicks then begin
OldTicks := BiosTicks;
with Event do begin
What := evMetaBroadcast;
Command := cmBiosTick;
InfoLong := OldTicks;
end;
end else
Event.What := evNothing;
end;

function GetBiosTicks: LongInt;
begin
GetBiosTicks := BiosTicks;
end;

end.

[LISTING TWO]

{***********************************************************************}
{ TICKVIEW.PAS }
{ }
{ Views to be driven by cmBiosTick. The heap and clock views were }
{ inspired by the Gadgets unit provided by Borland in the TVDEMOS }
{ subdirectory of Turbo Pascal 6.0. }
{***********************************************************************}

unit TickView;

{$R-,S-,V-}

interface

uses
Drivers, Objects, Views, App;

type
PTickView = ^TTickView;
TTickView = object(TView)
Display: Boolean;
constructor Init(var Bounds: TRect);
procedure Draw; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
function DoDraw: Boolean; virtual;
procedure DrawInfo(var S: String); virtual;
procedure ToggleDisplay; virtual;
end;

PHeapView = ^THeapView;
THeapView = object(TTickView)
OldMem: LongInt;
constructor Init(var Bounds: TRect);
function DoDraw: Boolean; virtual;
procedure DrawInfo(var S: String); virtual;
end;

PClockView = ^TClockView;
TClockView = object(TTickView)
OldTime: LongInt;
TimeStr: String[8];
constructor Init(var Bounds: TRect);
function DoDraw: Boolean; virtual;
procedure DrawInfo(var S: String); virtual;
end;

implementation

uses
Dos,
BiosTick, Cmds;

{------ TTickView (abstract) ------}

constructor TTickView.Init(var Bounds: TRect);
begin
TView.Init(Bounds);
EventMask := EventMask or evMetaBroadcast;
Display := True;
end;

procedure TTickView.Draw;
var
S: String;
B: TDrawBuffer;
C: Byte;
begin
C := GetColor(2);
MoveChar(B, ' ', C, Size.X);
DrawInfo(S);
if Display then
MoveStr(B, S, C);
WriteLine(0, 0, Size.X, 1, B);
end;

procedure TTickView.HandleEvent(var Event: TEvent);
begin
TView.HandleEvent(Event);
if Event.What = evMetaBroadcast then
case Event.Command of
cmBiosTick:
if DoDraw then DrawView;
end;
end;

function TTickView.DoDraw: Boolean;
begin
Abstract;
end;

procedure TTickView.DrawInfo(var S: String);
begin
Abstract;
end;

procedure TTickView.ToggleDisplay;
begin
Display := not Display;
DrawView;
end;

{----------- THeapView ------------}

constructor THeapView.Init(var Bounds: TRect);
begin
TTickView.Init(Bounds);
OldMem := 0;
end;

function THeapView.DoDraw: Boolean;
begin
DoDraw := OldMem <> MemAvail;
end;

procedure THeapView.DrawInfo(var S: String);
begin
OldMem := MemAvail;
Str(OldMem: Size.X, S);
end;

{---------- TClockView ------------}

constructor TClockView.Init(var Bounds: TRect);
begin
TTickView.Init(Bounds);
OldTime := 0;
end;

function TClockView.DoDraw: Boolean;
begin
DoDraw := (GetBiosTicks - OldTime) >= 18;
end;

procedure TClockView.DrawInfo(var S: String);
var
Hour, Minute, Second, Sec100: Word;
Param: record
Hr, Min, Sec: LongInt;
end;
begin
OldTime := GetBiosTicks;
GetTime(Hour, Minute, Second, Sec100);
with Param do begin
Hr := Hour;
Min := Minute;
Sec := Second;
end;
FormatStr(S, '%02d:%02d:%02d', Param);
end;

end.





[EXTRA LISTING #1]

{***********************************************************************}
{ TVTIME.PAS }
{ }
{ A short program to demonstrate the addition of a new TV event class }
{ that can be broadcast outside of the event chain focus. It uses a }
{ specific command based on the BIOS timer tick counter. }
{ }
{ Copyright (c) 1992 Charles Scott Nichol. All rights reserved. }
{***********************************************************************}

{$R-,S-,X+}

program
TVTime;

uses
App, Dialogs, Drivers, Menus, MsgBox, Objects, Views,
BiosTick, Cmds, TickView;

type
TTimeApp = object(TApplication)
MetaSupport: Boolean;
Clock: PClockView;
Heap: PHeapView;
constructor Init;
procedure GetEvent(var Event: TEvent); virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure InitDeskTop; virtual;
procedure InitMenuBar; virtual;
procedure InitStatusLine; virtual;
procedure OutOfMemory; virtual;
end;

const
cmAbout = 100;
cmToggleClock = 101;
cmToggleHeap = 102;
cmToggleMeta = 103;

{----------- TTimeApp ------------}

constructor TTimeApp.Init;
var
R: TRect;
begin
TApplication.Init;

MetaSupport := True;

GetExtent(R);
R.A.X := R.B.X - 8; R.B.Y := R.A.Y + 1; {End of top line}
Clock := New(PClockView, Init(R));
if ValidView(Clock) = nil then
Fail;
Insert(Clock);

GetExtent(R);
R.A.X := R.B.X - 8; R.A.Y := R.B.Y - 1; {End of bottom line}
Heap := New(PHeapView, Init(R));
if ValidView(Heap) = nil then begin
Dispose(Clock);
Fail;
end;
Insert(Heap);
end;

procedure TTimeApp.GetEvent(var Event: TEvent);
begin
TApplication.GetEvent(Event);
if Event.What = evNothing then begin
GetBiosTickEvent(Event); {Hook to add the BIOS tick event}
if Event.What = evNothing then begin
Event.What := evMetaBroadcast;
Event.Command := cmIdle; {Alternative to .Idle method}
end;
if MetaSupport and (Event.What = evMetaBroadcast) then begin
if TopView <> @Self then begin {We are not the current modal view}
HandleEvent(Event); {Force meta broadcast of event}
ClearEvent(Event); {Prevent redundant processing}
end;
end;
end;
end;

procedure TTimeApp.HandleEvent(var Event: TEvent);

procedure About;
const
S1 = #3'Bios Tick Time/Heap Display Demo';
S2 = #13#3'Copyright (c) 1992 Charles Scott Nichol';
S3 = #13#3'All rights reserved';
S4 = #13#3'Meta support is ';
var
D: PDialog;
R: TRect;
S5: String[15];
begin
R.Assign(0,0,49,10);
D := New(PDialog, Init(R, 'About'));
if MetaSupport then
S5 := 'enabled'
else
S5 := 'disabled';
with D^ do begin
Options := Options or ofCentered;
R.Assign(3, 2, Size.X - 2, Size.Y - 4);
Insert(New(PStaticText, Init(R, S1+S2+S3+S4+S5)));
R.Assign(19, 7, 29, 9);
Insert(New(PButton, Init(R, 'O~k~', cmOK, bfDefault)));
SelectNext(False);
end;
if ValidView(D) <> nil then begin
DeskTop^.ExecView(D);
Dispose(D, Done);
end;
end;

procedure ToggleMeta;
begin
MetaSupport := not MetaSupport;
end;

begin
TApplication.HandleEvent(Event);
if Event.What = evCommand then begin
case Event.Command of
cmAbout:
About;
cmToggleClock:
Clock^.ToggleDisplay;
cmToggleHeap:
Heap^.ToggleDisplay;
cmToggleMeta:
ToggleMeta;
end;
ClearEvent(Event);
end;
end;

procedure TTimeApp.InitDeskTop;
var
R: TRect;
begin
GetExtent(R);
R.Grow(0,-1); {Leave room for menu bar and status line}
DeskTop := New(PDeskTop, Init(R));
end;

procedure TTimeApp.InitMenuBar;
var
R: TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1; {Top line only}
MenuBar := New(PMenuBar, Init(R, NewMenu(
NewSubMenu('~'#240'~', hcNoContext, NewMenu(
NewItem('~A~bout', '', kbNoKey, cmAbout, hcNoContext,
NewItem('Toggle ~C~lock Display', '', kbNoKey, cmToggleClock, hcNoContext,
NewItem('Toggle ~H~eap Display', '', kbNoKey, cmToggleHeap, hcNoContext,
NewLine(
NewItem('E~x~it', '', kbNoKey, cmQuit, hcNoContext, nil)))))),
nil))));
end;

procedure TTimeApp.InitStatusLine;
var
R: TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1; {Bottom line only}
StatusLine := New(PStatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
NewStatusKey('~Alt-M~ Toggle Meta Support', kbAltM, cmToggleMeta,
NewStatusKey('~F10~ Menu', kbF10, cmMenu, nil))),
nil)));
end;

procedure TTimeApp.OutOfMemory;
begin
MessageBox(#3'Insufficient memory to complete operation', nil,

mfError + mfOkButton);
end;

{----------- Program ------------}

var
TimeApp: TTimeApp;
begin
if TimeApp.Init then begin
TimeApp.Run;
TimeApp.Done;
end;
end.


[EXTRA LISTING #2]

{***********************************************************************}
{ CMDS.PAS }
{ }
{ Constants for event and commands added. }
{ }
{ Copyright (c) 1992 Charles Scott Nichol. All rights reserved. }
{***********************************************************************}

unit
Cmds;

interface

const
evMetaBroadcast = $400; {Use an unallocated bit from Event.What}

const
cmBiosTick = 1000; {These commands are for evMetaBroadcast}
cmIdle = 1001;

implementation

end.






  3 Responses to “Category : Files from Magazines
Archive   : NOV92_1.ZIP
Filename : TVTIME.ASC

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/