unit mainFind;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Dialogs, StdCtrls, LCLType;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
FFindDialog: TFindDialog;
FFindPosition: integer;
FTextToSearch: string;
FTextToFind: string;
FMemo: TMemo;
procedure FindDialog1Find(Sender: TObject);
procedure SearchForTextInMemo;
procedure ShowNotFoundDlg;
procedure HighlightFoundText;
procedure MemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
function SuccessfulSearch: boolean;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.SearchForTextInMemo;
begin
FFindDialog.FindText:=FMemo.SelText;
FFindDialog.Execute;
end;
procedure TForm1.FindDialog1Find(Sender: TObject);
begin
if (FMemo.Text = '') then
Exit;
if (FFindDialog.FindText = '') then
Exit;
if not (frMatchCase in FFindDialog.Options) then
begin
FTextToSearch:=LowerCase(FMemo.Text);
FTextToFind:=LowerCase(FFindDialog.FindText);
end
else
begin
FTextToSearch:=FMemo.Text;
FTextToFind:=FFindDialog.FindText;
end;
if SuccessfulSearch then
HighlightFoundText
else ShowNotFoundDlg;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FFindDialog:=TFindDialog.Create(Self);
FFindDialog.OnFind:=@FindDialog1Find;
FFindDialog.Options:=[frHideWholeWord, frHideUpDown, frHideEntireScope];
FMemo:=TMemo.Create(Self);
FMemo.Align:=alClient;
FMemo.Text:='If the snake bites before it is charmed'#10'what is the use of the charmer?';
FMemo.OnKeyDown:=@MemoKeyDown;
FMemo.ScrollBars:=ssAutoBoth;
FMemo.Parent:=Self;
end;
procedure TForm1.HighlightFoundText;
begin
FMemo.SelStart:=FFindPosition - Length(FTextToFind);
FMemo.SelLength:=Length(FTextToFind);
end;
procedure TForm1.MemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
if Sender.Equals(FMemo) and (Shift = [ssCtrl]) and (Key = VK_F) then
begin
Key:=0;
SearchForTextInMemo;
end;
end;
procedure TForm1.ShowNotFoundDlg;
begin
MessageDlg(Format('"%s" was not found', [FFindDialog.FindText]), mtInformation, [mbOk], 0);
end;
function TForm1.SuccessfulSearch: boolean;
var
charsToMatch, startPosition: integer;
pc: PChar;
procedure ResetPCharAndMatches; inline;
begin
charsToMatch:=Length(FTextToFind);
pc:=PChar(FTextToFind);
end;
begin
if SameText(FMemo.SelText, FFindDialog.FindText) then
startPosition:=FMemo.SelStart + FMemo.SelLength + 1
else startPosition:=1;
Result:=False;
FFindPosition:=startPosition;
ResetPCharAndMatches;
while (FFindPosition <= Length(FTextToSearch)) and (charsToMatch > 0) do
begin
if (FTextToSearch[FFindPosition] = pc^) then
begin
Dec(charsToMatch);
Inc(pc);
end
else ResetPCharAndMatches;
if (charsToMatch = 0) then
Break;
Inc(FFindPosition);
end;
Result:=(charsToMatch = 0);
end;
end.