Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

Как работать с палитрой в Delphi

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

Как работать с палитрой в Delphi

Старый анекдот на новый лад:
- Что такое тугодум?
- Это игра Doom II, запущенная на 386-м компьютере.
- Ага, или Doom III практически на любом...

Палитра в TBitmap и TMetaFile доступна через property Palette. Если палитра имеется (что совсем необязательно), то Palette<>0:


procedure TMain.BitBtnClick(Sender: TObject);
var
  Palette : HPalette;
  PaletteSize : Integer;
  LogSize: Integer;
  LogPalette: PLogPalette;
  Red : Byte;
begin
  Palette := Image.Picture.Bitmap.ReleasePalette;
  // здесь можно использовать просто Image.Picture.Bitmap.Palette, но я не
  // знаю, удаляются ли ненужные палитры автоматически

  if Palette=0 then //Палитра отсутствует
    exit;
  PaletteSize := 0;
  if GetObject(Palette, SizeOf(PaletteSize), @PaletteSize) = 0 then
    Exit;
  // Количество элементов в палитре = paletteSize
  if PaletteSize = 0 then // палитра пустая
    Exit;
  // определение размера палитры
  LogSize := SizeOf(TLogPalette) + (PaletteSize - 1) * SizeOf(TPaletteEntry);
  GetMem(LogPalette, LogSize);
  try
    // заполнение полей логической палитры
    with LogPalette^ do
    begin
      palVersion := $0300; palNumEntries := PaletteSize;
      GetPaletteEntries(Palette, 0, PaletteSize, palPalEntry);
      // делаете что нужно с палитрой, например:
      Red := palPalEntry[PaletteSize-1].peRed;
      Edit1.Text := 'Красная составляющего последнего элемента палитры ='+IntToStr(Red);
      palPalEntry[PaletteSize-1].peRed := 0;
    end;
    // завершение работы
    Image.Picture.Bitmap.Palette := CreatePalette(LogPalette^);
  finally
    FreeMem(LogPalette, LogSize);
    // я должен позаботиться сам об удалении Released Palette
    DeleteObject(Palette);
  end;
end;


{ Этот модуль заполняет фон формы рисунком bor6.bmp (256 цветов)
и меняет его палитру при нажатии кнопки }
unit bmpformu;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TBmpForm = class(TForm)
    Button1: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    Bitmap: TBitmap;
    procedure ScrambleBitmap;
    procedure WMEraseBkgnd(var m: TWMEraseBkgnd); message WM_ERASEBKGND;
end;

var
  BmpForm: TBmpForm;

implementation

{$R *.DFM}

procedure TBmpForm.FormCreate(Sender: TObject);
begin
  Bitmap := TBitmap.Create;
  Bitmap.LoadFromFile('bor6.bmp');
end;

procedure TBmpForm.FormDestroy(Sender: TObject);
begin
  Bitmap.Free;
end;

// since we're going to be painting the whole form, handling this
// message will suppress the uneccessary repainting of the background
// which can result in flicker.
procedure TBmpform.WMEraseBkgnd(var m : TWMEraseBkgnd);
begin
  m.Result := LRESULT(False);
end;

procedure TBmpForm.FormPaint(Sender: TObject);
var
  x, y: Integer;
begin
  y := 0;
  while y < Height do
  begin
    x := 0;
    while x < Width do
    begin
      Canvas.Draw(x, y, Bitmap);
      x := x + Bitmap.Width;
    end;
    y := y + Bitmap.Height;
  end;
end;

procedure TBmpForm.Button1Click(Sender: TObject);
begin
  ScrambleBitmap;
  Invalidate;
end;

// scrambling the bitmap is easy when it's has 256 colors:
// we just need to change each of the color in the palette
// to some other value.
procedure TBmpForm.ScrambleBitmap;
var
  pal: PLogPalette;
  hpal: HPALETTE;
  i: Integer;
begin
  pal := nil;
  try
    GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 255);
    pal.palVersion := $300;
    pal.palNumEntries := 256;
    for i := 0 to 255 do
    begin
      pal.palPalEntry[i].peRed := Random(255);
      pal.palPalEntry[i].peGreen := Random(255);
      pal.palPalEntry[i].peBlue := Random(255);
    end;
    hpal := CreatePalette(pal^);
    if hpal <> 0 then
      Bitmap.Palette := hpal;
  finally
    FreeMem(pal);
  end;
end;

end.

Программа на Delphi, демонстрирующая работу с палетками в компонентах TBitmap и TMetaFile. Программа включает два форм: основной и форму битмапа.

  1. Единица TMain содержит процедуру BitBtnClick, которая освобождает палетку, получает ее размер и затем скрамблирует ее, изменяя каждый цветовой элемент на случайное значение.
  2. Единица bmpformu - это отдельная программа, загружающая изображение из файла 'bor6.bmp' (имеющего 256 цветов) и отображающая его на форме. Она также включает в себя две процедуры: ScrambleBitmap, которая скрамблирует палетку битмапа, изменяя каждый цветовой элемент на случайное значение, и FormPaint, которая рисует всю форму с скрамбленным изображением.
  3. Единица bmpformu имеет несколько событий, включая FormCreate, FormDestroy, WMEraseBkgnd, Button1Click, FormPaint и ScrambleBitmap.

Вот некоторые важные точки:

  • В Delphi палетки доступны через свойство Palette компонента TBitmap или TMetaFile.
  • Палетки можно освободить с помощью метода ReleasePalette, который используется в процедуре BitBtnClick.
  • Функция GetObject используется для получения размера палетки.
  • Скрамблированная палетка создается изменением каждого цветового элемента на случайное значение в процедуре ScrambleBitmap.
  • В Delphi необходимо вручную удалять освобожденные палетки с помощью функции DeleteObject.

Альтернативное решение для скрамблирования палетки:

procedure TBmpForm.ScrambleBitmap;
var
  i: Integer;
begin
  for i := 0 to Bitmap.PaletteEntries - 1 do
  begin
    Bitmap.Palette.Entries[i].Red := Random(255);
    Bitmap.Palette.Entries[i].Green := Random(255);
    Bitmap.Palette.Entries[i].Blue := Random(255);
  end;
end;

В этом коде непосредственно доступится к цветовым элементам палетки и изменяется каждый из них на случайное значение.

В статье описывается как работать с палитрой в Delphi, а также приведен пример кода на языке Pascal для изменения палитры битмапа при помощи процедуры ScrambleBitmap.


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

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




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


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


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-12-22 20:14:06
2025-06-16 08:51:07/0.0062031745910645/0