Код создания палитры
|
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]
