Добавил:
Studfiles2
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:Курсовой проект групп 3341 и 3382 / ExpertModule / Modul
.pasunit Modul;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, ExtCtrls, Buttons, ComCtrls,Instances,RuleItem,DmmTypes,
Grids, OleServer, Excel2000,ItemSet;
type
TElemSteck = Class {Описание класса элемента стека}
public
index: integer; //индекс
val:double; //значение
constructor Create(index1: integer;val1:double);
end;
TExpertMod = class(TForm)
Memo1: TMemo;
MainMenu1: TMainMenu;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
Panel1: TPanel;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Image1: TImage;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
ProgressBar1: TProgressBar;
Image3: TImage;
Label7: TLabel;
Panel2: TPanel;
Label8: TLabel;
Edit3: TEdit;
Label9: TLabel;
ListBox1: TListBox;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
BitBtn7: TBitBtn;
GreedAtr: TStringGrid;
OpenDialog1: TOpenDialog;
ExcelApplication1: TExcelApplication;
N1: TMenuItem;
N5: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
SaveDialog1: TSaveDialog;
BitBtn8: TBitBtn;
procedure N5Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure prbar(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
procedure ClickGreed(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure closeform(Sender: TObject; var Action: TCloseAction);
procedure BitBtn8Click(Sender: TObject);
private
{ Private declarations }
procedure PrintAttr(i:integer;inst1:TDMInstances);
procedure GreedAtrFull(inst1:TDMInstances);
public
{ Public declarations }
procedure Show(rul:TList;inst1:TDMInstances);
procedure otvet(index:integer);
procedure EnterAtr;
procedure TakeVal(n:integer;list:Tlist);
procedure takeSys(sys1:integer);
end;
var
ExpertMod: TExpertMod;
implementation
uses DmmConstants,logic,logic_str,MainForm;
{$R *.dfm}
var nom:integer; {номер последнего правила -для объяснений}
list_true_rules:TList; {список номеров доказанных правил -для объяснений}
Rules:TList;
inst:TDMInstances; {а это нужно позарез, так как инсты придется менять}
N: integer; {Количесиво уже введенных атрибутов}
OC:integer; {индекс основной цели, если она задана}
OC_name: AnsiString;
sys:integer; {Хранит состояние системы, для реализации подсказок}
{1-ввод первоначальных данных}
{2-выполнение логического вывода}
{3-результат получен}
constructor TElemSteck.Create(index1: integer;val1:double);
begin
index:=index1;
val:=val1;
end;
procedure TExpertMod.TakeSys(sys1:integer);
begin
sys:=sys1;
end;
{Процедура выводит значения i того атрибута на экран}
procedure TExpertMod.PrintAttr(i:integer;inst1:TDMInstances);
var j:integer;
begin
ExpertMod.Memo1.Lines.Add('');
{Имя атр в Edit}
ExpertMod.Edit1.Enabled:=true;
ExpertMod.Edit1.Text:=inst1.attribute(i).name;
ExpertMod.Edit1.Enabled:=false;
{Если значение введено,то его тоже в Edit}
ExpertMod.Edit2.Clear;
if inst1.instance(i).value(2)=1 then
begin
if inst1.attribute(i).attributeType=1 then ExpertMod.Edit2.Text:=FloatToStr(inst1.instance(i).value(1));
if inst1.attribute(i).attributeType=2 then ExpertMod.Edit2.Text:=inst1.attribute(i).value(round(inst1.instance(i).value(1)));
end;
{Если атрибут - основная цель}
if (ExpertMod.Edit1.Text=OC_name)and(OC_name<>'') then ExpertMod.Edit2.Text:='Основная цель';
{Метки типа атрибута}
ExpertMod.Label4.Visible:=false;
ExpertMod.Label5.Visible:=false;
if inst1.attribute(i).attributeType=1 then ExpertMod.Label4.Visible:=true;
if inst1.attribute(i).attributeType=2 then ExpertMod.Label5.Visible:=true;
{Возможные значения атрибутов}
if inst1.attribute(i).attributeType=1 then {Если атрибут числовой,}
begin
{Выводим значения верхней и нижней границ}
ExpertMod.Memo1.Lines.Add('Верхняя граница: '+inttostr(round(inst1.attribute(i).getLowerNumericBound)));
ExpertMod.Memo1.Lines.Add('Нижняя граница: '+inttostr(round(inst1.attribute(i).getUpperBumericBound)));
end;
if inst1.attribute(i).attributeType=2 then
begin
ExpertMod.Memo1.Lines.Add('Возможные значения: ');
for j:=0 to inst1.attribute(i).numValues-1 do {По всем запися в m_Values}
begin
// value:=inst1.attribute(i).value(j);
ExpertMod.Memo1.Lines.Add(inst1.attribute(i).value(j));
end;
end;
ExpertMod.Memo1.Lines.Add('');
{данные об общем количестве атрибутов}
if sys=1 then begin
ExpertMod.Memo1.Lines.Add('Общее количество атрибутов: '+inttostr(inst1.numAttributes));
ExpertMod.Memo1.Lines.Add('Номер текущего атрибута: '+inttostr(i+1));
ExpertMod.Memo1.Lines.Add('Введено значений атрибутов: '+inttostr(N));
end;
end;
{Открытие формы по процедуре с параметрами}
procedure TExpertMod.Show(rul:TList;inst1:TDMInstances);
var Dir: array [0..256] of Char;
begin
nom:=-1;
list_true_rules:=nil;
OC:=-1;
OC_name:='';
ExpertMod.Edit2.Text:='';
ExpertMod.Panel1.Visible:=true;
ExpertMod.Panel2.Visible:=false;
ExpertMod.Memo1.Clear;
sys:=1;
try
inst:= TDMInstances.Create(inst1);
try
inst.CleanupInstance;
Rules:=rul;
except
Application.MessageBox('Произошла ошибка при очистке массива атрибутов','Ошибка');
end;
except
Application.MessageBox('Произошла ошибка при создании копии массива атрибутов'+
#13+#10+'Попробуйте сначала загрузить данные из файла. Ж-)','Ошибка');
ExpertMod.Close;
end;
{Открытие панели ввода атрибутов}
N:=0;
ExpertMod.BitBtn1.Tag:=0; {Играет роль счетчика введенных атрибутов}
ExpertMod.Memo1.Lines.Add('Чтобы задать основную цель, Введите в качестве значения знак "!"');
ExpertMod.Memo1.Lines.Add('Общее количество атрибутов: '+inttostr(inst.numAttributes));
ExpertMod.Memo1.Lines.Add('Номер текущего атрибута: '+inttostr(ExpertMod.BitBtn1.Tag+1));
ExpertMod.Label4.Visible:=false;
ExpertMod.Label5.Visible:=false;
ExpertMod.Label6.Visible:=false;
ExpertMod.Image3.visible:=false;
ExpertMod.Label7.Visible:=false;
ExpertMod.BitBtn1.Default:=true;
ExpertMod.BitBtn7.Visible:=true;
{Выводит параметры первого атрибута}
PrintAttr(ExpertMod.BitBtn1.Tag,inst);
{инициализация таблицы}
GreedAtrFull(inst);
end;
{Процедурка на загрузку файла из Exel}
procedure TExpertMod.N5Click(Sender: TObject);
var file_name,s :String;
RangeMatrix:Variant;
X,Y,i,j:integer;
begin
if OpenDialog1.Execute then begin
file_name:=AnsiLowerCase(OpenDialog1.FileName);
try
ExpertMod.ExcelApplication1.Connect;
ExpertMod.ExcelApplication1.WorkBooks.Open(file_name,EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,EmptyParam,0);
X:=ExpertMod.GreedAtr.RowCount;
Y:=ExpertMod.GreedAtr.ColCount;
RangeMatrix := ExpertMod.ExcelApplication1.Range['A1',ExpertMod.ExcelApplication1.Cells.Item[X,Y]].Value;
for i:=1 to X do begin
for j:=0 to X-1 do begin
if Trim(AnsiLowerCase(RangeMatrix[i,1]))=Trim(AnsiLowerCase(ExpertMod.GreedAtr.Cells[0,j]))
then begin
ExpertMod.otvet(j-1);
if AnsiLowerCase(Trim(RangeMatrix[i,2]))='основная цель' then ExpertMod.Edit2.Text:='!'
else ExpertMod.Edit2.Text:=Trim(RangeMatrix[i,2]);
ExpertMod.BitBtn1.Click;
end;
end;
end;
except
Application.MessageBox('Не удается открыть файл','Сообщение',MB_OK+MB_ICONWARNING)
end;
end;
end;
{Процедура срабатывает при выборе пункта меню "Задачи / Ввести значения"
устанавливает значения компонентам}
procedure TExpertMod.N3Click(Sender: TObject);
begin
ExpertMod.BitBtn5.Click;
ExpertMod.Edit2.Text:='';
ExpertMod.Panel1.Visible:=true;
ExpertMod.Panel2.Visible:=false;
ExpertMod.Memo1.Clear;
{Открытие панели ввода атрибутов}
N:=0;
ExpertMod.BitBtn1.Tag:=0; {Играет роль счетчика введенных атрибутов}
ExpertMod.Memo1.Lines.Add('Чтобы задать основную цель, Введите в качестве значения знак "!"');
ExpertMod.Memo1.Lines.Add('Общее количество атрибутов: '+inttostr(inst.numAttributes));
ExpertMod.Memo1.Lines.Add('Номер текущего атрибута: '+inttostr(ExpertMod.BitBtn1.Tag+1));
ExpertMod.Label4.Visible:=false;
ExpertMod.Label5.Visible:=false;
ExpertMod.Label6.Visible:=false;
ExpertMod.Image3.visible:=false;
ExpertMod.Label7.Visible:=false;
ExpertMod.BitBtn1.Default:=true;
ExpertMod.BitBtn7.Visible:=true;
{Выводит параметры первого атрибута}
PrintAttr(ExpertMod.BitBtn1.Tag,inst);
end;
{Процедура срабатывает при выборе пункта меню "Задачи / Расчет"
должна запускать процедуру расчета}
procedure TExpertMod.N4Click(Sender: TObject);
var LR:TList;
R11,R22,R33,R44,R55:^TDMRuleItem;
R1,R2,R3,R4,R5:TDMRuleItem;
I1,J1,I2,J2,I3,J3,I4,J4,I5,J5:TDMItemSet;
a1,b1,c1,d1,a2,b2,c2,d2,a3,b3,c3,d3,a4,b4,c4,d4,a5,b5,c5,d5:IArray;
begin
ExpertMod.BitBtn1.Default:=false;
ExpertMod.ProgressBar1.Position:=ExpertMod.ProgressBar1.Min;
ExpertMod.Memo1.Clear;
ExpertMod.Memo1.Lines.Add('Производятся архигромоздкие вычисления...');
ExpertMod.Memo1.Lines.Add('Пожалуста пождите...');
ExpertMod.ProgressBar1.Visible:=true;
ExpertMod.BitBtn7.Visible:=true;
sys:=2;
{
//-----------------------------------------------
//-1
SetLength(a1,5);
SetLength(b1,5);
SetLength(c1,5);
SetLength(d1,5);
a1[0]:=0;c1[0]:=0;
b1[3]:=1;d1[3]:=0;
a1[1]:=IMIN_VALUE;c1[1]:=IMIN_VALUE;
a1[2]:=IMIN_VALUE;c1[2]:=IMIN_VALUE;
a1[3]:=IMIN_VALUE;c1[3]:=IMIN_VALUE;
a1[4]:=IMIN_VALUE;c1[4]:=IMIN_VALUE;
b1[0]:=IMIN_VALUE;d1[0]:=IMIN_VALUE;
b1[1]:=IMIN_VALUE;d1[1]:=IMIN_VALUE;
b1[2]:=IMIN_VALUE;d1[2]:=IMIN_VALUE;
b1[4]:=IMIN_VALUE;d1[4]:=IMIN_VALUE;
I1:=TDMItemSet.Create(a1,c1);
J1:=TDMItemSet.Create(b1,d1);
R1:=TDMRuleItem.Create(I1,J1);
new(R11);
R11^:=R1;
//-2
SetLength(a2,5);
SetLength(b2,5);
SetLength(c2,5);
SetLength(d2,5);
a2[1]:=10;c2[1]:=-1;
b2[0]:=0;d2[0]:=0;
a2[0]:=IMIN_VALUE;c2[0]:=IMIN_VALUE;
a2[2]:=IMIN_VALUE;c2[2]:=IMIN_VALUE;
a2[3]:=IMIN_VALUE;c2[3]:=IMIN_VALUE;
a2[4]:=IMIN_VALUE;c2[4]:=IMIN_VALUE;
b2[1]:=IMIN_VALUE;d2[1]:=IMIN_VALUE;
b2[2]:=IMIN_VALUE;d2[2]:=IMIN_VALUE;
b2[3]:=IMIN_VALUE;d2[3]:=IMIN_VALUE;
b2[4]:=IMIN_VALUE;d2[4]:=IMIN_VALUE;
I2:=TDMItemSet.Create(a2,c2);
J2:=TDMItemSet.Create(b2,d2);
R2:=TDMRuleItem.Create(I2,J2);
new(R22);
R22^:=R2;
//-3
SetLength(a3,5);
SetLength(b3,5);
SetLength(c3,5);
SetLength(d3,5);
a3[3]:=1;c3[3]:=0;
a3[2]:=5;c3[2]:=1;
b3[4]:=0;d3[4]:=0;
a3[0]:=IMIN_VALUE;c3[0]:=IMIN_VALUE;
a3[1]:=IMIN_VALUE;c3[1]:=IMIN_VALUE;
a3[4]:=IMIN_VALUE;c3[4]:=IMIN_VALUE;
b3[0]:=IMIN_VALUE;d3[0]:=IMIN_VALUE;
b3[1]:=IMIN_VALUE;d3[1]:=IMIN_VALUE;
b3[2]:=IMIN_VALUE;d3[2]:=IMIN_VALUE;
b3[3]:=IMIN_VALUE;d3[3]:=IMIN_VALUE;
I3:=TDMItemSet.Create(a3,c3);
J3:=TDMItemSet.Create(b3,d3);
R3:=TDMRuleItem.Create(I3,J3);
new(R33);
R33^:=R3;
//-4
SetLength(a4,5);
SetLength(b4,5);
SetLength(c4,5);
SetLength(d4,5);
a4[2]:=4;c4[2]:=-1;
b4[3]:=0;d4[3]:=0;
a4[0]:=IMIN_VALUE;c4[0]:=IMIN_VALUE;
a4[1]:=IMIN_VALUE;c4[1]:=IMIN_VALUE;
a4[3]:=IMIN_VALUE;c4[3]:=IMIN_VALUE;
a4[4]:=IMIN_VALUE;c4[4]:=IMIN_VALUE;
b4[0]:=IMIN_VALUE;d4[0]:=IMIN_VALUE;
b4[1]:=IMIN_VALUE;d4[1]:=IMIN_VALUE;
b4[2]:=IMIN_VALUE;d4[2]:=IMIN_VALUE;
b4[4]:=IMIN_VALUE;d4[4]:=IMIN_VALUE;
I4:=TDMItemSet.Create(a4,c4);
J4:=TDMItemSet.Create(b4,d4);
R4:=TDMRuleItem.Create(I4,J4);
new(R44);
R44^:=R4;
//-5
SetLength(a5,5);
SetLength(b5,5);
SetLength(c5,5);
SetLength(d5,5);
a5[3]:=0;c5[3]:=0;
a5[2]:=5;c5[2]:=-1;
b5[4]:=1;d5[4]:=0;
a5[0]:=IMIN_VALUE;c5[0]:=IMIN_VALUE;
a5[1]:=IMIN_VALUE;c5[1]:=IMIN_VALUE;
a5[4]:=IMIN_VALUE;c5[4]:=IMIN_VALUE;
b5[0]:=IMIN_VALUE;d5[0]:=IMIN_VALUE;
b5[1]:=IMIN_VALUE;d5[1]:=IMIN_VALUE;
b5[2]:=IMIN_VALUE;d5[2]:=IMIN_VALUE;
b5[3]:=IMIN_VALUE;d5[3]:=IMIN_VALUE;
I5:=TDMItemSet.Create(a5,c5);
J5:=TDMItemSet.Create(b5,d5);
R5:=TDMRuleItem.Create(I5,J5);
new(R55);
R55^:=R5;
//-----------------------------------------------
LR:=TList.Create;
LR.Clear;
LR.Add(R11);
LR.Add(R22);
LR.Add(R33);
LR.Add(R44);
LR.Add(R55);
Rules:=LR;
//-----------------------------------------------
}
try
//-----------------------------------------------
//Это запуск с передачей правил, пол. в рез. работы алгаритмов - рабочий
if OC<>-1 then logic.Execute_all(Rules,inst,OC)
else logic_str.Execute(Rules,inst);
except
ExpertMod.Memo1.Clear;
ExpertMod.Memo1.Lines.Add('Операция логического вывода выполнилась некорректно.');
ExpertMod.Memo1.Lines.Add('Возможно неправильно сформирован список правил.');
sys:=1;
end;
end;
{Процедура срабатывает в режиме ввода значений атрибутов
очищает поле значений}
procedure TExpertMod.BitBtn2Click(Sender: TObject);
begin
ExpertMod.Edit2.Text:='';
ExpertMod.Panel2.Visible:=true;
ExpertMod.Panel1.Visible:=false;
ExpertMod.ListBox1.Visible:=false;
ExpertMod.Panel2.Height:=150;
ExpertMod.BitBtn5.Visible:=true;
ExpertMod.BitBtn6.Click;
ExpertMod.BitBtn6.Visible:=false;
ExpertMod.BitBtn4.Top:=115;
ExpertMod.BitBtn3.Tag:=1;
end;
{Процедура срабатывает в режиме ввода значений атрибутов
вводит значение очередного атрибута}
procedure TExpertMod.EnterAtr;
var s,val_nom_str:string;
val_nom,correct,j,nom:integer;
val_num:Double;
begin
val_nom:=-1;
ExpertMod.Label7.Visible:=false;
ExpertMod.Memo1.Clear;
ExpertMod.Memo1.Lines.Add('****************************************');
//correct:=1;
if (ExpertMod.Edit2.Text='Основная цель') then ExpertMod.Edit2.Clear;
if (ExpertMod.edit2.Text='!')and(sys=1) then
begin
ExpertMod.Memo1.Lines.Add('Задана основная цель: ');
ExpertMod.Memo1.Lines.Add(ExpertMod.edit1.Text);
OC:=ExpertMod.BitBtn1.Tag; {Запомнили основную цель}
OC_name:=ExpertMod.Edit1.Text;
inst.instance(BitBtn1.Tag).setValue(2,0); {значит основная цель}
ExpertMod.BitBtn1.Tag:=ExpertMod.BitBtn1.Tag+1;
N:=N+1;
ExpertMod.Edit2.Clear;
{ Выводит параметры следующего атрибута}
if BitBtn1.Tag<inst.numAttributes then else BitBtn1.Tag:=0;
PrintAttr(ExpertMod.BitBtn1.Tag,inst);
end
else
begin {***}
if (ExpertMod.edit2.Text='')and(sys=1) then
begin
inst.instance(BitBtn1.Tag).setValue(2,2); {значит не задано значение}
ExpertMod.BitBtn1.Tag:=ExpertMod.BitBtn1.Tag+1;
ExpertMod.Edit2.Clear;
{ Выводит параметры следующего атрибута}
if BitBtn1.Tag<inst.numAttributes then else BitBtn1.Tag:=0;
PrintAttr(ExpertMod.BitBtn1.Tag,inst);
end
else
begin {**}
{Проверка введенного значения атрибута}
{числового}
if inst.attribute(ExpertMod.BitBtn1.Tag).attributeType=1 then
begin
correct:=1;
try
val_num:=StrToFloat(ExpertMod.edit2.Text);
if (inst.instance(ExpertMod.BitBtn1.Tag).value(2)=1) and
(inst.instance(ExpertMod.BitBtn1.Tag).value(1)=val_num) then correct:=2
else
begin
{!}
if (inst.attribute(ExpertMod.BitBtn1.Tag).getLowerNumericBound<>inst.attribute(ExpertMod.BitBtn1.Tag).getUpperBumericBound) then
if (val_num<inst.attribute(ExpertMod.BitBtn1.Tag).getLowerNumericBound) or
(val_num>inst.attribute(ExpertMod.BitBtn1.Tag).getUpperBumericBound) then
begin
ExpertMod.Label7.Visible:=true;
ExpertMod.Memo1.Lines.Add('Значение не попадает в заданный диапазон.');
correct:=0;
end;
end;
except
on e: Exception do
begin
ExpertMod.Memo1.Lines.Add('Неверно введено значение атрибута.');
ExpertMod.Memo1.Lines.Add('Обратите внимание на тип атрибута.');
PrintAttr(ExpertMod.BitBtn1.Tag,inst);
correct:=0;
end;
end;
end;
{номинального}
if inst.attribute(ExpertMod.BitBtn1.Tag).attributeType=2 then
begin
correct:=0;
try
//Если введен один символ и он цифра
if TryStrToInt(ExpertMod.edit2.Text,nom) then
begin
if inst.attribute(ExpertMod.BitBtn1.Tag).numValues-1>=nom then
begin
val_nom:=nom;
correct:=1;
end;
end
else
begin
//Если введена одна буква
if length(ExpertMod.edit2.Text)=1 then
begin
for j:=0 to inst.attribute(ExpertMod.BitBtn1.Tag).numValues-1 do {По всем запися в m_Values}
if pos(AnsiLowerCase(ExpertMod.edit2.Text),AnsiLowerCase(inst.attribute(ExpertMod.BitBtn1.Tag).value(j)))=1 then
begin
val_nom:=j;
correct:=1;
end;
end
else
for j:=0 to inst.attribute(ExpertMod.BitBtn1.Tag).numValues-1 do {По всем запися в m_Values}
if AnsiLowerCase(ExpertMod.edit2.Text)=AnsiLowerCase(inst.attribute(ExpertMod.BitBtn1.Tag).value(j)) then
begin
val_nom:=j;
correct:=1;
end;
end;
{Проверяем не повторяется ли значение}
if (inst.instance(ExpertMod.BitBtn1.Tag).value(2)=1) and
(inst.instance(ExpertMod.BitBtn1.Tag).value(1)=val_nom) then correct:=2;
if correct=0 then
begin
ExpertMod.Memo1.Lines.Add('Неверно введено значение атрибута.');
ExpertMod.Memo1.Lines.Add('Обратите внимание на тип атрибута.');
PrintAttr(ExpertMod.BitBtn1.Tag,inst);
end;
except
on e: Exception do
begin
ExpertMod.Memo1.Lines.Add('Неверно введено значение атрибута.');
ExpertMod.Memo1.Lines.Add('Обратите внимание на тип атрибута.');
PrintAttr(ExpertMod.BitBtn1.Tag,inst);
correct:=0;
end;
end;
end;
if correct=2 then begin
BitBtn1.Tag:=BitBtn1.Tag+1;
ExpertMod.Edit2.Clear;
if BitBtn1.Tag<inst.numAttributes then else BitBtn1.Tag:=0;
PrintAttr(ExpertMod.BitBtn1.Tag,inst);
end;
if correct=1 then begin {*}
{Вставка атрибутов}
if inst.attribute(ExpertMod.BitBtn1.Tag).attributeType=1 then
begin
if (inst.instance(ExpertMod.BitBtn1.Tag).value(2)=1) then
else begin inst.instance(BitBtn1.Tag).setValue(2,1); N:=N+1 end;
inst.instance(BitBtn1.Tag).setValue(1,val_num);
end;
if inst.attribute(ExpertMod.BitBtn1.Tag).attributeType=2 then
begin
if (inst.instance(ExpertMod.BitBtn1.Tag).value(2)=1) then
else begin inst.instance(BitBtn1.Tag).setValue(2,1); N:=N+1 end;
inst.instance(BitBtn1.Tag).setValue(1,val_nom);
end;
{Если система в режиме вывода}
if sys=2 then begin Logic.TakeVal(ExpertMod.BitBtn1.Tag,inst.instance(ExpertMod.BitBtn1.Tag).value(1)); logic.Execute(Rules,inst,OC); exit end;
BitBtn1.Tag:=BitBtn1.Tag+1;
ExpertMod.Edit2.Clear;
if BitBtn1.Tag<inst.numAttributes then else BitBtn1.Tag:=0;
if sys=1 then PrintAttr(ExpertMod.BitBtn1.Tag,inst);
end; {*}
end; {**}
end; {***}
end;
procedure TExpertMod.BitBtn1Click(Sender: TObject);
var val:double;
begin
if sys=3 then sys:=1;
ExpertMod.EnterAtr;
ExpertMod.GreedAtrFull(inst);
end;
{Процедура срабатывает при выборе пункта меню Вид / Список атрибутов
вводит имена всех атрибутов}
procedure TExpertMod.N8Click(Sender: TObject);
var i,j:integer;
name,typ,value:string;
LowerBound,UpperBound :Double;
begin
ExpertMod.BitBtn7.Visible:=true;
ExpertMod.BitBtn1.Default:=false;
ExpertMod.Memo1.Clear;
ExpertMod.Memo1.Lines.Add('Используемые атрибуты: ');
ExpertMod.Memo1.Lines.Add('');
for i:=0 to inst.numAttributes-1 do begin
name:=inst.attribute(i).name; {Выводим имя и тип атрибута}
typ:=inst.attribute(i).getAttrType;
ExpertMod.Memo1.Lines.Add(name+' '+typ);
if inst.attribute(i).attributeType=1 then {Если атрибут числовой,}
begin
LowerBound:=inst.attribute(i).getLowerNumericBound; {Выводим значения верхней и нижней границ}
UpperBound:=inst.attribute(i).getUpperBumericBound;
ExpertMod.Memo1.Lines.Add('Верхняя граница: '+inttostr(round(UpperBound)));
ExpertMod.Memo1.Lines.Add('Нижняя граница: '+inttostr(round(LowerBound)));
end;
if inst.attribute(i).attributeType=2 then
begin
ExpertMod.Memo1.Lines.Add('Возможные значения: ');
for j:=0 to inst.attribute(i).numValues-1 do {По всем запися в m_Values}
begin
value:=inst.attribute(i).value(j);
ExpertMod.Memo1.Lines.Add(value);
end;
end;
ExpertMod.Memo1.Lines.Add('');
end;
end;
{Процедура срабатывает при выборе пункта меню Вид / Введенные значения
вводит значение всех введенных атрибутов}
procedure TExpertMod.N9Click(Sender: TObject);
var i: integer;
name,val: AnsiString;
begin
ExpertMod.BitBtn1.Default:=false;
ExpertMod.Memo1.Clear;
if N=0 then begin
ExpertMod.Memo1.Lines.Add('Значений не введено.');
ExpertMod.Memo1.Lines.Add('Список атрибутов Вы можете посмотреть в пункте Вид / Список атрибутов');
end
else begin
ExpertMod.Memo1.Lines.Add('Введенные значения: ');
ExpertMod.Memo1.Lines.Add('');
for i:=0 to inst.numAttributes-1 do
begin
name:=inst.attribute(i).name;
if inst.instance(i).value(2)=1 then
begin
if inst.attribute(i).attributeType=1 then val:=floattostr(inst.instance(i).value(1));
if inst.attribute(i).attributeType=2 then val:=inst.attribute(i).value(round(inst.instance(i).value(1)));
end
else
if (name=OC_name)and(OC_name<>'') then val:='Основная цель'
else val:='Значение не задано';
name:=name+' : '+val;
ExpertMod.Memo1.Lines.Add(name);
end;
end;
end;
{Процедура срабатывает по таймеру, отвечает за ProgressBar}
procedure TExpertMod.prbar(Sender: TObject);
begin
ExpertMod.ProgressBar1.StepBy(5);
if (ExpertMod.ProgressBar1.Position=ExpertMod.ProgressBar1.Max) then
begin
ExpertMod.ProgressBar1.Visible:=false;
end;
end;
{Процедура срабатывает в режиме Задать вопросы,
читает один из типовых вопросов}
procedure TExpertMod.ListBox1Click(Sender: TObject);
begin
ExpertMod.Edit3.text:=ExpertMod.ListBox1.Items.ValueFromIndex[ExpertMod.ListBox1.itemindex];
end;
{Процедура срабатывает при выборе пункта меню Задачи / Вопросы
задает начальные значения}
procedure TExpertMod.N6Click(Sender: TObject);
begin
ExpertMod.BitBtn1.Default:=false;
ExpertMod.Panel1.Visible:=false;
ExpertMod.Panel2.Visible:=true;
ExpertMod.BitBtn6.Click;
end;
{Процедура срабатывает при выборе пункта меню Задачи / Вопросы
по клику на вопросик. Запускает механизм ответа на вопрос}
procedure TExpertMod.BitBtn3Click(Sender: TObject);
var q_type:integer; {0-как, 1-Почему, 2-Стандартный из списка}
ind:integer;
begin
ExpertMod.Memo1.Clear;
ExpertMod.Memo1.Lines.Add(ExpertMod.Edit3.text);
q_type:=-1;
if pos('как',AnsiLowerCase(ExpertMod.Edit3.text))>0 then q_type:=0
else
if pos('почему',AnsiLowerCase(ExpertMod.Edit3.text))>0 then q_type:=1;
if q_type=0 then begin
ExpertMod.Memo1.Lines.Add('Ответ на вопрос "Как?": ');
if (sys=1) then OtvetPoch_1v(1)
else
if OC=-1 then
begin
logic_str.Otv_Kak(ExpertMod.BitBtn3.Tag-1,list_true_rules,Rules,inst);
ExpertMod.BitBtn3.Tag:=ExpertMod.BitBtn3.Tag+1;
if ExpertMod.BitBtn3.Tag> list_true_rules.Count then ExpertMod.BitBtn3.Tag:=1;
end
else begin
logic.Otv_Kak(ExpertMod.BitBtn3.Tag-1,list_true_rules,Rules,inst);
ExpertMod.BitBtn3.Tag:=ExpertMod.BitBtn3.Tag+1;
if ExpertMod.BitBtn3.Tag> list_true_rules.Count+1 then ExpertMod.BitBtn3.Tag:=1;
end;
end;
if q_type=1 then begin
ExpertMod.Memo1.Lines.Add('Ответ на вопрос "Почему?": ');
if (sys=1) then OtvetPoch_1v(2)
else
if OC=-1 then
logic_str.Otv_Poch
else
logic.Otv_Poch(nom,Rules,inst,sys);
end;
if q_type=-1 then ExpertMod.Memo1.Lines.Add('Ваш вопрос не понятен...')
end;
procedure TExpertMod.TakeVal(n:integer;list:Tlist);
begin
nom:=n;
list_true_rules:=list;
end;
{получить_ответ п конкретному значению}
{Выводит сведения по номеру атрибута и выставляет все параметры для ввода}
procedure TExpertMod.otvet(index:integer);
begin
ExpertMod.N3.Click;
ExpertMod.Memo1.Clear;
if sys=2 then begin
ExpertMod.Memo1.Lines.Add('*****************************************');
ExpertMod.Memo1.Lines.Add('Введите пожалуста значение атрибута.');
ExpertMod.Memo1.Lines.Add('Это необходимо для продолжения вывода.');
ExpertMod.Memo1.Lines.Add('*****************************************');
end;
ExpertMod.PrintAttr(index,inst);
ExpertMod.BitBtn1.Tag:=index;
end;
{Переключение между панельками}
procedure TExpertMod.BitBtn4Click(Sender: TObject);
begin
ExpertMod.BitBtn5.Click;
ExpertMod.Panel2.Visible:=false;
ExpertMod.Panel1.Visible:=true;
end;
{Переключение между панельками в обратную сторону}
procedure TExpertMod.BitBtn5Click(Sender: TObject);
begin
ExpertMod.Panel2.Height:=273;
ExpertMod.ListBox1.Visible:=true;
ExpertMod.BitBtn4.Top:=234;
ExpertMod.BitBtn5.Visible:=false;
ExpertMod.BitBtn6.Visible:=true;
ExpertMod.GreedAtr.Top:=288;
ExpertMod.GreedAtr.height:=265;
end;
{установка размера панельки}
procedure TExpertMod.BitBtn6Click(Sender: TObject);
begin
ExpertMod.Panel2.Height:=150;
ExpertMod.ListBox1.Visible:=false;
ExpertMod.BitBtn4.Top:=115;
ExpertMod.BitBtn5.Visible:=true;
ExpertMod.BitBtn6.Visible:=false;
ExpertMod.GreedAtr.Top:=165;
ExpertMod.GreedAtr.height:=388;
end;
{тут срабатывает блок логического аывода}
procedure TExpertMod.BitBtn7Click(Sender: TObject);
begin
ExpertMod.Close;
end;
{Заполняет значениями таблицу}
procedure TExpertMod.GreedAtrFull(inst1:TDMInstances);
var i,j:integer;
begin
ExpertMod.GreedAtr.RowCount:=inst1.numAttributes+1;
ExpertMod.GreedAtr.Cells[0,0]:='Атрибут';
ExpertMod.GreedAtr.Cells[1,0]:='Значение';
for i:=1 to ExpertMod.GreedAtr.RowCount do
ExpertMod.GreedAtr.Cells[1,i]:='';
if OC<>-1 then ExpertMod.GreedAtr.Cells[1,OC+1]:='основная цель';
for i:=1 to inst1.numAttributes do
begin
ExpertMod.GreedAtr.Cells[0,i]:=inst1.attribute(i-1).name;
if inst1.instance(i-1).value(2)=1 then
begin
if inst1.attribute(i-1).attributeType=1 then ExpertMod.GreedAtr.Cells[1,i]:=FloatToStr(inst1.instance(i-1).value(1));
if inst1.attribute(i-1).attributeType=2 then ExpertMod.GreedAtr.Cells[1,i]:=inst1.attribute(i-1).value(round(inst1.instance(i-1).value(1)));
end;
end;
end;
procedure TExpertMod.ClickGreed(Sender: TObject);
var X,Y,Col,Row:Integer;
s:string;
begin
if sys=3 then sys:=1;
X:=mouse.CursorPos.X-ExpertMod.Left-5-ExpertMod.GreedAtr.Left;
Y:=mouse.CursorPos.Y-ExpertMod.Top-42-ExpertMod.GreedAtr.Top;
ExpertMod.GreedAtr.MouseToCell(X,Y,Col,Row);
ExpertMod.otvet(Row-1);
ExpertMod.Edit2.SetFocus;
end;
procedure TExpertMod.N10Click(Sender: TObject);
var file_res,str:string;
res:textfile;
vih:boolean;
begin
try
if sys=1 then file_res:='\Help1.txt'
else file_res:='\Help2.txt';
AssignFile(res,file_res);
Reset(res);
try
ExpertMod.Memo1.Clear;
vih:=true;
while vih do
begin
readln(res,str);
if str='*****' then vih:=false
else ExpertMod.Memo1.Lines.Add(str);
end;
finally
closefile(res);
end;
except
Application.MessageBox('Не определен доступ к файлу','Сообщение',MB_OK+MB_ICONWARNING)
end;
end;
procedure TExpertMod.N12Click(Sender: TObject);
begin
ExpertMod.Close;
end;
{процедурка на сохранение таблицы в файле}
procedure TExpertMod.N11Click(Sender: TObject);
var filename,s:string;
TabGrid : Variant;
i,k,R,C:integer;
WorkBk : _WorkBook;
WorkSheet : _WorkSheet;
begin
if not ExpertMod.SaveDialog1.Execute then Exit;
filename:=ExpertMod.SaveDialog1.FileName;
try
try
R:=ExpertMod.GreedAtr.RowCount;
C:=ExpertMod.GreedAtr.ColCount;
TabGrid := VarArrayCreate([0,(R - 1),0,(C - 1)],VarOleStr);
k:=0;
for i := 1 to R-1 do
begin
if ExpertMod.GreedAtr.Cells[1,i]<>'' then begin
TabGrid[k,0] := ExpertMod.GreedAtr.Cells[0,i];
TabGrid[k,1] := ExpertMod.GreedAtr.Cells[1,i];
k:=k+1;
end;
end;
ExpertMod.ExcelApplication1.Connect;
ExpertMod.ExcelApplication1.WorkBooks.Add(xlWBatWorkSheet,0);
WorkBk := ExpertMod.ExcelApplication1.WorkBooks.Item[1];
WorkSheet := WorkBk.WorkSheets.Get_Item(1) as _WorkSheet;
Worksheet.Range['A1',Worksheet.Cells.Item[R,C]].Value := TabGrid;
WorkSheet.Name := 'Expert System';
Worksheet.Columns.HorizontalAlignment := xlLeft;
WorkSheet.Columns.ColumnWidth := 14;
WorkSheet.Range['A' + IntToStr(1),'A' + IntToStr(R)].ColumnWidth := 31;
ExpertMod.ExcelApplication1.Visible[0] := False;
if FileExists(filename) then
DeleteFile(filename);
WorkBk.Close(True, filename, 0, 0);
except
Application.MessageBox('Не удалось сохранить файл','Сообщение',MB_OK+MB_ICONWARNING)
end;
finally
ExpertMod.ExcelApplication1.Disconnect;
TabGrid := Unassigned;
end;
end;
procedure TExpertMod.closeform(Sender: TObject; var Action: TCloseAction);
begin
Form1.Enabled:=true;
end;
//Сброс результатов
procedure TExpertMod.BitBtn8Click(Sender: TObject);
var i:integer;
begin
try
// inst.CleanupInstance;
nom:=-1;
list_true_rules.Free;
N:=0;
OC:=-1;
OC_name:='';
sys:=1;
for i:=1 to inst.numAttributes do begin
ExpertMod.GreedAtr.Cells[1,i]:='';
inst.instance(i-1).setValue(2,0);
inst.instance(i-1).setValue(1,0);
end;
except
ExpertMod.Memo1.Lines.Clear;
ExpertMod.Memo1.Lines.Add('*************************************');
ExpertMod.Memo1.Lines.Add('Операция очистки не может быть');
ExpertMod.Memo1.Lines.Add('выполнена.');
ExpertMod.Memo1.Lines.Add('*************************************');
end;
end;
end.