Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  3 781

•  TDictionary Custom Sort  5 895

•  Fast Watermark Sources  5 690

•  3D Designer  8 463

•  Sik Screen Capture  6 028

•  Patch Maker  6 471

•  Айболит (remote control)  6 465

•  ListBox Drag & Drop  5 327

•  Доска для игры Реверси  94 898

•  Графические эффекты  6 672

•  Рисование по маске  5 780

•  Перетаскивание изображений  4 849

•  Canvas Drawing  5 226

•  Рисование Луны  4 947

•  Поворот изображения  4 490

•  Рисование стержней  3 183

•  Paint on Shape  2 426

•  Генератор кроссвордов  3 304

•  Головоломка Paletto  2 612

•  Теорема Монжа об окружностях  3 397

•  Пазл Numbrix  2 246

•  Заборы и коммивояжеры  2 904

•  Игра HIP  1 874

•  Игра Go (Го)  1 786

•  Симулятор лифта  2 122

•  Программа укладки плитки  1 854

•  Генератор лабиринта  2 292

•  Проверка числового ввода  1 980

•  HEX View  2 289

•  Физический маятник  1 954

 
скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

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



Автор: Mirag

{ **** 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.




Похожие по теме исходники

Поисковик

Поиск символа

Поиск файлов

Поиск открытых файлов

 

Findup (поиск дублей)

Дейкстра: поиск кратчайшего пути




Copyright © 2004-2025 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте