Delphi code to produce sample EMF files with various origin, transform and clipping options for testing purposes

Project1.pas

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Windows,
  SysUtils,
  Classes,
  Vcl.Graphics,
  Vcl.Forms;

const
  DPI_TARGET= 96;
  RGN_NONE = -1; // Define a custom value for no clipping

var
  DPI_SCREEN: Integer;

type
  TTransformType = (NONE, NORMAL, SCALE, TRANSLATE, ROTATE, SHEAR, REFLECT);

function PixelsToMM(pixels: Integer): Integer;
var
  Inches: Double;
begin
  // Convert pixels to inches
  Inches := pixels / DPI_TARGET;
  // Convert inches to .01-mm
  Result := Round(Inches * 2540);
end;

function TransformTypeToStr(Transform: TTransformType): string;
begin
  case Transform of
    NONE: Result := 'None';
    NORMAL: Result := 'Normal';
    SCALE: Result := 'Scale';
    TRANSLATE: Result := 'Translate';
    ROTATE: Result := 'Rotate';
    SHEAR: Result := 'Shear';
    REFLECT: Result := 'Reflect';
  else
    Result := 'Unknown';
  end;
end;

function ModeToStr(Mode: Integer): string;
begin
  case Mode of
    RGN_AND: Result := 'And';
    RGN_COPY: Result := 'Copy';
    RGN_DIFF: Result := 'Diff';
    RGN_OR: Result := 'Or';
    RGN_XOR: Result := 'Xor';
    RGN_NONE: Result := 'None';
  else
    Result := 'Unknown';
  end;
end;

procedure CreateEMFWithClipRegion(const FileName: string; Mode: Integer; XOrigin: Integer = -1; YOrigin: Integer = -1; Transform: TTransformType = NONE);
var
  DC: HDC;
  MetaFileDC: HDC;
  MetaFile: HENHMETAFILE;
  aRect: TRect;
  RectRgn, TriangleRgn, CombinedRgn: HRGN;
  Brush: HBRUSH;
  Pen: HPEN;
  Points: array[0..2] of TPoint;
  XForm: TXForm;
begin
  // Create a device context for the screen
  DC := GetDC(0);
  try
    // Get the DPI (dots per inch) of the screen
    DPI_SCREEN := GetDeviceCaps(DC, LOGPIXELSX);

    // Define the bounding rectangle for the metafile in 0.01 mm units
    aRect := Rect(0, 0, PixelsToMM(500), PixelsToMM(500));

    // Create an enhanced metafile device context
    MetaFileDC := CreateEnhMetaFile(DC, PChar(FileName), @aRect, nil);
    try
      // Optionally set the window origin in 0.01 mm units
      if (XOrigin <> -1) and (YOrigin <> -1) then
        SetWindowOrgEx(MetaFileDC, XOrigin, YOrigin, nil);

      // Apply the specified world transformation
      if Transform <> NONE then
      begin
        SetGraphicsMode(MetaFileDC, GM_ADVANCED);
        case Transform of
          NORMAL:
            begin
              XForm.eM11 := 1.0; XForm.eM12 := 0.0;
              XForm.eM21 := 0.0; XForm.eM22 := 1.0;
              XForm.eDx := 0.0; XForm.eDy := 0.0;
            end;
          SCALE:
            begin
              XForm.eM11 := 0.5; XForm.eM12 := 0.0;
              XForm.eM21 := 0.0; XForm.eM22 := 0.5;
              XForm.eDx := 0.0; XForm.eDy := 0.0;
            end;
          TRANSLATE:
            begin
              XForm.eM11 := 1.0; XForm.eM12 := 0.0;
              XForm.eM21 := 0.0; XForm.eM22 := 1.0;
              XForm.eDx := 75.0;
              XForm.eDy := 0.0;
            end;
          ROTATE:
            begin
              XForm.eM11 := 0.8660; XForm.eM12 := 0.5000;
              XForm.eM21 := -0.5000; XForm.eM22 := 0.8660;
              XForm.eDx := 0.0; XForm.eDy := 0.0;
            end;
          SHEAR:
            begin
              XForm.eM11 := 1.0; XForm.eM12 := 1.0;
              XForm.eM21 := 0.0; XForm.eM22 := 1.0;
              XForm.eDx := 0.0; XForm.eDy := 0.0;
            end;
          REFLECT:
            begin
              XForm.eM11 := 1.0; XForm.eM12 := 0.0;
              XForm.eM21 := 0.0; XForm.eM22 := -1.0;
              XForm.eDx := 0.0; XForm.eDy := 0.0;
            end;
        end;
        SetWorldTransform(MetaFileDC, XForm);
      end;

      // Draw a colored background
      Brush := CreateSolidBrush(RGB(255, 192, 203)); // Pink background
      Pen := CreatePen(PS_SOLID, 1, RGB(255, 20, 147)); // Dark pink pen
      SelectObject(MetaFileDC, Brush);
      SelectObject(MetaFileDC, Pen);
      Rectangle(MetaFileDC, 0, 0, 500, 500);

      // Apply clipping region if mode is not NONE
      if Mode <> RGN_NONE then
      begin
        // Define a rectangle clipping region in the middle in 0.01 mm units
        RectRgn := CreateRectRgn(125, 125, 375, 375);

        // Define a triangle region in 0.01 mm units
        Points[0] := Point(100, 450);
        Points[1] := Point(250, 50);
        Points[2] := Point(400, 450);
        TriangleRgn := CreatePolygonRgn(Points, Length(Points), WINDING);

        // Combine the rectangle region and the triangle region
        CombinedRgn := CreateRectRgn(0, 0, 0, 0); // Create an empty region
        CombineRgn(CombinedRgn, RectRgn, TriangleRgn, Mode);

        // Select the combined region with the specified mode
        ExtSelectClipRgn(MetaFileDC, CombinedRgn, RGN_COPY);

        // Clean up the regions
        DeleteObject(RectRgn);
        DeleteObject(TriangleRgn);
        DeleteObject(CombinedRgn);
      end;

      // Draw a green rectangle in 0.01 mm units
      Brush := CreateSolidBrush(RGB(0, 255, 0)); // Green brush
      Pen := CreatePen(PS_SOLID, 1, RGB(0, 255, 0)); // Green pen
      SelectObject(MetaFileDC, Brush);
      SelectObject(MetaFileDC, Pen);
      Rectangle(MetaFileDC, 50, 50, 300, 300);

      // Draw a red circle in 0.01 mm units
      Brush := CreateSolidBrush(RGB(255, 0, 0)); // Red brush
      Pen := CreatePen(PS_SOLID, 1, RGB(255, 0, 0)); // Red pen
      SelectObject(MetaFileDC, Brush);
      SelectObject(MetaFileDC, Pen);
      Ellipse(MetaFileDC, 200, 200, 470, 470);

      // Deselect the clipping region
      SelectClipRgn(MetaFileDC, 0);

      // Clean up the brush and pen
      DeleteObject(Brush);
      DeleteObject(Pen);

    finally
      // Close the metafile and get the handle
      MetaFile := CloseEnhMetaFile(MetaFileDC);
    end;

    // Save the metafile to a file
    if MetaFile <> 0 then
    begin
      DeleteEnhMetaFile(MetaFile);
    end;
  finally
    // Release the screen device context
    ReleaseDC(0, DC);
  end;
end;

procedure TestCreateEMF(BasePath: string = '');
const
  Modes: array[0..5] of Integer = (RGN_AND, RGN_COPY, RGN_DIFF, RGN_OR, RGN_XOR, RGN_NONE);
  Transforms: array[0..6] of TTransformType = (NONE, NORMAL, SCALE, TRANSLATE, ROTATE, SHEAR, REFLECT);
var
  Mode: Integer;
  Transform: TTransformType;
  FileName: string;
begin
  if BasePath = '' then
    BasePath := ExtractFilePath(Application.ExeName);
  if not BasePath.EndsWith(PathDelim) then
    BasePath := BasePath + PathDelim;

  for Mode in Modes do
  begin

    for Transform in Transforms do
    begin

      // Without window origin
      FileName := Format('%sMetafile_Mode_%s_Transform_%s_NoOrigin.emf', [BasePath, ModeToStr(Mode), TransformTypeToStr(Transform)]);
      CreateEMFWithClipRegion(FileName, Mode, -1, -1, Transform);

      // With window origin
      FileName := Format('%sMetafile_Mode_%s_Transform_%s_WithOrigin.emf', [BasePath, ModeToStr(Mode), TransformTypeToStr(Transform)]);
      CreateEMFWithClipRegion(FileName, Mode, -50, -50, Transform);
    end;
  end;
end;

begin
  TestCreateEMF();
end.