Author: Tomas Rutkauskas
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.
1 unit Paltst;
2
3 interface
4
5 uses
6 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
7 Forms, Dialogs, ExtCtrls, Menus, Buttons;
8
9 type
10 TForm1 = class(TForm)
11 Image1: TImage;
12 procedure FormCreate(Sender: TObject);
13 procedure FormClose(Sender: TObject; var Action: TCloseAction);
14 private
15 { Private declarations }
16 procedure QNewPalette(var Msg: TWMQueryNewPalette); message WM_QueryNewPalette;
17 procedure PalChanged(var Msg: TWMPaletteChanged); message WM_PaletteChanged;
18 public
19 { Public declarations }
20 end;
21
22 var
23 Form1: TForm1;
24 Bmap: TBitmap;
25
26 implementation
27
28 {$R *.DFM}
29
30 procedure TForm1.FormCreate(Sender: TObject);
31 var
32 i: Word;
33 begin
34 Bmap := TBitmap.Create;
35 Bmap.LoadFromFile('Test.bmp');
36 Image1.Canvas.StretchDraw(Image1.BoundsRect, Bmap);
37 end;
38
39 procedure TForm1.QNewPalette(var Msg: TWMQueryNewPalette);
40 var
41 i: Word;
42 DC: HDC;
43 HPold: HPalette;
44 begin
45 DC := Form1.Canvas.Handle;
46 HPold := SelectPalette(DC, Bmap.Palette, False);
47 i := RealizePalette(DC);
48 SelectPalette(DC, HPold, False);
49 if (i > 0) then
50 InvalidateRect(Handle, nil, False);
51 Msg.Result := i;
52 end;
53
54 procedure TForm1.PalChanged(var Msg: TWMPaletteChanged);
55 var
56 i: Word;
57 DC: HDC;
58 HPold: HPalette;
59 begin
60 if (Msg.PalChg = Handle) then
61 Msg.Result := 0
62 else
63 begin
64 DC := Form1.Canvas.Handle;
65 HPold := SelectPalette(DC, Bmap.Palette, True);
66 i := RealizePalette(DC);
67 UpdateColors(DC);
68 SelectPalette(DC, HPold, False);
69 end;
70 end;
71
72 procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
73 begin
74 Bmap.Free;
75 end;
76
77 end.
|
