Question

请参阅我在tek-tips.com上提出的问题： http://tek-tips.com/viewthread.cfm?qid=1663735&page=1

正如我在其他几个主题中所提到的，我正在构建一个控件，以便在iPhone上复制SMS短信。这仅包含包含文本的控件两侧的气泡。我已经有一个工作版本，但需要从头开始重新构建它。我想对一些事情提出一些建议......

您认为存储邮件数据列表的最佳方法是什么？我在考虑使用TCollection，但这可能太重了。目前我正在使用包含原始文本数据的TStringList，该数据被解析并适当地翻译。这很好用，因为我不必创建任何带有不必要属性的额外对象。它只是......

data syntax:
<user_size><deliminator><user><message_size><deliminator><message>

which could look like:
9|djjd4713023|This is a test message!

characters:
SDTTTTTTTTTSSDTTTTTTTTTTTTTTTTTTTTTTT

user_size = 9
deliminator = |
user = djjd47130
etc.......

无论如何，我预计这个控件中可能有数千条消息。这让我想到了下一个问题。绘制它的最佳方式。目前，我正在使用TDrawGrid，并且正在将其转换为TStringGrid，因此我可以直接在网格中包含文本而不是TStringList。然而，这就是我停下来的地方，因为我想知道是否还有一种比使用网格更好的方法。这很简单，因为它可以自动管理存储每个单元格的矩形等。

如何使用TImage代替？关于可能的最大控制尺寸还存在另一个问题。随着消息的增多，此控件会自动增大，因此，如果有1000条消息，平均消息气泡高度约为80像素，则表示网格控制需要高达80,000像素。虽然使用TImage可能很难，因为我必须手动计算画布上的位置以绘制每个气球，类似于网格内部跟踪的情况。

顺便说一句，这个网格（或其他画布）位于TScrollBox内（最终控件将继承自TScrollingWinControl）。这是它可以滚动的方式，而实际的画布本身比控件大得多，大到足以绘制所有的消息气球。滚动控件实际上是在TScrollBox中上下移动，以查看显示消息的控件画布部分。

总结我需要完善的部分： - 在列表中存储消息项的轻量级方法（在网格，字符串列表，集合或其他列表中？） - 具有可变高度列表项的可滚动画布（网格，图像或其他列表？） - 允许最大数量的消息保持在可变高度？ - 能够自定义控件如何响应用户操作以自动向上或向下滚动

我不一定要求解决任何事情，而是建议尽可能做到最好。

Answer 1

如果我是你，我会做这样的事情：

unit ChatControl;

interface

uses
  Windows, Messages, SysUtils, Classes, Controls, Graphics;

type
  TUser = (User1 = 0, User2 = 1);

  TChatControl = class(TCustomControl)
  private
    FColor1, FColor2: TColor;
    FStrings: TStringList;
    FScrollPos: integer;
    FOldScrollPos: integer;
    FBottomPos: integer;
    FBoxTops: array of integer;
    FInvalidateCache: boolean;
    procedure StringsChanged(Sender: TObject);
    procedure SetColor1(Color1: TColor);
    procedure SetColor2(Color2: TColor);
    procedure SetStringList(Strings: TStringList);
    procedure ScrollPosUpdated;
    procedure InvalidateCache;
  protected
    procedure Paint; override;
    procedure Resize; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WndProc(var Message: TMessage); override;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
      MousePos: TPoint): Boolean; override;
    procedure Click; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Say(const User: TUser; const S: String): Integer;
    procedure ScrollToBottom;
  published
    property Align;
    property Anchors;
    property Cursor;
    property Font;
    property Color1: TColor read FColor1 write SetColor1 default clSkyBlue;
    property Color2: TColor read FColor2 write SetColor2 default clMoneyGreen;
    property Strings: TStringList read FStrings write SetStringList;
    property TabOrder;
    property TabStop;
  end;

procedure Register;

implementation

uses Math;

procedure Register;
begin
  RegisterComponents('Rejbrand 2009', [TChatControl]);
end;

{ TChatControl }

procedure TChatControl.Click;
begin
  inherited;
  if CanFocus and TabStop then
    SetFocus;
end;

constructor TChatControl.Create(AOwner: TComponent);
begin
  inherited;

  DoubleBuffered := true;

  FScrollPos := 0;
  FBoxTops := nil;
  InvalidateCache;

  FStrings := TStringList.Create;
  FStrings.OnChange := StringsChanged;
  FColor1 := clSkyBlue;
  FColor2 := clMoneyGreen;

  FOldScrollPos := MaxInt;
end;

procedure TChatControl.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := Params.Style or WS_VSCROLL;
end;

destructor TChatControl.Destroy;
begin
  FStrings.Free;
  inherited;
end;

function TChatControl.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  MousePos: TPoint): Boolean;
begin
  dec(FScrollPos, WheelDelta);
  ScrollPosUpdated;
end;

procedure TChatControl.InvalidateCache;
begin
  FInvalidateCache := true;
end;

procedure TChatControl.Paint;
const
  Aligns: array[TUser] of integer = (DT_RIGHT, DT_LEFT);
var
  Colors: array[TUser] of TColor;
var
  User: TUser;
  i, y, MaxWidth, RectWidth: integer;
  r, r2: TRect;
  SI: TScrollInfo;
begin

  inherited;

  Colors[User1] := FColor1;
  Colors[User2] := FColor2;

  y := 10 - FScrollPos;
  MaxWidth := ClientWidth div 2;

  Canvas.Font.Assign(Font);

  if FInvalidateCache then
    SetLength(FBoxTops, FStrings.Count);

  for i := 0 to FStrings.Count - 1 do
  begin

    if FInvalidateCache then
      FBoxTops[i] := y + FScrollPos
    else
    begin
      if (i < (FStrings.Count - 1)) and (FBoxTops[i + 1] - FScrollPos < 0) then
        Continue;
      if FBoxTops[i] - FScrollPos > ClientHeight then
        Break;
      y := FBoxTops[i] - FScrollPos;
    end;

    User := TUser(FStrings.Objects[i]);

    Canvas.Brush.Color := Colors[User];

    r := Rect(10, y, MaxWidth, 16);
    DrawText(Canvas.Handle,
      PChar(FStrings[i]),
      Length(FStrings[i]),
      r,
      Aligns[User] or DT_WORDBREAK or DT_CALCRECT);

    if User = User2 then
    begin
      RectWidth := r.Right - r.Left;
      r.Right := ClientWidth - 10;
      r.Left := r.Right - RectWidth;
    end;

    r2 := Rect(r.Left - 4, r.Top - 4, r.Right + 4, r.Bottom + 4);
    Canvas.RoundRect(r2, 5, 5);

    DrawText(Canvas.Handle,
      PChar(FStrings[i]),
      Length(FStrings[i]),
      r,
      Aligns[User] or DT_WORDBREAK);

    if FInvalidateCache then
    begin
      y := r.Bottom + 10;
      FBottomPos := y + FScrollPos;
    end;

  end;

  SI.cbSize := sizeof(SI);
  SI.fMask := SIF_ALL;
  SI.nMin := 0;
  SI.nMax := FBottomPos;
  SI.nPage := ClientHeight;
  SI.nPos := FScrollPos;
  SI.nTrackPos := SI.nPos;

  SetScrollInfo(Handle, SB_VERT, SI, true);

  if FInvalidateCache then
    ScrollToBottom;

  FInvalidateCache := false;

end;

procedure TChatControl.Resize;
begin
  inherited;
  InvalidateCache;
  Invalidate;
end;

function TChatControl.Say(const User: TUser; const S: String): Integer;
begin
  result := FStrings.AddObject(S, TObject(User));
end;

procedure TChatControl.ScrollToBottom;
begin
  Perform(WM_VSCROLL, SB_BOTTOM, 0);
end;

procedure TChatControl.SetColor1(Color1: TColor);
begin
  if FColor1 <> Color1 then
  begin
    FColor1 := Color1;
    Invalidate;
  end;
end;

procedure TChatControl.SetColor2(Color2: TColor);
begin
  if FColor2 <> Color2 then
  begin
    FColor2 := Color2;
    Invalidate;
  end;
end;

procedure TChatControl.SetStringList(Strings: TStringList);
begin
  FStrings.Assign(Strings);
  InvalidateCache;
  Invalidate;
end;

procedure TChatControl.StringsChanged(Sender: TObject);
begin
  InvalidateCache;
  Invalidate;
end;

procedure TChatControl.WndProc(var Message: TMessage);
var
  SI: TScrollInfo;
begin
  inherited;
  case Message.Msg of
    WM_GETDLGCODE:
      Message.Result := Message.Result or DLGC_WANTARROWS;
    WM_KEYDOWN:
      case Message.wParam of
        VK_UP:
          Perform(WM_VSCROLL, SB_LINEUP, 0);
        VK_DOWN:
          Perform(WM_VSCROLL, SB_LINEDOWN, 0);
        VK_PRIOR:
          Perform(WM_VSCROLL, SB_PAGEUP, 0);
        VK_NEXT:
          Perform(WM_VSCROLL, SB_PAGEDOWN, 0);
        VK_HOME:
          Perform(WM_VSCROLL, SB_TOP, 0);
        VK_END:
          Perform(WM_VSCROLL, SB_BOTTOM, 0);
      end;
    WM_VSCROLL:
      begin
        case Message.WParamLo of
          SB_TOP:
            begin
              FScrollPos := 0;
              ScrollPosUpdated;
            end;
          SB_BOTTOM:
            begin
              FScrollPos := FBottomPos - ClientHeight;
              ScrollPosUpdated;
            end;
          SB_LINEUP:
            begin
              dec(FScrollPos);
              ScrollPosUpdated;
            end;
          SB_LINEDOWN:
            begin
              inc(FScrollPos);
              ScrollPosUpdated;
            end;
          SB_PAGEUP:
            begin
              dec(FScrollPos, ClientHeight);
              ScrollPosUpdated;
            end;
          SB_PAGEDOWN:
            begin
              inc(FScrollPos, ClientHeight);
              ScrollPosUpdated;
            end;
          SB_THUMBTRACK:
            begin
              ZeroMemory(@SI, sizeof(SI));
              SI.cbSize := sizeof(SI);
              SI.fMask := SIF_TRACKPOS;
              if GetScrollInfo(Handle, SB_VERT, SI) then
              begin
                FScrollPos := SI.nTrackPos;
                ScrollPosUpdated;
              end;
            end;
        end;
        Message.Result := 0;
      end;
  end;
end;

procedure TChatControl.ScrollPosUpdated;
begin
  FScrollPos := EnsureRange(FScrollPos, 0, FBottomPos - ClientHeight);
  if FOldScrollPos <> FScrollPos then
    Invalidate;
  FOldScrollPos := FScrollPos;
end;

end.

即使有10 000条消息，这也是超快的。

Screenshot

要测试它，请执行类似

的操作

procedure TForm4.Button1Click(Sender: TObject);
var
  i: integer;
begin
  ChatControl1.Strings.Clear;
  for i := 0 to StrToInt(LabeledEdit1.Text) - 1 do
    ChatControl1.Say(TUser(Random(2)), RandomString(2, 80));
end;

procedure TForm4.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
  Assert(Sender is TEdit);
  if ord(Key) = VK_RETURN then
  begin
    ChatControl1.Say(TUser(TEdit(Sender).Tag), TEdit(Sender).TExt);
    Key := #0;
    TEdit(Sender).Clear;
  end;
end;

完整源码和编译演示：ChatControlDemo.zip

尽管如此，仍有进一步改进的空间。例如，当您将单个消息添加到字符串列表的末尾时，重新计算整个缓存数组是非常愚蠢的。显然，只需将这个新添加的消息的位置附加到缓存数组就足够了。但是我把它留给你了。

Delphi - 自定义绘制消息列表

1 个答案: