{****************************************************************************}
{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}

{$DEFINE WMF_DEBUG}

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;

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;


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 : Integer;End;
   TRect = packed Record left, top, right, bottom : Integer;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..255] of word;
       end;


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

var {Ted nejake globalni promenne}
    Tool:array[0..255] 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;

    BBox : TRect;
    xD, yD, yF, xF, xVE, yVE : smallint;
    xWE, yWE, xWO, yWO   : smallint;


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

{============================================================================}
function MyStr (Cislo: word): string;
{ €¡slo --> ©etˆzec }
var
  Vysledek : string;
begin { MyStr }
  Str (Cislo, Vysledek);
  MyStr := 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):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;
begin
FillChar(Tool,sizeof(tool),0);
end;


Procedure InicializaceSouradnicovehoSystemu;
begin
bbox.top:=-1;bbox.left:=-1;bbox.right:=-1;bbox.bottom:=-1;
yWE:=1;
xWE:=1;
xWO:=0;
yWO:=0;

yF:=1;
xF:=1;
end;


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


Function VytvorPaletu(var mystrm:pstream;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(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):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 Exit(false);
   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 LoadImageWMF(var mystrm:pstream;var dest:VirtualWindow):longint;
const MAX_HRAN = 512;

Var

 MaxPts : Array[0..254] Of Integer;
 Tstr : string;
 CR, R : MFRect;
 RGBN : RGBQuad;
 Poly : Polytype;
 Body : array[1..MAX_HRAN] of Bod;

 mfRec : MetaRecord;
 mfHdr : mfHeader;

 mfkey,newmfkey:dword;
 L, MFpos : LongInt;
 {PSt,} X1, X0, Y0 : Integer;

 I, II, Nh, MaxPt:Word;


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

 Akt_Tool:byte;
 Txt_Barva:byte;

 konec:boolean;
 wmf_x,wmf_y:longint;

 rs:longint;
 streamsize:longint;


 dbgfile:text;

begin
{$IFDEF WMF_DEBUG}
assign(dbgfile,'wmf_dbg.txt');
rewrite(dbgfile);
{$ENDIF}


konec:=false;

Inicializace_Tools;
InicializaceSouradnicovehoSystemu;

yD:=dest.hoehe;
xVE:=dest.breite;
yVE:=xVE * 3 Div 4; {pomer obrazovky?}

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

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

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

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

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;
Txt_barva:=0;

MFpos:=18+mfKey;

if not ZjistiMaximalniRozmeryPrvku(mystrm) then exit;

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

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

{$IFDEF WMF_DEBUG}
writeln(dbgfile,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;
       VytvorPaletu(mystrm,Nh);
       Nh:=Dej_Slot_pro_tool;
       End;

  $234:begin
       rs:=ReadStream(mystrm,i,2);       {SelectPalette}
       if rs<>2 then Exit;
       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;
                     End;

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


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

       {$IFDEF WMF_DEBUG}
       writeln(dbgfile,'   Win.org.X: ',xWO,'  Win.org.Y: ',yWO);
       {$ENDIF}
       end;

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

       {$IFDEF WMF_DEBUG}
       writeln(dbgfile,'   Win.ext.X: ',xWE,'  Win.ext.Y: ',yWE);
       {$ENDIF}

       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;

  $12D:Begin                    {SelectObject}
       rs:=ReadStream(mystrm,i,2);
       if rs<>2 then Exit;
       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;
         SmazTool(i);
         Nh:=Dej_Slot_pro_Tool;
         End;

  $2FA : Begin                    {void CreatePenIndirect}

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

         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;
          Tool[Nh].cara_barva:=MyRGB2word(RGBn.rd,RGBn.gr,RGBn.bl);
          Nh:=Dej_Slot_pro_tool;
         End;

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

         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;
         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;
          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;
         End;

  $324 : Begin                    {void Polygon}
         rs:=ReadStream(mystrm,maxpt,2);
         if rs<>2 then Exit;
         If MaxPt > MAX_HRAN Then MaxPt := MAX_HRAN;
         poly.num:=MaxPt;
         GetMem(poly.point,(poly.num+1)*8);
         rs:=ReadStream(mystrm,body,maxpt*4);
         if rs<>maxpt*4 then
            begin
            FreeMem(poly.point,(poly.num+1)*8);
            Exit;
            end;
         For I := 1 To MaxPt Do
             Begin
             poly.point^[i].x := (body[i].x - xWO) * xF Div xWE;
             poly.point^[i].y := (body[i].y - yWO) * yF Div yWE;
             {$IFDEF WMF_DEBUG}
             writeln(dbgfile,'   x: ',poly.point^[i].x, '  y: ',poly.point^[i].y);
             {$ENDIF}
             End;
         poly.point^[0]:=poly.point^[i];

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

  $538 : Begin                    {void PolyPolygon 3.0}
         rs:=ReadStream(mystrm,i,2);
         if rs<>2 then Exit;
         For L := 0 To i-1 Do
             begin
             rs:=ReadStream(mystrm,MaxPts[L],2);
             if rs<>2 then Exit;
             end;
         For L := 0 To i-1 Do
             Begin
             If MaxPts[L] > MAX_HRAN Then MaxPts[L] := MAX_HRAN;
             poly.num:=MaxPts[l];
             GetMem(poly.point,(poly.num+1)*8);
             rs:=ReadStream(mystrm,body,MaxPts[L]*4);
             if rs<>MaxPts[L]*4 then
                begin
                FreeMem(poly.point,(poly.num+1)*8);
                Exit;
                end;
             For I := 1 To MaxPts[l] Do
                 Begin
                 poly.point^[i].x := (body[i].x - xWO) * xF Div xWE;
                 poly.point^[i].y := (body[i].y - yWO) * yF Div yWE;
                 End;
             poly.point^[0]:=poly.point^[i];

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

  $325 : Begin                    {void Polyline}
         rs:=ReadStream(mystrm,maxpt,2);
         if rs<>2 then Exit;
         poly.num:=MaxPt-1;
         GetMem(poly.point,(poly.num+1)*8);
         For I := 1 To MaxPt Do
             Begin
             x0:=0;
             y0:=0;
             mystrm^.Read(X0,2);
             mystrm^.Read(Y0,2);
             poly.point^[i-1].x:=(x0 - xWO) * xF Div xWE;
             poly.point^[i-1].y:=(y0 - yWO) * yF Div yWE;
             End;

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

  $418 : Begin                    {void Ellipse}
         rs:=ReadStream(mystrm,r,8);
         if rs<>8 then Exit;
         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;
         {R.left := R.left + ((R.right - R.left) Div 2);
         R.top := R.top + ((R.bottom - R.top) Div 2);}

         {RotatedFilledEllipse(dest,115,85,32,25,0,2,63488,31);}

         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, 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;
          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;

          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}
          L := MFpos + 10;          {preskakuje nejake parametry ohledne}
          mystrm^.seek(L);          {zakriveni rohu?}
          rs:=ReadStream(mystrm,r,8);
          if rs<>8 then Exit;

          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;

          { ! TODO ! - vzdyt ja prece mam proceduru na okrouhle obdelniky !}
          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;

  $548 : Begin                    {void FloodFill}
         rs:=ReadStream(mystrm,rgbn,4);
         if rs<>4 then Exit;
         rs:=ReadStream(mystrm,y0,2);
         if rs<>2 then Exit;
         rs:=ReadStream(mystrm,x0,2);
         if rs<>2 then Exit;
         X0 := (X0 - xWO) * xF Div xWE;
         Y0 := (Y0 - yWO) * yF Div yWE;
         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;
         rs:=ReadStream(mystrm,TStr[1],I + (I And 1));
         if rs<>I + (I And 1) then Exit;
         Tstr[0]:=char(I + (I And 1));

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

         X0 := (X0 - xWO) * xF Div xWE;
         Y0 := (Y0 - yWO) * yF Div yWE;
         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;
         Tstr[0]:=char(I + (I And 1));
         X0 := (X0 - xWO) * xF Div xWE;
         Y0 := (Y0 - yWO) * yF Div yWE;
         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;
         End;

  $214 : Begin                    {void MoveTo}
         rs:=ReadStream(mystrm,y0,2);
         if rs<>2 then Exit;
         rs:=ReadStream(mystrm,x0,2);
         if rs<>2 then Exit;
{          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;}
         X0 := (X0 - xWO) * xF Div xWE;
         Y0 := (Y0 - yWO) * yF Div yWE;
         wmf_x:=x0;
         wmf_y:=y0;
         End;

  $213 : Begin                    {void LineTo}
         rs:=ReadStream(mystrm,y0,2);
         if rs<>2 then Exit;
         rs:=ReadStream(mystrm,x0,2);
         if rs<>2 then Exit;
{         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;}
          X0 := (X0 - xWO) * xF Div xWE;
          Y0 := (Y0 - yWO) * yF Div yWE;
          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;

{$IFDEF WMF_DEBUG}
Close(dbgfile);
{$ENDIF}

LoadImageWMF:=0;
End;


Function Load_WMF(s:string;var dest:VirtualWindow):longint;
var h:PGrpStream;
begin
h:=New(PGrpStream,Init(s,stOpenRead));
Load_WMF:=LoadImageWMF(h,dest);
Dispose(h,Done);
end;


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

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

if mfkey<>-1
   then Init_VW(dest,bbox.right-bbox.left+1,bbox.bottom-bbox.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.
