ListView + OwnerData / OwnerDraw / VCL样式严重闪烁

问题描述

如何避免在自定义绘制/数据ListView上闪烁？ DoubleBuffering已设置，但没有任何区别。使用鼠标滚轮滚动时，特别是在LV的顶部和底部，会产生非常明显的闪烁，然后使用滚动条将其完全“空白”，直到您停止移动为止，除非您非常缓慢地移动。

基于RRUZ examples的代码。

DPR

program ListViewDemo;

uses
  Vcl.Forms,main in 'main.pas' {FrmMain},Vcl.Themes,Vcl.Styles;

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  TStyleManager.TrySetStyle('Onyx Blue');
  Application.CreateForm(TFrmMain,FrmMain);
  Application.Run;
end.

PAS

unit main;

interface

uses
  Winapi.Windows,Winapi.Messages,CommCtrl,System.SysUtils,System.Variants,System.Classes,System.Generics.Collections,Vcl.Graphics,Vcl.Controls,Vcl.Forms,Vcl.Dialogs,Vcl.ComCtrls,System.ImageList,Vcl.ImgList,PngImageList;

type
  TColumnType = (ctText,ctCheck,ctProgress);

  TFrmMain = class(TForm)
    LvSampleData: TListView;
    PngImageList1: TPngImageList;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure LvSampleDataDrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
    procedure LvSampleDataData(Sender: TObject; Item: TListItem);
  private
    FColumns  : TDictionary<string,TListColumn>;
    procedure AddColumns();
    procedure AddItems();
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation

{$R *.dfm}

uses
  Vcl.Themes,Vcl.GraphUtil;

procedure TFrmMain.AddColumns;

  Procedure AddColumn(const AColumnName : String; AWidth : Integer; AColumnType : TColumnType);
  begin
   FColumns.Add(AColumnName,LvSampleData.Columns.Add());
   FColumns[AColumnName].Caption := AColumnName;
   FColumns[AColumnName].Width   := AWidth;
   FColumns[AColumnName].Tag     := Integer(AColumnType);
  end;

begin
   FColumns  := TDictionary<string,TListColumn>.Create();
   AddColumn('Text',150,ctText);
   AddColumn('Perc',100,ctProgress);
   AddColumn('Text2',ctText);
   AddColumn('Enabled',ctCheck);
end;

procedure TFrmMain.AddItems;
const
 MaxItems = 100;
var
 LItem : TListItem;
 i : Integer;
begin
  Randomize;
  LvSampleData.Items.BeginUpdate;
  try
    for i := 0 to MaxItems - 1 do
    begin
      LItem := LvSampleData.Items.Add;
      LItem.Caption:= Format('Sample text',[]);
      LItem.SubItems.Add(IntToStr(Random(101)));
      LItem.SubItems.Add(Format('Sample text 2',[]));
      LItem.SubItems.Add(IntToStr(Random(2)));
    end;
  finally
    LvSampleData.Items.EndUpdate;
  end;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := True;
  LvSampleData.OwnerDraw := True;
  LvSampleData.OwnerData := True;
  LvSampleData.ViewStyle := TViewStyle.vsReport;
  AddColumns();
  LvSampleData.Items.Count := 200;
end;

procedure TFrmMain.FormDestroy(Sender: TObject);
begin
  FColumns.Free;
end;

function ResizeRect(const ARect: TRect; const DxLeft,DxRight,DyTop,DyBottom: integer): TRect;
begin
  Result := ARect;
  Inc(Result.Left,DxLeft);
  Dec(Result.Right,DxRight);
  Inc(Result.Top,DyTop);
  Dec(Result.Bottom,DyBottom);
end;

procedure TFrmMain.LvSampleDataData(Sender: TObject; Item: TListItem);
begin
  Item.ImageIndex := 0;
  Item.Caption := Format('Sample text '+IntToStr(Random(1000)),[]);
  Item.SubItems.Add('75');
  Item.SubItems.Add(Format('Sample text 2',[]));
  Item.SubItems.Add('1');
end;

procedure TFrmMain.LvSampleDataDrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
const
  ListView_Padding = 5;
var
  LRect,LRect2: TRect;
  R: TRect;
  i,p : Integer;
  LText: string;
  LSize: TSize;
  LDetails: TThemedElementDetails;
  Ltextformat : TtextformatFlags;
  LColor : TColor;
  LStyleService : TCustomStyleServices;
  LColummnType  : TColumnType;
begin

  LStyleService  := StyleServices;
  if not LStyleService.Enabled then exit;

  Sender.Canvas.Brush.Style := bsSolid;
  Sender.Canvas.Brush.Color := LStyleService.GetSystemColor(clWindow);
  Sender.Canvas.FillRect(Rect);

  LRect := Rect;

  for i := 0 to TListView(Sender).Columns.Count - 1 do
  begin
    LColummnType := TColumnType(TListView(Sender).Columns[i].Tag);
    LRect.Right  := LRect.Left + Sender.Column[i].Width;

    LText := '';
    if i = 0 then
      LText := Item.Caption
    else
    if (i - 1) <= Item.SubItems.Count - 1 then
      LText := Item.SubItems[i - 1];

    Case LColummnType of
      ctText:  begin

                  LDetails := LStyleService.GetElementDetails(tgCellnormal);
                  LColor := LStyleService.GetSystemColor(clWindowText);
                  if ([odSelected,odHotLight] * State <> []) then
                  begin
                     LDetails := LStyleService.GetElementDetails(tgCellSelected);
                     LColor := LStyleService.GetSystemColor(clHighlightText);
                     LStyleService.DrawElement(Sender.Canvas.Handle,LDetails,LRect);
                  end;

                  LRect2 := LRect;
                  LRect2.Left := LRect2.Left + ListView_Padding + 16;

                  Ltextformat := TtextformatFlags(DT_SINGLELINE or DT_VCENTER or DT_LEFT or DT_END_ELLIPSIS);
                  LStyleService.DrawText(Sender.Canvas.Handle,LText,LRect2,Ltextformat,LColor);
               end;

      ctCheck: begin
                  if ([odSelected,odHotLight] * State <> []) then
                  begin
                     LDetails := LStyleService.GetElementDetails(tgCellSelected);
                     LStyleService.DrawElement(Sender.Canvas.Handle,LRect);
                  end;

                  LSize.cx := GetSystemMetrics(SM_CXMENUCHECK);
                  LSize.cy := GetSystemMetrics(SM_CYMENUCHECK);

                  LRect2.Top    := Rect.Top + (Rect.Bottom - Rect.Top - LSize.cy) div 2;
                  LRect2.Bottom := LRect2.Top + LSize.cy;
                  LRect2.Left   := LRect.Left + ((LRect.Width - LSize.cx) div 2);
                  LRect2.Right  := LRect2.Left + LSize.cx;

                  if (LText = '1') then
                  begin
                    if ([odSelected,odHotLight] * State <> []) then
                      LDetails := LStyleService.GetElementDetails(tbCheckBoxCheckedHot)
                    else
                      LDetails := LStyleService.GetElementDetails(tbCheckBoxCheckednormal);
                  end
                  else
                  begin
                    if ([odSelected,odHotLight] * State <> []) then
                      LDetails := LStyleService.GetElementDetails(tbCheckBoxUncheckedHot)
                    else
                      LDetails := LStyleService.GetElementDetails(tbCheckBoxUncheckednormal);
                  end;
                  LStyleService.DrawElement(Sender.Canvas.Handle,LRect2);
               end;


      ctProgress:
               begin
                  if ([odSelected,LRect);
                  end;

                  LRect2   := ResizeRect(LRect,2,2);
                  LDetails := LStyleService.GetElementDetails(tpBar);
                  LStyleService.DrawElement(Sender.Canvas.Handle,LRect2);

                  if not TryStrToInt(LText,p) then  p := 0;

                  InflateRect(LRect2,-1,-1);
                  LRect2.Right := LRect2.Left + Round(LRect2.Width * p / 100);

                  if p < 20 then
                  begin
                    Sender.Canvas.Brush.Style := bsSolid;
                    Sender.Canvas.Brush.Color := clWebFirebrick;
                    Sender.Canvas.FillRect(LRect2);
                  end
                  else
                  if p < 50 then
                  begin
                    Sender.Canvas.Brush.Style := bsSolid;
                    Sender.Canvas.Brush.Color := clWebGold;
                    Sender.Canvas.FillRect(LRect2);
                  end
                  else
                  begin
                    LDetails := LStyleService.GetElementDetails(tpChunk);
                    LStyleService.DrawElement(Sender.Canvas.Handle,LRect2);
                  end;
                end;
    end;

    if i = 0 then begin
      ListView_GetItemRect(Sender.Handle,Item.Index,R,LVIR_ICON);
      ImageList_Draw(
          PngImageList1.Handle,Sender.Canvas.Handle,R.Top,ILD_TRANSPARENT);
    end;

    Inc(LRect.Left,Sender.Column[i].Width);
  end;
end;

end.

DFM

object FrmMain: TFrmMain
  Left = 0
  Top = 0
  Caption = 'Test'
  ClientHeight = 449
  ClientWidth = 731
  Color = clBtnFace
  DoubleBuffered = True
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object LvSampleData: TListView
    Left = 0
    Top = 0
    Width = 731
    Height = 449
    Align = alClient
    Columns = <>
    SmallImages = PngImageList1
    TabOrder = 0
    OnData = LvSampleDataData
    OnDrawItem = LvSampleDataDrawItem
  end
  object PngImageList1: TPngImageList
    PngImages = <
      item
        Background = clWindow
        Name = 'arrow-circle-double'
        PngImage.Data = {
          89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
          610000001974455874536F6674776172650041646F626520496D616765526561
          647971C9653C000002724944415478DA7D925F4853511CC77FC76D2ED708525F
          8A302288B22C64230A56CD8885A3CCCCA21E7A18084E445BB45A3816A3A53559
          B81A3234C3A297516662A2Fdddd40C0277B5E8CF43105144F4A8A1C4DAEE6EDF
          33EF681BAB0B5FCE3DE7FE3E9FF3BBF71E4619570F721D792FCF5B19231B4605
          52B014038653C8B524D114422C9FC008B0350354FC856D6BDADB8F7C733AEFE3
          DECF25598211806532A0CC16ECE27099C753979C9BA382E262FAEA740E72494A
          D000B03107CC10ECE6F03AB7FBB00898156005F55CF2D9E97CC05E60A2CC03CA
          23874FAF77B96A13F3F3E0580A569494D027976B08CFBAFE27E0F0990D6D6D35
          BF6598EFAEC4CE1FDDEE613CBB8ABAC97F09F670B8DCE138184BB78D1402FEE0
          F13C441F3E0EF3FA7C020EDB2BECF603BF6498EFAE46DB6F3B3A46380CDD44BA
          3E5760C470B6D266332FF2B665B808F0ACD73B2A6C5675F6D66B26A637A98824
          8968319925E0F0397D4B4BF542FA8341B01C70D4E71BC3AC531F2A3D811A1D22
          40D09829A8C2A2634773F3FE9FBC6DF98369F1CEAFFCFEC7B31B55DE9BB54511
          74106D305B747DA3FD0289929E12524AC0E1F306ABD5148BC54814454A202B00
          4F05024FB0F315C38D95C77166F9CE74B4A65E776F7840489D3C89041661EC69
          E669DC69B1EC536B3434DEDDFD0CF0E5DBE665E17EB33A5A55B7574739576430
          2CB02EB4FB1A930AA45C9222D54D4DC6B160701C5FFA5288B1E7B74C85442675
          0F764B09B61CDBA67B77F7CD52070C1DC87F438B684244037CFD2551204014C6
          AD8824E58874513BB9FAE4DACAEF77BECCD08585ED7C9D0BF04F681552DA4714
          7C44D40BCBB40CC791843CC6E990CA8BCAADF4836668286EE5357F002DFCD337
          C469BD0A0000000049454E44AE426082}
      end>
    Left = 96
    Top = 88
    Bitmap = {}
  end
end

PNGImageList：https://github.com/TurboPack/PNGComponents

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）