带有 alpha 混合图标的图像列表失去透明度

2024-01-05

这是(或多或少)一个相关的问题:Delphi - 在运行时用图标填充图像列表会“破坏”透明度 https://stackoverflow.com/questions/3056889/delphi-populate-an-imagelist-with-icons-at-runtime-destroys-transparency.

我已经测试过@TOndrejanswer https://stackoverflow.com/a/3061520/937125。但似乎我需要启用视觉样式(XP Manifest)才能使其工作(将使用 Windows 通用控件 6.0 版本 - 我现在不想要)。我在运行时添加图标ExtractIconEx and ImageList_AddIcon.

显然设置ImageList.Handle使用系统图像列表句柄,does not需要 XP 清单。因此,当我使用系统图像列表显示文件列表(使用TListView).

我在徘徊系统图像列表有什么特别之处以及它是如何创建的,以便它在所有情况下都支持 alpha 混合?我无法弄清楚这一点。这是一些示例代码:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ImgList, StdCtrls, ShellAPI, ExtCtrls, Commctrl;

type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    PopupMenu1: TPopupMenu;
    MenuItem1: TMenuItem;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    FileName: string;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
// {$R WindowsXP.res}

procedure TForm1.FormCreate(Sender: TObject);
begin
  PopupMenu1.Images := ImageList1;
  FileName := 'C:\Program Files\Mozilla Firefox\firefox.exe';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  IconPath: string;
  IconIndex: Integer;
  hIconLarge, hIconSmall: HICON;
begin
  IconPath := FileName;
  IconIndex := 0; // index can be other than 0

  ExtractIconEx(PChar(IconPath), IconIndex, hIconLarge, hIconSmall, 1);

  Self.Refresh; // erase form
  DrawIconEx(Canvas.Handle, 10, 10, hIconSmall, 0, 16, 16, 0,
    DI_IMAGE or DI_MASK); // this will draw ok on the form

  // ImageList1.DrawingStyle := dsTransparent;
  ImageList1.Handle := ImageList_Create(ImageList1.Width, ImageList1.Height,
    {ILC_COLORDDB} ILC_COLOR32 or ILC_MASK, 0, ImageList1.AllocBy);
  ImageList_AddIcon(ImageList1.Handle, hIconSmall);

  MenuItem1.ImageIndex := 0;

  DestroyIcon(hIconSmall);
  DestroyIcon(hIconLarge);

  PopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;

procedure TForm1.Button2Click(Sender: TObject);
// using sys image-list will work with or without Manifest
type
  DWORD_PTR = DWORD;
var
  ShFileINfo :TShFileInfo;
  SysImageList: DWORD_PTR;
  FileName: string;
begin
  SysImageList := ShGetFileInfo(nil, 0, ShFileInfo, SizeOf(ShFileInfo),
    SHGFI_SYSICONINDEX OR SHGFI_SMALLICON);

  if SysImageList = 0 then Exit;
  ImageList1.Handle := SysImageList;
  ImageList1.ShareImages := True;

  if ShGetFileInfo(PChar(FileName), 0, ShFileInfo, SizeOf(ShFileInfo),
    SHGFI_SYSICONINDEX OR SHGFI_ICON OR SHGFI_SMALLICON) <> 0 then
  begin
    MenuItem1.ImageIndex := ShFileInfo.IIcon;
    Self.Refresh; // erase form
    DrawIconEx(Canvas.Handle, 10, 10, ShFileInfo.hIcon, 0, 16, 16, 0,
      DI_IMAGE or DI_MASK);
    DestroyIcon(ShFileInfo.hIcon); // todo: do I need to destroy here? 

    PopupMenu1.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
  end;      
end;

end.

视觉风格Disabled:

视觉风格Enabled:


解决方法是使用插入器类或子类TImageList并覆盖DoDraw 如图所示 https://stackoverflow.com/q/9877718/937125,但我真正想知道的是如何创建与系统图像列表相同的图像列表。

注:我知道TPngImageList并且不想在这种情况下使用它。


Edit:@David 的回答(和评论)是准确的:

您必须显式链接到 ImageList_Create (v6),因为 否则它会在模块加载时隐式链接并且将被 绑定到 v5.8

示例代码(不使用激活上下文 API):

function ImageList_Create_V6(CX, CY: Integer; Flags: UINT; Initial, Grow: Integer): HIMAGELIST;
var
  h: HMODULE;
  _ImageList_Create: function(CX, CY: Integer; Flags: UINT;
    Initial, Grow: Integer): HIMAGELIST; stdcall;
begin
  // TODO: find comctl32.dll v6 path programmatically
  h := LoadLibrary('C:\WINDOWS\WinSxS\x86_Microsoft.Windows.Common-Controls_6595b64144ccf1df_6.0.2600.5512_x-ww_35d4ce83\comctl32.dll');
  if h <> 0 then
  try
    _ImageList_Create := GetProcAddress(h, 'ImageList_Create');
    if Assigned(_ImageList_Create) then
      Result := _ImageList_Create(CX, CY, Flags, Initial, Grow);
  finally
    FreeLibrary(h);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ...
  ImageList1.Handle := ImageList_Create_V6(ImageList1.Width, ImageList1.Height,
    ILC_COLOR32 or ILC_MASK, 0, ImageList1.AllocBy);
  ...
end;

Edi2: @David 的示例代码 http://pastebin.com/dvMiGJ78这显示了如何通过 Activation Context API 正确完成此操作。


图像列表控件有两个版本。 v5.8版本和v6版本。系统镜像列表是系统拥有的共享组件,使用v6版本。它没有任何其他特殊之处,它只是一个普通的 v6 图像列表。在您的应用程序中,您的图像列表是 v5.8 或 v6,具体取决于您是否包含清单。但系统拥有的镜像列表始终是v6。

我不知道为什么你不想在你的应用程序中使用 v6 通用控件。但有了这个限制,您可以在创建图像列表时使用激活上下文 API 在本地使用 v6 通用控件。这将解决您的问题,并让应用程序的其余部分保留 v5.8 通用控件。

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

带有 alpha 混合图标的图像列表失去透明度 的相关文章

  • 如何在 TList 中存储动态数组?

    我需要存储未知数量的组 每个组都有未知数量的元素 项目 这是我的 小组 TGroup array of Integer lt dynamic array as you can see 我想使用 TList 来保存我的组 我的想法是 我可能想
  • FreeMM 与 ShareMem

    我们有很多用 delphi 和 c builder 编写的 dll 库 并使用 sharemem 和 borlndmm dll 3d party 库中的对齐问题迫使我们转向 delphi 2007 中的新内存管理器 有人可以帮我解释一下 共
  • Winform 没有.NET 框架?

    我必须创建一些表单并将其作为直接 EXE 提供 而不是安装程序 它安装 NET 框架 最终用户对此不满意 他们想要可以直接打开和工作的东西 我知道它可以作为网络完成 但我正在寻找 winforms 吗 请建议哪种工具 技术可以处理这个问题
  • 如何使用用户输入来寻址 Pascal 中的特定变量(Eval/Exec?)

    我正在尝试在分形程序中做一些非常具体的事情隆起7X http apophysis 7x org 使用的脚本语言是Pascal 该项目是用德尔福写的 https svn code sf net p apophysis7x svn trunk
  • Delphi - 相当于C#的三元运算符? [复制]

    这个问题在这里已经有答案了 可能的重复 Delphi 中是否存在或者将来是否存在条件运算符 https stackoverflow com questions 2108609 is there or is there ever going
  • Delphi如何使用其他窗体中的类型?

    抱歉 这是一个非常新手的问题 我正在对这个庞大的应用程序进行维护 它有5种不同的形式 我们将全局变量放在一个单元 uGlobal 中 但我似乎无法从数据单元 uData 访问它 我有这个 Unit uGlobal type TmyType
  • Delphi 2007 中的 HelpInsight 文档

    我正在使用 D2007 并尝试使用 HelpInsight 功能 自 D2005 起提供 来记录我的源代码 我主要对让 HelpInsight 工具提示正常工作感兴趣 通过各种网上冲浪和实验 我发现了以下内容 使用三斜杠 注释样式比其他记录
  • 我需要避免尝试更新连接到 TSQLQuery 的 Delphi TClientDataset 中的非物理字段

    概要 我的代码正在尝试更新 Delphi XE 中的非物理字段TClientDataset 连接到TSQLQuery以其SQL属性集 作为运行时的结果创建Open命令 我有一个TClientDataset连接到一个TDatasetProvi
  • 使用 TStringList 的分隔符解析字符串,似乎也解析空格(Delphi)

    我有一个简单的字符串 由某个字符分隔 比如说逗号 我应该能够创建一个 TStringList 并将其分隔符设置为逗号 然后将 DelimitedText 设置为我想要解析的文本 并且应该自动解析它 问题是 当我查看输出时 它还包含空格作为分
  • 如何将数据库查询的行转换为 XML 文件?

    我正在开发一个 Delphi 应用程序 该应用程序需要从一段工作中获取行并将其转换为单个 XML 文件 以便上传到第三方 Web 服务 有没有可用的组件或库可以做到这一点 如果不是 那么构建 DB2XML 转换器的最佳代码方法是什么 我注意
  • 如何使用 Gmail 的 SMTP 和 Indy 10 发送电子邮件?

    我正在使用 Delphi 2009 和 svn 中最新的 Indy 10 通过 SMTP 发送电子邮件 但它不适用于 Gmail Google Apps 托管域 当我尝试发送电子邮件时 我收到 必须首先发出 STARTTLS 命令 我尝试用
  • 打印 TDBGrid [重复]

    这个问题在这里已经有答案了 如何在不安装或下载组件的情况下打印 DBGrid OR 如何将 DBGrid 的数据放入 RichEdit 以便我可以从那里打印它 数据感知控件从 DataSource 属性获取数据 并使用它 不过 您必须手动遍
  • 在 Delphi 或 C++ Builder 中使用 Chromium Edge WebView2 [重复]

    这个问题在这里已经有答案了 既然 Microsoft Chromium Edge 已经最终确定 是否可以在 Delphi 或 C Builder 中使用它 据我了解 它是基于WebView2成分 是否有一个组件 例如TWebView2或者E
  • logback的“谨慎模式”是如何实现的?

    The 审慎模式 http logback qos ch manual appenders html prudentlogback 中的序列化所有 JVM 之间的 IO 操作 写入同一文件 可能运行在不同的主机上 在其他日志记录框架中 如果
  • 如何从该 JAVA 文件中提取 Delphi 类以与 Android 一起使用?

    我的Delphi XE7项目需要与FTDI FT311 Android 配件芯片 http www ftdichip com Products ICs FT311D html 他们帮助提供了一个 Android 演示 其中包括他们的 JAV
  • CharInSet 不适用于非英文字母?

    我已经将应用程序从 Delphi 2007 更新到 Delphi 2010 一切都很顺利 除了一条编译正常但不起作用的语句 If Edit1 Text 1 in S then ShowMessage Found else ShowMessa
  • 如何在表单上绘制半透明图像?

    我想在 Delphi 窗体上绘制半透明图像 但由于某种原因它不起作用 Here is the original PNG border is semi transparent 我将图像加载到TImage object Image1 Trans
  • 在 Delphi 中淡入 alpha 混合 PNG 表单

    几年前 当 Vista 首次发布时 我曾提出过这个问题 但始终没有解决这个问题 并把它搁置起来 留待以后再考虑 我有一个启动屏幕 我花了很大力气让它看起来很棒 这是 32bpp alpha 混合的 PNG 我有一些代码 如果需要 我可以挖掘
  • 如何在拥有句柄时检查给定进程是否正在运行

    我在用ShellExecuteEx启动应用程序 成功开始阅读后TShellExecuteInfo hProcess获取已启动进程的句柄 我想定期检查我的应用程序启动的进程是否仍在运行 两个或多个同名进程可以同时运行 我想确保我的应用程序正在
  • 如果加载 dll 找不到依赖项,有什么方法可以捕获错误吗?

    我正在编写一个 Windows 32 位程序 可以使用多个可能的 dll 之一 所以它尝试依次加载每个 dll 使用SysUtils SafeLoadLibrary如果加载成功 它就会使用该 dll 不幸的是 其中一些 dll 静态链接到其

随机推荐