home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9303 / metawin / wmfimp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-05  |  22.8 KB  |  755 lines
  1. {$define RETAIL_VERSION}
  2. {!$define Win32}
  3. {***************************************************************************
  4.   Source File Name     :  WMFIMP.PAS
  5.   Autor                :  Mario M. Westphal
  6.   Erstellt am          :  18.02.1993
  7.  
  8.   Compiler             :  Borland Pascal for Windows 1.x
  9.   Betriebssystem       :  DOS 5.0, Windows 3.x
  10.   Compiler-Schalter    :  -
  11.  
  12.   Bemerkungen          :  -
  13.  
  14.   Beschreibung         :  Bibliothek fⁿr den Import von "APM"-Metafiles
  15.  
  16.   Revisionen           :  1.00 18.02,1993 created (MW)
  17.                                07.04.1993 revisited (MW)
  18. ****************************************************************************}
  19. {$M 8192,8192}
  20. {$A+,B-,D+,F-,G+,I+,L+,N-,R+,S+,V+,W-,X+,Q+}
  21.  
  22. {$ifdef RETAIL_VERSION}
  23.   {$D-,L-,S-,R-,Q-,I-}
  24. {$endif}
  25.  
  26. library WMFIMP;
  27. {$D Copyright⌐ 1993 by Mario M. Westphal. Import filter for APM Metafiles. }
  28. {$C MOVEABLE PRELOAD DISCARDABLE}
  29.  
  30. uses
  31.   WinTypes,
  32.   WinProcs,
  33.   Objects,
  34.   Win31,
  35.   Strings,
  36.   SysTools,
  37.   bpwmfimp;
  38.  
  39. const
  40.   FILTERVERSION  = $0102;                   { Aktuelle Version der Bibliothek }
  41.   APMID          = $9AC6CDD7;               { Kennung APM File }
  42.   HFILE_ERROR    = -1;                      { Ergebnis von _llseek }
  43.  
  44. var
  45.   MFUsesOwnPal   : Boolean;                 { Wird von EnumMetaFileColors verwendet }
  46.  
  47. {*******************************************************************************}
  48. { Sortierte Kollektion mit PaletteneintrΣgen                                    }
  49. { Wird zur Zwischenspeicherung bei der Analyse des Metafiles verwendet.         }
  50. { Sortiert wird nach RGB-Werten und deren HΣufigkeit. Dies ist eine ziemliche   }
  51. { "brute force"-Methode, aber das Einfⁿgen eines besseren Algorithmus ist ohne  }
  52. { Probleme machbar.                                                             }
  53. {*******************************************************************************}
  54. type
  55.   { Ein Eintrag in der Palette }
  56.   PPalEntry = ^TPalEntry;
  57.   TPalEntry = object(TObject)
  58.       Color : TColorRef;              { RGB-Wert }
  59.       Count : LongInt;                { Anzahl der Referenzen auf diese Farbe }
  60.     constructor Init (C: TColorRef);
  61.     destructor Done; virtual;
  62.   end;
  63.  
  64.   constructor TPalEntry.Init (C: TColorRef);
  65.   begin
  66.     Inherited Init;
  67.     Color := C;
  68.     Count := 1;
  69.   end;
  70.  
  71.   destructor TPalEntry.Done ;
  72.   begin
  73.     Inherited Done;
  74.   end;
  75.  
  76. type
  77.   { Kollektion fⁿr die Metafile-Palette. Sortiert nach RGB-Werten. }
  78.   PPalCol = ^TPalCol;
  79.   TPalCol = object(TSortedCollection)
  80.     function KeyOf (Item: Pointer) : Pointer; virtual;
  81.     function Compare (Key1, Key2: Pointer) : Integer; virtual;
  82.   end;
  83.  
  84.   { Schlⁿssel ist die Farbe }
  85.   function TPalCol.KeyOf (Item: Pointer) : Pointer;
  86.   begin
  87.     KeyOf := @TPalEntry(Item^).Color;
  88.   end;
  89.  
  90.   { Sortieren nach RGB-Werten }
  91.   function TPalCol.Compare (Key1, Key2: Pointer) : Integer;
  92.   begin
  93.     if      TColorRef(Key1^) < TColorRef(Key2^) then Compare := -1
  94.     else if TColorRef(Key1^) > TColorRef(Key2^) then Compare :=  1
  95.     else                                             Compare :=  0;
  96.   end;
  97.  
  98. {-------------------------------------------------------------------------------
  99.   Liefert die Versionsnummer des Filters
  100. }
  101. function GetFilterVersion : Word; EXPORT;
  102. begin
  103.   GetFilterVersion := FILTERVERSION;
  104. end; { GetFilterVersion }
  105.  
  106.  
  107. {-------------------------------------------------------------------------------
  108.   Callback-Funktion fⁿr EnumMetafile.
  109.   Diese Funktion extrahiert aus den Records des Metafiles alle RGB-Werte
  110.   (einschlie▀lich der Paletten in Bitmap-Feldern) und erzeugt daraus eine
  111.   Kollektion mit FarbeintrΣgen und der absoluten HΣufigkeit, mit der die
  112.   jeweilige Farbe refernziert wird.
  113.   Die hier gewonnenen Informationen werden spΣter verwendet, um eine optimale
  114.   Palette anzulegen. Dazu werden alle RGB-Farbbezⁿge, die direkt angegeben
  115.   wurden, in Paletten-relative RGB-Werte umgerechnet. Dadurch wird die erzeugte
  116.   Palette von allen Elementen des Metafiles verwendet.
  117.  
  118.   PARAMETER:
  119.     Die fⁿr ein Metafile-Callback ⁿblichen Parameter. lParam enthΣlt den
  120.     Zeiger auf die Kollektion mit FarbeintrΣgen.
  121.   ERGEBNIS:
  122.     Immer <> 0, damit die AufzΣhlung fortgesetzt wird.
  123.  
  124. }
  125. function EnumMetaFileColors (PaintDC: HDC; lpHt, lpMR: Pointer;
  126.                              cObj: Integer; lParam: PPalCol) : Integer; EXPORT;
  127.  
  128. type
  129.   { Special Metafile-Records }
  130.  
  131.   { meta_StretchBlt }
  132.   PStretchBlt = ^TStretchBlt;
  133.   TStretchBlt = record
  134.     RopLo       : Word;
  135.     RopHi       : Word;
  136.     SYE         : Word;
  137.     SXE         : Word;
  138.     SY          : Word;
  139.     SX          : Word;
  140.     DYE         : Word;
  141.     DXE         : Word;
  142.     DY          : Word;
  143.     DX          : Word;
  144.     BitmapInfo    : TBitmapInfo;
  145.     bits          : array[0..0] of Byte;
  146.   end;
  147.  
  148. type
  149.   { meta_StretchDIB }
  150.   PStretchDIB = ^TStretchDIB;
  151.   TStretchDIB = record
  152.     RopLo       : Word;
  153.     RopHi       : Word;
  154.     Usag        : Word;
  155.     srcYExt     : Word;
  156.     srcXExt     : Word;
  157.     srcY        : Word;
  158.     srcX        : Word;
  159.     dstYExt     : Word;
  160.     dstXExt     : Word;
  161.     dstY        : Word;
  162.     dstX        : Word;
  163.     BitmapInfo  : TBitmapInfo;
  164.     bits        : Word;
  165.   end;
  166.  
  167. type
  168.   { meta_SetDIBitsToDevice }
  169.   PSetDIBits = ^TSetDIBits;
  170.   TSetDIBits = record
  171.     wUsage      : Word;
  172.     numscans    : Word;
  173.     startscan   : Word;
  174.     srcY        : Word;
  175.     srcX        : Word;
  176.     extY        : Word;
  177.     extX        : Word;
  178.     destY       : Word;
  179.     destX       : Word;
  180.     BitmapInfo  : TBitmapInfo;
  181.     bits        : Word;
  182.   end;
  183.  
  184. type
  185.   { meta_bitblt }
  186.   PBitBlt = ^TBitBlt;
  187.   TBitBlt = record
  188.     RopLo       : Word;
  189.     RopHi       : Word;
  190.     SY          : Word;
  191.     SX          : Word;
  192.     DYE         : Word;
  193.     DXE         : Word;
  194.     DY          : Word;
  195.     DX          : Word;
  196.     BitmapInfo  : TBitmapInfo;
  197.     bits        : Word;
  198.   end;
  199.  
  200. type
  201.   { meta_setpixel }
  202.   PSetPixelRec = ^TSetPixelRec;
  203.   TSetPixelRec = record
  204.     x     : Word;
  205.     y     : Word;
  206.     Color : TColorRef;
  207.   end;
  208.  
  209. type
  210.   { meta_floodfill }
  211.   PFloodFillRec = ^TFloodFillRec;
  212.   TFloodFillRec = record
  213.     x     : Integer;
  214.     y     : Integer;
  215.     Color : TColorRef;
  216.   end;
  217.  
  218. type
  219.   PColorRef   = ^TColorRef;
  220.   PRGBColors  = ^TRGBColors;
  221.   TRGBColors  = array[0..0] of TRGBQUAD;
  222.  
  223. var
  224.   MR    : PMetaRecord;
  225.   L     : PLogBrush;
  226.   P     : PLogPen;
  227.  
  228.   i     : Integer;
  229.   j     : LongInt;
  230.  
  231.   TC    : PColorRef;
  232.   RC    : TColorRef;
  233.  
  234.   bmInfo: PBitmapInfo;
  235.   Colors: LongInt;
  236.  
  237.   x,y   : Integer;
  238.   PP    : PPoint;
  239.  
  240. {$ifopt R+}
  241.   {$define R_ON}
  242.   {$R-}
  243. {$endif}
  244.  
  245.   { Fⁿgt alle Farben aus der ⁿbergebenen Bitmap-Palette in die Paletten-Kollektion ein }
  246.   procedure ScanBMPPal (pPal: PRGBColors; Count: Word);
  247.   var
  248.     j : Word;
  249.     TC: TColorRef;
  250.   begin
  251.     for j := 0 to Pred(Count) do
  252.     begin
  253.       with pPal^[j] do TC := RGB(rgbRed,rgbGreen,rgbBlue);
  254.       if lParam^.Search(@TC,i) then
  255.         inc(TPalEntry(lParam^.At(i)^).Count)      { RGB-Wert bereits enthalten! }
  256.       else
  257.         lParam^.Insert(New(PPalEntry,Init(TC)));  { Neue Farbe => in Palette aufnehmen }
  258.     end;
  259.   end;
  260.  
  261.  
  262. begin
  263.   MR := lpMR;
  264.   case MR^.rdFunction of
  265.  
  266.     META_CREATEBRUSHINDIRECT : begin
  267.       L := @MR^.rdParm;
  268.       if lParam^.Search(@L^.lbColor,i) then
  269.         inc(TPalEntry(lParam^.At(i)^).Count)                { Farbe bereits vorhanden }
  270.       else
  271.         lParam^.Insert(New(PPalEntry,Init(L^.lbColor)));    { Neuer Eintrag }
  272.       { RGB-Wert -> Palettenbezogener RGB-Wert }
  273.       L^.lbColor := L^.lbColor or $02000000
  274.     end; { meta_createbrushindirect }
  275.  
  276.  
  277.     META_CREATEPENINDIRECT : begin
  278.       P := @MR^.rdParm;
  279.       if lParam^.Search(@P^.lopnColor,i) then
  280.         inc(TPalEntry(lParam^.At(i)^).Count)
  281.       else
  282.         lParam^.Insert(New(PPalEntry,Init(P^.lopnColor)));
  283.       { RGB-Wert -> Palettenbezogener RGB-Wert }
  284.       P^.lopnColor := P^.lopnColor or $02000000
  285.     end; { meta_createpenindirect }
  286.  
  287.  
  288.     META_SETBKCOLOR : begin
  289.       TC := PColorRef(@MR^.rdParm);
  290.       if lParam^.Search(@TC,i) then
  291.         inc(TPalEntry(lParam^.At(i)^).Count)
  292.       else
  293.         lParam^.Insert(New(PPalEntry,Init(TC^)));
  294.       { RGB-Wert -> Palettenbezogener RGB-Wert }
  295.       TC^ := TC^ and $02000000;
  296.     end;
  297.  
  298.  
  299.     META_SETPIXEL : begin
  300.       TC := @PSetPixelRec(@MR^.rdParm)^.Color;
  301.       if lParam^.Search(@TC,i) then
  302.         inc(TPalEntry(lParam^.At(i)^).Count)
  303.       else
  304.         lParam^.Insert(New(PPalEntry,Init(TC^)));
  305.       { RGB-Wert -> Palettenbezogener RGB-Wert }
  306.       TC^ := TC^ and $02000000;
  307.     end;
  308.  
  309.  
  310.     META_SETTEXTCOLOR : begin
  311.       TC := PColorRef(@MR^.rdParm);
  312.       if lParam^.Search(@TC,i) then
  313.         inc(TPalEntry(lParam^.At(i)^).Count)
  314.       else
  315.         lParam^.Insert(New(PPalEntry,Init(TC^)));
  316.       { RGB-Wert -> Palettenbezogener RGB-Wert }
  317.       TC^ := TC^ and $02000000;
  318.     end;
  319.  
  320.  
  321.     META_FLOODFILL : begin
  322.       TC := @PFloodFillRec(@MR^.rdParm)^.Color;
  323.       if lParam^.Search(@TC,i) then
  324.         inc(TPalEntry(lParam^.At(i)^).Count)
  325.       else
  326.         lParam^.Insert(New(PPalEntry,Init(TC^)));
  327.       { RGB-Wert -> Palettenbezogener RGB-Wert }
  328.       TC^ := TC^ and $02000000;
  329.     end;
  330.  
  331.     META_STRETCHDIB,
  332.     META_SETDIBTODEV,
  333.     META_STRETCHBLT,
  334.     META_BITBLT     : begin
  335.       case MR^.rdFunction of
  336.         META_STRETCHDIB   : bmInfo := @PStretchDIB(@MR^.rdParm)^.BitmapInfo;
  337.         META_SETDIBTODEV  : bmInfo := @PSetDIBits(@MR^.rdParm)^.BitmapInfo;
  338.         META_STRETCHBLT   : bmInfo := @PStretchBlt(@MR^.rdParm)^.BitmapInfo;
  339.         META_BITBLT       : bmInfo := @PBitBlt(@MR^.rdParm)^.BitmapInfo;
  340.       end; { case }
  341.  
  342.       { Ermittle die Anzahl der Farben in der Bitmap }
  343.       with bmInfo^.bmiHeader do
  344.       begin
  345.         if biClrUsed <> 0 then       Colors := biClrUsed
  346.         else if biBitCount < 24 then Colors := 1 shl biBitCount
  347.         else                         Colors := 0; { flag 24-Bit }
  348.       end;
  349.  
  350.       if Colors > 0 then  { Keine 24-Bit Bimap }
  351.       begin
  352.         ScanBMPPal(@bmInfo^.bmiColors,Colors);
  353.       end
  354.       else
  355.       begin
  356.         { Analyse eines 24-Bit Bitmaps }
  357.         { Zu aufwenig fⁿr den Zweck. Um ein 24-Bit Bitmap darzustellen, mⁿ▀te dieses }
  358.         { auch gedithert werden. Dieser Proze▀ ist zu aufwendig fⁿr das einmalige    }
  359.         { Darstellen eines Bildes und wird aus diesem Grund hier nicht durchgefⁿhrt. }
  360.       end;
  361.     end; { Bitmaps }
  362.  
  363.  
  364.     { Die paletten-spezifischen Records des Metafiles werden nicht interpretiert,   }
  365.     { sondern werden nur abgefangen, um das globale Flag MFUsesOwnPal zu setzen.    }
  366.     { Die aufrufende Anwendung kann dann entscheiden, ob sie die aufgebaute Palette }
  367.     { oder die im Metafile enthaltene Palette benutzt.                              }
  368.  
  369.     META_ANIMATEPALETTE,
  370.     META_CREATEPALETTE,
  371.     META_RESIZEPALETTE,
  372.     META_SELECTPALETTE,
  373.     META_SETPALENTRIES,
  374.     META_REALIZEPALETTE : begin
  375.  
  376.       MFUsesOwnPal := true;
  377.  
  378.     end;
  379.  
  380.   end; { case }
  381.  
  382. {$ifdef R_ON}
  383.   {$undef R_ON}
  384.   {$R+}
  385. {$endif}
  386.   EnumMetaFileColors := 1;
  387. end;
  388.  
  389.  
  390. {-------------------------------------------------------------------------------
  391.   Erzeugt eine Palette aus dem ⁿbergebenen Metafile.
  392.   Diese Funktion prⁿft, ob der Bildschirm rasterfΣhig ist und erzeugt nur
  393.   dann eine Palette, wenn dies n÷tig ist. Bei einer Videokarte mit 16 Farben
  394.   ist die Verwendung einer Palette nicht sinnvoll. Bei vielen Grafikkarten mit
  395.   mehr als 256 Farben wird ⁿberhaupt keine Palette mehr verwendet. Auch in
  396.   diesem Fall wird keine Palette erzeugt.
  397.  
  398.   PARAMETER:
  399.     hMF   : Handle des Metafiles
  400.     Flags : 0 : Normale Palette (Alle Farben des Metafiles sind enthalten.
  401.                 So kann die Palette von der aufrufenden Anwendung selbst
  402.                 optimiert werden.
  403.             1 : Die Palette des Metafiles wird nach HΣufigkeit sortiert und
  404.                 optimal an die Systempalette angepasst.
  405.   ERGEBNIS:
  406.     Der Handle einer Palette, wenn die Funktion erfolgreich ausgefⁿhrt wurde.
  407.     Andernfalls ist der Rⁿckgabewert 0.
  408.  
  409.     Der Parameter Flags wird auf 0 gesetzt, wenn im Metafile keine paletten-
  410.     spezifischen Records vorhanden sind, ansonsten auf 1.
  411. }
  412. function CreateFilePalette (hMF: THandle; var Flags: Byte) : HPalette;
  413. type
  414.   OP = record
  415.     Count : LongInt;
  416.     Color : TColorRef;
  417.   end;
  418.  
  419.   OPType  = array[0..0] of OP;
  420.  
  421. var
  422.   LogPalette      : PLogPalette;
  423.   hPalette        : THandle;
  424.   PalEntrys       : Word;
  425.   PalCol          : PPalCol;
  426.   i,j             : LongInt;
  427.   hOptPal         : THandle;
  428.   OptPal          : ^OPType;
  429.   WinMaxPalEntrys : LongInt;
  430.   DC              : HDC;
  431.   EnumProc        : TFarProc;
  432.  
  433. {$ifopt R+}
  434.   {$define R_ON}
  435.   {$R-}
  436. {$endif}
  437.  
  438.   { Sortiert die Palette nach dem Feld "Count". Einfacher Bubble-Sort. }
  439.   procedure SortOptPal;
  440.   var
  441.     Temp  : OP;
  442.     i1,i2 : LongInt;
  443.   begin
  444.     for i1 := 0 to PalCol^.Count-2 do
  445.     begin
  446.       for i2 := Pred(PalCol^.Count) downto Succ(i1) do
  447.       begin
  448.         if OptPal^[i1].Count < OptPal^[i2].Count then
  449.         begin
  450.           Temp := OptPal^[i1];
  451.           OptPal^[i1] := OptPal^[i2];
  452.           OptPal^[i2] := Temp;
  453.         end;
  454.       end;
  455.     end;
  456.   end;
  457.  
  458.  
  459. begin
  460.   { Hole maximale Palettengr÷▀e }
  461.   DC := CreateDC('DISPLAY',nil,nil,nil);
  462.  
  463.   if (GetDeviceCaps(DC,RASTERCAPS) and RC_PALETTE <> 0) then
  464.   begin
  465.     { Maximale Anzahl: Gr÷▀e der Systempalette - Anzahl der reservierten Farben }
  466.     WinMaxPalEntrys := Word(GetDeviceCaps(DC,SIZEPALETTE)) - GetDeviceCaps(DC,NUMRESERVED);
  467.   end
  468.   else
  469.   begin
  470.     WinMaxPalEntrys := GetDeviceCaps(DC,NUMCOLORS);
  471.   end;
  472.  
  473.   { Kollektion fⁿr die MetaBild-Palette }
  474.   if WinMaxPalEntrys > 0 then
  475.   begin
  476.     New(PalCol,Init(WinMaxPalEntrys,10));
  477.     PalCol^.Duplicates := false;
  478.   end
  479.   else
  480.   begin
  481.     { In diesem Fall wird keine Palette ben÷tigt }
  482.     DeleteDC(DC);
  483.     CreateFilePalette := 0;
  484.     exit;
  485.   end;
  486.  
  487.   { Diese Variable wird von EnumMetaFileColors auf true gesetzt, wenn im }
  488.   { Metafile eine paletten-spezifische Funktion enthalten ist.           }
  489.   MFUsesOwnPal := false;
  490.  
  491.   { RGB-Werte aus dem Metafile auslesen und in die Kollektion aufnehmen }
  492.   EnumProc := MakeProcInstance(@EnumMetaFileColors,HInstance);
  493.   EnumMetaFile(DC,hMF,EnumProc,PalCol);
  494.   FreeProcInstance(EnumProc);
  495.  
  496.   DeleteDC(DC);
  497.  
  498.   { Wenn in der erzeugten Palette mehr EintrΣge enthalten sind, als in der }
  499.   { Systempalette Platz haben, werden hier die WinMaxPalEntrys's EintrΣge  }
  500.   { gesucht, die am hΣufigsten referenziert wurden. Aus diesen wird dann   }
  501.   { eine optimierte Palette aufgebaut.                                     }
  502.   if (Flags and 1 <> 0) and (PalCol^.Count > WinMaxPalEntrys) then
  503.   begin
  504.     PalEntrys := WinMaxPalEntrys;
  505.     hOptPal := GlobalAlloc(GHND,SizeOf(OPType)*PalCol^.Count);
  506.     OptPal := GlobalLock(hOptPal);
  507.  
  508.     { Alle EintrΣge aus der Kollektion kopieren }
  509.     for i := 0 to Pred(PalCol^.Count) do
  510.     begin
  511.       OptPal^[i].Count := PPalEntry(PalCol^.At(i))^.Count;
  512.       OptPal^[i].Color := PPalEntry(PalCol^.At(i))^.Color;
  513.     end;
  514.  
  515.     { Absteigend nach HΣufigkeit sortieren. OptPal enthΣlt dann alle PaletteneintrΣge,   }
  516.     { nach HΣufigkeit der Referenzierung sortiert. Die ersten "WinMaxPalEntrys" EintrΣge }
  517.     { bilden dann die zu realisierende Palette.                                          }
  518.     SortOptPal;
  519.  
  520.     { Speicher fⁿr die Palette holen }
  521.     hPalette := GlobalAlloc(GHND,SizeOf(LogPalette^)+PalEntrys*SizeOf(TPaletteEntry));
  522.     LogPalette := GlobalLock(hPalette);
  523.  
  524.     { Kompatible Palette aufbauen }
  525.     LogPalette^.palVersion := $300;
  526.     LogPalette^.palNumEntries := PalEntrys;
  527.     for i := 0 to Pred(PalEntrys) do
  528.     begin
  529.       LogPalette^.palpalEntry[i].peRed   := GetRValue(OptPal^[i].Color);
  530.       LogPalette^.palpalEntry[i].peGreen := GetGValue(OptPal^[i].Color);
  531.       LogPalette^.palpalEntry[i].peBlue  := GetBValue(OptPal^[i].Color);
  532.       LogPalette^.palpalEntry[i].peFlags := PC_NOCOLLAPSE;
  533.     end;
  534.  
  535.     CreateFilePalette := CreatePalette(LogPalette^);
  536.     GlobalUnlock(hPalette);
  537.     GlobalFree(hPalette);
  538.  
  539.     GlobalUnlock(hOptPal);
  540.     GlobalFree(hOptPal);
  541.   end
  542.  
  543.   else
  544.  
  545.   { Die erzeugte Palette lΣ▀t sich vollstΣndig in der Systempalette abbilden, oder }
  546.   { Flag wurde mit 0 ⁿbergeben => Erzeuge Palette mit allen Farben der Kollektion  }
  547.   begin
  548.     PalEntrys := PalCol^.Count;
  549.     hPalette := GlobalAlloc(GHND,SizeOf(LogPalette^)+PalEntrys*SizeOf(TPaletteEntry));
  550.     LogPalette := GlobalLock(hPalette);
  551.  
  552.     { Kompatible Palette aufbauen }
  553.     LogPalette^.palVersion := $300;
  554.     LogPalette^.palNumEntries := PalEntrys;
  555.     for i := 0 to Pred(PalEntrys) do
  556.     begin
  557.       LogPalette^.palpalEntry[i].peRed   := GetRValue(TPalEntry(PalCol^.At(i)^).Color);
  558.       LogPalette^.palpalEntry[i].peGreen := GetGValue(TPalEntry(PalCol^.At(i)^).Color);
  559.       LogPalette^.palpalEntry[i].peBlue  := GetBValue(TPalEntry(PalCol^.At(i)^).Color);
  560.       LogPalette^.palpalEntry[i].peFlags := PC_NOCOLLAPSE;
  561.     end;
  562.  
  563.     CreateFilePalette := CreatePalette(LogPalette^);
  564.     GlobalUnlock(hPalette);
  565.     GlobalFree(hPalette);
  566.   end;
  567.  
  568.   { Die Kollektion wird nicht mehr gebraucht }
  569.   Dispose(PalCol,Done);
  570.  
  571.   { Informationen ⁿber die Metafile-Palette zurⁿckliefern }
  572.   if MFUsesOwnPal then Flags := 1       { Eigene Palette im Metafile }
  573.                   else Flags := 0;      { Keine eigene Palette }
  574.  
  575. {$ifdef R_ON}
  576.   {$undef R_ON}
  577.   {$R+}
  578. {$endif}
  579. end;
  580.  
  581. {-------------------------------------------------------------------------------
  582.   LΣdt das Metafile aus der in FileSpec angegebenen Datei.
  583.   Die aktuelle Position in der Datei wird nicht verΣndert.
  584.  
  585.   PARAMETER:
  586.     FileSpec : EnthΣlt die Informationen, die zum Lesen
  587.                der Datei ben÷tigt werden.
  588.                In dieser Struktur werden auch Informationen
  589.                ⁿber das geladene Metafile zurⁿckgeliefert.
  590.   ERGEBNIS:
  591.     0 : Kein Fehler
  592.     1 : Keine APM-Datei
  593.     2 : Ungⁿltige Prⁿfsumme
  594.     3 : Fehler beim Lesen
  595.     4 : Datei nicht gefunden
  596.     5 : Allgemeiner Fehler
  597.     6 : Nicht genug Speicher
  598. }
  599. function LoadFile (var FileSpec: TFileSpec) : Integer; EXPORT;
  600. var
  601.   MFBits    : THandle;
  602.   MFRec     : TAPMFileHeader;
  603.   MH        : TMetaHeader;
  604.   Count     : Longint;
  605.   Size      : LongInt;
  606.   CheckSum  : Word;
  607.   i         : Integer;
  608.   TOF       : TOFStruct;
  609.   Bits      : Pointer;
  610.   fOldPos   : LongInt;
  611.   Flags     : Byte;
  612.  
  613. begin
  614.   if StrLen(FileSpec.Fullname) = 0 then           { Sicherheitshalber }
  615.   begin
  616.     LoadFile := 4;                                { FEHLER: Datei nicht gefunden }
  617.     exit;
  618.   end;
  619.  
  620.   fOldPos := FileSpec.FPos;
  621.   if _llSeek(FileSpec.FHandle,0,0) = HFILE_ERROR then
  622.   begin
  623.     LoadFile := 3;                                { FEHLER: Fehler beim Lesen }
  624.     exit;
  625.   end;
  626.  
  627.   { APM-Header lesen }
  628.   if _lread(FileSpec.FHandle,@MFRec,SizeOf(MFRec)) <> SizeOf(MFRec) then
  629.   begin
  630.     LoadFile := 3;                                { FEHLER: Fehler beim Lesen }
  631.     _llSeek(FileSpec.FHandle,FOldPos,0);
  632.     exit;
  633.   end;
  634.  
  635.   { Prⁿfen der Datei auf die APM-Kennung }
  636.   if MFRec.dwKey <> APMID then
  637.   begin
  638.     LoadFile := 1;                                { FEHLER: Keine APM-Datei }
  639.     _llSeek(FileSpec.FHandle,FOldPos,0);
  640.     exit;
  641.   end;
  642.  
  643.   { Prⁿfsumme testen: Die ersten 10 Words des Headers ⁿber XOR verknⁿpfen }
  644.   CheckSum := 0;
  645.   for i := 0 to 9 do
  646.   begin
  647.     CheckSum := CheckSum xor Word(Ptr(Seg(MFRec),Ofs(MFRec)+2*i)^);
  648.   end;
  649.   if CheckSum <> MFRec.wCheckSum then
  650.   begin
  651.     LoadFile := 2;                                { FEHLER: Falsche Prⁿfsumme }
  652.     _llSeek(FileSpec.FHandle,FOldPos,0);
  653.     exit;
  654.   end;
  655.  
  656.   { Metafile-Header lesen }
  657.   if _lread(FileSpec.FHandle,@MH,SizeOf(MH)) <> SizeOf(MH) then
  658.   begin
  659.     LoadFile := 3;                                { FEHLER: Fehler beim Lesen }
  660.     _llSeek(FileSpec.FHandle,FOldPos,0);
  661.     exit;
  662.   end
  663.   else
  664.   begin
  665.     { Zurⁿck an den Anfang des Metafile-Headers }
  666.     _llseek(FileSpec.FHandle,-SizeOf(MH),1);
  667.   end;
  668.  
  669.   { Alloziere Speicher und lade das Metafile in den globalen Heap. }
  670.   Size := MH.mtSize * 2;
  671.   MFBits := GlobalAlloc(GHND,Size);
  672.   if MFBits = 0 then
  673.   begin
  674.     LoadFile := 6;                                { FEHLER: Nicht genug Speicher }
  675.     _llSeek(FileSpec.FHandle,FOldPos,0);
  676.     exit;
  677.   end;
  678.  
  679.   Bits := GlobalLock(MFBits);
  680.   if _hread(FileSpec.FHandle,Bits,Size) <> Size then
  681.   begin
  682.     _llSeek(FileSpec.FHandle,FOldPos,0);
  683.     LoadFile := 3;                                { FEHLER: Fehler beim Lesen }
  684.     GlobalUnlock(MFBits);
  685.     GlobalFree(MFBits);
  686.     exit;
  687.   end;
  688.  
  689.   { Erzeuge aus dem globalen Speicher ein Memory-Metafile }
  690.   MFRec.hMF := SetMetaFileBits(MFBits);
  691.   GlobalUnlock(MFBits);
  692.  
  693.   { Informationen ⁿber das Metafile ablegen }
  694.   with FileSpec.FInfo do
  695.   begin
  696.     hMF := MFRec.hMF;                             { Handle der Datei }
  697.     lSize := Size;                                { Gr÷▀e des Metafiles im globalen Heap }
  698.     rcBBox := MFRec.rcBBox;                       { Umgebendes Rechteck }
  699.     wInch := MFRec.wInch;                         { Punkte pro logischem Zoll }
  700.   end;
  701.  
  702.   _llSeek(FileSpec.FHandle,FOldPos,0);            { Zurⁿck an die Startposition }
  703.  
  704.   if MFRec.hMF = 0 then
  705.     LoadFile := 6                                 { FEHLER: Nicht genug Speicher }
  706.   else
  707.   begin
  708.     LoadFile := 0;                                { Alles Ok! }
  709.     { Palette aufbauen }
  710.     case FileSpec.PalSpec of
  711.       bpBuilt    : begin
  712.                      Flags := 0;
  713.                      FileSpec.FInfo.hPal := CreateFilePalette(MFRec.hMF,Flags);
  714.                    end;
  715.       bpOptimize : begin
  716.                      Flags := 1;
  717.                      FileSpec.FInfo.hPal := CreateFilePalette(MFRec.hMF,Flags);
  718.                    end;
  719.       else         begin
  720.                      FileSpec.FInfo.hPal := 0;
  721.                      Flags := 0;
  722.                    end;
  723.     end; { case }
  724.  
  725.     { OwnPal ist true, wenn das Metafile paletten-spezifische Records enthΣlt }
  726.     FileSpec.FInfo.OwnPal := Flags <> 0;
  727.   end;
  728. end;
  729.  
  730.  
  731. {*******************************************************************************}
  732. { EXPORT Section                                                                }
  733. {*******************************************************************************}
  734. EXPORTS
  735.   GetFilterVersion                INDEX 1,
  736.   LoadFile                        INDEX 2;
  737.  
  738.  
  739. {*******************************************************************************}
  740. { LibMain und WEP                                                               }
  741. {*******************************************************************************}
  742. var
  743.   SavedExitProc : Pointer;
  744.  
  745. {-------------------------------------------------------------------------------
  746.   Exitprozedur der Bibliothek
  747. }
  748. procedure LibExit; Far;
  749. begin
  750.   ExitProc := SavedExitProc;
  751. end;
  752.  
  753. BEGIN
  754.   SavedExitProc := @ExitProc;
  755. END.