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

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;

[000654]

Содержание раздела