Строки. Краткая теория.
В Паскале определены два типа строк:
var
s:string;
I:byte;
begin
readln(s);
i:=s[0];
end.
var
dlinna_stroki:byte
s:string;
begin
readln(s); {вводим строку}
dlinna_stroki:=Ord(s[0]);
end.
Type
PChar = ^Char;
s[0]:=chr(dlinna)
{...}
{ввод очередного символа}
{...}
Inc(S[0]);
var
s,f: string;
i,j: byte;
begin
readln(s); j:=1;
for i:=length(s) downto 1 do begin
f[j]:=s[i]; inc(j);
end;
f[0]:=chr(j);
writeln(f);
end.
var
s:string;
f:Char
i:byte;
begin
readln(s);
for i:=1 to Length(s) div 2 do begin
f:=s[i];
s[i]:=s[Length(s)-i+1];
s[Length(s)-i+1]:=f;
end;
writeln(s);
end.
GetWords(s:string; var mas:TArray)
процедура возвращает массив mas, элементами которого являются слова строки s; под понятием слово подразумевается набор символов идущих подряд и не разграничиваемых знаком пробела (' ')
program WordsToArray;
uses crt;
type TArray=array[1..100]of string;
{ функция заполняет возвращает массив mas словами из строки s }
procedure GetWords(s:string; var mas:TArray);
var i,j:shortint;
begin
while pos(' ',s)<>0 do delete(s,pos(' ',s),1);
if s[1]=' ' then delete(s,1,1);
if s[length(s)]=' ' then delete(s,length(s),1); { удаляем лишние пробелы }
i:=1;
for j:=1 to length(s) do
if s[j]<>' ' then mas[i]:=mas[i]+s[j] else if i<>high(mas) then inc(i);
{ заполняем массив словами из строки }
end;
var s:string;
mas:TArray;i:shortint;
begin
clrscr;
write('> ');
readln(s);
GetWords(s,mas);
for i:=1 to high(mas) do if mas[i]<>'' then writeln(i,' - ',mas[i]);
end.
Для удобства использования процедуру GetWords можно определить как функцию, которая возвращает количество найденных слов в строке (в переменной delimiters должны храниться символы, которые нужно считать разделителями слов):
type
TWords = array[1 .. 100] of string[100];
TDelimiter = set of Char;
function GetWords(s: string; var mas: TWords; delimiters: TDelimiter): Byte;
var i, p: Byte;
begin
{ Заменяем все разделители пробелами }
for i := 1 to Length(s) do
if s[i] in delimiters then s[i] := #32;
{ Удаляем лишние пробелы }
repeat
p := Pos(' ', s); { Здесь 2 пробела !!! }
if p > 0 then Delete(s, p, 1);
until p = 0;
{ Удаляем пробел в начале строки }
if s[1] = ' ' then
Delete(s, 1, 1);
{ Удаляем пробел в конце строки }
If s[Length(s)] = ' ' then
Delete(s, Length(s), 1);
i := 0;
{ Заполняем массив словами из строки }
repeat
p := Pos(' ', s); Inc(i);
if p > 0 then begin
mas[i] := Copy(s, 1, Pred(p)); Delete(s, 1, p)
end
else mas[i] := s;
until p = 0;
GetWords := i
end;
var
i, count: Word;
words: TWords;
{ Пример использования функции }
const
s: string = ' That is all folks ';
begin
Count := GetWords(s, words, []);
for i := 1 to Count do
WriteLn(words[i]);
end.
type
TWordStr = string[100];
TDelimiter = set of Char;
PTItem = ^TItem;
TItem =
record
Data: TWordStr;
next: PTItem;
end;
TWordList =
record
first, last: PTItem;
end;
procedure InsertWord(var L: TWordList; s: string);
var p: PTItem;
begin
New(p);
p^.Data := s;
p^.next := nil;
if L.first = nil then L.first := p
else L.last^.next := p;
L.last := p
end;
function GetWords(s: string; var L: TWordList; delimiters: TDelimiter): Byte;
var i, p: Byte;
begin
{ Заменяем все разделители пробелами }
for i := 1 to Length(s) do
if s[i] In delimiters then s[i] := #32;
{ удаляем лишние пробелы }
repeat
p := Pos(' ', s); { Здесь 2 пробела !!! }
if p > 0 then Delete(s, p, 1)
until p = 0;
{ Удаляем пробел в начале ... }
if s[1] = ' '
then Delete(s, 1, 1);
{ ... и в конце строки }
if s[Length(s)] = ' '
then Delete(s, Length(s), 1);
i := 0;
{ заполняем список словами из строки }
repeat
p := Pos(' ', s); Inc(i);
if p > 0 then begin
InsertWord(L, Copy(s, 1, Pred(p)));
Delete(s, 1, p)
end
else InsertWord(L, s)
until p = 0;
GetWords := i
end;
{ пример использования функции }
const
s: string = ' That is - all folks;;. ';
var
i, count: Word;
L: TWordList;
p: PTItem;
begin
Count := GetWords(s, L, ['-', ';', '.']);
WriteLn(Count, ' words found ...');
p := L.first;
while p <> nil do begin
WriteLn(p^.Data);
p := p^.next;
end;
end.
Модуль для работы со строками
Внимание: материал готовится!
Как написать функцию для ввода строки с ограниченной длиной ?
Внимание: Материал готовится!
Стандартные функции и процедуры языка Паскаль для работы со строками и символами
Символы
Chr(x : byte) : Char - Возвращает символ ASCII кода х
Ord(c : Char) : Byte - Возвращает ASCII-код символа c
UpCase(c : Char) : Char - Переводит символы 'a'..'z' в верхний регистр
Pred(c : Char) : Char - Выдает предшествующий c символ
Succ(c : Char) : Char - Выдает последующий за c символ
Строки
Length(s : String) : Byte - Возвращает длину строки s
ConCat(s1, s2, s3 ... sn : String) : String - Возвращает конкатинацию (слияние) строк s1...sn
Copy(s : String; start, len : Integer) : String - Возвращает подстроку длиной len, начинающуюуся с позиции start строки s
Delete(VAR s : String; start, len : Integer) - Удалает подстроку длиной len начиная с позиции start строки s
Insert(VAR s : String; SubS : String; start : Integer ) - Вставляет в s подстроку SubS, начиная с позиции start
Pos(SubS, s : string) : byte - Ищет вхождение подстроки SubS в s и возвращает номер первого символа SubS в s, или 0, если s не соержит SubS
Процедуры преобразования
Str(X :F :n; s : string) - Преобразует числовое значение X в строковое s, возможно создание формата для х
Val(S : String; var X; errCode : integer) - Преобразует строку цифр S в числовое значение X, при неудачном преобразовании errCode содержит номер позиции символа в строке, который не удалось преобразовать (то есть он не является цифрои или десятичной точкой)
Имитация стандартных функций Паскаля для работы со строками
Функция POS
function _Pos(const subS, s: String): Integer;
var
i, j, LenS, LenSb: Integer;
find: Boolean;
begin
i := 1;
find := false;
LenS := Length(s);
LenSb := Length(subS);
while (i <= LenS) and not(find) do begin
while (i <= LenS) and (s[i] <> subS[1]) do
inc(i);
if (i <= LenS) and ( i + LenSb - 1 <= LenS) then begin
j := 0;
while (j < LenSb) and (s[i + j] = subS[j + 1]) do
inc(j);
find := (j > LenSb - 1);
end;
if not(find) then inc(i);
end;
if find then _Pos := i else _Pos := 0;
end;
function _Copy(const s: String; start, len: Word): String;
var
result: String;
LenS, i: Word;
begin
if (start <= 0) or (len <= 0) then result := '' else begin
result := '';
LenS := Length(s);
if start + len - 1 > LenS then
len := LenS - start + 1;
for i := start to start + len - 1 do
result := result + s[i];
end;
_Copy := result;
end;
procedure _Insert(var s: String; const subS: String; start: Word);
var
result: String;
i: Integer;
begin
if (start <= 0) or (start >= 255) then result := s else begin
result := '';
for i := 1 to start - 1 do
result := result + s[i];
result := result + subS;
for i := start to Length(s) do
result := result + s[i];
end;
s := result;
end;
procedure _Delete(var s: String; start, len: Word);
var
i: Integer;
begin
if (start <= 0) or (start >= 255) or (len <= 0) then exit;
if start + len - 1 > Length(s) then
len := Length(s) - start + 1;
for i := start to Length(s) - len do
s[i] := s[i + len];
dec(s[0], len);
end;
Сколько раз слово w встречается в строке s ?
function Count(Const s, w: String; start: Byte): Byte;
const
limits = ['.', ',', ';', '!', '?', ' '];
var
p: Byte;
begin
p := Pos(w, Copy(s, start, 255));
if (start > length(s)) or (p = 0) then Count := 0
else if (((start + p - 2) = 0) or (s[ start + p - 2] in limits))
and (((start + p + length(w) - 2) = Length(s)) or (s[start + p + length(w) - 1] in limits))
then Count := 1 + Count(s, w, start + p + length(w) - 2) else Count := 0 + Count(s, w, start + p + length(w) - 2);
end;
function Count(Const s, w: String; start: Byte): Byte;
begin
// ...
end;
begin
clrscr;
writeln(Count('mila mila mama ramu s milom milamila_mila milamilamila lalala mila', 'mila', 1));
readln;
end.