Hallo,

ich verwende die alte Unit search.pas für die Suche in Memos und versuche diese nun unter D2010 lauffähig zu bekommen.
Habe das ganze soweit anscheinend auch hinbekommen.
Das Problem ist nun, dass der Suchtext gefunden wird, aber im Memo die Markierung der gefundenen
Zeichenfolge ein paar Zeichen zu weit hinten beginnt.
Bei der ersten Fundstelle sind es zunächst zwei Zeichen, kommt der Suchtext öfter im Memo vor
verschiebt sich die Markierung immer weiter nach hinten.
Bin ein Unicode-Anfänger - vermutlich hat es etwas damit zu tun?

Oder gibt es unter D2010 was besseres für den Zweck?

Danke für jeden Tip.

Jürgen

zusammenfalten · markieren

Delphi-Quellcode:

unit Search;

interface

uses WinProcs, SysUtils, StdCtrls, Dialogs, Character;


function SearchMemo(Memo: TCustomEdit;
                    const SearchString: String;
                    Options: TFindOptions): Boolean;

{ SearchBuf is a lower-level search routine for arbitrary text buffers.  Same
  rules as SearchMemo above.  If a match is found, the function returns a
  pointer to the start of the matching string in the buffer.  If no match,
  the function returns nil. }
function SearchBuf(Buf: PChar; BufLen: Integer;
                   SelStart, SelLength: Integer;
                   SearchString: String;
                   Options: TFindOptions): PChar;

implementation


function SearchMemo(Memo: TCustomEdit;
                    const SearchString: String;
                    Options: TFindOptions): Boolean;
var
  Buffer, P: PChar;
  Size: Integer;
begin
  Result := False;
  if (Length(SearchString) = 0) then Exit;
  Size:=Memo.GetTextLen;
  Inc(Size);
  if (Size=0) then Exit;
  Buffer:=StrAlloc(Size);
  try
    Memo.GetTextBuf(Buffer,Size);
    P:=SearchBuf(Buffer, Size, Memo.SelStart, Memo.SelLength, SearchString, Options);
    if P <> nil then
    begin
      Memo.SetFocus;
      Memo.SelStart:=P-Buffer;
      Memo.SelLength:=Length(SearchString);
      Memo.Repaint;
      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, Z: 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 (CharInSet(BufPtr^, [#0..#255] - ['a'..'z','A'..'Z','1'..'9','0']))) do
    begin
      Inc(BufPtr, Direction);
      Dec(SearchCount);
    end;
    while (SearchCount > 0) and
          ((Direction = -1) xor (CharInSet(BufPtr^, [#0..#255] - ['a'..'z','A'..'Z','1'..'9','0']))) 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
      begin
      if not (frMatchCase in Options) then CharMap[C]:=ToUpper(C) else CharMap[C]:=C;
      end;

  if not (frMatchCase in Options) then SearchString:=UpperCase(SearchString);

  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
            CharInSet(Result[I],[#0..#255] - ['a'..'z','A'..'Z','1'..'9','0']) then
            Exit;
        Break;
      end;
    end;
    Inc(Result, Direction);
    Dec(SearchCount);
  end;
  Result := nil;
end;

end.

Hast du mal geschaut, welche Zeilenumbrüche in Buffer vorhanden sind?

SelStart verwendet den Windows-Standard #13#10.


PS: ich würde die CharMap nicht mehr Zeichen für Zeichen ins UpperCase übersetzen, sondern gleich alles auf einmal ... immerhin sind es dank Unicode ja nun 65-tausend und keine 256 Zeichen mehr.

Und diese 128 KB der CharMap machen sich nicht so gut auf'm Stack.
(glaub's mir, hab das in meinem himXML anfangs auch so versucht und Delphi abeitet nicht so gut, wenn der Stack mit zuvielen lokalen Variablen belegt wird)

Ja - damit hat es definitiv was zu tun.
Es sieht nämlich so aus als wären immer zwei Vorschübe drin.
Auszug aus dem Buffer:
'Zeile1'#$D#$A#$D#$A'Zeile2.......

Zwischen Zeile1 und Zeile2 ist nur eine Leerzeile im Memo drin.

Die CharMap habe ich früher mit
AnsiUpperBuff(PChar(@CharMap), sizeof(CharMap)); übersetzt.
Irgendwie habe das passende unter D2010 Unicode noch nicht gefunden - ich kämpfe......

Zitat von Hazebukelar:

Ja - damit hat es definitiv was zu tun.

#$D#$A ist schon das #13#40, also liegt es schonmal nicht daran und die Indizierung muß irgendwo anders falsch zählen.



CharUpperBuff aus der Unit Windows.

PS: in himXML nutze ich auch soein Vergleichsarray und 'nen Auszug ist auch dort
http://www.delphipraxis.net/internal....php?p=1062424 verbaut (falls man nicht im großen Projekt abgucken will)

hab die Ursache gefunden:
#$D wird als ein Zeichen gezählt und #$A ebenfalls.
Das gibt genau den Versatz.
Oh je - wie gewöhne ich das dem ab......

Eigentlich ist es so OK, da SelStart/SelLength diese auch als je ein Zeichen ansehn.

Ja - so ist es und genau das ist das Problem.
Trotzdem Danke - wenigstens habe ich die Ursache gefunden.