|
В этой статье мне хотелось бы привести
несколько недокументированных, но очень полезных функций для работы со строками.
Почти уверен, что Вам они пригодятся! Во всяком случае для меня они незаменимы,
и с их помощью я сделал полезную утилиту для внесения небольших (одинаковых
изменений) изменений в несколько текстовых документов сразу и с успехом ее
использую для внесения небольших коррективов в код своего сайта!
Перейдем от слов к делу, надо уже скорее
знакомить Вас с этими функциями! Первая, которую я предложу Вам проверяет есть
ли подстрока в строке, и если есть - возвращает
true, иначе -
false.
Функция эта выглядит так:
function MatchStrings(source, pattern: String): Boolean;
var
pSource: Array [0..255] of Char;
pPattern: Array [0..255] of Char;
function MatchPattern(element, pattern: PChar): Boolean;
function IsPatternWild(pattern: PChar): Boolean;
var
t: Integer;
begin
Result := StrScan(pattern,'*') <> nil;
if not Result then Result := StrScan(pattern,'?') <> nil;
end;
begin
if 0 = StrComp(pattern,'*') then
Result := True
else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
Result := False
else if element^ = Chr(0) then
Result := True
else begin
case pattern^ of
'*': if MatchPattern(element,@pattern[1]) then
Result := True
else
Result := MatchPattern(@element[1],pattern);
'?': Result := MatchPattern(@element[1],@pattern[1]);
else
if element^ = pattern^ then
Result := MatchPattern(@element[1],@pattern[1])
else
Result := False;
end;
end;
end;
begin
StrPCopy(pSource,source);
StrPCopy(pPattern,pattern);
Result := MatchPattern(pSource,pPattern);
end;
Использовать ее нужно примерно так:
MatchStrings('Михаил' , '*' + 'Михаил автор данной статьи' + '*');
Вызов этой функции в данном примере
возвратит true,
так как строка 'Михаил' содержится в строке 'Михаил автор этой статьи'. Символы
'*' нужны для корректности работы функции. Разберем небольшой пример, будем
вводить текст в поле Edit1, и искать его в Memo1, по нажатию на командной кнопке
Button1. Итак, разместим перечисленные компоненты на форме. Скопируйте описание
функции и поместите его после
implementation
{$R *.DFM}
А обработчик нажатия на командную кнопку
может иметь такой вид:
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
n_sov:integer;//число совпадений
begin
n_sov:=0;
for i:= 0 to memo1.Lines.Count-1 do
begin
if matchstrings(memo1.lines[i],'*'+edit1.text+'*') = true then
inc(n_sov) else;
end;
showmessage(inttostr(n_sov));
end;
На всякий случай :) приведу полный код
примера:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function MatchStrings(source, pattern: String): Boolean;
var
pSource: Array [0..255] of Char;
pPattern: Array [0..255] of Char;
function MatchPattern(element, pattern: PChar): Boolean;
function IsPatternWild(pattern: PChar): Boolean;
var
t: Integer;
begin
Result := StrScan(pattern,'*') <> nil;
if not Result then Result := StrScan(pattern,'?') <> nil;
end;
begin
if 0 = StrComp(pattern,'*') then
Result := True
else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
Result := False
else if element^ = Chr(0) then
Result := True
else begin
case pattern^ of
'*': if MatchPattern(element,@pattern[1]) then
Result := True
else
Result := MatchPattern(@element[1],pattern);
'?': Result := MatchPattern(@element[1],@pattern[1]);
else
if element^ = pattern^ then
Result := MatchPattern(@element[1],@pattern[1])
else
Result := False;
end;
end;
end;
begin
StrPCopy(pSource,source);
StrPCopy(pPattern,pattern);
Result := MatchPattern(pSource,pPattern);
end;
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
n_sov:integer;//число совпадений
begin
n_sov:=0;
for i:= 0 to memo1.Lines.Count-1 do
begin
if matchstrings(memo1.lines[i],'*'+edit1.text+'*') = true then
inc(n_sov) else;
end;
showmessage(inttostr(n_sov));
end;
end.
Если вдруг кто-то не знает, то функция
inc(x:ordinal); увеличивает число на единицу (а функция Dec - уменьшает). Таким
образом мы просто проходим в цикле все строки Memo1 и ищем совпадения. К
сожалению эта функция умеет только указывать если подстрока в строке, но
неплохо было бы ее доработать, чтобы она возвращала позицию символа, с которого
начинается совпадение. Если у вас есть идеи, то пожалуйста пишите!
Теперь познакомимся с более интересной
функцией, которая заменяет одну подстроку на другую в строке. Она выглядит таким
образом:
function ReplaceSub(str, sub1, sub2: String): String;
var
aPos: Integer;
rslt: String;
begin
aPos := Pos(sub1, str);
rslt := '';
while (aPos <> 0) do begin
rslt := rslt + Copy(str, 1, aPos - 1) + sub2;
Delete(str, 1, aPos + Length(sub1) - 1);
aPos := Pos(sub1, str);
end;
Result := rslt + str;
end;
Эта функция заменяет Sub1 на Sub2 в строке
Str и возвращает измененную строку.
Сразу усовершенствуем наш пример, дабы
разобраться с использованием этой функции. Добавьте на форму еще одно текстовое
поле Edit2. В Edit1 будем вводить слово, которое надо заменить, а в поле Edit2
слово, на которое надо заменить.
Теперь обработчик нажатия на кнопку у меня
выглядит так:
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
n_sov:integer;
begin
n_sov:=0;
for i:= 0 to memo1.Lines.Count-1 do
begin
if matchstrings(memo1.lines[i],'*' +edit1.text+ '*') = true
then begin
Memo1.lines[i]:=ReplaceSub(memo1.lines[i],edit1.text,edit2.text);
inc(n_sov);
end;
end;
showmessage(inttostr(n_sov));
end;
Ну и опять, на всякий случай, приведу
полный код примера:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function MatchStrings(source, pattern: String): Boolean;
var
pSource: Array [0..255] of Char;
pPattern: Array [0..255] of Char;
function MatchPattern(element, pattern: PChar): Boolean;
function IsPatternWild(pattern: PChar): Boolean;
var
t: Integer;
begin
Result := StrScan(pattern,'*') <> nil;
if not Result then Result := StrScan(pattern,'?') <> nil;
end;
begin
if 0 = StrComp(pattern,'*') then
Result := True
else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
Result := False
else if element^ = Chr(0) then
Result := True
else begin
case pattern^ of
'*': if MatchPattern(element,@pattern[1]) then
Result := True
else
Result := MatchPattern(@element[1],pattern);
'?': Result := MatchPattern(@element[1],@pattern[1]);
else
if element^ = pattern^ then
Result := MatchPattern(@element[1],@pattern[1])
else
Result := False;
end;
end;
end;
begin
StrPCopy(pSource,source);
StrPCopy(pPattern,pattern);
Result := MatchPattern(pSource,pPattern);
end;
function ReplaceSub(str, sub1, sub2: String): String;
var
aPos: Integer;
rslt: String;
begin
aPos := Pos(sub1, str);
rslt := '';
while (aPos <> 0) do begin
rslt := rslt + Copy(str, 1, aPos - 1) + sub2;
Delete(str, 1, aPos + Length(sub1) - 1);
aPos := Pos(sub1, str);
end;
Result := rslt + str;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
n_sov:integer;
begin
n_sov:=0;
for i:= 0 to memo1.Lines.Count-1 do
begin
if matchstrings(memo1.lines[i],'*' +edit1.text+ '*') = true
then begin
Memo1.lines[i]:=ReplaceSub(memo1.lines[i],edit1.text,edit2.text);
inc(n_sov);
end;
end;
showmessage(inttostr(n_sov));
end;
end.
На этом пока все. Надеюсь сумело помочь Вам
в Ваших начинаниях
| 
