Delphi 1

Код создания палитры

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;

{$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;

[000654]