unit Share;

interface

uses SysUtils,Windows,Classes,Graphics,Math;

procedure HandleKeyColor(Lines:TStrings; const Key:WideString; OutTexts:TList);
procedure GetDrawTextLines(ACanvas: TCanvas; const Text: WideString;  const R: TRect; Lines: TStrings);
implementation

const
  QSCutOff = 15;

type
  THackStrings=class(TStrings);
  TCompareFunc = function (Data1, Data2 : Pointer) : integer;
  TOutTextInfo=record
    Index:integer;
    StartPos:integer;
    EndPos:integer;
    FontColor:TColor;  //前景色
    BackColor:TColor;  //背景色
    Level:integer;     //关键字的级别，高级别的关键字在界面上会优先显示
    CanShow:Boolean;   //等于True才可以在界面上进行绘制
  end;
  POutTextInfo=^TOutTextInfo;
  
procedure QSInsertionSort(List    : TList;
                          First   : integer;
                          Last    : integer;
                          Compare : TCompareFunc);
var
  i, j       : integer;
  IndexOfMin : integer;
  Temp       : Pointer;
begin
  IndexOfMin := First;
  j := QSCutOff;
  if (j > Last) then
    j := Last;
  for i := Succ(First) to j do
    if (Compare(List.List^[i], List.List^[IndexOfMin]) < 0) then
      IndexOfMin := i;
  if (First <> IndexOfMin) then begin
    Temp := List.List^[First];
    List.List^[First] := List.List^[IndexOfMin];
    List.List^[IndexOfMin] := Temp;
  end;
  for i := First+2 to Last do begin
    Temp := List.List^[i];
    j := i;
    while (Compare(Temp, List.List^[j-1]) < 0) do begin
      List.List^[j] := List.List^[j-1];
      Dec(j);
    end;
    List.List^[j] := Temp;
  end;
end;

procedure QS(List    : TList;
             First   : integer;
             Last    : integer;
             Compare : TCompareFunc);
var
  L, R  : integer;
  Pivot : Pointer;
  Temp  : Pointer;
  Stack : array [0..63] of integer;
  SP    : integer;
begin
  Stack[0] := First;
  Stack[1] := Last;
  SP := 2;

  while (SP <> 0) do begin
    Dec(SP, 2);
    First := Stack[SP];
    Last := Stack[SP+1];

    while ((Last - First) > QSCutOff) do begin

      R := (First + Last) div 2;
      if (Compare(List.List^[First], List.List^[R]) > 0) then begin
        Temp := List.List^[First];
        List.List^[First] := List.List^[R];
        List.List^[R] := Temp;
      end;
      if (Compare(List.List^[First], List.List^[Last]) > 0) then begin
        Temp := List.List^[First];
        List.List^[First] := List.List^[Last];
        List.List^[Last] := Temp;
      end;
      if (Compare(List.List^[R], List.List^[Last]) > 0) then begin
        Temp := List.List^[R];
        List.List^[R] := List.List^[Last];
        List.List^[Last] := Temp;
      end;
      Pivot := List.List^[R];

      L := First;
      R := Last;
      while True do begin
        repeat Dec(R); until (Compare(List.List^[R], Pivot) <= 0);
        repeat Inc(L); until (Compare(List.List^[L], Pivot) >= 0);
        if (L >= R) then Break;
        Temp := List.List^[L];
        List.List^[L] := List.List^[R];
        List.List^[R] := Temp;
      end;

      if (R - First) < (Last - R) then begin
        Stack[SP] := Succ(R);
        Stack[SP+1] := Last;
        Inc(SP, 2);
        Last := R;
      end
      else begin
        Stack[SP] := First;
        Stack[SP+1] := R;
        inc(SP, 2);
        First := Succ(R);
      end;
    end;
  end;
end;

procedure QuickSort(List:TList; First:integer; Last:integer; Compare:TCompareFunc);
begin
  if (List = nil) then  Exit;
  if (First < 0) or (First >= List.Count) or
     (Last   < 0) or (Last   >= List.Count) or
     (First > Last) then  Exit;
  QS(List, First, Last, Compare);
  QSInsertionSort(List, First, Last, Compare);
end;

function CompareKeyItem(Data1, Data2:Pointer):integer;
var
  Key1:POutTextInfo;
  Key2:POutTextInfo;
begin
  Key1:=Data1;
  Key2:=Data2;
  Result:=Key1.Index-Key2.Index;
  if Result=0 then
  begin
    Result:=Key1.StartPos-Key2.StartPos;
    if Result=0 then
      Result:=Key1.EndPos-Key2.EndPos;
  end;
end;

procedure HandleKeyColor(Lines:TStrings; const Key:WideString; OutTexts:TList);
var
  I, Size, Count, L: Integer;
  P: PAnsiChar;
  S: WideString;
  List:THackStrings;
  Text:WideString;
  Index:integer;
  KeyItem,NextItem,PrevItem:POutTextInfo;
  ItemSizes:array of integer;
  FindNum,FindToken:Boolean;
  NumIndex,TokenIndex:integer;
  NumCount:integer;
  procedure AddKeyItem(const Key:WideString; Index:integer; FontColor,BackColor:TColor; Level:integer);
  var
    I,Size,L,PrevSize:integer;
  begin
    Size:=Length(Key);
    for I:=0 to List.Count-1 do
    begin
      if (I=0) then
        PrevSize:=1
      else
        PrevSize:=ItemSizes[I-1]+1;
      if (Index>=PrevSize) and (Index<=ItemSizes[I]) then
      begin
        New(KeyItem);
        KeyItem.Index:=I;
        KeyItem.StartPos:=Index-PrevSize+1;
        L:=Min(Size,ItemSizes[I]-Index+1);
        KeyItem.EndPos:=KeyItem.StartPos+L-1;
        KeyItem.FontColor:=FontColor;
        KeyItem.BackColor:=BackColor;
        KeyItem.Level:=Level;
        KeyItem.CanShow:=True;
        OutTexts.Add(KeyItem);
        Dec(Size,L);
        if Size<=0 then //关键字已经处理结束
          Break
        else
          Inc(Index,L);
      end;
    end;
  end;
begin
  //-------------------------------------------------------------------
  //把Lines中的每行文本拼凑在一起
  List:=THackStrings(Lines);
  Count := List.Count;
  Size := 0;
  SetLength(ItemSizes,Count);
  for I := 0 to Count - 1 do
  begin
    S:=List.Get(I);
    Inc(Size, Length(S));
    ItemSizes[I]:=Size;
  end;
  SetString(Text, nil, Size);
  P := Pointer(Text);
  for I := 0 to Count - 1 do
  begin
    S := List.Get(I);
    L := Length(S);
    if L <> 0 then
    begin
      System.Move(Pointer(S)^, P^, L*2);
      Inc(P, L*2);
    end;
  end;
  //-------------------------------------------------------------------
  //查找第一个关键字
  if Key<>'' then
  begin
    Index:=Pos(Key,Text);
    if Index<>0 then
    begin
      AddKeyItem(Key,Index,clWhite,clHighlight,1); //生成关键字信息
    end;
  end;
  //查找第二个关键字
  Index:=Pos(string('|已成交|'),string(Text));
  if Index<>0 then
  begin
    AddKeyItem('|已成交|',Index,clWhite,clHighlight,0); //生成关键字信息
  end;
  //如果还想添加自己的关键字，请按照上面两个例子依次添加即可
  //下面查找电话号码和时间
  Size:=Length(Text);
  FindNum:=False;
  FindToken:=False;
  NumIndex:=0;
  TokenIndex:=0;
  NumCount:=0;
  for I:=1 to Size do
  begin
    case Text[I] of
      '0'..'9':
      begin
        if not FindToken then
        if not FindNum then
        begin
          FindNum:=True;
          NumIndex:=I;
          NumCount:=1;
        end
        else
          Inc(NumCount);
      end;
      '[':
      begin
        FindToken:=True;
        TokenIndex:=I;
        if FindNum and (NumIndex>3) and (NumCount>=7) then  //在位置3之前出现的号码可能是编号，长度大于7的号码才可能是电话号码
        begin
          AddKeyItem(Copy(Text,NumIndex,I-NumIndex),NumIndex,clMaroon,clWhite,0);
        end;
        FindNum:=False;
        NumCount:=0;
      end;
      ']':
      begin
        if FindToken then
        begin
          AddKeyItem(Copy(Text,TokenIndex,I-TokenIndex+1),TokenIndex,clGrayText,clWhite,0);
          FindToken:=False;
        end
        else
        if FindNum and (NumIndex>3) and (NumCount>=7) then  //在位置3之前出现的号码可能是编号，长度大于7的号码才可能是电话号码
        begin
          AddKeyItem(Copy(Text,NumIndex,I-NumIndex),NumIndex,clMaroon,clWhite,0);
        end;
        FindNum:=False;
        NumCount:=0;
      end;
      '-':
      begin
        if not FindNum then
          NumCount:=0;
      end;
      else
      begin
        if Text[I]=' ' then
        begin
          if FindNum then
            Continue;
        end;
        if FindNum and (NumIndex>3) and (NumCount>=7) then  //在位置3之前出现的号码可能是编号，长度大于7的号码才可能是电话号码
        begin
          AddKeyItem(Copy(Text,NumIndex,I-NumIndex),NumIndex,clMaroon,clWhite,0);
        end;
        FindNum:=False;
        NumCount:=0;
      end;
    end;
  end;
  if OutTexts.Count>0 then
  begin
    QuickSort(OutTexts,0,OutTexts.Count-1,CompareKeyItem); //按关键字出现的先后进行排序
    //关键字之间可能交叉在一起，所以要分开
    PrevItem:=OutTexts[0];
    Count:=OutTexts.Count;
    for  I:=1 to Count-1 do
    begin
      NextItem:=OutTexts[I];
      if PrevItem.Index=NextItem.Index then  //只有在同一行上才可能交叉
      begin
        if (NextItem.StartPos>=PrevItem.StartPos) and (NextItem.StartPos<=PrevItem.EndPos) then  //发生了交叉
        begin
          if (NextItem.StartPos=PrevItem.StartPos) then
          begin
            if NextItem.EndPos< PrevItem.EndPos then
            begin
              if NextItem.Level>=PrevItem.Level then
                PrevItem.StartPos:=NextItem.EndPos+1
              else
                NextItem.CanShow:=False;
            end
            else if NextItem.EndPos=PrevItem.EndPos then
            begin
              if NextItem.Level>=PrevItem.Level then
                PrevItem.CanShow:=False
              else
                NextItem.CanShow:=False;
            end
            else
            begin
              if NextItem.Level>=PrevItem.Level then
                PrevItem.CanShow:=False
              else
                NextItem.StartPos:=PrevItem.EndPos+1;
            end;
          end
          else
          begin
            New(KeyItem);
            KeyItem.Index:=PrevItem.Index;
            KeyItem.StartPos:=PrevItem.StartPos;
            KeyItem.EndPos:=NextItem.StartPos-1;
            KeyItem.FontColor:=PrevItem.FontColor;
            KeyItem.BackColor:=PrevItem.BackColor;
            KeyItem.CanShow:=True;
            OutTexts.Add(KeyItem);
            if NextItem.EndPos<PrevItem.EndPos then
            begin
              if NextItem.Level>=PrevItem.Level then
                PrevItem.StartPos:=NextItem.EndPos+1
              else
              begin
                NextItem.CanShow:=False;
                PrevItem.StartPos:=KeyItem.EndPos+1;
              end;  
            end
            else if NextItem.EndPos=PrevItem.EndPos then
            begin
              if NextItem.Level>=PrevItem.Level then
                PrevItem.CanShow:=False
              else
              begin
                NextItem.CanShow:=False;
                PrevItem.StartPos:=KeyItem.EndPos+1;
              end;
            end
            else
            begin
              if NextItem.Level>=PrevItem.Level then
                PrevItem.CanShow:=False
              else
              begin
                PrevItem.StartPos:=KeyItem.EndPos+1;
                NextItem.StartPos:=PrevItem.EndPos+1;
              end;  
            end;
          end;
        end;
      end;
      PrevItem:=NextItem;
    end;
    if Count<>OutTexts.Count then
      QuickSort(OutTexts,0,OutTexts.Count-1,CompareKeyItem); //按关键字出现的先后进行排序
  end;
  ItemSizes:=nil;
end;

procedure GetDrawTextLines(ACanvas: TCanvas; const Text:
  WideString;  const R: TRect; Lines: TStrings);
var
  Index, i, Len, Count, Total: integer;
  str,S: WideString;
  StrList: TStrings;
  tR:TRect;
begin
  StrList := TStringList.Create;
  StrList.Text := Text;
  for Index := 0 to StrList.Count - 1 do
  begin
    str := StrList.Strings[Index];
    if str<>'' then
    begin
      Total:=Length(str);
      Len:=Total;
      i:=1;
      while Len>0 do
      begin
        tR:=R;
        S:=str;
        S:=PWidechar(S)+Total-Len;
        DrawTextW(ACanvas.Handle,PWidechar(S),Length(S),tR,DT_MODIFYSTRING or DT_CALCRECT or DT_END_ELLIPSIS or DT_LEFT);
        S:=PWideChar(S);
        if Copy(S,Length(S)-2,3)='...' then
          Count:=Length(S)-3
        else
          Count:=Length(S);
        Lines.Add(Copy(Str,i,Count));
        Inc(i,Count);
        Dec(Len,Count);
      end;
    end;
  end;
  StrList.Free;
end;

end.
