Как создать скриншот конкретного компонента на форме в Delphi: обзор возможностей и альтернативные решения для разработчиков.

Delphi , Компоненты и Классы , Создание компонент

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

Захват изображения компонента: базовый подход

Самый простой способ сделать скриншот компонента - использовать метод PaintTo класса TWinControl. Этот метод позволяет отрисовать содержимое компонента на любом холсте (Canvas), включая холст битмапа.

function CaptureWinControl(Control: TWinControl): TBitmap;
begin
  Result := TBitmap.Create;
  try
    Result.Width := Control.Width;
    Result.Height := Control.Height;
    Control.PaintTo(Result.Canvas, 0, 0);
  except
    Result.Free;
    raise;
  end;
end;

Этот метод работает только для компонентов, наследующихся от TWinControl (оконные контролы), но не подходит для простых элементов управления, таких как TLabel или TImage.

Универсальное решение для любых компонентов

Для захвата любого компонента, включая неоконные элементы управления, можно использовать функцию BitBlt Windows API:

function CaptureControl(Control: TControl): TBitmap;
var
  DC: HDC;
  CtrlRect: TRect;
  ParentHandle: THandle;
  Offset: TPoint;
begin
  Result := TBitmap.Create;
  try
    CtrlRect := Control.BoundsRect;
    Result.SetSize(CtrlRect.Width, CtrlRect.Height);

    if Control is TWinControl then
    begin
      ParentHandle := TWinControl(Control).Handle;
      Offset := Point(0, 0);
    end
    else
    begin
      ParentHandle := TWinControl(Control.Parent).Handle;
      Offset := Control.BoundsRect.TopLeft;
    end;

    DC := GetDC(ParentHandle);
    try
      BitBlt(Result.Canvas.Handle, 0, 0, CtrlRect.Width, CtrlRect.Height,
             DC, Offset.X, Offset.Y, SRCCOPY);
    finally
      ReleaseDC(ParentHandle, DC);
    end;
  except
    Result.Free;
    raise;
  end;
end;

Реализация с выбором компонента через ComboBox

Вот пример полной реализации формы, которая позволяет выбрать компонент из списка и сделать его скриншот:

unit Main.View;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, 
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TMainForm = class(TForm)
    CmboBoxComponents: TComboBox;
    BtnCapture: TButton;
    ImgCaptured: TImage;
    procedure FormCreate(Sender: TObject);
    procedure BtnCaptureClick(Sender: TObject);
  private
    function CaptureControl(aControl: TControl): TBitmap;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

function TMainForm.CaptureControl(aControl: TControl): TBitmap;
var
  DC: HDC;
  CtrlRect: TRect;
  ParentHandle: THandle;
  Offset: TPoint;
begin
  Result := TBitmap.Create;
  try
    CtrlRect := aControl.BoundsRect;
    Result.SetSize(CtrlRect.Width, CtrlRect.Height);

    if aControl is TWinControl then
    begin
      ParentHandle := TWinControl(aControl).Handle;
      Offset := Point(0, 0);
    end
    else
    begin
      ParentHandle := TWinControl(aControl.Parent).Handle;
      Offset := aControl.BoundsRect.TopLeft;
    end;

    DC := GetDC(ParentHandle);
    try
      BitBlt(Result.Canvas.Handle, 0, 0, CtrlRect.Width, CtrlRect.Height,
             DC, Offset.X, Offset.Y, SRCCOPY);
    finally
      ReleaseDC(ParentHandle, DC);
    end;
  except
    Result.Free;
    raise;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  CmboBoxComponents.Items.Clear;
  for I := 0 to ComponentCount - 1 do
    if Components[I] is TControl then
      CmboBoxComponents.Items.Add(Components[I].Name);

  if CmboBoxComponents.Items.Count > 0 then
    CmboBoxComponents.ItemIndex := 0;
end;

procedure TMainForm.BtnCaptureClick(Sender: TObject);
var
  Ctrl: TControl;
  Bmp: TBitmap;
begin
  if CmboBoxComponents.ItemIndex <> -1 then
  begin
    Ctrl := FindComponent(CmboBoxComponents.Text) as TControl;
    if Assigned(Ctrl) then
    begin
      Bmp := CaptureControl(Ctrl);
      try
        ImgCaptured.Picture.Assign(Bmp);
      finally
        Bmp.Free;
      end;
    end;
  end;
end;

end.

Альтернативные решения

1. Использование помощника класса (class helper):

type
  TWinControlHelper = class helper for TWinControl
  public
    function CreateBitmap: TBitmap;
  end;

implementation

function TWinControlHelper.CreateBitmap: TBitmap;
var
  DC: HDC;
begin
  DC := GetWindowDC(Handle);
  try
    Result := TBitmap.Create;
    try
      Result.SetSize(Width, Height);
      BitBlt(
        Result.Canvas.Handle,
        0, 0, Result.Width, Result.Height,
        DC, 0, 0,
        SRCCOPY
      );
    except
      Result.Free;
      raise;
    end;
  finally
    ReleaseDC(Handle, DC);
  end;
end;

1. Сохранение в JPEG:

procedure SaveControlToJPEG(Control: TControl; const FileName: string; Quality: Integer = 75);
var
  Bmp: TBitmap;
  Jpg: TJPEGImage;
begin
  Bmp := CaptureControl(Control);
  try
    Jpg := TJPEGImage.Create;
    try
      Jpg.CompressionQuality := Quality;
      Jpg.Assign(Bmp);
      Jpg.SaveToFile(FileName);
    finally
      Jpg.Free;
    end;
  finally
    Bmp.Free;
  end;
end;

Заключение

В статье рассмотрены различные способы создания скриншотов отдельных компонентов в Delphi. Выбор конкретного метода зависит от ваших требований:

1. Для оконных компонентов (TWinControl) проще всего использовать метод PaintTo.
2. Для универсального решения, работающего с любыми компонентами, подойдет вариант с BitBlt.
3. Для удобства можно реализовать помощник класса или отдельную функцию сохранения в различные форматы.

Представленные решения не требуют сторонних библиотек и работают в современных версиях Delphi, включая Delphi 11 Alexandria и Delphi 12 Athens.

Создано по материалам из источника по ссылке.

В статье рассматриваются различные методы создания скриншотов отдельных компонентов в Delphi, включая использование PaintTo, BitBlt и дополнительных функций для сохранения в различные форматы.

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

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

:: Главная :: Создание компонент ::