Можно ли изменить значок формы в строке заголовка модальной и немодальной форм во время выполнения? - PullRequest
Новая
       10

Можно ли изменить значок формы в строке заголовка модальной и немодальной форм во время выполнения?

0 голосов
/ 08 февраля 2012

Использование Delphi 2010.

Я ищу (возможно) функцию или процедуру, которой можно передать TForm и изображение (TImage или TBitmap), и он может изменить значок формы, либо перезаписав текущийодин, или написание нового в определенном месте, корректируя заголовок при необходимости.Должен работать как с модальными, так и с немодальными формами.

Пример:

процедура ChangeFormIcon (AForm: TForm; AIcon: TBitmap;

Все другие предложения приветствуются

Спасибо

1 Ответ

4 голосов
/ 08 февраля 2012

Что-то вроде этого должно делать то, что вы хотите.Я предположил, что вы используете растровые изображения 32bpp, возможно, с альфа-смешиванием.Если вы хотите использовать прозрачность, основанную на маске, вам потребуется заново обработать код, чтобы создать соответствующую битовую карту маски. 

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;
...