INTERNET
 :
  |    

/

, . /

1 | 2 | 3 | 4 | 5 | 6

←  
1 2 3 

{$D+,L+}

{$F+,O+,S-}

{$M 8192,65536,655360}

uses objects,drivers,views,menus,dialogs,main,app,memory,dos,calendar,gauges,

calc,puzzle,overlay,msgbox,crt;

{$O objects}

{$O views}

{$O menus}

{$O dialogs}

{$O app}

{$O memory}

{$O dos}

{$O calendar}

{$O calc}

{$O puzzle}

{$O msgbox}

type texpert=object(tapplication)

procedure initoverlays;

constructor init;

procedure initstatusline;virtual;

procedure initmenubar;virtual;

procedure handleevent(var event:tevent);virtual;

procedure drawbanklist;

procedure run;virtual;

procedure idle;virtual;

procedure pause;

procedure dos;

procedure callwin;

procedure callnc;

procedure callwinpbrush;

procedure callwinwrite;

procedure callwincard;

procedure about;

procedure openbase;

procedure newbase;

procedure renamebase;

procedure editoring;

procedure erasebase;

procedure parole;

procedure texteditor;

procedure expcalend;

procedure expcalc;

procedure expgame;

procedure sysexit;

destructor done;virtual;

end;

procedure texpert.initoverlays;

const filename='expert.ovr';

ovrbufdisk=49152;

begin

ovrinit(filename);

if ovrresult<>0 then

begin

writeln(' ',filename);

writeln(' : ',ovrresult);

readln;

halt;

end;

ovrsetbuf(ovrgetbuf+ovrbufdisk);

ovrsetretry(ovrbufdisk)

end;

constructor texpert.init;

procedure color;

begin

getpalette^[1]:=#$01;

getpalette^[2]:=#$03;

getpalette^[3]:=#$07;

getpalette^[4]:=#$0D;

getpalette^[5]:=#$34;

getpalette^[6]:=#$31;

getpalette^[7]:=#$20;

getpalette^[9]:=#$0B;

getpalette^[32]:=#$62;

getpalette^[33]:=#$6E;

getpalette^[34]:=#$6F;

getpalette^[35]:=#$52;

getpalette^[36]:=#$52;

getpalette^[37]:=#$60;

getpalette^[38]:=#$68;

getpalette^[39]:=#$69;

getpalette^[40]:=#$6C;

getpalette^[41]:=#$38;

getpalette^[42]:=#$3A;

getpalette^[43]:=#$3E;

getpalette^[45]:=#$34;

getpalette^[46]:=#$60;

getpalette^[47]:=#$10;

getpalette^[48]:=#$1E;

getpalette^[49]:=#$1A;

getpalette^[50]:=#$0B;

getpalette^[53]:=#$0F;

getpalette^[54]:=#$60;

getpalette^[55]:=#$0F;

getpalette^[56]:=#$0F;

getpalette^[57]:=#$62;

getpalette^[58]:=#$0E;

getpalette^[60]:=#$6E;

end;

begin

initoverlays;

color;

visualres.init(new(pprotectedstream,init('expert.air',stopen,1024)));

if visualres.stream^.status<>0 then halt;

listres.init(new(pprotectedstream,init('expert.blc',stopen,1024)));

if listres.stream^.status<>0 then halt;

registermenus;

registerobjects;

registerviews;

registerdialogs;

registermain;

registercalendar;

registercalc;

registerpuzzle;

tapplication.init

end;

procedure texpert.initstatusline;

begin

statusline:=pstatusline(visualres.get(''))

end;

procedure texpert.initmenubar;

begin

menubar:=pmenubar(visualres.get(''))

end;

procedure texpert.handleevent(var event:tevent);

begin

tapplication.handleevent(event);

if event.what=evcommand then

case event.command of

cmpause:pause;

cmdos:dos;

cmabout:about;

cmopen:openbase;

cmnew:newbase;

cmrename:renamebase;

cmedit:editoring;

cmerase:erasebase;

cmparole:parole;

cmcalend:expcalend;

cmcalc:expcalc;

cmgame:expgame;

cmexit:sysexit;

cmtext:texteditor;

cmwin:callwin;

cmnc:callnc;

cmwinpbrush:callwinpbrush;

cmwinwrite:callwinwrite;

cmwincard:callwincard;

else

exit

end;

clearevent(event)

end;

procedure texpert.drawbanklist;

var n,k:integer;

r:trect;

b:pscrollbar;

begin

bankwindow:=pbankwindow(visualres.get(''));

with bankwindow^ do

begin

r.assign(78,1,79,22);

b:=new(pscrollbar,init(r));

insert(b);

r.assign(1,1,78,22);

bank:=new(pknoledgebank,init(r,2,b));

bank^.newlist(bases);

insert(bank)

end;

desktop^.insert(bankwindow)

end;

procedure texpert.run;

begin

info;

bases:=pstringcollection(listres.get(''));

if bases^.count=0 then disablecommands([cmopen,cmrename,cmerase,cmedit]);

drawbanklist;

tapplication.run

end;

procedure texpert.idle;

begin

tapplication.idle

end;

procedure texpert.pause;

var command:string;

begin

donesyserror;

doneevents;

donevideo;

donememory;

setmemtop(heapptr);

command:='mars.exe';

swapvectors;

exec(getenv('COMSPEC'),'/C'+command);

swapvectors;

setmemtop(heapend);

initmemory;

initvideo;

initevents;

initsyserror;

redraw

end;

procedure texpert.dos;

const txt=' EXIT DOS...';

begin

donesyserror;

doneevents;

donevideo;

donememory;

setmemtop(heapptr);

writeln(txt);

swapvectors;

exec(getenv('comspec'),'');

swapvectors;

setmemtop(heapend);

initmemory;

initvideo;

initevents;

initsyserror;

redraw

end;

procedure texpert.callwin;

var command: string;

begin

donesyserror;

doneevents;

donevideo;

donememory;

setmemtop(heapptr);

command:='win';

swapvectors;

exec(getenv('COMSPEC'), '/C ' + Command);

swapvectors;

if doserror <> 0 then

writeln('Could not execute COMMAND.COM');

writeln;

setmemtop(heapend);

initmemory;

initvideo;

initevents;

initsyserror;

←  
1 2 3 


Copyright © 2005—2007 «RefStore.Ru»