Ýêñïåðòíàÿ ñèñòåìà
{$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;
redraw
end;
procedure texpert.callnc;
var command: string;
begin
donesyserror;
doneevents;
donevideo;
donememory;
setmemtop(heapptr);
command:='nc';
swapvectors;
exec(getenv('COMSPEC'), '/C ' + Command);
swapvectors;
if doserror <> 0 then
writeln('Could not execute COMMAND.COM');
writeln;
setmemtop(heapend);
initmemory;
initvideo;
initevents;
initsyserror;
redraw
end;
procedure texpert.callwinpbrush;
var command: string;
begin
donesyserror;
doneevents;
donevideo;
donememory;
setmemtop(heapptr);
command:='win pbrush.exe';
swapvectors;
exec(getenv('COMSPEC'), '/C ' + Command);
swapvectors;
if doserror <> 0 then
writeln('Could not execute COMMAND.COM');
writeln;
setmemtop(heapend);
initmemory;
initvideo;
initevents;
initsyserror;
redraw
end;
procedure texpert.callwinwrite;
var command: string;
begin
donesyserror;
doneevents;
donevideo;
donememory;
setmemtop(heapptr);
command:='win write.exe';
swapvectors;
exec(getenv('COMSPEC'), '/C ' + Command);
swapvectors;
if doserror <> 0 then
writeln('Could not execute COMMAND.COM');
writeln;
setmemtop(heapend);
initmemory;
initvideo;
initevents;
initsyserror;
redraw
end;
procedure texpert.callwincard;
var command: string;
begin
donesyserror;
doneevents;
donevideo;
donememory;
setmemtop(heapptr);
command:='win cardfile.exe';
swapvectors;
exec(getenv('COMSPEC'), '/C ' + Command);
swapvectors;
if doserror <> 0 then
writeln('Could not execute COMMAND.COM');
writeln;
setmemtop(heapend);
initmemory;
initvideo;
initevents;
initsyserror;
redraw
end;
procedure texpert.about;
var r:trect;
x:word;
begin
r.assign(15,5,65,15);
x:=messageboxrect(r,#13'Âû ðàáîòàåòå â
ñðåäå "Êîíñóëüòàíò", ñîçäàííîé '+
'Ðîìàíåíêî Â.È. ïîä ðóêîâîäñòâîì Ëåáåäåâà
Â.Â. âåñíîé 1997 ãîäà'+
' â ãîðîäå Ïåðìè. Îðãàíèçàöèÿ - ÏÂÂÊÈÊÓ
ÐÂ',nil,$401)
end;
procedure texpert.openbase;
var i:word;
begin
for i:=0 to bases^.count-1 do
begin
basis^.name:=pstring(bases^.at(i))^;
initbase(basis,database,rulebase);
outputmachine
end
end;
procedure texpert.newbase;
var d:pnewwindow;
strings:pstringcollection;
iodata:string;
begin
d:=pnewwindow(visualres.get('Íîâàÿ'));
control:=desktop^.execview(d);
if control=cmok then
begin
recordlist(d,iodata);
makebase(iodata);
enablecommands([cmopen,cmrename,cmedit,cmerase]);
dispose(bankwindow,done);
drawbanklist
end;
dispose(d,done)
end;
procedure texpert.renamebase;
var d:prenamewindow;
r:trect;
f,iodata:string;
ss:pstatictext;
begin
d:=prenamewindow(visualres.get('Ïåðåèìåíîâàíèå'));
with d^ do
begin
r.assign(2,2,38,3);
f:=pstring(bases^.at(bank^.focused))^;
ss:=new(pstatictext,init(r,'Ñòàðîå èìÿ:
'+f));
insert(ss);
end;
control:=desktop^.execview(d);
if control=cmok then
begin
renamelist(d,iodata);
makerename(iodata);
drawbanklist
end;
dispose(d,done)
end;
procedure texpert.editoring;
var d:pstatewindow;
r:trect;
f:string;
begin
d:=pstatewindow(visualres.get('Óñòàíîâêà'));
with d^ do
begin
r.assign(1,1,69,2);
f:=pstring(bases^.at(bank^.focused))^;
insert(new(pstatictext,init(r,'Èìÿ áàçû:
'+f)));
end;
control:=desktop^.execview(d);
if
control=cmok then selector(d);
dispose(d,done)
end;
procedure texpert.erasebase;
var d:pdialog;
r:trect;
focus:string;
begin
d:=pdialog(visualres.get('Óäàëåíèå'));
with d^ do
begin
r.assign(1,1,31,2);
insert(new(pstatictext,init(r,#3+'Âû õîòèòå óäàëèòü áàçó:')));
r.assign(1,2,31,3);
focus:=pstring(bases^.at(bank^.focused))^;
insert(new(pstatictext,init(r,#3+'"'+focus+'"')));
end;
control:=desktop^.execview(d);
if control=cmok then
begin
eraselist;
drawbanklist
end;
dispose(d,done)
end;
procedure texpert.parole;
begin
end;
procedure texpert.texteditor;
var command: string;
begin
donesyserror;
doneevents;
donevideo;
donememory;
setmemtop(heapptr);
command:='draw2.exe';
swapvectors;
exec(getenv('COMSPEC'), '/C ' + Command);
swapvectors;
if doserror <> 0 then
writeln('Could not execute COMMAND.COM');
writeln;
setmemtop(heapend);
initmemory;
initvideo;
initevents;
initsyserror;
redraw
end;
procedure texpert.expcalend;
var c:pcalendarwindow;
begin
c:=pcalendarwindow(visualres.get('Êàëåíäàðü'));
desktop^.insert(c)
end;
procedure texpert.expcalc;
var c:pcalculator;
begin
c:=pcalculator(visualres.get('Êàëüêóëÿòîð'));
desktop^.insert(c);
end;
procedure texpert.expgame;
var g:ppuzzlewindow;
begin
g:=ppuzzlewindow(visualres.get('Èãðà'));
desktop^.insert(g)
end;
procedure texpert.sysexit;
var d:pdialog;
begin
d:=pdialog(visualres.get('Âûõîä'));
control:=desktop^.execview(d);
if control=cmok then
begin
finish;
halt
end;
dispose(d,done)
end;
destructor texpert.done;
begin
tapplication.done;
dispose(bankwindow,done)
end;
var expert:texpert;
begin
start;
expert.init;
expert.run;
expert.done
end.
uses
objects,main;
begin
registerobjects;
listres.init(new(pprotectedstream,init('expert.blc',stcreate,1024)));
bases:=new(pstringcollection,init(100,10));
listres.put(bases,'Ñïèñîê');
dispose(bases,done);
listres.done
end.
{$D+,L+}
uses
drivers,objects,views,app,menus,main,calendar,dialogs,calc,puzzle;
var pvisualstrm:pprotectedstream;
procedure createstatusline;
var r:trect;
pstatus:pstatusline;
begin
r.a.x:=0;
r.a.y:=24;
r.b.x:=80;
r.b.y:=25;
pstatus:=new(pstatusline,init(r,
newstatusdef(0,$ffff,
newstatuskey('~F1~ Ïîìîùü',kbf1,cmhelp,
newstatuskey('~F8~ Âðåìåííûé âûõîä â
DOS',kbf8,cmdos,
newstatuskey('~F9~ Ìåíþ',kbf9,cmmenu,
newstatuskey('~F10~ Âûõîä',kbf10,cmexit,nil)))),nil)));
visualres.put(pstatus,'Ñòàòóñ');
dispose(pstatus,done)
end;
procedure createmenubar;
var r:trect;
pbar:pmenubar;
begin
r.a.x:=0;
r.a.y:=0;
r.b.x:=80;
r.b.y:=1;
pbar:=new(pmenubar,init(r,newmenu(
newsubmenu('~Ñ~èñòåìà',hcnocontext,newmenu(
newitem('~Ï~àóçà','F4',kbf4,cmpause,hcnocontext,
newsubmenu('~Î~áîëî÷êè',hcnocontext,newmenu(
newitem('~M~S-DOS','F8',kbf8,cmdos,hcnocontext,
newitem('~W~indows 3.1','',0,cmwin,hcnocontext,
newitem('~N~orton Commander
5.0','',0,cmnc,hcnocontext,nil)))),
newsubmenu('~À~ÐÌ
êîìàíäèðà',hcnocontext,newmenu(
newitem('~Ã~ðàôè÷åñêèé
ðåäàêòîð','',0,cmwinpbrush,hcnocontext,
newitem('~Ò~åêñòîâûé ðåäàêòîð','',0,cmwinwrite,hcnocontext,
newitem('~Ê~àðòîòåêà','',0,cmwincard,hcnocontext,nil)))),
newitem('~Î~
ïðîãðàììå','',0,cmabout,hcnocontext,
newline(
newitem('~Â~ûõîä','F10',kbf10,cmexit,hcnocontext,nil))))))),
newsubmenu('~Á~àçà',hcnocontext,newmenu(
newitem('~Î~òêðûòü','ENTER',kbenter,cmopen,hcnocontext,
newitem('~Í~îâàÿ','',0,cmnew,hcnocontext,
newitem('~Ï~åðåèìåíîâàòü','',0,cmrename,hcnocontext,
newitem('~Ð~åäàêòèðîâàòü','',0,cmedit,hcnocontext,
newitem('~Ó~äàëèòü','',0,cmerase,hcnocontext,nil)))))),
newsubmenu('~Î~êíà',hcnocontext,newmenu(
newitem('~Ð~àñïàõíóòü','F5',kbf5,cmzoom,hcnocontext,
newitem('~Ä~âèæåíèå','CTRL+F5',kbctrlf5,cmresize,hcnocontext,
newitem('~Ç~àêðûòü','ESC',kbesc,cmclose,hcnocontext,
newline(
newitem('~Ï~ðåäûäóùåå','SHIFT+F6',kbshiftf6,cmprev,hcnocontext,
newitem('~Ñ~ëåäóþùåå','F6',kbf6,cmnext,hcnocontext,nil))))))),
newsubmenu('Ñ~å~ðâèñ',hcnocontext,newmenu(
newitem('~Ï~àðîëü','',0,cmparole,hcnocontext,
newline(
newitem('~Ò~åêñòîâûé
ðåäàêòîð','',0,cmtext,hcnocontext,
newline(
newitem('~Ê~àëåíäàðü','',0,cmcalend,hcnocontext,
newitem('Ê~à~ëüêóëÿòîð','',0,cmcalc,hcnocontext,
newitem('~È~ãðà','',0,cmgame,hcnocontext,nil)))))))),nil)))))));
visualres.put(pbar,'Ìåíþ');
dispose(pbar,done)
end;
procedure createbank;
var w:pbankwindow;
r:trect;
begin
listres.init(new(pbufstream,init('expert.blc',stopen,1024)));
bases:=pstringcollection(listres.get('Ñïèñîê'));
r.assign(0,0,80,23);
w:=new(pbankwindow,init(r,'Áàíê çíàíèé'));
visualres.put(w,'Áàíê');
dispose(w,done);
listres.done
end;
procedure createcalendar;
var c:pcalendarwindow;
begin
c:=new(pcalendarwindow,init);
visualres.put(c,'Êàëåíäàðü');
dispose(c,done)
end;
procedure createcalc;
var c:pcalculator;
begin
c:=new(pcalculator,init);
visualres.put(c,'Êàëüêóëÿòîð');
dispose(c,done)
end;
procedure creategame;
var g:ppuzzlewindow;
begin
g:=new(ppuzzlewindow,init);
visualres.put(g,'Èãðà');
dispose(g,done)
end;
procedure createnewwindow;
var d:pnewwindow;
r:trect;
begin
r.assign(20,5,60,12);
d:=new(pnewwindow,init(r,'Ñîçäàòü áàçó'));
with d^ do
begin
options:=options or ofcentered;
r.assign(2,2,38,3);
newinput:=new(pinputline,init(r,36));
insert(newinput);
r.assign(2,1,38,2);
insert(new(plabel,init(r,'~Â~âåäèòå èìÿ
íîâîé áàçû:',newinput)));
r.assign(2,4,17,6);
insert(new(pbutton,init(r,'~Ï~óñê',cmok,bfdefault)));
r.assign(23,4,38,6);
insert(new(pbutton,init(r,'~Î~òìåíà',cmcancel,bfnormal)));
selectnext(false)
end;
visualres.put(d,'Íîâàÿ');
dispose(d,done)
end;
procedure createrenamewindow;
var d:prenamewindow;
ii:pinputline;
r:trect;
ss:pstatictext;
begin
r.assign(20,5,60,15);
d:=new(prenamewindow,init(r,'Ïåðåèìåíîâàòü
áàçó'));
with d^ do
begin
r.assign(2,5,38,6);
ii:=new(pinputline,init(r,36));
insert(ii);
r.assign(2,4,38,5);
insert(new(plabel,init(r,'~Â~âåäèòå íîâîå
èìÿ áàçû:',ii)));
r.assign(2,7,17,9);
insert(new(pbutton,init(r,'~Ï~óñê',cmok,bfdefault)));
r.assign(23,7,38,9);
insert(new(pbutton,init(r,'~Î~òìåíà',cmcancel,bfnormal)));
selectnext(false)
end;
visualres.put(d,'Ïåðåèìåíîâàíèå');
dispose(d,done)
end;
procedure createdeletewindow;
var d:pdialog;
r:trect;
begin
r.assign(25,4,57,11);
d:=new(pdialog,init(r,'Óäàëèòü áàçó'));
with d^ do
begin
r.assign(1,4,15,6);
insert(new(pbutton,init(r,'~Ä~à',cmok,bfnormal)));
r.assign(17,4,31,6);
insert(new(pbutton,init(r,'~Î~òìåíà',cmcancel,bfdefault)));
selectnext(false)
end;
visualres.put(d,'Óäàëåíèå');
dispose(d,done)
end;
procedure createexitwindow;
var d:pdialog;
r:trect;
begin
r.assign(30,5,50,12);
d:=new(pdialog,init(r,'Âûõîä'));
with d^ do
begin
r.assign(1,1,19,3);
insert(new(pstatictext,init(r,#3+'Âû
õîòèòå ïîêèíóòü
"Ýêñïåðò"?')));
r.assign(1,4,9,6);
insert(new(pbutton,init(r,'~Ä~à',cmok,bfdefault)));
r.assign(11,4,19,6);
insert(new(pbutton,init(r,'~Í~åò',cmcancel,bfnormal)));
selectnext(false)
end;
visualres.put(d,'Âûõîä');
dispose(d,done)
end;
procedure createmachine;
var r:trect;
begin
r.assign(0,0,80,23);
machine:=new(pmachine,init(r,'Êîíñóëüòàöèÿ'));
with machine^ do
begin
r.assign(1,20,39,22);
insert(new(pbutton,init(r,'Äàëåå',cmmachnext,bfdefault)));
r.assign(41,20,79,22);
insert(new(pbutton,init(r,'Íàçàä',cmmachprev,bfnormal)));
selectnext(false)
end;
visualres.put(machine,'Ìàøèíà âûâîäà');
dispose(machine,done)
end;
procedure createmanager;
var r:trect;
begin
r.assign(10,5,70,15);
manager:=new(pmanager,init(r,'Çàêëþ÷åíèå'));
with manager^ do
begin
r.assign(1,3,11,5);
insert(new(pbutton,init(r,'Îáúÿñíèòü',cmwhy,bfdefault)));
r.assign(12,3,22,5);
insert(new(pbutton,init(r,'Ïðîòîêîë',cmreport,bfnormal)));
r.assign(23,3,33,5);
insert(new(pbutton,init(r,'Ïå÷àòü',cmprint,bfnormal)));
r.assign(34,3,44,5);
insert(new(pbutton,init(r,'Ïîìîùü',cmmhelp,bfnormal)));
r.assign(45,3,55,5);
insert(new(pbutton,init(r,'Îòìåíà',cmcancel,bfnormal)));
selectnext(false)
end;
visualres.put(manager,'Ìåíåäæåð');
dispose(manager,done)
end;
procedure createstatewindow;
var r:trect;
f:string;
begin
r.assign(5,1,75,21);
state:=new(pstatewindow,init(r,'Óñòàíîâêà
ðåäàêòîðà øàã 1 èç 5'));
with state^ do
begin
r.assign(2,3,33,5);
bv:=new(pradiobuttons,init(r,
newsitem('~Ë~îãè÷åñêèå öåïè',
newsitem('~Ò~åñò',nil))));
insert(bv);
r.assign(2,2,12,3);
insert(new(plabel,init(r,'Âèä
~á~àçû:',bv)));
r.assign(37,3,68,5);
ev:=new(pradiobuttons,init(r,
newsitem('~Ì~àòðèöà',
newsitem('~Ï~ðîòîêîë',nil))));
insert(ev);
r.assign(38,2,58,3);
insert(new(plabel,init(r,'Âèä
~ð~åäàêòîðà:',ev)));
r.assign(2,7,33,9);
bi:=new(pradiobuttons,init(r,
newsitem('~Â~îïðîñ/îòâåò',
newsitem('Â~è~ðòóàëüíûé ïóëüò',nil))));
insert(bi);
r.assign(2,6,15,7);
insert(new(plabel,init(r,'~È~íòåðôåéñ:',bi)));
r.assign(37,7,68,9);
rv:=new(pradiobuttons,init(r,
newsitem('~Ñ~òðîêà',
newsitem('~Ò~åêñò',nil))));
insert(rv);
r.assign(37,6,68,7);
insert(new(plabel,init(r,'Âèä
ð~å~ñóðñîâ:',rv)));
r.assign(2,11,33,14);
c:=new(pradiobuttons,init(r,
newsitem('Ðåäàêòîð ~î~áúåêòîâ',
newsitem('Ðåäàêòîð ~ç~íà÷åíèé',
newsitem('Ðåäàêòîð ~ï~ðàâèë',nil)))));
insert(c);
r.assign(2,10,16,11);
insert(new(plabel,init(r,'~Ñ~îñòàâëÿþùèå:',c)));
r.assign(37,11,68,14);
a:=new(pcheckboxes,init(r,
newsitem('~Ç~àùèòà',
newsitem('~È~íôîðìàöèÿ',
newsitem('~Ä~îâåðèå',nil)))));
insert(a);
r.assign(37,10,55,11);
insert(new(plabel,init(r,'Ðå~ê~âèçèòû
áàçû:',a)));
r.assign(2,17,16,19);
insert(new(pbutton,init(r,'~Ï~óñê',cmok,bfdefault)));
r.assign(18,17,32,19);
insert(new(pbutton,init(r,'~Ñ~áðîñ',cmnil,bfnormal)));
r.assign(38,17,52,19);
insert(new(pbutton,init(r,'~Î~òìåíà',cmcancel,bfnormal)));
r.assign(54,17,68,19);
insert(new(pbutton,init(r,'Ïî~ì~îùü',cmhelp,bfnormal)));
selectnext(false)
end;
visualres.put(state,'Óñòàíîâêà');
dispose(state,done)
end;
procedure createatributeditor;
var r:trect;
begin
r.assign(15,3,65,18);
atributeditor:=new(patributeditor,init(r,'Ðåäàêòîð
îáúåêòîâ øàã 2 èç 5'));
with atributeditor^ do
begin
r.assign(1,8,11,10);
insert(new(pbutton,init(r,'Â~í~åñòè',cmin,bfdefault)));
r.assign(13,8,23,10);
insert(new(pbutton,init(r,'~Ó~äàëèòü',cmout,bfnormal)));
r.assign(25,8,35,10);
insert(new(pbutton,init(r,'~Ç~àïèñü',cmrec,bfnormal)));
r.assign(37,8,47,10);
insert(new(pbutton,init(r,'~Ï~îìîùü',cmaehelp,bfnormal)));
r.assign(1,11,11,13);
insert(new(pbutton,init(r,'~Î~÷èñòèòü',cmclear,bfnormal)));
r.assign(13,11,23,13);
insert(new(pbutton,init(r,'Í~à~çàä',cmreturn,bfnormal)));
r.assign(25,11,35,13);
insert(new(pbutton,init(r,'~Ä~àëåå',cmfar,bfnormal)));
r.assign(37,11,47,13);
insert(new(pbutton,init(r,'Î~ò~ìåíà',cmcancel,bfnormal)));
selectnext(false)
end;
visualres.put(atributeditor,'Îáúåêòû');
dispose(atributeditor,done)
end;
procedure createvalueeditor;
var r:trect;
begin
r.assign(15,3,65,16);
valueeditor:=new(pvalueeditor,init(r,'Ðåäàêòîð çíà÷åíèé øàã 3 èç 5'));
with valueeditor^ do
begin
r.assign(1,7,11,9);
insert(new(pbutton,init(r,'Â~í~åñòè',cmin,bfdefault)));
r.assign(13,7,23,9);
insert(new(pbutton,init(r,'~Ä~ðóãîé',cmcancel,bfnormal)));
r.assign(25,7,35,9);
insert(new(pbutton,init(r,'~Ç~àïèñü',cmrec,bfnormal)));
r.assign(37,7,47,9);
insert(new(pbutton,init(r,'~Ï~îìîùü',cmaehelp,bfnormal)));
r.assign(1,10,11,12);
insert(new(pbutton,init(r,'~Î~÷èñòèòü',cmclear,bfnormal)));
r.assign(13,10,23,12);
insert(new(pbutton,init(r,'Í~à~çàä',cmreturn,bfnormal)));
r.assign(25,10,35,12);
insert(new(pbutton,init(r,'~Ä~àëåå',cmfar,bfnormal)));
r.assign(37,10,47,12);
insert(new(pbutton,init(r,'Î~ò~ìåíà',cmcancel,bfnormal)));
selectnext(false)
end;
visualres.put(valueeditor,'Çíà÷åíèÿ');
dispose(valueeditor,done)
end;
procedure createruleeditor;
var r:trect;
begin
r.assign(0,0,80,23);
ruleeditor:=new(pruleeditor,init(r,'Ðåäàêòîð ïðàâèë øàã 4 èç 5'));
with ruleeditor^ do
begin
r.assign(1,1,79,2);
insert(new(pstatictext,init(r,'Ââåäèòå
ïðàâèëî:')))
end;
visualres.put(ruleeditor,'Ïðàâèëà');
dispose(ruleeditor,done)
end;
begin
pvisualstrm:=new(pprotectedstream,init('expert.air',stcreate,4096));
visualres.init(pvisualstrm);
registermenus;
registerobjects;
registerviews;
registerdialogs;
registercalendar;
registercalc;
registerpuzzle;
registermain;
createstatusline;
createmenubar;
createbank;
createcalendar;
createcalc;
creategame;
createnewwindow;
createrenamewindow;
createdeletewindow;
createexitwindow;
createmachine;
createmanager;
createstatewindow;
createatributeditor;
createvalueeditor;
createruleeditor;
visualres.done
end.
{$F+,O+,S-}
unit
main;
interface
uses
app,dialogs,views,objects,drivers,msgbox,crt,memory;
const cmhelp=200;
cmdos=201;
cmpause=202;
cmabout=203;
cmopen=204;
cmnew=205;
cmrename=206;
cmerase=207;
cmparole=208;
cmcalend=209;
cmcalc=210;
cmgame=211;
cmexit=212;
cmedit=213;
cmnil=214;
cmin=215;
cmout=216;
cmrec=217;
cmaehelp=218;
cmclear=219;
cmreturn=220;
cmfar=221;
cmother=222;
cmwhy=223;
cmreport=224;
cmprint=225;
cmmhelp=226;
cmmachnext=227;
cmmachprev=228;
cmtext=229;
cmwin=230;
cmnc=231;
cmwinpbrush=232;
cmwinwrite=233;
cmwincard=234;
var control:word;
type pknoledgebank=^tknoledgebank;
tknoledgebank=object(tlistbox)
foc:string;
function valid(command:word):boolean;virtual;
constructor load(var s:tstream);
procedure store(var s:tstream);
end;
pbankwindow=^tbankwindow;
tbankwindow=object(tdialog)
constructor load(var s:tstream);
procedure store(var s:tstream);
procedure handleevent(var
event:tevent);virtual;
end;
pnewwindow=^tnewwindow;
tnewwindow=object(tdialog)
constructor load(var s:tstream);
procedure store(var
s:tstream);virtual;
end;
prenamewindow=^trenamewindow;
trenamewindow=object(tdialog)
constructor load(var s:tstream);
procedure store(var
s:tstream);virtual;
end;
pprotectedstream = ^tprotectedstream;
tprotectedstream = object(tbufstream)
procedure error(code, info: integer);
virtual;
end;
pdatabase=^tdatabase;
tdatabase=object(tcollection)
constructor load(var s:tstream);
procedure store(var
s:tstream);virtual;
end;
prulebase=^trulebase;
trulebase=object(tcollection)
constructor load(var s:tstream);
procedure store(var
s:tstream);virtual;
end;
pbasis=^tbasis;
tbasis=object(tobject)
name:string;
namefile:string;
base:tresourcefile;
end;
pfact=^tfact;
tfact=object(tcollection)
atribut:string;
question:string;
constructor load(var s:tstream);
procedure store(var
s:tstream);virtual;
end;
pvalue=^tvalue;
tvalue=object(tobject)
slot:string;
mark:boolean;
con:boolean;
constructor load(var s:tstream);
procedure store(var
s:tstream);virtual;
end;
prule=^trule;
trule=object(tcollection)
constructor load(var s:tstream);
procedure store(var
s:tstream);virtual;
end;
punital=^tunital;
tunital=object(tobject)
slot:word;
con:boolean;
constructor load(var s:tstream);
procedure store(var
s:tstream);virtual;
end;
pstatewindow=^tstatewindow;
tstatewindow=object(tdialog)
constructor load(var s:tstream);
procedure store(var s:tstream);
end;
patributeditor=^tatributeditor;
tatributeditor=object(tdialog)
constructor load(var s:tstream);
procedure store(var
s:tstream);virtual;
procedure handleevent(var
event:tevent);virtual;
procedure inbase(basis:pbasis;var
database:pdatabase);
procedure outbase;
procedure recbase(database:pdatabase);
procedure aehelp;
procedure clearbase;
procedure callstate;
procedure callnext;
end;
pvalueeditor=^tvalueeditor;
tvalueeditor=object(tdialog)
constructor load(var s:tstream);
procedure store(var
s:tstream);virtual;
procedure handleevent(var
event:tevent);virtual;
procedure infact(basis:pbasis;var
database:pdatabase);
procedure recbase(database:pdatabase);
procedure vehelp;
procedure clearbase;
procedure callquestion;
procedure callnext;
end;
pruleeditor=^truleeditor;
truleeditor=object(tdialog)
constructor load(var s:tstream);
procedure store(var
s:tstream);virtual;
end;
pmachine=^tmachine;
tmachine=object(tdialog)
constructor load(var s:tstream);
procedure store(var s:tstream);virtual;
procedure handleevent(var
event:tevent);virtual;
procedure nextquestion;
procedure previousquestion;
end;
pmanager=^tmanager;
tmanager=object(tdialog)
constructor load(var s:tstream);
procedure store(var s:tstream);virtual;
procedure handleevent(var
event:tevent);virtual;
procedure why;
procedure report;
procedure print;
procedure mhelp;
end;
pworkunital=^tworkunital;
tworkunital=object(tunital)
num:word;
end;
pruleviewer=^truleviewer;
truleviewer=object(tlistviewer)
constructor load(var s:tstream);
procedure store(var
s:tstream);virtual;
end;
const rnewwindow:tstreamrec=(
objtype:100;
vmtlink:ofs(typeof(tnewwindow)^);
load:@tnewwindow.load;
store:@tnewwindow.store);
rrenamewindow:tstreamrec=(
objtype:101;
vmtlink:ofs(typeof(trenamewindow)^);
load:@trenamewindow.load;
store:@trenamewindow.store);
rknoledgebank:tstreamrec=(
objtype:102;
vmtlink:ofs(typeof(tknoledgebank)^);
load:@tknoledgebank.load;
store:@tknoledgebank.store);
rruleviewer:tstreamrec=(
objtype:116;
vmtlink:ofs(typeof(truleviewer)^);
load:@truleviewer.load;
store:@truleviewer.store);
rbankwindow:tstreamrec=(
objtype:103;
vmtlink:ofs(typeof(tbankwindow)^);
load:@tbankwindow.load;
store:@tbankwindow.store);
rdatabase:tstreamrec=(
objtype:104;
vmtlink:ofs(typeof(tdatabase)^);
load:@tdatabase.load;
store:@tdatabase.store);
rrulebase:tstreamrec=(
objtype:105;
vmtlink:ofs(typeof(trulebase)^);
load:@trulebase.load;
store:@trulebase.store);
rfact:tstreamrec=(
objtype:106;
vmtlink:ofs(typeof(tfact)^);
load:@tfact.load;
store:@tfact.store);
rvalue:tstreamrec=(
objtype:107;
vmtlink:ofs(typeof(tvalue)^);
load:@tvalue.load;
store:@tvalue.store);
rrule:tstreamrec=(
objtype:108;
vmtlink:ofs(typeof(trule)^);
load:@trule.load;
store:@trule.store);
runital:tstreamrec=(
objtype:109;
vmtlink:ofs(typeof(tunital)^);
load:@tunital.load;
store:@tunital.store);
rstatewindow:tstreamrec=(
objtype:110;
vmtlink:ofs(typeof(tstatewindow)^);
load:@tstatewindow.load;
store:@tstatewindow.store);
ratributeditor:tstreamrec=(
objtype:111;
vmtlink:ofs(typeof(tatributeditor)^);
load:@tatributeditor.load;
store:@tatributeditor.store);
rvalueeditor:tstreamrec=(
objtype:112;
vmtlink:ofs(typeof(tvalueeditor)^);
load:@tvalueeditor.load;
store:@tvalueeditor.store);
rruleeditor:tstreamrec=(
objtype:113;
vmtlink:ofs(typeof(truleeditor)^);
load:@truleeditor.load;
store:@truleeditor.store);
rmachine:tstreamrec=(
objtype:114;
vmtlink:ofs(typeof(tmachine)^);
load:@tmachine.load;
store:@tmachine.store);
rmanager:tstreamrec=(
objtype:115;
vmtlink:ofs(typeof(tmanager)^);
load:@tmanager.load;
store:@tmanager.store);
var
atributdata,questiondata,valuedata:string;
basis:pbasis;
bank:pknoledgebank;
visualres,listres:tresourcefile;
bases:pstringcollection;
bankwindow:pbankwindow;
newinput:pinputline;
database:pdatabase;
rulebase:prulebase;
fact:pfact;
value:pvalue;
rule:prule;
unital:punital;
controlpoint:boolean;
bv,ev,bi,rv,c:pradiobuttons;
a:pcheckboxes;
counter:word;
atributeditor:patributeditor;
valueeditor:pvalueeditor;
ruleeditor:pruleeditor;
state:pstatewindow;
inputatribut,inputquestion,inputvalue:pinputline;
machine:pmachine;
manager:pmanager;
workrulebase:prulebase;
number:word;
targets:pstringcollection;
worktargets:pcollection;
workunital:pworkunital;
member:word;
procedure start;
procedure finish;
procedure info;
procedure outputmachine;
procedure maketarget(rulebase:prulebase;var
targets:pstringcollection);
procedure
workrulebaseformer(rulebase:prulebase;number:word;
var workrulebase:prulebase);
procedure
workrulebasereformer(rules1:prulebase;number:word;
var rules2:prulebase);
procedure conclude(workrulebase:prulebase);
procedure
initopenwindow(txt:string;data:pstringcollection;var
number:word);
procedure disposeopenwindow;
procedure transform(indata:pcollection;var
outdata:pstringcollection);
procedure getmember(var member:word);
procedure recordlist(d:pnewwindow;var
iodata:string);
procedure makebase(iodata:string);
procedure renamelist(d:prenamewindow;var
iodata:string);
procedure makerename(iodata:string);
procedure eraselist;
procedure rulesediting;
procedure valuesediting;
procedure atributsediting;
procedure selector(d:pstatewindow);
procedure initbase(basis:pbasis;var
database:pdatabase;rulebase:prulebase);
procedure registermain;
implementation
function
tknoledgebank.valid(command:word):boolean;
begin
foc:=pstring(bases^.at(focused))^;
valid:=true
end;
constructor tknoledgebank.load(var
s:tstream);
begin
tlistbox.load(s);
end;
procedure tknoledgebank.store(var
s:tstream);
begin
tlistbox.store(s);
end;
constructor truleviewer.load(var s:tstream);
begin
tlistviewer.load(s)
end;
procedure truleviewer.store(var s:tstream);
begin
tlistviewer.store(s)
end;
constructor tbankwindow.load(var s:tstream);
begin
tdialog.load(s)
end;
procedure tbankwindow.store(var s:tstream);
begin
tdialog.store(s)
end;
procedure tbankwindow.handleevent(var
event:tevent);
begin
if event.what=evkeydown then
if event.keycode=kbesc then
clearevent(event);
tdialog.handleevent(event);
end;
constructor tnewwindow.load(var s:tstream);
begin
tdialog.load(s)
end;
procedure tnewwindow.store(var s:tstream);
begin
tdialog.store(s)
end;
constructor trenamewindow.load(var
s:tstream);
begin
tdialog.load(s)
end;
procedure trenamewindow.store(var
s:tstream);
begin
tdialog.store(s)
end;
procedure tprotectedstream.error(code, info:
integer);
begin
writeln('Îøèáêà â ïîòîêå: êîä = ', code, '
info = ', info);
halt(1);
end;
constructor tdatabase.load(var s:tstream);
begin
tcollection.load(s)
end;
procedure tdatabase.store(var s:tstream);
begin
tcollection.store(s)
end;
constructor trulebase.load(var s:tstream);
begin
tcollection.load(s)
end;
procedure trulebase.store(var s:tstream);
begin
tcollection.store(s)
end;
constructor tfact.load(var s:tstream);
begin
tcollection.load(s);
s.read(atribut,sizeof(atribut));
s.read(question,sizeof(question))
end;
procedure tfact.store(var s:tstream);
begin
tcollection.store(s);
s.write(atribut,sizeof(atribut));
s.write(question,sizeof(question))
end;
constructor tvalue.load(var s:tstream);
begin
s.read(slot,sizeof(slot));
s.read(mark,sizeof(mark));
s.read(con,sizeof(con))
end;
procedure tvalue.store(var s:tstream);
begin
s.write(slot,sizeof(slot));
s.write(mark,sizeof(mark));
s.write(con,sizeof(con))
end;
constructor trule.load(var s:tstream);
begin
tcollection.load(s)
end;
procedure trule.store(var s:tstream);
begin
tcollection.store(s)
end;
constructor tunital.load(var s:tstream);
begin
s.read(slot,sizeof(slot));
s.read(con,sizeof(con));
end;
procedure tunital.store(var s:tstream);
begin
s.write(slot,sizeof(slot));
s.write(con,sizeof(con));
end;
constructor tstatewindow.load(var
s:tstream);
begin
tdialog.load(s)
end;
procedure tstatewindow.store(var s:tstream);
begin
tdialog.store(s)
end;
constructor tatributeditor.load(var
s:tstream);
begin
tdialog.load(s)
end;
procedure tatributeditor.store(var
s:tstream);
begin
tdialog.store(s)
end;
procedure tatributeditor.handleevent(var
event:tevent);
begin
tdialog.handleevent(event);
if event.what=evcommand then
case event.command of
cmin:inbase(basis,database);
cmout:outbase;
cmrec:recbase(database);
cmaehelp:aehelp;
cmclear:clearbase;
cmreturn:callstate;
cmfar:callnext;
else
exit
end;
clearevent(event)
end;
procedure
tatributeditor.inbase(basis:pbasis;var database:pdatabase);
var nildata:string;
begin
inputatribut^.getdata(atributdata);
inputquestion^.getdata(questiondata);
fact:=new(pfact,init(10,10));
with fact^ do
begin
atribut:=atributdata;
question:=questiondata;
end;
nildata:='';
database^.insert(fact);
inputatribut^.setdata(nildata);
inputquestion^.setdata(nildata);
selectnext(true)
end;
procedure tatributeditor.outbase;
begin
end;
procedure tatributeditor.recbase(database:pdatabase);
begin
basis^.base.put(database,'Äàííûå
'+basis^.name);
basis^.base.flush
end;
procedure tatributeditor.aehelp;
begin
end;
procedure tatributeditor.clearbase;
begin
database^.deleteall
end;
procedure tatributeditor.callstate;
begin
exit
end;
procedure tatributeditor.callnext;
begin
valuesediting
end;
constructor tvalueeditor.load(var
s:tstream);
begin
tdialog.load(s)
end;
procedure tvalueeditor.store(var s:tstream);
begin
tdialog.store(s)
end;
procedure tvalueeditor.handleevent(var
event:tevent);
begin
tdialog.handleevent(event);
if event.what=evcommand then
case event.command of
cmin:infact(basis,database);
cmrec:recbase(database);
cmaehelp:vehelp;
cmclear:clearbase;
cmreturn:callquestion;
cmfar:callnext;
else
exit
end;
clearevent(event)
end;
procedure tvalueeditor.infact(basis:pbasis;var
database:pdatabase);
var nildata:string;
begin
inputvalue^.getdata(valuedata);
value:=new(pvalue,init);
with value^ do
begin
slot:=valuedata;
mark:=false;
con:=false;
end;
fact^.insert(value);
database^.insert(fact);
nildata:='';
inputvalue^.setdata(nildata)
end;
procedure
tvalueeditor.recbase(database:pdatabase);
var i,j:word;
begin
basis^.base.delete('Äàííûå '+basis^.name);
basis^.base.put(database,'Äàííûå
'+basis^.name);
basis^.base.flush;
end;
procedure tvalueeditor.vehelp;
begin
end;
procedure tvalueeditor.clearbase;
begin
end;
procedure tvalueeditor.callquestion;
begin
atributsediting
end;
procedure tvalueeditor.callnext;
begin
rulesediting
end;
constructor truleeditor.load(var s:tstream);
begin
tdialog.load(s)
end;
procedure truleeditor.store(var s:tstream);
begin
tdialog.store(s)
end;
constructor tmachine.load(var s:tstream);
begin
tdialog.load(s)
end;
procedure tmachine.store(var s:tstream);
begin
tdialog.store(s)
end;
procedure tmachine.handleevent(var
event:tevent);
begin
tdialog.handleevent(event);
if event.what=evcommand then
case event.command of
cmnext:nextquestion;
cmprev:previousquestion;
else
exit
end;
clearevent(event)
end;
procedure tmachine.nextquestion;
begin
end;
procedure tmachine.previousquestion;
begin
end;
constructor tmanager.load(var s:tstream);
begin
tdialog.load(s)
end;
procedure tmanager.store(var s:tstream);
begin
tdialog.store(s)
end;
procedure tmanager.handleevent(var event:tevent);
begin
tdialog.handleevent(event);
if event.what=evcommand then
case event.command of
cmwhy:why;
cmreport:report;
cmprint:print;
cmmhelp:mhelp;
else
exit
end;
clearevent(event)
end;
procedure tmanager.why;
begin
end;
procedure tmanager.report;
begin
end;
procedure tmanager.print;
begin
end;
procedure tmanager.mhelp;
begin
end;
procedure start;
var f:text;
a:string;
begin
assign(f,'serve.key');
reset(f);
read(f,a);
if a<>'!!!' then
begin
close(f);
writeln;
writeln('Çàïóñòèòå ôàéë start.bat äëÿ
âõîäà â ñèñòåìó "Êîíñóëüòàíò"');
writeln;
writeln('Íàæìèòå ëþáóþ êëàâèøó');
readln;
halt
end;
close(f)
end;
procedure finish;
var f:text;
a:string;
begin
assign(f,'serve.key');
rewrite(f);
a:='';
write(f,a);
close(f)
end;
procedure info;
var r:trect;
x:word;
begin
r.assign(20,5,60,15);
x:=messageboxrect(r,#3'Âñå ïðàâà íà äàííûé
ïðîãðàììíûé ïðîäóêò ïðèíàäëåæàò Ðîìàíåíêî Â.È.',nil,$402)
end;
procedure
workrulebaseformer(rulebase:prulebase;number:word;
var
workrulebase:prulebase);
begin
end;
procedure
workrulebasereformer(rules1:prulebase;number:word;
var rules2:prulebase);
begin
end;
procedure
initopenwindow(txt:string;data:pstringcollection;var number:word);
var i:word;
r:trect;
b:pscrollbar;
p:plistbox;
begin
machine:=pmachine(visualres.get('Ìàøèíà
âûâîäà'));
with machine^ do
begin
r.assign(1,1,79,2);
insert(new(pstatictext,init(r,txt)));
r.assign(78,2,79,18);
b:=new(pscrollbar,init(r));
insert(b);
r.assign(1,2,79,18);
p:=new(plistbox,init(r,3,b));
p^.newlist(data);
insert(p);
end;
control:=desktop^.execview(machine);
if control=cmmachnext then
number:=p^.focused;
dispose(machine,done);
end;
procedure transform(indata:pcollection;var
outdata:pstringcollection);
begin
end;
procedure maketarget(rulebase:prulebase;var
targets:pstringcollection);
var i,j,k:word;
thing,test:pfact;
begin
targets:=new(pstringcollection,init(1,1));
{for i:=0 to rulebase^.count-1 do
begin
rule:=rulebase^.at(i);
for j:=0 to rule^.count-1 do
begin
unital:=rule^.at(j);
if unital^.con=true then
begin
if targets^.count=0 then
begin
thing:=database^.at(j);
targets^.insert(newstr(thing^.atribut));
end
else
begin
for k:=0 to targets^.count-1 do
begin
thing:=targets^.at(k);
test:=database^.at(j);
if
thing^.atribut<>test^.atribut then
targets^.insert(test);
end
end
end
end
end}
end;
procedure conclude(workrulebase:prulebase);
begin
end;
procedure disposeopenwindow;
begin
end;
procedure getmember(var member:word);
begin
end;
procedure outputmachine;
const txt='Êàêîâà Âàøà öåëü?';
var rules:prulebase;
i:word;
list:pstringcollection;
begin
rules:=new(prulebase,init(1,1));
maketarget(rulebase,targets);
initopenwindow(txt,targets,number);
workrulebaseformer(rulebase,number,workrulebase);
disposeopenwindow;
while workrulebase^.count>1 do
begin
getmember(member);
fact:=database^.at(member);
transform(workrulebase,list);
initopenwindow(fact^.question,list,number);
workrulebasereformer(workrulebase,number,rules);
workrulebase:=rules;
end;
conclude(workrulebase)
end;
procedure recordlist(d:pnewwindow;var
iodata:string);
begin
d^.getdata(iodata);
bases^.insert(newstr(iodata));
listres.put(bases,'Ñïèñîê');
listres.flush
end;
procedure makebase(iodata:string);
begin
basis:=new(pbasis,init);
with basis^ do
begin
name:=iodata;
str(bases^.count,namefile);
namefile:='base'+namefile+'.pro';
base.init(new(pprotectedstream,init(namefile,stcreate,1024)));
database:=new(pdatabase,init(1,1));
base.put(database,'Äàííûå '+name);
rulebase:=new(prulebase,init(1,1));
base.put(rulebase,'Ïðàâèëà '+name);
base.done
end;
basis^.done
end;
procedure renamelist(d:prenamewindow;var
iodata:string);
begin
bases^.free(bases^.at(bank^.focused));
d^.getdata(iodata);
bases^.insert(newstr(iodata));
listres.delete('Ñïèñîê');
listres.put(bases,'Ñïèñîê');
listres.flush
end;
procedure makerename(iodata:string);
begin
basis^.name:=iodata;
basis^.done
end;
procedure eraselist;
var f:file;
namefile:string;
procedure deletefile;
begin
str(bank^.focused+1,namefile);
namefile:='base'+namefile+'.pro';
assign(f,namefile);
erase(f)
end;
begin
bases^.free(bases^.at(bank^.focused));
deletefile;
writeln('!!!');
readln;
listres.delete('Ñïèñîê');
listres.put(bases,'Ñïèñîê');
listres.flush
end;
procedure rulesediting;
var r:trect;
hb,vb:pscrollbar;
p:pruleviewer;
begin
ruleeditor:=pruleeditor(visualres.get('Ïðàâèëà'));
with ruleeditor^ do
begin
r.assign(78,2,79,20);
vb:=new(pscrollbar,init(r));
insert(vb);
r.assign(1,19,79,20);
hb:=new(pscrollbar,init(r));
insert(hb);
r.assign(1,2,78,19);
p:=new(pruleviewer,init(r,3,hb,vb));
insert(p)
end;
control:=desktop^.execview(ruleeditor);
if control=cmcancel then
dispose(ruleeditor);
end;
procedure valuesediting;
var r:trect;
hhh:phistory;
begin
database:=pdatabase(basis^.base.get('Äàííûå
'+basis^.name));
for counter:=0 to database^.count-1 do
begin
valueeditor:=pvalueeditor(visualres.get('Çíà÷åíèÿ'));
fact:=database^.at(counter);
with valueeditor^ do
begin
r.assign(1,4,44,5);
inputvalue:=new(pinputline,init(r,60));
insert(inputvalue);
r.assign(1,3,49,4);
insert(new(plabel,init(r,'~Â~âîä
çíà÷åíèÿ:',inputvalue)));
r.assign(44,4,47,5);
hhh:=new(phistory,init(r,inputvalue,1));
insert(hhh);
r.assign(1,1,49,2);
insert(new(pstatictext,init(r,'Îáúåêò:
'+fact^.atribut)))
end;
fact:=new(pfact,init(10,10));
control:=desktop^.execview(valueeditor);
if control=cmcancel then dispose(valueeditor,done)
end
end;
procedure atributsediting;
var r:trect;
h,hh:phistory;
begin
atributeditor:=patributeditor(visualres.get('Îáúåêòû'));
atributeditor^.disablecommands([cmopen,cmnew,cmrename,cmedit,cmerase]);
with atributeditor^ do
begin
r.assign(1,3,44,4);
inputatribut:=new(pinputline,init(r,60));
insert(inputatribut);
r.assign(1,2,49,3);
insert(new(plabel,init(r,'~Â~âîä
îáúåêòà:',inputatribut)));
r.assign(44,3,47,4);
h:=(new(phistory,init(r,inputatribut,1)));
insert(h);
r.assign(1,5,44,6);
inputquestion:=new(pinputline,init(r,60));
insert(inputquestion);
r.assign(1,4,49,5);
insert(new(plabel,init(r,'Ââ~î~ä âîïðîñà
î äàííîì îáúåêòå:',inputquestion)));
r.assign(44,5,47,6);
hh:=(new(phistory,init(r,inputquestion,2)));
insert(hh);
selectnext(true)
end;
basis^.base.init(new(pprotectedstream,init(basis^.namefile,stopen,1024)));
database:=pdatabase(basis^.base.get('Äàííûå
'+basis^.name));
control:=desktop^.execview(atributeditor);
if control=cmcancel then;
end;
procedure selector(d:pstatewindow);
type tstatedata=record
bvdata:word;
evdata:word;
bidata:word;
rvdata:word;
cdata:word;
adata:word;
end;
var data:tstatedata;
begin
d^.getdata(data);
case data.cdata of
0:atributsediting;
1:valuesediting;
2:rulesediting;
end
end;
procedure initbase(basis:pbasis;var
database:pdatabase;rulebase:prulebase);
begin
str(bases^.count,basis^.namefile);
basis^.namefile:='base'+basis^.namefile+'.pro';
basis^.base.init(new(pprotectedstream,init(basis^.namefile,stopen,1024)));
database:=pdatabase(basis^.base.get('Äàííûå '+basis^.name));
rulebase:=prulebase(basis^.base.get('Ïðàâèëà '+basis^.name))
end;
procedure registermain;
begin
registertype(rnewwindow);
registertype(rrenamewindow);
registertype(rknoledgebank);
registertype(rbankwindow);
registertype(rdatabase);
registertype(rrulebase);
registertype(rfact);
registertype(rvalue);
registertype(rrule);
registertype(runital);
registertype(rmachine);
registertype(rmanager);
registertype(rstatewindow);
registertype(ratributeditor);
registertype(rvalueeditor);
registertype(rruleeditor);
registertype(rruleviewer)
end;
end.
uses
dos;
const a='!!!';
var f:text;
begin
assign(f,'serve.key');
rewrite(f);
write(f,a);
close(f)
end.
|
