
Вчера, 18:41
|
Модератор
|
|
Регистрация: 17.04.2008
Сообщения: 8,107
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
|
|
Ну это, конечно, извращение, но например как то так:
Код:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
lbSearch: TLabel;
edSearch: TEdit;
cbCaseSensitive: TCheckBox;
edText: TMemo;
btFind: TButton;
btFindNext: TButton;
procedure btFindClick(Sender: TObject);
procedure btFindNextClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function SearchForText(AMemo : TMemo; AText : String; ACaseSensitive : Boolean; AStartPos : Integer) : Integer;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.btFindClick(Sender: TObject);
var
Idx : Integer;
begin
Idx := SearchForText(edText, edSearch.Text, cbCaseSensitive.Checked, 1);
If Idx = 0
Then
Begin
MessageDlg('Not found.',mtInformation,[mbOK],0);
edSearch.SetFocus;
End
Else
Begin
edText.SelStart := Idx-1;
edText.SelLength := Length(edSearch.Text);
edText.SetFocus;
End;
end;
procedure TForm1.btFindNextClick(Sender: TObject);
var
Idx : Integer;
begin
If edText.SelLength = 0
Then btFindClick(Sender)
Else
Begin
Idx := SearchForText(edText, edSearch.Text, cbCaseSensitive.Checked, edText.SelStart+2);
If Idx > 0
Then
Begin
MessageDlg('Not found.',mtInformation,[mbOK],0);
edSearch.SetFocus;
End
Else
Begin
edText.SelStart := Idx-1;
edText.SelLength := Length(edSearch.Text);
edText.SetFocus;
End;
End;
end;
function TForm1.SearchForText(AMemo: TMemo; AText: String;
ACaseSensitive: Boolean; AStartPos: Integer): Integer;
function IsCharsEqual(Ch1, Ch2 : Char; IsCaseSensitive : Boolean) : Boolean;
begin
If IsCaseSensitive
Then Result := Ch1 = Ch2
Else Result := UpperCase(Ch1) = UpperCase(Ch2);
end;
function IsStringsEqual(Str1, Str2 : String;IsCaseSensitive : Boolean) : Boolean;
begin
If IsCaseSensitive
Then Result := Str1 = Str2
Else Result := UpperCase(Str1) = UpperCase(Str2);
end;
var
I : Integer;
strText : String;
strSample : String;
begin
Result := 0;
If Atext = '' Then Exit;
strText := AMemo.Lines.Text;
For I := AStartPos To Length(strText) Do
If IsCharsEqual(AText[1], strText[i], ACaseSensitive) Then
Begin
strSample := Copy(strText,I,Length(AText));
If IsStringsEqual(AText,strSample,ACaseSensitive) Then
Begin
Result := I;
Break;
End;
End;
end;
end.
Но вообще, это просто своя имлементация расширенного PosEx или чего-то подобного.
|