delphi – 在列表框画布上绘制unicode文本太慢了

procedure TfrmDatePicker.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
  R: TRect;
begin
  ListBox1.Canvas.Font.Color := clBlack;
  ListBox1.Canvas.Font.Style := [fsBold];

  ListBox1.Canvas.Font.Size := 9;

  if Odd(Index) then ListBox1.Canvas.Brush.Color := clWhite
  else ListBox1.Canvas.Brush.Color := clBtnFace;

  ListBox1.Canvas.FillRect (Rect);
  ListBox1.Canvas.Pen.Color := clHighlight;

  if(odSelected in State) then
  begin
      ListBox1.Canvas.Font.Color := clHighlightText;
      ListBox1.Canvas.Brush.Color := clHighlight;
      ListBox1.Canvas.Rectangle(Rect.Left,Rect.Top,Rect.Right,Rect.Bottom);
      if(odFocused in State) then DrawFocusRect(ListBox1.Canvas.Handle,Rect);
  end;

  ImageList1.Draw(ListBox1.Canvas,Rect.Left + 2,Rect.top + (ListBox1.ItemHeight - ImageList1.Height) div 2,Index,true);


  ListBox1.Canvas.TextOut(Rect.Left + 70,Rect.Top + 4,'????????? ??????????????????????????');

  ListBox1.Canvas.Font.Style := ListBox1.Canvas.Font.Style - [fsBold];

  R := Rect;
  R.Left := R.Left + 70;
  R.Top := R.Top + 32;
  R.Height := 30;

  DrawText(ListBox1.Canvas.Handle,PChar(ss),Length(ss),R,DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);
  ListBox1.Canvas.TextOut(Rect.Right - 80,Rect.top + 4,'5 mins ago');
end;

如果你REALY REALY REALY想要使用标准的ListBox来显示你的RSS feed我建议你使用双缓冲.这意味着你在内存中的位图上绘制你的东西,并将它绘制到listView.源代码我已经做了一个小型演示,向您展示如何操作.我没有解决所有问题,但我相信这是您使用标准VCL组件所能获得的最佳效果.

unit Unit12;

interface

uses
  Winapi.Windows,Winapi.Messages,System.SysUtils,System.Variants,System.Classes,Vcl.Graphics,Vcl.Controls,Vcl.Forms,Vcl.Dialogs,Vcl.StdCtrls,Vcl.ImgList;

type
  TForm12 = class(TForm)
    ListBox1: TListBox;
    ImageList1: TImageList;
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    MemBitmap: TBitmap;
    OldListBoxWP: TWndMethod;
    procedure NewListBoxWP(var Message: TMessage);
  public
    { Public declarations }
  end;

var
  Form12: TForm12;

implementation

{$R *.dfm}

const
  NewsStr = '?????? ???? ???? ?? ???? ?????? ???? ?????? ???? ??????? ?? ???? ?????? ???' +
    '?? ????????? ? ?????????? ???????? ?? ?? ????? ? ??????? ?? ??????? ???????? ???????? ?????? ???? ???? ?? ???? ?????? ???? ?????? ???? ??????? ?? ???? ? ?????????? ???????? ?? ?? ????? ? ??????? ?? ??????? ???????? ????????';

procedure TForm12.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ListBox1.WindowProc := OldListBoxWP;
  MemBitmap.Free;
end;

procedure TForm12.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  OldListBoxWP := ListBox1.WindowProc;
  ListBox1.WindowProc := NewListBoxWP;
  MemBitmap := TBitmap.Create;
  MemBitmap.SetSize(Width,Height);

  ListBox1.Items.BeginUpdate;
  for i := 0 to 10 do
    ListBox1.Items.Add(NewsStr);
  ListBox1.Items.EndUpdate;
end;

procedure TForm12.FormResize(Sender: TObject);
begin
  MemBitmap.SetSize(Width,Height);
end;

procedure TForm12.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  R: TRect;
begin
  MemBitmap.Canvas.Font.Color := clBlack;
  MemBitmap.Canvas.Font.Style := [fsBold];

  MemBitmap.Canvas.Font.Size := 9;

  if Odd(Index) then
    MemBitmap.Canvas.Brush.Color := clWhite
  else
    MemBitmap.Canvas.Brush.Color := clBtnFace;

  MemBitmap.Canvas.FillRect(Rect);
  MemBitmap.Canvas.Pen.Color := clHighlight;

  if (odSelected in State) then
  begin
    MemBitmap.Canvas.Font.Color := clHighlightText;
    MemBitmap.Canvas.Brush.Color := clHighlight;
    MemBitmap.Canvas.Rectangle(Rect.Left,Rect.Bottom);
    if (odFocused in State) then
      DrawFocusRect(MemBitmap.Canvas.Handle,Rect);
  end;

  ImageList1.Draw(MemBitmap.Canvas,Rect.Top + (ListBox1.ItemHeight - ImageList1.Height) div 2,true);
  MemBitmap.Canvas.TextOut(Rect.Left + 70,'????????? ??????????????????????????');

  MemBitmap.Canvas.Font.Style := MemBitmap.Canvas.Font.Style - [fsBold];

  R := Rect;
  R.Left := R.Left + 70;
  R.Top := R.Top + 32;
  R.Height := 30;

  DrawText(MemBitmap.Canvas.Handle,PChar(NewsStr),Length(NewsStr),DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);
  MemBitmap.Canvas.TextOut(Rect.Right - 80,'5 mins ago');

  BitBlt(ListBox1.Canvas.Handle,Rect.Left - 1,Rect.Top - 1,Rect.Right - Rect.Left + 2,Rect.Bottom - Rect.Top + 2,MemBitmap.Canvas.Handle,SRCCOPY);
end;

procedure TForm12.NewListBoxWP(var Message: TMessage);
begin
  if Message.Msg = WM_ERASEBKGND then
    Message.Result := 0
  else
    OldListBoxWP(Message);
end;

end.