Delphi, VirtualStringTree - 간단한 텍스트 스타일 (예 : bbcode) 처리

Question

bbcode와 같은 간단한 텍스트 스타일을 처리하는 가장 좋은 방법은 텍스트의 굵은 기울임 꼴 등을 허용하는 것입니다. 내가 한 일은 텍스트를 부분으로 나눠서 각 부분이 스타일을 지정한 다음 각 부분을 텍스트로 구성하여 Rect.Left + Canvas.TextWidth(Texts[i-1])부터 시작하는 것입니다. 이것은 그러나 아주 느린 것입니다, 게다가 나는 VirtualStringTree의 경우에 그것을 어떻게 텍스트로 만들지 전혀 모른다. OnBeforeItemPaint가 있지만 콜백이 열 인덱스를 인식하지 못합니다. OnBeforeCellPaint하지만 VST를 말하기 위해 변수를 노출시키지 않습니다. 따라서 내 그림에 페인트했습니다. 따라서 내 텍스트에 페인트됩니다 ...

누구든지, 제발? :)

관련, 마이클

Answer 1

HTML 태그의 간단한 하위 집합을 사용하여 비슷한 작업을 수행했습니다. 여기에 텍스트를 그리는 코드입니다 :

function TMyVST.DrawHTML(const ARect: TRect; const ACanvas: TCanvas; const Text: String): Integer; 
(*DrawHTML - Draws text on a canvas using tags based on a simple subset of HTML/CSS 

    <B> - Bold e.g. <B>This is bold</B> 
    <I> - Italic e.g. <I>This is italic</I> 
    <U> - Underline e.g. <U>This is underlined</U> 
    <font-color=x> Font colour e.g. 
       <font-color=clRed>Delphi red</font-color> 
       <font-color=#FFFFFF>Web white</font-color> 
       <font-color=$000000>Hex black</font-color> 
    <font-size=x> Font size e.g. <font-size=30>This is some big text</font-size> 
    <font-family> Font family e.g. <font-family=Arial>This is arial</font-family>*) 

    function CloseTag(const ATag: String): String; 
    begin 
    Result := concat('/', ATag); 
    end; 

    function GetTagValue(const ATag: String): String; 
    var 
    p: Integer; 
    begin 
    p := pos('=', ATag); 

    if p = 0 then 
     Result := '' 
    else 
     Result := copy(ATag, p + 1, MaxInt); 
    end; 

    function ColorCodeToColor(const Value: String): TColor; 
    var 
    HexValue: String; 
    begin 
    Result := 0; 

    if Value <> '' then 
    begin 
     if (length(Value) >= 2) and (copy(Uppercase(Value), 1, 2) = 'CL') then 
     begin 
     // Delphi colour 
     Result := StringToColor(Value); 
     end else 
     if Value[1] = '#' then 
     begin 
     // Web colour 
     HexValue := copy(Value, 2, 6); 

     Result := RGB(StrToInt('$'+Copy(HexValue, 1, 2)), 
         StrToInt('$'+Copy(HexValue, 3, 2)), 
         StrToInt('$'+Copy(HexValue, 5, 2))); 
     end 
     else 
     // Hex or decimal colour 
     Result := StrToIntDef(Value, 0); 
    end; 
    end; 

const 
    TagBold = 'B'; 
    TagItalic = 'I'; 
    TagUnderline = 'U'; 
    TagBreak = 'BR'; 
    TagFontSize = 'FONT-SIZE'; 
    TagFontFamily = 'FONT-FAMILY'; 
    TagFontColour = 'FONT-COLOR'; 
    TagColour = 'COLOUR'; 

var 
    x, y, idx, CharWidth, MaxCharHeight: Integer; 
    CurrChar: Char; 
    Tag, TagValue: String; 
    PreviousFontColour: TColor; 
    PreviousFontFamily: String; 
    PreviousFontSize: Integer; 
    PreviousColour: TColor; 

begin 
    ACanvas.Font.Size := Canvas.Font.Size; 
    ACanvas.Font.Name := Canvas.Font.Name; 
    ACanvas.Font.Color := Canvas.Font.Color; 
    ACanvas.Font.Style := Canvas.Font.Style; 

    PreviousFontColour := ACanvas.Font.Color; 
    PreviousFontFamily := ACanvas.Font.Name; 
    PreviousFontSize := ACanvas.Font.Size; 
    PreviousColour := ACanvas.Brush.Color; 

    x := ARect.Left; 
    y := ARect.Top + 1; 
    idx := 1; 

    MaxCharHeight := ACanvas.TextHeight('Ag'); 

    While idx <= length(Text) do 
    begin 
    CurrChar := Text[idx]; 

    // Is this a tag? 
    if CurrChar = '<' then 
    begin 
     Tag := ''; 

     inc(idx); 

     // Find the end of then tag 
     while (Text[idx] <> '>') and (idx <= length(Text)) do 
     begin 
     Tag := concat(Tag, UpperCase(Text[idx])); 

     inc(idx); 
     end; 

     /////////////////////////////////////////////////// 
     // Simple tags 
     /////////////////////////////////////////////////// 
     if Tag = TagBold then 
     ACanvas.Font.Style := ACanvas.Font.Style + [fsBold] else 

     if Tag = TagItalic then 
     ACanvas.Font.Style := ACanvas.Font.Style + [fsItalic] else 

     if Tag = TagUnderline then 
     ACanvas.Font.Style := ACanvas.Font.Style + [fsUnderline] else 

     if Tag = TagBreak then 
     begin 
     x := ARect.Left; 

     inc(y, MaxCharHeight); 
     end else 

     /////////////////////////////////////////////////// 
     // Closing tags 
     /////////////////////////////////////////////////// 
     if Tag = CloseTag(TagBold) then 
     ACanvas.Font.Style := ACanvas.Font.Style - [fsBold] else 

     if Tag = CloseTag(TagItalic) then 
     ACanvas.Font.Style := ACanvas.Font.Style - [fsItalic] else 

     if Tag = CloseTag(TagUnderline) then 
     ACanvas.Font.Style := ACanvas.Font.Style - [fsUnderline] else 

     if Tag = CloseTag(TagFontSize) then 
     ACanvas.Font.Size := PreviousFontSize else 

     if Tag = CloseTag(TagFontFamily) then 
     ACanvas.Font.Name := PreviousFontFamily else 

     if Tag = CloseTag(TagFontColour) then 
     ACanvas.Font.Color := PreviousFontColour else 

     if Tag = CloseTag(TagColour) then 
     ACanvas.Brush.Color := PreviousColour else 

     /////////////////////////////////////////////////// 
     // Tags with values 
     /////////////////////////////////////////////////// 
     begin 
     // Get the tag value (everything after '=') 
     TagValue := GetTagValue(Tag); 

     if TagValue <> '' then 
     begin 
      // Remove the value from the tag 
      Tag := copy(Tag, 1, pos('=', Tag) - 1); 

      if Tag = TagFontSize then 
      begin 
      PreviousFontSize := ACanvas.Font.Size; 
      ACanvas.Font.Size := StrToIntDef(TagValue, ACanvas.Font.Size); 
      end else 

      if Tag = TagFontFamily then 
      begin 
      PreviousFontFamily := ACanvas.Font.Name; 
      ACanvas.Font.Name := TagValue; 
      end; 

      if Tag = TagFontColour then 
      begin 
      PreviousFontColour := ACanvas.Font.Color; 

      try 
       ACanvas.Font.Color := ColorCodeToColor(TagValue); 
      except 
       //Just in case the canvas colour is invalid 
      end; 
      end else 

      if Tag = TagColour then 
      begin 
      PreviousColour := ACanvas.Brush.Color; 

      try 
       ACanvas.Brush.Color := ColorCodeToColor(TagValue); 
      except 
       //Just in case the canvas colour is invalid 
      end; 
      end; 
     end; 
     end; 
    end 
    else 
    // Draw the character if it's not a ctrl char 
    if CurrChar >= #32 then 
    begin 
     CharWidth := ACanvas.TextWidth(CurrChar); 

     if x + CharWidth > ARect.Right then 
     begin 
     x := ARect.Left; 

     inc(y, MaxCharHeight); 
     end; 

     if y + MaxCharHeight < ARect.Bottom then 
     begin 
     ACanvas.Brush.Style := bsClear; 

     ACanvas.TextOut(x, y, CurrChar); 
     end; 

     x := x + CharWidth; 
    end; 

    inc(idx); 
    end; 

    Result := x; 
end; 

... 그리고 DoAfterCellPaint 호출

procedure TMyVST.DoAfterCellPaint(Canvas: TCanvas; 
    Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); 
begin 
    inherited; 

    DrawHTML(CellRect, Canvas, 'HTML <B>tagged</B> string'); 
end; 

Answer 2

onPainText을보십시오. 그것은 칼럼을 가지고 있습니다. TargetCanvas를 사용하여 글꼴의 속성을 변경하십시오.