我正在创建一个消息传递应用程序,我想在列表框中进行聊天(聊天的选择),我想在有人在线时将名称更改为绿色。有没有办法做到这一点?
答案 0 :(得分:2)
这很容易。您只需要所有者绘制列表框。
将列表框的 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.
结果:
很明显,您需要稍微调整代码以使其看起来不错,但至少这应该给您一个良好的开端。