[Back to OOP SWAG index] [Back to Main SWAG index] [Original]
unit clocks;
{$X+} {allow discardable function results}
{ Clock-on-a-menubar OOP extension to Turbo Vision apps
Copyright (c) 1990 by Danny Thorpe
Alarms have not been implemented.
}
interface
uses dos, objects, drivers, views, menus, dialogs, app, msgbox;
const cmClockChangeDisplay = 1001;
cmClockSetAlarm = 1002;
ClockNoSecs = 0;
ClockDispSecs = 1;
Clock12hour = 0;
Clock24hour = 1;
type
ClockDataRec = record
Format: word;
Seconds: word;
RefreshStr: String[2];
end;
PClockMenu = ^TClockMenu;
TClockMenu = object(TMenuBar)
ClockOptions: ClockDataRec;
Refresh: byte;
LastTime: DateTime;
TimeStr: string[10];
constructor Init(var Bounds: TRect; Amenu: PMenu);
procedure Draw; virtual;
procedure Update; virtual;
procedure SetRefresh(Secs: integer); virtual;
procedure SetRefreshStr( Secs: string); virtual;
procedure ClockChangeDisplay; virtual;
procedure HandleEvent( var Event: TEvent); virtual;
function FormatTimeStr(h,m,s:word):string; virtual;
end;
implementation
function LeadingZero(w : Word) : String;
var
s : String;
begin
Str(w:0,s);
if Length(s) = 1 then
s := '0' + s;
LeadingZero := s;
end;
constructor TClockMenu.Init(var Bounds: TRect; AMenu: PMenu);
var Temp: PMenuBar;
ClockMenu: PMenu;
R: TRect;
begin
ClockMenu:= NewMenu(NewSubMenu('~'#0'~Clock ', hcNoContext, NewMenu(
NewItem('~C~hange display','',0,cmClockChangeDisplay, hcNoContext,
NewItem('Set ~A~larm','', 0, cmClockSetAlarm, hcNoContext,
nil))),
AMenu^.Items));
{ ^^ tack passed menubar on end of new clock menu }
ClockMenu^.Default:= AMenu^.Default;
TMenuBar.Init(Bounds, ClockMenu);
fillchar(LastTime,sizeof(LastTime),#$FF); {fill with 65000's}
TimeStr:='';
ClockOptions.Format:= Clock24Hour;
ClockOptions.Seconds:= ClockDispSecs;
SetRefresh(1);
end;
procedure TClockMenu.Draw;
var P: PMenuItem;
begin
P:= FindItem(#0);
if P <> nil then
begin
DisposeStr(P^.Name);
P^.Name:= NewStr('~'#0'~'+TimeStr);
end;
TMenuBar.Draw;
end;
procedure TClockMenu.Update;
var h,m,s,hund: word;
begin
GetTime(h,m,s,hund);
if abs(s-LastTime.sec) >= Refresh then
begin
with LastTime do
begin
Hour:=h;
Min:=m;
Sec:=s;
end;
TimeStr:= FormatTimeStr(h,m,s);
DrawView;
end;
end;
procedure TClockMenu.SetRefresh(Secs: integer);
begin
if Secs > 59 then
Secs := 59;
if Secs < 0 then
Secs := 0;
Refresh:= Secs;
Str(Refresh:2,ClockOptions.RefreshStr);
end;
procedure TClockMenu.SetRefreshStr( Secs: string);
var temp,code: integer;
begin
val(Secs, temp, code);
if code = 0 then
SetRefresh(temp);
end;
procedure TClockMenu.ClockChangeDisplay;
var
D: PDialog;
Control: PView;
Command: word;
temp,code: integer;
R: TRect;
ClockData : ClockDataRec;
begin
ClockData := ClockOptions;
R.Assign(14,3,48,15);
D:= new(PDialog, Init(R, 'Clock Display'));
R.Assign(3,3,20,5);
Control:= new(PRadioButtons, Init(R,
NewSItem('~1~2 hour',
NewSItem('~2~4 hour',
nil))));
D^.Insert(Control);
R.Assign(3,2,20,3);
Control:= new(Plabel, Init(R, '~F~ormat', Control));
D^.Insert(Control);
R.Assign(3,6,20,7);
Control:= new(PCheckBoxes, Init(R,
NewSItem('~S~econds',
nil)));
D^.Insert(Control);
R.Assign(16,9,20,10);
Control:= new(PInputLine, Init(R, 2));
D^.Insert(Control);
R.Assign(2,8,20,9);
Control:= new(PLabel, Init(R, '~R~efresh Rate', Control));
D^.Insert(Control);
R.Assign(2,9,15,10);
Control:= new(PLabel, Init(R, '0-59 seconds', PLabel(Control)^.Link));
D^.Insert(Control);
R.Assign(21,3,31,5);
Control:= new(PButton, Init(R, '~O~k', cmOk, bfDefault));
D^.Insert(Control);
R.Assign(21,6,31,8);
Control:= new(PButton, Init(R, '~C~ancel', cmCancel, bfNormal));
D^.Insert(Control);
D^.SelectNext(False);
D^.SetData(ClockData);
repeat
Command:= Desktop^.ExecView(D);
if Command = cmOK then
begin
D^.GetData(ClockData);
val(ClockData.RefreshStr,temp,code);
if (code <> 0) or ((temp<0) or (temp>59)) then
MessageBox('Refresh rate must be between 0 and 59 seconds.',nil,
mfOKButton+mfError);
end;
until (Command = cmCancel)
or ((code=0) and ((temp>=0) and (temp<=59)));
Dispose(D, Done);
if Command = cmOk then
begin
ClockOptions:= ClockData;
SetRefreshStr(ClockData.RefreshStr);
end;
{ update display to reflect changes immediately }
TimeStr:= FormatTimeStr(LastTime.hour, LastTime.min, LastTime.sec);
DrawView;
end;
procedure TClockMenu.HandleEvent( var Event: TEvent);
begin
TMenuBar.HandleEvent( Event);
if Event.What = evCommand then
begin
case Event.Command of
cmClockChangeDisplay: ClockChangeDisplay;
cmClockSetAlarm: ;
end;
end;
end;
function TClockMenu.FormatTimeStr(h,m,s: word): string;
var st, tail: string;
begin
tail:='';
if ClockOptions.Format = Clock24Hour then
st:= LeadingZero(h)
else
begin
if h >= 12 then
begin
tail:= 'pm';
if h>12 then
dec(h,12);
end
else
tail:= 'am';
if h=0 then h:=12; {12 am}
str(h:0,st); { no leading space on hours }
end;
st:=st+':'+ LeadingZero(m);
if ClockOptions.Seconds = ClockDispSecs then
st:= st+':'+LeadingZero(s);
FormatTimeStr:= st + tail;
end;
end.
{ ----------------------------- DEMO ---------------------- }
program TestPlatform;
uses Objects, Drivers, Views, Menus, App,
Dos, { for the paramcount and paramstr funcs}
Clocks; { for the clock on the menubar object, TClockMenu }
{ This generic test platform has been hooked up to the clock-on-the-menubar
object / unit. Search for *** to find hook-up points.
Copyright (c) 1990 by Danny Thorpe
}
const cmNewWin = 100;
cmFileOpen = 101;
WinCount : Integer = 0;
MaxLines = 50;
type PInterior = ^TInterior;
TInterior = object(TScroller)
constructor init(var Bounds: TRect; AHScrollbar, AVScrollbar: PScrollbar);
procedure Draw; virtual;
end;
PDemoWindow = ^TDemoWindow;
TDemoWindow = object(TWindow)
constructor Init(WindowNo: integer);
end;
TMyApp = object(TApplication)
procedure InitStatusLine; virtual;
procedure InitMenuBar; virtual;
procedure NewWindow;
procedure HandleEvent( var Event: TEvent); virtual;
procedure Idle; virtual;
end;
var MyApp: TMyApp;
Lines: array [0..MaxLines-1] of PString;
LineCount: Integer;
constructor TInterior.Init(var Bounds: TRect; AHScrollbar, AVScrollbar: PScrollbar);
begin
TScroller.Init(Bounds,AHScrollbar,AVScrollbar);
Growmode := gfGrowHiX + gfGrowHiY;
Options := Options or ofFramed;
SetLimit(128,LineCount);
end;
procedure TInterior.Draw;
var color: byte;
y,i: integer;
B: TDrawBuffer;
begin
TScroller.Draw;
Color := GetColor($01);
for y:= 0 to Size.Y -1 do
begin
MoveChar(B,' ',Color,Size.X);
I := Delta.Y + Y;
if (I<Linecount) and (Lines[I] <> nil) then
MoveStr(B,Copy(Lines[I]^,Delta.X+1,size.x),Color);
WriteLine(0,y,size.x,1,B);
end;
end;
procedure ReadFile;
var F: text;
S: string;
begin
LineCount:=0;
if paramcount = 0 then
assign(F,'clockwrk.pas')
else
assign(F,paramstr(1));
reset(F);
while not eof(F) and (linecount < maxlines) do
begin
readln(f,s);
Lines[Linecount] := NewStr(S);
Inc(LineCount);
end;
Close(F);
end;
constructor TDemoWindow.Init(WindowNo: Integer);
var LInterior, RInterior: PInterior;
HScrollbar, VScrollbar: PScrollbar;
R: TRect;
Center: integer;
begin
R.Assign(0,0,40,15);
R.Move(Random(40),Random(8));
TWindow.Init(R, 'Window', wnNoNumber);
GetExtent(R);
Center:= (R.B.X + R.A.X) div 2;
R.Assign(Center,R.A.Y+1,Center+1,R.B.Y-1);
VScrollbar:= new(PScrollbar, Init(R));
with VScrollbar^ do Options := Options or ofPostProcess;
Insert(VScrollbar);
GetExtent(R);
R.Assign(R.A.X+2,R.B.Y-1,Center-1,R.B.Y);
HScrollbar:= new(PScrollbar, Init(R));
with HScrollbar^ do Options := Options or ofPostProcess;
Insert(HScrollbar);
GetExtent(R);
R.Assign(R.A.X+1,R.A.Y+1,Center,R.B.Y-1);
LInterior:= new(PInterior, Init(R, HScrollbar, VScrollbar));
with LInterior^ do
begin
Options:= Options or ofFramed;
Growmode:= GrowMode or gfGrowHiX;
SetLimit(128,LineCount);
end;
Insert(LInterior);
GetExtent(R);
R.Assign(R.B.X-1,R.A.Y+1,R.B.X,R.B.Y-1);
VScrollbar:= new(PScrollbar, Init(R));
with VScrollbar^ do Options := Options or ofPostProcess;
Insert(VScrollbar);
GetExtent(R);
R.Assign(Center+2,R.B.Y-1,R.B.X-2,R.B.Y);
HScrollbar:= new(PScrollbar, Init(R));
with HScrollbar^ do
begin
Options := Options or ofPostProcess;
GrowMode:= GrowMode or gfGrowLoX;
end;
Insert(HScrollbar);
GetExtent(R);
R.Assign(Center+1,R.A.Y+1,R.B.X-1,R.B.Y-1);
RInterior:= new(PInterior, Init(R, HScrollbar, VScrollbar));
with RInterior^ do
begin
Options:= Options or ofFramed;
Growmode:= GrowMode or gfGrowLoX;
SetLimit(128,LineCount);
end;
Insert(RInterior);
end;
procedure TMyApp.InitStatusLine;
var R: TRect;
begin
GetExtent(R); { find out how big the current view is }
R.A.Y := R.B.Y-1; { squeeze R down to one line at bottom of frame }
StatusLine := New(PStatusline, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
NewStatusKey('~F4~ New', kbF4, cmNewWin,
NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
nil))),
nil)
));
end;
{ *** The vvv below indicate the primary hook-up point for the menubar-clock.
This programmer-defined normal menu structure will be tacked onto the
end of the clock menubar in TClockMenu.Init.
}
procedure TMyApp.InitMenuBar;
var R: TRect;
begin
GetExtent(R); {***}
r.b.y:= r.a.y+1; { vvv }
Menubar := New(PClockMenu, Init(R, NewMenu(
NewSubMenu('~F~ile', hcNoContext, NewMenu(
NewItem('~O~pen','F3', kbF3, cmFileOpen, hcNoContext,
NewItem('~N~ew','F4', kbF4, cmNewWin, hcNoContext,
NewLine(
NewItem('E~x~it','Alt-X', kbAltX, cmQuit, hcNoContext,
nil))))),
NewSubMenu('~W~indow', hcNoContext, NewMenu(
NewItem('~N~ext','F6', kbF6, cmNext, hcNoContext,
NewItem('~Z~oom','F7', kbF7, cmZoom, hcNoContext,
nil))),
nil)) { one ) for each menu defined }
)));
end;
procedure TMyApp.NewWindow;
var
Window: PDemoWindow;
R: TRect;
begin
inc(WinCount);
Window:= New(PDemoWindow, Init(WinCount));
Desktop^.Insert(Window);
end;
{*** clock hook-up point - typecasting required to access "new" method }
procedure TMyApp.Idle;
begin
TApplication.Idle;
PClockMenu(MenuBar)^.Update;
end;
procedure TMyApp.HandleEvent( var Event: TEvent);
begin
TApplication.HandleEvent(Event);
if Event.What = evCommand then
begin
case Event.Command of
cmNewWin: NewWindow;
else { case }
Exit;
end; { case }
ClearEvent(Event);
end; {if}
end;
begin
readfile;
MyApp.Init;
MyApp.run;
MyApp.done;
end.
[Back to OOP SWAG index] [Back to Main SWAG index] [Original]