If Items[i].selected then break;
Items[i].Selected := False;
If I = Itemscount then I:=1 else I:=I+1;
Items[I].Selected := True;
end;
end;
{надрукувати меню на екран}
Print;
{якщо Еск -- вийти}
Until Ord(CommandKey) = 27;
end;
{вивiд меню на екран}
Procedure TMenu.Print;
var i:integer;
width: integer;
Position: Integer;
TempText: String;
begin
{тiльки якщо пункти є}
If ItemsCount > 0 then
Begin
Width:=getMaximalWidth + 4;
{ робимо заголовок}
TempText:='ЗАДАЧА О НАЗНАЧЕНИЯХ';
CreateTextWindow(1, 1, 80, 4, LightGray, Black);
GotoXY(ScreenWidth div 2 - Length(TempText) div 2, 2);
Write(TempText);
{робимо меню i друкуємо його}
CreateTextWindow(1, 4, 80, 6,green, White);
For I:=1 to ItemsCount do
begin
GotoXY( Width * I - Width div 2 - Length(Items[i].Caption) div 2, 2);
If Items[I].Selected then TextColor(Yellow) Else TextColor(White);
Write(Items[I].Caption);
end;
End;
end;
{знайти найширший пункт}
Function TMenu.getMaximalWidth: Integer;
var max: integer;
i: integer;
begin
if ItemsCount > 0 then
begin
max := Length(Items[1].Caption);
For I:=1 to ItemsCount do
begin
If Length(Items[i].Caption) > max then
Max := Length(Items[i].Caption);
end;
end;
getMaximalWidth := max;
end;
{виконати дiю}
Procedure TMenu.ExecuteAction;
Var N: Integer;
Begin
if ItemsCount > 0 then
begin
For N:=1 to ItemsCount do
begin
If Items[N].Selected Then ProcedureType(Items[N].Action);
end;
end;
End;
{додати пункт до меню}
Procedure TMenu.AddItem(Caption: String; Action: ProcedurePointer);
begin
If ItemsCount < MaxMenuItems then
begin
ItemsCount := ItemsCount + 1;
Items[ItemsCount].Caption := Caption;
If ItemsCount = 1 Then
Items[ItemsCount].Selected := True
Else Items[ItemsCount].Selected := False;
Items[ItemsCount].Action := Action;
end;
end;
{встановити потрiбний текстовий режим та знайти ширину i висоту екрану}
Procedure ScreenInitialization;
Begin
CheckBreak := False;
OriginalMode := LastMode;
TextMode( Lo(LastMode) + Font8x8);
ScreenWidth := Lo(WindMax) + 1;
ScreenHeight := Hi(WindMax) + 1;
TextBackground(Black);
TextColor(White);
End;
{процедура виходу}
Procedure ExitProc;
begin
Halt;
end;
{вивiд допомоги}
Procedure PrintHelp;
var s: file of char;
buffer:char;
begin
CreateTextWindow(1, 7, ScreenWidth, ScreenHeight, Black, White);
assign(s, 'help.txt');
reset(s);
while not eof(s) do
begin
read(s, buffer);
write(buffer);
end;
end;
{запит з клавiатури значення (1)}
Function InputValue(Comment: String): Integer;
Var Temp: Integer;
Len: Integer;
I, J: Integer;
begin
Len:= Length(comment);
J := 1;
While J <> 0 do
begin
CreateTextWindow( ScreenWidth div 2 - Len div 2 - 2,
ScreenHeight div 2 - 6 div 2,
ScreenWidth div 2 + Len div 2+ 2,
ScreenHeight div 2 + 6 div 2,
Blue, White);
TextColor(Yellow);
GotoXY( 3, 3); Write(Comment);
TextColor(White);
Window( ScreenWidth div 2 - Len div 2,
ScreenHeight div 2 + 2 div 2,
ScreenWidth div 2 + Len div 2,
ScreenHeight div 2 + 4 div 2);
TextColor(White);
{$I-}
Readln(Temp);
{$I+}
If IOResult <> 0 then J:=1 Else J:=0;
end;
CreateTextWindow(1, 7, ScreenWidth, ScreenHeight, Black, White);
InputValue := Temp;
end;
Procedure ASSIGMENTPROBLEM(N: Integer; C: MyArray);
var I, J0,m,m0,h2, I0,j1,last,up,low, J, k, cnt, s, ss: Integer;
V, u, d: MySimpleArray;
VJ, v0,h, dj, min,z : Real;
x,y, Col, free, lab: array[1..MaxN] of Integer;
label 41, 50, 43, 60, 55, 70, 80, 999;
begin
For I:=1 to N do
X[i] := 0;
For J0:=1 to N do
begin
J:=N - J0 + 1;
VJ := C[j,1];
I0 := 1;
For I:= 2 To N do
If C[i,j] < vj Then begin vj := C[i,j]; I0 := i; end;
V[j] := vj;
Col[j] := j;
If X[i0] = 0 then begin x[i0]:=j; y[j]:=i0; end
else begin x[i0] := -1 * ABS( X[i0] ); y[j]:=0; end;
end;
m:=0;
For I:=1 to N do
begin
If x[i] = 0 then
begin
m:=m+1;
free[m]:=i;
break;
end; {if}
If x[i] < 0 then
x[i]:=-1*x[i]
else
begin
j1:=x[i]; min:=Huge;
For J:=1 to N do
begin
If j = j1 then break;
If c[j,i] - v[j] < min then Min := c[j,i] - v[j];
end; {for}
v[j1] := v[j1] - min;
end;{else}
end;
Cnt:=0;
If m = 0 then goto 999;
41:
m0:=m; k:=1; m:=0;
50:
i:=free[k]; k:=k+1;
v0 := c[1, i] - v[1];
j0:=1; vj:=Huge;
For j:=2 to N do
begin
h:=c[j,i] - v[j];
If H < vj then
begin
if H >= v0 then
begin vj := h; j1 := j; end
else begin vj:=v0; v0 := h; j1:=j0; j0:=j; end;
end;
end;
i0:=y[j0];
if v0 < vj then
v[j0] := v[j0] - vj + v0
else
begin
if i0 = 0 then goto 43;
j0:=j1; i0 := y[j1];
end;
if i0 = 0 then goto 43;
if v0 < vj then
begin
k := k - 1;
free[k]:=i0;
end else
begin
m:=m+1;
free[m]:=i0;
end;
43:
x[i] := j0;
y[j0] := i;
if k <= m0 then goto 50;
cnt := cnt + 1;
if (m > 0) AND (cnt < 2) then Goto 41;
m0 := m;
For M:=1 to M0 do
begin
i0:=free[m];
For J:=1 to N do
begin
d[j]:=c[j,i0] - v[j];
lab[j]:=i0;
end;
up:=1;
low := 1;
60:
last:=low - 1;
min := d[col[up]];
up := up+1;
for k:=up to n do
begin
j := col[k];
dj := d[j];
if dj <=min then
begin
if dj < min then begin min:=dj; up:=low; end;
col[k]:=col[k];
col[up] := j;
up := up+1;
end;
end;
for h2:=low to up - 1 do
begin
j:=col[h2];
if y[j] = 0 then Goto 70;
end;
55:
j0:=col[low];
low:=low+1;
i:=y[j0];
h:=c[j0, i] - v[j0] - min;
for k:=up to n do
begin
j:=col[k];
vj:=c[j,i] - v[j] - h;
if vj < d[j] then
begin
d[j] := vj;
lab[j]:=i;
if vj = min then
begin
if y[j] = 0 then Goto 70;
col[k]:=col[up];
col[up]:=j;
up:=up+1;
end;
end;
end;
if low = up then goto 60;
goto 55;
70:
for k:=1 to last do
begin
j0 := col[k];
v[j0] := v[j0] + d[j0] - min;
end;
80:
i:=lab[j];
y[j]:=i;
k:=j;
j:=x[i];
x[i]:=k;
if i0 <> i then Goto 80;
end;
999:
z := 0;
For I:=1 to N do
begin
u[i]:=c[x[i],i] - v[x[i]];
z:=z+c[x[i],i];
end;
Writeln;
TextColor(LightBlue);
For I:=1 to N do begin
Writeln(' ДЛя комп"ютера ', I, ' задача ', y[i], ' найкраще пiдiйде.');
end;
end;
procedure PROG;
var i, j: integer;
si, sj: string;
begin
Num:=InputValue('Введiть кiлькiсть комп"ютерiв:');
For I:=1 to Num do
For J:=1 to Num do
begin
str(i, si);
str(j, sj);
Input[I,J]:=InputValue('Коефiцiєнт ' + si + '-ї задачi на комп"ютерi ' + sj);
end;
ASSIGMENTPROBLEM(num, input);
end;
procedure priklad;
var
FC: File of Char;
I, J: Integer;
BUFFER: Char;
begin
CreateTextWindow(1, 7, ScreenWidth, ScreenHeight, Black, White);
Assign(FC, 'EXAMPLET.TXT');
Reset(FC);
While not EOF(FC) do
begin
Read(FC, BUFFER);
Write(Buffer);
end;
close(FC);
Num:=5;
Input[1,1]:=9; Input[2,1]:=20; Input[3,1]:=60; Input[4,1]:=15; Input[5,1]:=21;
Input[1,2]:=38; Input[2,2]:=71; Input[3,2]:=69; Input[4,2]:=49; Input[5,2]:=60;
Input[1,3]:=28; Input[2,3]:=13; Input[3,3]:=80; Input[4,3]:=28; Input[5,3]:=34;
Input[1,4]:=58; Input[2,4]:=34; Input[3,4]:=13; Input[4,4]:=37; Input[5,4]:=25;
Input[1,5]:=30; Input[5,5]:=3; Input[2,5]:=53; Input[3,5]:=20; Input[4,5]:=21;
ASSIGMENTPROBLEM(num, input);
end;
begin
{встановлюємо екран}
ScreenInitialization;
{додаємо до меню пунктики}
With Menu do
begin
AddItem('Prog', @PROG);
AddItem('Справка', @printHelp);
AddItem('Пример', @priklad);
AddItem('Выход', @exitProc);
Activate;
end;
end.
Керівництво користувача
Дана програма призначена для використання в операційній системі MS DOS.
Для запуску програми потрібно запустити файл Lena.exe. Після запуску програми на екрані з’являється меню, яке містить три пункти – “Данные”, “Результат” та “?”. Пункт меню “Данные” складається з підпунктів “Из файла”, “Вручную”, “Выход”. Вибравши “Из файла”, ви вводите матрицю вагів, збережену в якомусь файлі. Вибравши “Выход”, програма закривається. “Результат” має підпункти “На экран” і “В файл”. Вибравши один з цих підпунктів, ви або виводите результат на екран, або відповідно зберігаєте його у файл. Пункт меню “?” має підпункт “Справка”.
Технічні вимоги до використання
Для запуску даної програми необхідна наявність персонального комп’ютера IBM PC.
Мінімальні вимоги до ПК:
Intel Pentium 100 мГц;
операційна система MS DOS;
пам’ять 288 байт;
дисковод або CD ROM;
клавіатура.
Висновок
У цій курсовій роботі вирішена задача про призначення.
Розроблено алгоритм рішення поставленої задачі.
Програма складена і налагоджена у середовищі програмування Турбо Паскаль.
У процесі налагодження була отримана цілком працездатна програма.
Проведено тестування програми. Аналіз результатів показав, що задача успішно виконана.
Довідкова література
1. Б.Іванов “Дискретная математика. Алгоритмы и программы”.
2. Н.Вірт “Алгоритми + Структури даних = Програма”.
3. Т.Рюттен, Г.Франкен “Турбо Паскаль 6.0”.