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

Советы » Цвета и Палитра » Код создания палитры

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

;

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com