Black Box 4/BlackBox.cdr/w3_image/metaview.arj/DISPMETA.PAS

Pascal/Delphi Source File | 1991-05-09 | 6.3 KB | 214 lines

program DisplayMetafiles;

{$R VIEWMETA.RES}

uses WinTypes, WinProcs, WObjects,
     Strings, StdDlgs, ViewMeta;

const
   id_Viewer = 201;

   cm_Open = 101;
   cm_About = 102;
   cm_PreserveAspect = 103;
   cm_DialogExample = 104;

type
   PMyChildWindow = ^MyChildWindow;
   MyChildWindow = object(TWindow)
      MetaWnd : PMetafileViewer;
      constructor Init(AParent: PWindowsObject; ATitle: PChar);
      destructor Done; virtual;
      function GetClassName: PChar; virtual;
      procedure GetWindowClass(var AWndClass: TWndClass); virtual;
      procedure WMSize(var Msg: TMessage); virtual wm_First + wm_Size;
      procedure WMMDIActivate(var Msg: TMessage); virtual wm_First + wm_MDIActivate;
      procedure CMPreserveAspect(var Msg: TMessage); virtual cm_First + cm_PreserveAspect;
      procedure SetPreserveAspectCheckMark; virtual;
      procedure IDViewer(var Msg: TMessage); virtual id_First + id_Viewer;
   end;

   PMyMDIWindow = ^MyMDIWindow;
   MyMDIWindow = object(TMDIWindow)
      AName:PChar;
      constructor Init(ATitle: PChar; AMenu: HMenu);
      destructor Done; virtual;
      procedure GetWindowClass(var AWndClass: TWndClass); virtual;
      procedure SetupWindow; virtual;
      function InitChild: PWindowsObject; virtual;
      procedure CMOpen(var Msg: TMessage); virtual cm_First + cm_Open;
      procedure CMAbout(var Msg: TMessage); virtual cm_First + cm_About;
      procedure CMDialogExample(var Msg:TMessage); virtual cm_First + cm_DialogExample;
   end;

   PMyApplication = ^MyApplication;
   MyApplication = object(TApplication)
      constructor Init(AName: PChar);
      procedure InitMainWindow; virtual;
      destructor Done; virtual;
   end;

{**************************************************************}

   constructor MyChildWindow.Init(AParent: PWindowsObject; ATitle: PChar);
      begin
         TWindow.Init(AParent, ATitle);
         Attr.Style:= Attr.Style + ws_Child;
         MetaWnd:= New(PMetafileViewer, Init(@Self, id_Viewer,
                          ATitle, cw_UseDefault, cw_UseDefault,
                          cw_UseDefault, cw_UseDefault, True, False));
      end;

   destructor MyChildWindow.Done;
      begin
         TWindow.Done;
      end;

   function MyChildWindow.GetClassName: PChar;
      begin
         GetClassName:= 'MyChildWindow';
      end;

   procedure MyChildWindow.GetWindowClass(var AWndClass: TWndClass);
      begin
         TWindow.GetWindowClass(AWndClass);
         AWndClass.hIcon:= LoadIcon(HInstance, 'METAV_ICON');
      end;

   procedure MyChildWindow.WMSize(var Msg: TMessage);
      begin
         TWindow.WMSize(Msg);
         MoveWindow(MetaWnd^.HWindow, 0, 0, Msg.lParamLo, Msg.lParamHi, True);
      end;

   procedure MyChildWindow.IDViewer(var Msg: TMessage);
      begin
         if (Msg.lParamHi = mfn_Clicked) then
            begin
               {Metafile Client area was clicked on}
            end
         else if (Msg.lParamHi = mfn_DblClicked) then
            begin
               {Metafile Client area was double clicked on}
            end
         else if (Msg.lParamHi = mfn_Aldus) then
            begin
               {Metafile is an Aldus metafile}
            end
         else if (Msg.lParamHi = mfn_MSoft) then
            begin
               {Metafile is an Microsoft metafile}
            end;
      end;

   procedure MyChildWindow.WMMDIActivate(var Msg: TMessage);
      begin
         if (Msg.wParam <> 0) then {Window is being activated}
            begin
               SetPreserveAspectCheckMark;
            end;
      end;

   procedure MyChildWindow.CMPreserveAspect(var Msg: TMessage);
      begin
         MetaWnd^.ToggleAspect;
         SetPreserveAspectCheckMark;
      end;

   procedure MyChildWindow.SetPreserveAspectCheckMark;
      var
         MenuHandle : HMenu;
         CheckStatus : word;
      begin
         if MetaWnd^.AspectRatioPreserved then
            CheckStatus:= mf_Checked
         else
            CheckStatus:= mf_UnChecked;

         MenuHandle:= GetMenu(Application^.MainWindow^.HWindow);
         CheckMenuItem(MenuHandle, cm_PreserveAspect ,CheckStatus);
      end;

{**************************************************************}

   constructor MyMDIWindow.Init(ATitle: PChar; AMenu: HMenu);
      begin
         TMDIWindow.Init(ATitle, AMenu);
         ChildMenuPos:= 2;
      end;

   destructor MyMDIWindow.Done;
      begin
         TMDIWindow.Done;
      end;

   procedure MyMDIWindow.GetWindowClass(var AWndClass: TWndClass);
      begin
         TWindow.GetWindowClass(AWndClass);
         AWndClass.hIcon:= LoadIcon(HInstance, 'APGM_ICON');
      end;

   procedure MyMDIWindow.SetupWindow;
      begin
        TMDIWindow.SetupWindow;
      end;

   function MyMDIWindow.InitChild: PWindowsObject;
      begin
         InitChild:= New(PMyChildWindow, Init(@Self, AName));
      end;

   procedure MyMDIWindow.CMOpen(var Msg: TMessage);
      var
         AFile: array[0..100] of char;
      begin
         StrCopy(AFile, '*.WMF');
         if Application^.ExecDialog(New(PFileDialog, Init(@Self,
               PChar(sd_FileOpen), AFile))) = id_OK then
            begin
               AName:= AFile;
               CreateChild;
            end;
         DefWndProc(Msg);
      end;

   procedure MyMDIWindow.CMAbout(var Msg: TMessage);
      begin
         Application^.ExecDialog(
            New(PDialog, Init(@Self, 'ABOUT')));
      end;

   procedure MyMDIWindow.CMDialogExample(var Msg:TMessage);
      begin
         Application^.ExecDialog(
            New(PDialog, Init(@Self, 'META_DLG')));
      end;

{**************************************************************}

   constructor MyApplication.Init(AName: PChar);
      begin
         TApplication.Init(AName);
      end;

   procedure MyApplication.InitMainWindow;
      begin
         MainWindow:= New(PMyMDIWindow, Init('Metafile Viewer', LoadMenu(HInstance, 'DEFAULT_MENU')));
      end;

   destructor MyApplication.Done;
      begin
         TApplication.Done;
      end;

{**************************************************************}

var
   MyApp : MyApplication;

begin
   MyApp.Init('Metafile Viewer');
   MyApp.Run;
   MyApp.Done;
end.