Why doesn't this work in 256-color video mode? It is supposed to fill
the client area of the form with the non-standard $00FFDDDD. It does
this, but the fill is dithered instead of solid.
unit WBMain;
interface
uses Forms, etc;
type
TWBMainForm = class(TForm)
.
.
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
.
.
private
FOldPal : HPalette;
FOurPal : HPalette;
public
end;
var
WBMainForm: TWBMainForm;
implementation
{$R *.DFM}
//
procedure TWBMainForm.FormCreate(Sender: TObject);
const
NewColor = $00FFDDDD;
var
logPal : PLogPalette;
entry, palSize : integer;
begin
if GetDeviceCaps(Canvas.Handle, RASTERCAPS) AND RC_PALETTE <> 0 then
begin {256-color palette}
palSize := SizeOf(TLogPalette) + 256*SizeOf(TPalet{*word*249}try);
GetMem(logPal, palSize);
TRY
FillChar(logPal^, palSize, 0);
logPal^.palVersion := $300;
logPal^.palNumEntries := 256;
GetSystemPalet{*word*249}tries(Canvas.Handle, 0, 256,
logPal^.palPalEntry);
entry := 10;
{$R-}
with logPal^.palPalEntry[entry] do
begin
peRed := GetRValue(NewColor);
peGreen := GetGValue(NewColor);
peBlue := GetBValue(NewColor);
peFlags := PC_NOCOLLAPSE;
end;
{$R+}
FOurPal := CreatePalette(logPal^);
FINALLY
FreeMem(logPal, palSize);
END {TRY..FINALLY};
FOldPal := SelectPalette(Canvas.Handle, FOurPal, False);
RealizePalette(Canvas.Handle);
end {256-color palette};
Color := NewColor;
end {FormCreate};
//
procedure TWBMainForm.FormDestroy(Sender: TObject);
begin
SelectPalette(Canvas.Handle, FOldPal, False);
DeleteObject(FOurPal);
end {FormDestroy};
//
end.