Dynamische Form-Icons und VCL-Styles

[Ghostwalker]

MoinMoin,

das wird jetzt mehr eine Problembeschreibung sammt Workaround :)

Problem:

Ich wollte dynmisch (zur Laufzeit) einem Formular ein eigenes Icon zuweisen.

Delphi-Quellcode:

procdure TForm1.FormCreate(sender:TObject);
begin
  form1.LoadFromResource(.....
end;

Funktionierte soweit auch, bis ich die VCL-Styles aktiviert hab. Schwub, das Icon wurde
durch das Programm-Icon ersetzt. :(

Nachdem ich da etwas nachgeforscht hatte, fand ich heraus, das das Problem in der VCL.Forms liegt.
Der dortige TFormStyleHook ignoriert schlicht das eigene Icon.

Workaround:

Eigentlich ganz einfach. Im Formular die WM_GETICON-Message abfangen, und das richtige Icon zurückliefern:

Delphi-Quellcode:

Interface

Type
  TForm1 = Class(TForm)
   :
    Procedure WMGetIcon(var msg : TMessage); message WM_GETICON;
   :

Implementation

:
procedure TForm1.WMGetIcon(var msg: TMessage);
begin
  msg.Result := Icon.Handle;
end;

Um das ganze perfekt zu hand haben, sollte man noch die Parameter auswerten.
(siehe https://docs.microsoft.com/de-de/win...msg/wm-geticon


Sollte also noch jemand das Problem haben, hier gibts zumindest einen Workaround :)

[KodeZwerg]

Danke für diesen Tipp!!
Ich probiere es heut abend gleich aus da ich das gleiche Problem habe.
Mein workaround ist nervig da die Form dadurch flackert.
(Formstyle = -border, Icon setzen, Formstyle = +border)

[KodeZwerg]

Ich bekomme es nicht zum laufen mit der oben genannten Methodik.
Gibt es vielleicht noch eine möglichkeit, abgesehen von -border +border style bzw recreatewnd oder wende ich es falsch an?

Im Anhang ist ein Test Projekt, binär sowie quell projekt.

Projekt Datei mit Style Aufruf:

Delphi-Quellcode:

program Project1;

{$IFNDEF MSWindows}
{$MESSAGE ERROR 'This application is made for Windows only!'}
{$ENDIF MSWindows}

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Vcl.Themes,
  Vcl.Styles;

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  TStyleManager.TrySetStyle('Jet');
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Hier das Formular:

Delphi-Quellcode:

unit Unit1;

{$IFNDEF MSWindows}
{$MESSAGE ERROR 'This unit is made for Windows only!'}
{$ENDIF MSWindows}

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    CheckBox1: TCheckBox;
    procedure Button1Click(Sender: TObject);
  private
    // Procedure WMGetIcon(var msg : TMessage); message WM_GETICON; // Original
    procedure WMGetIcon(var Msg: TWMGetIcon); message WM_GETICON; // Windows.pas
    procedure WMSetIcon(var Msg: TWMSetIcon); message WM_SETICON; // testweise mit Set anstelle Get
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  // Application.Icon := Image1.Picture.Icon; // bewirkt: nichts.  ->  ohne Style = Application.Icon und Form.Icon sind gesetzt
  // Application.MainForm.Icon := Image1.Picture.Icon; // bewirkt: Application.Icon ist gesetzt. (TaskBar Icon)  ->  ohne Style = Application.Icon und Form.Icon sind gesetzt
  // Self.Icon := Image1.Picture.Icon; // bewirkt: Application.Icon ist gesetzt. (TaskBar Icon)  ->  ohne Style = Application.Icon und Form.Icon sind gesetzt
  Icon := Image1.Picture.Icon; // bewirkt: Application.Icon ist gesetzt. (TaskBar Icon)  ->  ohne Style = Application.Icon und Form.Icon sind gesetzt
  if Checkbox1.Checked then
    RecreateWnd;
end;

(*
  // original
  procedure TForm1.WMGetIcon(var msg: TMessage);
  begin
  msg.Result := Icon.Handle;
  end;
*)

procedure TForm1.WMGetIcon(var Msg: TWMGetIcon);
begin
  // inherited;
  // Msg.Result := Icon.Handle; // bewirkt: nichts.
  // ShowMessage('WM_GETICON' + #13#10 + 'Msg: ' + IntToStr(Msg.Msg) + #13#10 + 'Result: ' + IntToStr(Msg.Result));
  DefaultHandler(Msg); // einfach nur durchschleifen...
end;

procedure TForm1.WMSetIcon(var Msg: TWMSetIcon);
begin
  // inherited;
  // Msg.Result := Msg.Icon;
  // ShowMessage('WM_SETICON' + #13#10 + 'Msg: ' + IntToStr(Msg.Msg) + #13#10 + 'HICON: ' + IntToStr(Msg.Icon) + #13#10 + 'Result: ' + IntToStr(Msg.Result));
  DefaultHandler(Msg); // einfach nur durchschleifen...
end;

end.

Frage:
Was gibt es noch für möglichkeiten bzw wie sollte man es richtig machen?
Egal wie ich es auch anstelle, nur das Taskbar Icon bzw Alt-Tab Icon wird korrekt gesetzt aber das Formular an sich bleibt sturr fixiert, abgesehen von meinem dirty unschönen workaround.

[KodeZwerg]

*stubs an*