marksearch.pas

richviewaction 1.58 需要richview 1.9.46

{*******************************************************}
{                                                       }
{       RichView                                        }
{       Functions for highlighting substrings in        }
{       RichView                                        }
{                                                       }
{       Copyright (c) Sergey Tkachenko                  }
{       [e-mail]                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}

unit MarkSearch;

interface
uses Windows, Graphics, SysUtils, RVUni, CRVData, CRVFData, RVFuncs, RVStyle,
  RVItem, RVTable, RichView, RVScroll;

{
  The functions mark all occurences of s in RVData with (Color, BackColor).
  If RVData is nil (or omitted), rv.RVData is used.
  Both functions search both in Unicode and ANSI text items.
  Options:
    WholeWords (words are defined as characters between two characters from
      rv.Delimiters)
    IgnoreCase (for Unicode text, works only on WinNT-based systems
      (Win2000, WinXP...))
  Return value:
    number of marks. If it is positive, call rv.Format.
    If you call this function for TRichViewEdit, call ClearUndo.
}


function MarkSubStringA(const s: String;
  Color, BackColor: TColor; IgnoreCase, WholeWords: Boolean; rv: TCustomRichView;
  RVData: TCustomRVData=nil): Integer;
function MarkSubStringW(const s: WideString;
  Color, BackColor: TColor; IgnoreCase, WholeWords: Boolean; rv: TCustomRichView;
  RVData: TCustomRVData=nil): Integer;

implementation

type TSetOfChar = set of Char;

// Returns the address of the first occurence of SubStr in S (nil if not found).
// Copied from JVCL, fixed
function StrPosW(S, SubStr: PWideChar): PWideChar;
var
  P: PWideChar;
  I: Integer;
begin
  Result := nil;
  if (S = nil) or (SubStr = nil) or
    (S[0] = #0) or (SubStr[0] = #0) then
    Exit;
  Result := S;
  while Result[0] <> #0 do
  begin
    if Result[0] <> SubStr[0] then
      Inc(Result)
    else
    begin
      P := Result + 1;
      I := 1; // fix
      while (P[0] <> #0) and (P[0] = SubStr[I]) do
      begin
        Inc(I);
        Inc(P);
      end;
      if SubStr[I] = #0 then
        Exit
      else
        Inc(Result);
    end;
  end;
  Result := nil;
end;

// Returns the index of the last occurence of Substr in Str.
// If IgnoreCase=True, the search is not case sensitive, assuming that Substr is
// in lower case
// If DelimSet is not empty, the function returns only occurence as word
function LastPosAA(const Substr, Str: String; IgnoreCase: Boolean;
  DelimSet: TSetOfChar): Integer;
var PSubstr, PStr, PStart: PChar;
    Len, SubLen: Integer;
    Str2: String;
begin
  Result := 0;
  if IgnoreCase then begin
    Str2 := AnsiLowerCase(Str);
    PStr := PChar(Str2);
    end
  else
    PStr := PChar(Str);
  PStart := PStr;
  PSubStr := PChar(Substr);
  Len := Length(Str);
  SubLen := Length(Substr);
  repeat
    PStr := AnsiStrPos(PStr, PSubstr);
    if PStr=nil then
      exit;
    if (DelimSet=[]) or
       (((PStr=PStart) or (PStr[-1] in DelimSet)) and
        ((PStart+Len=PStr+SubLen) or (PStr[SubLen] in DelimSet))) then
      Result := PStr-PStart+1;
    inc(PStr);
  until PStr[0]=#0;
end;

// Returns the first occurence of Chr in Str, or nil if not found
function StrScanW(Str: PWideChar; Chr: WideChar; StrLen: Cardinal): PWideChar;
asm
       TEST    EAX, EAX
       JZ      @@Exit        // get out if the string is nil or StrLen is 0
       JCXZ    @@Exit
@@Loop:
       CMP     [EAX], DX     // this unrolled loop is actually faster on modern processors
       JE      @@Exit        // than REP SCASW
       ADD     EAX, 2
       DEC     ECX
       JNZ     @@Loop
       XOR     EAX, EAX
@@Exit:
end;

// For WinTN-based OS, returns lower case string of S, otherwise returns S.
function WideLowerCase(S: PWideChar; Len: Integer): WideString;
begin
  Result := S;
  if RVNT then
    CharLowerBuffW(Pointer(Result), Len);
end;

// Returns the index of the last occurence of Substr in Str ("raw Unicode strings")
// If IgnoreCase=True, the search is not case sensitive, assuming that Substr is
// in lower case (works only in WinNT-based OS, otherwise the search is always
// case sensitive
// If DelimW<>'', the function returns only occurence as word
function LastPosWW(const Substr, Str: String; IgnoreCase: Boolean;
  DelimW: PWideChar; DelimWLen: Integer): Integer;
var PSubstr, PStr, PStart: PWideChar;
    Len, SubLen: Integer;
    Str2: WideString;
begin
  Result := 0;
  if IgnoreCase then begin
    Str2 := WideLowerCase(Pointer(Str), Length(Str) div 2);
    PStr := Pointer(Str2);
    end
  else
    PStr := Pointer(Str);

  PStart := PStr;
  PSubStr := Pointer(Substr);
  Len := Length(Str) div 2;
  SubLen := Length(Substr) div 2;
  repeat
    PStr := StrPosW(PStr, PSubstr);
    if PStr=nil then
      exit;
    if (DelimWLen=0) or
       (((PStr=PStart) or (StrScanW(DelimW, PStr[-1], DelimWLen)<>nil)) and
        ((PStart+Len=PStr+SubLen) or (StrScanW(DelimW, PStr[SubLen], DelimWLen)<>nil))) then
      Result := PStr-PStart+1;
    inc(PStr);
  until PStr[0]=#0;
end;

// This function returns the index of text style representing marked text
function GetMarkedStyle(RVStyle: TRVStyle; StyleNo: Integer;
  AColor, ABackColor: TColor): Integer;
begin
  Result := RVStyle.TextStyles.FindStyleWithColor(StyleNo, clBlack, clSkyBlue);
  if Result<0 then begin
    Result := RVStyle.TextStyles.Count;
    with RVStyle.TextStyles.Add do begin
      Assign(RVStyle.TextStyles[StyleNo]);
      if AColor<>clNone then
        Color := AColor;
      if ABackColor<>clNone then
        BackColor := ABackColor;
      Standard := False;
    end;
  end;
end;

// Marks substrings in RVData (including all tables in it).
// For ANSI text items, this function marks s.
// For Unicode text items, this function marks ws ("raw Unicode string")
function MarkSubString_(RVData: TCustomRVData; const s, sw: String;
  Color, BackColor: TColor; IgnoreCase: Boolean; DelimSet: TSetOfChar;
  DelimW: PWideChar; DelimWLen: Integer): Integer;
var i,r,c,p: Integer;
    table: TRVTableItemInfo;
    ItemText, s1, s2, s3: String;
    item: TRVTextItemInfo;
    ItemOptions: TRVItemOptions;
begin
  Result := 0;
  i := RVData.ItemCount-1;
  while i>=0 do begin
    if RVData.GetItemStyle(i)=rvsTable then begin
      table := TRVTableItemInfo(RVData.GetItem(i));
      for r := 0 to table.Rows.Count-1 do
        for c := 0 to table.Rows[0].Count-1 do
          if table.Cells[r,c]<>nil then
            inc(Result, MarkSubString_(table.Cells[r,c].GetRVData, s, sw,
              Color, BackColor, IgnoreCase, DelimSet, DelimW, DelimWLen));
      end
    else if RVData.GetItemStyle(i)>=0 then begin
      ItemText := RVData.GetItemText(i);
      ItemOptions := RVData.GetItem(i).ItemOptions;
      if rvioUnicode in ItemOptions then
        p := LastPosWW(sw, ItemText, IgnoreCase, DelimW, DelimWLen)
      else
        p := LastPosAA(s, ItemText, IgnoreCase, DelimSet);
      if p>0 then begin
        inc(Result);
        s1 := RVU_Copy(ItemText, 1, p-1, ItemOptions);
        s2 := RVU_Copy(ItemText, p, Length(s), ItemOptions);
        s3 := RVU_Copy(ItemText, p+Length(s), Length(ItemText)-(p+Length(s))+1,
          ItemOptions);
        if s3<>'' then begin
          item := RichViewTextItemClass.Create(RVData);
          item.Assign(RVData.GetItem(i));
          item.Tag := RV_CopyTag(RVData.GetItemTag(i), rvoTagsArePChars in RVData.Options);
          item.SameAsPrev := True;
          item.Inserting(RVData, s3, False);
          RVData.Items.InsertObject(i+1, s3, item);
          item.Inserted(RVData, i+1);
        end;
        if s1='' then begin
          RVData.GetItem(i).StyleNo := GetMarkedStyle(RVData.GetRVStyle,
            RVData.GetItemStyle(i), Color, BackColor);
          RVData.SetItemText(i, s2);
          end
        else begin
          item := RichViewTextItemClass.Create(RVData);
          item.Assign(RVData.GetItem(i));
          item.Tag := RV_CopyTag(RVData.GetItemTag(i), rvoTagsArePChars in RVData.Options);
          item.StyleNo := GetMarkedStyle(RVData.GetRVStyle, item.StyleNo,
            Color, BackColor);
          item.SameAsPrev := True;
          item.Inserting(RVData, s2, False);
          RVData.Items.InsertObject(i+1, s2, item);
          item.Inserted(RVData, i+1);
          RVData.SetItemText(i, s1);
          inc(i);
        end;
      end;
    end;
    dec(i);
  end;
end;

// Fills DelimSet and DelimWStr ("raw Unicode string") from Delimiters
procedure MakeTempDelim(const Delimiters: String; WholeWords: Boolean;
  CodePage: TRVCodePage; var DelimSet: TSetOfChar; var DelimWStr: String);
var i: Integer;
begin
  DelimSet := [];
  DelimWStr := '';
  if WholeWords then begin
    for i := 1 to Length(Delimiters) do
      DelimSet := DelimSet+[Delimiters[i]];
    DelimWStr := RVU_AnsiToUnicode(CodePage, Delimiters);
  end;
end;

function MarkSubStringA(const s: String;
  Color, BackColor: TColor; IgnoreCase, WholeWords: Boolean; rv: TCustomRichView;
  RVData: TCustomRVData=nil): Integer;
var
  DelimSet: TSetOfChar;
  DelimW: PWideChar; DelimWLen: Integer;
  substr, substrw, DW: String;
begin
  if RVData=nil then
    RVData := rv.RVData;
  if IgnoreCase then
    substr := AnsiLowerCase(s)
  else
    substr := s;
  if RVNT then
    substrw := RVU_AnsiToUnicode(rv.Style.DefCodePage, substr)
  else
    substrw := RVU_AnsiToUnicode(rv.Style.DefCodePage, s);
  MakeTempDelim(rv.Delimiters, WholeWords, rv.Style.DefCodePage, DelimSet, DW);
  DelimW := Pointer(DW);
  DelimWLen := Length(DW) div 2;
  Result := MarkSubString_(RVData, substr, substrw, Color, BackColor, IgnoreCase,
    DelimSet, DelimW, DelimWLen)
end;

function MarkSubStringW(const s: WideString;
  Color, BackColor: TColor; IgnoreCase, WholeWords: Boolean; rv: TCustomRichView;
  RVData: TCustomRVData=nil): Integer;
var
  DelimSet: TSetOfChar;
  DelimW: PWideChar; DelimWLen: Integer;
  s2: WideString;
  substr, substrw, DW: String;
begin
  if RVData=nil then
    RVData := rv.RVData;
  if IgnoreCase then
    s2 := WideLowerCase(PWideChar(s), Length(s))
  else
    s2 := s;
  substrw := RVU_GetRawUnicode(s2);
  substr := RVU_UnicodeToAnsi(rv.Style.DefCodePage, substrw);
  MakeTempDelim(rv.Delimiters, WholeWords, rv.Style.DefCodePage, DelimSet, DW);
  DelimW := Pointer(DW);
  DelimWLen := Length(DW) div 2;
  Result := MarkSubString_(RVData, substr, substrw, Color, BackColor, IgnoreCase,
    DelimSet, DelimW, DelimWLen)
end;

end.