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;
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+'"'+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(
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,'~Í~åò',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,'~Î~òìåíà',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,'Î~ò~ìåíà',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
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
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);