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更改字體的屬性。