0,0 → 1,511 |
unit FindReplace; |
|
// Source: http://www.tek-tips.com/viewthread.cfm?qid=160357 |
// Some changed by Daniel Marschall, especially to make it compatible with TSynEdit |
|
interface |
|
uses |
Windows, Messages, SysUtils, Classes, Dialogs, SynEdit; |
|
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: TSynEdit; {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; |
|
property _FindDialog: TFindDialog read fFindDialog; |
property _ReplaceDialog: TReplaceDialog read fReplaceDialog; |
|
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: TSynEdit |
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; |
highlightedText: string; |
|
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 ); |
*) |
highlightedText := fEditor.SelText; |
|
{compare the two strings} |
if StrIComp( PChar(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 (CharInSet(TestString[1], [' ', #9 ])) and (CharInSet(TestString[FindTextLength + 2], [' ', #9 ])) then |
Result := true |
{case 2} |
else if(TestString[1] = #$A) and (CharInSet(TestString[FindTextLength + 2], [' ', #9 ])) then |
Result := true |
{case 3, note: #$D end of line} |
else if(CharInSet(TestString[1], [' ', #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 )*) fEditor.Lines.Strings[i].Length ); |
|
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. |