Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 16.05.2012, 19:46   #1
NikitaVilkoss
 
Регистрация: 18.12.2011
Сообщений: 3
Восклицание Не работают динамические массивы в delphi.

Помогите пожалуйста сделать динамические массивы, без них программа работает, а с ними - вылетает.

Код:
program sort;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

type
Strings = Array of String;

type
  PStrings = ^Strings;

var arr: Strings;
var arrp: PStrings;
var i : Integer;

procedure list_directory(Path: string;const arr: PStrings);
var
a:Strings;
SR: TSearchRec;
i:Integer;
begin
i:=0;
if FindFirst(Path + '*.*', faAnyFile, SR) = 0 then
  begin
    a := arr^;
    repeat
      if (SR.Attr <> faDirectory) then
      begin
        SetLength(a,i+1);
        a[i] := SR.Name;
        Inc(i);
      end;
    until FindNext(SR) <> 0;
    SysUtils.FindClose(SR);
    for i:=0 to Length(a) do Writeln(a[i]);

  end;
  Writeln(Length(a));
end;


function compare_strings (a:String; b: String ) : Integer;
 var len,i: Integer;
begin
 if Length(a) < Length(b)then
  begin
   len := Length(a);
   compare_strings:=1;
  end
  else
  begin
   len := Length(b);
   if Length(a) = Length(b) then begin
      compare_strings:=0;
   end
   else
   begin
     compare_strings:=-1;
   end;
  end;

for i:=1 to len do
  begin
    if a[i] > b[i]  then
    begin
      compare_strings := 1;
      break;
    end
    else
    begin
      if a[i] < b[i] then
      begin
         compare_strings := -1;
         Break;
      end;
    end;
  end;

end;


function buble_sort(var arr:Strings) : Strings;
var i,g:Integer;
var temp:string;
begin
    g:=10;
    repeat
        i:=0;
        repeat
            inc(i);
            if compare_strings(arr[i],arr[i+1]) = 1 then
            begin
                temp:=arr[i+1];
                arr[i+1] := arr[i];
                arr[i] := temp;
            end;
            writeln(arr[i]);
        until i > g;
        dec(g);
    until g = 0;
    buble_sort:=arr;
end;

function insert_sort(var arr:Strings) : Strings;
var i,j:Integer;
var temp:string[255];
begin
    for i:=2 to 255 do
    begin
        temp:=arr[i];
        j:=i-1;
        while (j>0) and (compare_strings(arr[j],temp) = 1) do
        begin
            arr[j+1] := arr[j];
            dec(j);
        end;
        arr[j+1] := temp;
    end;
    insert_sort:=arr;
end;

begin
SetLength(arr,2);
arrp := @arr[Low(arr)];
   list_directory('/',arrp);
   for i:=1 to length(arr) do
      begin
           writeln(arr[i]);
      end;
   arr := insert_sort(arr);
   writeln('');
   writeln('result:');
   for i:=1 to length(arr) do
      begin
           writeln(arr[i]);
      end;

   readln;
end.

Последний раз редактировалось NikitaVilkoss; 16.05.2012 в 19:52.
NikitaVilkoss вне форума Ответить с цитированием
Старый 16.05.2012, 19:57   #2
p51x
Старожил
 
Регистрация: 15.02.2010
Сообщений: 15,695
По умолчанию

а разве динамические массивы не от 0 до Н-1?
p51x вне форума Ответить с цитированием
Старый 16.05.2012, 20:01   #3
NikitaVilkoss
 
Регистрация: 18.12.2011
Сообщений: 3
По умолчанию

Я в динамических массивах - просто 0, знаю, зачем они в нужны и как в теории работать должны. Но сделать не могу =( Тут, по идее одна функция осталась.
NikitaVilkoss вне форума Ответить с цитированием
Старый 16.05.2012, 20:53   #4
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,515
По умолчанию

Полезная галочка при работе с массивами

Держи исправления
главное исправление //////////////
прочие //
Код:
program sort;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

type
Strings = Array of String;

//type
//  PStrings = ^Strings;

procedure list_directory(Path: string; var a: Strings); //
var
//a:Strings;
SR: TSearchRec;
i:Integer;
begin
i:=0;
if FindFirst(Path + '*.*', faAnyFile, SR) = 0 then
  begin
//    a := arr^;
    repeat
      if (SR.Attr <> faDirectory) then
      begin
        SetLength(a,i+1);
        a[i] := SR.Name;
        Inc(i);
      end;
    until FindNext(SR) <> 0;
    SysUtils.FindClose(SR);
    for i:=0 to Length(a)-1 do Writeln(a[i]);  //

  end;
  Writeln(Length(a));
end;


function compare_strings (a:String; b: String ) : Integer;
 var len,i: Integer;
begin
 if Length(a) < Length(b)then
  begin
   len := Length(a);
   compare_strings:=1;
  end
  else
  begin
   len := Length(b);
   if Length(a) = Length(b) then begin
      compare_strings:=0;
   end
   else
   begin
     compare_strings:=-1;
   end;
  end;

for i:=1 to len do
  begin
    if a[i] > b[i]  then
    begin
      compare_strings := 1;
      break;
    end
    else
    begin
      if a[i] < b[i] then
      begin
         compare_strings := -1;
         Break;
      end;
    end;
  end;

end;


function buble_sort(var arr:Strings) : Strings;
var i,g:Integer;
var temp:string;
begin
    g:=10;
    repeat
        i:=0;
        repeat
            inc(i);
            if compare_strings(arr[i],arr[i+1]) = 1 then
            begin
                temp:=arr[i+1];
                arr[i+1] := arr[i];
                arr[i] := temp;
            end;
            writeln(arr[i]);
        until i > g;
        dec(g);
    until g = 0;
    buble_sort:=arr;
end;

function insert_sort(var arr: Strings) : Strings;
var
  i,j:Integer;
  temp:string;//
begin
    for i:=1 to length(arr)-1 do ////////////////////////////
    begin
        temp:=arr[i];
        j:=i-1;
        while (j>0) and (compare_strings(arr[j],temp) = 1) do
        begin
            arr[j+1] := arr[j];
            dec(j);
        end;
        arr[j+1] := temp;
    end;
    insert_sort:=arr;
end;

var arr: Strings;
//var arrp: PStrings;
var i : Integer;
begin
//  SetLength(arr,2);
//arrp := @arr[Low(arr)];
   list_directory('/',arr);
   for i:=0 to length(arr)-1 do //
      begin
           writeln(arr[i]);
      end;
   arr := insert_sort(arr);
   writeln('');
   writeln('result:');
   for i:=0 to length(arr)-1 do //
      begin
           writeln(arr[i]);
      end;

   readln;
end.
Изображения
Тип файла: jpg 1.JPG (41.6 Кб, 80 просмотров)
программа — запись алгоритма на языке понятном транслятору
evg_m на форуме Ответить с цитированием
Старый 16.05.2012, 20:58   #5
NikitaVilkoss
 
Регистрация: 18.12.2011
Сообщений: 3
По умолчанию

Спасибо огромное! Сейчас буду разбираться.
NikitaVilkoss вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
2 задачи на массивы. почему не работают ??? (((( ProgFrog Microsoft Office Excel 3 21.05.2012 21:07
Динамические массивы в Delphi Razdolbam Помощь студентам 4 01.03.2011 17:04
Динамические массивы. delphi Multiman Помощь студентам 15 29.11.2010 23:00
Динамические массивы и массивы варианты N@stya Помощь студентам 0 11.06.2010 21:09