Поиск и замена текста в поле МЕМО программно

Delphi , Компоненты и Классы , TMemo и TRichEdit

Автор: Mirag
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> 
На форму бросьте кнопку и поле МЕМО
напишите в МЕМО(в первой строке) текст и поставьте C:\, нажмите кнопку,
при этом C:\ замениться на D:\ без потери форматирования
Вот и все...

Зависимости: Смотрите uses
Автор:       Mirag, wwwMirage@yandex.ru, Mirag
Copyright:   Mirag
Дата:        15 ноября 2002 г.
***************************************************** }

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.

Перевод контента на русский язык:

Это программное обеспечение Delphi, выполняющее операцию поиска и замены текста в компоненте TMemo (мемо). Паттерн поиска задается как '*c:*' и строкой замены - 'd:\'. Когда кнопка нажата, программа проверяет, содержит ли текст мемо паттерн поиска, и если да, то заменяет его на строку замены.

Вот некоторые улучшения и предложения:

1. Организация кода: Код слишком плотный и может быть организован лучше для читаемости. Например, вы можете разделить функции на отдельные модули или единицы.
2. Обработка ошибок: В программе нет обработки ошибок. Хорошо бы добавить некоторые проверки для обработки случаев, когда паттерн поиска не найден или когда строка замены пуста.
3. Интерфейс пользователя: Программа только предоставляет кнопку и компонент мемо, что может быть недостаточно для дружественного интерфейса. Вы могли бы рассмотреть добавление более контролов, таких как текстовый блок для ввода патерна поиска или строки замены.

Вот обновленная версия кода с некоторыми улучшениями:

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;

implementation

{$R *.dfm}

function ReplaceSub(str, sub1, sub2: string): string;
begin
  // same implementation as before
end;

function MatchStrings(source, pattern: string): Boolean;
begin
  // same implementation as before
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ss: string;
  found: Boolean;
begin
  found := MatchStrings(Memo1.Lines.Text, '*c:\*');
  if found then
  begin
    ss := ReplaceSub(Memo1.Lines.Strings[0], 'c:\', 'd:\');
    Memo1.Lines.Delete(0);
    Memo1.Lines.Insert(0, ss);
  end
  else
    ShowMessage('Pattern not found!');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // same implementation as before
end;

end.

Замечу, что я оставил оригинальный код в основном нетронутым, но сделал некоторые минимальные изменения для улучшения читаемости и добавил комментарии. Вы может хоть раз рефакторить код для его более эффективной и поддерживаемой работы.

В статье описывается программное решение для поиска и замены текста в поле МЕМО, которое позволяет заменить строку 'C:\' на 'D:\' без потери форматирования.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: TMemo и TRichEdit ::