当前位置：文江博客话题详情

是否可以在运行时更改模式和非模式表单标题栏中的表单图标？

发布于 2025-01-03 10:40:35 字数 245 浏览 3 评论 0原文

使用Delphi 2010。

我正在寻找（可能）一个可以传递TForm & 的函数或过程。一张图像（TImage 或 TBitmap），它可以更改表单图标，覆盖当前图标，或在特定位置写入新图标，并在必要时调整标题。必须同时使用模态和非模态形式。

示例：

procedure ChangeFormIcon(AForm: TForm; AIcon: TBitmap;

欢迎所有其他建议

感谢

原文

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

终止放荡 2025-01-10 10:40:35

像这样的事情应该做你想做的事。我假设您正在使用 32bpp 位图，并可能进行 alpha 混合。如果您想使用基于遮罩的透明度，那么您需要重新编写代码以创建适当的遮罩位图。

procedure CopyBitmapToIcon(Bitmap: TBitmap; Icon: TIcon);
var
  MonoBitmap: HBITMAP;
  IconInfo: TIconInfo;
  IconHandle: HICON;
begin
  MonoBitmap := CreateBitmap(Bitmap.Width, Bitmap.Height, 1, 1, 0);
  Try
    FillChar(IconInfo, SizeOf(IconInfo), 0);
    IconInfo.fIcon := True;
    IconInfo.hbmMask := MonoBitmap;
    IconInfo.hbmColor := Bitmap.Handle;
    IconHandle := CreateIconIndirect(IconInfo);
    if IconHandle=0 then begin
      RaiseLastOSError;
    end;
    Icon.Handle := IconHandle;
  Finally
    DeleteObject(MonoBitmap);
  End;
end;

procedure TMyForm.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
  Icon: TIcon;
begin
  Icon := Self.Icon;
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit;
    Bitmap.SetSize(Icon.Width, Icon.Height);
    Bitmap.Canvas.Brush.Style := bsSolid;
    Bitmap.Canvas.Brush.Color := clRed;
    Bitmap.Canvas.FillRect(Rect(0, 0, Icon.Width, Icon.Height));
    CopyBitmapToIcon(Bitmap, Icon);
  finally
    Bitmap.Free;
  end;
end;

Something like this should do what you want. I've assumed that you are using 32bpp bitmaps with, potentially, alpha blending. If you want to use mask based transparency then you would need to re-work the code to create an appropriate mask bitmap.

procedure CopyBitmapToIcon(Bitmap: TBitmap; Icon: TIcon);
var
  MonoBitmap: HBITMAP;
  IconInfo: TIconInfo;
  IconHandle: HICON;
begin
  MonoBitmap := CreateBitmap(Bitmap.Width, Bitmap.Height, 1, 1, 0);
  Try
    FillChar(IconInfo, SizeOf(IconInfo), 0);
    IconInfo.fIcon := True;
    IconInfo.hbmMask := MonoBitmap;
    IconInfo.hbmColor := Bitmap.Handle;
    IconHandle := CreateIconIndirect(IconInfo);
    if IconHandle=0 then begin
      RaiseLastOSError;
    end;
    Icon.Handle := IconHandle;
  Finally
    DeleteObject(MonoBitmap);
  End;
end;

procedure TMyForm.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
  Icon: TIcon;
begin
  Icon := Self.Icon;
  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit;
    Bitmap.SetSize(Icon.Width, Icon.Height);
    Bitmap.Canvas.Brush.Style := bsSolid;
    Bitmap.Canvas.Brush.Color := clRed;
    Bitmap.Canvas.FillRect(Rect(0, 0, Icon.Width, Icon.Height));
    CopyBitmapToIcon(Bitmap, Icon);
  finally
    Bitmap.Free;
  end;
end;

回复收藏 0 原文

~没有更多了~