{ *************************************************************************** }
{                                                                             }
{ EControl Syntax Editor SDK                                                  }
{                                                                             }
{ Copyright (c) 2004 - 2008 EControl Ltd., Zaharov Michael                    }
{     www.econtrol.ru                                                         }
{     support@econtrol.ru                                                     }
{                                                                             }
{ *************************************************************************** }
{$I ecSyntEdit.INC}

unit ecComplRend;

interface

uses Windows, Classes, Controls, Graphics, ecStrUtils, ecSyntAnal, ImgList;

type
  TColumnStart = (scNone, scLeft, scCenter, scRight);

  TGetCustomElemEvent = procedure(ItemIndex, TagIndex: integer;
    var ImageIndex, StyleIndex: integer; var Text: ecString) of object;

  TElemRec = class
    FText: ecString;
    FStyleIdx: integer;
    FImageIdx: integer;
    FWidth: integer;
    FIsCustom: Boolean;
    FColumn: TColumnStart; // Rendered in new column
  end;

  TLineRec = class
  private
    FElems: TList;
    FHeight: integer;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  // class for rendering formatted strings
  TComplexRender = class
  private
    FImages: TCustomImageList;
    FStyles: TStylesCollection;
    FItems: TecStrings;
    FColumns: array of integer;
    FParsedItems: TList;
    FCanvas: TCanvas;
    FFont: TFont;
    FColumnSpace: integer;
    FIndexMap: TList;
    FFormatted: Boolean;
    FWithColumns: Boolean;
    FOnGetCustomElem: TGetCustomElemEvent;
    procedure ItemsChanged(Sender: TObject);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetItems(const Value: TecStrings);
    procedure SetStyles(const Value: TStylesCollection);
    function GetWidth: integer;
    procedure SetCanvas(const Value: TCanvas);
    function GetHeight: integer;
    function GetMaxItemHeight: integer;
    procedure SetFont(const Value: TFont);
    procedure SetColumnSpace(const Value: integer);
    function VisibleItem(Index: integer): TLineRec;
    function GetParsItem(Index: integer): TLineRec;
    procedure SetFormatted(const Value: Boolean);
    procedure SetWithColumns(const Value: Boolean);
  protected
    function ParseItem(ItemIndex: integer; S: ecString): TObject;
    function AddCustomElem(LineRec: TLineRec; ItemIndex, CustomElemIdx: integer): TElemRec;
//    function CheckParsed: Boolean;
  public
    constructor Create;
    destructor Destroy; override;

    procedure ClearIndex;
    procedure ReleaseIndex;
    procedure AddIndex(Idx: integer);
    function MapIndex(Index: integer): integer;

    procedure ParseItems; virtual;
    procedure UpdateColumns;
    procedure DrawItem(Index: integer; const Rect: TRect; FixedColors: Boolean);
    function ItemHeight(Index: integer): integer;
    function ItemWidth(Index: integer): integer;
    function CustomTagCount(Index: integer): integer;
    function VisibleCount: integer;

    property Images: TCustomImageList read FImages write SetImages;
    property Styles: TStylesCollection read FStyles write SetStyles;
    property Items: TecStrings read FItems write SetItems;
    property Canvas: TCanvas read FCanvas write SetCanvas;
    property Font: TFont read FFont write SetFont;
    property ColumnSpace: integer read FColumnSpace write SetColumnSpace;
    // Result values
    property Width: integer read GetWidth;
    property Height: integer read GetHeight;
    property MaxItemHeight: integer read GetMaxItemHeight;
    // Flags
    property Formatted: Boolean read FFormatted write SetFormatted;
    property WithColumns: Boolean read FWithColumns write SetWithColumns;
    // Runtime formatting
    property OnGetCustomElem: TGetCustomElemEvent read FOnGetCustomElem write FOnGetCustomElem;
  end;

implementation

uses Contnrs, SysUtils, Math;

{ TLineRec }

constructor TLineRec.Create;
begin
  inherited;
//  FImageIndex := -1;
  FElems := TObjectList.Create;
end;

destructor TLineRec.Destroy;
begin
  FreeAndNil(FElems);
  inherited;
end;

{ TComplexRender }

constructor TComplexRender.Create;
begin
  inherited;
  FItems := TecStringList.Create;
  TecStringList(FItems).OnChange := ItemsChanged;
  FFormatted := True;
  FWithColumns := True;
  FColumnSpace := 8;
end;

destructor TComplexRender.Destroy;
begin
  FreeAndNil(FParsedItems);
  FreeAndNil(FItems);
  FreeAndNil(FIndexMap);
  inherited;
end;

procedure TComplexRender.ItemsChanged(Sender: TObject);
begin
  FreeAndNil(FParsedItems);
end;

procedure TComplexRender.SetImages(const Value: TCustomImageList);
begin
  if FImages <> Value then
    begin
      FImages := Value;
      FreeAndNil(FParsedItems);
    end;
end;

procedure TComplexRender.SetItems(const Value: TecStrings);
begin
  FItems.Assign(Value);
end;

procedure TComplexRender.SetStyles(const Value: TStylesCollection);
begin
  FStyles := Value;
  FreeAndNil(FParsedItems);
end;

procedure TComplexRender.SetCanvas(const Value: TCanvas);
begin
  FCanvas := Value;
//  FreeAndNil(FParsedItems);
end;

procedure TComplexRender.SetFont(const Value: TFont);
begin
  FFont := Value;
  FreeAndNil(FParsedItems);
end;

procedure TComplexRender.SetColumnSpace(const Value: integer);
begin
  FColumnSpace := Value;
  FreeAndNil(FParsedItems);
end;
{
function TComplexRender.CheckParsed: Boolean;
begin
  if not Assigned(FParsedItems) then
    ParseItems;
  Result := Assigned(FParsedItems);
end;}

procedure TComplexRender.UpdateColumns;
var N, i, j, ColumnSize, ColumnIdx: integer;

  procedure SaveColumn;
  begin
    if Length(FColumns) < ColumnIdx + 1 then
     begin
      SetLength(FColumns, ColumnIdx + 1);
      FColumns[ColumnIdx] := ColumnSize + FColumnSpace;
     end else
    if FColumns[ColumnIdx] < ColumnSize then
      FColumns[ColumnIdx] := ColumnSize + FColumnSpace;

    Inc(ColumnIdx);
    ColumnSize := 0;
  end;

begin
  SetLength(FColumns, 0);
  if Assigned(FParsedItems) then
    begin
      N := VisibleCount;
      for i := 0 to N - 1 do
        begin
          with VisibleItem(i) do
            begin
              ColumnSize := 0;
              ColumnIdx := 0;
              for j := 0 to FElems.Count - 1 do
               with TElemRec(FElems[j]) do
                begin
                  if (FColumn <> scNone) and (j > 0) then
                    SaveColumn
                  else
                    Inc(ColumnSize, FWidth);
                end;
              if ColumnSize > 0 then
                SaveColumn;
            end;
        end;
    end;
end;

procedure TComplexRender.ParseItems;
var i: integer;
begin
{  if Assigned(FParsedItems) then
    FreeAndNil(FParsedItems);

  if (FCanvas <> nil) and (FFont <> nil) then
    begin
      FParsedItems := TObjectList.Create;
      for i := 0 to FItems.Count - 1 do
        FParsedItems.Add(ParseItem(FItems[i]));
    end;}
  if FFormatted then
    begin
      for i := 0 to FItems.Count - 1 do
        GetParsItem(i);
      if WithColumns then
        UpdateColumns;
    end;
end;

type TControlHack = class(TControl);

function TComplexRender.ParseItem(ItemIndex: integer; S: ecString): TObject;
var Res: TLineRec;

  procedure UpdHeight(H: integer);
  begin
    if H > Res.FHeight then
      Res.FHeight := H;
  end;

  procedure ApplyElem(Elem: TElemRec);
  begin
    if Elem = nil then Exit;
    with Elem do
      begin
        FWidth := 0;
        if FImageIdx > -1 then
          begin
            Inc(FWidth, FImages.Width + 2);
            UpdHeight(FImages.Height + 1);
          end;
        if (FStyleIdx >= 0) and (FStyleIdx <= FStyles.Count) then
          begin
            FCanvas.Font := FFont;
            if FStyleIdx <> 0 then
              FStyles[FStyleIdx - 1].ApplyTo(FCanvas);
          end;
        if FText <> '' then
          with ecTextExtent(FCanvas, FText) do
            begin
              Inc(FWidth, cx);
              UpdHeight(cy);
            end;
      end;
  end;

  function AddElem(AStyleIdx, AImageIdx: integer; const AText: ecString = ''): TElemRec;
  begin
    Result := TElemRec.Create;
    Result.FStyleIdx := AStyleIdx;
    Result.FImageIdx := AImageIdx;
    Result.FText := AText;
    Result.FIsCustom := False;
    Res.FElems.Add(Result);
    ApplyElem(Result);
  end;

var K, I, J, N, CEI: integer;
begin
  I := 1;
  K := 1;
  N := Length(S);
  CEI := 0;

  FCanvas.Font := FFont;
  Res := TLineRec.Create;
  Result := Res;
  with Res do
    while I <= N do
      begin
        if S[I] = '\' then
          if (I < N) and (S[I + 1] = '\') then
            begin
              Delete(S, I, 1);
              Dec(N);
            end else
            begin
              // Simple text
              if I > K then
                AddElem(-1, -1, Copy(S, K, I - K));

              J := I + 1;
              while (J <= N) and (S[J] <> '\') do
                Inc(J);
              if J > N then Exit;

              try
                case ecUpCase(S[I + 1]) of
                  'I': if FImages <> nil then
                         AddElem(-1, StrToInt(Copy(S, I + 2, J - I - 2)));
                  'S': if FStyles <> nil then
                         AddElem(StrToInt(Copy(S, I + 2, J - I - 2)), -1);
                  'T': if J - I - 1 = 2 then
                         case ecUpCase(S[I + 2]) of
                           'R': AddElem(-1,-1).FColumn := scRight;
                           'C': AddElem(-1,-1).FColumn := scCenter;
                           else AddElem(-1,-1).FColumn := scLeft;
                         end
                       else
                         AddElem(-1,-1).FColumn := scLeft;
                  'X': begin
                         ApplyElem(AddCustomElem(Res, ItemIndex, CEI));
                         Inc(CEI);
                       end;
                end;
              except
//                ApplicationHandleException(Self);
              end;

              I := J;
              K := J + 1;
            end;
        Inc(I);
      end;
    if I > K  then
      AddElem(-1, -1, Copy(S, K, I - K));

  if Res.FHeight = 0 then
    Res.FHeight := Canvas.TextHeight('W');
end;

procedure TComplexRender.DrawItem(Index: integer; const Rect: TRect; FixedColors: Boolean);
var cf, cb: TColor;
    i, x, j, col, next_c, w, col_w: integer;
begin
  if {not CheckParsed or }(Index >= VisibleCount) {or (Length(FColumns) = 0) }then Exit;
  cf := FCanvas.Font.Color;
  cb := FCanvas.Brush.Color;
  col := 1;
  next_c := 0;
  X := Rect.Left;
  FCanvas.Font := FFont;
  if FixedColors then
    FCanvas.Font.Color := cf;

  if not FFormatted then
    ecTextOut(FCanvas, x, Rect.Top, FItems[MapIndex(Index)])
  else
  with VisibleItem(Index) do
    for i := 0 to FElems.Count - 1 do
      with TElemRec(FElems[i]) do
        begin
          if FColumn <> scNone then
            begin
              // width in the column
              W := 0;
              for j := i + 1 to FElems.Count - 1 do
                with TElemRec(FElems[j]) do
                  if FColumn = scNone then
                    Inc(W, FWidth)
                  else
                    Break;

              if Col < Length(FColumns) then
                col_w := FColumns[col]
              else
                col_w := W + FColumnSpace;

              if next_c = 0 then
                if Length(FColumns) > 0 then
                  next_c := Rect.Left + FColumns[0]
                else
                  next_c := X + FColumnSpace;
              X := next_c;
              next_c := next_c + col_w;
              Inc(col);

              case FColumn of
                scCenter: X := X + (col_w - W - FColumnSpace) div 2;
                scRight:  X := X + (col_w - W - FColumnSpace);
              end;
            end else
          if FImageIdx <> -1 then
            begin
              if (FImageIdx >= 0) and (FImageIdx < FImages.Count) then
                FImages.Draw(FCanvas, X + 1, Rect.Top + 1, FImageIdx);
              Inc(X, FImages.Width + 2);
            end;
          if FStyleIdx <> -1 then
            begin
              if (FStyleIdx >= 0) and (FStyleIdx <= FStyles.Count) then
                begin
                  FCanvas.Font := FFont;
                  if FStyleIdx > 0 then
                    FStyles[FStyleIdx - 1].ApplyTo(FCanvas);
                  if FixedColors then
                    begin
                      FCanvas.Font.Color := cf;
                      FCanvas.Brush.Color := cb;
                    end;
                end;
            end;
          if FText <> '' then
            begin
              ecTextOut(FCanvas, x, Rect.Top, FText);
              Inc(X, FWidth);
            end;
        end;
  Canvas.Font := FFont;
  Canvas.Brush.Color := cb;
end;

function TComplexRender.GetWidth: integer;
var i, W: integer;
begin
  Result := 0;
//  ParseItems;
//  if not CheckParsed then Exit;
//  UpdateColumns;
  if WithColumns then
    begin
      ParseItems;
      for i := 0 to Length(FColumns) - 1 do
        Inc(Result, FColumns[i]);
    end else
  for i := 0 to VisibleCount - 1 do
    begin
      W := ItemWidth(i);
      if W > Result then Result := W;
    end;
end;

function TComplexRender.GetHeight: integer;
var i: integer;
begin
  Result := 0;
  for i := 0 to VisibleCount - 1 do
    Inc(Result, ItemHeight(i));
end;

function TComplexRender.GetMaxItemHeight: integer;
var i, H: integer;
begin
  Result := 0;
  for i := 0 to VisibleCount - 1 do
    begin
      H := ItemHeight(i);
      if H > Result then Result := H;
    end;
end;

function TComplexRender.ItemHeight(Index: integer): integer;
begin
  if Index >= VisibleCount then Result := 15 else
    if FFormatted then Result := VisibleItem(Index).FHeight
      else Result := Canvas.TextHeight('W');
end;

function TComplexRender.ItemWidth(Index: integer): integer;
var i: integer;
begin
  if Index >= VisibleCount then Result := 0 else
    if FFormatted then
      begin
        Result := 0;
        with VisibleItem(Index) do
          for i := 0 to FElems.Count - 1 do
            with TElemRec(FElems[i]) do
              if FColumn <> scNone then
                Inc(Result, FColumnSpace) else
                Inc(Result, FWidth);
      end
    else
      Result := Canvas.TextWidth(FItems[MapIndex(Index)]);
end;

function TComplexRender.VisibleCount: integer;
begin
  if Assigned(FIndexMap) then Result := FIndexMap.Count else
    Result := FItems.Count;
end;

function TComplexRender.MapIndex(Index: integer): integer;
begin
  if Assigned(FIndexMap) then
    Index := integer(FIndexMap[Index]);
  Result := Index;
end;

function TComplexRender.VisibleItem(Index: integer): TLineRec;
begin
  Result := GetParsItem(MapIndex(Index));
end;

function TComplexRender.GetParsItem(Index: integer): TLineRec;
begin
  if not Assigned(FParsedItems) then
    begin
      FParsedItems := TObjectList.Create;
      FParsedItems.Count := FItems.Count;
      if WithColumns then
        ParseItems;
    end;
  if FParsedItems[Index] = nil then
    FParsedItems[Index] := ParseItem(Index, FItems[Index]);
  Result := TLineRec(FParsedItems[Index]);
end;

procedure TComplexRender.AddIndex(Idx: integer);
begin
  if not Assigned(FIndexMap) then
    FIndexMap := TList.Create;
  FIndexMap.Add(TObject(Idx));
end;

procedure TComplexRender.ClearIndex;
begin
  if not Assigned(FIndexMap) then
    FIndexMap := TList.Create
  else
    FIndexMap.Clear;
end;

procedure TComplexRender.ReleaseIndex;
begin
  FreeAndNil(FIndexMap);
end;

procedure TComplexRender.SetFormatted(const Value: Boolean);
begin
  if FFormatted <> Value then
    begin
      FFormatted := Value;
      FreeAndNil(FParsedItems);
    end;
end;

procedure TComplexRender.SetWithColumns(const Value: Boolean);
begin
  if FWithColumns <> Value then
    begin
      FWithColumns := Value;
      if FWithColumns then
        ParseItems
      else
        SetLength(FColumns, 0);
    end;
end;

function TComplexRender.AddCustomElem(LineRec: TLineRec;
  ItemIndex, CustomElemIdx: integer): TElemRec;
begin
  if Assigned(FOnGetCustomElem) then
    begin
      Result := TElemRec.Create;
      Result.FImageIdx := -1;
      Result.FStyleIdx := -1;
      Result.FText := '';
      Result.FIsCustom := True;
      LineRec.FElems.Add(Result);
      FOnGetCustomElem(ItemIndex, CustomElemIdx, Result.FImageIdx, Result.FStyleIdx, Result.FText);
    end else
      Result := nil;
end;

function TComplexRender.CustomTagCount(Index: integer): integer;
var i: integer;
begin
  Result := 0;
  if (Index < VisibleCount) and FFormatted then
    with VisibleItem(Index) do
      for i := 0 to FElems.Count - 1 do
        if TElemRec(FElems[i]).FIsCustom then
          Inc(Result);
end;

end.
