Содержание материала

 

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.

 

 

 

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить