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

概述我正尝试使用以下格式从列表框中的RSS显示新闻,如下图所示.屏幕截图中的应用程序是通过设置列表框样式在firemonkey中开发的.我需要在我的VCL应用程序中显示相同内容. 这种布局的要求是： >新闻标题应为粗体文字 >简短描述应位于底部,应该是 如果它不适合单行(如图所示); font-style应该是正常的 >每个新闻项都应该有一个图像 我的代码到目前为止： procedure TfrmDa 我正尝试使用以下格式从列表框中的RSS显示新闻,如下图所示.屏幕截图中的应用程序是通过设置列表框样式在firemonkey中开发的.我需要在我的VCL应用程序中显示相同内容.

这种布局的要求是：

>新闻标题应为粗体文字
>简短描述应位于底部,应该是
如果它不适合单行(如图所示);
Font-style应该是正常的
>每个新闻项都应该有一个图像

我的代码到目前为止：

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;

这是我得到的输出：

问题

Unicode文本绘图太慢,滚动列表框或调整窗体大小时,它会闪烁太多.

注意

>字体已设置为@Microsoft NeoGothic
>物品高度= 70; style = ownerdrawfixed
>在中绘制相同的unicode文本没有问题
firemonkey应用程序发布在第一个屏幕截图中.
>上面发布的代码适用于普通的英文文本和
根本没有闪烁.该问题仅存在于Unicode文本中.

更新：
似乎问题出在DrawText方法的DT_WORDBREAK标志中.每当我删除此标志时,虽然闪烁可见,但绘制文本有显着改进.

UnicoIDe文本示例

तिम्रोत्योबोलिलेमलाईबोलायोमिठोतिम्रोत्योमुस्कानमामलाईझुलायोझुलाओह्स्द्जिःसह्स्ध्फद्जद्श्जड्सहसफगस्द्फ़गस्द्फ्गफसग्स्द्फ़ग्दस्फ्गद्स्फग्दतिम्रोत्योबोलिलेमलाईबोलायोमिठोतिम्रोत्योमुस्कानमामलाईसह्स्ध्फद्जद्श्जड्सहसफगस्द्फ़गस्द्फ्गफसग्स्द्फ़ग्दस्फ्ग द्स्फग्द

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

unit Unit12;interfaceuses  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.

总结

以上是内存溢出为你收集整理的delphi – 在列表框画布上绘制unicode文本太慢了全部内容，希望文章能够帮你解决delphi – 在列表框画布上绘制unicode文本太慢了所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。