更改列表框中特定项目的颜色 [重复]

Question

我正在创建一个消息传递应用程序，我想在列表框中进行聊天（聊天的选择），并且我想在有人在线时将名称更改为绿色。有没有办法做到这一点？

Answer 1

这很容易。您只需要所有者绘制列表框。

将列表框的Style 设置为lbVirtualOwnerDraw 并分配其OnData 和OnDrawItem 处理程序：

unit ChatMainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, Generics.Collections;

type
  TUserData = record
    UserName: string;
    Online: Boolean;
  end;

  TMainForm = class(TForm)
    lbUsers: TListBox;
    procedure lbUsersData(Control: TWinControl; Index: Integer;
      var Data: string);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure lbUsersDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
      State: TOwnerDrawState);
  private
    FUserData: TList<TUserData>;
  public

  end;

var
  MainForm: TMainForm;

implementation

uses
  Math;

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);

  function usr(const AUserName: string; AOnline: Boolean): TUserData;
  begin
    Result.UserName := AUserName;
    Result.Online := AOnline;
  end;

begin

  FUserData := TList<TUserData>.Create;
  FUserData.Add(usr('Andreas Rejbrand', True));
  FUserData.Add(usr('John Doe', False));
  FUserData.Add(usr('Mary Smith', True));
  FUserData.Add(usr('Bill Evans', False));
  FUserData.Add(usr('Jonathan Stone', True));
  FUserData.Add(usr('Gary Jones', True));

  lbUsers.Count := FUserData.Count;

end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FUserData.Free;
end;

procedure TMainForm.lbUsersData(Control: TWinControl; Index: Integer;
  var Data: string);
begin
  if InRange(Index, 0, FUserData.Count - 1) then
    Data := FUserData[Index].UserName;
end;

procedure TMainForm.lbUsersDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
const
  BackColors: array[Boolean] of TColor = (clWindow, clWindow);
  TextColors: array[Boolean] of TColor = (clGrayText, clWindowText);
begin
  if InRange(Index, 0, FUserData.Count - 1) then
  begin
    lbUsers.Canvas.Brush.Color := BackColors[FUserData[Index].Online];
    lbUsers.Canvas.Font.Color := TextColors[FUserData[Index].Online];
    if odSelected in State then
    begin
      lbUsers.Canvas.Brush.Color := clHighlight;
      lbUsers.Canvas.Font.Color := clHighlightText;
    end;
    lbUsers.Canvas.Font.Style := [];
    if FUserData[Index].Online then
      lbUsers.Canvas.Font.Style := [fsBold];
    lbUsers.Canvas.FillRect(Rect);
    InflateRect(Rect, -2, -2);
    var S := FUserData[Index].UserName;
    lbUsers.Canvas.TextRect(Rect, S,
      [tfSingleLine, tfVerticalCenter, tfEndEllipsis]);
  end;
end;

end.

结果：

显然，您需要稍微调整一下代码以使其看起来不错，但至少这应该会给您一个良好的开端。