|
p align="left">{знайти найширший пункт} 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”.
Страницы: 1, 2
| 
