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

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
beginpalVersion := $300;palNumEntries := 256;{$R-}for ColorIndex := 10 to 245 dowith palPalEntry[ColorIndex] dobeginpeRed := 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 > 255ThenBlueVal := 0;end;

[000654]

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