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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 17.05.2015, 10:36   #1
demon31
Пользователь
 
Регистрация: 17.05.2015
Сообщений: 28
По умолчанию Копирование строки s в строку s1 n раз

Код:
Unit STRINGS3;
Interface
  Const StrOk=0;
        StrOut=1;
        StrNotFound=2;
        StrBig=3;
        StrSmall=4;
  Type string1=array[-1..1024] of char;
  procedure WriteToStr(var st:string1;s:string);
  procedure WriteFromStr(var s:string;st:string1);
  procedure InputStr(var st:string1);
  procedure OutputStr(const st:string1);
  function Comp(s1,s2:string1;var fl:shortint):boolean;
  procedure Delete(var s:string1;index,count:word);
  procedure Insert(subs:string1;var s:string1;index:word);
  procedure Concat(const s1,s2:string1;var srez:string1);
  procedure Copy(s:string1;index,count:word;var subs:string1);
  function Length(s:string1):word;
  function Pos(subs,s:string1):word;
  var StrError:byte;
Implementation
  procedure SetLength(var st:string1;l:word);
  Begin
    if l>1024 then
      StrError:=StrOut
    else
    begin
      StrError:=StrOk;
      st[-1]:=chr(l shr 8);
      st[0]:=chr(l);
    end;
  End;
  function Length(s:string1):word;
    var a:word;
  Begin
    StrError:=StrOk;
    a:=ord(s[-1]);
    Length:=(a shl 8) OR ord(s[0]);
  End;
  procedure Copy(s:string1;index,count:word;var subs:string1);
    var i:word;
  Begin
    if (Length(s)<(index+count-1))OR(index<1) then
      StrError:=StrOut
    else
    begin
      StrError:=StrOk;
      SetLength(subs,count);
      for i:=index to index+count-1 do
        subs[i-index+1]:=s[i];
    end;
  End;
  procedure Concat(const s1,s2:string1;var srez:string1);
    var i:word;
  Begin
    if (Length(s1)+Length(s2))>1024 then
      StrError:=StrOut
    else
    begin
      StrError:=StrOk;
      Copy(s1,1,Length(s1),srez);
      for i:=1 to Length(s2) do
        srez[i+Length(s1)]:=s2[i];
      SetLength(srez,Length(s1)+Length(s2));
    end;
  End;
  procedure InputStr(var st:string1);
    var i:word;
        c:char;
  Begin
    i:=0;
    read(c);
    while (ord(c)<>13)OR(i>=1024) do
    begin
      inc(i);
      st[i]:=c;
      read(c);
    end;
    SetLength(st,i);
  End;
  procedure Insert(subs:string1;var s:string1;index:word);
    var i:word;
        buf:string1;
  Begin
    if (Length(s)+Length(subs))>1024 then
      StrError:=StrBig
    else
    if index>Length(s) then
      StrError:=StrOut
    else
    begin
      StrError:=StrOk;
      Copy(s,index,Length(s)-index+1,buf);
      SetLength(s,index-1);
      Concat(s,subs,s);
      Concat(s,buf,s);
    End;
  End;
  procedure Delete(var s:string1;index,count:word);
    var i:word;
        buf:string1;
  Begin
    if Length(s)<index+count-1 then
      StrError:=StrSmall
    else
    begin
      StrError:=StrOk;
      Copy(s,index+count,Length(s)-count-index+1,buf);
      SetLength(s,index-1);
      Concat(s,buf,s);
    end;
  End;
  procedure OutputStr(const st:string1);
    var i:word;
  Begin
     for i:=1 to Length(st) do
       write(st[i]);
  End;
  procedure WriteToStr(var st:string1;s:string);
    var i:byte;
  Begin
    StrError:=StrOk;
    for i:=1 to ord(s[0]) do
      st[i]:=s[i];
    SetLength(st,ord(s[0]));
  End;
  procedure WriteFromStr(var s:string;st:string1);
    var i:byte;
  Begin
    if Length(st)>255 then
      StrError:=StrBig
    else
    begin
      StrError:=StrOk;
      for i:=1 to Length(st) do
        s[i]:=st[i];
    end;
    s[0]:=chr(Length(st));
  End;
  function Comp(s1,s2:string1;var fl:shortint):boolean;
    var i,l:word;
  Begin
    i:=1;
    if Length(s1)>Length(s2) then
      l:=Length(s2)
    else
      l:=Length(s1);
    while (i<=l)AND(s1[i]=s2[i]) do
      inc(i);
    if (Length(s1)=Length(s2)) then
    begin
      if i>l then
        fl:=0
      else if s1[i]>s2[i] then
        fl:=1
      else if s1[i]<s2[i] then
        fl:=-1
    end
    else
    if Length(s1)>Length(s2) then
      fl:=1
    else
      fl:=-1;
    Comp:=(fl=0);
  End;
  function Pos(subs,s:string1):word;
    var i,j,p:word;
        fl:shortint;
        buf:string1;
  Begin
    i:=0;
    j:=0;
    p:=0;
    while ((i+Length(subs))<=Length(s))AND(p=0) do
    begin
      inc(i);
      Copy(s,i,Length(subs),buf);
      if Comp(subs,buf,fl) then
        p:=i;
    end;
    if p=0 then
      StrError:=StrNotFound
    else
      StrError:=StrOk;
    Pos:=p;
  End;
End.
Помогите на основе этих модулей написать такую процедуру, Copies(var s1,s2:string; n:byte).
Назначение: копирование строки s в строку s1 n раз.
Входные параметры: s1,n.
Выходные параметры: s2.

Последний раз редактировалось Stilet; 17.05.2015 в 12:43.
demon31 вне форума Ответить с цитированием
Старый 17.05.2015, 12:46   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,792
По умолчанию

Код:
procedure Copies(var s1,s2:string; n:byte);
begin
 while n>0 do begin
  Concat(s1,s2,s2); 
  dec(n);
 end;
end;
Если не ошибаюсь.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
копирование ячеек на лист 2 и по условию копирование строки в буфер FiataliS Microsoft Office Excel 7 11.05.2020 18:19
копирование строк нужное количество раз Composter Microsoft Office Excel 2 14.12.2011 23:04
Копирование строки в строку User230 Общие вопросы C/C++ 3 02.11.2011 23:58
Копировать строку N раз tgm Microsoft Office Excel 6 02.12.2010 21:06
функция: копирование части строки в другую строку plasticman Microsoft Office Excel 1 18.03.2009 15:30