var
Form1: TForm1;
blueVal: Byte;
BluePalette: HPalette;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
LogicalPalette: PLogPalette;
ColorIndex: LongInt;
begin
GetMem(LogicalPalette, (SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * 256));
GetSystemPaletteEntries(Canvas.Handle, 0, 256,
LogicalPalette^.palPalEntry[0]);
with LogicalPalette^ do
begin
palVersion := $300;
palNumEntries := 256;
{$R-}
for ColorIndex := 10 to 245 do
with palPalEntry[ColorIndex] do
begin
peRed := 0;
peGreen := 0;
peBlue := 255 - (ColorIndex - 10);
peFlags := PC_NOCOLLAPSE;
end;
end;
{$R+}
BluePalette := CreatePalette(LogicalPalette^);
FreeMem(LogicalPalette, (SizeOf(TLogPalette) + SizeOf(TPaletteEntry) * 256));
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteObject(BluePalette);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
OldPal: HPALETTE;
begin
OldPal := SelectPalette(Canvas.Handle, BluePalette, False);
RealizePalette(Canvas.Handle);
canvas.pen.color := $02000000 or (BlueVal * $00010000);
canvas.pen.width := 10;
canvas.moveto(0, 0);
canvas.lineto(X, Y);
SelectPalette(Canvas.Handle, OldPal, False);
Inc(BlueVal);
if BlueVal > 255 then
BlueVal := 0;
end;
|