Захват части изображения

Delphi , Графика и Игры , Изображения

Автор: Mike Scott

Вот пример кода, позволящего с помощью TBitmap захватить часть изображения и сохранить его в файле. Я включил функцию копирования палитры, необходимой при работе в режиме 256 цветов.

function CopyPalette(Palette: HPalette): HPalette;
var
  nEntries: integer;
  LogPalSize: integer;
  LogPalette: PLogPalette;
begin
  Result := 0;
  if Palette = 0 then
    exit;
  GetObject(Palette, sizeof(nEntries), @nEntries);
  if nEntries < 1 then
    exit;
  LogPalSize := sizeof(TLogPalette) + sizeof(TPaletteEntry) * (nEntries - 1);
  GetMem(LogPalette, LogPalSize);
  with LogPalette^ do
  try
    palVersion := $300;
    palNumEntries := nEntries;
    GetPaletteEntries(Palette, 0, nEntries, palPalEntry[0]);
    Result := CreatePalette(LogPalette^);
  finally
    FreeMem(LogPalette, LogPalSize);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.Width := 50;
    Bitmap.Height := 40;
    Bitmap.Palette := CopyPalette(Image1.Picture.Bitmap.Palette);
    Bitmap.Canvas.CopyRect(Rect(0, 0, 50, 40),
      Image1.Picture.Bitmap.Canvas,
      Bounds(20, 10, 50, 40));
    Bitmap.SaveToFile('c:\windows\temp\junk.bmp');
  finally
    Bitmap.Free;
  end;
end;

Перевод на русский язык:

Код Delphi позволяет захватить часть изображения и сохранить ее в виде нового файла bitmap.

Вот, что код делает:

1. Функция CopyPalette принимает палетку (таблицу цветов) в качестве входного параметра и возвращает копию этой палетки. Это необходимо при работе с 256-цветным режимом, где палетка должна быть скопирована отдельно от данных изображения.
2. Процедура Button1Click создает новый объект TBitmap, устанавливает его ширину и высоту в 50x40 пикселей, копирует палетку из оригинального изображения (используя функцию CopyPalette) и затем захватывает прямоугольник размером 50x30 пикселей из оригинального изображения, начиная с позиции (20,10). Захваченная область хранится в новом bitmap.
3. Наконец, код сохраняет новый bitmap в файле "junk.bmp" в временной папке Windows.

Функция GetObject используется для получения количества элементов в палетке. Это необходимо потому, что Delphi'с TBitmap не предоставляет прямого доступа к размеру палетки.

Вот несколько предложений по улучшению кода:

• Рассмотрите использование TPaletteEntryArray вместо PLogPalette, чтобы улучшить безопасность памяти и уменьшить риск буферных переполнений.
• Вместо ручного расчета размера логической палетки можно использовать константу или вычисленное значение, которое будет проще поддерживать.
• Если оригинальное изображение имеет канал альфа, вам может потребоваться сохранение его в захваченной области. Это потребует использования TCanvas.Picture вместо TBitmap.Canvas.
• Рассмотрите добавление обработки ошибок для случаев, когда файл не может быть сохранен (например, из-за проблемы с правами доступа).
• Вы также можете добавить больше гибкости коду, позволяя пользователю выбрать имя и папку вывода программно.

Вот обновленная версия кода, которая включает некоторые из этих предложений:

function CopyPalette(Palette: HPalette): HPalette;
var
  nEntries: integer;
  LogPalSize: integer;
  LogPalette: TPaletteEntryArray;
begin
  Result := 0;
  if Palette = 0 then
    exit;

  GetObject(Palette, sizeof(nEntries), @nEntries);
  if nEntries < 1 then
    exit;

  SetLength(LogPalette, nEntries);

  with LogPalette do
  try
    palVersion := $300;
    palNumEntries := nEntries;
    GetPaletteEntries(Palette, 0, nEntries, palPalEntry[0]);
    Result := CreatePalette(LogPalette);
  finally
    SetLength(LogPalette, 0);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Bitmap: TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.Width := 50;
    Bitmap.Height := 40;
    Bitmap.Palette := CopyPalette(Image1.Picture.Bitmap.Palette);
    Bitmap.Canvas.CopyRect(Rect(0, 0, 50, 40),
      Image1.Picture.Bitmap.Canvas,
      Bounds(20, 10, 50, 30));
    SaveFileDialog1.InitialDir := 'c:\windows\temp';
    SaveFileDialog1.Filter := 'Bitmap files (*.bmp)|*.bmp';
    if SaveFileDialog1.Execute then
      Bitmap.SaveToFile(SaveFileDialog1.FileName);
  finally
    Bitmap.Free;
  end;
end;

Обратите внимание, что я также добавил компонент SaveFileDialog, чтобы позволить пользователю выбрать имя и папку вывода. Это только один из возможных способов улучшения кода; у вас могут быть другие идеи по его облегчению или укреплению.

В статье рассматривается пример кода на языке Pascal, который позволяет захватить часть изображения и сохранить ее в файле с помощью компонента TBitmap.

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

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

:: Главная :: Изображения ::