在列表框画布上绘制unicode文本太慢了 [英] Drawing unicode text on listbox canvas is too slow
问题描述
我正在使用以下格式显示列表框中的RSS来显示新闻,如下图所示。屏幕截图上的应用程序是通过对列表框进行样式开发的。我需要在我的VCL应用程序中显示相同的信息。
I am trying to display news from a RSS in a listbox using the following format as shown in the image below. The application on the screenshot has been developed in firemonkey by styling the listbox. I need to display the same in my VCL application.
此布局的要求是:
- 新闻标题应为粗体文本
- 简短说明应位于底部,如果不适合单行(如图所示),则应包含
;
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文本绘图太慢了,当列表框滚动或窗体调整大小时,它会闪烁太多。
Unicode text drawing is too slow and it flickers too much when the listbox is scrolled or the form is resized.
注意
- 该字体已设置为 @Microsoft NeoGothic
- Itemheight = 70; style = ownerdrawfixed
- 在第一个截图中发布的
firemonkey应用程序中绘制相同的unicode文本没有问题。 - 上面贴上的代码对于正常的英文文本和
都没有闪烁。该问题仅存在于Unicode文本中。
- The font has been set to @Microsoft NeoGothic
- Itemheight =70; style = ownerdrawfixed
- There is no problem in drawing the same unicode text in the firemonkey application posted in the first screenshot.
- The code posted above works pretty fine for normal English text and there is no flicker at all. The problem exists only for Unicode text.
更新:
似乎问题出在 DrawText 方法的 DT_WORDBREAK 标志。每当我删除这个标志,绘图文本虽然闪烁是可见的有很大的改善。
Update: It seems the problem is in DT_WORDBREAK flag of DrawText method. Whenever I remove this flag, there is significant improvement in the drawing the text though the flickers are visible.
样本Unicoide文本
तिम्रोत्योबोलिलेमलाईबोलायोमिठोतिम्रोत्योमुस्कान मामलाईझुलायोझुलाओह्स्द्जिःसह्स्ध्फद्जद्श्जड्सहसफगस्द्फ़गस्द्फ्गफसग्स्द्फ़ग्दस्फ्गद्स्फग्दतिम्रोत्योबोलिलेमलाईबोलायोमिठोतिम्रोत्योमुस्कानमामलाईसह्स्ध्फद्जद्श्जड्सहसफगस्द्फ़गस्द्फ्गफसग्स्द्फ़ग्दस्फ्गद्स्फग्द
तिम्रो त्यो बोलि ले मलाई बोलायो मिठो तिम्रो त्यो मुस्कान मा मलाई झुलायो झुलाओ ह्स्द्जिः स ह्स्ध्फद्ज द्श्जड्स हस फग स्द्फ़ ग स्द्फ्ग फस ग्स्द्फ़ ग्दस्फ्ग द्स्फग्द तिम्रो त्यो बोलि ले मलाई बोलायो मिठो तिम्रो त्यो मुस्कान मा मलाई स ह्स्ध्फद्ज द्श्जड्स हस फग स्द्फ़ ग स्द्फ्ग फस ग्स्द्फ़ ग्दस्फ्ग द्स्फग्द
推荐答案
如果你现实现实想要使用标准ListBox显示你的R SS提要我建议你使用双缓冲。这意味着你可以在内存中绘制一些位图,并将其绘制到listView中。从你的源代码我已经做了一个小的演示,显示你如何做。我不解决所有的问题,但我相信这是最好的一个标准的VCL组件可以得到。单位Unit12;
If you REALY REALY REALY want to use a standard ListBox for displaying you RSS feed I suggest you use double Buffering. Meaning you draw your stuff on a bitmap in memory and den draw that to you listView. From you Sourcecode i've made a small demo showing you how to do.I doesn't solve all the problems but I belive this is the best you can get with a standard VCL component.
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.Top, Rect.Right, Rect.Bottom);
if (odFocused in State) then
DrawFocusRect(MemBitmap.Canvas.Handle, Rect);
end;
ImageList1.Draw(MemBitmap.Canvas, Rect.Left + 2, Rect.Top + (ListBox1.ItemHeight - ImageList1.Height) div 2, Index, true);
MemBitmap.Canvas.TextOut(Rect.Left + 70, Rect.Top + 4, 'कान्तिपुर समाचारआजकोपत्रिकामाकेहिछैन');
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), R, DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);
MemBitmap.Canvas.TextOut(Rect.Right - 80, Rect.Top + 4, '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, Rect.Left - 1, Rect.Top - 1, SRCCOPY);
end;
procedure TForm12.NewListBoxWP(var Message: TMessage);
begin
if Message.Msg = WM_ERASEBKGND then
Message.Result := 0
else
OldListBoxWP(Message);
end;
end.
这篇关于在列表框画布上绘制unicode文本太慢了的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!