传道兼灌水^_^
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.