Обновленный Код По Линейной Сортировке

Тема в разделе "Pascal and Delphi", создана пользователем vladis222, 14 окт 2012.

  1. vladis222

    vladis222 Active Member

    Регистрация:
    6 дек 2011
    Сообщения:
    31
    Симпатии:
    0
    Здравствуйте Обращаюсь к вам по такому вопросу: я по примеру из методички написал код для линейной сортировки,но программа работает как-то коряво.Подскажите,пожалуйста,в чем проблема. Вот код программы:
    Код (Delphi):
    program laba_sort;

    {$APPTYPE CONSOLE}

    uses
    SysUtils,CRT32;

    const Nmax=10;
    type first_array=array[1..Nmax] of Integer;
    var i,j:Integer;
    a:first_array;
    ch:Byte;
    n:Integer;
    procedure InTab(var a:first_array);
    var  ch:Char;
    fname:string;
    i:integer;
    f:file of Integer;
    begin
    ClrScr;
    Writeln('Vvedite 10 elementov massiva : ');
    for i:=1 to Nmax do
    begin
    Read(a[i]);
    end;
    Writeln('Sohranit massiv v faile ?(y/n) ');
    ch:=ReadKey;
    if ch in ['n','N','ò','Ò'] then
    Exit;
    Writeln('Vvedite imya faila : ');
    Readln(fname);
    Assign(f,fname);
    {$I-}
    Rewrite(f);
    {$I+}
    if IOresult=0 then
    begin
    for i:=1 to Nmax do
    write(f, a[i]);
    Close(f);
    end
    else
    begin
    Writeln('Oshibka pri sozdanii faila!');
    ReadKey;
    end;
    end;
    procedure InFileTab(var a:first_array );
    var
    f:file of Integer;
    fname:string;
    ch:Char;
    begin
    ClrScr;
    repeat
    Writeln('Vvedite imya faila');
    Readln(fname);
    Assign(f,fname);
    {$I-}
    Reset(f);
    {$I+}
    if IOResult<>0 then
    begin
    Writeln('Ne vozmojno naiti fail ',fname);
    Writeln('Prodoljit rabotu ? y/n');
    ch:=ReadKey;
    if ch in ['n','N','ò','Ò'] then
    Exit;
    end;
    until IOResult=0;
    n:=0;
    while not Eof(f) do
    begin
    n:=n+1;
    read(f,a[n]);
    end;
    Close(f);
    Writeln('Tablica zagrujena iz faila ! ', fname);
    write('Najmite ljubuju klavishu : ');
    ReadKey;
    end;
    procedure ShowTab(var a:first_array);
    var i:Integer;
    begin
    ClrScr;
    Writeln('Elementy massiva : ');
    Writeln('----------------------------------');
    for i:=1 to Nmax do
    begin
    Write('|',a[i]);
    end;
    Write(' Najmite ljubuju klavishu : ');
    Readkey;
    end;
    procedure PrintTab(var a:first_array;i,imin:Integer);
    var k:Integer;
    begin
    for k:=1 to Nmax do
    begin
    if k=i then
    textattr:=red*16+white
    else
    if k=imin then
    textattr:=blue*16+white
    else
    textattr:=black*16+white;
    write(a[k]);
    textattr:=black*16+white;
    write('  ');
    end;
    Writeln;
    end;
    procedure SortTab(var a:first_array);
    var i,imin,j:Integer;
    tmp:Integer;
    begin
    ClrScr;
    Writeln('Shagi sortirovki');
    Writeln('(videleni kluchi perestavlyaemih zapisej)');
    for i:=1 to Nmax-1 do
    begin
    imin:=i;
    for j:=i+1 to Nmax do
    if a[j]<a[imin] then
    imin:=j;
    if imin<>i then
    begin
    PrintTab(a,i,imin);
    ReadKey;
    tmp:=a[i];
    a[i]:=a[imin];
    a[imin]:=tmp;
    end;
    end;
    end;

    begin
    repeat
    ClrScr;
    Writeln('1.Vvod dannih s klaviaturi');
    Writeln('2.Zagruzka tablici iz faila');
    Writeln('3.Vivod tablici');
    Writeln('4.Sortirovka tablici metodom linejnogo vibora');
    Writeln('5.Bystraja sortirovka(srednij razd.element)');
    Writeln('----------------------------------------------');
    Writeln('0.Vihod');

    Writeln;
    Write('Vash vibor : ');
    Readln(ch);

    Case ch of
    1:InTab(a);
    2:InFileTab(a);
    3:ShowTab(a);
    4:SortTab(a);

    end;
    until ch=0;
    end.
     
  2. -master-

    -master- Well-Known Member

    Регистрация:
    14 янв 2012
    Сообщения:
    629
    Симпатии:
    19
    А в чем кривость?
     
  3. vladis222

    vladis222 Active Member

    Регистрация:
    6 дек 2011
    Сообщения:
    31
    Симпатии:
    0
    Да дело в том,что при сортировке показываются все шаги кроме последнего, ну и не выделяются шрифтом,как написано в процедуре.
     
  4. -master-

    -master- Well-Known Member

    Регистрация:
    14 янв 2012
    Сообщения:
    629
    Симпатии:
    19
    А зачем в PrintTab цикл?
     
  5. vladis222

    vladis222 Active Member

    Регистрация:
    6 дек 2011
    Сообщения:
    31
    Симпатии:
    0
    ну,для выделения перемещающихся элементов сортировки определенным цветом
     
  6. vladis222

    vladis222 Active Member

    Регистрация:
    6 дек 2011
    Сообщения:
    31
    Симпатии:
    0
    ну,для выделения перемещающихся элементов сортировки определенным цветом
     
Загрузка...

Поделиться этой страницей