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

Delphi , Графика и Игры , Цвета и Палитра

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;

Here is the translation of the content into Russian:

Процедура FormCreate

• Создает структуру TLogPalette (логическая палетка) в памяти с помощью GetMem.
• Использует GetSystemPaletteEntries для получения системных палеток.
• Перебирает палетки (от индекса 10 до 245) и устанавливает значения цветов для каждого элемента:
  • Красные и зеленые компоненты устанавливаются в 0.
  • Синий компонент рассчитывается путем вычитания индекса цвета из 255, начиная с 10. Это создает градиент синих цветов.
  • Устанавливает peFlags в PC_ NOCOLLAPSE.
• Создает новую палетку с помощью CreatePalette и присваивает ее BluePalette.
• Освобождает память, выделенную для LogicalPalette, с помощью FreeMem.

Процедура FormDestroy

• Удаляет объект BluePalette при уничтожении формы.

Процедура FormMouseDown

• Выбирает BluePalette как текущую палету для канваса с помощью SelectPalette.
• Реализует изменения палеты с помощью RealizePalette.
• Рисует линию на канвасе с пеной, цвет которой рассчитывается путем комбинации синего значения из палеты и константы ($02000000 или (BlueVal * $00010000)).
• Устанавливает ширину пена в 10.
• Перемещает пену в координаты (0, 0) и рисует линию до координат мыши X и Y.
• Выбирает предыдущую палету назад с помощью SelectPalette.
• Увеличивает синий значение (BlueVal) при клике формы. Если синее значение превышает 255, оно обертывается вокруг 0.

Замечания

• Код использует старую версию Delphi (вероятно, пред-2009 года) из-за использования TLogPalette и GetSystemPaletteEntries. В новых версиях используются TPalette и GetDeviceCaps.
• Создание и использование палетки не оптимизированы для производительности. Лучше создавать одиночную инстанцию палеты и использовать ее снова вместо рекреации каждые раз.
• Код рисования линии можно улучшить, используя более эффективный метод рисования (например, используя Canvas.DrawLine) или кэшируя цвет пена и используя его напрямую.

В целом, этот код демонстрирует, как создавать пользовательскую палету и использовать ее для рисования на форме Delphi. Однако есть области, где код можно улучшить для лучшей производительности и поддержки.

В статье описывается создание палитры в Delphi с помощью процедуры TForm1.FormCreate и ее использование в процедуре TForm1.FormMouseDown.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Цвета и Палитра ::