Il testo Unicode nella tela della casella di riepilogo è troppo lento

Question

Sto tentando di visualizzare notizie da un RSS in una casella di riepilogo utilizzando il seguente formato, come mostrato nell'immagine seguente. L'applicazione sullo screenshot è stata sviluppata in firemonkey disegnando la listbox. Devo visualizzare lo stesso nella mia applicazione VCL.

Le disposizioni della presente disposizione sono:

• Il titolo notizia dovrebbe essere il testo in grassetto
• La descrizione breve dovrebbe essere collocato in basso e dovrebbe essere confezionati se doesn' t adattarsi in una singola riga (come mostrato nell'immagine); font-style dovrebbe essere normale
• Ci dovrebbe essere un'immagine per ogni notizia

Il mio codice finora:

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; 

Ecco l'output sto ottenendo:

Problema

Il disegno del testo Unicode è troppo lento e sfarfallio quando la casella di riepilogo scorre o il modulo viene ridimensionato.

Nota

• Il carattere è stata impostata a @microsoft neogotico
• itemHeight = 70; style = ownerdrawfixed
• Non c'è alcun problema nel disegnare lo stesso testo unicode nell'applicazione firemonkey pubblicata nel primo screenshot.
• Il codice pubblicato sopra funziona piuttosto bene per il normale testo inglese e non c'è affatto sfarfallio. Il problema esiste solo per il testo Unicode.

Aggiornamento: Sembra che il problema è nella DT_WORDBREAK bandiera della DrawText metodo. Ogni volta che rimuovo questo flag, c'è un miglioramento significativo nel disegno del testo anche se i flicker sono visibili.

Esempio Unicoide Testo

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

Answer 1

Se REALY REALY REALY desidera utilizzare un ListBox standard per la visualizzazione si Feed RSS ti suggerisco di utilizzare il doppio buffering. Significa che disegni le tue cose su una bitmap in memoria e den draw that you listView. Da te Sourcecode ho fatto una piccola demo che ti mostra come fare.Non risolvo tutti i problemi ma credo che questo sia quanto di meglio si possa ottenere con un componente VCL standard.

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.