[Back to OOP SWAG index] [Back to Main SWAG index] [Original]
{************************************************}
{ }
{ UNIT XVIEWS A collection of new Views }
{ Copyright (c) 1994-97 by Tom Wellige }
{ Donated as FREEWARE }
{ }
{ Ortsmuehle 4, 44227 Dortmund, GERMANY }
{ EMail: wellige@itk.de }
{ }
{************************************************}
(*
Some few words on this unit:
----------------------------
- This units works fine with Turbo Pascal 6 or higher. If you use
TP/BP 7 you can use the "inherited" command as shown in the
comment lines on each line where it is possible.
- This unit defines first of all a basic object (TXView) for status views
which are updateable via messages (send from the applications Idle
methode). All inheritances only have to override the abstract methode
UPDATE and place the information to display in a string. In this manner
there are a ClockView, a DateView and an HeapView as examples
implemented. The usage of these objects (TClock, TDate and THeap) will
be demonstrated in the programs XTEST1 and XTEST2.
- There is also a 7-segment view implemented in this unit (T7Segment)
capable of displaying all numbers from 0 to 9 and the characters
"A" "b" "c" "d" "E" "F" and "-". The usage of this object is also
demonstrated in this unit by the object TBigClock which is a clock
in "hh:mm:ss" format. How to use this clock is demonstrated in the
XTEST3 program.
*)
unit xviews;
interface
uses dos, objects, drivers, views;
const
cmGetData = 5000; { Request data string from TXView object }
cmChange7Segment = 5001; { Set new value to display in T7Segment }
cmChangeBack = 5002; { Change Background of T7Segment }
type
PXView = ^TXView; (* Basic status view object *)
TXView = object(TView)
Data: string;
procedure HandleEvent(var Event: TEvent); virtual;
procedure Update; virtual;
procedure Draw; virtual;
function GetString: PString; virtual;
end;
PClock = ^TClock; (* Displays current time *)
TClock = object(TXView)
procedure Update; virtual;
end;
PDate = ^TDate; (* Displays current date *)
TDate = object(TXView)
procedure Update; virtual;
end;
PHeap = ^THeap; (* Displays free bytes on the heap *)
THeap = object(TXView)
procedure Update; virtual;
end;
PInfoView = ^TInfoView; (* Show all "actual" datas *)
TInfoView = object(TView)
procedure Draw; virtual;
end;
PInfoWindow = ^TInfoWindow; (* Window holding TInfoView *)
TInfoWindow = object(TWindow)
constructor Init(var Bounds: TRect);
end;
TSegment = array[1..13] of byte; (* Buffer for T7Sgement *)
P7Segment = ^T7Segment; (* 7 Segment View (7x5) *)
T7Segment = object(TView)
Segment: TSegment;
Number: word;
{ 16 -> segm_ = "-", >=17 -> segmBlank = " " }
BackGround: boolean;
{ not active segment visible (gray) ? }
constructor Init(Top: TPoint; ABackGround: boolean; ANumber: word);
{ Top: upper left corner of segment
ABackGround: not active segments visible (gray) ?
ANumber: default value to be displayed }
procedure HandleEvent(var Event: TEvent); virtual;
procedure Draw; virtual;
procedure UpdateSegments;
end;
PBigClock = ^TBigClock;
TBigClock = object(TGroup)
Seg: Array[1..6] of P7Segment;
constructor Init(Top: TPoint; BackGround: boolean);
{ Top: upper left corner of clock
BackGround: will passed to each T7Segment: not active segments
visible (gray) ? }
procedure HandleEvent(var Event: TEvent); virtual;
procedure Update;
end;
const
Date : PDate = nil;
Clock: PClock = nil;
Heap : PHeap = nil;
implementation
{***********************************************************************}
{** TXView **}
{***********************************************************************}
procedure TXView.HandleEvent(var Event: TEvent);
begin
{ TP/BP7: inherited HandleEvent(Event); }
TView.HandleEvent(Event);
if Event.What = evBroadCast then
if Event.Command = cmGetData then
begin
ClearEvent(Event);
Event.InfoPtr:= GetString;
end;
end;
procedure TXView.Update;
begin
Abstract;
end;
procedure TXView.Draw;
var
Buf: TDrawBuffer;
C: word;
begin
C:= GetColor(2); (* Application -> "Menu normal" *)
(* Window -> "Frame active" *)
MoveChar(Buf, ' ', C, Size.X);
MoveStr(Buf, Data, C);
WriteLine(0, 0, Size.X, 1, Buf);
end;
function TXView.GetString: PString;
begin
GetString:= PString(@Data);
end;
{***********************************************************************}
{** TClock **}
{***********************************************************************}
procedure TClock.Update;
type
Rec = record
hh, mm, ss: longint; end;
var
DataRec: Rec;
hh, mm, ss, hs: word;
begin
GetTime(hh, mm, ss, hs);
DataRec.hh:= hh;
DataRec.mm:= mm;
DataRec.ss:= ss;
FormatStr(Data, '%2d:%2d:%2d', DataRec);
if hh < 10 then Data[1]:= '0';
if mm < 10 then Data[4]:= '0';
if ss < 10 then Data[7]:= '0';
DrawView;
end;
{***********************************************************************}
{** TDate **}
{***********************************************************************}
procedure TDate.Update;
type
Rec = record
dd, mm, yy: longint; end;
var
DataRec: Rec;
dd, mm, yy, dw: word;
begin
GetDate(yy, mm, dd, dw);
DataRec.dd:= dd;
DataRec.mm:= mm;
DataRec.yy:= yy;
FormatStr(Data, '%2d.%2d.%4d', DataRec);
if dd < 10 then Data[1]:= '0';
if mm < 10 then Data[4]:= '0';
DrawView;
end;
{***********************************************************************}
{** THeap **}
{***********************************************************************}
procedure THeap.Update;
var
Mem: longint;
begin
Mem:= MemAvail;
FormatStr(Data, '%d Bytes', Mem);
DrawView;
end;
{***********************************************************************}
{** TInfoView **}
{***********************************************************************}
procedure TInfoView.Draw;
var
Buf: TDrawBuffer;
C: word;
s: string;
begin
C:= GetColor(2); (* Application -> "Menu normal" *)
(* Window -> "Frame active" *)
s:= 'Date : ';
if assigned(Date) then
s:= s + PString(Message(Date, evBroadCast, cmGetData, nil))^ else
s:= s + 'not accessable';
MoveChar(Buf, ' ', C, Size.X);
MoveStr(Buf, s, C);
WriteLine(0, 0, Size.X, 1, Buf);
s:= 'Time : ';
if assigned(Clock) then
s:= s + PString(Message(Clock, evBroadCast, cmGetData, nil))^ else
s:= s + 'not accessable';
MoveChar(Buf, ' ', C, Size.X);
MoveStr(Buf, s, C);
WriteLine(0, 1, Size.X, 1, Buf);
s:= 'Memory : ';
if assigned(Heap) then
s:= s + PString(Message(Heap, evBroadCast, cmGetData, nil))^ else
s:= s + 'not accessable';
MoveChar(Buf, ' ', C, Size.X);
MoveStr(Buf, s, C);
WriteLine(0, 2, Size.X, 1, Buf);
end;
{***********************************************************************}
{** TInfoWindow **}
{***********************************************************************}
constructor TInfoWindow.Init(var Bounds: TRect);
var R: TRect;
begin
{ TP/BP7: inherited Init(Bounds, 'Systeminfo', 0); }
TWindow.Init(Bounds, 'Systeminfo', 0);
Palette:= wpCyanWindow;
Flags:= Flags and not (wfClose + wfZoom + wfGrow);
GetExtent(R);
R.Grow(-2, -2);
Insert(New(PInfoView, Init(R)));
end;
{***********************************************************************}
{** T7Segment **}
{***********************************************************************}
const { 1 2 3 4 5 6 7 8 9 A B C D }
segm0: TSegment = (1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1);
segm1: TSegment = (0, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1);
segm2: TSegment = (1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1);
segm3: TSegment = (1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1);
segm4: TSegment = (1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 0, 0, 1);
segm5: TSegment = (1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1);
segm6: TSegment = (1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1);
segm7: TSegment = (1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1);
segm8: TSegment = (1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1);
segm9: TSegment = (1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 0, 1);
segmA: TSegment = (1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1);
segmB: TSegment = (1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1);
segmC: TSegment = (1, 1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 1, 1);
segmD: TSegment = (0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1);
segmE: TSegment = (1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1);
segmF: TSegment = (1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 0, 0);
segm_: TSegment = (0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0);
segmBlank: TSegment =
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
constructor T7Segment.Init(Top: TPoint; ABackGround: boolean; ANumber: word);
var R: TRect;
begin
R.Assign(Top.X, Top.Y, Top.X+7, Top.Y+5);
{ TP/BP7: inherited Init(R); }
TView.Init(R);
BackGround:= ABackGround;
Number:= ANumber;
UpdateSegments;
end;
procedure T7Segment.HandleEvent(var Event: TEvent);
begin
{ TP/BP7: inherited HandleEvent(Event); }
TView.HandleEvent(Event);
if Event.What = evBroadCast then
case Event.Command of
cmChange7Segment: begin
Number:= Word(Event.InfoPtr^);
UpdateSegments;
DrawView;
ClearEvent(Event);
end;
cmChangeBack : begin
if BackGround then BackGround:= false
else BackGround:= true;
DrawView;
end;
end;
end;
procedure T7Segment.Draw;
var
Buf: TDrawBuffer;
Front, Back: byte;
function SetColor(w: word; c: byte): word;
begin
w:= w and $00FF;
w:= swap(w);
w:= w or c;
w:= swap(w);
SetColor:= w;
end;
procedure SetBufColor(var B: TDrawBuffer; C: word);
var i: integer;
begin
for i:= 0 to Size.X do
Buf[i]:= SetColor(Buf[i], C);
end;
begin
if BackGround then Back:= $8 else Back:= $0;
Front:= $F;
{ Segment 1,2,3 }
SetBufColor(Buf, $0);
MoveStr (Buf, ' þþþþþ', Back);
if Segment[1] = 1 then
Buf[1]:= SetColor(Buf[1], Front);
if Segment[2] = 1 then begin
Buf[2]:= SetColor(Buf[2], Front);
Buf[3]:= SetColor(Buf[3], Front);
Buf[4]:= SetColor(Buf[4], Front); end;
if Segment[3] = 1 then
Buf[5]:= SetColor(Buf[5], Front);
WriteLine(0, 0, Size.X, 1, Buf);
{ Segment 4,5 }
SetBufColor(Buf, $0);
MoveStr (Buf, ' Û Û', Back);
if Segment[4] = 1 then
Buf[1]:= SetColor(Buf[1], Front);
if Segment[5] = 1 then
Buf[5]:= SetColor(Buf[5], Front);
WriteLine(0, 1, Size.X, 1, Buf);
{ Segment 6,7,8 }
SetBufColor(Buf, $0);
MoveStr (Buf, ' þþþþþ', Back);
if Segment[6] = 1 then
Buf[1]:= SetColor(Buf[1], Front);
if Segment[7] = 1 then begin
Buf[2]:= SetColor(Buf[2], Front);
Buf[3]:= SetColor(Buf[3], Front);
Buf[4]:= SetColor(Buf[4], Front); end;
if Segment[8] = 1 then
Buf[5]:= SetColor(Buf[5], Front);
WriteLine(0, 2, Size.X, 1, Buf);
{ Segment 9,10 }
SetBufColor(Buf, $0);
MoveStr (Buf, ' Û Û', Back);
if Segment[9] = 1 then
Buf[1]:= SetColor(Buf[1], Front);
if Segment[10] = 1 then
Buf[5]:= SetColor(Buf[5], Front);
WriteLine(0, 3, Size.X, 1, Buf);
{ Segment 11,12,13 }
SetBufColor(Buf, $0);
MoveStr (Buf, ' þþþþþ', Back);
if Segment[11] = 1 then
Buf[1]:= SetColor(Buf[1], Front);
if Segment[12] = 1 then begin
Buf[2]:= SetColor(Buf[2], Front);
Buf[3]:= SetColor(Buf[3], Front);
Buf[4]:= SetColor(Buf[4], Front); end;
if Segment[13] = 1 then
Buf[5]:= SetColor(Buf[5], Front);
WriteLine(0, 4, Size.X, 1, Buf);
end;
procedure T7Segment.UpdateSegments;
begin
case Number of
0: Segment:= segm0;
1: Segment:= segm1;
2: Segment:= segm2;
3: Segment:= segm3;
4: Segment:= segm4;
5: Segment:= segm5;
6: Segment:= segm6;
7: Segment:= segm7;
8: Segment:= segm8;
9: Segment:= segm9;
10: Segment:= segmA;
11: Segment:= segmB;
12: Segment:= segmC;
13: Segment:= segmD;
14: Segment:= segmE;
15: Segment:= segmF;
16: Segment:= segm_;
else
Segment:= segmBlank;
end;
end;
{***********************************************************************}
{** TBigClock **}
{***********************************************************************}
type
PBlackView = ^TBlackView; (* black background for TBigClock *)
TBlackView = object(TView)
procedure Draw; virtual;
end;
procedure TBlackView.Draw;
var
Buf : TDrawBuffer;
Color: word;
i : integer;
begin
Color:= $0F;
for i:= 0 to Size.Y do
begin
MoveChar(Buf, ' ', Color, Size.X);
if (i = 2) or (i = 4) then
begin
Buf[16]:= $0FFE;
Buf[33]:= $0FFE;
end;
WriteLine(0, i, Size.X, 1, Buf);
end;
end;
constructor TBigClock.Init(Top: TPoint; BackGround: boolean);
const
XPos : Array [1..6] of word = (1, 8, 18, 25, 35, 42);
var
R: TRect;
P: TPoint;
i: integer;
begin
R.Assign(Top.X, Top.Y, Top.X+50, Top.Y+7);
{ TP/BP7: inherited Init(R); }
TGroup.Init(R);
R.Assign(0, 0, Size.X, Size.Y);
Insert(new(PBlackView, Init(R)));
for i:= 1 to 6 do
begin
P.X:= XPos[i]; P.Y:= 1;
Seg[i]:= new(P7Segment, Init(P, BackGround, 0));
insert(Seg[i]);
end;
end;
procedure TBigClock.HandleEvent(var Event: TEvent);
var i: integer;
begin
{ TP/BP7: inherited HandleEvent(Event); }
TGroup.HandleEvent(Event);
if Event.What = evBroadCast then
if Event.Command = cmChangeBack then
begin
for i:= 1 to 6 do
Message(Seg[i], evBroadCast, cmChangeBack, nil);
end;
end;
procedure TBigClock.Update;
var
w, h, m, s, hs: word;
begin
GetTime(h, m, s, hs);
w:= h div 10;
Message(Seg[1], evBroadCast, cmChange7Segment, @w); (* Hours - 10^1 *)
w:= h mod 10;
Message(Seg[2], evBroadCast, cmChange7Segment, @w); (* Hours - 10^0 *)
w:= m div 10;
Message(Seg[3], evBroadCast, cmChange7Segment, @w); (* Minutes - 10^1 *)
w:= m mod 10;
Message(Seg[4], evBroadCast, cmChange7Segment, @w); (* Minutes - 10^0 *)
w:= s div 10;
Message(Seg[5], evBroadCast, cmChange7Segment, @w); (* Seconds - 10^1 *)
w:= s mod 10;
Message(Seg[6], evBroadCast, cmChange7Segment, @w); (* Seconds - 10^0 *)
end;
end.
{ -------------------- DEMO -------------- CUT HERE ------------ }
program XTest1;
{ usage of TDate, TClock and THeap defined in Unit XVIEWS }
uses Drivers, Objects, App, Views, Menus, XViews;
const
cmWindow = 1000;
type
PMyApp = ^TMyApp;
TMyApp = object(TApplication)
constructor Init;
procedure Idle; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure Window;
procedure InitStatusLine; virtual;
end;
constructor TMyApp.Init;
var R: TRect;
begin
{ TP/BP7: inherited Init; }
TApplication.Init;
GetExtent(R);
R.A.X:= R.B.X - 11;
R.A.Y:= R.B.Y - 1;
Date:= New(PDate, Init(R));
Insert(Date);
GetExtent(R);
R.A.X:= R.B.X - 9;
R.B.Y:= R.A.Y + 1;
Clock:= New(PClock, Init(R));
Insert(Clock);
GetExtent(R);
R.A.X:= R.A.X + 1;
R.B.X:= R.A.X + 20;
R.B.Y:= R.A.Y + 1;
Heap:= New(PHeap, Init(R));
Insert(Heap);
end;
procedure TMyApp.Idle;
var Event: TEvent;
begin
{ TP/BP7: inherited Idle; }
TApplication.Idle;
Date^.Update;
Clock^.Update;
Heap^.Update;
end;
procedure TMyApp.HandleEvent(var Event: TEvent);
begin
{ TP/BP7: inherited HandleEvent(Event); }
TApplication.HandleEvent(Event);
case Event.What of
evCommand:
case Event.Command of
cmWindow : Window;
end;
end;
end;
procedure TMyApp.Window;
var
P: PWindow;
R: TRect;
begin
Desktop^.GetExtent(R);
P:= New(PWindow, Init(R, 'Memory-Eater', 0));
P^.Options:= P^.Options or ofTileAble;
Desktop^.Insert(P);
Cascade;
end;
procedure TMyApp.InitStatusLine;
var R: TRect;
begin
GetExtent(R);
R.A.Y:= R.B.Y - 1;
New(StatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
NewStatusKey('~F3~ Open Window', kbF3, cmWindow,
NewStatusKey('', kbAltF3, cmClose,
nil))),
nil)));
end;
var
MyApp: TMyApp;
begin
MyApp.Init;
MyApp.Run;
MyApp.Done;
end.
{ -------------------- DEMO -------------- CUT HERE ------------ }
program XTest2;
{ usage of TInfoWindow defined in Unit XVIEWS }
uses Drivers, Objects, App, Views, XViews;
type
PMyApp = ^TMyApp;
TMyApp = object(TApplication)
Info: PInfoWindow;
constructor Init;
procedure Idle; virtual;
end;
constructor TMyApp.Init;
var R: TRect;
begin
{ TP/BP7: inherited Init; }
TApplication.Init;
R.Assign(0,0,1,1);
Date:= New(PDate, Init(R));
Date^.Hide;
Insert(Date);
Clock:= New(PClock, Init(R));
Clock^.Hide;
Insert(Clock);
Heap:= New(PHeap, Init(R));
Heap^.Hide;
Insert(Heap);
R.Assign(1,1,35,8);
Info:= New(PInfoWindow, Init(R));
Info^.Options:= Info^.Options or ofCentered;
Insert(Info);
end;
procedure TMyApp.Idle;
var Event: TEvent;
begin
{ TP/BP7: inherited Idle; }
TApplication.Idle;
if assigned(Date) then Date^.Update;
if assigned(Clock) then Clock^.Update;
if assigned(Heap) then Heap^.Update;
Info^.Redraw;
end;
var
MyApp: TMyApp;
begin
MyApp.Init;
MyApp.Run;
MyApp.Done;
end.
{ -------------------- DEMO -------------- CUT HERE ------------ }
program XTest3;
{ usage of TBigClock defined in Unit XVIEWS }
uses Drivers, Objects, App, Menus, Views, XViews;
const
cmToggle = 1000;
type
PMyApp = ^TMyApp;
TMyApp = object(TApplication)
BigClock: PBigClock;
constructor Init;
procedure InitStatusLine; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
procedure Idle; virtual;
end;
constructor TMyApp.Init;
var P: TPoint;
begin
{ TP/BP7: inherited Init; }
TApplication.Init;
P.X:= 15; P.Y:= 9;
BigClock:= new(PBigClock, Init(P, true));
Insert(BigClock);
end;
procedure TMyApp.InitStatusLine;
var R: TRect;
begin
GetExtent(R);
R.A.Y:= R.B.Y - 1;
New(StatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
NewStatusKey('~F2~ Toggle Background', kbF2, cmToggle,
nil)),
nil)));
end;
procedure TMyApp.HandleEvent(var Event: TEvent);
begin
{ TP/BP7: inherited HandleEvent(Event); }
TApplication.HandleEvent(Event);
if Event.What = evCommand then
if Event.Command = cmToggle then
Message(BigClock, evBroadCast, cmChangeBack, nil);
end;
procedure TMyApp.Idle;
var Event: TEvent;
begin
{ TP/BP7: inherited Idle; }
TApplication.Idle;
if assigned(BigClock) then BigClock^.Update;
end;
var
MyApp: TMyApp;
begin
MyApp.Init;
MyApp.Run;
MyApp.Done;
end.
[Back to OOP SWAG index] [Back to Main SWAG index] [Original]