Renk Paletlerinin yaratılması ve kullanımı
Delphi uygulamasında çizim yapılırken, gereken paletin yaratılması ve kullanılması nasıl olur?
Eğer palet değiştirme yolu ile animasyon yapılacaksa, en az 256 renk modunda çalışılmalı ve, aşağıdaki kod örneğinde geçen bütün PC_NOCOLLAPSE değerleri PC_RESERVED olarak değiştirilmelidir.
Palet yaratmanın yanı sıra, yapılması gereken diğer işlemler de şunlardır.
1. Formun GetPalette davranışı,yeni paleti döndürecek şekilde değiştirilmelidir.
2. Boyamaya başlamadan hemen önce, yeni palet seçilmelidir.
OldPal := SelectPalette(Canvas.Handle, NewPalette, False);
RealizePalette(Canvas.Handle);
SelectPalette(Canvas.Handle, OldPal, False);
3. İşlem tamamlandıktan sonra palet yok edilmelidir.
4. Renk değeri almak için, RGB fonksiyonu yerine PaletteRGB fonksiyonu kullanılmalıdır.
function CreateIdentityPalette(const aRGB; nColors : Integer) : HPALETTE;
type
QA = Array[0..255] of TRGBQUAD;
var
Palette : PLOGPALETTE;
PalSize : Word;
ScreenDC : HDC;
I : Integer;
nStaticColors : Integer;
nUsableColors : Integer;
begin
PalSize := SizeOf(TLOGPALETTE) + SizeOf(TPALETTEENTRY) * 256;
GetMem(Palette, PalSize);
try
with Palette^ do
begin
palVersion := $0300;
palNumEntries := 256;
ScreenDC := GetDC(0);
try
if (GetSystemPaletteUse(ScreenDC) = SYSPAL_NOSTATIC)
then
begin
{$R-}
for i := 0 to (nColors-1) do
with palPalEntry[i], QA(aRGB)[I] do
begin
peRed := rgbRed;
peGreen := rgbGreen;
peBlue := rgbBlue;
peFlags := PC_NOCOLLAPSE;
end;
for i := nColors to 255 do
palPalEntry[i].peFlags := PC_NOCOLLAPSE;
I := 255;
with palPalEntry[i] do
begin
peRed := 255;
peGreen := 255;
peBlue := 255;
peFlags := 0;
end;
with palPalEntry[0] do
begin
peRed := 0;
peGreen := 0;
peBlue := 0;
peFlags := 0;
end;
{$R+}
end
else
begin
nStaticColors := GetDeviceCaps(ScreenDC, NUMRESERVED);
GetSystemPaletteEntries(ScreenDC, 0, 256, palPalEntry);
{$R-}
nStaticColors := nStaticColors shr 1;
for i:= 0 to (nStaticColors-1) do
palPalEntry[i].peFlags := 0;
nUsableColors := nColors - nStaticColors;
for I := nStaticColors to (nUsableColors-1) do
with palPalEntry[i], QA(aRGB)[i] do
begin
peRed := rgbRed;
peGreen := rgbGreen;
peBlue := rgbBlue;
peFlags := PC_NOCOLLAPSE;
end;
for i := nUsableColors to (255-nStaticColors) do
palPalEntry[i].peFlags := PC_NOCOLLAPSE;
for i := (256 - nStaticColors) to 255 do
palPalEntry[i].peFlags := 0;
end;
finally
ReleaseDC(0, ScreenDC);
end;
end;
Result := CreatePalette(Palette^);
finally
FreeMem(Palette, PalSize);
end;
end;
procedure ClearSystemPalette;
var
Palette : PLOGPALETTE;
PalSize : Word;
ScreenDC : HDC;
I : Word;
const
ScreenPal : HPALETTE = 0;
begin
PalSize := SizeOf(TLOGPALETTE) + SizeOf(TPALETTEENTRY) * 255;
GetMem(Palette, PalSize);
try
FillChar(Palette^, PalSize, 0);
Palette^.palVersion := $0300;
Palette^.palNumEntries := 256;
{$R-}
For I := 0 to 255 do
With Palette^.palPalEntry[I] do
peFlags := PC_NOCOLLAPSE;
{$R+}
ScreenDC := GetDC(0);
try
ScreenPal := CreatePalette(Palette^);
if ScreenPal <> 0
then
begin
ScreenPal := SelectPalette(ScreenDC,ScreenPal,FALSE);
RealizePalette(ScreenDC);
ScreenPal := SelectPalette(ScreenDC,ScreenPal,FALSE);
DeleteObject(ScreenPal);
end;
finally
ReleaseDC(0, ScreenDC);
end;
finally
FreeMem(Palette, PalSize);
end;
end;
//Alıntıdır...