如何在memo中用Finddialog进行查找

[ruive]

请各位高手帮忙叫个代码~~~Finddialog不能自动查找...得自己写代码好像.

[knife_s]

pos(S1,S2);

[ruive]

能不能给个完整一点的代码呢?

[liutianfeiyun]

unit Search;

interface

uses WinProcs, SysUtils, StdCtrls, Dialogs,ComCtrls;

const

//wordDelimiters: set of Char = [#0..#255] - ['a'..'z', 'A'..'Z', '1'..'9', '0']; 　
wordDelimiters : set of Char = [#0..#255] - ['a'..'z', 'A'..'Z', '1'..'9','0'];
//function SearchMemo(Memo: TCustomEdit; const SearchString: string; Options: TFindOptions): Boolean;　
function SearchRichEdit(RichEdit : TCustomRichEdit; Const SearchString : string; Options : TFindOptions): boolean ;
//function SearchBuf(Buf: PChar; BufLen: Integer;SelStart, SelLength: Integer; SearchString: string; Options: TFindOptions): PChar;　
function SearchBuf(Buf : PChar; BufLen : Integer; Selstart,SelLength : integer; SearchString : string; Options : TFindOptions): PChar;
//implementation
implementation
function SearchRichEdit(RichEdit : TCustomRichEdit; Const SearchString : string; Options : TFindOptions): boolean ;
var
Buffer, P: PChar;
Size: Word;
begin
Result := false;

if (Length(SearchString) = 0) then
Exit;

Size := RichEdit.GetTextLen;

if (Size = 0) then
Exit;

Buffer := StrAlloc(Size + 1);

try

RichEdit.GetTextBuf(Buffer, Size + 1);

P := SearchBuf(Buffer, Size, RichEdit.SelStart, RichEdit.SelLength,
SearchString, Options);

if P <> nil then

begin
RichEdit.SelStart := P - Buffer;

RichEdit.SelLength := Length(SearchString);

Result := true;
end;

finally

StrDispose(Buffer);
end;
end;
function SearchBuf(Buf : PChar; BufLen : Integer; Selstart,SelLength : integer; SearchString : string; Options : TFindOptions): PChar;
var
SearchCount, I: Integer;
C: Char;
Direction: Shortint;
CharMap: array [Char] of Char;
function FindNextWordStart(var BufPtr: PChar): Boolean;
begin { (True XOR N) is equivalent to

(not N) }

Result := false; { (False XOR N) is equivalent

to (N) }

{ When Direction is forward (1), skip non

delimiters, then skip delimiters. }

{ When Direction is backward (-1), skip delims, then

skip non delims }

while (SearchCount > 0) and

((Direction = 1) xor (BufPtr^ in

WordDelimiters)) do

begin
Inc(BufPtr, Direction);

Dec(SearchCount);
end;

while (SearchCount > 0) and

((Direction = -1) xor (BufPtr^ in

WordDelimiters)) do

begin
Inc(BufPtr, Direction);

Dec(SearchCount);
end;

Result := SearchCount > 0;

if Direction = -1 then

begin { back up one char, to leave ptr on first non

delim }

Dec(BufPtr, Direction);

Inc(SearchCount);
end;
end;
begin
Result := nil;
if BufLen <= 0 then
Exit;
if frDown in Options then
begin
Direction := 1;
Inc(SelStart, SelLength); { start search past end of
selection }

SearchCount := BufLen - SelStart - Length(SearchString);

if SearchCount < 0 then
Exit;

if Longint(SelStart) + SearchCount > BufLen then

Exit;
end

else

begin
Direction := -1;

Dec(SelStart, Length(SearchString));

SearchCount := SelStart;
end;

if (SelStart < 0) or (SelStart > BufLen) then
Exit;

Result := @Buf[SelStart];
{ Using a Char map array is faster than calling

AnsiUpper on every character }

for C := Low(CharMap) to High(CharMap) do

CharMap[C] := C;
if not (frMatchCase in Options) then
begin
AnsiUpperBuff(PChar(@CharMap), SizeOf(CharMap));
AnsiUpperBuff(@SearchString[1],Length(SearchString));
end;
while SearchCount > 0 do
begin
if frWholeWord in Options then
if not FindNextWordStart(Result) then
Break;
I := 0;
while (CharMap[Result[I]] = SearchString[I + 1]) do
begin
Inc(I);
if I >= Length(SearchString) then
begin
if (not (frWholeWord in Options)) or
(SearchCount = 0) or
(Result[I] in WordDelimiters) then
Exit;
Break;
end;
end;
Inc(Result, Direction);
Dec(SearchCount);
end;
Result := nil;
end;
end.

[yuqianyi1974]

procedure TForm1.Button1Click(Sender: TObject);
begin
  finddialog1.Execute;
end;

procedure TForm1.FindDialog1Find(Sender: TObject);
var
  I, J, PosReturn, SkipChars: Integer;
begin
  for I := 0 to Memo1.Lines.Count do
  begin
    PosReturn := Pos(FindDialog1.FindText,Memo1.Lines[I]);
    if PosReturn <> 0 then {found!}
    begin
      SkipChars := 0;
      for J := 0 to I - 1 do
        SkipChars := SkipChars + Length(Memo1.Lines[J]);
      SkipChars := SkipChars + (I*2);
      SkipChars := SkipChars + PosReturn - 1;

      Memo1.SetFocus;
      Memo1.SelStart := SkipChars;
      Memo1.SelLength := Length(FindDialog1.FindText);
      Break;
    end;
  end;

[genispan]

[Quote=引用 4 楼 yuqianyi1974 的回复:]
Delphi(Pascal) code
procedure TForm1.Button1Click(Sender: TObject);
begin
finddialog1.Execute;
end;

procedure TForm1.FindDialog1Find(Sender: TObject);
var
I, J, PosReturn, SkipChars: Integer;
begin
for I := 0 to Memo1.Lines.Count do
begin
PosReturn := Pos(FindDialog1.FindText,Memo1.Lines[I]);
if PosReturn <> 0 then {found!}
begin
SkipChars := 0;
f…
[/Quote]

[ruive]

[Quote=引用 4 楼 yuqianyi1974 的回复:]
Delphi(Pascal) code
procedure TForm1.Button1Click(Sender: TObject);
begin
finddialog1.Execute;
end;

procedure TForm1.FindDialog1Find(Sender: TObject);
var
I, J, PosReturn, SkipChars: Integer;
begin
for I := 0 to Memo1.Lines.Count do
begin
PosReturn := Pos(FindDialog1.FindText,Memo1.Lines[I]);
if PosReturn <> 0 then {found!}
begin
SkipChars := 0;
f…
[/Quote]



只能查找到第一个相同的,我要继续查找下一个相同的字符串呢?该怎么做?

[ruive]

我已经自己搞定了...谢谢咯

[ruive]

我已经自己搞定了...谢谢咯