Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/CMIDLE.ZIP/UWIDLE.PAS

Pascal/Delphi Source File | 1991-03-16 | 4.9 KB | 257 lines

{--------------------------------------------------------------}
{ UWIDLE.PAS                                                   }
{ COPYRIGHT (C) USERWARE 1991 ALL RIGHTS RESERVED.             }
{ (portions copyright 1990 Borland International.)
{ USERWARE, 4 FALCON LN E, FAIRPORT NY 14450-3312 USA.         }
{ VOICE: 716-425-3463. CIS: 71540,3660.                        }
{==============================================================}

unit uwidle;

interface
 uses
  objects,drivers,views,dialogs;

const
 cmidle=$FFFF;

type
 pidlewhen=^tidlewhen;
 tidlewhen=record
  hour,min,sec,sec100:word
 end;

type
 pidleview=^tidleview;
 tidleview=object(tview)
  lastidle:tidlewhen;
  constructor init(var bounds:trect);
  procedure update;virtual;
  procedure handleevent(var event:tevent);virtual;
 end;

type
 pidleclock=^tidleclock;
 tidleclock=object(tidleview)
  lastsec:byte; {read-only}
  refresh:byte; {0..59!}
  timestr:string[10];
  constructor init(var bounds:trect);
  procedure draw;virtual;
  procedure update;virtual;
 end;

type
 pidleheap=^tidleheap;
 tidleheap=object(tidleview)
  oldmem:longint;
  procedure draw;virtual;
  procedure update;virtual;
 end;

type
 pkbcheckbox=^tkbcheckbox;
 tkbcheckbox=object(tcheckboxes)
  procedure conform;
  constructor init(var bounds:trect);
  procedure update;
  procedure handleevent(var event:tevent);virtual;
  procedure press(item:integer);virtual;
 end;

const
 minpanelsize:tpoint=(x:8;y:3);
type
 ppanel=^tpanel;
 tpanel=object(tdialog)
  constructor init(var bounds:trect;atitle:ttitlestr);
  procedure sizelimits(var min,max:tpoint);virtual;
  procedure zoom;virtual;
 end;

type
 pstatuspanel=^tstatuspanel;
 tstatuspanel=object(tpanel)
  constructor init;
 end;

implementation
 uses app;

constructor tidleview.init;
begin
 tview.init(bounds);
 fillchar(lastidle,sizeof(lastidle),#$FF);
 eventmask:=eventmask or evbroadcast
end;

procedure tidleview.update;
begin
 drawview
end;

procedure tidleview.handleevent;
begin
 tview.handleevent(event);
 if (event.what=evbroadcast) and (event.command=cmidle)
  then begin
   lastidle:=pidlewhen(event.infoptr)^;
   update
  end
end;

{}

constructor tidleclock.init;
begin
 tidleview.init(bounds);
 lastsec:=$FF;
 refresh:=$01
end;

procedure tidleclock.draw;
var
 b:tdrawbuffer;
 c:byte;
begin
 lastsec:=lastidle.sec;
 c:=getcolor(2);
 movechar(b,' ',c,size.x);
 movestr(b,timestr,c);
 writeline(0,0,size.x,1,b)
end;

procedure tidleclock.update;
 function leadingzero(w:word):string;
 var
  s:string;
 begin
  str(w:0,s); leadingzero:=copy('00',1,2-length(s))+s
 end;
begin
 if(abs(lastidle.sec-lastsec)<refresh) then exit;
 with lastidle do
  timestr:=leadingzero(hour)+':'+leadingzero(min)+':'+leadingzero(sec);
 drawview
end;

{}

procedure tidleheap.draw;
var
 s:string;
 b:tdrawbuffer;
 c:byte;
begin
 oldmem:=memavail;
 str(oldmem:size.x,s);
 c:=getcolor(2);
 movechar(b,' ',c,size.x);
 movestr(b,s,c);
 writeline(0,0,size.x,1,b)
end;

procedure tidleheap.update;
begin
 if (oldmem<>memavail) then drawview
end;

{}

var
 shiftstate:byte absolute $40:$17;

procedure tkbcheckbox.conform;
var
 nowstate:word;
begin
 nowstate:=shiftstate shr 4;
 setdata(nowstate)
end;

constructor tkbcheckbox.init;
begin
 tcheckboxes.init(bounds,
  newsitem('Scroll Lock',
  newsitem('Num Lock',
  newsitem('Caps Lock',
  newsitem('Ins Mode',
  nil)))) );
 eventmask:=eventmask or evbroadcast;
 helpctx:=$F000; {force out of range for standard hints.}
 conform
end;

procedure tkbcheckbox.update;
begin
 conform;
 drawview
end;

procedure tkbcheckbox.handleevent;
begin
 tcheckboxes.handleevent(event);
 if (event.what=evbroadcast) and (event.command=cmidle)
  then update
end;

procedure tkbcheckbox.press;
begin
 tcheckboxes.press(item);
 case item of
  0:shiftstate:=shiftstate xor kbscrollstate;
  1:shiftstate:=shiftstate xor kbnumstate;
  2:shiftstate:=shiftstate xor kbcapsstate;
  3:shiftstate:=shiftstate xor kbinsstate
 end
end;

{}

constructor tpanel.init;
begin
 tdialog.init(bounds,atitle);
 setstate(sfshadow,false);
 flags:=flags or wfzoom
end;

procedure tpanel.sizelimits;
begin
 tdialog.sizelimits(min,max);
 min:=minpanelsize
end;

procedure tpanel.zoom;
begin
 if (origin.x=0) and (origin.y=0)
  then moveto(zoomrect.a.x,zoomrect.a.y)
  else begin
   zoomrect.assign(origin.x,origin.y,origin.x+size.x,origin.y+size.y);
   moveto(0,0)
  end
end;

{}

constructor tstatuspanel.init;
var
 r:trect;
begin
 desktop^.getextent(r);
 r.a.x:=r.b.x-20;
 r.a.y:=r.b.y-02;
 inc(r.b.y,5);

 tpanel.init(r,'');
  r.assign(1,1,9,2);
 insert(new(pidleclock,init(r)));
  inc(r.a.x,10); inc(r.b.x,10);
 insert(new(pidleheap,init(r)));
  r.assign(1,2, 19,6);
 insert(new(pkbcheckbox,init(r)))
end;

{}

end.