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

分类：编程问答

如何解决ListView + OwnerData / OwnerDraw / VCL样式严重闪烁

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

enter image description here

基于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 举报，一经查实，本站将立刻删除。

相关推荐

导入项目后报错问题
依赖报错 idea导入项目后依赖报错，解决方案：https://blog.csdn.net/weixin_42420249/article/details/81191861 依赖版本报错：更换其他版本 无法下载依赖可参考：https://blog.csdn.net/weixin_42628809/a
idea不能识别yaml文件
使用mybatis plus常见错误
错误1：代码生成器依赖和mybatis依赖冲突 启动项目时报错如下 2021-12-03 13:33:33.927 ERROR 7228 [ main] o.s.b.d.LoggingFailureAnalysisReporter : *************************** APPL
gradle常见问题与错误
错误1：gradle项目控制台输出为乱码 # 解决方案：https://blog.csdn.net/weixin_43501566/article/details/112482302 # 在gradle-wrapper.properties 添加以下内容 org.gradle.jvmargs=-Df
Mybatis Plus传入参数0不起作用
错误还原：在查询的过程中，传入的workType为0时，该条件不起作用 &lt;select id=&quot;xxx&quot;&gt; SELECT di.id, di.name, di.work_type, di.updated... &lt;where&gt; &lt;if test=&qu
linux中make编译源码包失败
报错如下，gcc版本太低 ^ server.c:5346:31: 错误：‘struct redisServer’没有名为‘server_cpulist’的成员 redisSetCpuAffinity(server.server_cpulist); ^ server.c: 在函数‘hasActiveC
微服务启动错误：Command line is too long. Shorten command line for
解决方案1 1、改项目中.idea/workspace.xml配置文件，增加dynamic.classpath参数 2、搜索PropertiesComponent，添加如下 &lt;property name=&quot;dynamic.classpath&quot; value=&quot;tru
vue常见错误
删除根组件app.vue中的默认代码后报错：Module Error (from ./node_modules/eslint-loader/index.js): 解决方案：关闭ESlint代码检测，在项目根目录创建vue.config.js，在文件中添加 module.exports = { lin
spark常见错误
查看spark默认的python版本 [root@master day27]# pyspark /home/software/spark-2.3.4-bin-hadoop2.7/conf/spark-env.sh: line 2: /usr/local/hadoop/bin/hadoop: No s
matplotlib报错：AttributeError: module 'backend_interagg' has no attribute 'FigureCanvas'. Did you mean: 'FigureCanvasAgg'?
使用本地python环境可以成功执行 import pandas as pd import matplotlib.pyplot as plt # 设置字体 plt.rcParams[&#39;font.sans-serif&#39;] = [&#39;SimHei&#39;] # 能正确显示负号 p
gitlab登录失败，报错：This challenge page was accidentally cached by an intermediary and is no longer available.
设置时间 控制面板
后端开发常见错误
错误1：Request method ‘DELETE‘ not supported 错误还原：controller层有一个接口，访问该接口时报错：Request method ‘DELETE‘ not supported 错误原因：没有接收到前端传入的参数，修改为如下 参考 错误2：cannot r
docker常见错误
错误1：启动docker镜像时报错：Error response from daemon: driver failed programming external connectivity on endpoint quirky_allen 解决方法：重启docker -&gt; systemctl r
idea常见错误
错误1：private field ‘xxx‘ is never assigned 按Altʾnter快捷键，选择第2项 参考：https://blog.csdn.net/shi_hong_fei_hei/article/details/88814070 错误2：启动时报错，不能找到主启动类 #
pip安装依赖失败
报错如下，通过源不能下载，最后警告pip需升级版本 Requirement already satisfied: pip in c:\users\ychen\appdata\local\programs\python\python310\lib\site-packages (22.0.4) Coll
maven常见错误
错误1：maven打包报错 错误还原：使用maven打包项目时报错如下 [ERROR] Failed to execute goal org.apache.maven.plugins:maven-resources-plugin:3.2.0:resources (default-resources)
cloud项目中常见错误
错误1：服务调用时报错 服务消费者模块assess通过openFeign调用服务提供者模块hires 如下为服务提供者模块hires的控制层接口 @RestController @RequestMapping(&quot;/hires&quot;) public class FeignControl
springboot常见错误
错误1：运行项目后报如下错误 解决方案 报错2：Failed to execute goal org.apache.maven.plugins:maven-compiler-plugin:3.8.1:compile (default-compile) on project sb 解决方案：在pom.
springmvc拦截器中使用redisTemplate报空指针异常
参考 错误原因 过滤器或拦截器在生效时，redisTemplate还没有注入 解决方案：在注入容器时就生效 @Component //项目运行时就注入Spring容器 public class RedisBean { @Resource private RedisTemplate&lt;String
vite报错：npm ERR! command C:WINDOWSsystem32cmd.exe /d /s /c C:UsersychenAppDataLocalTempnpx-dde1c848.cmd
使用vite构建项目报错 C:\Users\ychen\work&gt;npm init @vitejs/app @vitejs/create-app is deprecated, use npm init vite instead C:\Users\ychen\AppData\Local\npm-
pythonJavaScriptjavaHTMLPHPreactjsC#AndroidCSSNode.jssqlrpython-3.xMysqLjQueryc++pandasFlutterangularIOSdjangolinuxswifttypescript路由器JSON路由器设置无线路由器h3c华三华三路由器设置华三路由器电脑软件教程arraysdocker软件图文教程Cvue.jslaravelspring-boot