Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Find/Replace components

Status
Not open for further replies.

bearsite4

Programmer
Sep 29, 2001
79
AU
I'm looking for a find and replace components of the text editing variety. Ideally, I'm hoping that I can just connect it to the RichEdit component and it will automatically do all the work so I don't have to do any extra code. Does anyone know where I can find one?
 
Are you sure that's right? Looking at the site, it seems to me that GExperts is just a bunch of enhancements to the Delphi ide itself and it doesn't contain any components.

Sorry I won't be able to reply for a while. I've got my exams right now.
 
The GExperts thing installs a menu option which does allow you to replace compnents, found that it does not work perfectly, replaced one kind of datasource with another, and a large percentage lost their dataset property, meaning I had to go back through and check them all.

This is only available at design time, I get the impression from your question that you are wanting to change components at run time, is this correct?
 
> I get the impression from your question that you are wanting to change components at run time.

Actually, I haven't even got a component. Delphi comes with find and replace dialog components which only displays the dialog. But I'm looking for one that will also do the finding and replacing for me if I hook it up to a RichEdit component. Basically, I'm a bit lazy but I figure if I can get a hold of a component that will do this it will probably be more bug free than one I would write myself.
 
I don't know of one, but there is no reason you can't just copy and paste the code from the examples in the Delphi help, for instance, the onreplace: (change re1 to the name of your richedit component)

var
SelPos: Integer;
begin
with TReplaceDialog(Sender) do
begin
{ Perform a global case-sensitive search for FindText in Memo1 }
SelPos := Pos(FindText, re1.Text);
if SelPos > 0 then
begin
re1.SelStart := SelPos - 1;
re1.SelLength := Length(FindText);
{ Replace selected text with ReplaceText }
re1.SelText := ReplaceText;
end
else MessageDlg(Concat('Could not find "', FindText, '" in re1.'), mtError, [mbOk], 0);
end;
 
Hello bearsite4

I agree there are some simple examples in the help, you can fiddle around with these to makke them more efficent,
e.g. The example code doesnt take account of the case of the charaters. Thats easy to fix with a call to uppercase(text).

The main problem I have with the find dialog system is that it gives you 'Up' and 'Down' search buttons and implementing an upwards search is not so easy ! using the examples as a basis.
Multiple searchs are not implemented at all in the replace example which will only replace the first occurence.

To get them all The principle is look in all the text for the first occurence of the word. then get the rest of the text for the next search for the word.
If you are going up/backwards you have to find the final position of the word. and trucate the text from the other end.

A good component would need to implement this and all the other options on the Find/Replace dialog.

As an embeded systems programmer, I see a lot of so called proffesional program Editors where the 'Find' dialogs are very poorly implemented. No upwards searchs, no memory of the last text searched for.

If there is a fully featured find/replace component out there it would be a good thing.

Steve..
 
Thanks for all your ideas. I had a quick stab at it myself but for some reason, I never thought of adapting the code from the help file.

Before I go all out and write the component myself I'll have another look around the web for it. If I find any, I'll let you know.
 
Here's a component I created myself so of course it's free for all. It does the basic job though it hasn't been thoroughly tested. I thought since I started this thread here I should place the code here. Any further updates will go to my homepage ( I don't really update my homepage much though, so don't expect the component to be even available for download there for at least 1-2 weeks maybe more.

unit FindReplace;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls,
Dialogs;

type
FindReplaceCommunication = ( frcAlertUser, frcAlertReplace, frcEndReached );
{allows the replace functions to use the find function avoiding alot
of code duplication. frcAlertuser means that when the find function
has reached the end of the text while searching for a word it will pop
up a message saying the word can't be found. frcAlertReplace
tells the find function not to display a message to the user saying that
the word can't be found but instead to set the state to frcEndReached to
let the replace function know it's reached the end of the text}

TFindReplace = class(TComponent)
private
fEditor: TCustomMemo; {the richedit or memo component to hook it up to}
fReplaceDialog: TReplaceDialog; {the replace dialog}
fFindDialog: TFindDialog; {the find dialog}

FindTextLength: integer; {the length of the text we want to find}
TextToFind: string; {the text to find}

FindActionOnEnd: FindReplaceCommunication; {the action the find function
should take when it reaches the end of the text while searching for the
word}

function TestWholeWord( Sender: TFindDialog; TestString: string ): boolean;
{returns a true or false depending on whether the user chose the whole word
only option and whether or not the word is a whole word. Actually, it can
test multiple words in a single string as well.}

protected
StringComparison: function ( const S1, S2: string ): Integer;
{the function to use to compare 2 strings. Should be assigned
different values according to the search criteria}
procedure ProcessCriteria( Sender: TFindDialog );
{set some internals given the search criteria such as match case}
procedure FindForwards( Sender: TFindDialog; start, finish: integer );
{search through the editor in a forwards direction}
procedure FindBackwards( start, finish: integer );
{search through the editor in a backwards direction}

{defined event handlers}
procedure OnFind( Sender: TObject ); virtual;
procedure OnReplace( Sender: TObject ); virtual;

{the centralised find/replace functions}
function TryAndMatch( Sender: TFindDialog; index, finish: integer ): boolean; virtual;
function TryAndReplace: boolean; virtual;

procedure DoReplace; virtual;
{the replace function that coordinates all the work}
procedure DoReplaceAll; virtual;
{the replace all function that coordinates all the work}

public
constructor Create( AOwner: TComponent); override;

procedure FindExecute;
{opens the find dialog}
procedure ReplaceExecute;
{opens the replace dialog}
procedure FindNext; overload;
{finds the next occurence of the character}
procedure FindNext( errorMessage: string ); overload;
{same as above except allows you to specify the message to display
if the user hasn't picked a search word}

procedure GoToLine( LineNumber: integer );
procedure GetLineNumber( Position: Integer; var LineNumber, ColumnNumber: Integer );
{returns the line and column number the cursor is on in the editor}

published
property Editor: TCustomMemo
read fEditor write fEditor;
end;

procedure Register;

implementation

{$R findrep.dcr}

constructor TFindReplace.Create( AOwner: TComponent );
begin
inherited;

{create the find dialog}
fFindDialog := TFindDialog.Create( Self );
{set up the event handlers}
fFindDialog.OnFind := OnFind;

{create the replace dialog}
fReplaceDialog := TReplaceDialog.Create( Self );
{set up the event handlers}
fReplaceDialog.OnReplace := OnReplace;
fReplaceDialog.OnFind := OnFind;

{set find's default action on end of text to alert the user.
If a replace function changes this it is it's responsibility
to change it back}
FindActionOnEnd := frcAlertUser;
end;

procedure TFindReplace.ProcessCriteria( Sender: TFindDialog );
begin

{assign a case sensitive or case insensitive string
comparison function to StringComparison depending
on the whether or not the user chose to match case.
The functions assigned are normal VCL functions.}
if frMatchCase in Sender.Options then
StringComparison := CompareStr
else StringComparison := CompareText;

end;

procedure TFindReplace.FindForwards( Sender: TFindDialog; start, finish: integer );
var
i: integer;

begin

{because we'll be using the length of the text to search for
often, we should calculate it here to save time}
FindTextLength := Length( TextToFind );

{to find the word we go through the text on a character by character
basis}
for i := start to finish do
if TryAndMatch( Sender, i, finish ) then
{if we've got a match then stop}
Exit;

end;

procedure TFindReplace.FindBackwards( start, finish: Integer );
{since only find has a (search) up option and replace doesn't
we don't have to worry about sender since only the onFind will
be calling thi function}

var
i: integer;

begin
{See comments for findforward}

FindTextLength := Length( TextToFind );

{to find the word we go through the text on a character by character
basis but working backwards}
for i := finish downto start do
if TryAndMatch( fFindDialog, i, start ) then
Exit;

end;

function TFindReplace.TryAndMatch( Sender: TFindDialog; index, finish: integer ): boolean;
{returns true if there was a match and false otherwise}
var
StringToTest: string;

begin
{create a new string to test against}
StringToTest := copy( fEditor.Text, index+1, FindTextLength );

if (StringComparison( StringToTest, TextToFind ) = 0) and
TestWholeWord( Sender, copy( fEditor.Text, index, FindTextLength+2 ) ) then
{with TestWholeWord we pass the value index not index+1 so that it will also
get the previous character. We pass the value FindTextLenght+2 so it
will copy the next character after the test string aswell}
begin {if all true then we've found the text}
{highlight the word}
fEditor.SetFocus;
fEditor.SelStart := index;
fEditor.SelLength := FindTextLength;

{quit the function}
Result := true; {because we've found the word}
Exit;
end
{if we've tried the last character and we can't find it then
display a message saying so.}
else if (index = finish) and (FindActionOnEnd = frcAlertUser) then
ShowMessage( TextToFind + ' could not be found' )
{otherwise if the replace function requested us to keep quiet
about it then don't display the message to the user}
else if (index = finish) and (FindActionOnEnd = frcAlertReplace) then
FindActionOnEnd := frcEndReached;

Result := false; {didn't find it}
end;

procedure TFindReplace.OnFind( Sender: TObject );
var
highlightedText: pChar;

begin
{handle all the user options}
ProcessCriteria( Sender as TFindDialog );

{check if there is already some highlighted text. If there is and
this text is the text to search for then it's probably been highlighted
by the previous find operation. In this case, move selStart to
the position after the final character so the find operation won't find
the same word again. If the user chose to search up then move selStart
to the character before the highlighted word}
if fEditor.SelLength > 0 then
begin
GetMem( highlightedText, fEditor.SelLength + 1 );
fEditor.GetSelTextBuf( highlightedText, fEditor.SelLength+1 );

{compare the two strings}
if StrIComp( highlightedText, pChar( fFindDialog.FindText ) ) = 0 then
begin
if frDown in (Sender as TFindDialog).Options then
fEditor.selStart := fEditor.SelStart + fEditor.SelLength
else fEditor.selStart := fEditor.SelStart - 1;
end;

FreeMem( highlightedText, fEditor.SelLength + 1 );
end;

{set the text to find to the findtext field of the find dialog}
TextToFind := (Sender as TFindDialog).FindText;

{begin the search}
if frDown in (Sender as TFindDialog).Options then {the user choose to search down}
begin
{if the user has highlighted a block of text only search
within that block}
if fEditor.SelLength > 0 then
FindForwards( (Sender as TFindDialog), fEditor.selStart, fEditor.selStart + fEditor.selLength )
{otherwise search the whole of the text}
else FindForwards( (Sender as TFindDialog), fEditor.selStart, fEditor.GetTextLen );
end
else {the user chose to search up}
begin
{if the user has highlighted a block of text only search
within that block}
if fEditor.SelLength > 0 then
FindBackwards( fEditor.selStart, fEditor.selStart + fEditor.selLength )
{otherwise search the whole of the text}
else FindBackwards( 0, fEditor.selStart );
end;

end;

procedure TFindReplace.OnReplace( Sender: TOBject );
begin
ProcessCriteria( fReplaceDialog );

{set the action on end to alert the function not the user}
FindActionOnEnd := frcAlertReplace;

{set the text to find to the findtext field of the replace dialog}
TextToFind := fReplaceDialog.FindText;

{now replace the word}
if frReplace in fReplaceDialog.Options then
DoReplace
else DoReplaceAll;

{reset the action on end to alert the user}
FindActionOnEnd := frcAlertUser;
end;

procedure TFindReplace.DoReplace;
begin

{if the user has highlighted a block of text only replace
within that block}
if fEditor.SelLength > 0 then
begin
FindForwards( fReplaceDialog, fEditor.selStart, fEditor.selStart + fEditor.selLength );
TryAndReplace;
end
{otherwise replace within the whole of the text}
else
begin
FindForwards( fReplaceDialog, fEditor.selStart, fEditor.GetTextLen );
TryAndReplace;
end;

end;

procedure TFindReplace.DoReplaceAll;
begin
{see comments for DoReplace}

if fEditor.SelLength > 0 then
begin
FindForwards( fReplaceDialog, fEditor.selStart, fEditor.selStart + fEditor.selLength );
{keep replacing until we reach the end of the text}
while FindActionOnEnd <> frcEndReached do
begin
{we enclose the TryAndReplace in a loop because there might be more
than one occurence of the word in the line}
while TryAndReplace do
FindForwards( fReplaceDialog, fEditor.selStart, fEditor.selStart + fEditor.selLength );

FindForwards( fReplaceDialog, fEditor.selStart, fEditor.selStart + fEditor.selLength );
end;
end
else
begin
FindForwards( fReplaceDialog, fEditor.selStart, fEditor.GetTextLen );
while FindActionOnEnd <> frcEndReached do
begin
while TryAndReplace do
FindForwards( fReplaceDialog, fEditor.selStart, fEditor.GetTextLen );

FindForwards( fReplaceDialog, fEditor.selStart, fEditor.GetTextLen );
end;
end;

end;

function TFindReplace.TryAndReplace: boolean;
{returns true if a replacement was made and false otherwise. This is
so a function can keep calling TryAndReplace until it returns false
since there might be more than one occurence of the word to replace
in the line}

var
LineNumber, ColumnNumber: integer;
ReplacementString: string; {string used to replace the text}

OldSelStart: integer; {the position of the cursore prior to the text
being replaced}


begin
{assume no replacement was made}
Result := false;

{check to see if the word was found otherwise we don't add the
replaceText to the editor. That is, only delete the selected text
and insert the replacement text if the end was not reached}
if not (FindActionOnEnd = frcEndReached) then
begin
{get the line number and column number of the cursor which
is needed for string manipulations later. We should do this
before the call to clear selection}
GetLineNumber( fEditor.SelStart, LineNumber, ColumnNumber );
{get the position of the cursor prior to the replace operation
so we cab restore it later}
OldSelStart := fEditor.SelStart;

{delete the unwanted word}
fEditor.ClearSelection;

{Add the replacement text}
{Since we can't directly manipulate the Lines field of the
TCustomMemo component we'll extract the line, manipulate it
then put it back}
ReplacementString := fEditor.Lines[ LineNumber ];
{truncate the newline (#$A#$D) at the end of tempstring}
SetLength( ReplacementString, Length( ReplacementString )-2 );
{add the replacement text into tempstring}
Insert( fReplaceDialog.ReplaceText, ReplacementString, ColumnNumber+1 );
{remove the old string and add the new string into the editor}
fEditor.Lines.Delete( LineNumber );
fEditor.Lines.Insert( LineNumber, ReplacementString );

{set the result to true since we have made a replacement}
Result := true;

{reposition the cursor to the character after the last chracter in
the newly replacing text. This is mainly so we can locate multiple
occurences of the to-be-replaced text in the same line}
fEditor.SelStart := oldSelStart + length( fReplaceDialog.ReplaceText );
end
end;

procedure TFindReplace.FindExecute;
begin
fFindDialog.Execute;
end;

procedure TFindReplace.ReplaceExecute;
begin
fReplaceDialog.Execute;
end;

function TFindReplace.TestWholeWord( Sender: TFindDialog; TestString: string ): boolean;
begin
{assume it's not a whole word}
Result := false;

{if the user didn't choose whole words only then basically
we don't care about it so return true}
if not (frWholeWord in Sender.Options) then
begin
Result := true;
Exit;
end;

{Test if the word is a whole word}
{Basically there are 4 cases: ( _ denotes whitespace )
1. _word_
2. \nword_
3. _word\n
4.\nword\n}
{case 1, note: #9 tab, #$A newline}
if (TestString[1] in [' ', #9 ]) and (TestString[FindTextLength + 2] in [' ', #9 ]) then
Result := true
{case 2}
else if(TestString[1] = #$A) and (TestString[FindTextLength + 2] in [' ', #9 ]) then
Result := true
{case 3, note: #$D end of line}
else if(TestString[1] in [' ', #9 ]) and (TestString[FindTextLength + 2] = #$D) then
Result := true
else if (TestString[1] = #$A) and (TestString[FindTextLength + 2] = #$D) then
Result := true

end;

procedure TFindReplace.FindNext;
begin
FindNext( 'Please chose a search word' );
end;

procedure TFindReplace.FindNext( errorMessage: string );
begin

if fFindDialog.FindText = '' then
begin
ShowMessage( errorMessage );
Exit;
end;

{I'm not sure if I should pass fFindDialog as sender}
OnFind( fFindDialog );
end;

procedure TFindReplace.GetLineNumber( Position: Integer; var LineNumber, ColumnNumber: integer );
var
i: integer;

begin
{initialise line number to 0}
LineNumber := 0;

{increment line number each time we encounter a newline (#$D) in the text}
for i := 1 to Position do
if fEditor.Text = #$D then
inc( LineNumber );

{set the column number to position first}
ColumnNumber := Position;
{get the columnNumber by subtracting the length of each previous line}
for i := 0 to (LineNumber-1) do
dec( ColumnNumber, Length( fEditor.Lines ) );

end;

procedure TFindReplace.GoToLine( LineNumber: integer );
var
currentLine: integer;
i: integer;

begin
{set the current line to 1}
currentLine := 1;

{go through the whole text looking for the line}
for i := 1 to fEditor.GetTextLen do
begin
if currentLine = LineNumber then
begin
{goto the position corresponding to the line}
fEditor.selStart := i;
fEditor.SetFocus;
{quit the function}
Exit;
end
else if fEditor.Text = #$D then
inc( currentLine );
end;

end;

procedure Register;
begin
RegisterComponents('Tek-tips', [TFindReplace]);
end;

end.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top