Проблема с выводом TMetaFileCanvas при рисовании изображения за пределами разрешения экрана в Delphi

Delphi , Графика и Игры , MetaFile

связана с тем, что TMetaFileCanvas использует HDC экрана в качестве устройства ссылки (ReferenceDevice) по умолчанию. При этом, когда вы пытаетесь нарисовать изображение за пределами экрана, GDI не может правильно обработать операцию BitBlt, что приводит к тому, что изображение не отображается.

Чтобы решить эту проблему, вам нужно предоставить TMetaFileCanvas устройство ссылки, которое не основывается на экране. Одним из вариантов является использование HDC большого битмапа в качестве устройства ссылки. Вы можете создать битмап размером, превышающим разрешение экрана, и использовать его HDC в качестве устройства ссылки для TMetaFileCanvas. При этом, убедитесь, что битмап имеет правильный формат пикселей (например, pf24bit) и тип.handle = bmDIB.

Вот пример кода, который демонстрирует, как это можно сделать:

program Project1;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.Types,
  Windows,
  Vcl.Graphics,
  Vcl.Imaging;

const
  SIZECONST = 3000; // должен быть больше разрешения экрана
  OFFSET = 1500;

function GetMyMetafile(const aHDC: HDC): TMetafile;
var
  metcnv: TMetafileCanvas;
begin
  Result := TMetafile.Create;
  Result.SetSize(500, 500);

  metcnv := TMetafileCanvas.Create(Result, aHDC);
  try
    metcnv.Brush.Color := clRed;
    metcnv.FillRect(Rect(0, 0, 500, 500));
  finally
    metcnv.Free;
  end;
end;

procedure OutputToMetaFile(const aFilename: string; const aStartOffset,
  aEndOffset, aMaxSize: Integer; aGraphic: TGraphic; aHDC: HDC);
var
  metafile: TMetafile;
  metcnv: TMetafileCanvas;
begin
  metafile := TMetafile.Create;
  try
    metafile.SetSize(aMaxSize, aMaxSize);

    metcnv := TMetafileCanvas.Create(metafile, aHDC);
    try
      // нарисуйте его где-то за пределами экрана
      metcnv.StretchDraw(Rect(aStartOffset, aStartOffset, aEndOffset, aEndOffset), aGraphic);
      metcnv.MoveTo(aStartOffset, aStartOffset);
      metcnv.LineTo(aEndOffset, aEndOffset);
    finally
      metcnv.Free;
    end;

    metafile.SaveToFile(aFilename);
  finally
    metafile.Free;
  end;
end;

procedure OutputToBitmap(const aFilename: string; const aStartOffset,
  aEndOffset, aMaxSize: Integer; aGraphic: TGraphic);
var
  bmp: TBitmap;
begin
  bmp := TBitmap.Create;
  try
    bmp.SetSize(aMaxSize, aMaxSize);

    bmp.Canvas.StretchDraw(Rect(aStartOffset, aStartOffset, aEndOffset, aEndOffset), aGraphic);
    bmp.Canvas.MoveTo(aStartOffset, aStartOffset);
    bmp.Canvas.LineTo(aEndOffset, aEndOffset);

    bmp.SaveToFile(aFilename);
  finally
    bmp.Free;
  end;
end;

var
  mygraph: TMetafile;
  bigBitmap: TBitmap;
  mHDC: HDC;
begin
  bigBitmap := TBitmap.Create;
  try
    bigBitmap.PixelFormat := pf24bit;
    Assert(bigBitmap.HandleType = bmDIB, 'Handle Type should be a DIB');
    bigBitmap.Width := SIZECONST;
    bigBitmap.Height := SIZECONST;
    mHDC := bigBitmap.Canvas.Handle;

    mygraph := GetMyMetafile(mHDC);
    OutputToMetaFile('inscreen.emf', 0, 1000, SIZECONST, mygraph, mHDC);
    OutputToMetaFile('outsidescreen.emf', OFFSET, SIZECONST-1, SIZECONST, mygraph, mHDC);

    // то же самое, используя битмап
    OutputToBitmap('inscreen.bmp', 0, 1000, SIZECONST, mygraph);
    OutputToBitmap('outsidescreen.bmp', OFFSET, SIZECONST-1, SIZECONST, mygraph);
  finally
    bigBitmap.Free;
    mygraph.Free;
  end;
end.

В этом примере кода создается битмап размером SIZECONST x SIZECONST, и его HDC используется в качестве устройства ссылки для TMetaFileCanvas. Затем создаются два метафайла: один для рисования внутри границ экрана (inscreen.emf), и один для рисования вне границ экрана (outsidescreen.emf). Также создаются два битмапа: один для рисования внутри границ экрана (inscreen.bmp), и один для рисования вне границ экрана (outsidescreen.bmp). При этом, убедитесь, что битмап имеет правильный формат пикселей (например, pf24bit) и тип.handle = bmDIB.

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

Проблема с выводом TMetaFileCanvas при рисовании изображения за пределами разрешения экрана в Delphi связана с тем, что по умолчанию TMetaFileCanvas использует HDC экрана в качестве устройства ссылки, что приводит к некорректной работе GDI за пределами эк

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

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

:: Главная :: MetaFile ::