Как вставить изображение из буфера обмена

Необходимость вставки изображения из буфера обмена в приложении, связанного с графикой, возникает всегда. По этому поводу небольшой пост и очень простой способ.

О вставке изображения написал подробную статью: Clipboard в Delphi: Изображение без потери альфа-канала. Внутри статьи:

почему VCL теряет альфу и как устроен синтез форматов в Windows;
что на самом деле лежит в буфере (написал утилиту-просмотрщик);
как достать PNG и CF_DIBV5 напрямую;
готовый модуль: две функции, вставка и копирование с альфой.

Использовать метод LoadFromClipboardFormat класса TGraphic достаточно затруднительно. Во-первых, потому что он громоздкий:

    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
      APalette: HPALETTE); virtual; abstract;

1 2	procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; APalette: HPALETTE); virtual; abstract;

Во-вторых, вот что написано в комментариях к этому методу в модуле Vcl.Graphics:

// LoadFromClipboardFormat - Replaces the current image with the data
//   provided.  If the TGraphic does not support that format it will generate
//   an exception.

// LoadFromClipboardFormat - Replaces the current image with the data

// provided. If the TGraphic does not support that format it will generate

// an exception.

LoadFromClipboardFormat — заменяет текущее изображение предоставленными данными. Если TGraphic не поддерживает этот формат, он сгенерирует исключение.

Проще говоря, если создали не тот TGraphic, будут проблемы.

Поэтому всегда лучше использовать экземпляр класса TPicture. Его можно создать динамически, или использовать уже существующий на форме. Например, свойство Picture компонента TImage.

Для вставки изображения из буфера обмена используем известный хак, чтобы добраться до protected метода AssignTo класса TClipboard.

// paste image from clipboard
type
  TMyClipboard = class(TClipboard);

procedure TFmMain.btnPasteClick(Sender: TObject);
var
  p: TPicture;
begin
  if not Clipboard.HasFormat(CF_PICTURE) then
  begin
    MessageDlg('The clipboard has no image!', mtError, [mbOk], 0);
    Exit;
  end;

  p := TPicture.Create;
  try
    TMyClipboard(Clipboard).AssignTo(p);
    SetGraphic(p.Graphic);

  finally
    FreeAndNil(p);
  end;
end;

// paste image from clipboard

type

TMyClipboard = class(TClipboard);

procedure TFmMain.btnPasteClick(Sender: TObject);

var

p: TPicture;

begin

if not Clipboard.HasFormat(CF_PICTURE) then

begin

MessageDlg('The clipboard has no image!', mtError, [mbOk], 0);

Exit;

end;

p := TPicture.Create;

try

TMyClipboard(Clipboard).AssignTo(p);

SetGraphic(p.Graphic);

finally

FreeAndNil(p);

end;

Метод SetGraphic — метод что-то делающий на смену текущего TGraphic. Например:

procedure TFmMain.SetGraphic(const AGraphic: TGraphic);
begin
  Image1.Picture.Assign(AGraphic);
  lblSize.Caption := IntToStr(AGraphic.Width) + ' x ' +
    IntToStr(AGraphic.Height);
  // Что-то еще - DoMakeImages;
end;

procedure TFmMain.SetGraphic(const AGraphic: TGraphic);

begin

Image1.Picture.Assign(AGraphic);

lblSize.Caption := IntToStr(AGraphic.Width) + ' x ' +

IntToStr(AGraphic.Height);

// Что-то еще - DoMakeImages;

end;

Единственная проблема — чтобы вы не скопировали в буфер обмена, вставляться всегда будет TBitmap.

Хорошая новость — альфа канал также будет вставлен. Плохая новость — стандартный TBitmap работает с альфа-каналом так себе. Чтобы отобразить пришедший из буфера обмена битмап в наилучшем виде, надо использовать GDI+ или Direct2D.

Копируем из браузера оригинал:

Рис1. Скопировать из браузера в буфера обмена

Рис.1. TBitmap плохо работает с альфа каналом

Рис.3. GDI+ хорошо работает с альфа каналом

Рис.4. Direct2D прекрасно работает с альфа каналом

Вообще, всегда лучше работать с TPicture. Он для этого и был создан, чтобы разруливать проблемы с нужным классом-наследником от TGraphic. Например, при открытии файла, чтобы не мучиться проблемой — какой TGraphic создавать, всегда можно воспользоваться методом LoadFromFile экземпляра TPicture. Он там внутри сам разберется, какой класс использовать.

// load image from file
procedure TFmMain.btnOpenClick(Sender: TObject);
var
  p: TPicture;
begin
  if not OpenPictureDialog1.Execute then
    Exit;

  p := TPicture.Create;
  try
    p.LoadFromFile(OpenPictureDialog1.FileName);
    SetGraphic(p.Graphic);

  finally
    FreeAndNil(p);
  end;
end;

// load image from file

procedure TFmMain.btnOpenClick(Sender: TObject);

var

p: TPicture;

begin

if not OpenPictureDialog1.Execute then

Exit;

p := TPicture.Create;

try

p.LoadFromFile(OpenPictureDialog1.FileName);

SetGraphic(p.Graphic);

finally

FreeAndNil(p);

end;

Чтобы иметь возможность открывать больше форматов не забываем добавлять в предложение uses соответствующие модули. Например:

interface

uses
  // standart uses list +
  Vcl.Imaging.PNGImage,Vcl.Imaging.JPEG, Vcl.Imaging.GIFImg;

interface

uses

// standart uses list +

Vcl.Imaging.PNGImage,Vcl.Imaging.JPEG, Vcl.Imaging.GIFImg;

И, пожалуй, еще одно. Бывает так, что при вызове диалогов в Delphi возникает неприятный завис, ни диалога, ни реакций в приложении. Поэтому, во избежании такого поведения, имеет смысл где-нибудь пораньше в коде вставить такую запись:

  UseLatestCommonDialogs := False;

1	UseLatestCommonDialogs := False;

Этим постом открываю рубрику «Коротыши». Планирую писать сюда всякие мелкие полезняшки. В меню сайта пока не вывожу, думаю использовать в качестве поясняющего материала к статьям.

Информация о новые коротышах доступна в телеграм-канале. Подписывайтесь, чтобы не пропустить ) Там же можно комментировать и участвовать в обсуждении.

Поиск этой темы на сайте.

5 4 голоса

Рейтинг статьи

0 комментариев

Старые

Новые Популярные

Межтекстовые Отзывы

Посмотреть все комментарии