unit ChatEdit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.StdCtrls, Winapi.CommCtrl,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Contnrs, Vcl.Themes,
  Vcl.OleCtrls,
  Vcl.Menus, Vcl.ExtCtrls, mmSystem;

type
  TMyAlign = (myleft, mycenter, myright);
  TBBCode = (BBcolor, BBsize, BBfont, BBb, BBi, BBright, BBcenter, BBbutton,
    BBimg, BBcolorEnd, BBsizeEnd, BBfontEnd, BBbEnd, BBiEnd, BBrightEnd,
    BBcenterEnd, BBbuttonEnd, BBimgEnd, sLinebreak);

  TBBCodes = class(TObject)
    from, end_id: Integer;
    Typ: TBBCode;
    Value: string;
  end;

  TEvents = array of TBBCodes;

  TChatEdit = class(TCustomControl)
  private
    FFont: TFont;
    FLines: TStringList;
    Special_Objects: TObjectList;
    FScrollbar: TScrollBar;
    current_Height: Integer;

    procedure setLines(Value: TStringList);
    procedure setFont(Value: TFont);
    procedure setScrollbar(Value: TScrollBar);
    procedure onScrollbarChange(Sender: TObject);
    function giveNextChars(Text: String; id: Integer; id_to: Integer): String;
    function findUntil(Input: String; id: Integer; Find: String): Integer;
    function explode(Input: String; Splitter: String): TStringList;
    function StrtoCol(Text: String): TColor;

    function getTextWidth(Text: string): Integer;
    function searchforBBCodes(Text: String): TEvents;

    function createTBBCodes(from: Integer; end_id: Integer; Typ: TBBCode;
      Value: String): TBBCodes;
    { Private-Deklarationen }
  protected

    procedure Paint; override;
    { Protected-Deklarationen }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Clear;
    procedure AddLine(Text: String);
    function Count: Integer;

    { Public-Deklarationen }
  published
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGesture;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;

    property Font: TFont read FFont write setFont;
    property Lines: TStringList read FLines write setLines;
    property Scrollbar: TScrollBar read FScrollbar write setScrollbar;
    property Anchors;
    property Align;
    property Color;
    property Constraints;
    property Ctl3D;
    property PopupMenu;
    { Published-Deklarationen }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Chat', [TChatEdit]);
end;

function CaseStringOf(const Value: string; const Args: array of string)
  : Integer;
begin
  for Result := 0 to High(Args) do
    if Args[Result] = Value then
      Exit;
  Result := -1;
end;

constructor TChatEdit.Create(AOwner: TComponent);
var
  Pfad: String;
begin
  inherited Create(AOwner);
  FLines := TStringList.Create;
  FFont := TFont.Create;
  Special_Objects := TObjectList.Create;

  Pfad := ExtractFilePath(ParamStr(0));

  FScrollbar := TScrollBar.Create(Self);
  FScrollbar.Parent := Self;
  FScrollbar.Kind := sbVertical;
  FScrollbar.PageSize := FScrollbar.Max;
  FScrollbar.Top := 1;
  FScrollbar.OnChange := onScrollbarChange;

  FLines.Add(Self.GetNamePath);
end;

function TChatEdit.createTBBCodes(from: Integer; end_id: Integer; Typ: TBBCode;
  Value: String): TBBCodes;
begin
  Result := TBBCodes.Create;
  Result.from := from;
  Result.end_id := end_id;
  Result.Typ := Typ;
  Result.Value := Value;
end;

function TChatEdit.searchforBBCodes(Text: String): TEvents;
var
  zahl, search_begin, search_end, this_height: Integer;
  gesamt: String;
  BB: TStringList;
  Events: TObjectList;
begin
  Events := TObjectList.Create;
  zahl := 1;

  // Intialisierung
  this_height := 0;

  while zahl < Length(Text) do
  begin
    if Text[zahl] = '&' then
    begin
      search_begin := zahl;
      search_end := findUntil(Text, zahl, ' ');
      gesamt := lowercase(giveNextChars(Text, zahl, search_end));

      search_end := search_end + 2;

      Events.Add(createTBBCodes(zahl, search_end, sLinebreak, ''));

      zahl := search_begin + Length(gesamt);
    end;
    if Text[zahl] = '[' then
    begin
      search_begin := zahl;
      zahl := zahl + 1;

      if Text[zahl] <> '/' then
      begin

        // Bei Öffnung
        search_end := findUntil(Text, zahl, ']');
        gesamt := lowercase(giveNextChars(Text, zahl, search_end));

        BB := explode(gesamt, '=');
        search_end := search_end + 2;

        case CaseStringOf(BB[0], ['color', 'size', 'font', 'b', 'i', 'right',
          'center', 'button', 'img']) of
          0:
            begin
              if BB.Count = 2 then
                Events.Add(createTBBCodes(search_begin, search_end,
                  BBcolor, BB[1]));
            end;
          1:
            begin
              if BB.Count = 2 then
                Events.Add(createTBBCodes(search_begin, search_end,
                  BBsize, BB[1]));

              if this_height < Canvas.TextHeight('h') then
                this_height := Canvas.TextHeight('h');

            end;
          2:
            begin
              if (BB.Count = 2) and (Screen.Fonts.IndexOf(BB[1]) <> -1) then
                Events.Add(createTBBCodes(search_begin, search_end,
                  BBfont, BB[1]));
            end;
          3:
            begin
              Events.Add(createTBBCodes(search_begin, search_end, BBb, ''));
            end;
          4:
            begin
              Events.Add(createTBBCodes(search_begin, search_end, BBi, ''));
            end;
          5:
            begin
              Events.Add(createTBBCodes(search_begin, search_end, BBright, ''));
            end;
          6:
            begin
              Events.Add(createTBBCodes(search_begin, search_end,
                BBcenter, ''));
            end;
        end;

      end
      else
      begin
        // Bei Schließung
        search_end := findUntil(Text, zahl, ']') - 1;
        gesamt := lowercase(giveNextChars(Text, zahl + 1, search_end));

        search_end := search_end + 3;
        case CaseStringOf(gesamt, ['color', 'size', 'font', 'b', 'i', 'right',
          'center', 'button', 'img']) of
          0:
            Events.Add(createTBBCodes(search_begin, search_end,
              BBcolorEnd, ''));
          1:
            Events.Add(createTBBCodes(search_begin, search_end, BBsizeEnd, ''));
          2:
            Events.Add(createTBBCodes(search_begin, search_end, BBfontEnd, ''));
          3:
            Events.Add(createTBBCodes(search_begin, search_end, BBbEnd, ''));
          4:
            Events.Add(createTBBCodes(search_begin, search_end, BBiEnd, ''));
          5:
            Events.Add(createTBBCodes(search_begin, search_end,
              BBrightEnd, ''));
          6:
            Events.Add(createTBBCodes(search_begin, search_end,
              BBcenterEnd, ''));
        end;
        gesamt := '/' + gesamt;
      end;

      zahl := search_begin + 1 + Length(gesamt);
      gesamt := '';
    end;
    zahl := zahl + 1;
  end;

  SetLength(Result, Events.Count);
  for zahl := 0 to Events.Count - 1 do
  begin
    Result[zahl] := TBBCodes(Events[zahl]);
  end;
end;

function TChatEdit.StrtoCol(Text: string): TColor;
begin
  case CaseStringOf(Text, ['red', 'yellow', 'green', 'blue', 'white', 'black',
    'brown', 'silver']) of
    0:
      Result := clRed;
    1:
      Result := clYellow;
    2:
      Result := clGreen;
    3:
      Result := clHotLight;
    4:
      Result := clWhite;
    5:
      Result := clBlack;
    6:
      Result := clOlive;
    7:
      Result := clSilver;
  else
    Result := clBlack;
  end;
end;

function TChatEdit.findUntil(Input: string; id: Integer; Find: string): Integer;
var
  anfang: Integer;
begin
  anfang := id;
  Result := -1;
  while Length(Input) >= id do
  begin
    if Find = Input[id] then
    begin
      Result := (id - 1) - anfang;
      break;
    end;
    id := id + 1;
  end;
end;

function TChatEdit.explode(Input: string; Splitter: string): TStringList;
var
  zahl, last_Split: Integer;
begin
  zahl := 1;
  last_Split := 1;
  Result := TStringList.Create;
  while zahl < Length(Input) do
  begin
    if Input[zahl] = Splitter then
    begin
      if zahl + 1 < Length(Input) then
      begin
        Result.Add(giveNextChars(Input, last_Split, zahl - 2));
        last_Split := zahl;
      end;
    end;
    zahl := zahl + 1;
  end;
  if (last_Split < zahl) and (Result.Count > 0) then
    Result.Add(giveNextChars(Input, last_Split + 1, (zahl) - (last_Split + 1)));

  if Result.Count = 0 then
    Result.Add(Input);

end;

function TChatEdit.giveNextChars(Text: String; id: Integer;
  id_to: Integer): String;
var
  gesamt: Integer;
begin
  Result := '';
  gesamt := id + id_to;
  for id := id to gesamt do
    Result := Result + Text[id];

end;

procedure TChatEdit.onScrollbarChange(Sender: TObject);
begin
  Paint;
end;

destructor TChatEdit.Destroy;
begin
  FFont.Destroy;
  Special_Objects.Free;
  FLines.Free;
  FScrollbar.Free;

  inherited Destroy;
end;

procedure TChatEdit.setFont(Value: TFont);
begin
  FFont.Assign(Value);
  Canvas.Font.Assign(Value);
  Paint;
end;

procedure TChatEdit.setLines(Value: TStringList);
begin
  FLines.Assign(Value);
  Paint;
end;

procedure TChatEdit.setScrollbar(Value: TScrollBar);
begin
  FScrollbar.Assign(Value);
  Paint;
end;

function TChatEdit.getTextWidth(Text: string): Integer;
var
  zahl, active_Event_Index: Integer;
  Events: TEvents;
begin
  Events := searchforBBCodes(Text);
  active_Event_Index := 0;
  Result := 0;
  zahl := 1;

  if Length(Events) < 0 then
    while zahl < Length(Text) do
    begin
      if Events[active_Event_Index].from = zahl then
      begin
        if Events[active_Event_Index].Typ = sLinebreak then
          break;

        if (Events[active_Event_Index].Typ = BBfont) and
          (Screen.Fonts.IndexOf(Events[active_Event_Index].Value) <> -1) then
          Canvas.Font.Name := Events[active_Event_Index].Value;
        if Events[active_Event_Index].Typ = BBfontEnd then
          Canvas.Font.Name := FFont.Name;

        if Events[active_Event_Index].Typ = BBsize then
          Canvas.Font.Size := StrtoInt(Events[active_Event_Index].Value);
        if Events[active_Event_Index].Typ = BBsizeEnd then
          Canvas.Font.Size := FFont.Size;

        if active_Event_Index < Length(Events) - 1 then
          active_Event_Index := active_Event_Index + 1;

        zahl := zahl + Events[active_Event_Index].end_id;
      end;

      Result := Result + Canvas.TextWidth(Text[zahl]);
      zahl := zahl + 1;
    end
  else
    Result := Canvas.TextWidth(Text);

end;

procedure TChatEdit.Paint;
var
  zahl, i, current_width, this_height, this_width, Event_index: Integer;
  MyAlgin: TMyAlign;
  Events: TEvents;
  Linebreak: Boolean;
begin
  inherited;
  MyAlgin := myleft;

  Linebreak := false;
  this_height := 0;

  // Scrollbar
  FScrollbar.left := Self.Width - FScrollbar.Width;
  FScrollbar.height := Self.height - 2;

  // Rahmen zeichnen
  Canvas.Brush.Color := clWhite;
  Canvas.Rectangle(0, 0, Self.Width - (FScrollbar.Width + 1), Self.height);

  // Für Text zeichnen vorbereiten
  Canvas.Brush.Style := bsClear;
  Canvas.Font := FFont;

  // Setzen der Zähler werte
  current_Height := 0;
  current_width := 2;

  // Render
  for zahl := 0 to FLines.Count - 1 do
  begin

    // Setzen des Zählers auf 1 da der String erst beim zweitem Anfängt
    i := 1;
    Event_index := 0;

    // Nach BBCodes suchen
    Events := searchforBBCodes(FLines[zahl]);
    // Überprüfung der Ziffern
    while i < Length(FLines[zahl]) do
    begin

      if i = Events[Event_index].from then
      begin
        case Events[Event_index].Typ of
          BBcolor:
            Canvas.Font.Color := StrtoCol(Events[Event_index].Value);
          BBsize:
            if Events[Event_index].Value <> '' then
              Canvas.Font.Size := StrtoInt(Events[Event_index].Value);
          BBfont:
            if Screen.Fonts.IndexOf(Events[Event_index].Value) <> -1 then
              Canvas.Font.Name := FFont.Name;
          BBb:
            Canvas.Font.Style := Canvas.Font.Style + [fsBold];
          BBi:
            Canvas.Font.Style := Canvas.Font.Style + [fsItalic];
          BBright:
            MyAlgin := myright;
          BBcenter:
            MyAlgin := mycenter;
          BBbutton:
            ;
          BBimg:
            ;
          BBcolorEnd:
            Canvas.Font.Color := FFont.Color;
          BBsizeEnd:
            Canvas.Font.Size := FFont.Size;
          BBfontEnd:
            Canvas.Font.Name := FFont.Name;
          BBbEnd:
            Canvas.Font.Style := Canvas.Font.Style - [fsBold];
          BBiEnd:
            Canvas.Font.Style := Canvas.Font.Style - [fsItalic];
          BBrightEnd:
            begin
              MyAlgin := myleft;
              current_width := 2;
            end;
          BBcenterEnd:
            begin
              MyAlgin := myleft;
              current_width := 2;
            end;
          BBbuttonEnd:
            ;
          BBimgEnd:
            ;
          sLinebreak:
            begin
              Linebreak := true;
            end;
        end;

        i := i + Events[Event_index].end_id;

        if Event_index < Length(Events) - 1 then
          Event_index := Event_index + 1;
      end;

      // algin
      case MyAlgin of
        mycenter:
          begin
            this_width := getTextWidth(giveNextChars(FLines[zahl], i + 1,
              Length(FLines[zahl])));
            current_width := (Self.Width - FScrollbar.Width + 1) div 2 -
              this_width div 2;
          end;
        myright:
          begin
            this_width := getTextWidth(giveNextChars(FLines[zahl], i + 1,
              Length(FLines[zahl]) - i));
            current_width := (Self.Width - (FScrollbar.Width + 1)) - this_width;
          end;
      end;

      if this_height < Canvas.TextHeight('H') then
        this_height := Canvas.TextHeight('H');

        if Linebreak then
      begin
        current_width := 2;
        current_Height := current_Height + this_height;
        this_height := Canvas.TextHeight('H');
        Linebreak := false;
      end;

      // TextZeichnen
      if FLines[zahl][i] <> ']' then
      begin
        Canvas.TextOut(current_width, (current_Height - FScrollbar.Position) +
          this_height - (Canvas.TextHeight('h') + 2), FLines[zahl][i]);
        current_width := current_width + Canvas.TextWidth(FLines[zahl][i]);
      end;
      i := i + 1;



    end;
    // Zurücksetzung
    Canvas.Font.Color := FFont.Color;
    Canvas.Font.Size := FFont.Size;
    Canvas.Font.Name := FFont.Name;
    Canvas.Font.Style := Canvas.Font.Style - [fsBold];
    Canvas.Font.Style := Canvas.Font.Style - [fsItalic];
    MyAlgin := myleft;

    current_width := 2;
    current_Height := current_Height + this_height;
  end;

  Canvas.Font.Color := FFont.Color;
  Canvas.Font.Name := FFont.Name;
  Canvas.Font.Style := FFont.Style;
  Canvas.Font.Size := FFont.Size;

  if Self.height < current_Height then
  begin
    FScrollbar.Enabled := true;
    FScrollbar.Max := current_Height;
    FScrollbar.PageSize := Self.height;
  end
  else
  begin
    FScrollbar.Enabled := false;
  end;
end;

function TChatEdit.Count: Integer;
begin
  Result := FLines.Count;
end;

procedure TChatEdit.Clear;
begin
  FLines.Clear;
end;

procedure TChatEdit.AddLine(Text: string);
begin
  if FLines[0] = '' then
    FLines[0] := Text
  else
    FLines.Add(Text);

  Paint;
  if Self.height < current_Height then
    FScrollbar.Position := FScrollbar.Max - FScrollbar.PageSize;
  Paint;
end;

end.