QuoteText parsen?

[Sir Rufo]

Nur so zum Starten ein kleiner Parser (als State-Machine) quick und dirty.
Der kann auf jeden Fall das hier produzieren
dp_182623.PNG

Delphi-Quellcode:

unit Parser.BBCode;

interface

uses
  Vcl.Graphics, System.SysUtils, System.Generics.Collections;

type
  TTextPart = class
  private
    FFont: TFont;
    FText: string;
  public
    constructor Create( AFont: TFont; const AText: string );
    property Font: TFont read FFont;
    property Text: string read FText;
  end;

  TBBCodeParser = class
  private type
    TState = procedure( AChar: Char ) of object;
  private
    FParts: TList<TTextPart>;
    FCommandStack: TList<string>;
    FDefaultFont: TFont;
    FState: TState;
    FFont: TFont;
    FTextBuffer: TStringBuilder;
    FCommandBuffer: TStringBuilder;
    procedure InitParser;
    procedure ParseText( AChar: Char );
    procedure ParseCommand( AChar: Char );
    procedure ParseCloseCommand( AChar: Char );
    procedure HandleTextBuffer;
    procedure HandleCommandBuffer( Closing: Boolean = False );
  public
    constructor Create( ADefaultFont: TFont );
    destructor Destroy; override;

    procedure Parse( AText: string );
    property Parts: TList<TTextPart> read FParts;
  end;

implementation

uses
  System.StrUtils;

{ TBBCodeParser }

constructor TBBCodeParser.Create( ADefaultFont: TFont );
begin
  inherited Create;
  FDefaultFont := ADefaultFont;
  FFont := TFont.Create;
  FTextBuffer := TStringBuilder.Create;
  FCommandBuffer := TStringBuilder.Create;
  FParts := TObjectList<TTextPart>.Create;
  FCommandStack := TList<string>.Create;
end;

destructor TBBCodeParser.Destroy;
begin
  FFont.Free;
  FTextBuffer.Free;
  FCommandBuffer.Free;
  FParts.Free;
  FCommandStack.Free;
  inherited;
end;

procedure TBBCodeParser.HandleCommandBuffer( Closing: Boolean );
const
  FontStyle: array [TFontStyle] of string = ( 'fsBold', 'fsItalic', 'fsUnderline', 'fsStrikeOut' );
var
  LCommand: string;
  LIdx: Integer;
begin
  LCommand := FCommandBuffer.ToString;
  FCommandBuffer.Clear;

  if Closing
  then
    begin
      // von hinten aus dem Stack nehmen
      for LIdx := FCommandStack.Count - 1 downto 0 do
        if FCommandStack[LIdx] = LCommand
        then
          begin
            FCommandStack.Delete( LIdx );
            Break;
          end;
    end
  else
    // Einfach an den Stack anhängen
    FCommandStack.Add( LCommand );

  // Font einstellen
  FFont.Assign( FDefaultFont );

  for LCommand in FCommandStack do
    begin
      LIdx := IndexText( LCommand, FontStyle );
      if LIdx >= 0
      then
        FFont.Style := FFont.Style + [TFontStyle( LIdx )];

      if LCommand.StartsWith( 'cl', True )
      then
        FFont.Color := StringToColor( LCommand );
    end;
end;

procedure TBBCodeParser.HandleTextBuffer;
begin
  if FTextBuffer.Length > 0
  then
    begin
      FParts.Add( TTextPart.Create( FFont, FTextBuffer.ToString ) );
      FTextBuffer.Clear;
    end;
end;

procedure TBBCodeParser.InitParser;
begin
  FFont.Assign( FDefaultFont );
  FTextBuffer.Clear;
  FCommandBuffer.Clear;
  FCommandStack.Clear;
  FParts.Clear;
  FState := ParseText;
end;

procedure TBBCodeParser.Parse( AText: string );
var
  LChar: Char;
begin
  InitParser;
  for LChar in AText do
    FState( LChar );
  HandleTextBuffer;
end;

procedure TBBCodeParser.ParseCloseCommand( AChar: Char );
begin
  case AChar of
    ']':
      begin
        HandleTextBuffer;
        HandleCommandBuffer( True );
        FState := ParseText;
      end;
  else
    FCommandBuffer.Append( AChar );
  end;
end;

procedure TBBCodeParser.ParseCommand( AChar: Char );
begin
  case AChar of
    ']':
      begin
        HandleTextBuffer;
        HandleCommandBuffer( False );
        FState := ParseText;
      end;
    '/':
      FState := ParseCloseCommand;
  else
    FCommandBuffer.Append( AChar );
  end;
end;

procedure TBBCodeParser.ParseText( AChar: Char );
begin
  case AChar of
    '[':
      FState := ParseCommand;
  else
    FTextBuffer.Append( AChar );
  end;
end;

{ TTextPart }

constructor TTextPart.Create( AFont: TFont; const AText: string );
begin
  inherited Create;
  FFont := TFont.Create;
  FFont.Assign( AFont );
  FText := AText;
end;

end.

UPDATE
So mit der kleinen Änderung (CommandStack) können jetzt auch verschachtelte Commands verarbeitet werden.
So z.B.

Code:

normal [clRed]rot [clGreen]grün [/clGreen]wieder rot [/clRed]normal
normal [fsBold]fett [fsItalic]fett-kursiv [fsStrikeOut]fett-kursiv-durchgestrichen [fsUnderline]fett-kursiv-durchgestrichen-unterstrichen [/fsBold]kursiv-durchgestrichen-unterstrichen [/fsItalic]durchgestrichen-unterstrichen [/fsStrikeOut]unterstrichen [/fsUnderline]normal

Ist dann das gleiche Ergebnis:

Zitat:

normal rot grün wieder rot normal
normal fett fett-kursiv fett-kursiv-durchgestrichen fett-kursiv-durchgestrichen-unterstrichen kursiv-durchgestrichen-unterstrichen durchgestrichen-unterstrichen unterstrichen normal

wie hier mit den BBCodes

Code:

normal [COLOR="Red"]rot [COLOR="Green"]grün [/COLOR]wieder rot [/COLOR]normal
normal [B]fett [I]fett-kursiv [S]fett-kursiv-durchgestrichen [U]fett-kursiv-durchgestrichen-unterstrichen [/U][/S][/I][/B][I][S][U]kursiv-durchgestrichen-unterstrichen [/U][/S][/I][S][U]durchgestrichen-unterstrichen [/U][/S][U]unterstrichen [/U]normal