Componentes.Terceros.DevExpressVCL/official/x.48/ExpressPrinting System 4/Sources/dxPSPDFMetaFileParser.pas

{*******************************************************************}
{                                                                   }
{       Developer Express Visual Component Library                  }
{       ExpressPrinting System COMPONENT SUITE                      }
{                                                                   }
{       Copyright (C) 1998-2009 Developer Express Inc.              }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{   The entire contents of this file is protected by U.S. and       }
{   International Copyright Laws. Unauthorized reproduction,        }
{   reverse-engineering, and distribution of all or any portion of  }
{   the code contained in this file is strictly prohibited and may  }
{   result in severe civil and criminal penalties and will be       }
{   prosecuted to the maximum extent possible under the law.        }
{                                                                   }
{   RESTRICTIONS                                                    }
{                                                                   }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES           }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE    }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS   }
{   LICENSED TO DISTRIBUTE THE EXPRESSPRINTINGSYSTEM AND            }
{   ALL ACCOMPANYING VCL CONTROLS AS PART OF AN                     }
{   EXECUTABLE PROGRAM ONLY.                                        }
{                                                                   }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED      }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE        }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE       }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT  }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                      }
{                                                                   }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON       }
{   ADDITIONAL RESTRICTIONS.                                        }
{                                                                   }
{*******************************************************************}

unit dxPSPDFMetaFileParser;

interface

{$I cxVer.inc}

uses
  Types, Windows, Classes, SysUtils, Graphics, cxGraphics, dxPSCore, dxBkGnd,
  cxClasses, dxPSPDFExportCore, cxDrawTextUtils, cxGeometry, dxPSPDFExport,
  dxPSGlbl, dxPSFillPatterns, dxPSReportRenderCanvas;

type

  { TdxPSPDFMetaFileGdiObjectItem }

  TdxPSPDFMetaFileGdiObjectItem = class(TObject)
  private
    FColor: TColor;
    FHandle: THandle;
    FSourceObject: TObject;
  public
    constructor Create(AHandle: THandle; ASourceObject: TObject; AColor: TColor);
    destructor Destroy; override;
    //
    property Color: TColor read FColor;
    property Handle: THandle read FHandle;
    property SourceObject: TObject read FSourceObject;
  end;

  { TdxPSPDFMetaFileGdiObjectList }

  TdxPSPDFMetaFileGdiObjectList = class(TList)
  private
    function GetItem(Index: Integer): TdxPSPDFMetaFileGdiObjectItem;
  protected
    procedure Notify(Ptr: Pointer; Action: TListNotification); override;
  public
    function CreateBrush(const ABrushInfo: TLogBrush): HBRUSH;
    function CreateFont(const AFontInfo: TExtLogFontW): HFONT;
    function CreatePen(const APenInfo: TLogPen): HPEN;
    function CreatePenEx(const APenInfo: TExtLogPen): HPEN;
    function FindObject(AHandle: THandle; var AObject: TdxPSPDFMetaFileGdiObjectItem): Boolean;
    //
    property Items[Index: Integer]: TdxPSPDFMetaFileGdiObjectItem read GetItem;
  end;

  { TdxPSPDFMetaFileExportProvider }

  TdxPSPDFMetaFileExportProvider = class(TObject)
  private
    FBackgroundColor: TColor;
    FBackgroundMode: Integer;
    FBaseWindowOrg: TPoint;
    FGdiObjectList: TdxPSPDFMetaFileGdiObjectList;
    FInternalWindowOrg: TPoint;
    FMoveToPoint: TPoint;
    FPDFCanvas: TdxPSPDFReportRenderCanvas;
    FPen: TPen;
    FScaleDenumerator: Integer;
    FScaleNumerator: Integer;
    FTextColor: TColor;
    function GetBackgroundColor: TColor;
    function GetPatternColor: TColor;
    procedure SetPen(AValue: TPen);
  protected
    function ConvertPoint(const P: TPoint): TPoint;
    function ConvertPoints(P: Pointer; ACount: Integer; AIsSmallPoints: Boolean): TPointArray;
    function ConvertRect(const R: TRect): TRect;
    function ConvertRegion(ARegion: HRGN): TcxRegion;
    function ConvertValue(AValue: Integer): Integer;
    function CreateRegion(ARgnData: PRgnData; ARgnDataSize: Integer): TcxRegion;
    function ExctractBitmap(ARecordAddress: Pointer;
      ABitmapInfoOffset, ABitmapBitsOffset: Cardinal): TcxBitmap; overload;
    function ExctractBitmap(ARecordAddress: Pointer; const R: TRect;
      ABitmapInfoOffset, ABitmapBitsOffset: Cardinal): TcxBitmap; overload;
    procedure DrawBitmap(const ADest, ASource: TRect; ARecordAddress: Pointer;
      ABitmapInfoOffset, ABitmapBitsOffset: Cardinal);
    //
    procedure EmfAlphaBlend(const ARecord: PEMRAlphaBlend);
    procedure EmfBitBlt(const ARecord: PEMRBitBlt);
    procedure EmfCreateBrush(const ARecord: PEMRCreateBrushIndirect; ATable: PHandleTable);
    procedure EmfCreateFont(const ARecord: PEMRExtCreateFontIndirect; ATable: PHandleTable);
    procedure EmfCreatePen(const ARecord: PEMRCreatePen; ATable: PHandleTable);
    procedure EmfCreatePenEx(const ARecord: PEMRExtCreatePen; ATable: PHandleTable);
    procedure EmfDeleteObject(const ARecord: PEMRSelectObject; ATable: PHandleTable);
    procedure EmfEllipse(R: TRect);
    procedure EmfExcludeClipRect(const ARecord: PEMRExcludeClipRect);
    procedure EmfExtTextOut(const ARecord: PEMRExtTextOut; AIsUnicode: Boolean);
    procedure EmfFillRgn(const ARecord: TEMRFillRgn; ATable: PHandleTable);
    procedure EmfIntersectClipRect(const ARecord: PEMRIntersectClipRect);
    procedure EmfLineTo(const ARecord: TEMRLineTo);
    procedure EmfMaskBlt(const ARecord: PEMRMaskBlt);
    procedure EmfPaintRgn(const ARecord: EMRPaintRgn);
    procedure EmfPie(const ARecord: EMRPie; ATable: PHandleTable);
    procedure EmfPolygon(const APolygon: TEMRPolyline);
    procedure EmfPolygon16(const APolygon: TEMRPolyline16);
    procedure EmfPolyline(const APolyline: TEMRPolyline);
    procedure EmfPolyline16(const APolyline: TEMRPolyline16);
    procedure EmfRectangle(R: TRect);
    procedure EmfRoundRect(R: TRect; ACorners: TSize);
    procedure EmfSelectClipRgn(const ARecord: PEMRExtSelectClipRgn);
    procedure EmfSelectObject(const ARecord: PEMRSelectObject; ATable: PHandleTable);
    procedure EmfSetPixel(const ARecord: TEMRSetPixelV);
    procedure EmfSetWindowOrg(const ARecord: PEMRSetWindowOrgEx);
    procedure EmfStretctBlt(const ARecord: PEMRStretchBlt);
    procedure EmfStretctDIBits(const ARecord: PEMRStretchDIBits);
    procedure WriteMetaFileObject(ATable: PHandleTable;
      AObjectsInTable: Integer; const ARecord: PEnhMetaRecord);
    //
    property BackgroundColor: TColor read GetBackgroundColor;
    property BackgroundMode: Integer read FBackgroundMode;
    property BaseWindowOrg: TPoint read FBaseWindowOrg;
    property GdiObjectList: TdxPSPDFMetaFileGdiObjectList read FGdiObjectList;
    property PatternColor: TColor read GetPatternColor;
    property Pen: TPen read FPen write SetPen;
    property ScaleDenumerator: Integer read FScaleDenumerator;
    property ScaleNumerator: Integer read FScaleNumerator;
    property TextColor: TColor read FTextColor;
  public
    constructor Create(APDFCanvas: TdxPSPDFReportRenderCanvas); virtual;
    destructor Destroy; override;
    procedure Render(AMetaFile: TMetafile; const R: TRect;
      AScaleNumerator, AScaleDenumerator: Integer); virtual;
    //
    property PDFCanvas: TdxPSPDFReportRenderCanvas read FPDFCanvas;
  end;

implementation

uses
  dxCore;

function EnhMetaFileProc(DC: HDC; ATable: PHandleTable;
  const ARecord: PEnhMetaRecord; AObjectsCount: Integer;
  AProvider: TdxPSPDFMetaFileExportProvider): Integer; stdcall;
begin
  AProvider.WriteMetaFileObject(ATable, AObjectsCount, ARecord);
  Result := 1;
end;

{ TdxPSPDFMetaFileExportProvider }

constructor TdxPSPDFMetaFileExportProvider.Create(APDFCanvas: TdxPSPDFReportRenderCanvas);
begin
  inherited Create;
  FPen := TPen.Create;
  FPDFCanvas := APDFCanvas;
  FGdiObjectList := TdxPSPDFMetaFileGdiObjectList.Create;
end;

destructor TdxPSPDFMetaFileExportProvider.Destroy;
begin
  FreeAndNil(FPen);
  FreeAndNil(FGdiObjectList);
  inherited Destroy;
end;

function TdxPSPDFMetaFileExportProvider.ConvertPoint(const P: TPoint): TPoint;
begin
  Result.X := ConvertValue(P.X);
  Result.Y := ConvertValue(P.Y);
end;

function TdxPSPDFMetaFileExportProvider.ConvertPoints(
  P: Pointer; ACount: Integer; AIsSmallPoints: Boolean): TPointArray;
const
  OffsetSizeMap: array[Boolean] of Integer = (SizeOf(TPoint), SizeOf(TSmallPoint));
var
  I: Integer;
begin
  SetLength(Result, ACount);
  for I := 0 to ACount - 1 do
  begin
    if AIsSmallPoints then
      Result[I] := ConvertPoint(SmallPointToPoint(PSmallPoint(P)^))
    else
      Result[I] := ConvertPoint(PPoint(P)^);
    Inc(Integer(P), OffsetSizeMap[AIsSmallPoints]);
  end;
end;

function TdxPSPDFMetaFileExportProvider.ConvertRect(const R: TRect): TRect;
begin
  Result.Top := ConvertValue(R.Top);
  Result.Left := ConvertValue(R.Left);
  Result.Right := ConvertValue(R.Right);
  Result.Bottom := ConvertValue(R.Bottom);
end;

function TdxPSPDFMetaFileExportProvider.ConvertRegion(ARegion: HRGN): TcxRegion;
var
  ARgnData: PRgnData;
  ARgnDataSize: Integer;
begin
  ARgnDataSize := GetRegionData(ARegion, 0, nil);
  ARgnData := AllocMem(ARgnDataSize);
  try
    if GetRegionData(ARegion, ARgnDataSize, ARgnData) <> 0 then
      Result := CreateRegion(ARgnData, ARgnDataSize)
    else
      Result := nil;
  finally
    FreeMem(ARgnData, ARgnDataSize);
  end;
end;

function TdxPSPDFMetaFileExportProvider.ConvertValue(AValue: Integer): Integer;
begin
  Result := MulDiv(AValue, ScaleNumerator, ScaleDenumerator);
end;

function TdxPSPDFMetaFileExportProvider.CreateRegion(
  ARgnData: PRgnData; ARgnDataSize: Integer): TcxRegion;
var
  ARgnRect: PRect;
  I: Integer;
  R: TRect;
begin
  Result := TcxRegion.Create(cxNullRect);
  ARgnRect := PRect(@ARgnData^.Buffer[0]);
  for I := 0 to ARgnData^.rdh.nCount - 1 do
  begin
    R := ConvertRect(ARgnRect^);
    Result.Combine(TcxRegion.Create(R), roAdd);
    Inc(ARgnRect);
  end;
end;

procedure TdxPSPDFMetaFileExportProvider.EmfAlphaBlend(const ARecord: PEMRAlphaBlend);
var
  ASourceBitmap, ABitmap: TcxBitmap;
  R: TRect;
begin
  ASourceBitmap := ExctractBitmap(ARecord,
    Bounds(ARecord^.xSrc, ARecord^.ySrc, ARecord^.cxSrc, ARecord^.cySrc),
    ARecord^.offBmiSrc, ARecord^.offBitsSrc);
  try
    ABitmap := TcxBitmap.CreateSize(ASourceBitmap.Width, ASourceBitmap.Height);
    try
      ABitmap.cxCanvas.FillRect(ABitmap.ClientRect, ARecord^.crBkColorSrc);
      if cxGetBitmapPixelFormat(ASourceBitmap) = 32 then
        cxAlphaBlend(ABitmap, ASourceBitmap, ABitmap.ClientRect, ASourceBitmap.ClientRect)
      else
      begin
        ASourceBitmap.Transparent := True;
        ABitmap.Canvas.Draw(0, 0, ASourceBitmap);
      end;
      R := Bounds(ARecord^.xDest, ARecord^.yDest, ARecord^.cxDest, ARecord^.cyDest);
      PDFCanvas.DrawPicture(ABitmap, ConvertRect(R), ppmStretch, PixelsNumerator, PixelsDenominator);
    finally
      ABitmap.Free;
    end;
  finally
    ASourceBitmap.Free;
  end;
end;

procedure TdxPSPDFMetaFileExportProvider.EmfBitBlt(const ARecord: PEMRBitBlt);
begin
  if ARecord.cbBitsSrc = 0 then
  begin
    PDFCanvas.FillRect(ConvertRect(
      Bounds(ARecord^.xDest, ARecord^.yDest, ARecord^.cxDest, ARecord^.cyDest)),
      PatternColor);
  end
  else
    DrawBitmap(
      Bounds(ARecord^.xDest, ARecord^.yDest, ARecord^.cxDest, ARecord^.cyDest),
      Bounds(ARecord^.xSrc, ARecord^.ySrc, ARecord^.cxDest, ARecord^.cxDest),
      ARecord, ARecord^.offBmiSrc, ARecord^.offBitsSrc);
end;

procedure TdxPSPDFMetaFileExportProvider.EmfCreateBrush(
  const ARecord: PEMRCreateBrushIndirect; ATable: PHandleTable);
begin
  ATable^.objectHandle[ARecord^.ihBrush] := GdiObjectList.CreateBrush(ARecord^.lb);
end;

procedure TdxPSPDFMetaFileExportProvider.EmfCreateFont(
  const ARecord: PEMRExtCreateFontIndirect; ATable: PHandleTable);
begin
  ATable^.objectHandle[ARecord^.ihFont] := GdiObjectList.CreateFont(ARecord^.elfw);
end;

procedure TdxPSPDFMetaFileExportProvider.EmfCreatePen(
  const ARecord: PEMRCreatePen; ATable: PHandleTable);
begin
  ATable^.objectHandle[ARecord^.ihPen] := GdiObjectList.CreatePen(ARecord^.lopn);
end;

procedure TdxPSPDFMetaFileExportProvider.EmfCreatePenEx(
  const ARecord: PEMRExtCreatePen; ATable: PHandleTable);
begin
  ATable^.objectHandle[ARecord^.ihPen] := GdiObjectList.CreatePenEx(ARecord^.elp);
end;

procedure TdxPSPDFMetaFileExportProvider.EmfDeleteObject(
  const ARecord: PEMRSelectObject; ATable: PHandleTable);
var
  AObject: TdxPSPDFMetaFileGdiObjectItem;
begin
  if GdiObjectList.FindObject(ATable^.ObjectHandle[ARecord^.ihObject], AObject) then
    GdiObjectList.Remove(AObject);
end;

procedure TdxPSPDFMetaFileExportProvider.EmfExtTextOut(
  const ARecord: PEMRExtTextOut; AIsUnicode: Boolean);

  function CalculateTextWidth(const ARecord: PEMRExtTextOut; const ATextInfo: TEMRText): Integer;
  var
    AOffsets: PInteger;
    I: Integer;
  begin
    Result := 0;
    if ATextInfo.offDx > 0 then
    begin
      AOffsets := PInteger(DWORD(ARecord) + ATextInfo.offDx);
      for I := 0 to ATextInfo.nChars - 1 do
      begin
        Inc(Result, AOffsets^);
        Inc(AOffsets);
      end;
    end;
  end;

  function CalculateTextRect(const ARecord: PEMRExtTextOut; const ATextInfo: TEMRText): TRect;
  begin
    Result := ARecord^.rclBounds;
    if (Result.Right < 0) and (Result.Bottom < 0) then
    begin
      Result := Bounds(0, 0, CalculateTextWidth(ARecord, ATextInfo), Abs(PDFCanvas.Font.Size));
      Result := cxRectOffset(Result, ATextInfo.ptlReference);
    end;
    Inc(Result.Bottom, Abs(PDFCanvas.Font.Size));
  end;

  function ExtractText(const ARecord: PEMRExtTextOut; const ATextInfo: TEMRText): WideString;
  var
    ATextA: AnsiString;
  begin
    if AIsUnicode then
      SetString(Result, PWideChar(DWORD(ARecord) + ATextInfo.offString), ATextInfo.nChars)
    else
    begin
      SetString(ATextA, PAnsiChar(DWORD(ARecord) + ATextInfo.offString), ATextInfo.nChars);
      Result := dxAnsiStringToWideString(ATextA,
        dxGetCodePageFromCharset(PDFCanvas.Font.Charset));
    end;
  end;

var
  ATextInfo: TEMRText;
  R: TRect;
begin
  if ARecord^.emrtext.nChars > 0 then
  begin
    ATextInfo := ARecord^.emrtext;
    R := cxRectOffset(ConvertRect(CalculateTextRect(ARecord, ATextInfo)), FInternalWindowOrg);
    PDFCanvas.DrawTextLine(R, R, cxRectWidth(R), ExtractText(ARecord, ATextInfo), TextColor);
  end;
end;

procedure TdxPSPDFMetaFileExportProvider.EmfEllipse(R: TRect);
begin
  R := ConvertRect(R);
  if BackgroundColor <> clNone then
    PDFCanvas.FillEllipse(R, BackgroundColor, TextColor, TdxPSSolidFillPattern, nil);
  PDFCanvas.DrawEllipseFrame(R, Pen.Color, ConvertValue(Pen.Width));
end;

procedure TdxPSPDFMetaFileExportProvider.EmfFillRgn(
  const ARecord: TEMRFillRgn; ATable: PHandleTable);
var
  AObject: TdxPSPDFMetaFileGdiObjectItem;
  ARegion: TcxRegion;
begin
  if GdiObjectList.FindObject(ATable^.ObjectHandle[ARecord.ihBrush], AObject) then
  begin
    ARegion := CreateRegion(@ARecord.RgnData[0], ARecord.cbRgnData);
    try
      PDFCanvas.FillRegion(ARegion.Handle, AObject.Color, clNone, TdxPSSolidFillPattern, nil);
    finally
      ARegion.Free;
    end;
  end;
end;

procedure TdxPSPDFMetaFileExportProvider.EmfExcludeClipRect(
  const ARecord: PEMRExcludeClipRect);
begin
  PDFCanvas.ExcludeClipRect(ConvertRect(ARecord^.rclClip));
end;

procedure TdxPSPDFMetaFileExportProvider.EmfIntersectClipRect(
  const ARecord: PEMRIntersectClipRect);
begin
  PDFCanvas.IntersectClipRgn(ConvertRect(ARecord^.rclClip));
end;

procedure TdxPSPDFMetaFileExportProvider.EmfLineTo(const ARecord: TEMRLineTo);
begin
  PDFCanvas.Polyline(
    [ConvertPoint(FMoveToPoint), ConvertPoint(ARecord.ptl)],
    Pen.Color, ConvertValue(Pen.Width));
  FMoveToPoint := ARecord.ptl;
end;

procedure TdxPSPDFMetaFileExportProvider.EmfMaskBlt(const ARecord: PEMRMaskBlt);

  function CreateMaskRegion(const AMaskSourceRect: TRect): TcxRegion;
  var
    AMaskBitmap: TcxBitmap;
    ARegion: HRGN;
  begin
    AMaskBitmap := ExctractBitmap(ARecord, AMaskSourceRect, ARecord^.offBmiMask, ARecord^.offBitsMask);
    try
      ARegion := cxCreateRegionFromBitmap(AMaskBitmap, clWhite);
      Result := ConvertRegion(ARegion);
      DeleteObject(ARegion);
    finally
      AMaskBitmap.Free;
    end;
  end;

var
  AMaskRegion: TcxRegion;
begin
  PDFCanvas.SaveClipRgn;
  try
    AMaskRegion := CreateMaskRegion(
      Bounds(ARecord^.xMask, ARecord^.yMask, ARecord^.cxDest, ARecord^.cyDest));
    if Assigned(AMaskRegion) then
    begin
      AMaskRegion.Offset(ConvertPoint(Point(ARecord^.xDest, ARecord^.yDest)));
      AMaskRegion.Offset(cxPointInvert(PDFCanvas.WindowOrg));
      PDFCanvas.Region.Combine(AMaskRegion, roIntersect);
    end;
    DrawBitmap(
      Bounds(ARecord^.xDest, ARecord^.yDest, ARecord^.cxDest, ARecord^.cyDest),
      cxInvalidRect, ARecord, ARecord^.offBmiSrc, ARecord^.offBitsSrc);
  finally
    PDFCanvas.RestoreClipRgn;
  end;
end;

procedure TdxPSPDFMetaFileExportProvider.EmfPaintRgn(const ARecord: EMRPaintRgn);
var
  ARegion: TcxRegion;
begin
  if BackgroundColor <> clNone then
  begin
    ARegion := CreateRegion(@ARecord.RgnData[0], ARecord.cbRgnData);
    try
      PDFCanvas.FillRegion(ARegion.Handle, BackgroundColor, clNone,
        TdxPSSolidFillPattern, nil);
    finally
      ARegion.Free;
    end;
  end;
end;

procedure TdxPSPDFMetaFileExportProvider.EmfPolyline(const APolyline: TEMRPolyline);
begin
  PDFCanvas.Polyline(
    ConvertPoints(@APolyLine.aptl[0], APolyLine.cptl, False),
    Pen.Color, ConvertValue(Pen.Width));
end;

procedure TdxPSPDFMetaFileExportProvider.EmfPolyline16(const APolyline: TEMRPolyline16);
begin
  PDFCanvas.Polyline(
    ConvertPoints(@APolyLine.apts[0], APolyLine.cpts, True),
    Pen.Color, ConvertValue(Pen.Width));
end;

procedure TdxPSPDFMetaFileExportProvider.EmfPie(
  const ARecord: EMRPie; ATable: PHandleTable);
begin
  PDFCanvas.Pie(ConvertRect(ARecord.rclBox),
    ConvertPoint(ARecord.ptlStart), ConvertPoint(ARecord.ptlEnd));
end;

procedure TdxPSPDFMetaFileExportProvider.EmfPolygon(const APolygon: TEMRPolyline);
begin
  PDFCanvas.Polygon(
    ConvertPoints(@APolygon.aptl[0], APolygon.cptl, True),
    Pen.Color, BackgroundColor, ConvertValue(Pen.Width));
end;

procedure TdxPSPDFMetaFileExportProvider.EmfPolygon16(const APolygon: TEMRPolyline16);
begin
  PDFCanvas.Polygon(
    ConvertPoints(@APolygon.apts[0], APolygon.cpts, True),
    Pen.Color, BackgroundColor, ConvertValue(Pen.Width));
end;

procedure TdxPSPDFMetaFileExportProvider.EmfRectangle(R: TRect);
begin
  R := ConvertRect(R); 
  if BackgroundColor <> clNone then
    PDFCanvas.FillRect(R, BackgroundColor);
  if BackgroundColor <> Pen.Color then
    PDFCanvas.DrawFrame(R, Pen.Color, Pen.Color, ConvertValue(Pen.Width));
end;

procedure TdxPSPDFMetaFileExportProvider.EmfRoundRect(R: TRect; ACorners: TSize);
begin
  R := ConvertRect(R);
  ACorners.cx := ConvertValue(ACorners.cx div 2);
  ACorners.cy := ConvertValue(ACorners.cy div 2);
  if BackgroundColor <> clNone then
  begin
    PDFCanvas.FillRoundRect(R, ACorners.cx, ACorners.cy, BackgroundColor,
      TextColor, TdxPSSolidFillPattern, nil);
  end;
  PDFCanvas.DrawRoundFrame(R, ACorners.cx, ACorners.cy,
    Pen.Color, ConvertValue(Pen.Width));
end;

procedure TdxPSPDFMetaFileExportProvider.EmfSelectClipRgn(
  const ARecord: PEMRExtSelectClipRgn);
var
  ARegion: TcxRegion;
begin
  if ARecord.cbRgnData = 0 then
    PDFCanvas.ResetPageRegion
  else
  begin
    ARegion := CreateRegion(@ARecord.RgnData[0], ARecord.cbRgnData);
    ARegion.Offset(cxPointInvert(BaseWindowOrg));
    PDFCanvas.Region.Combine(ARegion, roSet);
  end;
end;

procedure TdxPSPDFMetaFileExportProvider.EmfSelectObject(
  const ARecord: PEMRSelectObject; ATable: PHandleTable);
var
  AObject: TdxPSPDFMetaFileGdiObjectItem;
begin
  if GdiObjectList.FindObject(ATable^.ObjectHandle[ARecord^.ihObject], AObject) then
  begin
    if AObject.SourceObject is TBrush then
      PDFCanvas.Brush := TBrush(AObject.SourceObject);
    if AObject.SourceObject is TPen then
      Pen := TPen(AObject.SourceObject);
    if AObject.SourceObject is TFont then
    begin
      PDFCanvas.Font := TFont(AObject.SourceObject);
      PDFCanvas.Font.Size := ConvertValue(PDFCanvas.Font.Size);
    end;
  end;
end;

procedure TdxPSPDFMetaFileExportProvider.EmfSetPixel(const ARecord: TEMRSetPixelV);
var
  R: TRect;
begin
  R := Rect(ARecord.ptlPixel.X, ARecord.ptlPixel.Y,
    ARecord.ptlPixel.X + 1, ARecord.ptlPixel.Y + 1);
  PDFCanvas.FillRect(ConvertRect(R), ARecord.crColor);
end;

procedure TdxPSPDFMetaFileExportProvider.EmfSetWindowOrg(const ARecord: PEMRSetWindowOrgEx);
var
  P: TPoint;
begin
  P := ConvertPoint(ARecord^.ptlOrigin);
  FInternalWindowOrg := P;
  Inc(P.X, BaseWindowOrg.X);
  Inc(P.Y, BaseWindowOrg.Y);
  PDFCanvas.WindowOrg := P;
end;

procedure TdxPSPDFMetaFileExportProvider.EmfStretctBlt(const ARecord: PEMRStretchBlt);
begin
  if ARecord^.cbBitsSrc <> 0 then
  begin
    DrawBitmap(
      Bounds(ARecord^.xDest, ARecord^.yDest, ARecord^.cxDest, ARecord^.cyDest),
      Bounds(ARecord^.xSrc, ARecord^.ySrc, ARecord^.cxSrc, ARecord^.cySrc),
      ARecord, ARecord^.offBmiSrc, ARecord^.offBitsSrc);
  end;
end;

procedure TdxPSPDFMetaFileExportProvider.EmfStretctDIBits(const ARecord: PEMRStretchDIBits);
begin
  if ARecord^.cbBitsSrc <> 0 then
  begin
    DrawBitmap(
      Bounds(ARecord^.xDest, ARecord^.yDest, ARecord^.cxDest, ARecord^.cyDest),
      Bounds(ARecord^.xSrc, ARecord^.ySrc, ARecord^.cxSrc, ARecord^.cySrc),
      ARecord, ARecord^.offBmiSrc, ARecord^.offBitsSrc);
  end;
end;

function TdxPSPDFMetaFileExportProvider.ExctractBitmap(
  ARecordAddress: Pointer; ABitmapInfoOffset, ABitmapBitsOffset: Cardinal): TcxBitmap;

  function GetBitmapBitsSize(const AInfo: TBitmapInfo): Integer;
  begin
    with AInfo.bmiHeader do
      Result := biWidth * Abs(biHeight) * biBitCount div 8;
  end;

var
  ABits: Pointer;
  AInfo: PBitmapInfo;
begin
  Result := TcxBitmap.Create;
  AInfo := PBitmapInfo(DWORD(ARecordAddress) + ABitmapInfoOffset);
  Result.Handle := CreateDIBSection(cxScreenCanvas.Handle, AInfo^, DIB_RGB_COLORS, ABits, 0, 0);
  cxCopyData(Pointer(DWORD(ARecordAddress) + ABitmapBitsOffset), ABits, GetBitmapBitsSize(AInfo^));
end;

function TdxPSPDFMetaFileExportProvider.ExctractBitmap(
  ARecordAddress: Pointer; const R: TRect;
  ABitmapInfoOffset, ABitmapBitsOffset: Cardinal): TcxBitmap;
var
  ATempBitmap: TcxBitmap;
begin
  if cxRectIsEqual(R, cxInvalidRect) then
    Result := ExctractBitmap(ARecordAddress, ABitmapInfoOffset, ABitmapBitsOffset)
  else
  begin
    Result := TcxBitmap.CreateSize(R);
    ATempBitmap := ExctractBitmap(ARecordAddress, ABitmapInfoOffset, ABitmapBitsOffset);
    try
      Result.CopyBitmap(ATempBitmap, Result.ClientRect, R.TopLeft);
    finally
      ATempBitmap.Free;
    end;
  end;
end;

procedure TdxPSPDFMetaFileExportProvider.DrawBitmap(
  const ADest, ASource: TRect; ARecordAddress: Pointer;
  ABitmapInfoOffset, ABitmapBitsOffset: Cardinal);
var
  ABitmap: TcxBitmap;
begin
  ABitmap := ExctractBitmap(ARecordAddress, ASource, ABitmapInfoOffset, ABitmapBitsOffset);
  try
    PDFCanvas.DrawPicture(ABitmap, ConvertRect(ADest),
      ppmStretch, PixelsNumerator, PixelsDenominator)
  finally
    ABitmap.Free;
  end;
end;

function TdxPSPDFMetaFileExportProvider.GetBackgroundColor: TColor;
begin
  if BackgroundMode = TRANSPARENT then
    Result := clNone
  else
    Result := PDFCanvas.Brush.Color;
end;

function TdxPSPDFMetaFileExportProvider.GetPatternColor: TColor;
begin
  Result := BackgroundColor;
  if Result = clNone then
    Result := TextColor;
end;

procedure TdxPSPDFMetaFileExportProvider.SetPen(AValue: TPen);
begin
  FPen.Assign(AValue);
end;

procedure TdxPSPDFMetaFileExportProvider.Render(AMetaFile: TMetafile;
  const R: TRect; AScaleNumerator, AScaleDenumerator: Integer); 
var
  ASavedWindowOrg: TPoint;
begin
  PDFCanvas.SaveState;
  ASavedWindowOrg := PDFCanvas.WindowOrg;
  try
    FBaseWindowOrg := Point(R.Left + ASavedWindowOrg.X, R.Top + ASavedWindowOrg.Y);
    FScaleNumerator := AScaleNumerator;
    FScaleDenumerator := AScaleDenumerator;
    PDFCanvas.WindowOrg := FBaseWindowOrg;
    EnumEnhMetaFile(0, AMetaFile.Handle, @EnhMetaFileProc, Self,
      Bounds(0, 0, AMetaFile.Width, AMetaFile.Height));
  finally
    PDFCanvas.WindowOrg := ASavedWindowOrg;
    PDFCanvas.RestoreState;
  end;
end;

procedure TdxPSPDFMetaFileExportProvider.WriteMetaFileObject(
  ATable: PHandleTable; AObjectsInTable: Integer; const ARecord: PEnhMetaRecord);
begin
  case ARecord^.iType of
    EMR_SAVEDC:
      PDFCanvas.SaveState;
    EMR_RESTOREDC:
      PDFCanvas.RestoreState;
    EMR_MASKBLT:
      EmfMaskBlt(PEMRMaskBlt(ARecord));
    EMR_BITBLT:
      EmfBitBlt(PEMRBitBlt(ARecord));
    EMR_STRETCHBLT:
      EmfStretctBlt(PEMRStretchBlt(ARecord));
    EMR_STRETCHDIBITS:
      EmfStretctDIBits(PEMRStretchDiBits(ARecord));
    EMR_ELLIPSE:
      EmfEllipse(PEMREllipse(ARecord)^.rclBox);
    EMR_RECTANGLE:
      EmfRectangle(PEMRRectangle(ARecord)^.rclBox);
    EMR_POLYLINE:
      EmfPolyLine(PEMRPolyline(ARecord)^);
    EMR_POLYLINE16:
      EmfPolyLine16(PEMRPolyline16(ARecord)^);
    EMR_CREATEPEN:
      EmfCreatePen(PEMRCreatePen(ARecord), ATable);
    EMR_SETBKMODE:
      FBackgroundMode := PEMRSETBKMODE(ARecord)^.iMode;
    EMR_EXTSELECTCLIPRGN:
      EmfSelectClipRgn(PEMRExtSelectClipRgn(ARecord));
    EMR_SELECTOBJECT:
      EmfSelectObject(PEMRSelectObject(ARecord), ATable);
    EMR_DELETEOBJECT:
      EmfDeleteObject(PEMRDeleteObject(ARecord), ATable);
    EMR_SETBKCOLOR:
      FBackgroundColor := PEMRSETBKCOLOR(ARecord)^.crColor;
    EMR_SETTEXTCOLOR:
      FTextColor := PEMRSETTEXTCOLOR(ARecord)^.crColor;
    EMR_SETWINDOWORGEX:
      EmfSetWindowOrg(PEMRSETWINDOWORGEX(ARecord));
    EMR_EXCLUDECLIPRECT:
      EmfExcludeClipRect(PEMREXCLUDECLIPRECT(ARecord));
    EMR_INTERSECTCLIPRECT:
      EmfIntersectClipRect(PEMRINTERSECTCLIPRECT(ARecord));
    EMR_CREATEBRUSHINDIRECT:
      EmfCreateBrush(PEMRCreateBrushIndirect(ARecord), ATable);
    EMR_EXTCREATEFONTINDIRECTW:
      EmfCreateFont(PEMRExtCreateFontIndirect(ARecord), ATable);
    EMR_EXTCREATEPEN:
      EmfCreatePenEx(PEMRExtCreatePen(ARecord), ATable);
    EMR_EXTTEXTOUTW, EMR_EXTTEXTOUTA:
      EmfExtTextOut(PEMRExtTextOut(ARecord), ARecord^.iType = EMR_EXTTEXTOUTW);
    EMR_ROUNDRECT:
      EmfRoundRect(PEMRRoundRect(ARecord)^.rclBox, PEMRRoundRect(ARecord)^.szlCorner);
    EMR_POLYGON:
      EmfPolygon(PEMRPolyline(ARecord)^);
    EMR_POLYGON16:
      EmfPolygon16(PEMRPolyline16(ARecord)^);
    EMR_SETPIXELV:
      EmfSetPixel(PEMRSetPixelV(ARecord)^);
    EMR_MOVETOEX:
      FMoveToPoint := PEMRMoveToEx(ARecord)^.ptl;
    EMR_LINETO:
      EmfLineTo(PEMRLineTo(ARecord)^);
    EMR_PAINTRGN:
      EmfPaintRgn(PEMRPaintRgn(ARecord)^);
    EMR_FILLRGN:
      EmfFillRgn(PEMRFillRgn(ARecord)^, ATable);
    EMR_PIE:
      EmfPie(PEMRPie(ARecord)^, ATable);
    EMR_OFFSETCLIPRGN:
      with ConvertPoint(PEMROffsetClipRgn(ARecord)^.ptlOffset) do
        PDFCanvas.Region.Offset(X, Y);
    EMR_ALPHABLEND:
      EmfAlphaBlend(PEMRAlphaBlend(ARecord));
  end;
end;

{ TdxPSPDFMetaFileGdiObjectList }

function TdxPSPDFMetaFileGdiObjectList.CreateBrush(const ABrushInfo: TLogBrush): HBRUSH;
var
  ABrush: TBrush;
begin
  ABrush := TBrush.Create;
  ABrush.Handle := CreateBrushIndirect(ABrushInfo);
  Add(TdxPSPDFMetaFileGdiObjectItem.Create(ABrush.Handle, ABrush, ABrushInfo.lbColor));
  Result := ABrush.Handle;
end;

function TdxPSPDFMetaFileGdiObjectList.CreateFont(const AFontInfo: EXTLOGFONTW): HFONT;
var
  AFont: TFont;
begin
  AFont := TFont.Create;
  AFont.Handle := CreateFontIndirectW(AFontInfo.elfLogFont);
  Add(TdxPSPDFMetaFileGdiObjectItem.Create(AFont.Handle, AFont, clDefault));
  Result := AFont.Handle;
end;

function TdxPSPDFMetaFileGdiObjectList.CreatePen(const APenInfo: TLogPen): HPEN;
var
  APen: TPen;
begin
  APen := TPen.Create;
  APen.Color := APenInfo.lopnColor;
  APen.Width := APenInfo.lopnWidth.X;
  Add(TdxPSPDFMetaFileGdiObjectItem.Create(APen.Handle, APen, APenInfo.lopnColor));
  Result := APen.Handle;  
end;

function TdxPSPDFMetaFileGdiObjectList.CreatePenEx(const APenInfo: TExtLogPen): HPEN;
var
  ABrushInfo: TLogBrush;
  APen: TPen;
begin
  APen := TPen.Create;
  ZeroMemory(@ABrushInfo, SizeOf(ABrushInfo));
  ABrushInfo.lbStyle := APenInfo.elpBrushStyle;
  ABrushInfo.lbColor := APenInfo.elpColor;
  ABrushInfo.lbHatch := APenInfo.elpHatch;
  APen.Handle := ExtCreatePen(APenInfo.elpPenStyle, APenInfo.elpWidth,
    ABrushInfo, APenInfo.elpNumEntries, @APenInfo.elpStyleEntry[0]);
  Add(TdxPSPDFMetaFileGdiObjectItem.Create(APen.Handle, APen, APenInfo.elpColor));
  Result := APen.Handle;
end;

function TdxPSPDFMetaFileGdiObjectList.FindObject(
  AHandle: THandle; var AObject: TdxPSPDFMetaFileGdiObjectItem): Boolean;
var
  I: Integer;
begin
  AObject := nil;
  for I := 0 to Count - 1 do
  begin
    Result := Items[I].Handle = AHandle;
    if Result then
    begin
      AObject := Items[I];
      Break;
    end;
  end;
  Result := Assigned(AObject);
end;

function TdxPSPDFMetaFileGdiObjectList.GetItem(
  Index: Integer): TdxPSPDFMetaFileGdiObjectItem;
begin
  Result := TdxPSPDFMetaFileGdiObjectItem(inherited Items[Index]);
end;

procedure TdxPSPDFMetaFileGdiObjectList.Notify(Ptr: Pointer; Action: TListNotification);
begin
  inherited Notify(Ptr, Action);
  if Assigned(Ptr) and (Action = lnDeleted) then
    TObject(Ptr).Free;
end;

{ TdxPSPDFMetaFileGdiObjectItem }

constructor TdxPSPDFMetaFileGdiObjectItem.Create(
  AHandle: THandle; ASourceObject: TObject; AColor: TColor);
begin
  inherited Create;
  FHandle := AHandle;
  FSourceObject := ASourceObject;
  FColor := AColor;
end;

destructor TdxPSPDFMetaFileGdiObjectItem.Destroy;
begin
  FreeAndNil(FSourceObject);
  inherited Destroy;
end;

end.