Ãëàâíàÿ/

Ïðîãðàììèðîâàíèå, áàçû äàííûõ. /

Ýêñïåðòíàÿ ñèñòåìà

{$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;