Jump to content
Sign in to follow this  
DavidRM

Chat Scroller - Need Some Tips

Recommended Posts

I built this component to use in my Paintball Net game UI:

unit UPBTInfoScroll;

interface

uses
  System.Types,
  System.Lists,
  System.Time,
  System.Colors,
  SmartCL.System,
  SmartCL.Theme,
  SmartCL.Components,
  SmartCL.Controls.Label,
  SmartCL.Scroll,
  SmartCL.Controls.ScrollBar,
  SmartCL.Css.Classes;

type
  TPBTScrollItem = class(TW3CustomControl)
  protected
    FItemText: string;
    procedure InitializeItem; virtual;
    procedure SetItemText(aValue: string);
  public
    function CreationFlags: TW3CreationFlags; override;
    procedure InitializeObject; override;
    procedure UpdateDisplay; virtual;
    property ItemText: string read FItemText write SetItemText;
  end;

  TPBTScrollItemClass = class of TPBTScrollItem;

  TPBTScrollInfoItem = class(TPBTScrollItem)
  protected
  public
    procedure UpdateDisplay; override;
    property InfoText: string read ItemText write ItemText;
  end;

  TPBTScrollErrorItem = class(TPBTScrollInfoItem)
  end;

  TPBTChatType = (ctAnnounce, ctChat, ctSay, ctShout, ctWhisper, ctTell, ctPlan,
    ctTeamPlan, ctWizChat);

  TPBTScrollChatItem = class(TPBTScrollItem)
  private
    FChatType: TPBTChatType;
    FChatHeader: string;
    FChatText: string;
    FChatColor: TColor;
  public
    procedure UpdateDisplay; override;
    property ChatTYpe: TPBTChatType read FChatType;
    property ChatHeader: string read FChatHeader;
    property ChatText: string read FChatText;
    property ChatColor: TColor read FChatColor;
  end;

  TPBTScrollItems = class(TW3ScrollContent)
  private
    function GetItem(Index: Integer): TPBTScrollItem;
    function GetCount: integer;
  public
    function  Add: TPBTScrollItem; overload;
    function  Add(aScrollItemClass: TPBTScrollItemClass): TPBTScrollItem; overload;
    procedure Clear; virtual;
    procedure FinalizeObject; override;
    procedure Delete(aIndex: integer);
  published
    property Items[index: Integer]: TPBTScrollItem read GetItem; default;
    property Count: integer read GetCount;
  end;

  TPBTInfoScrollAddItemCallback = function: TPBTScrollItem;

  TPBTInfoScroll = class(TW3ScrollControl)
  private
    function GetItems: TPBTScrollItems;
    function GetScrollIsAtBottom: boolean;
  protected
    procedure InitializeObject; override;
    procedure Resize; override;
    function GetScrollContentClass: TW3ScrollContentClass; override;
  public
    function CreationFlags: TW3CreationFlags; override;
    procedure Clear;
    procedure ScrollToBottom;
    procedure RealignItems;
    procedure AddItem(aCallBack: TPBTInfoScrollAddItemCallback);
    procedure AddText(const aText: string);
    procedure AddChat(aChatType: TPBTChatType; const aChatHeader, aChatText: string; aChatColor: TColor);
    procedure AddInfo(const aInfoText: string);
    procedure AddError(const aErrorText: string);
    function MaxInfoWidth: integer;
    function MinInfoWidth: integer;
  published
    property Items: TPBTScrollItems read GetItems;
    property ScrollIsAtBottom: boolean read GetScrollIsAtBottom;
  end;

implementation

// TPBTScrollItem
procedure TPBTScrollItem.InitializeItem;
begin
end;

procedure TPBTScrollItem.SetItemText(aValue: string);
begin
  if aValue <> FItemText then
  begin
    FItemText := aValue;
    UpdateDisplay;
  end;
end;

function TPBTScrollItem.CreationFlags: TW3CreationFlags;
begin
  inherited;
  Include(Result, cfAllowSelection);
end;

procedure TPBTScrollItem.InitializeObject;
begin
  inherited;
  SetContentSelectionMode(tsmText);
end;

procedure TPBTScrollItem.UpdateDisplay;
begin
  InnerHTML := Format('<span style="user-select:text;-moz-user-select:text;-webkit-user-select:text;-ms-user-select:text;-khtml-user-select:text">%s</span>',
    [TString.EncodeTags(FItemText)]);
end;

// TPBTScrollInfoItem
procedure TPBTScrollInfoItem.UpdateDisplay;
begin
  inherited;
end;

// TPBTScrollErrorItem

// TPBTScrollChatItem
procedure TPBTScrollChatItem.UpdateDisplay;
begin
  inherited;
  InnerHTML := Format('<span style="color:%s;user-select:text;-moz-user-select:text;-webkit-user-select:text;-ms-user-select:text;-khtml-user-select:text"><b>%s</b>: %s</span>',
    [ColorToWebStr(FChatColor), TString.EncodeTags(FChatHeader), TString.EncodeTags(FChatText)]);
end;

// TPBTScrollItems
function TPBTScrollItems.GetItem(Index: Integer): TPBTScrollItem;
begin
  Result := TPBTScrollItem(GetChildren[Index]);
end;

function TPBTScrollItems.GetCount: integer;
begin
  Result := GetChildCount;
end;

function  TPBTScrollItems.Add: TPBTScrollItem;
begin
  Result := Add(TPBTScrollItem);
end;

function  TPBTScrollItems.Add(aScrollItemClass: TPBTScrollItemClass): TPBTScrollItem;
begin
  Result := aScrollItemClass.Create(Self);
  Result.InitializeItem;
end;

procedure TPBTScrollItems.Clear;
begin
  // can't get rid of from [0]. Not sure why.
  while Count > 0 do
    GetChildren[Count - 1].Free;
  Height := 0;
end;

procedure TPBTScrollItems.FinalizeObject;
begin
  Clear;
  inherited;
end;

procedure TPBTScrollItems.Delete(aIndex: integer);
begin
  if aIndex < GetChildCount then
    GetChildren[aIndex].Free;
end;

// TPBTInfoScroll
function TPBTInfoScroll.GetItems: TPBTScrollItems;
begin
  Result := TPBTScrollItems(Content);
end;

function TPBTInfoScroll.GetScrollIsAtBottom: boolean;
begin
  Result := (ScrollController.ContentTop <= -(Content.Height - (Height + 10)))
end;

procedure TPBTInfoScroll.InitializeObject;
begin
  inherited;
  SetBarSize(CNT_SCROLLBAR_SIZE);
  ScrollBars := sbScrollBar;
end;

procedure TPBTInfoScroll.Resize;
begin
  inherited;
end;

function TPBTInfoScroll.GetScrollContentClass: TW3ScrollContentClass;
begin
  Result := TPBTScrollItems;
end;

function TPBTInfoScroll.CreationFlags: TW3CreationFlags;
begin
  inherited;
  // Allow key-capture and selection
  include(result, cfKeyCapture);
  include(result, cfAllowSelection);
end;

procedure TPBTInfoScroll.Clear;
begin
  Items.Clear;
  SetSize(ClientWidth, 0);
  ScrollController.Refresh;
end;

procedure TPBTInfoScroll.ScrollToBottom;
begin
  ScrollController.ScrollTo(0, -(Content.Height - Height));
end;

procedure TPBTInfoScroll.RealignItems;
var
  ii: integer;
begin
  ScrollController.Refresh;
  if Items.Count > 0 then
  begin
    Items.BeginUpdate;
    try
      Items[0].Top := 0;
      for ii := 1 to Items.Count - 1 do
      begin
        Items[ii].Top := Items[ii - 1].Top + Items[ii - 1].Height;
      end;
    finally
      Items.EndUpdate;
    end;
  end;
end;

procedure TPBTInfoScroll.AddItem(aCallBack: TPBTInfoScrollAddItemCallback);
const
  margin = 5;
  MAX_ITEMS = 500;
var
  lastItem, aItem: TPBTScrollItem;
  needRealign, wasAtBottom: boolean;
begin
  Items.BeginUpdate;
  Content.BeginUpdate;
  try
    if Items.Count > 0 then
      lastItem := Items[Items.Count - 1];
    needRealign := Items.Count > MAX_ITEMS;
    if needRealign then
      while Items.Count > (MAX_ITEMS div 3) * 2 do
        Items.Delete(0);
    if Content.Width <> (ClientWidth - GetBarSize) then
      Content.Width := (ClientWidth - GetBarSize);
    wasAtBottom := (ScrollController.ContentTop <= -(Content.Height - (Height + 10)));
    aItem := aCallBack;
    aItem.UpdateDisplay;
    if lastItem <> nil then
      aItem.Top := lastItem.Top + lastItem.Height
    else
      aItem.Top := 0;
    Content.Height := aItem.Top + aItem.Height + margin;
    if Content.Height <= Height then
    begin
      Content.Height := Height;
      wasAtBottom := True;
    end;
  finally
    Content.EndUpdate;
    Items.EndUpdate;
  end;
  if needRealign then
    RealignItems;
  ScrollController.Refresh;
  if wasAtBottom then
    ScrollToBottom;
  if needRealign then
    Invalidate;
end;

procedure TPBTInfoScroll.AddText(const aText: string);
begin
  AddItem(
    lambda
      Result := Items.Add;
      Result.ItemText := aText;
    end
  );
end;

procedure TPBTInfoScroll.AddChat(aChatType: TPBTChatType; const aChatHeader, aChatText: string; aChatColor: TColor);
begin
  AddItem(
    lambda
      Result := Items.Add(TPBTScrollChatItem);
      TPBTScrollChatItem(Result).FChatType := aChatType;
      TPBTScrollChatItem(Result).FChatHeader := aChatHeader;
      TPBTScrollChatItem(Result).FChatText := aChatText;
      TPBTScrollChatItem(Result).FChatColor := aChatColor;
    end
  );
end;

procedure TPBTInfoScroll.AddInfo(const aInfoText: string);
begin
  AddItem(
    lambda
      Result := Items.Add(TPBTScrollInfoItem);
      TPBTScrollInfoItem(Result).InfoText := aInfoText;
    end
  );
end;

procedure TPBTInfoScroll.AddError(const aErrorText: string);
begin
  AddItem(
    lambda
      Result := Items.Add(TPBTScrollErrorItem);
      TPBTScrollErrorItem(Result).InfoText := aErrorText;
    end
  );
end;

function TPBTInfoScroll.MaxInfoWidth: integer;
var
  aMax: string;
begin
  while aMax.Length < 70 do
    aMax += 'XXXXXXXXXX';
  Result := MeasureText(aMax).tmWidth + GetBarSize;
end;

function TPBTInfoScroll.MinInfoWidth: integer;
begin
  Result := MaxInfoWidth div 2;
end;

end.

 

My goal was to have it act like a scrolling chat. New items are added to the bottom, pushing up the items already there. By default scrolling "sticks" to the bottom of the view area, unless the player has manually scrolled it back to review something or whatever.

Overall, it works. What I'm looking for are missed opportunities and maybe some solutions to a couple issues:

  • The biggest issue is the build up of items in the scroll. Right now, I have it check for a maximum size, then prune it down to half that size. I would *prefer* if it could be indefinitely large. The solutions I've seen for that have relied on items being the same height. That constraint doesn't work for me.
  • Resizing isn't exactly snappy/smooth. Just seems like there's probably a way to make that better.

Also, as a sorta sub-goal, I wanted to share what I had done. SMS needs a lot more sharing going on. 😃

So...hit me. Tell me how I'm doing it wrong and/or could do it better.

Thanks!

-David

Share this post


Link to post
Share on other sites

Yeah, it's basically impossible to draw an infinite amount of controls. So I'd store the chat contents as pure data and only dynamically draw the visible ones. This same idea is used in TW3ListBox.

Share this post


Link to post
Share on other sites
4 hours ago, jarto said:

Yeah, it's basically impossible to draw an infinite amount of controls. So I'd store the chat contents as pure data and only dynamically draw the visible ones. This same idea is used in TW3ListBox.

Yeah, but TW3ListBox has the assumption that all items are the same height. I'm struggling with how to have visible-only items that can be any size.

Share this post


Link to post
Share on other sites
3 hours ago, DavidRM said:

Yeah, but TW3ListBox has the assumption that all items are the same height. I'm struggling with how to have visible-only items that can be any size.

You can use the same principles as TW3ListBox, but you'd just have to rewrite the rendering part. After all, the tricky part is just to figure out which ones to paint.

Share this post


Link to post
Share on other sites

Either one of two approaches come to mind : standardise rowheight by calculating all chat data lines in a conversation according to the width of the chatbox. And then set rowheight to the height of a single line (say 30px). For very large conversations you could use this approach, but probably a standard TW3ListBox will do.

Otherwise make rowheight variable and calculate the height of all previous chats and determine which ones are in the visual viewport. That probably will take a specialised TW3ListBox.

 

Share this post


Link to post
Share on other sites

I'm going to take a break from my Chromium work and have a look if I can modify ListBox to work with variable row heights.

Edit: That's not too difficult to do. It'll just slow down a bit the calculation of rows to be shown. With variable heights you need to loop through all items when with fixed heights you can calculate which ones should be shown.

However, having dynamic row heights is a pain and I believe that a chat control would need those. In that case the height of all items change during a device flip or window resize. And I believe that a proper chat control actually needs dynamic size.

So, how would I do this? I'd set the min-width of the items to 100% and use PositionMode pmRelative. Then you should be able to just add and remove controls while the browser takes care of resizing and stacking them.

Something like this:

procedure TForm1.W3Button1Click(Sender: TObject);
//  Add to the end
begin
  var Item:=TW3DivHtmlElement.Create(Content); //Or anything else
  Item.PositionMode:=pmRelative;
  w3_setStyle(Item.Handle, 'min-width', '100%');
  Item.InnerText:='Hello world! I am control number '+IntToStr(Content.ControlCount)+'. How are you doing there?';
end;

procedure TForm1.W3Button2Click(Sender: TObject);
//  Remove 1st.
begin
  Content.ForEach( function(const Child: TW3TagContainer): TEnumResult
    begin
      Child.Free;
      result:=erBreak;
    end);
end;

procedure TForm1.InitializeForm;
begin
  inherited;
  // this is a good place to initialize components
  Content.NativeScrolling:=True;
end;

 

Share this post


Link to post
Share on other sites

Here's the overhauled version, that only uses as many actual on-screen elements as required to show the visible items. It's been working pretty well.

unit UPBTInfoScroll;

interface

uses
  System.Types,
  System.Lists,
  System.Time,
  System.Colors,
  SmartCL.System,
  SmartCL.Theme,
  SmartCL.Components,
  SmartCL.Controls.Label,
  SmartCL.Scroll,
  SmartCL.Controls.ScrollBar,
  SmartCL.Css.Classes;

type
  TPBTScrollItemData = class(TObject)
  private
    FItemText: string;
    FItemTop: integer;
    FItemHeight: integer;
  public
    function ItemStyleName: string; virtual;
    function InnerHtml: string; virtual;
    property ItemText: string read FItemText write FItemText;
    property ItemTop: integer read FItemTop write FItemTop;
    property ItemHeight: integer read FItemHeight write FItemHeight;
  end;

  TPBTScrollInfoItemData = class(TPBTScrollItemData)
  public
    function ItemStyleName: string; override;
  end;

  TPBTScrollErrorItemData = class(TPBTScrollItemData)
  public
    function ItemStyleName: string; override;
  end;

  TPBTChatType = (ctAnnounce, ctChat, ctSay, ctShout, ctWhisper, ctTell, ctPlan,
    ctTeamPlan, ctWizChat);

  TPBTScrollChatItemData = class(TPBTScrollItemData)
  private
    FChatType: TPBTChatType;
    FChatHeader: string;
    FChatColor: TColor;
  public
    function ItemStyleName: string; override;
    function InnerHtml: string; override;
    property ChatType: TPBTChatType read FChatType write FChatType;
    property ChatHeader: string read FChatHeader write FChatHeader;
    property ChatColor: TColor read FChatColor write FChatColor;
    property ChatText: string read ItemText write ItemText;
  end;

  TPBTScrollItem = class(TW3CustomControl)
  protected
    FItemData: TPBTScrollItemData;
    procedure SetItemData(aValue: TPBTScrollItemData);
  public
    function CreationFlags: TW3CreationFlags; override;
    procedure InitializeObject; override;
    procedure UpdateDisplay; virtual;
    property ItemData: TPBTScrollItemData read FItemData write SetItemData;
  end;

  TPBTScrollItemClass = class of TPBTScrollItem;

  TPBTScrollInfoItem = class(TPBTScrollItem)
  end;

  TPBTScrollErrorItem = class(TPBTScrollInfoItem)
  end;

  TPBTScrollChatItem = class(TPBTScrollItem)
  end;

  TPBTScrollItems = class(TW3ScrollContent)
  private
    function GetItem(Index: Integer): TPBTScrollItem;
    function GetCount: integer;
  public
    function  Add: TPBTScrollItem; overload;
    function  Add(aScrollItemClass: TPBTScrollItemClass): TPBTScrollItem; overload;
    procedure Clear; virtual;
    procedure FinalizeObject; override;
    procedure Delete(aIndex: integer);
  published
    property Items[index: Integer]: TPBTScrollItem read GetItem; default;
    property Count: integer read GetCount;
  end;

  TPBTInfoScrollAddItemDataCallback = function: TPBTScrollItemData;
  TPBTInfoScrollAddItemCallback = function: TPBTScrollItem;

  TPBTInfoScroll = class(TW3ScrollControl)
  private
    FDataItems: array of TPBTScrollItemData;
    FNewItems: array of TPBTScrollItemData;
    function GetItems: TPBTScrollItems;
    function GetScrollIsAtBottom: boolean;
    procedure ScrollControllerScrolling(Sender: TObject);
  protected
    procedure InitializeObject; override;
    procedure Resize; override;
    function GetScrollContentClass: TW3ScrollContentClass; override;
  public
    function CreationFlags: TW3CreationFlags; override;
    procedure Clear;
    procedure Refresh;
    procedure ScrollToBottom;
    procedure RealignItems;
    procedure UpdateVisibleItems;
    procedure AddItem(aCallback: TPBTInfoScrollAddItemDataCallback);
    procedure AddText(const aText: string);
    procedure AddChat(aChatType: TPBTChatType; const aChatHeader, aChatText: string; aChatColor: TColor);
    procedure AddInfo(const aInfoText: string);
    procedure AddError(const aErrorText: string);
    function MaxInfoWidth: integer;
    function MinInfoWidth: integer;
  published
    property Items: TPBTScrollItems read GetItems;
    property ScrollIsAtBottom: boolean read GetScrollIsAtBottom;
  end;

implementation

function TPBTScrollItemData.ItemStyleName: string;
begin
  Result := 'TPBTScrollItem';
end;

function TPBTScrollItemData.InnerHtml: string;
begin
  Result := Format('<span style="user-select:text;-moz-user-select:text;-webkit-user-select:text;-ms-user-select:text;-khtml-user-select:text">%s</span>',
    [TString.EncodeTags(FItemText)]);
end;

function TPBTScrollInfoItemData.ItemStyleName: string;
begin
  Result := 'TPBTScrollInfoItem';
end;

function TPBTScrollErrorItemData.ItemStyleName: string;
begin
  Result := 'TPBTScrollErrorItem';
end;

function TPBTScrollChatItemData.ItemStyleName: string;
begin
  Result := 'TPBTScrollChatItem';
end;

function TPBTScrollChatItemData.InnerHtml: string;
begin
  Result := Format('<span style="color:%s;user-select:text;-moz-user-select:text;-webkit-user-select:text;-ms-user-select:text;-khtml-user-select:text"><b>%s</b>: %s</span>',
    [ColorToWebStr(FChatColor), TString.EncodeTags(FChatHeader), TString.EncodeTags(ChatText)]);
end;

// TPBTScrollItem
procedure TPBTScrollItem.SetItemData(aValue: TPBTScrollItemData);
begin
  if FItemData <> nil then
    TagStyle.RemoveClassFromControl(Handle, FItemData.ItemStyleName);
  FItemData := aValue;
  if FItemData <> nil then
  begin
    Top := FItemData.ItemTop;
    TagStyle.AddClassToControl(Handle, FItemData.ItemStyleName);
  end;
  UpdateDisplay;
end;

function TPBTScrollItem.CreationFlags: TW3CreationFlags;
begin
  inherited;
  Include(Result, cfAllowSelection);
end;

procedure TPBTScrollItem.InitializeObject;
begin
  inherited;
  SetContentSelectionMode(tsmText);
  w3_setStyle(Handle, 'min-width', '100%');
end;

procedure TPBTScrollItem.UpdateDisplay;
begin
  if FItemData <> nil then
    InnerHTML := FItemData.InnerHtml
  else
    InnerHTML := '';
end;

// TPBTScrollInfoItem

// TPBTScrollErrorItem

// TPBTScrollChatItem

// TPBTScrollItems
function TPBTScrollItems.GetItem(Index: Integer): TPBTScrollItem;
begin
  Result := TPBTScrollItem(GetChildren[Index]);
end;

function TPBTScrollItems.GetCount: integer;
begin
  Result := GetChildCount;
end;

function  TPBTScrollItems.Add: TPBTScrollItem;
begin
  Result := Add(TPBTScrollItem);
end;

function  TPBTScrollItems.Add(aScrollItemClass: TPBTScrollItemClass): TPBTScrollItem;
begin
  Result := aScrollItemClass.Create(Self);
end;

procedure TPBTScrollItems.Clear;
begin
  // can't get rid of from [0]. Not sure why.
  while Count > 0 do
    GetChildren[Count - 1].Free;
  Height := 0;
end;

procedure TPBTScrollItems.FinalizeObject;
begin
  Clear;
  inherited;
end;

procedure TPBTScrollItems.Delete(aIndex: integer);
begin
  if aIndex < GetChildCount then
    GetChildren[aIndex].Free;
end;

// TPBTInfoScroll
function TPBTInfoScroll.GetItems: TPBTScrollItems;
begin
  Result := TPBTScrollItems(Content);
end;

function TPBTInfoScroll.GetScrollIsAtBottom: boolean;
begin
  Result := (Content.Height <= ClientHeight) or
    (ScrollController.ContentTop <= -(Content.Height - (ClientHeight + 10)))
end;

procedure TPBTInfoScroll.ScrollControllerScrolling(Sender: TObject);
begin
  UpdateVisibleItems;
end;

procedure TPBTInfoScroll.InitializeObject;
begin
  inherited;
  SetBarSize(CNT_SCROLLBAR_SIZE);
  ScrollBars := sbScrollBar;
  ScrollController.OnScrolling := ScrollControllerScrolling;
end;

procedure TPBTInfoScroll.Resize;
begin
  inherited;
  Content.Width := ClientWidth - CNT_SCROLLBAR_SIZE;
  Refresh;
end;

function TPBTInfoScroll.GetScrollContentClass: TW3ScrollContentClass;
begin
  Result := TPBTScrollItems;
end;

function TPBTInfoScroll.CreationFlags: TW3CreationFlags;
begin
  inherited;
  // Allow key-capture and selection
  include(result, cfKeyCapture);
  include(result, cfAllowSelection);
end;

procedure TPBTInfoScroll.Clear;
begin
  FDataItems.Clear;
  Refresh;
end;

procedure TPBTInfoScroll.Refresh;
begin
  if Width > 0 then
  begin
    var wasAtBottom := GetScrollIsAtBottom;
    RealignItems;
    ScrollController.Refresh;
    if wasAtBottom then
      ScrollToBottom;
    UpdateVisibleItems;
  end;
end;

procedure TPBTInfoScroll.ScrollToBottom;
begin
  ScrollController.ScrollTo(0, -(Content.Height - ClientHeight));
end;

procedure TPBTInfoScroll.RealignItems;
begin
  // recalculate the size of each itemData
  if (FDataItems.Length > 0) or (FNewItems.Length > 0) then
    Items.BeginUpdate;
    try
      var aItem := Items.Add;
      try
        var aTop: integer := 0;
        for var aItemData in FDataItems do
        begin
          aItem.ItemData := aItemData;
          aItemData.ItemHeight := aItem.Height;
          aItemData.ItemTop := aTop;
          Inc(aTop, aItemData.ItemHeight);
        end;
        for var aItemData in FNewItems do
        begin
          FDataItems.Add(aItemData);
          aItem.ItemData := aItemData;
          aItemData.ItemHeight := aItem.Height;
          aItemData.ItemTop := aTop;
          Inc(aTop, aItemData.ItemHeight);
        end;
        FNewItems.Clear;
        Content.Height := aTop;
        if Content.Height < ClientHeight then
          Content.Height := ClientHeight;
      finally
        aItem.Free;
      end;
    finally
      Items.EndUpdate;
    end;
end;

procedure TPBTInfoScroll.UpdateVisibleItems;
var
  aStartIdx, aEndIdx, aDataIdx, viewTop: integer;
begin
  viewTop := ScrollController.ContentTop;
  if viewTop < 0 then
    viewTop := -viewTop;
  // find first visible itemData
  // start from the bottom of the list
  aStartIdx := FDataItems.Length;
  while (aStartIdx > 0) do
  begin
    Dec(aStartIdx);
    if FDataItems[aStartIdx].ItemTop <= viewTop then
      break;
  end;
  // find last visible itemData
  aEndIdx := aStartIdx;
  while (aEndIdx < FDataItems.Length) do
  begin
    if (aEndIdx = FDataItems.Length - 1) or
      (FDataItems[aEndIdx].ItemTop > viewTop + ClientHeight) then
      break;
    Inc(aEndIdx);
  end;
  Items.BeginUpdate;
  try
    if (aStartIdx >= FDataItems.Length) then
      Items.Clear
    else
    begin
      // adjust item count
      while Items.Count < (aEndIdx - aStartIdx) + 1 do
        Items.Add;
      while Items.Count > (aEndIdx - aStartIdx) + 1 do
        Items.Delete(Items.Count - 1);
      aDataIdx := aStartIdx;
      for var ii := 0 to Items.Count -1 do
      begin
        var aItem := Items[ii];
        aItem.ItemData := FDataItems[aDataIdx];
        Inc(aDataIdx);
      end;
    end;
  finally
    Items.EndUpdate;
  end;
end;

procedure TPBTInfoScroll.AddItem(aCallback: TPBTInfoScrollAddItemDataCallback);
const
  margin = 5;
begin
  var aItemData: TPBTScrollItemData := aCallback;
  if Width = 0 then
  begin
    FNewItems.Add(aItemData);
    exit;
  end;
  var wasAtBottom := (ScrollController.ContentTop <= -(Content.Height - (ClientHeight + 2 * margin)));
  Items.BeginUpdate;
  try
    if FDataItems.Length > 0 then
      aItemData.ItemTop := FDataItems[FDataItems.Length - 1].ItemTop +
        FDataItems[FDataItems.Length - 1].ItemHeight;
    FDataItems.Add(aItemData);
    var aItem := Items.Add;
    aItem.ItemData := aItemData;
    aItemData.ItemHeight := aItem.Height;
    Content.BeginUpdate;
    try
      Content.Height := aItem.Top + aItem.Height;
      if Content.Height <= ClientHeight then
      begin
        Content.Height := ClientHeight;
        wasAtBottom := True;
      end;
    finally
      Content.EndUpdate;
    end;
  finally
    Items.EndUpdate;
  end;
  ScrollController.Refresh;
  if wasAtBottom then
    ScrollToBottom;
  UpdateVisibleItems;
end;

procedure TPBTInfoScroll.AddText(const aText: string);
begin
  AddItem(
    lambda
      Result := new TPBTScrollItemData;
      Result.ItemText := aText;
    end
  );
end;

procedure TPBTInfoScroll.AddChat(aChatType: TPBTChatType; const aChatHeader, aChatText: string; aChatColor: TColor);
begin
  AddItem(
    lambda
      Result := new TPBTScrollChatItemData;
      TPBTScrollChatItemData(Result).ChatType := aChatType;
      TPBTScrollChatItemData(Result).ChatHeader := aChatHeader;
      TPBTScrollChatItemData(Result).ChatText := aChatText;
      TPBTScrollChatItemData(Result).ChatColor := aChatColor;
    end
  );
end;

procedure TPBTInfoScroll.AddInfo(const aInfoText: string);
begin
  AddItem(
    lambda
      Result := new TPBTScrollInfoItemData;
      Result.ItemText := aInfoText;
    end
  );
end;

procedure TPBTInfoScroll.AddError(const aErrorText: string);
begin
  AddItem(
    lambda
      Result := new TPBTScrollErrorItemData;
      Result.ItemText := aErrorText;
    end
  );
end;

function TPBTInfoScroll.MaxInfoWidth: integer;
var
  aMax: string;
begin
  while aMax.Length < 70 do
    aMax += 'XXXXXXXXXX';
  Result := MeasureText(aMax).tmWidth + GetBarSize;
end;

function TPBTInfoScroll.MinInfoWidth: integer;
begin
  Result := MaxInfoWidth div 2;
end;

end.

There are some bits that specific to my Paintball Net project, like the style names, which I have keyed to CSS.

-David

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×