How to respond to QueryNewPalette and PaletteChanged messages

Problem/Question/Abstract:

How to respond to QueryNewPalette and PaletteChanged messages

Answer:

Here is a simple test program I wrote for displaying a 256 color bitmap. It works properly on my system ... so far. The code was derived from a sample which is included in the WM_QUERYNEWPALETTE help description in the Microsoft Visual C++ compiler (The Win API). These examples were not included in the Delphi version of the Win API help file for some reason. Too bad because they are extremely useful.

This code passes all the tests on my system. The app starts with the bitmap displayed correctly. With another app in the foreground or with an icon (for example the MSDOS icon) dragged on top, it displays a proper "background palette". Minimizing and moving the window shows a proper palette.

In the form's Oncreate method, I LoadFromFile to a temp bitmap then StretchDraw that to the Image1 canvas. I found I needed handlers for WM_QueryNewPalette to realize the bitmap's palette - and WM_PaletteChanged to call the WinAPI UpdateColors function to map the palette to the system palette. UpdateColors avoids the horrible background palette map.

unit Paltst;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, Menus, Buttons;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure QNewPalette(var Msg: TWMQueryNewPalette); message WM_QueryNewPalette;
    procedure PalChanged(var Msg: TWMPaletteChanged); message WM_PaletteChanged;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Bmap: TBitmap;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Word;
begin
  Bmap := TBitmap.Create;
  Bmap.LoadFromFile('Test.bmp');
  Image1.Canvas.StretchDraw(Image1.BoundsRect, Bmap);
end;

procedure TForm1.QNewPalette(var Msg: TWMQueryNewPalette);
var
  i: Word;
  DC: HDC;
  HPold: HPalette;
begin
  DC := Form1.Canvas.Handle;
  HPold := SelectPalette(DC, Bmap.Palette, False);
  i := RealizePalette(DC);
  SelectPalette(DC, HPold, False);
  if (i > 0) then
    InvalidateRect(Handle, nil, False);
  Msg.Result := i;
end;

procedure TForm1.PalChanged(var Msg: TWMPaletteChanged);
var
  i: Word;
  DC: HDC;
  HPold: HPalette;
begin
  if (Msg.PalChg = Handle) then
    Msg.Result := 0
  else
  begin
    DC := Form1.Canvas.Handle;
    HPold := SelectPalette(DC, Bmap.Palette, True);
    i := RealizePalette(DC);
    UpdateColors(DC);
    SelectPalette(DC, HPold, False);
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Bmap.Free;
end;

end.