Страница: 8/10
end;
SetColor(LightGreen);
Str(_iN.b/_iN.x:3:1,s);
OutTextXY(MinX+Round(_iN.b/_iN.x*MASHT),MinY+5,s);{рисуем значения на оси OX}
Str(_iN.b/_iN.y:3:1,s);
OutTextXY(MinX-40,MinY-Round(_iN.b/_iN.y*MASHT),s);{рисуем значения на оси OY}
MoveTo(MinX,MinY-Round(_iN.b/_iN.y*MASHT));
SetColor(15);{Рисуем саму линию}
LineTo(MinX+Round(_iN.b/_iN.x*MASHT),MinY);
End;
procedure EnterNerav;{процедура ввода неравенств до нажатия Esc}
procedure GetNerav;{подпроцедура ввода коэф-тов одного неравенства}
var j,k: Real;
Begin
repeat
SetFillStyle(1,0); Bar(0,0,GetMaxX,MaxY-1);
OutTextXY(7,3,'Введите коэффициенты неравенств: ');
Window(34,1,80,1);
Read(N.x, N.y, N.b);{вводим коэффициенты}
j:=N.x;
k:=N.y;
repeat{далее идет сокращение коэффициентов если это возможно}
if (Frac(N.b / j) = 0) then
if (Frac(N.x / j) = 0) then Break;
j:=j-1;
until (j<=0);
if J>=0 then
repeat
if (Frac(N.b / k) = 0) then begin
if (Frac(N.y / k) = 0) then
if (j=k) then begin
N.b:=N.b / k;
N.x:=N.x / k;
N.y:=N.y / k;
Break;
end
end;
k:=k-1;
until (k<=0);
until (N.x<>0) and (N.y<>0); {Ограничение чтоб небыло нулей}
Inc(i); {Увеличиваем счетчик}
Matr[i]:=N;{Добавляем в матрицу коэффициенты}
ShowLine(N);{Вызываем процедуру рисования линии}
SetFillStyle(1,0); Bar(0,0,GetMaxX,MaxY-1);
OutTextXY(7,3,'Ввести еще? (Enter=Да/Esc=Нет)');
End;
var
Key:Char;
Begin
GetNerav;
repeat
key:=#0;
if KeyPressed then begin
key:=ReadKey;
case key of
#13: GetNerav;{ввод еще одного нер-ва}
end;
end;
Until Key in [#27];{до нажатия Esc}
End;
procedure EnterMainF;
{эта процедура предлагает выбрать пользователю выбрать выход из ОДЗ}
var key: Char;
j: 0 100;
S: String;
Begin
SetFillStyle(3,1); FloodFill(MinX+1, MinY-1, 15);
SetFillStyle(1,0); Bar(0,0,GetMaxX,MaxY-1);
SetColor(White);
OutTextXY(7,3,'Введите коэффициенты целевой функции: ');
Window(40,1,80,25); Read(MainF.x, MainF.y);
End;
procedure GetResult;
var
k,j: 0 100;
X: Real;
Y: Real;
XTmp: Real;
YTmp: Real;
cTmp: Real;
boolAnswer: Boolean;
key: Char;
STmp: String;
Result: String;{Строка для вывода на экра результата}
procedure SolveOprtel(inN, inMainF: TNerav; ic:Real; var outX, outY: Real);
{в этой подпроцедуре подностью вычисляется определитель}
var
_d: Real;{Дельта определителя}
dx: Real;{Дельта X определителя}
dy: Real;{Дельта Y определителя}
Begin
_d:=(inN.x*(inMainF.y)) - (inN.y*inMainF.x);
dx:=(inN.b*(inMainF.y)) - (inN.y*ic);
dy:=(inN.x*ic) - (inN.b*inMainF.x);
if _d <> 0 then begin{исклюсаем бесчисленное мн-во решений}
outX:=dx/_d;
outY:=dy/_d;
end;
if (_d = 0) and ((dx = 0) xor (dy = 0)) then begin{исклюсаем - нет решений}
SetColor(Red);
OutTextXY(300,230,'Нет решений!!!');
ReadKey;
CloseGraph;
Halt;
end;
End;
Begin
Bar(0,0,GetMaxX,MaxY-1);
SetColor(White);
OutTextXY(7,3,'Пожалуйста подождите . (Esc - Отмена)');
{считаем координаты выхода}
c:=0;
cTmp:=0;
repeat
if i=1 then SolveOprtel(Matr[1], MainF, c, XResult, YResult)
else
for j:=1 to i-1 do begin
SolveOprtel(Matr[j], MainF, c, XTmp, YTmp);
for k:=j+1 to i do begin
SolveOprtel(Matr[k], MainF, c, X, Y);
if X=XTmp then XResult:=X;
if Y=YTmp then YResult:=Y;
end;
end;
{далее мы находим максимум функции}
BoolAnswer:=False;
for k:=1 to i do begin
N:=Matr[k];
if (N.x*XResult+N.y*YResult<=N.b) then begin
{Если в ОДЗ}
c:=cTmp;
boolAnswer:=True;
end;
{далее проверяем вышла ли cTmp за ОДЗ}
if (N.x*XResult+N.y*YResult>N.b) then begin Exit
end;
end;
cTmp:=cTmp+STEP;{Увеличиваем cTmp на STEP}
if keyPressed then key:=ReadKey;{если Esc нажата, то прерываем}
until (key=#27) or (cTmp>=10000);
if boolAnswer then begin
Реферат опубликован: 3/01/2008