Code: |
{ **** UBPFD *********** by delphibase.endimus.com **** >> Поиск и замена текста в поле МЕМО программно
На форму бросьте кнопку и поле МЕМО напишите в МЕМО(в первой строке) текст и поставьте C:\, нажмите кнопку, при этом C:\ замениться на D:\ без потери форматирования Вот и все...
Зависимости: Смотрите uses Автор: Mirag, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., Mirag Copyright: Mirag
***************************************************** }
unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TForm1 = class(TForm) Button1: TButton; Label1: TLabel; Memo1: TMemo; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end;
var Form1: TForm1; result: boolean; implementation
{$R *.dfm}
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;
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 ss: string; begin result := MatchStrings(memo1.Lines.Text, '*c:\*'); if result = true then begin messagebox(0, '', '', MB_OK); ss := ReplaceSub(memo1.Lines.Strings[0], 'c:\', 'd:\'); memo1.Lines.Delete(0); memo1.Lines.Insert(0, ss); end; end;
procedure TForm1.FormCreate(Sender: TObject); begin
end;
end.
|
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!