Процедуры добавления, удаления строки из динамического массива строк

[Suny-o]

//Тип dinarr - динамический массив строк, без него создание процедур delElem, addElem невозможно

//Примечание: обрабатываемый массив также должен иметь тип dinarr

Type
dinarr=array of string;

procedure delElem( var a:dinarr; index:integer);
var last,n:integer;
begin
 last:=length(a);
 For n:=index to (last-1) do
 begin
 a[n]:=a[n+1];
 end;
setlength(a,(last-1));
end;

procedure addElem( var a:dinarr; index: integer; anew:string);
var len,n:integer;
begin
 len:=length(a)+1;
setlength(a,len);
 for n := (len-1) downto index do
 begin
 a[n+1]:=a[n];
 end;
 a[index]:=anew;
end;

___________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

[Utkin]

Да удаление у Вас будет очень медленным. И чем больше строк, тем медленней. И нет проверки индексов. Что если будет индекс -1? Вылет проги обеспечен. Если это внутренние процедуры, то по барабану. Если юнит будет использоваться сторонними людьми, такая проверка ИМХО должна быть.
Кстати, а в чем вопрос-то?

И еще мне уже неудобно, но приходится почти в каждом посте навяливать TStringList. Если это не учебное задание, пользуйте класс, где все Ваши фишки уже давно готовы. А если учебное, то можно просто глянуть как TStringList устроен...

[Serge_Bliznykov]

Utkin, согласен ПОЛНОСТЬЮ!

и плюс 900000 за TStringList

[Suny-o]

//Тип dinarr, dinarr2 - одномерный и двухмерный динамический массив строк, без них создание процедур delElem, delElem2, addElem, addElem2 невозможно
//Примечание: обрабатываемый массив также должен иметь тип dinarr или dinarr2
Type
dinarr=array of string;
dinarr2=array of array of string;

//Процедура удаления в одномерном массиве с проверкой индексов
procedure delElem( var a:dinarr; index:integer);
var last,n:integer;
begin
   last:=length(a);
   if (index<0) or (index>(last-1)) then ShowMessage('Удаление элемента с индексом '+inttostr(index)+' (индексы от 0 до '+inttostr(last-1)+') невозможно')
   else
   begin
    For n:=index to (last-1) do
    begin
      a[n]:=a[n+1];
    end;
    setlength(a,(last-1));
   end;
end;

//Процедуры удаления в 2x мерном массиве с проверкой индексов
//Удаляется индекс (index)
procedure delElem2( var a:dinarr2; mainindex, index:integer);
var last,n:integer;
begin
   last:=length(a[mainindex]);
   if (index<0) or (index>(last-1)) then ShowMessage('Удаление элемента с индексом '+inttostr(index)+' (индексы от 0 до '+inttostr(last-1)+') невозможно')
   else
   begin
    For n:=index to (last-1) do
    begin
      a[mainindex,n]:=a[mainindex,n+1];
    end;
    setlength(a[mainindex],(last-1));
   end;
end;

//Процедура добавления в одномерном массиве с проверкой индексов
procedure addElem( var a:dinarr; index: integer;  anew:string);
var len,n:integer;
begin
   len:=length(a);
   if (index<0) or (index>len) then ShowMessage('Добавление элемента с индексом '+inttostr(index)+' (индексы от 0 до '+inttostr(len)+') невозможно')
   else
   begin
    if index<len then
    begin
     len:=length(a)+1;
     setlength(a,len);
     for n := (len-1) downto index do
     begin
      a[n]:=a[n-1];
     end;
     a[index]:=anew;
    end
    else if index=len then
    begin
     len:=length(a)+1;
     setlength(a,len);
     a[index]:=anew;
     end;
   end;
end;

//Процедура добавления в 2x мерном массиве с проверкой индексов
//Добавляется индекс (index)
procedure addElem2( var a:dinarr2; mainindex, index: integer;  anew:string);
var len,n:integer;
begin
   len:=length(a[mainindex]);
   if (index<0) or (index>len) then ShowMessage('Добавление элемента с индексом '+inttostr(index)+' (индексы от 0 до '+inttostr(len)+') невозможно')
   else
   begin
    if index<len then
    begin
     len:=length(a[mainindex])+1;
     setlength(a[mainindex],len);
     for n := (len-1) downto index do
     begin
      a[mainindex,n]:=a[mainindex,n-1];
     end;
     a[mainindex,index]:=anew;
    end
    else if index=len then
    begin
     len:=length(a[mainindex])+1;
     setlength(a[mainindex],len);
     a[mainindex,index]:=anew;
    end;
   end;
end;

Нашел ошибку - правильный код выделен синим, добавил проверку индексов

[Utkin]

Единственное замечание - вывод диагностических сообщений в случае ошибки я бы сделал в отдельных функциях. Разделяйте интерфейс и основную логику программы. Ну это я так на будущее придираюсь . А так мало ли - завтра скажут пиши ошибки на форме, а не отдельным окошком. Или запихни логи работы в файл.

[Suny-o]

//Тип dinarr, dinarr2 - одномерный и двухмерный динамический массив строк, без них создание процедур delElem, delElem2, addElem, addElem2 невозможно
//Примечание: обрабатываемый массив также должен иметь тип dinarr или dinarr2
Type
dinarr=array of string;
dinarr2=array of array of string;

//Процедура удаления в одномерном массиве с проверкой индексов
procedure delElem( var a:dinarr; index:integer);
var last,n:integer;
begin
   last:=length(a);
   if (index<0) or (index>(last-1)) then ShowMessage('Удаление элемента с индексом '+inttostr(index)+' (индексы от 0 до '+inttostr(last-1)+') невозможно')
   else
   begin
    For n:=index to (last-1) do
    begin
      a[n]:=a[n+1];
    end;
    setlength(a,(last-1));
   end;
end;

//Процедуры удаления в 2x мерном массиве с проверкой индексов
//Удаляется индекс (index)
procedure delElem2( var a:dinarr2; mainindex, index:integer);
var last,n:integer;
begin
   last:=length(a[mainindex]);
   if (index<0) or (index>(last-1)) then ShowMessage('Удаление элемента с индексом '+inttostr(index)+' (индексы от 0 до '+inttostr(last-1)+') невозможно')
   else
   begin
    For n:=index to (last-1) do
    begin
      a[mainindex,n]:=a[mainindex,n+1];
    end;
    setlength(a[mainindex],(last-1));
   end;
end;

//Процедура добавления в одномерном массиве с проверкой индексов
procedure addElem( var a:dinarr; index: integer;  anew:string);
var len,n:integer;
begin
   len:=length(a);
   if (index<0) or (index>len) then ShowMessage('Добавление элемента с индексом '+inttostr(index)+' (индексы от 0 до '+inttostr(len)+') невозможно')
   else
   begin
    if index<len then
    begin
     len:=length(a)+1;
     setlength(a,len);
     for n := (len-1) downto (index+1) do
     begin
      a[n]:=a[n-1];
     end;
     a[index]:=anew;
    end
    else if index=len then
    begin
     len:=length(a)+1;
     setlength(a,len);
     a[index]:=anew;
     end;
   end;
end;

//Процедура добавления в 2x мерном массиве с проверкой индексов
//Добавляется индекс (index)
procedure addElem2( var a:dinarr2; mainindex, index: integer;  anew:string);
var len,n:integer;
begin
   len:=length(a[mainindex]);
   if (index<0) or (index>len) then ShowMessage('Добавление элемента с индексом '+inttostr(index)+' (индексы от 0 до '+inttostr(len)+') невозможно')
   else
   begin
    if index<len then
    begin
     len:=length(a[mainindex])+1;
     setlength(a[mainindex],len);
     for n := (len-1) downto (index+1) do
     begin
      a[mainindex,n]:=a[mainindex,n-1];
     end;
     a[mainindex,index]:=anew;
    end
    else if index=len then
    begin
     len:=length(a[mainindex])+1;
     setlength(a[mainindex],len);
     a[mainindex,index]:=anew;
    end;
   end;
end;

Нашел ошибку - правильный код выделен синим (процедуры addElem и addElem2 выдавали ошибку если index=0)