Date: Fri, 10 Dec 1999 14:25:49 +0100
From: Freddy Darsonville <fd@jmbs-soft.com>
To: "Earl F. Glynn", ee@jmbs-soft.com
Subject: rotating a metafile...
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

Hello Earl,

thanks for your response to Emmanuel Etasse. I work with him, and in
fact, it's me who is concerned by the problem of rotating a metafile....

First, Id'like to congratulate you for your marvelous Web site (efg2). I
known it (and practice it) since many months !!!
I've got a PhD in 3D graphic vizualization and image processing, and I
miss not to have known your site earlier...It brings together lots of
interessant algorithms, which are sometime "classic" but always painful
to redevelop...

I can bring you my modest (and not yet finished, nor completed...)
contribution to the problem :

I've tryed to replay all the metafile records, as promoted by Borland
(In fact, there is no other solution to do !).
I've not implemented all the record cases, just them I use for my
application. If someone can complete my work, I would be very grateful
to him !

here is my code :
you can notice that I use one of your library (flipReverseRotateLibrary)
for rotating the BitBlt record (which is not debugged because I don't
use it...).

Please note that I've witten 2 functions :
one for NT which works perfectly (based on the SetWorldTransform API
function) : function NTRotateMetafile(TheMeta : HENHMETAFILE;
w,h:integer) : TMetafile;

the other for 95....

Freddy Darsonville


/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

unit libmeta;

interface
{$R-}
uses
    Windows, Classes,math, Graphics, FlipReverseRotateLibrary,SysUtils;

type
    PDWORD = ^DWORD;

  {the callback function for enumerating enhanced metafile records}
function RotateLeftRecords(DisplaySurface: HDC;    var MetafileTable:
THandleTable;    var MetafileRecord: TEnhMetaRecord; ObjectCount:
Integer;    var Data: Longint): Integer; stdcall;

  {the metafile records I've done}
procedure RotateLeftLINETO(var rec: TEnhMetaRecord; dc: HDC; width:
integer); stdcall;
procedure RotateLeftMOVETOEX(var rec: TEnhMetaRecord; dc: HDC; width:
integer); stdcall;
procedure RotateLeftEXTTEXTOUTW(var rec: TEnhMetaRecord; dc: HDC; width:
integer); stdcall;
procedure RotateLeftEXTCREATEFONTINDIRECTW(var rec: TEnhMetaRecord; dc:
HDC; width: integer); stdcall;
procedure RotateLeftRECTANGLE(var rec: TEnhMetaRecord; dc: HDC; width:
integer); stdcall;
procedure RotateLeftPOLYLINE(var rec: TEnhMetaRecord; dc: HDC; width:
integer); stdcall;
procedure RotateLeftPOLYGON(var rec: TEnhMetaRecord; dc: HDC; width:
integer); stdcall;
procedure RotateLeftPOLYLINE16(var rec: TEnhMetaRecord; dc: HDC; width:
integer); stdcall;
procedure RotateLeftPOLYGON16(var rec: TEnhMetaRecord; dc: HDC; width:
integer); stdcall;
procedure RotateLeftBITBLT(var rec: TEnhMetaRecord; dc: HDC; width:
integer); stdcall;
procedure RotateLeftEXTSELECTCLIPRGN(var rec: TEnhMetaRecord; dc: HDC;
width: integer); stdcall;

  {the other !!!!}
procedure ToDo(var rec: TEnhMetaRecord; dc: HDC; width: integer);
stdcall;


function RotateMetafile(TheMeta : HENHMETAFILE; w,h:integer) :
TMetafile;
function NTRotateMetafile(TheMeta : HENHMETAFILE; w,h:integer) :
TMetafile;



implementation

uses dialogs;

var
    fdc: HFONT; //local but necessary


function RotateLeftRecords(DisplaySurface: HDC;
    var MetafileTable: THandleTable;
    var MetafileRecord: TEnhMetaRecord;
    ObjectCount: Integer;
    var Data: Longint): Integer;
begin
    case MetafileRecord.iType of
        EMR_LINETO: RotateLeftLINETO(MetafileRecord, displaySurface,
data);
        EMR_MOVETOEX: RotateLeftMOVETOEX(MetafileRecord, displaySurface,
data);
        EMR_EXTTEXTOUTW: RotateLeftEXTTEXTOUTW(MetafileRecord,
displaySurface, data);
        EMR_EXTCREATEFONTINDIRECTW:
RotateLeftEXTCREATEFONTINDIRECTW(MetafileRecord, displaySurface, data);
        EMR_RECTANGLE: RotateLeftRECTANGLE(MetafileRecord,
displaySurface, data);
        EMR_POLYLINE: RotateLeftPOLYLINE(MetafileRecord, displaySurface,
data);
        EMR_POLYGON: RotateLeftPOLYGON(MetafileRecord, displaySurface,
data);
        EMR_POLYLINE16: RotateLeftPOLYLINE16(MetafileRecord,
displaySurface, data);
        EMR_POLYGON16: RotateLeftPOLYGON16(MetafileRecord,
displaySurface, data);
        EMR_EXTSELECTCLIPRGN: RotateLeftEXTSELECTCLIPRGN(MetafileRecord,
displaySurface, data);
        EMR_FILLRGN:Todo(MetafileRecord, displaySurface, data);
        EMR_FRAMERGN:Todo(MetafileRecord, displaySurface, data);
        EMR_INVERTRGN:Todo(MetafileRecord, displaySurface, data);
        EMR_PAINTRGN:Todo(MetafileRecord, displaySurface, data);
        EMR_STRETCHBLT:Todo(MetafileRecord, displaySurface, data);
        EMR_MASKBLT:Todo(MetafileRecord, displaySurface, data);
        EMR_PLGBLT:Todo(MetafileRecord, displaySurface, data);
        EMR_SETDIBITSTODEVICE:Todo(MetafileRecord, displaySurface,
data);
        EMR_STRETCHDIBITS : Todo(MetafileRecord, displaySurface, data);

//        EMR_BITBLT:Todo(MetafileRecord, displaySurface, data);
//        EMR_SETMETARGN: Todo(MetafileRecord, displaySurface, data);
    else
        PlayEnhMetaFileRecord(DisplaySurface, MetafileTable,
MetafileRecord, ObjectCount);
    end;

    Result := 1; // continue enumeration
end;

procedure RotateLeftLINETO(var rec: TEnhMetaRecord; dc: HDC; width:
longint);
var
    p: PEMRLineTo;
begin
    p := PEMRLineTo(@rec);
    lineto(dc, width - p.ptl.y, p.ptl.x);
end;

procedure RotateLeftMOVETOEX(var rec: TEnhMetaRecord; dc: HDC; width:
longint);
var
    p: PEMRMoveToEx;
begin
    p := PEMRMoveToEx(@rec);
    movetoex(dc, width - p.ptl.y, p.ptl.x, nil);
end;

procedure RotateLeftEXTTEXTOUTW(var rec: TEnhMetaRecord; dc: HDC; width:
longint);
var
    p: PEMRExtTextOut;
    ptext: PEMRText;
    R: TRect;
    text: PWideChar;


    LogRec: TLOGFONT; {* Storage area for font information *}
    hf: HFONT;
begin
    p := PEMRExtTextOut(@rec);
    ptext := PEMRText(@p.emrtext);


    text := PWideChar(DWORD(ptext) + ptext.offstring div 2 + 2);

    R := Rect(width - p.rclBounds.bottom, p.rclBounds.left, width -
p.rclBounds.top, p.rclBounds.right);

     SelectObject(dc, fdc);

    TextOutW(DC, width - p.emrtext.ptlReference.y,
p.emrtext.ptlReference.x, PWideCHAR(text), ptext.nChars);

end;

procedure RotateLeftEXTCREATEFONTINDIRECTW(var rec: TEnhMetaRecord; dc:
HDC; width: longint);
var
    p: PEMRExtCreateFontIndirect;
    logf: TLOGFONTW;
    res : boolean;
begin
    p := PEMRExtCreateFontIndirect(@rec);
    logf := p.elfw.elfLogFont;
    logf.lfEscapement := logf.lfEscapement + 2700;
    logf.lfOrientation := logf.lfEscapement;

    fdc := CreateFontIndirectW(logf);
    SelectObject(DC,fdc);
end;

procedure RotateLeftRECTANGLE(var rec: TEnhMetaRecord; dc: HDC; width:
integer);
var
    p: PEMRRectangle;
begin
    p := PEMRRectangle(@rec);
    rectangle(dc, width - p.rclBox.top, p.rclBox.left, width -
p.rclBox.bottom, p.rclBox.right);
end;

procedure RotateLeftPOLYLINE(var rec: TEnhMetaRecord; dc: HDC; width:
integer);
var
    p: PEMRPolyline;
    i: integer;
    ar: array[0..200] of TPoint;
    nb: integer;
begin
    p := PEMRPolyline(@rec);
    nb := p.cptl;

    for i := 0 to nb - 1 do
        ar[i] := Point(width - p.aptl[i].y, p.aptl[i].x);
    polyline(dc, ar, nb);
end;



procedure RotateLeftPOLYGON(var rec: TEnhMetaRecord; dc: HDC; width:
integer);
var
    p: PEMRPolygon;
    i: integer;
    ar: array[0..200] of TPoint;
    nb: integer;
begin
    p := PEMRPolygon(@rec);
    nb := p.cptl;

    for i := 0 to nb - 1 do
        ar[i] := Point(width - p.aptl[i].y, p.aptl[i].x);
    polygon(dc, ar, nb);
end;

procedure RotateLeftPOLYLINE16(var rec: TEnhMetaRecord; dc: HDC; width:
integer);
var
    p: PEMRPolyline16;
    i: integer;
    ar: array[0..200] of TPoint;
    nb: integer;
begin
    p := PEMRPolyline16(@rec);
    nb := p.cpts;

    for i := 0 to nb - 1 do
        ar[i] := Point(width - p.apts[i].y, p.apts[i].x);
    polyline(dc, ar, nb);
end;



procedure RotateLeftPOLYGON16(var rec: TEnhMetaRecord; dc: HDC; width:
integer);
var
    p: PEMRPolygon16;
    i: integer;
    ar: array[0..200] of TPoint;
    nb: integer;
begin
    p := PEMRPolygon16(@rec);
    nb := p.cpts;

    for i := 0 to nb - 1 do
        ar[i] := Point(width - p.apts[i].y, p.apts[i].x);
    polygon(dc, ar, nb);
end;

procedure RotateLeftBITBLT(var rec: TEnhMetaRecord; dc: HDC; width:
integer); stdcall;
const
    MaxPixelCount = 65536; // or some other arbitrarily large value
type
    TRGBArray = array[0..MaxPixelCount - 1] of TRGBTriple;
    pRGBArray = ^TRGBArray;
var
    p: PEMRBitBlt;
    bmp, rotbmp: TBitmap;
    i, j: integer;
    RowIn, RowOut: pRGBArray;
    DWordWidth: integer;
begin
    p := PEMRBitBlt(@rec);
    bmp := TBitmap.Create;
    bmp.PixelFormat := pf24bit;
    bmp.Width := p.cxDest;
    bmp.Height := p.cyDest;

    DWordWidth := 4*bmp.Width;
    for j := 0 to bmp.Height - 1 do
    begin
        rowIn := Pointer(DWORD(@p) + p.offBitsSrc + j * DWordWidth);
        rowOut := bmp.ScanLine[j];

        // Could optimize the following by using a function like
CopyMemory
        // from the Windows unit.
        for i := 0 to bmp.Width - 1 do
        begin
          // Why does this crash with RowOut[i] := RowIn[i]?  Alignment?

          // Use this longer form as workaround.
            with rowOut[i] do
            begin
                rgbtRed := rowIn[i].rgbtRed;
                rgbtGreen := rowIn[i].rgbtGreen;
                rgbtBlue := rowIn[i].rgbtBlue;
            end
        end
    end {SimpleCopy};

    rotbmp := RotateScanLine90(90, bmp);
    bitblt(dc, width - p.yDest, p.xDest, p.cyDest, p.cxDest,
rotbmp.Canvas.Handle, 0, 0, p.dwRop);
end;



procedure RotateLeftEXTSELECTCLIPRGN(var rec: TEnhMetaRecord; dc: HDC;
width: integer); stdcall;
var
    p: PEMRExtSelectClipRgn;
    rdh : TRgnDataHeader;
    prdh : pRgnDataHeader;
    rect : TRect;
    hrgn : integer;
begin
try
    p := PEMRExtSelectClipRgn(@rec);

    pRdh := pRgnDataHeader(@p.RgnData);
    rdh := tRgnDataHeader(prdh^);
    rect := rdh.rcBound ;
    hrgn := CreateRectRgn(Width - rect.Top , rect.Left , Width -
rect.Bottom , rect.Right );
    ExtSelectClipRgn(dc,hrgn,rdh.iType );
except
     ShowMessage('RotateLeftEXTSELECTCLIPRGN failed');
end;
end;

procedure ToDo(var rec: TEnhMetaRecord; dc: HDC; width: integer);
stdcall;
begin
     assert(False,'This type of metafile record is not supported :
'+IntToStr(rec.iType ));
end;



function RotateMetafile(TheMeta : HENHMETAFILE; w,h:integer) :
TMetafile;
var
    buf: TEnhMetaHeader;
    thewidth: longint;
    meta, meta2: TMetafile;
    metaCanvas, metacanvas2: TMetafileCanvas;
    R: TRect;
    hregion:    HRGN;
begin


    GetEnhMetaFileHeader(TheMeta, sizeof(TEnhMetaHeader), @buf);


   {enumerate the records in the metafile}
    meta := TMetafile.Create;
    meta.Enhanced := True;
    meta2 := TMetafile.Create;
    meta2.Enhanced := True;
    meta2.Height :=(buf.rclBounds.Right - buf.rclBounds.left) ;
    meta2.Width :=(buf.rclBounds.Bottom  - buf.rclBounds.Top);

  //  GetClipRgn (theMeta, hregion);
  //  GetrgnBox(hregion, R);


    thewidth :=  buf.rclBounds.Bottom  - buf.rclBounds.top; //0

    metaCanvas := TMetafileCanvas.Create(meta, 0);
    metaCanvas2 := TMetafileCanvas.Create(meta2, 0);


    EnumEnhMetaFile(metaCanvas.Handle, TheMeta, @RotateLeftRecords,
        @thewidth, buf.rclBounds);
    metaCanvas.free;

    GetEnhMetaFileHeader(meta.Handle, sizeof(TEnhMetaHeader), @buf);
    metacanvas2.Draw(-buf.rclBounds.Left, -buf.rclBounds.top, meta);
    metaCanvas2.free;


    meta.free;
    result := meta2;
end;

function NTRotateMetafile(TheMeta : HENHMETAFILE; w,h:integer) :
TMetafile;
var
    buf: TEnhMetaHeader;
    meta: TMetafile;
    metaCanvas: TMetafileCanvas;
    R: TRect;
    hregion:    HRGN;
       mat : XForm;
begin
    GetEnhMetaFileHeader(TheMeta, sizeof(TEnhMetaHeader), @buf);

   {enumerate the records in the metafile}
    meta := TMetafile.Create;
    metaCanvas := TMetafileCanvas.Create(meta, 0);
    meta.Enhanced := True;
    meta.Height :=w;
    meta.Width :=h;

    SetGraphicsMode(metaCanvas.Handle,GM_ADVANCED);

    mat.eM11 := 0;
    mat.eM12 := 1;
    mat.eM21 := -1;
    mat.eM22 := 0;
    mat.eDx := (buf.rclBounds.Bottom  - buf.rclBounds.Top);
    mat.eDy :=0;

    SetWorldTransform(metaCanvas.Handle,mat);
    PlayEnhMetaFile (metaCanvas.Handle,TheMeta  , rect(0,0,w,h) );

    metaCanvas.free;
    result := meta;
end;

end.