Delphi заготовки

Пример программы удаления одинаковых слов из строки (Delphi).


1. Процедура выравнивания регистров
стандартная процедура  LowerCase - не работает с русскими буквами

function LowerCaseRus(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
    Ch := Source^;
    if (Ch >= 'A') and (Ch <= 'Z') then Inc(Ch, 32);
    if (Ch >= 'À') and (Ch <= 'ß') then Inc(Ch, 32); // Добавим строку
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;

2. процедура инициализации списка знаков препинания


type
 endWord  = set of  #0..#255;

var
  bkend:endWord;

begin

bkend:=[#146,#91,#93,#40,#41,#123,#125,#58,#44,#150,#151,#133,#33,
                      #46,#45,#145,#146,#147,#148,#171,#187,#39,#59,#47,#47,#32,
                      #183,#38,#64,#42,#92,#149,#94,#169,#164,#134,#135,#176,
                      #35,#185,#37,#137,#182,#174,#167,#126,#153,#95,#124,#166,'0','1','2','3','4','5','6','7','8','9'];

end


3. Получение количества слов в строке  String


Function GetWordCount(s:string;len:integer=0):integer;
 var y,x:integer;
    s2:string;
begin
  y:=0;
  s2:='';
  result:=0;
  for X:=1 to length(s) do begin
    if (ord(s[x])<33) or (s[x] in bkend) or (x=length(s)) then
                       begin
                       if (s2<>'') and ((len=0) or (length(s2)>=len)) then begin
                             y:=y+1;
                             end;
                             s2:='';
                          end else s2:=s2+s[x];

  end;
  result:=y;
end;


4. Получение слова из строки номер Index


Function GetPosIndex(s:string;index:integer;len:integer=0):Tpoint;
var y,x:integer;
    s2:string;
begin
  y:=0;
  s2:='';
  result.X:=1;
  result.y:=0;
  for X:=1 to length(s) do begin
if (ord(s[x])<33) or (s[x] in bkend) or (x=length(s)) then
                       begin
                       if (s2<>'') and ((len=0) or (length(s2)>=len))  then begin
                             y:=y+1;
                             if y=index then begin
                               result.y:=x-result.X;
                               exit;
                             end
                             end;
                             s2:='';
                          end
                          else begin
                          if s2='' then result.X:=x;
                          s2:=s2+s[x];

                          end;


  end;

end;


Function GetSlovoIndex(s:string;index:integer;len:integer=0):string;
var pr:Tpoint;
begin
    pr:=GetPosIndex(s,index,len);
    if pr.X>0 then
    if pr.y>0 then result:=copy(s,pr.x,pr.y);

end;


5. функция удаляет повторяющиеся слова в списке
 также может быть адаптирована для получения списка уникальных слов в тексте

Function GeTTextFromNotDoubleWord(TextValue:string):string;
var
    WordList:array of string; // список уникальных слов
    WordListCount:integer; // кол-во уникальных слов

    Function AddWord(s:string):boolean; // проверяет список слов // если слово не найдено Добавляет слово в список
    // вовзращает true если слово новое false если слово уже было в списке
    var x:Integer;
    begin
      result:=true;
      for x:=0 to WordListCount-1 do
        if WordList[x]=s then begin
         result:=false;
         break; // если мы нашли слово то просто выходим
         end;

      if result then begin
        WordListCount:=WordListCount+1;
        Setlength(WordList,WordListCount);
        WordList[WordListCount-1]:=s;
      end;
    end;

    var lenText:integer; // кол-во слов
    x:Integer;// переменная
    Word:string; // слово
    WordPos:Tpoint; // позиция слова в тексте
    NewText:string;      //  полученный текст
begin
  WordListCount:=0;
  newText:=TextValue;
  lentext:=GetWordCount(newText); // получаем кол-во слов в тексте
  x:=1;
  while x<lentext do begin
  WordPos:=GetPosIndex(newText,x);
  Word:=copy(newText,WordPos.x,WordPos.y);
   if not AddWord(LowerCaseRus(Word)) then begin
      delete(newText,WordPos.x,WordPos.y); // удаляем слово
      lentext:=lentext-1; // уменьшаем кол-во слов на 1
      x:=x-1; //
   end;
  x:=x+1;
  end;
 result:=newText;
 WordListCount:=0; // очищаем список слов
 SetLength(WordList,WordListCount);
end;

полный текст работы можно скачать по ссылке
http://netsoftware.ucoz.ru/26_udalit_povtory.zip