Mirror

Duplicate a metafile without the fill color of the original (Views: 100)


Problem/Question/Abstract:

I have a TMetafile that is created drawing to a TMetafileCanvas. There are various polygons that are drawn using a solid brush style and a grey fill color (red outline). Some of the time I would like to duplicate the metafile but have no fill color (ie just red outlines). But I want to keep it as a metafile and not have to regenerate the original with no fill. I've been looking into changing the palette color, but the metafile does not seem to have any palette entries. Anyone have any ideas?

Answer:

Solve 1:

function unfilledMetafile(const in_metafile: TMetafile): TMetafile;
var
  metaHeaderSize: DWORD;
  metaHeader: PEnhMetaHeader;
  data: PByteArray;
  metaRec: PEMR;
  brushRec: PEMRCreateBrushIndirect;
  i: cardinal;
  {Debug, copy to clipboard
  MyFormat: Word;
  AData: Cardinal;
  APalette: HPALETTE; }
begin
  {Get the header}
  metaHeaderSize := GetEnhMetaFileHeader(in_metafile.Handle, 0, nil);
  if (metaHeaderSize > 0) then
  begin
    GetMem(metaHeader, metaHeaderSize);
    try
      GetEnhMetaFileHeader(in_metafile.Handle, metaHeaderSize, metaHeader);
      GetMem(data, metaHeader^.nBytes);
      ZeroMemory(data, metaHeader^.nBytes);
      try
        GetEnhMetaFileBits(in_metafile.Handle, metaHeader^.nBytes, @(data^[0]));
        {Go through the metafile and update brushes to unfilled}
        i := metaHeaderSize;
        while (i < metaHeader^.nBytes) do
        begin
          {Get record info}
          metaRec := PEMR(@(data^[i]));
          if (metaRec^.itype = EMR_CREATEBRUSHINDIRECT) then
          begin
            brushRec := PEMRCreateBrushIndirect(metaRec);
            brushRec^.lb.lbStyle := BS_HOLLOW;
          end;
          Inc(i, metaRec^.nSize);
        end;
        {Put the data into a new metafile}
        Result := TMetafile.Create();
        Result.Handle := SetEnhMetaFileBits(metaHeader^.nBytes, PChar(data));
      finally
        FreeMem(data, metaHeader^.nBytes);
      end;
    finally
      FreeMem(metaHeader, metaHeaderSize);
    end;
  end
  else
  begin
    raise Exception.Create('Unable to create unfilled metafile');
  end;
  {Debug, copy to clipboard
  Result.SaveToClipboardFormat(MyFormat, AData, APalette);
  ClipBoard.SetAsHandle(MyFormat, AData); }
end;


Solve 2:

The "callback" function:

function EnhMetaFileProc(DC: HDC; {handle to device context}
  lpHTable: PHANDLETABLE; {Pointer to metafile handle table}
  lpEMFR: PENHMETARECORD; {Pointer to metafile record}
  nObj: Integer; {Count of objects}
  aCanvas: TCanvas): Integer; stdcall;
var
  tmpPen, OldPen: HPen;
  tmpBrush, OldBrush: HBrush;
begin
  aCanvas.Pen.Color := clBlack;
  tmpPen := aCanvas.Pen.Handle;
  aCanvas.Brush.Style := bsClear
    tmpBrush := aCanvas.Brush.Handle;
  OldPen := SelectObject(aCanvas.Handle, tmpPen);
  OldBrush := SelectObject(aCanvas.Handle, tmpBrush);
  {Draw the metafile record}
  PlayEnhMetaFileRecord(dc, lpHTable^, lpEMFR^, nObj);
  SelectObject(aCanvas.Handle, OldPen);
  SelectObject(aCanvas.Handle, OldBrush);
  {Set to zero to stop metafile enumeration}
  Result := 1;
end;

And then, you draw it using EnumEnhMetafile with the callback:

EnumEnhMetaFile(Canvas.Handle, FWMFImage.Handle, @EnhMetaFileProc, Canvas, tmpRect);

<< Back to main page