{****************************************************************************}
{Unit VNM_WMF - it is a addon unit for graphics library VenomGFX.            }
{It brings a loader for .WMF graphics files                                  }
{   It defines function Load_WMF                                             }
{      written by BearWindows, adjusted by Laaca                             }
{****************************************************************************}

unit VNM_WMF;
{$IFDEF VER2}{$DEFINE NEWFPC}{$ENDIF}
{$IFDEF VER3}{$DEFINE NEWFPC}{$ENDIF}
{$IFDEF NEWFPC}{$CALLING OLDFPCCALL}{$ENDIF}

{$IFDEF DEBUG}
{$DEFINE WMF_DEBUG}
{$ENDIF}

interface
Uses VenomGFX;


Function Load_WMF(s:string;var dest:VirtualWindow):longint;
{Dest must be already defined! (Because we use the DEST dimensions)}

Function DirtyLoad_WMF(s:string;var dest:VirtualWindow):byte;
{Here DEST is not defined and is initialized at run-time. This variant
 should be used only internaly when used via Load_Image function.
 DEST will be initialized for dimension 320x200}

implementation
uses GrpFile,VenomMng,objects,TinyDbg;

Const

{konstanty vyplni prevzate z jednotky Graph}
EmptyFill     = 0; {vybarvi barvou pozadi}
SolidFill     = 1; {plosne vybarvovani}
LineFill      = 2; {styl ---}
LtSlashFill   = 3; {styl ///}
SlashFill     = 4; {styl /// tucne}
BkSlashFill   = 5; {styl \\\ tucne}
LtBkSlashFill = 6; {styl \\\}
HatchFill     = 7; {ctverecky}
xHatchFill    = 8; {ctverecky nasikmo}
InterleaveFill= 9; {interleaving line}
WideDotFill   = 10;{tecky ridce}
CloseDotFill  = 11;{tecky huste}
UserFill      = 12;{uzivatelsky definovane}

{konstanty rezu pisem prevzate z jednotky Graph}
DefaultFont   = 0;
TriplexFont   = 1;
SmallFont     = 2;
SansSerifFont = 3;
GothicFont    = 4;

TOOL_NIC              = 0;
TOOL_CARA             = 1;
TOOL_VYPLN            = 2;
TOOL_PALETA           = 3;
TOOL_FONT             = 4;
TOOL_NEIMPLEMENTOVANO = 5;


PARAMETR_KULATOSTI_ROHU = 6;
MAX_HRAN = 15000;
MAX_POLYGON = 15000;
MAX_TOOL = 2000;
VELIKOST_BAREVNE_PALETY=256;
BAJTU_PAMETI_NA_FILLED_POLYGON_BUFFER = 256000;

type
   RGBQuad = packed Record Rd, Gr, Bl, Rs : Byte;End;
   BGRQuad = packed Record Rs, Bl, Gr, Rd : Byte;end;
   MFRect = packed Record bottom, right, top, left : smallint;End;
   TRect = packed Record left, top, right, bottom : smallint;End;
   TArcRec = packed Record sy,sx,ey,ex:smallint;end;

   Bod = packed record x,y:smallint;end;

   mfHeader = packed Record
      mtType : Word;
      mtHeaderSize : Word;  {zde v BAJTECH, ale v souboru ulozeno ve WORDech}
      mtVersion : Word;
      mtSize : LongInt;     {zde v BAJTECH, ale v souboru ulozeno ve WORDech}
      mtNoObjects : Word;   {pocet objektu}
      mtMaxRecord : LongInt;{velikost nejvetsiho zaznamu v souboru (zde v bajtech)}
      mtNoParameters : Word;{ma byt 0}
      End;

   AldusmfHeader = packed Record
      key : LongInt;
      hmf : Word;
      bbox : TRect;
      inch : Word;
      reserved : LongInt;
      checksum : Word;
      End;

   MetaRecord = packed Record
      rdSize : LongInt;   {budeme ukladat v bajtech, i kdyz v souboru jsou zde wordy}
      rdFunction : Word;
      rdParm : Array[0..32000] Of Word;
      End;


   PPaleta = ^TPaleta;
    TPaleta = record
       poc_barev:byte;
       barva:array[0..VELIKOST_BAREVNE_PALETY-1] of word;
       end;


   {PolygonType = Array[1..10000] Of PointType;}


    ToolType = array[0..MAX_TOOL] of record
         typ:byte;
         case typ_kreslitka:byte of
           TOOL_CARA   :(cara_sire,cara_styl,cara_barva:word);
           TOOL_VYPLN  :(vypln_styl,vypln_barva:word);
           TOOL_PALETA :(paleta:PPaleta);
           TOOL_FONT   :(fstyle:word);
         end;

    xy_dimType = record
        xWO, yWO:smallint;
        xWE, yWE:smallint;
        xF, yF:smallint;

        yD:smallint;
        xVE:smallint;
        yVE:smallint;
        end;



var  {Ted nejake globalni promenne}
ukazatel_na_puvodni_buffer_pro_filled_polygon:pointer;
wmf_buffer_pro_filled_polygon:pointer;





const HexDigits:array[0..15] of char = '0123456789ABCDEF';

{============================================================================}
function MyStrW (Cislo: word): string;
{ €¡slo --> ©etˆzec }
var
  Vysledek : string;
begin { MyStr }
  Str (Cislo, Vysledek);
  MyStrW := Vysledek;
end;  { MyStr }


Function SwapString(s:string):string;
var a,b:byte;
      t:string;
begin
a:=Length(s);
t:='';
for b:=a downto 1 do t:=t+s[b];
SwapString:=t;
end;



Function HexStr(l:longint):string;
var a:longint;
    s:string;
begin
s:='';
a:=0;
repeat
s:=s+HexDigits[l and 15];
l:=l div 16;
inc(a);
until l=0;
HexStr:=SwapString(s);
end;



Function ReadStream(strm:pstream;var Buf; Count:longint):longint;
var l:longint;
begin
l:=strm^.GetPos;
strm^.Read(buf,count);
if strm^.status<>stOK then
   begin
   strm^.reset;
   l:=strm^.GetSize-l;
   strm^.Read(buf,l);
   end else l:=count;
ReadStream:=l;
end;

{============================================================================}


Function Read_Placeable_header(var mystrm:pstream;var bbox:TRect):longint;
var rs:longint;
    mfAHdr:AldusmfHeader;
    bas_head_pos:longint;

begin
FillChar(bbox,sizeOf(TRect),0);
bas_head_pos:=-1;

mystrm^.seek(0);
rs:=ReadStream(mystrm,mfAHdr,SizeOf(AldusmfHeader));
if rs=SizeOf(AldusmfHeader) then
   begin
   bas_head_pos:=22;
   bbox:=mfAHdr.bbox;
   end;
Read_Placeable_header:=bas_head_pos;
end;


Procedure Inicializace_Tools(var tool:ToolType);
begin
FillChar(Tool,sizeof(ToolType),0);
end;


Procedure InicializaceSouradnicovehoSystemu(var dest:VirtualWindow; var bbox:TRect;var xy_dim:xy_dimType);
var yVEreal:real;
begin
with bbox do
  begin
  top:=-1;left:=-1;right:=-1;bottom:=-1;
  end;

with xy_dim do
  begin
  yWE:=1;
  xWE:=1;
  xWO:=0;
  yWO:=0;

  yF:=1;
  xF:=1;

  yD:=dest.hoehe;
  xVE:=dest.breite;

  yVEreal:=xVE;
  if vga.segment=0
     then yVEreal:=yVEreal * 3 / 4                   {pomer obrazovky?}
     else yVEreal:=yVEreal * vga.hoehe / vga.breite;
  yVE:=round(yVEreal);
  end;
end;


Function Dej_Slot_pro_tool(var tool:ToolType):longint;
var n:longint;
begin
for n:=0 to MAX_TOOL do
    if Tool[N].typ=0 then Exit(n);
Dej_Slot_pro_tool:=MAX_TOOL;
end;


Function VytvorPaletu(var mystrm:pstream;var tool:ToolType;Nh:longint):boolean;
var q:TPaleta;
    p:PPaleta;
    rs:longint;
    i,j:word;
    NBGR:BGRquad;
    RGBN:RGBquad;

begin
rs:=ReadStream(mystrm,i,2);
if rs<>2 then Exit(false);

q.poc_barev:=i;

for j:=0 to i-1 do
    begin
    rs:=ReadStream(mystrm,NBGR,4); {Tady pozor, paletove barvy maji obracene}
    if rs<>4 then Exit(false);     {jednotlive slozky nez ty z ColorRef}
    RGBN.rs:=NBGR.rs;
    RGBN.bl:=NBGR.bl;
    RGBN.gr:=NBGR.gr;
    RGBN.rd:=NBGR.rd;
    q.barva[j]:=MyRGB2word(rgbn.rd,rgbn.gr,rgbn.bl);
    end;

New(p);
Move(q,p^,sizeof(TPaleta));
Tool[nh].typ:=TOOL_PALETA;
Tool[nh].paleta:=p;
VytvorPaletu:=true;
end;


Function SmazTool(var Tool:ToolType;Nh:longint):boolean;
begin
if Tool[Nh].typ = TOOL_PALETA then Dispose(Tool[Nh].paleta);
Tool[Nh].typ:=TOOL_NIC;
SmazTool:=true;
end;


Function UpravTloustkuCary(i:word):word;
begin
UpravTloustkuCary:=i div 5 + 1;
end;


Function ZjistiMaximalniRozmeryPrvku(var mystrm:pstream;var bbox:TRect):boolean;
var savpos:longint;
    konec:boolean;
    mfpos,rs,streamsize:longint;
    mfrec:MetaRecord;

begin
ZjistiMaximalniRozmeryPrvku:=true;
if (bbox.bottom=-1) and (bbox.right=-1) then
   begin
   streamsize:=mystrm^.GetSize;
   savpos:=mystrm^.GetPos;
   mfpos:=savpos;
   konec:=false;

   repeat
   mystrm^.Seek(mfpos);

   rs:=ReadStream(mystrm,mfrec,6);
   if rs<>6 then
      begin
      Exit(false);
      end;
   If mfRec.rdSize = 0 Then break else mfRec.rdSize:=mfRec.rdSize*2;

   case mfRec.rdFunction Of
   1:begin end;

   end;{case}


   inc(MFpos,mfRec.rdSize);
   if (MFpos<0) or (MFpos>=streamsize) then konec:=true;

   until konec=true;

   mystrm^.Seek(savpos);
   end;
end;


Function AdjustPointX(xbod:word;var xy_dim:xy_dimType):longint;
begin
with xy_dim do
  begin
  AdjustPointX:=(xbod-xWO)*xF div xWE;
  end;
end;

Function AdjustPointY(ybod:word;var xy_dim:xy_dimType):longint;
begin
with xy_dim do
  begin
  AdjustPointY:=(ybod-yWO)*yF div yWE;
  end;
end;

Procedure AdjustTRect(var xy_dim:xy_dimType; var r:MFRect);
begin
with xy_dim do
  begin
  R.left := (R.left - xWO) * xF Div xWE;
  R.right := (R.right - xWO) * xF Div xWE;
  R.top := (R.top - yWO) * yF Div yWE;
  R.bottom := (R.bottom - yWO) * yF Div yWE;
  end;
end;

Procedure AdjustArcStartEnd(var xy_dim:xy_dimType; var art:TArcrec);
begin
art.sx:=AdjustPointX(art.sx,xy_dim);
art.ex:=AdjustPointX(art.ex,xy_dim);
art.sy:=AdjustPointY(art.sy,xy_dim);
art.ey:=AdjustPointY(art.ey,xy_dim);
end;


Function arctan2(y,x : real) : real;
begin
if (x=0) then
   begin
   if y=0 then
      arctan2:=0.0
      else if y>0 then
      arctan2:=pi/2
      else if y<0 then
   arctan2:=-pi/2;
   end
   else
   ArcTan2:=ArcTan(y/x);
if x<0.0 then
   ArcTan2:=ArcTan2+pi;
if ArcTan2>pi then
   ArcTan2:=ArcTan2-2*pi;
end;



Function LoadImageWMF(var mystrm:pstream;var dest:VirtualWindow):longint;
Var

 MaxPts : packed Array[0..MAX_POLYGON] Of smallint;
 Tstr : string;
 CR, R : MFRect;
 RGBN : RGBQuad;
 PolyRaw, PolyFin : TPolytype;
 Body : array[1..MAX_HRAN] of Bod;

 mfRec : MetaRecord;
 mfHdr : mfHeader;

 mfkey,newmfkey:dword;

 Tool : ToolType;
 BBox : TRect;
 art : TArcRec;

 xy_dim : xy_dimType;

 uus,uue,ats,ate:real;

 {xD, yD, xVE, yVE : smallint;}


 L, MFpos : LongInt;
 {PSt,} X1, X0, Y0, rrx, rry : longint;

 I, II, Nh, MaxPt:longint;


 Akt_Cara:word;
 Akt_Vypln:word;
 Akt_Font:byte;
 Akt_Paleta:byte;

 Akt_Tool:byte;
 Akt_Txt_Barva:word;

 konec:boolean;
 wmf_x,wmf_y:longint;

 rs:longint;
 streamsize:longint;

 yVEreal:real;

 dbgstring:string;

begin
konec:=false;

Inicializace_Tools(tool);
InicializaceSouradnicovehoSystemu(dest, bbox, xy_dim);


streamsize:=mystrm^.GetSize;
rs:=ReadStream(mystrm,mfkey,4);
if rs<>4 then Exit;

If mfKey = $9AC6CDD7 Then
   begin
   newmfkey:=Read_Placeable_header(mystrm, bbox);
   xy_dim.xWO:=bbox.left;
   xy_dim.yWO:=bbox.top;
   mfkey:=newmfKey;
   {$IFDEF WMF_DEBUG}
   DbgLogX('Ma "Placeable header".');
   dbgstring:=mystr(bbox.left);
   dbgstring:='   bbox.left: '+dbgstring;
   dbgstring:=dbgstring+'  bbox.top: '+mystr(bbox.top)+'  bbox.right: '+mystr(bbox.right)+'  bbox.bottom: '+mystr(bbox.bottom);
   DbgLogX(dbgstring);
   {$ENDIF}
   end;

if mfKey =-1 then Exit(1);
If mfKey = $00090001 Then mfKey := 0;    {NoAldus}

mystrm^.Seek(mfkey);
rs:=ReadStream(mystrm,mfHdr,SizeOf(mfHeader));
if rs<>SizeOf(mfHeader) then Exit(2);

mfHdr.mtSize:=mfHdr.mtSize*2;
mfHdr.mtHeaderSize:=mfHdr.mtHeaderSize*2;
mfHdr.mtMaxRecord:=mfHdr.mtMaxRecord*2;


Nh:=0;
Akt_cara:=0;
Akt_vypln:=0;
Akt_font:=DefaultFont;
Akt_paleta:=0;
Akt_Tool:=0;
Akt_txt_barva:=0;

MFpos:=18+mfKey;

if not ZjistiMaximalniRozmeryPrvku(mystrm,bbox) then exit(3);

Repeat
mystrm^.Seek(mfpos);
rs:=ReadStream(mystrm,mfrec,6);
if rs<>6 then Exit(4);

i:=0;    {musi byt, protoze v ReadStream nacitam jen dolni dva bajty}
ii:=0;   {to same}

X1:=0;
X0:=0;
Y0:=0;
MaxPt:=0;

If mfRec.rdSize = 0 Then break else mfRec.rdSize:=mfRec.rdSize*2;

{$IFDEF WMF_DEBUG}
dbglogX(hexstr(mfRec.rdFunction)+'h');
{$ENDIF}

case mfRec.rdFunction Of
  $0F7:Begin                    {CreatePalette}
       Tool[Nh].typ:=TOOL_PALETA;

       rs:=ReadStream(mystrm,i,2);
       if rs<>2 then Exit(5);
       VytvorPaletu(mystrm,Tool,Nh);
       Nh:=Dej_Slot_pro_tool(Tool);
       End;

  $234:begin
       rs:=ReadStream(mystrm,i,2);       {SelectPalette}
       if rs<>2 then Exit(6);
       akt_paleta:=i;
       end;


  {void Create's which are not supported}
  $1F9,$2FD,$6FE,$F8:Begin
                     Tool[Nh].typ:=TOOL_NEIMPLEMENTOVANO;
                     Nh:=Dej_Slot_pro_tool(Tool);
                     End;

  $209:Begin                    {SetTextColor}
       rs:=ReadStream(mystrm,RGBN,4);
       if rs<>4 then Exit(7);
       akt_txt_barva:=MyRGB2word(rgbn.rd,rgbn.gr,rgbn.bl);{prevodbarvy(dword(rgbn));}  {SetColor(prevodbarvy(rgbn));}
       End;


  $20B:begin                    {SetWindowOrg}
       rs:=ReadStream(mystrm,xy_dim.yWO,2);
       if rs<>2 then Exit(8);
       rs:=ReadStream(mystrm,xy_dim.xWO,2);
       if rs<>2 then Exit(8);

       {$IFDEF WMF_DEBUG}
       DbgLogX('   Win.org.X: '+mystr(xy_dim.xWO)+'  Win.org.Y: '+mystr(xy_dim.yWO));
       {$ENDIF}
       end;

  $20C:begin                    {SetWindowExt}
       rs:=ReadStream(mystrm,xy_dim.yWE,2);
       if rs<>2 then Exit(9);
       rs:=ReadStream(mystrm,xy_dim.xWE,2);
       if rs<>2 then Exit(9);

       {$IFDEF WMF_DEBUG}
       DbgLogX('   Win.ext.X: '+mystr(xy_dim.xWE)+'  Win.ext.Y: '+mystr(xy_dim.yWE));
       {$ENDIF}

       with xy_dim do
          begin
          xF:=xVE;
          yF:=yVE;
          If Abs(xWE/yWE) < (xVE/yVE) then xF:=xWE * yVE Div yWE
             else   {Stretching Left & Right}
          If Abs(xWE/yWE) > (xVE/yVE) then yF:=yWE * xVE Div xWE;
                    {Stretching Up & Down}
          yF:=yF * yD Div yVE;
          xF:=Abs(xF);
          yF:=Abs(yF);
          end;
       End;

  $12D:Begin                    {SelectObject}
       rs:=ReadStream(mystrm,i,2);
       if rs<>2 then Exit(10);
       Akt_tool:=i;
       case Tool[i].typ of
        TOOL_CARA:   akt_cara:=i;
        TOOL_VYPLN:  akt_vypln:=i;
        TOOL_FONT:   akt_font:=i;
        TOOL_PALETA: akt_paleta:=i;
       end;{case}
       End;


  $1F0 : Begin                    {void DeleteObject}
         rs:=ReadStream(mystrm,i,2);
         if rs<>2 then Exit(11);
         SmazTool(tool,i);
         Nh:=Dej_Slot_pro_Tool(tool);
         End;

  $2FA : Begin                    {void CreatePenIndirect}

         rs:=ReadStream(mystrm,I,2);   {styl cary}
         if rs<>2 then Exit(12);
         rs:=ReadStream(mystrm,II,2);  {tloustka cary}
         if rs<>2 then Exit(12);

         Tool[Nh].typ:=TOOL_CARA;
         Tool[Nh].cara_sire:=UpravTloustkuCary(II);

          Case I Of
           $00 : Tool[Nh].cara_styl := SolidLn;
           $01 : Tool[Nh].cara_styl := DashedLn;
           $02 : Tool[Nh].cara_styl := DottedLn;
           $03 : Tool[Nh].cara_styl := CenterLn;
           $04 : Tool[Nh].cara_styl := CenterLn;
           $05 : Tool[Nh].cara_styl := SolidLn;
           $06 : Tool[Nh].cara_styl := SolidLn;
           else Tool[Nh].cara_styl:=SolidLn;
          End;
          L := MFpos + 12;
          mystrm^.Seek(l);
          rs:=ReadStream(mystrm,RGBn,4);
          if rs<>4 then Exit(13);
          Tool[Nh].cara_barva:=MyRGB2word(RGBn.rd,RGBn.gr,RGBn.bl);
          Nh:=Dej_Slot_pro_tool(tool);
         End;

  $2FC : Begin                    {void CreateBrushIndirect}
         rs:=ReadStream(mystrm,I,2);
         if rs<>2 then Exit(14);
         rs:=ReadStream(mystrm,RGBn,4);
         if rs<>4 then Exit(14);
         rs:=ReadStream(mystrm,II,2);
         if rs<>2 then Exit(14);

         Tool[Nh].typ:=TOOL_VYPLN;
         Tool[Nh].vypln_barva:=MyRGB2word(RGBn.rd,RGBn.gr,RGBn.bl);

         If I = 0 Then Tool[Nh].vypln_styl := SolidFill;
         If I = 1 Then Tool[Nh].vypln_styl := Emptyfill; {Special Case!}
         If I = 2 Then
           Begin
            Case II Of
             0 : Tool[Nh].vypln_styl := LineFill;
             1 : Tool[Nh].vypln_styl := LineFill;
             2 : Tool[Nh].vypln_styl := BkSlashFill;
             3 : Tool[Nh].vypln_styl := LtSlashFill;
             4 : Tool[Nh].vypln_styl := HatchFill;
             5 : Tool[Nh].vypln_styl := xHatchFill;
            End;
           End;
         Nh:=Dej_Slot_pro_tool(tool);
         End;

  $2FB : Begin                    {void CreateFontIndirect}
          L := MFpos + 22;  {nekolik bajtu ted preskocime...}
          mystrm^.Seek(L);  {...protoze je neumime zpracovat}
          rs:=ReadStream(mystrm,i,2);
          if rs<>2 then Exit(15);
          Tool[Nh].typ:=TOOL_FONT;
          Case (I And $F000) Of
           $0000 : Tool[Nh].fStyle := SansSerifFont;
           $1000 : Tool[Nh].fStyle := TriplexFont;
           $2000 : Tool[Nh].fStyle := SansSerifFont;
           $3000 : Tool[Nh].fStyle := SmallFont;
           $4000, $5000 : Tool[Nh].fStyle := GothicFont;
           else Tool[Nh].fStyle:=DefaultFont;
          End;
          {SetTextStyle(fStyle, 0, 4);}
         Nh:=Dej_Slot_pro_tool(tool);
         End;

  $324 : Begin                    {void Polygon}
         rs:=ReadStream(mystrm,maxpt,2);
         if rs<>2 then Exit(16);
         If MaxPt > MAX_HRAN Then MaxPt := MAX_HRAN;

         Init_Poly(PolyRaw,MaxPt);

         rs:=ReadStream(mystrm,body,maxpt*4); {2 bajty X + 2 bajty Y -> 4 bajty}
         if rs<>maxpt*4 then
            begin
            Kill_Poly(PolyRaw);
            Exit(17);
            end;


         For I := 1 To MaxPt Do
             Begin
                polyraw.point^[i].x := AdjustPointX(body[i].x,xy_dim);
                polyraw.point^[i].y := AdjustPointY(body[i].y,xy_dim);
             End;


         Normalize_PolyPoints(PolyRaw,PolyFin);
         {debug}
         for i:=1 to polyfin.num do
             {$IFDEF WMF_DEBUG}
             dbglogx('   x: '+mystr(polyfin.point^[i].x)+'  y: '+mystr(polyfin.point^[i].y));
             {$ENDIF}
         {/debug}

         {debug}


         If Tool[Akt_Vypln].vypln_styl <> Emptyfill
            Then FilledPolygon(dest, polyfin, Tool[Akt_Cara].cara_sire,Tool[Akt_Cara].cara_styl,Tool[Akt_Cara].cara_barva, Tool[Akt_Vypln].vypln_barva)
            Else Polygon(dest, polyfin, Tool[Akt_Cara].cara_sire,Tool[Akt_Cara].cara_styl, Tool[Akt_Cara].cara_barva);


         {/debug}
         Kill_Poly(PolyRaw);
         Kill_Poly(PolyFin);
         {write('?');readln;}
         End;

  $538 : Begin                    {void PolyPolygon 3.0}
         rs:=ReadStream(mystrm,i,2);
         if rs<>2 then Exit(18);
         For L := 0 To i-1 Do
             begin
             rs:=ReadStream(mystrm,MaxPts[L],2);
             if rs<>2 then Exit(19);
             end;
         For L := 0 To i-1 Do
             Begin
             If MaxPts[L] > MAX_HRAN Then MaxPts[L] := MAX_HRAN;
             Init_Poly(PolyRaw,MaxPts[L]);
             rs:=ReadStream(mystrm,body,MaxPts[L]*4);
             if rs<>MaxPts[L]*4 then
                begin
                Kill_Poly(PolyRaw);
                Exit(20);
                end;

             with xy_dim do
                begin
                For II := 1 To MaxPts[L] Do
                    Begin
                    polyraw.point^[Ii].x := (body[II].x - xWO) * xF Div xWE;
                    polyraw.point^[Ii].y := (body[II].y - yWO) * yF Div yWE;
                    End;
                end;

            Normalize_PolyPoints(PolyRaw,PolyFin);
            {debug}
            {$IFDEF WMF_DEBUG}
            for ii:=1 to polyfin.num do
                begin
                  dbglogx('L:'+mystr(L)+'   x: '+mystr(polyfin.point^[ii].x)+'  y: '+mystr(polyfin.point^[ii].y));
                end;
            dbglogx('L:'+mystr(L)+'   celkem vrcholu: '+mystr(polyfin.num));
            {$ENDIF}
            {/debug}

            If Tool[Akt_Vypln].vypln_styl <> Emptyfill
               Then FilledPolygon(dest, polyfin, Tool[Akt_Cara].cara_sire,Tool[Akt_Cara].cara_styl,Tool[Akt_Cara].cara_barva, Tool[Akt_Vypln].vypln_barva)
               Else Polygon(dest, polyfin, Tool[Akt_Cara].cara_sire,Tool[Akt_Cara].cara_styl, Tool[Akt_Cara].cara_barva);


            Kill_Poly(polyraw);
            Kill_Poly(polyfin);
            End;
         End;

  $325 : Begin                    {void Polyline}
         rs:=ReadStream(mystrm,maxpt,2);
         if rs<>2 then Exit(21);

         Init_Poly(polyraw,maxpt);

         with xy_dim do
            begin
            For I := 1 To MaxPt Do
                Begin
                x0:=0;
                y0:=0;
                mystrm^.Read(X0,2);
                mystrm^.Read(Y0,2);
                polyraw.point^[i-1].x:=(x0 - xWO) * xF Div xWE;
                polyraw.point^[i-1].y:=(y0 - yWO) * yF Div yWE;
                End;
            end;

         Normalize_PolyPoints(PolyRaw,PolyFin);
         PolyFin.point^[0]:=PolyFin.point^[1];
         {I pres volani "Polygon" nemame ambici kreslit nutne uzavreny utvar,
          ale klikatou caru, ktera nemusi byt nutne uzavrena}

         Polygon(dest, polyfin, Tool[Akt_Cara].cara_sire,Tool[Akt_Cara].cara_styl, Tool[Akt_Cara].cara_barva);
         Kill_Poly(polyraw);
         Kill_Poly(polyfin);
         End;

  $418 : Begin                    {void Ellipse}
         rs:=ReadStream(mystrm,r,8);
         if rs<>8 then Exit(22);
         AdjustTRect(xy_dim,r);
         If Tool[Akt_Vypln].vypln_styl <> Emptyfill
            then
            FilledEllipse(dest, (R.right+R.left) div 2,
                                (R.bottom+R.top) div 2,
                                (R.right-R.left) div 2,
                                (R.bottom-R.top) div 2,
                 Tool[Akt_Cara].cara_sire{1}, Tool[Akt_Cara].cara_barva, Tool[Akt_Vypln].vypln_barva)
            Else
            Ellipse(dest, (R.right+R.left) div 2,
                          (R.bottom+R.top) div 2,
                          (R.right-R.left) div 2,
                          (R.bottom-R.top) div 2,
                 Tool[Akt_Cara].cara_sire, Tool[Akt_Cara].cara_barva);

         End;

  $41B : Begin                    {void Rectangle}
          rs:=ReadStream(mystrm,R, 8);
          if rs<>8 then Exit(23);
          AdjustTRect(xy_dim,r);
          If Tool[Akt_Vypln].vypln_styl <> Emptyfill
             then Bar(dest,R.left, R.top, R.right - 1, R.bottom - 1,
                           Tool[Akt_Vypln].vypln_barva);
          Rectangle(dest,R.left, R.top, R.right - 1, R.bottom - 1,
                         Tool[Akt_Cara].cara_sire,
                         Tool[Akt_Cara].cara_styl,
                         Tool[Akt_Cara].cara_barva);
         End;

  $61C : Begin                    {void RoundRect}
          rs:=ReadStream(mystrm,r,8);
          if rs<>8 then Exit(24);
          AdjustTRect(xy_dim,r);
          If Tool[Akt_Vypln].vypln_styl <> Emptyfill
             then RoundBar(dest,R.left, R.top, R.right - 1, R.bottom - 1,
                           PARAMETR_KULATOSTI_ROHU,
                           Tool[Akt_Cara].cara_barva,
                           Tool[Akt_Vypln].vypln_barva);
          RoundRect(dest,R.left, R.top, R.right - 1, R.bottom - 1,
                         Tool[Akt_Cara].cara_sire,
                         Tool[Akt_Cara].cara_styl,
                         PARAMETR_KULATOSTI_ROHU,
                         Tool[Akt_Cara].cara_barva);
         End;


  $817 : begin                    {Arc}
         rs:=ReadStream(mystrm,art,8);
         if rs<>8 then Exit(40);

         rs:=ReadStream(mystrm,r,8);
         if rs<>8 then Exit(41);

         AdjustArcStartEnd(xy_dim,art);
         AdjustTRect(xy_dim,r);

         x0:=(R.right+R.left) div 2;
         y0:=(R.top+R.bottom) div 2;

         uus:=arctan2(art.sy-y0,art.sx-x0)*180/pi;
         uue:=arctan2(art.ey-y0,art.ex-x0)*180/pi;

         Arc(dest, x0, x0, rrx, rry,
                   round(uus),
                   round(uue),
                   Tool[Akt_Cara].cara_barva);


         {debug}
         {$IFDEF WMF_DEBUG}

         dbglogx('x1: '+mystr(r.left));
         dbglogx('y1: '+mystr(r.top));
         dbglogx('x2: '+mystr(r.right));
         dbglogx('y2: '+mystr(r.bottom));

         dbglogx('sx: '+mystr(art.sx));
         dbglogx('sy: '+mystr(art.sy));
         dbglogx('ex: '+mystr(art.ex));
         dbglogx('ey: '+mystr(art.ey));

         {$ENDIF}
         {/debug}

         end;


  $830 : Begin                    {Chord}
         {dummy}
         End;



  $548 : Begin                    {void FloodFill}
         rs:=ReadStream(mystrm,rgbn,4);
         if rs<>4 then Exit(25);
         rs:=ReadStream(mystrm,y0,2);
         if rs<>2 then Exit(25);
         rs:=ReadStream(mystrm,x0,2);
         if rs<>2 then Exit(25);

         with xy_dim do
            begin
            X0 := (X0 - xWO) * xF Div xWE;
            Y0 := (Y0 - yWO) * yF Div yWE;
            end;
         FloodFill(dest,X0, Y0,MyRGB2word(RGBn.rd,RGBn.gr,RGBn.bl));
         {Tady se skutecne barva zadava primo - nikoliv pres Akt_cara ci Akt_vypln}
         End;

  $521 : Begin                    {void TextOut}
         rs:=ReadStream(mystrm,i,1);
         if rs<>1 then Exit(26);
         rs:=ReadStream(mystrm,TStr[1],I + (I And 1));
         if rs<>I + (I And 1) then Exit(27);
         Tstr[0]:=char(I + (I And 1));

         rs:=ReadStream(mystrm,y0,2);
         if rs<>2 then Exit(28);
         rs:=ReadStream(mystrm,x0,2);
         if rs<>2 then Exit(28);

         with xy_dim do
            begin
            X0 := (X0 - xWO) * xF Div xWE;
            Y0 := (Y0 - yWO) * yF Div yWE;
            end;
         outtext(dest,X0, Y0, Tstr, Tool[Akt_Cara].cara_barva);
         End;

  $A32 : Begin                    {void ExtTextOut}
         rs:=ReadStream(mystrm,y0,2);
         if rs<>2 then Exit;
         rs:=ReadStream(mystrm,x0,2);
         if rs<>2 then Exit;
         rs:=ReadStream(mystrm,i,2);
         if rs<>2 then Exit;
         rs:=ReadStream(mystrm,x1,2);
         if rs<>2 then Exit;
         rs:=ReadStream(mystrm,Tstr[1],I + (I And 1));
         if rs<>I + (I And 1) then Exit(29);
         Tstr[0]:=char(I + (I And 1));

         with xy_dim do
            begin
            X0 := (X0 - xWO) * xF Div xWE;
            Y0 := (Y0 - yWO) * yF Div yWE;
            end;
         outtext(dest,X0, Y0, Tstr, Tool[Akt_Cara].cara_barva);
         End;

  $416 : Begin
         rs:=ReadStream(mystrm,cr,8);           {void IntersectClipRect}
         if rs<>8 then Exit(30);
         End;

  $214 : Begin                    {void MoveTo}
         rs:=ReadStream(mystrm,y0,2);
         if rs<>2 then Exit(31);
         rs:=ReadStream(mystrm,x0,2);
         if rs<>2 then Exit(31);
{          If (X0 in [CR.Left..CR.Right]) = False Then
          Begin
          If (Abs(X0-CR.Right) < Abs(X0-CR.Left))
          Then X0 := CR.Right else  X0 := CR.Left;
          End;}
 {         If not (Y0 in [CR.Top..CR.Bottom]) Then
          If (Abs(Y0-CR.Top) < Abs(Y0-CR.Bottom))
          Then Y0 := CR.Top else  Y0 := CR.Bottom;}

         with xy_dim do
            begin
            X0 := (X0 - xWO) * xF Div xWE;
            Y0 := (Y0 - yWO) * yF Div yWE;
            end;

         wmf_x:=x0;
         wmf_y:=y0;
         End;

  $213 : Begin                    {void LineTo}
         rs:=ReadStream(mystrm,y0,2);
         if rs<>2 then Exit(32);
         rs:=ReadStream(mystrm,x0,2);
         if rs<>2 then Exit(32);
{         If (X0 in [CR.Left..CR.Right]) = False Then
          Begin
          If (Abs(X0-CR.Right) < Abs(X0-CR.Left))
          Then X0 := CR.Right else  X0 := CR.Left;
          End;}
{          If not (Y0 in [CR.Top..CR.Bottom]) Then
          If (Abs(Y0-CR.Top) < Abs(Y0-CR.Bottom))
          Then Y0 := CR.Top else  Y0 := CR.Bottom;}

          with xy_dim do
            begin
            X0 := (X0 - xWO) * xF Div xWE;
            Y0 := (Y0 - yWO) * yF Div yWE;
            end;

          Line(dest,wmf_x,wmf_y, X0, Y0, Tool[Akt_Cara].cara_barva);
          wmf_x:=x0;
          wmf_y:=y0;
         End;
  $000 : konec:=true;                {void META_EOF}
 End;


inc(MFpos,mfRec.rdSize);


if (MFpos<0) or (MFpos>streamsize) then konec:=true; {UGLY, UGLY, velice quick}
                                                  {and dirty ochrana pred chybou}
until konec=true;

LoadImageWMF:=0;
End;


Function Load_WMF(s:string;var dest:VirtualWindow):longint;
var h:PGrpStream;
begin
h:=New(PGrpStream,Init(s,stOpenRead));
if h^.status=stOk
   then begin

   ukazatel_na_puvodni_buffer_pro_filled_polygon:=buffer_for_Filled_polygon;
   GetMem(wmf_buffer_pro_filled_polygon,BAJTU_PAMETI_NA_FILLED_POLYGON_BUFFER);
   buffer_for_Filled_polygon:=wmf_buffer_pro_filled_polygon;

   Load_WMF:=LoadImageWMF(h,dest);

   buffer_for_Filled_polygon:=ukazatel_na_puvodni_buffer_pro_filled_polygon;
   FreeMem(wmf_buffer_pro_filled_polygon);
   end
   else Load_WMF:=255;
Dispose(h,Done);
end;


Function DirtyLoad_WMF(s:string;var dest:VirtualWindow):byte;
var mfKey:longint;
    h:PGrpStream;
    dbox:TRect;

begin
h:=New(PGrpStream,Init(s,stOpenRead));
mfkey:=Read_Placeable_header(h,dbox);
Dispose(h,Done);

if mfkey<>-1
   then Init_VW(dest,dbox.right-dbox.left+1,dbox.bottom-dbox.top+1,false)
   else Init_VW(dest,320,200,false);
Clr(dest,65535);
DirtyLoad_WMF:=Load_WMF(s,dest);
end;


Procedure Register_WMF_Loader;
begin
RegisterImageLoader('WMF',@DirtyLoad_WMF);
end;

begin
Register_WMF_Loader;
end.
