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

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

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 13.11.2008, 11:48   #1
One.Love
Пользователь
 
Регистрация: 13.01.2008
Сообщений: 91
По умолчанию Фильтр матов в Memo

Ребят помогите пожалуйста -(
Срочно нужно сделать фильтр матерных слов в Memo.
Я так предполагаю что должен быть ListBox или лучше всего база данных, и при каждом введенном слове в мемо должен отслеживаться мат, и если он занесен в базу данных, то должен автоматом стираться...
Вообщем точного представления не имею. Если не сложно помогите кодом пожалуйста? -( Заранее премного благодарен -)
One.Love вне форума Ответить с цитированием
Старый 13.11.2008, 12:01   #2
Arigato
Высокая репутация
СуперМодератор
 
Аватар для Arigato
 
Регистрация: 27.07.2008
Сообщений: 15,863
По умолчанию

Что именно не понятно? Можно хранить список в текстовом файле, его загружать в TStringList, определять присутствие слова в тексте Memo при помощи функции Pos. Если есть - стирать.
Arigato вне форума Ответить с цитированием
Старый 13.11.2008, 12:18   #3
One.Love
Пользователь
 
Регистрация: 13.01.2008
Сообщений: 91
По умолчанию

Просто ниразу не работал с мемо так серьезно, он у меня всегда был как контейнер для хранения или передачи текста. Можешь подробнее подсказать, если не сложно с кодом? -(
One.Love вне форума Ответить с цитированием
Старый 13.11.2008, 12:33   #4
Arigato
Высокая репутация
СуперМодератор
 
Аватар для Arigato
 
Регистрация: 27.07.2008
Сообщений: 15,863
По умолчанию

Memo1.Lines.Text - получить содержимое Memo1 в виде текстовой строки. В нем и нужно производить замену.
Arigato вне форума Ответить с цитированием
Старый 13.11.2008, 20:51   #5
One.Love
Пользователь
 
Регистрация: 13.01.2008
Сообщений: 91
По умолчанию

Объясни как для чайников каким образом производить эту самую замену?
Блин ниразу не работал с ними -(
One.Love вне форума Ответить с цитированием
Старый 26.11.2008, 23:57   #6
One.Love
Пользователь
 
Регистрация: 13.01.2008
Сообщений: 91
По умолчанию

мне кто-нибудь поможет с фильтром? Люди срочно надо, ниразу не работал с разбором слов, помогите пожалуйста кодом? -(
One.Love вне форума Ответить с цитированием
Старый 27.11.2008, 00:28   #7
FaTaL
Участник клуба
 
Аватар для FaTaL
 
Регистрация: 09.11.2007
Сообщений: 1,762
По умолчанию

Ну типа если например матерные слова загрузить в ListBox, то
for i:=0 to ListBox.ItemsCount-1 do
begin
и тут проверяешь
If Pos(ListBox.Items.Strings[i]) then
удалешь или что-то с ней делаешь
end;

Это просто как пример.
FaTaL вне форума Ответить с цитированием
Старый 27.11.2008, 07:25   #8
Altera
Старожил
 
Аватар для Altera
 
Регистрация: 29.01.2008
Сообщений: 2,406
По умолчанию

Я вижу этот алгоритм так:
1) Сначала надо проверяемый текст разбить на слова. Т.е. надо узнать, сколько всего слов в тексте, а потом пустить циклом, от первого слова до последнего в предложении. В каждом периоде цикла следует покучать соответствующее индексу слово и искать в нём (другим циклом, длина которого зависит от количества нецензурных слов в базе данных) мат. Вот тут уже и функция pos пригодиться.
з.ы. Лучше, если в базе будут содержаться не слова целиком а их корни, или основы, например "ху", "еб" и т.д.

Сейчас у меня нет времени, в школу пора. Чуть позже может разработаю этот алгоритм...

Последний раз редактировалось Altera; 27.11.2008 в 07:31.
Altera вне форума Ответить с цитированием
Старый 27.11.2008, 15:46   #9
Altera
Старожил
 
Аватар для Altera
 
Регистрация: 29.01.2008
Сообщений: 2,406
По умолчанию

Вот набросок
Код:
function checkWord(const value: pChar): boolean;
var
c: integer;
begin
   result := true;
   for c := 0 to forma.Memo3.Lines.Count - 1 do
      if pos(forma.Memo3.Lines[c], value) <> 0 then
      begin
         result := false;
         exit;
      end;
end;

function censur(const value: pChar): pChar;
const
//sep: string = ' '+#13#10;
syb: string = 'абвгдеёжсийклмнопрстувхцчшщъыьэюя'+
'АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
var
c: integer;
text, curWord: string;
begin
   c := 0; text := ''; curWord := '';

   while c <= length(value) do
   begin
      if pos(value[c], syb) = 0 then
      begin
         if curWord <> '' then
         begin
            if checkWord(pChar(curWord)) then
               text := text + curWord;
            curWord := '';
         end;
      end
      else
      begin

      end;
      curWord := curWord + value[c];
      inc(c);
   end;
   result := pChar(text);
end;

procedure Tforma.button1Click(Sender: TObject);
begin
   memo2.Text := censur(pChar(memo1.Text));
end;

memo1 - поле ввода текста
memo2 - текст после цензуры
memo3 - здесь содержатся матерные слова.
Altera вне форума Ответить с цитированием
Старый 27.11.2008, 16:32   #10
Dj_smart
Капсула от спама
Форумчанин
 
Аватар для Dj_smart
 
Регистрация: 04.03.2008
Сообщений: 779
По умолчанию

Вот, у меня в чате было реализовано:
Код:
str,sw,big, sensored:string;
n4c:boolean;
q3:integer;

sw:=Viewmemo.Lines[l]; // строчка поля, что фильтруем
big:=AnsiLowerCase(sw);
  if n4c then begin // n4c - проверять ли маты
  for n:=0 to MatForm.Mats.Items.Count-1 do begin // mats - матерные слова
    str:=MatForm.Mats.Items[n];
    while (pos(str,big)<>0) do begin
      q3:=pos(str,big);
      sw:=copy(sw,0,q3-1)+Sensored+copy(sw,q3+length(str),length(sw)); // sensored - строчка, на которую заменяется мат
      big:=ansilowercase(sw);
    end;
  end;
Если ничего не забыл - всё должно работать.
Как оказывается вырезать всё слово менее интереснее чем его корень. Лишь тот, кто желает унать мат подсознательно подставит нехватающий кусок)))
Если данный ответ не столь конкретен, как Вы желаете его увидеть, возможно необходимо поразмыслить, стоит ли вопрос того, чтобы о нём спрашивать на форуме?
CncFiles.ru - бесплатный файловый хостинг
Dj_smart вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перевод из Memo по английскому в Memo по русскому Sanek777 Общие вопросы Delphi 5 26.09.2008 00:17
Фильтр Инночка Помощь студентам 4 30.04.2008 20:27
Фильтр в базе Versifikator БД в Delphi 3 18.04.2008 10:35
фильтр в DBGrid ГОСЕАН БД в Delphi 10 09.02.2008 12:51
В Memo сделать так, чтобы текст был разного цвета, разноцветный memo Artem Компоненты Delphi 3 07.09.2007 13:40