home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9303 / metawin / wmfview.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-05  |  29.7 KB  |  1,008 lines
  1. {$define RETAIL_VERSION}
  2. {!define Win32}
  3. {***************************************************************************
  4.   Source File Name     :  WMFVIEW.PAS
  5.   Autor                :  Mario M.  Westphal
  6.   Erstellt am          :  20.02.1993
  7.  
  8.   Compiler             :  Borland Pascal for Windows
  9.   Betriebssystem       :  DOS 5.0, Windows 3.x
  10.   Compiler-Schalter    :  -
  11.  
  12.   Bemerkungen          :  -
  13.  
  14.   Beschreibung         :
  15.  
  16.  
  17.   Revisionen           :  1.00 20.02.1993 created (MW)
  18.                                07.04.1993 revisited (MW)
  19. ****************************************************************************}
  20. {$M 8192,8192}
  21. {$A+,B-,D+,F-,G+,I+,L+,N-,R+,S+,V+,W-,X+,Q+}
  22.  
  23. {$ifdef RETAIL_VERSION}
  24.   {$D-,L-,S-,R-,Q-,I-}
  25. {$endif}
  26.  
  27. program MetafileViewer;
  28. {$R WMFVIEW.RES}
  29.  
  30. uses
  31.   WinTypes,
  32.   WinProcs,
  33.   Objects,
  34.   OMemory,
  35.   OWindows,
  36.   ODialogs,
  37.   OStdDlgs,
  38.   WinDOS,
  39.   Win31,
  40.   CommDlg,
  41.   Strings,
  42.   ShellAPI,
  43.   ToolHelp,
  44.  
  45.   SysTools,
  46.   ExDlg,
  47.   BPWmfImp;
  48.  
  49. const
  50.     AppName         = 'Metafile Viewer';
  51.  
  52.   { Menu - IDs }
  53.   idm_Load        = 101;
  54.   idm_About       = 102;
  55.   idm_Close       = 103;
  56.  
  57.   idm_PalOptimize = 201;
  58.   idm_Directmode  = 202;
  59.  
  60.   idm_ZOriginal   = 301;
  61.   idm_ZClient     = 302;
  62.   idm_200         = 303;
  63.   idm_400         = 304;
  64.   idm_50          = 305;
  65.   idm_25          = 306;
  66.  
  67. type
  68.     PMWindow = ^TMWindow;
  69.     TMWindow = object(TWindow)
  70.       MFName           : array[0..255] of Char;       { Dateiname Metafile }
  71.       MFInfo           : TFileSpec;                   { Struktur fⁿr Loadmetafile }
  72.       MFNoRecs         : LongInt;                     { Anzahl Records im Metafile }
  73.       Pal              : HPalette;                    { Metafile-Palette }
  74.       OldPal           : HPalette;                    { Original-Palette }
  75.       PalOptimize      : Boolean;                     { True => Palette optimieren }
  76.       DirectMode       : Boolean;                     { True => Keine Offscreen-Technik }
  77.       Zoom             : Real;                        { Aktueller Zoomfaktor }
  78.       LastZoomID       : Word;                        { Fⁿr Checkmenuitem }
  79.       HomeDir          : array[0..255] of Char;       { Fⁿr die INI-Dateien }
  80.       HasBitmapMem     : Boolean;                     { True => Genug Speicher fⁿr OffScreen-Bitmap }
  81.       hbmClient        : HBitmap;                     { Offscreen-Bitmap }
  82.       cxBitmap         : Integer;                     { Gr÷▀e der Bitmap }
  83.       cyBitmap         : Integer;
  84.       cxMeta           : Integer;                     { Gr÷▀e des Metafiles (ohne Zoom) }
  85.       cyMeta           : Integer;
  86.       XLogPixels       : Integer;                     { Pixel/Zoll des Bildschirms }
  87.       YLogPixels       : Integer;
  88.  
  89.         constructor Init (AParent: PWindowsObject; ATitle: PChar);
  90.  
  91.         procedure SetupWindow; virtual;
  92.  
  93.     function  CanClose : Boolean; virtual;
  94.  
  95.         destructor Done; virtual;
  96.  
  97.         function     GetClassName: PChar; virtual;
  98.  
  99.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  100.  
  101.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  102.  
  103.     procedure WMQueryNewPalette (var Msg: TMessage);
  104.       virtual wm_First or wm_QueryNewPalette;
  105.  
  106.     procedure WMPaletteChanged (var Msg: TMessage);
  107.       virtual wm_First or wm_PaletteChanged;
  108.  
  109.     procedure ShowMetaFile (PaintDC: HDC);
  110.  
  111.     procedure WMSize (var Msg: TMessage);
  112.       virtual wm_First or wm_Size;
  113.  
  114.     procedure WMKeyDown (var Msg: TMessage);
  115.       virtual wm_First or wm_KeyDown;
  116.  
  117.     procedure ProcessLoadFile (FileName: PChar);
  118.  
  119.     procedure CalcNewValues;
  120.  
  121.     procedure RedrawWindow;
  122.  
  123.     { Menⁿ Datei }
  124.     procedure IDMLoad (var Msg: TMessage);
  125.       virtual cm_First or idm_Load;
  126.  
  127.     procedure IDMAbout (var Msg: TMessage);
  128.       virtual cm_First or idm_About;
  129.  
  130.     procedure IDMClose (var Msg: TMessage);
  131.       virtual cm_First or idm_Close;
  132.  
  133.     { Menⁿ Optionen }
  134.     procedure IDMPalOptimize (var Msg: TMessage);
  135.       virtual cm_First or idm_PalOptimize;
  136.  
  137.     procedure IDMDirectMode (var Msg: TMessage);
  138.       virtual cm_First or idm_DirectMode;
  139.  
  140.     { Menⁿ Zoom }
  141.     procedure IDMZoomOriginal (var Msg: TMessage);
  142.       virtual cm_First or idm_ZOriginal;
  143.  
  144.     procedure IDMZoomClient (var Msg: TMessage);
  145.       virtual cm_First or idm_ZClient;
  146.  
  147.     procedure IDMZoom200 (var Msg: TMessage);
  148.       virtual cm_First or idm_200;
  149.  
  150.     procedure IDMZoom400 (var Msg: TMessage);
  151.       virtual cm_First or idm_400;
  152.  
  153.     procedure IDMZoom50 (var Msg: TMessage);
  154.       virtual cm_First or idm_50;
  155.  
  156.     procedure IDMZoom25 (var Msg: TMessage);
  157.       virtual cm_First or idm_25;
  158.  
  159.     { Drag 'n Drop }
  160.         procedure WMDropFiles (var Msg: TMessage);
  161.             virtual wm_First + wm_DropFiles;
  162.  
  163.     { INI-Datei }
  164.  
  165.     procedure ReadINIData;
  166.     procedure WriteINIData;
  167.     end;
  168.  
  169. {-------------------------------------------------------------------------------
  170.   Liefert die Gr÷▀e des freien linearen Adressraumes. Durch einen Aufruf der
  171.   TOOLHELP.Routine MemManInfo wird die Anzahl der freien Seiten im Sytem
  172.   ermittelt und mit der Gr÷▀e einer Seize multipliziert. Der resultierende
  173.   Wert gibt die Gr÷▀e des Speichers an, den Windows ohne Swappen zur Verfⁿgung
  174.   stellen kann.
  175.   Die Funktion liefert allerdings nur im erweiterten Modus korrekte Werte. Im
  176.   Standardmodus, oder wenn die DLL nicht gefunden wurde, liefert die Funktion
  177.   als Default den gesamten verfⁿgbaren Speicher, inclusive Swapping-Option.
  178. }
  179. function GetFreeLinearSpace : LongInt;
  180. var
  181.   pInfo  : TMemManInfo;
  182. begin
  183.   pInfo.dwSize := SizeOf(pInfo);
  184.   if MemManInfo(@pInfo) then
  185.   begin
  186.     if GetWinFlags and WF_ENHANCED <> 0 then
  187.       GetFreeLinearSpace := pInfo.dwMaxPagesLockable * pInfo.wPageSize
  188.     else
  189.       GetFreeLinearSpace := pInfo.dwLargestFreeBlock;
  190.   end
  191.   else
  192.     GetFreeLinearSpace := GetFreeSpace(0);
  193. end;
  194.  
  195.  
  196. {*******************************************************************************}
  197. { TMWindow                                                                      }
  198. {*******************************************************************************}
  199. constructor TMWindow.Init (AParent : PWindowsObject; ATitle: PChar);
  200. var IC : HDC;
  201. begin
  202.     Inherited Init(AParent, ATitle);
  203.     Attr.W := (GetSystemMetrics(sm_CXScreen))-100;
  204.     Attr.H := (GetSystemMetrics(sm_CYScreen))-100;
  205.     Attr.X := (GetSystemMetrics(sm_CXScreen) div 2) - Attr.W div 2;
  206.     Attr.Y := (GetSystemMetrics(sm_CYScreen) div 2) - Attr.H div 2;
  207.     Attr.Style := ws_OverlappedWindow or ws_ClipChildren or ws_HScroll or ws_VScroll;
  208.   Attr.Menu := LoadMenu(HInstance,'MNU_MAIN');
  209.  
  210.   Scroller := New(PScroller,Init(@Self,1,1,0,0));
  211.  
  212.   FillChar(MFinfo,SizeOf(MFInfo),0);
  213.   MFName[0] := #0;
  214.  
  215.   Pal := 0;
  216.   CheckMenuItem(Attr.Menu,idm_PalOptimize,MF_CHECKED);
  217.   Zoom := 0;                                { Default: Originalgr÷▀e }
  218.   LastZoomID := idm_ZOriginal;
  219.   CheckMenuItem(Attr.Menu,idm_ZOriginal,MF_CHECKED);
  220.   hbmClient := 0;
  221.   HasBitmapMem := true;
  222.   DirectMode := false;
  223.   OldPal := 0;
  224.  
  225.   { Ermittle Aufl÷sung Pixel/log. Zoll }
  226.   IC := CreateIC('DISPLAY',nil,nil,nil);
  227.   XLogPixels := GetDeviceCaps(IC,LOGPIXELSX);
  228.   YLogPixels := GetDeviceCaps(IC,LOGPIXELSY);
  229.  
  230.   { Verfⁿgt der Treiber ⁿber eine Palette? }
  231.   PalOptimize := (GetDeviceCaps(IC,RASTERCAPS) and RC_PALETTE <> 0);
  232.   { Wenn nicht, ist auch keine Optimierung n÷tig }
  233.   if not PalOptimize then
  234.     EnableMenuItem(Attr.Menu,idm_PalOptimize,MF_BYCOMMAND or MF_GRAYED);
  235.  
  236.   DeleteDC(IC);
  237. end;
  238.  
  239. {-------------------------------------------------------------------------------
  240.   Drag 'n Drop API ankurbeln und Initialisierungsdaten lesen
  241. }
  242. procedure TMWindow.SetupWindow;
  243. begin
  244.     Inherited SetupWindow;
  245.     DragAcceptFiles(HWindow,true);
  246.   ReadINIData;
  247. end;
  248.  
  249. {-------------------------------------------------------------------------------
  250.   Drag 'n Drop abschlie▀en, Initialisierungsdaten wegschreiben.
  251. }
  252. function TMWindow.CanClose : Boolean;
  253. begin
  254.   DragAcceptFiles(HWindow,false);
  255.   WriteINIData;
  256.   CanClose := true;
  257. end;
  258.  
  259. {-------------------------------------------------------------------------------
  260.   Palette und Metafile freigeben
  261. }
  262. destructor TMWindow.Done;
  263. var
  264.   DC : HDC;
  265. begin
  266.   if OldPal <> 0 then
  267.   begin
  268.     { Palette aktivieren, die beim Programmstart aktiv war }
  269.     DC := GetDC(HWindow);
  270.     SelectPalette(DC,OldPal,true);
  271.     RealizePalette(DC);
  272.     ReleaseDC(HWindow,DC);
  273.   end;
  274.  
  275.   if Pal <> 0 then
  276.   begin
  277.     DeleteObject(Pal);
  278.     Pal := 0;
  279.   end;
  280.  
  281.   if MFInfo.FInfo.hMF <> 0 then
  282.   begin
  283.     DeleteMetaFile(MFInfo.FInfo.hMF);
  284.     MFInfo.FInfo.hMF := 0;
  285.   end;
  286.  
  287.   if hbmClient <> 0 then
  288.   begin
  289.     DeleteObject(hbmClient);
  290.     hbmClient := 0;
  291.   end;
  292.  
  293.     Inherited Done;
  294. end;
  295.  
  296. {-------------------------------------------------------------------------------
  297. }
  298. function TMWindow.GetClassName: PChar;
  299. begin
  300.     GetClassName := 'METAFILE_VIEWER';
  301. end;
  302.  
  303. {-------------------------------------------------------------------------------
  304. }
  305. procedure TMWindow.GetWindowClass(var AWndClass: TWndClass);
  306. begin
  307.     Inherited GetWindowClass(AWndClass);
  308.   AWndClass.hIcon := LoadIcon(HInstance,'ICON_APP');
  309.   AWndClass.Style := AWndClass.Style and CS_BYTEALIGNWINDOW;
  310. end;
  311.  
  312. {-------------------------------------------------------------------------------
  313.   Anzeigen des Metafiles. Erzeugt eine OffScreen-Bitmap, wenn die Bitmap im
  314.   physikalisch vorhandenen Speicher angelegt werden kann. Justiert die
  315.   Scroller.
  316. }
  317. procedure TMWindow.ShowMetaFile (PaintDC: HDC);
  318. var
  319.   OldDc         : Integer;
  320.   Pnt           : TPoint;
  321.   Size          : TSize;
  322.   MemDC         : HDC;
  323.   hbmOld        : HBitmap;
  324.   hpOld         : HPalette;
  325.   R             : TRect;
  326.   SizeOfBitmap  : LongInt;
  327.  
  328.   { Fenstertitel anpassen }
  329.   procedure ChangeCaption (IsOffScreen: Boolean);
  330.   var
  331.     Caption : array[0..255] of Char;
  332.   begin
  333.        StrCopy(Caption, AppName);
  334.     StrCat(Caption, ': ');
  335.       StrCat(Caption, AnsiLower(MFName));
  336.     if IsOffScreen then StrCat(Caption,' (OffScreen)')
  337.                    else StrCat(Caption,' (Direct)');
  338.     SetCaption(Caption);
  339.   end;
  340.  
  341. begin
  342.   if MFInfo.FInfo.hMF <> 0 then
  343.   begin
  344.     { Erzeugen eines Bitmaps, da▀ das Metafile im aktuellen Zoomfaktor aufnehmen kann }
  345.     if not DirectMode then
  346.     begin
  347.       { Berechne die Gr÷▀e der resultierenden Bitmap }
  348.       SizeOfBitmap := (LongInt((cxBitmap+1))*(cyBitmap+1) *
  349.                        LongInt(GetDeviceCaps(PaintDC,BITSPIXEL))) div 8;
  350.       { Wenn die Bitmap ohne das Auslagern von Seiten angelegt werden kann, wird sie }
  351.       { erzeugt, im anderen Fall wird der "Direct"-Modus verwendet.                  }
  352.       if GetFreeLinearSpace > SizeOfBitmap then
  353.         hbmClient := CreateCompatibleBitmap(PaintDC,cxBitmap+1,cyBitmap+1)
  354.       else
  355.         hbmClient := 0;
  356.     end
  357.     else
  358.       hbmClient := 0;
  359.     HasBitmapMem := hbmClient <> 0;
  360.  
  361.     { Wenn genug Speicher fⁿr die Bitmap vorhanden war }
  362.     if HasBitmapMem then
  363.     begin
  364.       Scroller^.TrackMode := true;
  365.       Scroller^.AutoMode := true;
  366.       ChangeCaption(true);
  367.  
  368.       MemDC := CreateCompatibleDC(PaintDC);
  369.       SetMapMode(MemDC,MM_ANISOTROPIC);
  370.       SetViewPortOrgEx(MemDC,0,0,@Pnt);
  371.       hbmOld := SelectObject(MemDC,hbmClient);
  372.       SetViewPortExtEx(MemDC,cxBitmap,cyBitmap,@Size);
  373.       if Pal <> 0 then
  374.       begin
  375.         hpOld := SelectPalette(MemDC,Pal,false);
  376.         if OldPal = 0 then OldPal := hpOld;
  377.         RealizePalette(MemDC);
  378.       end
  379.       else
  380.         hpOld := 0;
  381.  
  382.       GetClientRect(HWindow,R);
  383.       FillRect(MemDC,R,GetStockObject(WHITE_BRUSH));
  384.       PlayMetaFileExtended(@Self,MemDC,MFInfo.FInfo.hMF,MFNoRecs);
  385.       if hpOld <> 0 then SelectPalette(MemDC,hpOld,false);
  386.       SelectObject(MemDC,hbmOld);
  387.       DeleteDC(MemDC);
  388.     end
  389.     else
  390.     begin
  391.       { Nicht genug Speicher fⁿr die Bitmap => Direct-Mode }
  392.       Scroller^.TrackMode := false;
  393.       Scroller^.AutoMode := false;
  394.       ChangeCaption(false);
  395.     end;
  396.   end; { hMF <> 0 }
  397. end;
  398.  
  399. {-------------------------------------------------------------------------------
  400.   Realisiert die Palette und ruft ShowMetaFile auf, wenn eine OffScreen-Bitmap
  401.   existiert. Im anderen Fall wird das Metafile direkt angezeigt.
  402. }
  403. procedure TMWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  404. var
  405.   hbmOld     : HBitmap;
  406.   hpOld      : HPalette;
  407.   MemDC      : HDC;
  408.   R          : TRect;
  409.   Pnt        : TPoint;
  410.   Size       : TSize;
  411.   x,y        : LongInt;
  412.  
  413. begin
  414.   if MFInfo.FInfo.hMF <> 0 then
  415.   begin
  416.     if (HasBitmapMem) and (hbmClient = 0) then
  417.     begin
  418.       ShowMetaFile(PaintDC);
  419.     end;
  420.  
  421.     if Scroller^.HasHScrollBar then x := Scroller^.XPos
  422.                                else x := 0;
  423.     if Scroller^.HasVScrollBar then y := Scroller^.YPos
  424.                                else y := 0;
  425.  
  426.  
  427.     { Die Palette immer als Hintergrundpalette realisieren. Wenn wir an dieser Stelle sind, und }
  428.     { wir sind die aktive Anwendung, wurde die Palette schon in wm_QueryNewPalette als  Vorder- }
  429.     { grundpalette realisiert; im anderen Fall sind wir sowieso nicht die bestimmende Anwendung.}
  430.     if Pal <> 0 then
  431.     begin
  432.       hpOld := SelectPalette(PaintDC,Pal,true);
  433.       if OldPal = 0 then OldPal := hpOld;
  434.       RealizePalette(PaintDC);
  435.     end
  436.     else
  437.       hpOld := 0;
  438.  
  439.     GetClientRect(HWindow,R);
  440.     if hbmClient <> 0 then
  441.     begin
  442.       MemDC := CreateCompatibleDC(PaintDC);
  443.       hbmOld := SelectObject(MemDC,hbmClient);
  444.       FillRect(PaintDC,R,GetStockObject(WHITE_BRUSH));
  445.       BitBlt(PaintDC,x,y,Min(cxBitmap,R.Right)+1,Min(cyBitmap,R.Bottom)+1,
  446.              MemDC,x,y,SRCCOPY);
  447.       SelectObject(MemDC,hbmOld);
  448.       DeleteDC(MemDC);
  449.     end
  450.     else begin
  451.       ShowCursor(false);
  452.       SetMapMode(PaintDC,MM_ANISOTROPIC);
  453.       SetViewPortOrgEx(PaintDC,-x,-y,@Pnt);
  454.       SetViewPortExtEx(PaintDC,cxBitmap,cyBitmap,@Size);
  455.       FillRect(PaintDC,R,GetStockObject(WHITE_BRUSH));
  456.       PlayMetaFile(PaintDC,MFInfo.FInfo.hMF);
  457.       ShowCursor(true);
  458.     end;
  459.  
  460.     if hpOld <> 0 then SelectPalette(PaintDC,hpOld,false);
  461.  
  462.   end;
  463. end;
  464.  
  465. {-------------------------------------------------------------------------------
  466.   Wird aufgerufen, wenn die Anwendung aktiv wird. Realisiert die Palette
  467.   und baut das Fenster neu auf. Liefert einen Wert ungleich 0, wenn eine Palette
  468.   realisiert wurde.
  469. }
  470. procedure TMWindow.WMQueryNewPalette (var Msg: TMessage);
  471. var
  472.   DC       : HDC;
  473.   Changed  : LongInt;
  474.   hpOld    : HPalette;
  475. begin
  476.   { Haben wir ein Metafile geladen und eine Palette? }
  477.   if (MFInfo.FInfo.hMF <> 0) and (Pal <> 0) then
  478.   begin
  479.     DC := GetDC(HWindow);
  480.     hpOld := SelectPalette(DC,Pal,false);
  481.     if OldPal = 0 then OldPal := hpOld;
  482.     Changed := RealizePalette(DC);
  483.     if hpOld <> 0 then SelectPalette(DC,hpOld,false);
  484.     ReleaseDC(HWindow,DC);
  485.     if Changed <> 0 then InvalidateRect(HWindow,nil,false);
  486.     Msg.Result := Changed;
  487.   end
  488.   else
  489.    DefWndProc(Msg);
  490. end;
  491.  
  492. {-------------------------------------------------------------------------------
  493.   Wird aufgerufen, wenn eine andere Anwendung eine neue Palette realisiert hat.
  494.   Baut den Bilschirm neu auf, um die Ausgabe zu verbessern, auch wenn weniger
  495.   Farben verfⁿgbar sind.
  496. }
  497. procedure TMWindow.WMPaletteChanged (var Msg: TMessage);
  498. var
  499.   DC       : HDC;
  500.   Changed  : LongInt;
  501.   hpOld    : HPalette;
  502. begin
  503.   if Msg.wParam = HWindow then exit;  { Nicht das eigene Fenster }
  504.   if (MFInfo.FInfo.hMF <> 0) and (Pal <> 0) then
  505.   begin
  506.     DC := GetDC(HWindow);
  507.     hpOld := SelectPalette(DC,Pal,true);
  508.     if OldPal = 0 then OldPal := hpOld;
  509.     Changed := RealizePalette(DC);
  510.     if hpOld <> 0 then SelectPalette(DC,hpOld,false);
  511.     ReleaseDC(HWindow,DC);
  512.     if Changed <> 0 then InvalidateRect(HWindow,nil,false);
  513.     Msg.Result := 0;
  514.   end
  515.   else
  516.    DefWndProc(Msg);
  517. end;
  518.  
  519. {-------------------------------------------------------------------------------
  520.   Justiert die Scroller neu und baut die Anzeige neu auf.
  521. }
  522. procedure TMWindow.WMSize (var Msg: TMessage);
  523. var
  524.   R : TRect;
  525. begin
  526.   if Msg.wParam = SIZE_MINIMIZED then exit;
  527.  
  528.   if Zoom = 1 then
  529.     RedrawWindow
  530.   else
  531.   begin
  532.     if (cxBitmap > Msg.lParamLo) and (cyBitmap > Msg.lParamHi) then
  533.     begin
  534.       GetClientRect(HWindow,R);
  535.       Scroller^.SetRange(Max(0,cxBitmap-R.Right),Max(0,cyBitmap-R.Bottom));
  536.       Scroller^.SetPageSize;
  537.       InvalidateRect(HWindow,nil,true);
  538.     end
  539.     else
  540.       RedrawWindow;
  541.   end;
  542.   Msg.Result := 0;
  543. end;
  544.  
  545. {-------------------------------------------------------------------------------
  546.   Erm÷glicht das Scrollen ⁿber die Tastatur.
  547. }
  548. procedure TMWindow.WMKeyDown (var Msg: TMessage);
  549. begin
  550.   case Msg.wParam of
  551.     vk_Prior   : SendMessage(HWindow,WM_VScroll,sb_PageUp,0);
  552.     vk_Next    : SendMessage(HWindow,WM_VScroll,sb_PageDown,0);
  553.     vk_Up      : SendMessage(HWindow,WM_VScroll,sb_LineUp,0);
  554.     vk_Down    : SendMessage(HWindow,WM_VScroll,sb_LineDown,0);
  555.     vk_Left    : begin
  556.                    if GetKeyState(vk_CONTROL) < 0 then
  557.                      SendMessage(HWindow,WM_HScroll,sb_PageUp,0)
  558.                    else
  559.                      SendMessage(HWindow,WM_HScroll,sb_LineUp,0)
  560.                  end;
  561.     vk_Right   : begin
  562.                    if GetKeyState(vk_CONTROL) < 0 then
  563.                      SendMessage(HWindow,WM_HScroll,sb_PageDown,0)
  564.                    else
  565.                      SendMessage(HWindow,WM_HScroll,sb_LineDown,0)
  566.                  end;
  567.   end;
  568. end;
  569.  
  570. {-------------------------------------------------------------------------------
  571.   LΣdt das Metafile und aktualisiert die Ausgabe, Caption usw.
  572. }
  573. procedure TMWindow.ProcessLoadFile (FileName: PChar);
  574. const
  575.   LIBNAME = 'WMFIMP.DLL';
  576.  
  577. var
  578.   i                   : Word;
  579.   s                   : array[0..20] of Char;
  580.   hOldCursor          : HCursor;
  581.   MsgWin              : PMsgWindow;
  582.   hFile               : Integer;
  583.  
  584.   hGrImpLib           : THandle;
  585.   ModeSave            : Word;
  586.   pfnGetFilterVersion : TpfnGetFilterVersion;
  587.   pfnLoadFile         : TpfnLoadFile;
  588.  
  589. begin
  590.   StrCopy(MFName, FileName);
  591.   if MFInfo.FInfo.hMF <> 0 then
  592.   begin
  593.     DeleteMetaFile(MFInfo.FInfo.hMF);
  594.     MFInfo.FInfo.hMF := 0;
  595.   end;
  596.  
  597.   { Library laden }
  598.   ModeSave := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  599.   hGrImpLib := LoadLibrary(LIBNAME);
  600.   if hGrImpLib < HINSTANCE_ERROR then
  601.   begin
  602.     MessageBox(0,'Kann die Bibliothek '+LIBNAME+' nicht finden!'#13#10+
  603.                  'Bitte ⁿberprⁿfen Sie, ob Sie ⁿber eine Datei dieses Namens auf Ihrer Festplatte '+
  604.                  'verfⁿgen und kopieren Sie diese in das Windows-Verzeichnis.',AppName,
  605.                mb_IconStop or mb_Ok);
  606.     SetErrorMode(ModeSave);
  607.     exit;
  608.   end;
  609.  
  610.   SetErrorMode(ModeSave);
  611.  
  612.   { Meldungsfenster anzeigen }
  613.   MsgWin := PMsgWindow(Application^.MakeWindow(New(PMsgWindow,Init(@Self,'Information'))));
  614.   MsgWin^.SetText('Laden und analysieren der Metadatei...');
  615.  
  616.   { Datei ÷ffnen }
  617.   hOldCursor := SetCursor(LoadCursor(0,IDC_WAIT));
  618.   hFile := _lopen(MFName,OF_READ);
  619.   if hFile > 0 then
  620.   begin
  621.  
  622.     { Alte Palette l÷schen }
  623.     if Pal <> 0 then
  624.     begin
  625.       DeleteObject(Pal);
  626.       Pal := 0;
  627.     end;
  628.  
  629.     { Erzeuge die Info-Struktur fⁿr LoadMetaFile }
  630.     FillChar(MFInfo,SizeOf(MFInfo),0);
  631.     with MFInfo do
  632.     begin
  633.       Size := SizeOf(MFInfo);
  634.       StrCopy(FullName,MFName);
  635.       FHandle := hFile;
  636.       FMode := OF_READ;
  637.       FPos := 0;
  638.       if PalOptimize then PalSpec := bpOptimize
  639.                      else PalSpec := bpNone;
  640.     end;
  641.  
  642.     @pfnGetFilterVersion := GetProcAddress(hGrImpLib,'GETFILTERVERSION');
  643.     @pfnLoadFile := GetProcAddress(hGrImpLib,'LOADFILE');
  644.  
  645.     { Datei laden }
  646.     if pfnLoadFile(MFInfo) = 0 then
  647.     begin
  648.       if MFInfo.FInfo.OwnPal then Pal := 0                  { Metafile hat eigene Palette }
  649.                              else Pal := MFInfo.FInfo.hPal; { Sonst erzeugte Palette benutzen }
  650.     end
  651.     else
  652.     begin
  653.       MessageBox(HWindow,'Dies ist kein gⁿltiges MetaFile!', AppName,mb_Ok or mb_IconExclamation);
  654.     end;
  655.     Dispose(MsgWin,Done);
  656.     { Datei wieder schlie▀en }
  657.     _lclose(hFile);
  658.   end
  659.   else
  660.   begin
  661.     MessageBox(HWindow,'Die Datei kann nicht ge÷ffnet werden!',AppName,
  662.                mb_Ok or mb_IconExclamation);
  663.   end;
  664.   SetCursor(hOldCursor);
  665.   FreeLibrary(hGrImpLib);
  666.   Scroller^.ScrollTo(0,0);
  667.   HasBitmapMem := true;
  668.   RedrawWindow;
  669. end;
  670.  
  671. {-------------------------------------------------------------------------------
  672.   Berechnet die Gr÷▀e des Metafiles und die der Bitmap. Als "Normale Gr÷▀e"
  673.   werden die Originalma▀e aus dem APM-Header angenommen. Auch die Zoomfaktoren
  674.   beziehen sich auf diese Gr÷▀e.
  675. }
  676. procedure TMWindow.CalcNewValues;
  677. var
  678.   wx, wy     : Integer;
  679.   R          : TRect;
  680.   f          : Real;
  681. begin
  682.   if MFInfo.FInfo.hMF = 0 then exit;
  683.  
  684.   { Breite/H÷he des Metafiles in logischen Einheiten }
  685.   wx := (MFInfo.FInfo.rcBBox.Right-MFInfo.FInfo.rcBBox.Left)+1;
  686.   wy := (MFInfo.FInfo.rcBBox.Bottom-MFInfo.FInfo.rcBBox.Top)+1;
  687.  
  688.   { Berechne die Gr÷▀e des Metafiles unter Berⁿcksichtigung des }
  689.   { richtigen SeitenverhΣltnisses und des aktuellen Zoomfaktors }
  690.   if Zoom = 1 then
  691.   begin
  692.     { Anpassung an die Gr÷▀e des Clientbereichs }
  693.     GetClientRect(HWindow,R);
  694.     InflateRect(R,-1,-1);
  695.   end
  696.   else
  697.   begin
  698.     { Originalgr÷▀e }
  699.     R.Left := 0;
  700.     R.Top := 0;
  701.     R.Right := LongInt(wx) * XLogPixels div MFInfo.FInfo.wInch;
  702.     R.Bottom := LongInt(wy) * YLogPixels div MFInfo.FInfo.wInch;
  703.   end;
  704.  
  705.   if R.Right > R.Bottom then
  706.   begin
  707.     f := Abs(wx / wy);
  708.     cyMeta := R.Bottom;
  709.     cxMeta := Round(cyMeta * f);
  710.     if cxMeta > R.Right then
  711.     begin
  712.       cxMeta := R.Right;
  713.       cyMeta := Round(cxMeta / f);
  714.     end;
  715.   end
  716.   else
  717.   begin
  718.     f := Abs(wy / wx);
  719.     cxMeta := R.Right;
  720.     cyMeta := Round(cxMeta * f);
  721.     if cyMeta > R.Bottom then
  722.     begin
  723.       cyMeta := R.Bottom;
  724.       cxMeta := Round(cyMeta / f);
  725.     end;
  726.   end;
  727.  
  728.   if Zoom <> 0 then
  729.   begin
  730.     cxBitmap := Round(cxMeta*Zoom);
  731.     cyBitmap := Round(cyMeta*Zoom);
  732.   end
  733.   else
  734.   begin
  735.     cxBitmap := cxMeta;
  736.     cyBitmap := cyMeta;
  737.   end;
  738.  
  739.   GetClientRect(HWindow,R);
  740.   InflateRect(R,-1,-1);
  741.   Scroller^.SetRange(Max(0,cxBitmap-R.Right),Max(0,cyBitmap-R.Bottom));
  742.   Scroller^.SetPageSize;
  743. end;
  744.  
  745. {-------------------------------------------------------------------------------
  746.   Gibt die OffScreen-Bitmap frei und macht das Fenster ungⁿltig. Wird
  747.   aufgerufen, wenn ein neuer Zoomfaktor eingestellt wird, wenn ein neues
  748.   Metafile geladen wird oder wenn zwischen "Palette optimieren" und "Normal"
  749.   umgeschaltet wird.
  750. }
  751. procedure TMWindow.RedrawWindow;
  752. begin
  753.   if hbmClient <> 0 then
  754.   begin
  755.     DeleteObject(hbmClient);
  756.     hbmClient := 0;
  757.   end;
  758.   CalcNewValues;
  759.   InvalidateRect(HWindow,nil,true);
  760. end;
  761.  
  762. {-------------------------------------------------------------------------------
  763.   Behandelt den User-Dialog zum Laden einer Datei.
  764. }
  765. procedure TMWindow.IDMLoad (var Msg: TMessage);
  766. const
  767.   DefExt = 'wmf';
  768.  
  769. var
  770.   OpenFN      : TOpenFileName;
  771.   Filter      : array [0..100] of Char;
  772.   FullFileName: array [0..255] of Char;
  773.  
  774. begin
  775.   { Filter fⁿr die Dateinamen aufbauen. Dieser mu▀ mit einer 00 beendet werden. }
  776.   StrCopy(FullFileName, '');
  777.   SetCurDir(HomeDir);
  778.  
  779.   FillChar(Filter, SizeOf(Filter), #0);  { 00 am Ende! }
  780.   StrCopy(Filter, 'Metadateien');
  781.   StrCopy(@Filter[StrLen(Filter)+1], '*.wmf');
  782.  
  783.   FillChar(OpenFN, SizeOf(TOpenFileName), #0);
  784.   with OpenFN do
  785.   begin
  786.     hInstance       := HInstance;
  787.     hwndOwner       := HWindow;
  788.     lpstrDefExt     := DefExt;
  789.     lpstrFile       := FullFileName;
  790.     lpstrFilter     := Filter;
  791.     lpstrFileTitle  := nil;
  792.     flags           := ofn_FileMustExist or ofn_HideReadOnly;
  793.     lStructSize     := sizeof(TOpenFileName);
  794.     nFilterIndex    := 1;       {Index in den String-Filter }
  795.     nMaxFile        := SizeOf(FullFileName);
  796.   end;
  797.  
  798.   MFNoRecs := 0;    { Anzahl der EintrΣge im Metafile ist noch unbekannt }
  799.  
  800.   if GetOpenFileName(OpenFN) then
  801.   begin
  802.     FileSplit(FullFileName,HomeDir,Filter,Filter);
  803.     if HomeDir[StrLen(HomeDir)-1] = '\' then HomeDir[StrLen(HomeDir)-1] := #0;
  804.     ProcessLoadFile(FullFileName);
  805.   end;
  806. end;
  807.  
  808.  
  809. {-------------------------------------------------------------------------------
  810.   "Hallo"-Dialog
  811. }
  812. procedure TMWindow.IDMAbout (var Msg: TMessage);
  813. begin
  814.   Application^.ExecDialog(New(PCtrDialog,Init(@Self,'DLG_ABOUT',CTRDLG_PARENT)));
  815. end;
  816.  
  817. {-------------------------------------------------------------------------------
  818.   Menⁿoption schlie▀en
  819. }
  820. procedure TMWindow.IDMClose (var Msg: TMessage);
  821. begin
  822.   PostMessage(HWindow,WM_CLOSE,0,0);
  823. end;
  824.  
  825. {-------------------------------------------------------------------------------
  826.   Schaltet die Palettenoptimierung ein oder aus.
  827. }
  828. procedure TMWindow.IDMPalOptimize (var Msg: TMessage);
  829. begin
  830.   if PalOptimize then
  831.   begin
  832.     PalOptimize := not PalOptimize;
  833.     CheckMenuItem(Attr.Menu,idm_PalOptimize,MF_UNCHECKED);
  834.     if MFInfo.FInfo.hMF <> 0 then ProcessLoadFile(MFName);
  835.   end
  836.   else
  837.   begin
  838.     PalOptimize := not PalOptimize;
  839.     CheckMenuItem(Attr.Menu,idm_PalOptimize,MF_CHECKED);
  840.     if MFInfo.FInfo.hMF <> 0 then ProcessLoadFile(MFName);
  841.   end;
  842. end;
  843.  
  844.  
  845. {-------------------------------------------------------------------------------
  846.   Schaltet den Direkt-Modus ein oder aus.
  847. }
  848. procedure TMWindow.IDMDirectMode (var Msg: TMessage);
  849. begin
  850.   if DirectMode then
  851.   begin
  852.     DirectMode := not DirectMode;
  853.     CheckMenuItem(Attr.Menu,idm_DirectMode,MF_UNCHECKED);
  854.     if MFInfo.FInfo.hMF <> 0 then ProcessLoadFile(MFName);
  855.   end
  856.   else
  857.   begin
  858.     DirectMode := not DirectMode;
  859.     CheckMenuItem(Attr.Menu,idm_DirectMode,MF_CHECKED);
  860.     if MFInfo.FInfo.hMF <> 0 then ProcessLoadFile(MFName);
  861.   end;
  862. end;
  863.  
  864. {-------------------------------------------------------------------------------
  865. }
  866. procedure TMWindow.IDMZoomOriginal (var Msg: TMessage);
  867. begin
  868.   Zoom := 0;
  869.   CheckMenuItem(Attr.Menu,LastZoomID,MF_UNCHECKED);
  870.   CheckMenuItem(Attr.Menu,301,MF_CHECKED);
  871.   HasBitmapMem := true;
  872.   RedrawWindow;
  873.   LastZoomID := 301;
  874. end;
  875.  
  876. {-------------------------------------------------------------------------------
  877. }
  878. procedure TMWindow.IDMZoomClient (var Msg: TMessage);
  879. begin
  880.   Zoom := 1;
  881.   CheckMenuItem(Attr.Menu,LastZoomID,MF_UNCHECKED);
  882.   CheckMenuItem(Attr.Menu,302,MF_CHECKED);
  883.   HasBitmapMem := true;
  884.   RedrawWindow;
  885.   LastZoomID := 302;
  886. end;
  887.  
  888. {-------------------------------------------------------------------------------
  889. }
  890. procedure TMWindow.IDMZoom200 (var Msg: TMessage);
  891. begin
  892.   Zoom := 2;
  893.   CheckMenuItem(Attr.Menu,LastZoomID,MF_UNCHECKED);
  894.   CheckMenuItem(Attr.Menu,303,MF_CHECKED);
  895.   HasBitmapMem := true;
  896.   RedrawWindow;
  897.   LastZoomID := 303;
  898. end;
  899.  
  900. {-------------------------------------------------------------------------------
  901. }
  902. procedure TMWindow.IDMZoom400 (var Msg: TMessage);
  903. begin
  904.   Zoom := 4;
  905.   CheckMenuItem(Attr.Menu,LastZoomID,MF_UNCHECKED);
  906.   CheckMenuItem(Attr.Menu,304,MF_CHECKED);
  907.   HasBitmapMem := true;
  908.   RedrawWindow;
  909.   LastZoomID := 304;
  910. end;
  911.  
  912. {-------------------------------------------------------------------------------
  913. }
  914. procedure TMWindow.IDMZoom50 (var Msg: TMessage);
  915. begin
  916.   Zoom := 0.5;
  917.   CheckMenuItem(Attr.Menu,LastZoomID,MF_UNCHECKED);
  918.   CheckMenuItem(Attr.Menu,305,MF_CHECKED);
  919.   HasBitmapMem := true;
  920.   RedrawWindow;
  921.   LastZoomID := 305;
  922. end;
  923.  
  924. {-------------------------------------------------------------------------------
  925. }
  926. procedure TMWindow.IDMZoom25 (var Msg: TMessage);
  927. begin
  928.   Zoom := 0.25;
  929.   CheckMenuItem(Attr.Menu,LastZoomID,MF_UNCHECKED);
  930.   CheckMenuItem(Attr.Menu,306,MF_CHECKED);
  931.   HasBitmapMem := true;
  932.   RedrawWindow;
  933.   LastZoomID := 306;
  934. end;
  935.  
  936. {-------------------------------------------------------------------------------
  937.   Drag 'n Drop
  938.   Behandelt das Ablegen von Dateien aus dem Dateimanager.
  939. }
  940. procedure TMWindow.WMDropFiles (var Msg: TMessage);
  941. var
  942.     Name    : array[0..255] of Char;
  943.     wFiles: Word;
  944. begin
  945.   Msg.Result := 0; { "Botschaft verarbeitet" }
  946.  
  947.     wFiles := DragQueryFile(Msg.wParam, $FFFF, nil, 0);
  948.  
  949.   if wFiles > 1 then
  950.   begin
  951.     MessageBox(HWindow,'Diese Anwendung kann nur einzelne Dateien anzeigen',AppName,
  952.                        mb_Ok or mb_IconExclamation);
  953.   end
  954.   else
  955.   begin
  956.     if IsIconic(HWindow) then Show(sw_ShowNormal);
  957.     { Die erste Datei holen }
  958.     DragQueryFile(Msg.wParam, 0, Name, SizeOf(Name));
  959.     MFNoRecs := 0;  { Anzahl der EintrΣge ist noch unbekannt }
  960.     ProcessLoadFile(Name);
  961.   end;
  962.  
  963.   { Freigabe des durch wm_DropFiles belegten Speichers }
  964.     DragFinish(Msg.wParam);
  965. end;
  966.  
  967. {-------------------------------------------------------------------------------
  968.   Lie▀t die EintrΣge aus der INI-Datei
  969. }
  970. procedure TMWindow.ReadINIData;
  971. begin
  972.   GetPrivateProfileString(AppName,'lastdir','',HomeDir,SizeOf(HomeDir),'WMFVIEW.INI');
  973. end;
  974.  
  975. {-------------------------------------------------------------------------------
  976. }
  977. procedure TMWindow.WriteINIData;
  978. begin
  979.   WritePrivateProfileString(AppName,'lastdir',HomeDir,'WMFVIEW.INI');
  980. end;
  981.  
  982. {*******************************************************************************}
  983. { TAnApplication                                                                }
  984. {*******************************************************************************}
  985. type
  986.     TAnApplication = object(TApplication)
  987.         procedure InitMainWindow; virtual;
  988.     end;
  989.  
  990. procedure TAnApplication.InitMainWindow;
  991. begin
  992.     MainWindow := New(PMWindow, Init(nil, AppName));
  993. end;
  994.  
  995.  
  996. {*******************************************************************************}
  997. { M A I N                                                                       }
  998. {*******************************************************************************}
  999. var
  1000.     MyApp     : TAnApplication;
  1001.  
  1002. begin
  1003.     MyApp.Init(AppName);
  1004.     MyApp.Run;
  1005.     MyApp.Done;
  1006. end.
  1007.  
  1008.