1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
В программе происходит сортировка в 4-части а мне надо в 5-части , а я не могу разобраться как это делается хотя есть пример помогите пожалуйста | 2 | 3 | 1 | | | 4 --------------------------- 8 | | |5 | 7 | 6 |
"(Показать/Скрыть)
program sort; uses Crt,Graph; const raz=8; type TMatr=array[1..raz,1..raz] of integer; var n,k,i,j,rows,cols:integer; a:TMatr; b:TMatr; z,rowNo:integer;
Procedure sort1V (var a1:TMatr); begin for j:=cols+2 to 2*cols do For k:=j-cols-1 downto 1 do for i:=2*rows-j+1 to rows-1 do if b[i,j]>b[i+1,j] then begin z:=b[i,j]; b[i,j]:=b[i+1,j]; b[i+1,j]:=z end; end;
{Процедура рисования окна диалога} procedure okno(xv,yv,xn,yn,colfona,colbukv:byte;zag:string); var i:integer; begin TextBackGround(8); Window(xv,yv,xn,yn); TextColor(colbukv); write(#201); for i:=1 to xn-xv-1 do write(#205); write(#187); for i:=1 to yn-yv-2 do begin GoToXY(1,i+1); write(#186); GoToXY(xn-xv+1,i+1); write(#186); end; write(#200); for i:=1 to xn-xv-1 do write(#205); write(#188); window(xv+1,yv+1,xn-1,yn-2); TextBackGround(colfona); ClrScr; GoToXY((xn-xv) div 2 - Length(zag) div 2,1); write(zag); window(xv+1,yv+2,xn-1,yn-2); end;
procedure vvod_dannblx(var a,b:TMatr); var beg,fin,ii,jj,x:integer; error,pr:boolean;
begin repeat write('Введите размер матрицы:'); readln(rows,cols); write('Введите начало и конец диопозона:'); {$I-} {$R-} read(beg,fin); {$I+} {$R+} error:=((fin-beg)<SQR(2*cols))or (IOResult<>0); if (rows>raz/2)or(cols>raz/2)or (rows<>cols) then error:=true;
if error then writeln('Ошибка ввода!!!'); until not error;
for i:=1 to 2*rows do for j:=1 to 2*cols do begin repeat x:=round(random*(fin-beg)+beg); pr:=false; for ii:=1 to i-1 do for jj:=1 to 2*cols do if a[ii,jj]=x then pr:=true; for jj:=1 to j-1 do if a[i,jj]=x then pr:=true until not pr; a[i,j]:=x; b[i,j]:=0; end; sort1V(a);
end; procedure vblvod_isx_dannblx; var count:integer; begin writeln; count:=-1; for i:=1 to 2*rows do begin count:=count+1; for j:=1 to 2*cols do begin if (i>=1) and (i<=rows) then begin if (j>=2*cols-count) and (j<=2*cols) then begin b[i,j]:=a[i,j]; TextColor(0) end else textcolor(15); end else textcolor(15); write(a[i,j]:4); end; writeln(''); end; sort1V(b); readln; end;
procedure vblvod_rezyltata; begin writeln; for i:=1 to 2*rows do begin for j:=1 to 2*cols do write(b[i,j]:4); writeln(''); end; readln; end;