Zeichnen von Unicode Text auf Listbox Canvas ist zu langsam

Question

Ich versuche, Nachrichten aus einem RSS in einer Listbox mit dem folgenden Format anzuzeigen, wie in der Abbildung unten gezeigt. Die Anwendung auf dem Screenshot wurde in Firefemonkey entwickelt, indem die Listbox formatiert wurde. Ich muss dasselbe in meiner VCL-Anwendung anzeigen.

Die Anforderungen dieses Layouts sind:

• Die Nachricht Titel fett gedruckten Text
• Die kurze Beschreibung sollte, wenn es am Boden, und es sollte sein gewickelt doesn befinden sollte‘ t passt in eine einzelne Linie (wie im Bild gezeigt); font-style sollte normal sein
• Es sollte

Mein Code bisher ein Bild für jede News sein:

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; 

Hier wird die Ausgabe erhalte ich:

Problem

Die Unicode-Textzeichnung ist zu langsam und es flackert zu sehr, wenn die Listbox gescrollt wird oder die Größe des Formulars geändert wird.

Hinweis

• Die Schriftart @microsoft neugotischen gesetzt wurde
• ItemHeight = 70; style = ownerdrawfixed
• Es gibt kein Problem beim Zeichnen des gleichen Unicode-Textes in der firemonkey Anwendung, die im ersten Screenshot gepostet wurde.
• Der oben geschriebene Code funktioniert ziemlich gut für normalen englischen Text und gibt es überhaupt kein Flackern. Das Problem besteht nur für Unicode-Text.

Update: Es scheint, das Problem ist in DT_WORDBREAK Flagge DrawText Methode. Immer wenn ich dieses Flag entferne, gibt es eine deutliche Verbesserung in der Zeichnung des Textes, obwohl das Flackern sichtbar ist.

Probe Unicoide Text

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

Answer 1

Wenn Sie WIRKLICH wollen WIRKLICH WIRKLICH ein Standard-List-Box verwenden für Sie RSS-Feed Anzeige Ich schlage vor, Sie Double-Buffering verwenden. Das heißt, du machst deine Sachen auf eine Bitmap im Speicher und machst das auf dich listView. Von dir Sourcecode habe ich eine kleine Demo gemacht, die dir zeigt wie es geht.Ich löse nicht alle Probleme, aber ich glaube, das ist das Beste, was man mit einer VCL-Standardkomponente bekommen kann.

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.