Устанавливает цвет и стиль закраски. Устанавливает шаблон и цвет для всех операций закраски, производимых FillPoly, Bar, Bar3D и PieSlice. Доступно несколько предопределенных шаблонов закраски. Заданный по умолчанию шаблон = Solid и заданный по умолчанию цвет - цвет с максимальным номером в палитре. Если в SetFillStyle переданы недопустимые параметры, то в переменной GraphResult возвращается значение grError, и текущие установки закраски не будут изменены.

Если Pattern равняется UserFill, то активным шаблоном закраски станет шаблон, определяемый пользователем (устанавливаемый с помощью процедуры SetFillPattern).

Procedure FloodFill(X, Y : Integer; Border : Word);

Закрашивает замкнутую область, используя текущие стиль и цвет закраски. Закрашивает замкнутую область на растровых устройствах. Точка с координатами (X, Y) - начальная точка внутри замкнутой области, с которой начнется закраска. Текущий шаблон закраски устанавливается процедурами SetFillStyle и SetFillPattern. Закрашивается область, ограниченная цветом с номером Border. Если точка (X, Y) находится внутри замкнутой области, то закраска будет происходить внутри области. Если же эта точка находится снаружи замкнутой области, то будет закрашено все пространство вне области.

Более подробное описание программы содержится в комментариях к исходному тексту.

2.1 Текст программы

{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O+,P-,Q-,R-,S+,T-,V+,X+}

{$M 16384,0,655360}

program Kurs1;{Геометрическая интерпретация решения задач}

uses

CRT, Graph;{используемы модули}

{Типы}

type

TNerav = record{коэффициенты неравенств а1х+а2y<=b}

x: Real;{a1}

y: Real;{a2}

b: Real; {b}

end;

TMatrix = array[1 100] of TNerav;{Количество неравенств}

{Константы}

const

MaxX: Integer = 640-30; {максимальное значение X на экране}

MaxY = 20; {максимальное значение Y на экране}

MinX = 40; {x=0 минимальное значение X на экране}

MinY: Integer = 480-40;{y=0 минимальное значение Y на экране}

MASHT = 15; {Масштаб при 15: maxY=28, MaxX=38}

STEP = 1; {шаг изменения свободного члена целевой функчии}

{Переменные}

var

Gd, Gm: Integer; {Иниц. гафики}

Matr: TMatrix; {Матрица неравенств}

c: Real; {Свободный член целевой ф-ии}

N: TNerav; {Коэффициенты неравенств}

i: 0 100; {Счетчик кол-ва неравенств}

MainF: TNerav; {Коэффициенты целевой ф-ии}

XResult,YResult: Real; {Ответ(кординаты)}

procedure ShowXOY;{Проц. показа координатных осей}

Begin

SetColor(White);

Line(MinX, MaxY,MinX-4, MaxY+7);{стрелочки у Y}

Line(MinX, MaxY,MinX+4, MaxY+7);

OutTextXY(MinX-15, MaxY, 'У');

MoveTo(MinX, MaxY);

LineTo(MinX, MinY);{Сами оси}

LineTo(MaxX, MinY);

Line(MaxX, MinY, MaxX-7, MinY-4);{стрелочки у X}

Line(MaxX, MinY, MaxX-7, MinY+4);

OutTextXY(MaxX, MinY+5, 'X');

End;

procedure ShowLine(_iN:TNerav);

var s: String;

Begin

if _iN.b/_iN.y<0 then begin{если коэффиц. при Y меньше 0}

MoveTo(MinX+Round((_iN.b-(Round(MinY/MASHT)*_iN.y))/_iN.x*MASHT),MaxY);

SetColor(15);

LineTo(MinX+Round(_iN.b/_iN.x*MASHT),MinY);

end;

if _iN.b/_iN.x<0 then begin{если коэффиц. при X меньше 0}

MoveTo(MinX,MinY-Round(_iN.b/_iN.y*MASHT));

SetColor(15);

LineTo(MaxX,MinY-Round((_iN.b-(Round(MaxX/MASHT)*_iN.x))/_iN.y*MASHT));

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);