home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / windows / c / mobjm260 / sfxview.pa_ / sfxview.pa
Encoding:
Text File  |  1994-09-06  |  69.4 KB  |  2,054 lines
  1. (*********************************************************************)
  2. (*                                                                   *)
  3. (*          Microworks ObjectMate 2.6                                                        *)
  4. (*                                                                   *)
  5. (*     Windows Interface Develpment Kit for the Borland Languages.   *)
  6. (*                                                                   *)
  7. (*         SFXVIEW.PAS : Object Viewer                                       *)
  8. (*                                                                                                                             *)
  9. (*     Copyright 1992-94 Microworks Sydney, Australia.                 *)
  10. (*                                                                   *)
  11. (*********************************************************************)
  12.  
  13. program SFXVIEW;
  14.  
  15. {$R SFXView.res}
  16.  
  17. uses WinTypes, WinProcs, ODMenu, SFX200, CommDlg, Strings,
  18.          {$IFDEF Ver15}
  19.              WObjects;
  20.          {$ELSE}
  21.              Objects, OWindows, ODialogs;
  22.          {$ENDIF}
  23.  
  24. const
  25.  
  26.     { Resource identifiers }
  27.     id_Toolbar             = 1;
  28.  
  29.     { File menu commands }
  30.     cm_FileOpen            = 100;
  31.     cm_FileExOpen          = 101;
  32.     cm_FileOpenExtraFlags  = 102;
  33.     cm_FileSaveAs          = 103;
  34.     cm_OpenDir             = 104;
  35.     cm_OpenDirHelp         = 105;
  36.     cm_ExitWindow          = 106;
  37.  
  38.     cm_PrintMin            = 200;
  39.     cm_Print               = 200;
  40.     cm_PrintHelp           = 201;
  41.     cm_PrintSetup          = 202;
  42.     cm_PrintSetupHelp      = 203;
  43.     cm_PrintMax            = 203;
  44.  
  45.     { Search menu commands }
  46.     cm_SearchMin           = 300;
  47.     cm_SearchFind          = 300;
  48.     cm_SearchFindHelp      = 301;
  49.     cm_SearchReplace       = 302;
  50.     cm_SearchReplaceHelp   = 303;
  51.     cm_SearchMax           = 303;
  52.  
  53.         {    Button identifiers }
  54.     id_SFXFrame            = 312;
  55.     id_Gray                = 313;
  56.     id_Glaze               = 314;
  57.     id_Steel               = 315;
  58.     id_3DGray              = 316;
  59.     id_3DGlaze             = 317;
  60.     id_3DSteel             = 318;
  61.     id_mbOk                = 319;
  62.     id_mbOkCancel          = 320;
  63.     id_mbAbortRetryIgnore  = 321;
  64.     id_mbRetryCancel       = 322;
  65.     id_mbYesNo             = 323;
  66.     id_mbYesNoCancel       = 324;
  67.     id_mbGo                = 325;
  68.     id_mbGoStop            = 326;
  69.     id_mbOkCancelHelp      = 327;
  70.     id_mbYesNoHelp         = 328;
  71.  
  72.     {    Color menu commands }
  73.     cm_BasicColor          = 400;
  74.     cm_BasicColorHelp      = 401;
  75.     cm_ExtendedColor       = 402;
  76.     cm_ExtendedColorHelp   = 403;
  77.  
  78.     {    Font menu commands }
  79.     cm_BasicFont                   = 500;
  80.     cm_BasicFontExtraFlags = 501;
  81.     cm_ExtendedFont        = 502;
  82.     cm_ExtendedFontApply   = 503;
  83.     cm_ExtendedFontHelp    = 504;
  84.  
  85.     { Object menu identifiers }
  86.     cm_ObjectMin           = 600;
  87.     cm_Button              = 601;
  88.     cm_Static              = 602;
  89.     cm_Shade                       = 603;
  90.     cm_Check               = 604;
  91.     cm_Radio               = 605;
  92.     cm_Control             = 606;
  93.     cm_Toolbar             = 607;
  94.     cm_MessageBox          = 608;
  95.     cm_Window              = 609;
  96.  
  97.     { Toolbar menu identifiers }
  98.     cm_Top                 = 610;
  99.     cm_Float               = 611;
  100.     cm_Bottom              = 612;
  101.     cm_Status              = 613;
  102.     cm_Hints               = 614;
  103.     cm_ObjectMax           = 614;
  104.  
  105. { Miscellaneous identifiers }
  106.     id_Timer               = 700;
  107.     id_StdBtn              = 701;
  108.     id_BitBtn              = 702;
  109.     id_StatBmp             = 703;
  110.     id_StatText            = 704;
  111.     id_Toolbar1            = 705;
  112.     id_Toolbar2            = 706;
  113.     id_Textbtn             = 707;
  114.     id_Splash              = 708;
  115.  
  116.     { Toolbar identifiers }
  117.     id_One                 = 801;
  118.     id_Two                 = 802;
  119.     id_Three               = 803;
  120.     id_Four                = 804;
  121.  
  122.     { Help menu commands }
  123.     cm_Help                = 900;
  124.     cm_About               = 901;
  125.  
  126.     AppName : PChar        = 'SFXVIEW';
  127.  
  128. type
  129.  
  130.     PViewApp = ^TViewApp;
  131.     TViewApp = object(TApplication)
  132.         procedure InitMainWindow; virtual;
  133.     end;
  134.  
  135.     PDefaultDialog = ^TDefaultDialog;
  136.     TDefaultDialog = object(TDialog)
  137.         procedure SetUpWindow; virtual;
  138.     end;
  139.  
  140.     PChildDialog = ^TChildDialog;
  141.     TChildDialog = object(TDialog)
  142.         procedure SetUpWindow; virtual;
  143.         procedure OK (var Msg: TMessage); virtual id_First + id_Ok;
  144.         procedure Cancel (var Msg: TMessage); virtual id_First + id_Cancel;
  145.     end;
  146.  
  147.     PButtonDialog = ^TButtonDialog;
  148.     TButtonDialog = object(TDialog)
  149.         procedure SetUpWindow; virtual;
  150.         procedure IDStdBtn (var Msg: TMessage); virtual id_First + id_StdBtn;
  151.         procedure IDBitBtn (var Msg: TMessage); virtual id_First + id_BitBtn;
  152.         procedure IDTextBtn (var Msg: TMessage); virtual id_First + id_TextBtn;
  153.     end;
  154.  
  155.     PStaticDialog = ^TStaticDialog;
  156.     TStaticDialog = object(TDialog)
  157.         procedure SetUpWindow; virtual;
  158.         procedure IDStatBmp (var Msg: TMessage); virtual id_First + id_StatBmp;
  159.         procedure IDStatText (var Msg: TMessage); virtual id_First + id_StatText;
  160.     end;
  161.  
  162.     PControlDialog = ^TControlDialog;
  163.     TControlDialog = object(TDialog)
  164.         i : Integer;
  165.         destructor Done; virtual;
  166.         procedure SetUpWindow; virtual;
  167.         procedure WMSFXCtlColor (var Msg: TMessage); virtual wm_First + wm_SFXCtlColor;
  168.         procedure WMTimer (var Msg: TMessage); virtual wm_First + wm_Timer;
  169.     end;
  170.  
  171.     PToolbarDialog = ^TToolbarDialog;
  172.     TToolbarDialog = object(TDialog)
  173.         TB1, TB2, TB3 : PSFXToolbar;
  174.         constructor Init(AParent: PWindowsObject; AName: PChar);
  175.         procedure SetUpWindow; virtual;
  176.         procedure WMCommand (var Msg: TMessage); virtual wm_First + wm_Command;
  177.     end;
  178.  
  179.     PPopupToolbar = ^TPopupToolbar;
  180.     TPopupToolbar = object(TSFXToolbar)
  181.         procedure WMCommand (var Msg: TMessage); virtual wm_First + wm_Command;
  182.         procedure WMNCActivate (var Msg: TMessage); virtual wm_First + wm_NCActivate;
  183.     end;
  184.  
  185.     PMessageBoxDialog = ^TMessageBoxDialog;
  186.     TMessageBoxDialog = object(TDialog)
  187.         MsgStyle : Word;
  188.         procedure SetUpWindow; virtual;
  189.         procedure WMCommand (var Msg: TMessage); virtual wm_First + wm_Command;
  190.     end;
  191.  
  192.     PToolbar = ^TToolbar;
  193.     TToolbar = object(TSFXToolbar)
  194.         procedure WMCommand (var Msg: TMessage); virtual wm_First + wm_Command;
  195.         procedure WMMouseMove (var Msg: TMessage); virtual wm_First + wm_MouseMove;
  196.     end;
  197.  
  198.     PSplashWindow = ^TSplashWindow;
  199.     TSplashWindow = object(TSFXStatic)
  200.         destructor Done; virtual;
  201.         procedure SetUpWindow; virtual;
  202.         procedure WMGetDlgCode (var Msg: TMessage); virtual wm_First + wm_GetDlgCode;
  203.         procedure WMKeyDown (var Msg: TMessage); virtual wm_First + wm_KeyDown;
  204.         procedure WMLButtonDown (var Msg: TMessage); virtual wm_First + wm_LButtonDown;
  205.         procedure WMNCHitTest (var Msg: TMessage); virtual wm_First + wm_NCHitTest;
  206.         procedure WMTimer (var Msg: TMessage); virtual wm_First + wm_Timer;
  207.     end;
  208.  
  209.     PViewWindow = ^TViewWindow;
  210.     TViewWindow = object(TSFXWindow)
  211.         BkBrush       : HBrush;
  212.         OldBrush      : HBrush;
  213.         Font          : HFont;
  214.         OldFont       : HFont;
  215.         FindDlg       : HWnd;  { FindText dialog handle }
  216.         ReplaceDlg    : HWnd;  { ReplaceText dialog handle }
  217.         Splash        : PSplashWindow;
  218.         Toolbar       : PToolbar;
  219.         FontColor     : TColorRef;
  220.         LogFont       : TLogFont;
  221.         frFind        : TFindReplace;  { Persistent structure for FindText }
  222.         frReplace     : TFindReplace;  { Persistent structure for ReplaceText }
  223.         MsgFind       : Word;
  224.         OldToolbarPos : Word;
  225.         ToolbarPos    : Word;
  226.         Text          : array[0..255] of Char;
  227.         Find          : array[0..255] of Char;  { Search string for FindText }
  228.         ReplaceFind   : array[0..255] of Char;  { Search string for ReplaceText }
  229.         Replace       : array[0..255] of Char;  { Replace string for ReplaceText }
  230.         Template      : Integer;
  231.         Filters       : PChar;
  232.         OFNFlags      : LongInt;
  233.         szText        : array[0..255] of Char;
  234.         Index         : LongInt;
  235.         Color         : TColorRef;
  236.         CCFlags       : LongInt;
  237.         CFFlags       : LongInt;
  238.         FindIcon      : HIcon;
  239.         ReplaceIcon   : HIcon;
  240.         ColorIcon     : HIcon;
  241.         FontIcon      : HIcon;
  242.         PrintIcon     : HIcon;
  243.         DirIcon       : HIcon;
  244.         FileIcon      : HIcon;
  245.         constructor Init(AParent: PWindowsObject; AName: PChar);
  246.         destructor Done; virtual;
  247.         function  GetClassName : PChar; virtual;
  248.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  249.         procedure SetUpWindow; virtual;
  250.         procedure Create3DMenus;
  251.         procedure Paint (PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  252.         procedure WMSize (var Msg: TMessage); virtual wm_First + wm_Size;
  253.         procedure WMCommand (var Msg: TMessage); virtual wm_First + wm_Command;
  254.         procedure WMDrawItem (var Msg: TMessage); virtual wm_First + wm_DrawItem;
  255.         procedure WMInitMenuPopup (var Msg: TMessage); virtual wm_First + wm_InitMenuPopup;
  256.         procedure WMMeasureItem (var Msg: TMessage); virtual wm_First + wm_MeasureItem;
  257.         procedure WMMenuChar (var Msg: TMessage); virtual wm_First + wm_MenuChar;
  258.         procedure WMMenuSelect (var Msg: TMessage); virtual wm_First + wm_MenuSelect;
  259.         procedure WMMouseMove (var Msg: TMessage); virtual wm_First + wm_MouseMove;
  260.         procedure WMNCMouseMove (var Msg: TMessage); virtual wm_First + wm_NCMouseMove;
  261.         procedure WMSFXApplyColor (var Msg: TMessage); virtual wm_First + wm_SFXApplyColor;
  262.         procedure WMSFXApplyFont (var Msg: TMessage); virtual wm_First + wm_SFXApplyFont;
  263.         procedure WMSFXHelp (var Msg: TMessage); virtual wm_First + wm_SFXHelp;
  264.         procedure WMSFXInitDialog (var Msg: TMessage); virtual wm_First + wm_SFXInitDialog;
  265.         procedure DefWndProc (var Msg: TMessage); virtual;
  266.         procedure UpdateClientRect;
  267.         procedure HandleMouseMove (Point: TPoint);
  268.         procedure HandleSearch (WndOwner: HWnd; pFR: PFindReplace);
  269.         function  HandlePrintDialogs (WndOwner: HWnd; iDialog: Word): BOOL;
  270.         function  HandleSearchDialogs (WndOwner: HWnd; iDialog: Word): HWnd;
  271.         procedure CMFileOpen (var Msg: TMessage); virtual cm_First + cm_FileOpen;
  272.         procedure CMFileExOpen (var Msg: TMessage); virtual cm_First + cm_FileExOpen;
  273.         procedure CMFileOpenExtraFlags (var Msg: TMessage); virtual cm_First + cm_FileOpenExtraFlags;
  274.         procedure CMFileSaveAs (var Msg: TMessage); virtual cm_First + cm_FileSaveAs;
  275.         procedure CMOpenDir (var Msg: TMessage); virtual cm_First + cm_OpenDir;
  276.         procedure CMOpenDirHelp (var Msg: TMessage); virtual cm_First + cm_OpenDirHelp;
  277.         procedure CMBasicColor (var Msg: TMessage); virtual cm_First + cm_BasicColor;
  278.         procedure CMBasicColorHelp (var Msg: TMessage); virtual cm_First + cm_BasicColorHelp;
  279.         procedure CMExtendedColor (var Msg: TMessage); virtual cm_First + cm_ExtendedColor;
  280.         procedure CMExtendedColorHelp (var Msg: TMessage); virtual cm_First + cm_ExtendedColorHelp;
  281.         procedure CMBasicFont (var Msg: TMessage); virtual cm_First + cm_BasicFont;
  282.         procedure CMBasicFontExtraFlags (var Msg: TMessage); virtual cm_First + cm_BasicFontExtraFlags;
  283.         procedure CMExtendedFont (var Msg: TMessage); virtual cm_First + cm_ExtendedFont;
  284.         procedure CMExtendedFontApply (var Msg: TMessage); virtual cm_First + cm_ExtendedFontApply;
  285.         procedure CMExtendedFontHelp (var Msg: TMessage); virtual cm_First + cm_ExtendedFontHelp;
  286.         procedure CMButton (var Msg: TMessage); virtual cm_First + cm_Button;
  287.         procedure CMStatic (var Msg: TMessage); virtual cm_First + cm_Static;
  288.         procedure CMShade (var Msg: TMessage); virtual cm_First + cm_Shade;
  289.         procedure CMCheck (var Msg: TMessage); virtual cm_First + cm_Check;
  290.         procedure CMRadio (var Msg: TMessage); virtual cm_First + cm_Radio;
  291.         procedure CMControl (var Msg: TMessage); virtual cm_First + cm_Control;
  292.         procedure CMToolbar (var Msg: TMessage); virtual cm_First + cm_Toolbar;
  293.         procedure CMMessageBox (var Msg: TMessage); virtual cm_First + cm_MessageBox;
  294.         procedure CMWindow (var Msg: TMessage); virtual cm_First + cm_Window;
  295.         procedure CMTop (var Msg: TMessage); virtual cm_First + cm_Top;
  296.         procedure CMFloat (var Msg: TMessage); virtual cm_First + cm_Float;
  297.         procedure CMBottom (var Msg: TMessage); virtual cm_First + cm_Bottom;
  298.         procedure CMStatus (var Msg: TMessage); virtual cm_First + cm_Status;
  299.         procedure CMHints (var Msg: TMessage); virtual cm_First + cm_Hints;
  300.         procedure CMAbout (var Msg: TMessage); virtual cm_First + cm_About;
  301.         procedure CMExitWindow (var Msg: TMessage); virtual cm_First + cm_ExitWindow;
  302.         procedure CMHelp (var Msg: TMessage); virtual cm_First + cm_Help;
  303.     end;
  304.  
  305. var
  306.     UseHints  : Boolean;
  307.     Style     : Word;
  308.     Tool      : Word;
  309.     ClassName : array[0..25] of Char;
  310.  
  311. {********** TViewApp **********}
  312.  
  313. procedure TViewApp.InitMainWindow;
  314. begin
  315.     MainWindow := New(PViewWindow, Init(nil, 'Object Viewer'));
  316. end;
  317.  
  318. {********** TViewWindow **********}
  319.  
  320. constructor TViewWindow.Init(AParent: PWindowsObject; AName: PChar);
  321. begin
  322.     TSFXWindow.Init(AParent, AName);
  323.     Attr.Style := Attr.Style or mws_3DFrame or mws_SFXCaption;
  324.     Attr.X := 0;
  325.     Attr.Y := 0;
  326.     Attr.W := cw_UseDefault;
  327.     Attr.W := cw_UseDefault;
  328.     Attr.Menu := LoadMenu(HInstance, AppName);
  329.     Color := GetSysColor(Color_Window);
  330.     BkBrush := CreateSolidBrush(Color);
  331.  
  332.     (* Creates the splash window displayed when the main window first appears.
  333.      * An SFXStatic control is used to display the centered bitmap inside a
  334.      * raised border.
  335.      *)
  336.     Splash := New(PSplashWindow, Init(@Self, id_Splash, 'SplashPanel', 0, 0, 318, 153, 0));
  337.     Splash^.Attr.Style := ws_Child or ws_Visible or mss_CenterBitmap or mss_Raised;
  338.  
  339.     { Set initial RGB font color and default LOGFONT values }
  340.     FontColor := RGB(0, 0, 255);
  341.     FillChar(LogFont, SizeOf(TLogFont), #0);
  342.     with LogFont do
  343.     begin
  344.         lfHeight := 36;
  345.         lfItalic := 0;
  346.         lfWeight := fw_Bold;
  347.         lfStrikeOut := 0;
  348.         lfUnderline := 1;
  349.         lfOutPrecision := Out_Stroke_Precis;
  350.         lfClipPrecision := Clip_Stroke_Precis;
  351.         lfQuality := Default_Quality;
  352.         lfPitchAndFamily := Variable_Pitch;
  353.         StrCopy(lfFaceName, 'Times New Roman');
  354.     end;
  355.     Font := CreateFontIndirect(LogFont);
  356.  
  357.     { Register the Find/Replace common dialog message }
  358.     MsgFind := RegisterWindowMessage(FindMsgString);
  359.     FindDlg := 0;
  360.     ReplaceDlg := 0;
  361.     Toolbar := nil;
  362.     ToolbarPos := 0;
  363.  
  364.     { Load caption icons, depending on height of title bar }
  365.     if GetSystemMetrics(SM_CYSIZE) = 26 then
  366.     begin
  367.         FindIcon := LoadIcon(HInstance, 'Find2');
  368.         ReplaceIcon := LoadIcon(HInstance, 'Replace2');
  369.         ColorIcon := LoadIcon(HInstance, 'Color2');
  370.         FontIcon := LoadIcon(HInstance, 'Font2');
  371.         PrintIcon := LoadIcon(HInstance, 'Print2');
  372.         DirIcon := LoadIcon(HInstance, 'Dir2');
  373.         FileIcon := LoadIcon(HInstance, 'File2');
  374.     end
  375.     else
  376.     begin
  377.         FindIcon := LoadIcon(HInstance, 'Find1');
  378.         ReplaceIcon := LoadIcon(HInstance, 'Replace1');
  379.         ColorIcon := LoadIcon(HInstance, 'Color1');
  380.         FontIcon := LoadIcon(HInstance, 'Font1');
  381.         PrintIcon := LoadIcon(HInstance, 'Print1');
  382.         DirIcon := LoadIcon(HInstance, 'Dir1');
  383.         FileIcon := LoadIcon(HInstance, 'File1');
  384.     end;
  385.  
  386.     { Turn on Flyover Hints }
  387.     UseHints := True;
  388.     CmdShow := sw_ShowMaximized;
  389. end;
  390.  
  391. destructor TViewWindow.Done;
  392. begin
  393.     (* EraseObject is defined in the SFX200 unit. It checks first to
  394.      * make sure the object handle is valid before calling DeleteObject.
  395.      * This the safe way to delete a handle.
  396.      *)
  397.     EraseObject(BkBrush);
  398.     EraseObject(Font);
  399.     EraseObject(FindIcon);
  400.     EraseObject(ReplaceIcon);
  401.     EraseObject(ColorIcon);
  402.     EraseObject(FontIcon);
  403.     EraseObject(PrintIcon);
  404.     EraseObject(DirIcon);
  405.     EraseObject(FileIcon);
  406.     TSFXWindow.Done;
  407. end;
  408.  
  409. function TViewWindow.GetClassName;
  410. begin
  411.     GetClassName := AppName;
  412. end;
  413.  
  414. procedure TViewWindow.GetWindowClass(var AWndClass: TWndClass);
  415. begin
  416.     TSFXWindow.GetWindowClass(AWndClass);
  417.  
  418.     (* SFXDefWindowProc's default window color is light gray. To override this
  419.      * you must supply a valid brush handle or specify one of the color flags
  420.      * MWS_GLAZE or MWS_STEEL with AWndClass.HBrBackground set to zero.
  421.      *)
  422.     AWndClass.HBrBackground := BkBrush;
  423.     AWndClass.HIcon := LoadIcon(HInstance, AppName);
  424.     AWndclass.Style := AWndclass.Style and not cs_HRedraw and not cs_VRedraw;
  425. end;
  426.  
  427. procedure TViewWindow.SetUpWindow;
  428. var
  429.     Msg : TMessage;
  430. begin
  431.     TSFXWindow.SetUpWindow;
  432.  
  433.     (* Set up 3D ownerdraw menu items
  434.      *)
  435.     Create3DMenus;
  436.  
  437.     (* Create a top aligned toolbar - see CMTOP procedure
  438.      *)
  439.     Tool := id_One;
  440.     CMStatus(Msg);
  441.     CheckMenuItem(Attr.Menu, cm_Hints, mf_ByCommand or mf_Checked);
  442.  
  443.     (* Set the initial dialog class displayed to SFX3DDlg. This
  444.      *    information is changed when the user presses a toolbar button.
  445.      *)
  446.     StrCopy(ClassName, 'SFX3DDlg');
  447.     Style := mws_SFXFrame;
  448.  
  449.     (* The CenterWindow function is defined in the SFX200 unit. Here it's used to center
  450.      * the Splash window over HWindow. If HWindow was zero the Splash window would
  451.      * be centered over the desktop window.
  452.      *)
  453.     CenterWindow(HWindow, Splash^.HWindow);
  454.     SetFocus(Splash^.HWindow);
  455. end;
  456.  
  457. procedure TViewWindow.Create3DMenus;
  458. var
  459.     Menu     : HMenu;
  460.     MenuText : PChar;
  461. begin
  462.     (* Since the system menu rarely gets modified, Set3DSystemMenu can be used to
  463.      * automatically set up a basic ownerdraw system menu.
  464.      *)
  465.     Set3DSystemMenu(HWindow, 'Object Viewer');
  466.  
  467.     (* You cannot specify ownerdraw menu items in a resource file. You can only
  468.      * specify (modify) them from within your program.
  469.      *)
  470.     Menu := GetSubMenu(Attr.Menu, 0);
  471.     MenuText := '&Open...';
  472.     ModifyMenu(Menu, 0, mf_ByPosition or mf_OwnerDraw, cm_FileOpen, MenuText);
  473.     MenuText := 'Open with E&xtended Select...';
  474.     ModifyMenu(Menu, 1, mf_ByPosition or mf_OwnerDraw, cm_FileExOpen, MenuText);
  475.     MenuText := 'Open with Extra &Flags...';
  476.     ModifyMenu(Menu, 2, mf_ByPosition or mf_OwnerDraw, cm_FileOpenExtraFlags, MenuText);
  477.     MenuText := '&Save As...';
  478.     ModifyMenu(Menu, 3, mf_ByPosition or mf_OwnerDraw, cm_FileSaveAs, MenuText);
  479.     MenuText := '&Directory...';
  480.     ModifyMenu(Menu, 5, mf_ByPosition or mf_OwnerDraw, cm_OpenDir, MenuText);
  481.     MenuText := 'Di&rectory with Help...';
  482.     ModifyMenu(Menu, 6, mf_ByPosition or mf_OwnerDraw, cm_OpenDirHelp, MenuText);
  483.     MenuText := '&Print...';
  484.     ModifyMenu(Menu, 8, mf_ByPosition or mf_OwnerDraw, cm_Print, MenuText);
  485.     MenuText := 'Pr&int with Help...';
  486.     ModifyMenu(Menu, 9, mf_ByPosition or mf_OwnerDraw, cm_PrintHelp, MenuText);
  487.     MenuText := 'Pri&nter Setup...';
  488.     ModifyMenu(Menu, 10, mf_ByPosition or mf_OwnerDraw, cm_PrintSetup, MenuText);
  489.     MenuText := 'Prin&ter Setup with Help...';
  490.     ModifyMenu(Menu, 11, mf_ByPosition or mf_OwnerDraw, cm_PrintSetupHelp, MenuText);
  491.     MenuText := '&Exit';
  492.     ModifyMenu(Menu, 13, mf_ByPosition or mf_OwnerDraw, cm_ExitWindow, MenuText);
  493.  
  494.     Menu := GetSubMenu(Attr.Menu, 1);
  495.     MenuText := '&Find...';
  496.     ModifyMenu(Menu, 0, mf_ByPosition or mf_OwnerDraw, cm_SearchFind, MenuText);
  497.     MenuText := 'F&ind with Help...';
  498.     ModifyMenu(Menu, 1, mf_ByPosition or mf_OwnerDraw, cm_SearchFindHelp, MenuText);
  499.     MenuText := '&Replace...';
  500.     ModifyMenu(Menu, 3, mf_ByPosition or mf_OwnerDraw, cm_SearchReplace, MenuText);
  501.     MenuText := 'R&eplace with Help...';
  502.     ModifyMenu(Menu, 4, mf_ByPosition or mf_OwnerDraw, cm_SearchReplaceHelp, MenuText);
  503.  
  504.     Menu := GetSubMenu(Attr.Menu, 2);
  505.     MenuText := '&Basic Color...';
  506.     ModifyMenu(Menu, 0, mf_ByPosition or mf_OwnerDraw, cm_BasicColor, MenuText);
  507.     MenuText := 'Basic &Color with Help...';
  508.     ModifyMenu(Menu, 1, mf_ByPosition or mf_OwnerDraw, cm_BasicColorHelp, MenuText);
  509.     MenuText := '&Extended Color...';
  510.     ModifyMenu(Menu, 3, mf_ByPosition or mf_OwnerDraw, cm_ExtendedColor, MenuText);
  511.     MenuText := 'E&xtended Color with Help...';
  512.     ModifyMenu(Menu, 4, mf_ByPosition or mf_OwnerDraw, cm_ExtendedColorHelp, MenuText);
  513.  
  514.     Menu := GetSubMenu(Attr.Menu, 3);
  515.     MenuText := '&Basic Font...';
  516.     ModifyMenu(Menu, 0, mf_ByPosition or mf_OwnerDraw, cm_BasicFont, MenuText);
  517.     MenuText := 'Basic &Font with Extra Flags...';
  518.     ModifyMenu(Menu, 1, mf_ByPosition or mf_OwnerDraw, cm_BasicFontExtraFlags, MenuText);
  519.     MenuText := '&Extended Font...';
  520.     ModifyMenu(Menu, 3, mf_ByPosition or mf_OwnerDraw, cm_ExtendedFont, MenuText);
  521.     MenuText := 'E&xtended Font with Apply...';
  522.     ModifyMenu(Menu, 4, mf_ByPosition or mf_OwnerDraw, cm_ExtendedFontApply, MenuText);
  523.     MenuText := 'Ex&tended Font with Help...';
  524.     ModifyMenu(Menu, 5, mf_ByPosition or mf_OwnerDraw, cm_ExtendedFontHelp, MenuText);
  525.  
  526.     Menu := GetSubMenu(Attr.Menu, 4);
  527.     MenuText := '&Buttons...';
  528.     ModifyMenu(Menu, 0, mf_ByPosition or mf_OwnerDraw, cm_Button, MenuText);
  529.     MenuText := '&Static Controls...';
  530.     ModifyMenu(Menu, 1, mf_ByPosition or mf_OwnerDraw, cm_Static, MenuText);
  531.     MenuText := 'S&hade Controls...';
  532.     ModifyMenu(Menu, 2, mf_ByPosition or mf_OwnerDraw, cm_Shade, MenuText);
  533.     MenuText := 'Chec&k Boxes...';
  534.     ModifyMenu(Menu, 3, mf_ByPosition or mf_OwnerDraw, cm_Check, MenuText);
  535.     MenuText := '&Radio Buttons...';
  536.     ModifyMenu(Menu, 4, mf_ByPosition or mf_OwnerDraw, cm_Radio, MenuText);
  537.     MenuText := '&Controls...';
  538.     ModifyMenu(Menu, 5, mf_ByPosition or mf_OwnerDraw, cm_Control, MenuText);
  539.     MenuText := '&Toolbars...';
  540.     ModifyMenu(Menu, 7, mf_ByPosition or mf_OwnerDraw, cm_Toolbar, MenuText);
  541.     MenuText := '&Message && Input Boxes...';
  542.     ModifyMenu(Menu, 8, mf_ByPosition or mf_OwnerDraw, cm_MessageBox, MenuText);
  543.     MenuText := '&Windows...';
  544.     ModifyMenu(Menu, 10, mf_ByPosition or mf_OwnerDraw, cm_Window, MenuText);
  545.  
  546.     Menu := GetSubMenu(Attr.Menu, 5);
  547.     MenuText := '&Top';
  548.     ModifyMenu(Menu, 0, mf_ByPosition or mf_OwnerDraw, cm_Top, MenuText);
  549.     MenuText := '&Floating';
  550.     ModifyMenu(Menu, 1, mf_ByPosition or mf_OwnerDraw, cm_Float, MenuText);
  551.     MenuText := '&Bottom';
  552.     ModifyMenu(Menu, 2, mf_ByPosition or mf_OwnerDraw, cm_Bottom, MenuText);
  553.     MenuText := '&Status Bar';
  554.     ModifyMenu(Menu, 3, mf_ByPosition or mf_OwnerDraw, cm_Status, MenuText);
  555.     MenuText := 'Flyover &Hints';
  556.     ModifyMenu(Menu, 5, mf_ByPosition or mf_OwnerDraw, cm_Hints, MenuText);
  557.  
  558.     Menu := GetSubMenu(Attr.Menu, 6);
  559.     MenuText := '&ObjectMate Reference...';
  560.     ModifyMenu(Menu, 0, mf_ByPosition or mf_OwnerDraw, cm_Help, MenuText);
  561.     MenuText := '&About ObjectMate...';
  562.     ModifyMenu(Menu, 1, mf_ByPosition or mf_OwnerDraw, cm_About, MenuText);
  563. end;
  564.  
  565. procedure TViewWindow.Paint (PaintDC: HDC; var PaintInfo: TPaintStruct);
  566. begin
  567.     SetTextColor(PaintDC, FontColor);
  568.     SetBkMode(PaintDC, TRANSPARENT);
  569.     if Font <> 0 then
  570.         OldFont := SelectObject(PaintDC, Font);
  571.     TextOut(PaintDC, 10, 30, 'Microworks ObjectMate 2.6', 25);
  572.     if Font <> 0 then
  573.         SelectObject(PaintDC, OldFont);
  574. end;
  575.  
  576. procedure TViewWindow.WMSize (var Msg: TMessage);
  577. var
  578.     CRect : TRect;
  579. begin
  580.     (* AlignToolbar is a TSFXToolbar object method defined in the SFX200 unit. It sends
  581.      * a WM_ALIGNTOOLBAR message to itself to realign a Top, Left, Right or Bottom aligned
  582.      * toolbar or status bar. It should be added to the WM_SIZE message response so that
  583.      * an aligned toolbar gets realigned properly when its parent is resized.
  584.      *)
  585.     Toolbar^.AlignToolbar;
  586.  
  587.     (* The main window was not created with the CS_HREDRAW and CS_VREDRAW style
  588.      * so the toolbar could be excluded from the main window's update region. The
  589.      * left and top toolbar styles automatically redraw that area of the toolbar
  590.      * window that has changed.
  591.      *)
  592.      UpdateClientRect;
  593. end;
  594.  
  595. procedure TViewWindow.WMCommand (var Msg: TMessage);
  596. begin
  597.     with Msg do
  598.     begin
  599.         if UseHints and (lParamLo = 0) and (lParamHi = 0) then
  600.             Toolbar^.SetText('');
  601.         if (wParam >= cm_PrintMin) and (wParam <= cm_PrintMax) then
  602.             HandlePrintDialogs(HWindow, wParam)
  603.         else
  604.         if (wParam >= cm_SearchMin) and (wParam <= cm_SearchMax) then
  605.             HandleSearchDialogs(HWindow, wParam)
  606.         else
  607.             TSFXWindow.WMCommand(Msg);
  608.     end;
  609. end;
  610.  
  611. procedure TViewWindow.WMDrawItem (var Msg:tMessage);
  612. begin
  613.     (* Pass WMDrawItem onto DrawMenuItem. If you don't want the user to
  614.      * change fonts and highlight colors you can use the default zero
  615.      * values for Font, Color and TextColor.
  616.      *)
  617.     if PDrawItemStruct(Msg.lParam)^.CtlType = ODT_MENU then
  618.         DrawMenuItem(PDrawItemStruct(Msg.lParam), 0, 0, 0);
  619. end;
  620.  
  621. procedure TViewWindow.WMInitMenuPopup (var Msg: TMessage);
  622. begin
  623.     if (Msg.lParamHi = 0) and (Msg.lParamLo = 5) then
  624.     begin
  625.         if ToolbarPos <> OldToolbarPos then
  626.         begin
  627.             CheckMenuItem(Msg.wParam, ToolbarPos, MF_CHECKED);
  628.             CheckMenuItem(Msg.wParam, OldToolbarPos, MF_UNCHECKED);
  629.         end;
  630.         if UseHints then
  631.             CheckMenuItem(Msg.wParam, cm_Hints, MF_CHECKED)
  632.         else
  633.             CheckMenuItem(Msg.wParam, cm_Hints, MF_UNCHECKED);
  634.     end
  635.     else
  636.         TSFXWindow.DefWndProc(Msg);
  637. end;
  638.  
  639. procedure TViewWindow.WMMeasureItem (var Msg: TMessage);
  640. begin
  641.     (* The same font handle passed to DrawMenuItem must be passed to MeasureMenuItem
  642.      *)
  643.     if PMeasureItemStruct(Msg.lParam)^.CtlType = ODT_MENU then
  644.         MeasureMenuItem(HWindow, PMeasureItemStruct(Msg.lParam), 0);
  645. end;
  646.  
  647. procedure TViewWindow.WMMenuChar (var Msg: TMessage);
  648. begin
  649.     (* ProcessSystemChar automatically handles ownerdraw system menu mnemonics.
  650.      *)
  651.     if Msg.lParamLo and mf_SysMenu <> 0 then
  652.         Msg.Result := ProcessSystemChar(Msg.wParam)
  653.     else
  654.     if Msg.lParamHi = GetSubMenu(GetMenu(HWindow), 0) then
  655.     begin
  656.         case Msg.wParam of
  657.             79, 111: Msg.Result := MakeLong(0, 2);
  658.             88, 120: Msg.Result := MakeLong(1, 2);
  659.             70, 102: Msg.Result := MakeLong(2, 2);
  660.             83, 115: Msg.Result := MakeLong(3, 2);
  661.             68, 100: Msg.Result := MakeLong(5, 2);
  662.             82, 114: Msg.Result := MakeLong(6, 2);
  663.             80, 112: Msg.Result := MakeLong(8, 2);
  664.             73, 105: Msg.Result := MakeLong(9, 2);
  665.             78, 110: Msg.Result := MakeLong(10, 2);
  666.             84, 116: Msg.Result := MakeLong(11, 2);
  667.             69, 101: Msg.Result := MakeLong(13, 2);
  668.         end;
  669.     end
  670.     else
  671.     if (Msg.lParamHi = GetSubMenu(GetMenu(HWindow), 1)) then
  672.     begin
  673.         case Msg.wParam of
  674.             70, 102: Msg.Result := MakeLong(0, 2);
  675.             73, 105: Msg.Result := MakeLong(1, 2);
  676.             82, 114: Msg.Result := MakeLong(3, 2);
  677.             69, 101: Msg.Result := MakeLong(4, 2);
  678.         end;
  679.     end
  680.     else
  681.     if Msg.lParamHi = GetSubMenu(GetMenu(HWindow), 2) then
  682.     begin
  683.         case Msg.wParam of
  684.             66, 98:  Msg.Result := MakeLong(0, 2);
  685.             67, 99:  Msg.Result := MakeLong(1, 2);
  686.             69, 101: Msg.Result := MakeLong(3, 2);
  687.             88, 120: Msg.Result := MakeLong(4, 2);
  688.         end;
  689.     end
  690.     else
  691.     if Msg.lParamHi = GetSubMenu(GetMenu(HWindow), 3) then
  692.     begin
  693.         case Msg.wParam of
  694.             66, 98:  Msg.Result := MakeLong(0, 2);
  695.             70, 102: Msg.Result := MakeLong(1, 2);
  696.             69, 101: Msg.Result := MakeLong(3, 2);
  697.             88, 120: Msg.Result := MakeLong(4, 2);
  698.             84, 116: Msg.Result := MakeLong(5, 2);
  699.         end;
  700.     end
  701.     else
  702.     if Msg.lParamHi = GetSubMenu(GetMenu(HWindow), 4) then
  703.     begin
  704.         case Msg.wParam of
  705.             66, 98:  Msg.Result := MakeLong(0, 2);
  706.             83, 115: Msg.Result := MakeLong(1, 2);
  707.             72, 104: Msg.Result := MakeLong(2, 2);
  708.             75, 107: Msg.Result := MakeLong(3, 2);
  709.             82, 114: Msg.Result := MakeLong(4, 2);
  710.             67, 99:  Msg.Result := MakeLong(5, 2);
  711.             84, 116: Msg.Result := MakeLong(7, 2);
  712.             77, 109: Msg.Result := MakeLong(8, 2);
  713.             87, 119: Msg.Result := MakeLong(10, 2);
  714.         end;
  715.     end
  716.     else
  717.     if Msg.lParamHi = GetSubMenu(GetMenu(HWindow), 5) then
  718.     begin
  719.         case Msg.wparam of
  720.             84, 116: Msg.Result := MakeLong(0, 2);
  721.             70, 102: Msg.Result := MakeLong(1, 2);
  722.             66, 98:  Msg.Result := MakeLong(2, 2);
  723.             83, 115: Msg.Result := MakeLong(3, 2);
  724.             72, 104: Msg.Result := MakeLong(5, 2);
  725.         end;
  726.     end
  727.     else
  728.     if Msg.lParamHi = GetSubMenu(GetMenu(HWindow), 6) then
  729.     begin
  730.         case Msg.wParam of
  731.             79, 111: Msg.Result := MakeLong(0, 2);
  732.             65,    97:  Msg.Result := MakeLong(1, 2);
  733.         end;
  734.     end;
  735. end;
  736.  
  737. procedure TViewWindow.WMMenuSelect (var Msg: TMessage);
  738. begin
  739.     if UseHints then
  740.     begin
  741.         Text[0] := #0;
  742.         LoadString(HInstance, Msg.wParam, Text, SizeOf(Text));
  743.         Toolbar^.SetText(Text);
  744.     end;
  745. end;
  746.  
  747. procedure TViewWindow.WMMouseMove (var Msg: TMessage);
  748. begin
  749.     HandleMouseMove(MakePoint(Msg.lParam));
  750. end;
  751.  
  752. procedure TViewWindow.WMNCMousemove (var Msg: TMessage);
  753. begin
  754.     HandleMouseMove(MakePoint(Msg.lParam));
  755. end;
  756.  
  757. procedure TViewWindow.WMSFXApplyColor (var Msg: TMessage);
  758. begin
  759.     (* This private message is sent when the user presses the Apply button in
  760.      * a Color common dialog box. Msg.wParam is zero and Msg.lParam is the new RGB color
  761.      * value selected by the user. This value is used to change the window's
  762.      * background brush.
  763.      *)
  764.     BkBrush := CreateSolidBrush(Msg.lParam);
  765.     OldBrush := SetClassWord(HWindow, gcw_HBrBackground, BkBrush);
  766.     EraseObject(OldBrush);
  767.     UpdateClientRect;
  768. end;
  769.  
  770. procedure TViewWindow.WMSFXApplyFont (var Msg: TMessage);
  771. begin
  772.  (* This private message is sent when the user presses the Apply button in a
  773.     * Font common dialog box. Msg.wParam is the handle of the newly created font
  774.     * and Msg.lParam is the new RGB color value. If the color option is not used
  775.     * by the font dialog box Msg.lParam is 'RGB(0, 0, 0)'. SFX200.DLL does not delete
  776.     *    this font, that's your responsiblilty!
  777.     *)
  778.     EraseObject(Font);
  779.     Font := Msg.wParam;
  780.     FontColor := Msg.lParam;
  781.     UpdateClientRect;
  782. end;
  783.  
  784. procedure TViewWindow.WMSFXHelp (var Msg: TMessage);
  785. begin
  786.     (* This private message is sent when the user presses the help button in a
  787.      * one of the common dialog boxes. Msg.wParam is zero, Msg.lParamLo is the
  788.      * window handle of the common dialog box sending the message and Msg.lParamHi
  789.      * identifies the type of common dialog box template sending the message. It is
  790.      * one of the common dialog constants defined in the SFX200 unit.
  791.      *)
  792.     Text[0] := #0;
  793.     LoadString(HInstance, Msg.lParamHi, Text, SizeOf(Text));
  794.     SFXMsgBox(HWindow, Text, 'Information', mb_IconInformation, Style);
  795. end;
  796.  
  797. procedure TViewWindow.WMSFXInitDialog (var Msg: TMessage);
  798. begin
  799.     (* WM_SFXINITDIALOG is sent from an SFX common dialog box's WM_INITDIALOG message
  800.      * response in SFX200.DLL. wParam is a handle to the common dialog box and lParam
  801.      * is the DLG_XXX constant identifying the type of common dialog box template.
  802.      * This message gives you a chance to do something extra initialization - like
  803.      * setting the MWS_SFXCAPTION flag and specifying a custom icon for each template.
  804.      *)
  805.     SetWindowLong(Msg.wParam, gwl_Style, GetWindowLong(Msg.wParam, gwl_Style) or MWS_SFXCAPTION);
  806.  
  807.     (* A WM_SETBITMAP message is sent to specify the custom icon to display on the
  808.      * title bar. The icon image has been drawn to fit exactly, depending on the
  809.      * height of the title bar, so Msg.lParam is 1 to prevent the icon shrinking.
  810.      *)
  811.     if Msg.lParamHi = dlg_Find then
  812.         SendMessage(Msg.wParam, wm_SetBitmap, FindIcon, 1);
  813.     if Msg.lParamHi = dlg_Replace then
  814.         SendMessage(Msg.wParam, wm_SetBitmap, ReplaceIcon, 1);
  815.     if (Msg.lParamHi = dlg_Color) or (Msg.lParamHi = dlg_ExColor) then
  816.         SendMessage(Msg.wParam, wm_SetBitmap, ColorIcon, 1);
  817.     if (Msg.lParamHi = dlg_Font) or (Msg.lParamHi = dlg_ExFont) then
  818.         SendMessage(Msg.wParam, wm_SetBitmap, FontIcon, 1);
  819.     if (Msg.lParamHi = dlg_Print) or (Msg.lParamHi = dlg_PrintSetup) then
  820.         SendMessage(Msg.wParam, wm_SetBitmap, PrintIcon, 1);
  821.     if Msg.lParamHi = dlg_Opendir then
  822.         SendMessage(Msg.wParam, wm_SetBitmap, DirIcon, 1);
  823.     if (Msg.lParamHi = dlg_OpenSave) or (Msg.lParamHi = dlg_ExOpenSave) then
  824.         SendMessage(Msg.wParam, wm_SetBitmap, FileIcon, 1);
  825. end;
  826.  
  827. procedure TViewWindow.DefWndProc (var Msg: TMessage);
  828. begin
  829.     { Trap the Find/Replace message }
  830.     with Msg do
  831.         if Message = MsgFind then
  832.             HandleSearch(HWindow, PFindReplace(Msg.lParam))
  833.     else
  834.         TSFXWindow.DefWndProc(Msg);
  835. end;
  836.  
  837. procedure TViewWindow.UpdateClientRect;
  838. var
  839.     CRect : TRect;
  840. begin
  841.     GetClientRect(HWindow, CRect);
  842.     if ToolbarPos = cm_Top then
  843.         Inc(CRect.Top, 27)
  844.     else
  845.     if (ToolbarPos = cm_Bottom) or (ToolbarPos = cm_Status) then
  846.         Dec(CRect.Bottom, 27);
  847.     InvalidateRect(HWindow, @CRect, True);
  848. end;
  849.  
  850. procedure TViewWindow.HandleMouseMove (Point: TPoint);
  851. var
  852.     ChildRect : TRect;
  853. begin
  854.     (* UseHints is a boolean value thats switches on/off Flyover hints. This code
  855.      * clears the toolbar/status bar text if the cursor is inside the main window
  856.      * but out side the toolbar. The code that sets the text is in the TToolbar
  857.      * WM_MOUSEMOVE method.
  858.      *)
  859.     if UseHints then
  860.     begin
  861.         ChildRect := ChildToParentRect(Toolbar^.HWindow)^;
  862.         if not PtInRect(ChildRect, Point) then
  863.         begin
  864.             Toolbar^.GetText(Text);
  865.             if StrIComp(Text, #0) <> 0 then
  866.                 Toolbar^.SetText(#0);
  867.         end;
  868.     end;
  869. end;
  870.  
  871. procedure TViewWindow.HandleSearch (WndOwner: HWnd; pFR: PFindReplace);
  872. var
  873.     FindMsg : array[0..512] of Char;
  874. begin
  875.     with pFR^ do
  876.     begin
  877.         if fr_DialogTerm and Flags <> 0 then
  878.         begin
  879.             (* The dialog is closing on the Close button.  Therefore we must
  880.              * invalidate the handle we saved from FindText or ReplaceText.
  881.              * Since we have two window handles for these dialogs we have to
  882.              * determine which one to invalidate.  Since the FINDMSGSTRING
  883.              * message does not distinguish the two dialogs, we have stored
  884.              * a non-zero in the FINDREPLACE structure's lCustData for
  885.              * FindText and a zero for ReplaceText.
  886.             *)
  887.             if lCustData <> 0 then
  888.                 FindDlg := 0
  889.             else
  890.                 ReplaceDlg := 0;
  891.             Exit;
  892.         end;
  893.  
  894.         (* Perform your searching here.  For this example the state of the
  895.          * various flags simply reported.
  896.          *)
  897.         StrCopy(FindMsg, 'Dialog:'#9#9);
  898.         if lCustData <> 0 then
  899.             StrCat(FindMsg, 'Find'#10#13)
  900.         else
  901.             StrCat(FindMsg, 'Replace'#10#13);
  902.  
  903.         StrCat(FindMsg, 'Button:'#9#9);
  904.         if Flags and fr_FindNext <> 0 then
  905.             StrCat(FindMsg, 'Find Next'#10#13)
  906.         else
  907.         if Flags and fr_Replace <> 0 then
  908.             StrCat(FindMsg, 'Replace'#10#13)
  909.         else
  910.         if Flags and fr_ReplaceAll <> 0 then
  911.             StrCat(FindMsg, 'Replace All'#10#13);
  912.  
  913.         StrCat(FindMsg, 'Direction:'#9);
  914.         if Flags and fr_Down <> 0 then
  915.             StrCat(FindMsg, 'Forward'#10#13)
  916.         else
  917.             StrCat(FindMsg, 'Backward'#10#13);
  918.  
  919.         StrCat(FindMsg, 'Whole Word:'#9);
  920.         if Flags and fr_WholeWord <> 0 then
  921.             StrCat(FindMsg, 'On'#10#13)
  922.         else
  923.             StrCat(FindMsg, 'Off'#10#13);
  924.  
  925.         StrCat(FindMsg, 'Match Case:'#9);
  926.         if Flags and fr_MatchCase <> 0 then
  927.             StrCat(FindMsg, 'On'#10#13)
  928.         else
  929.             StrCat(FindMsg, 'Off'#10#13);
  930.         SFXMsgBox(WndOwner, FindMsg, 'Find/Replace Message', mb_IconInformation, 0);
  931.     end;
  932. end;
  933.  
  934. function TViewWindow.HandlePrintDialogs (WndOwner: HWnd; iDialog: Word): BOOL;
  935. var
  936.     pd      : TPrintDlg;
  937.     Reply   : BOOL;
  938.     DocName : PChar;
  939. begin
  940.     FillChar(pd, SizeOf(TPrintDlg), #0);
  941.     with pd do
  942.     begin
  943.         lStructSize := SizeOf(TPrintDlg);
  944.         hwndOwner := WndOwner;
  945.         hInstance := GetSFXInstance;  { Returns instance handle of SFX200.DLL }
  946.         { GetSFXTemplate returns a pointer the string identifing which template to load }
  947.         lpPrintTemplateName := GetSFXTemplate(ClassName, DLG_PRINT);
  948.         lpSetupTemplateName := GetSFXTemplate(ClassName, DLG_PRINTSETUP);
  949.  
  950.         case iDialog of
  951.             cm_Print, cm_PrintHelp:
  952.             begin
  953.                 { Returns DC for printer }
  954.                 Flags := Flags or pd_ReturnDC or pd_AllPages or pd_Collate or pd_DisablePrintToFile or
  955.                                  pd_EnablePrintTemplate or pd_EnableSetupTemplate;
  956.  
  957.                 if iDialog = cm_PrintHelp then
  958.                     Flags := Flags or pd_ShowHelp;
  959.  
  960.                 nCopies := 1;      { Initial contents of the Copies edit control.}
  961.                 nFromPage := 1;    { Initial contents of the From edit control.}
  962.                 nToPage := 25;     { Initial contents of the To edit control.}
  963.                 nMinPage := 1;     { Lowest possible number in the From/To edits.}
  964.                 nMaxPage := 25;    { Highest possible number in the From/To edits.}
  965.                 Reply := PrintDlg(pd);
  966.                 if Reply then
  967.                 begin
  968.                     (* Print something useless...note that this code
  969.                      * ignores trying to make the point size in the
  970.                      * font match the point size on the printed page.
  971.                      * This is simply to demonstrate that the hDC is
  972.                      * immediately available for printing.
  973.                      *)
  974.                     if Font <> 0 then
  975.                     begin
  976.                         OldFont := SelectObject(pd.hDC, Font);
  977.                         DocName := 'Printing Test';
  978.                         Escape(pd.hDC, StartDoc, 14, DocName, nil);
  979.                         TextOut(pd.hDC, 50, 50, 'Microworks ObjectMate 2.3', 27);
  980.                         Escape(pd.hDC, NewFrame, 0, nil, nil);
  981.                         Escape(pd.hDC, EndDoc, 0, nil, nil);
  982.  
  983.                         { Cleanup }
  984.                         if Font <> 0 then
  985.                             SelectObject(pd.hDC, OldFont);
  986.                     end;
  987.                 end;
  988.             end;
  989.  
  990.             cm_PrintSetup, cm_PrintSetupHelp:
  991.             begin
  992.                 (* Do Printer Setup only with PD_PRINTSETUP.  You can still
  993.                  * retrieve the DC/IC from this with PD_RETURNDC or PD_RETURNIC.
  994.                  *)
  995.                 Flags := Flags or pd_ReturnIC or pd_PrintSetup or pd_EnableSetupTemplate;
  996.  
  997.                 if iDialog = cm_PrintSetupHelp then
  998.                     Flags := Flags or pd_ShowHelp;
  999.                 Reply := PrintDlg(pd);
  1000.             end;
  1001.  
  1002.         end;
  1003.  
  1004.  
  1005.         (* Cleanup:  Delete any DC or IC created by PrintDlg and free the
  1006.      * allocated handles hDevMode and hDevNames.  The caller is responsible
  1007.      * to perform this cleanup once it is finished using the DC or the data.
  1008.          *)
  1009.         if pd.hDC <> 0 then
  1010.             DeleteDC(pd.hDC);
  1011.  
  1012.         if pd.hDevMode <> 0 then
  1013.             GlobalFree(pd.hDevMode);
  1014.  
  1015.         if pd.hDevNames <> 0 then
  1016.             GlobalFree(pd.hDevNames);
  1017.         HandlePrintDialogs := Reply;
  1018.     end;
  1019. end;
  1020.  
  1021. function TViewWindow.HandleSearchDialogs (WndOwner: HWnd; iDialog: Word): HWnd;
  1022. var
  1023.     HDialog : HWnd;
  1024. begin
  1025.     (* Since we pass a pointer to the TFindReplace structure for
  1026.      * a modeless dialog, the structure must persist outside the scope of
  1027.      * this function, that is, it must be global. We use a
  1028.      * different structure for FindText and ReplaceText since we allow
  1029.      * both dialogs to be active at one time.
  1030.      *)
  1031.     case iDialog of
  1032.         cm_SearchFind, cm_SearchFindHelp:
  1033.         begin
  1034.             if FindDlg <> 0 then
  1035.                 Exit;
  1036.             FillChar(frFind, SizeOf(TFindReplace), #0);
  1037.             with frFind do
  1038.             begin
  1039.                 lStructSize := SizeOf(TFindReplace);
  1040.                 hwndOwner := WndOwner;
  1041.                 hInstance := GetSFXInstance;
  1042.                 lpTemplateName := GetSFXTemplate(ClassName, dlg_Find);
  1043.                 StrCopy(Find, 'Search String');
  1044.                 lpstrFindWhat := Find;
  1045.                 wFindWhatLen := SizeOf(Find);
  1046.                 Flags := Flags or fr_Down or fr_MatchCase or fr_WholeWord or fr_EnableTemplate;
  1047.                 if iDialog = cm_SearchFindHelp then
  1048.                     Flags := Flags or fr_ShowHelp;
  1049.                 (* For our own purposes, use lCustData to distinguish
  1050.                  * an invocation of Find vs. and invocation or Replace
  1051.                  * within the message processing for FindMsgString. Otherwise
  1052.                  * there's no way to distinguish where that message originated.
  1053.                  *)
  1054.                 lCustData := 1;
  1055.                 FindDlg := FindText(frFind);
  1056.                 HDialog := FindDlg;
  1057.                 (* FindText returns as soon as the dialog is up. Therefore we
  1058.                  * have to manage memory and so forth when we are told it's
  1059.                  * closing.  Memory for the TFindReplace structure and the
  1060.                  * lpstrFindWhat string both must be global.
  1061.                  *)
  1062.             end;
  1063.         end;
  1064.  
  1065.         cm_SearchReplace, cm_SearchReplaceHelp:
  1066.         begin
  1067.             if ReplaceDlg <> 0 then
  1068.                 Exit;
  1069.             FillChar(frReplace, SizeOf(TFindReplace), #0);
  1070.             with frReplace do
  1071.             begin
  1072.                 lStructSize := SizeOf(TFindReplace);
  1073.                 hwndOwner := WndOwner;
  1074.                 hInstance := GetSFXInstance;
  1075.                 lpTemplateName := GetSFXTemplate(ClassName, dlg_Replace);
  1076.                 StrCopy(ReplaceFind, 'Search String');
  1077.                 lpstrFindWhat := ReplaceFind;
  1078.                 wFindWhatLen := SizeOf(ReplaceFind);
  1079.                 StrCopy(Replace, 'Replace String');
  1080.                 lpstrReplaceWith := Replace;
  1081.                 wReplaceWithLen := SizeOf(Replace);
  1082.                 Flags := Flags or fr_WholeWord or fr_EnableTemplate;
  1083.                 if iDialog = cm_SearchReplaceHelp then
  1084.                     Flags := Flags or fr_ShowHelp;
  1085.                 lCustData := 0;
  1086.                 ReplaceDlg := ReplaceText(frReplace);
  1087.                 HDialog := ReplaceDlg;
  1088.             end;
  1089.         end;
  1090.     end;
  1091.     HandleSearchDialogs := HDialog;
  1092. end;
  1093.  
  1094. procedure TViewWindow.CMFileOpen (var Msg: TMessage);
  1095. begin
  1096.     (* The new SFXOpenFile function is the easiest way to display a 'Open File'
  1097.      * common dialog box. Many of the arguments have defaults and may only require
  1098.      * a 'nil' or '0' value, depending on your requirements.
  1099.      *)
  1100.     Filters := 'All Files (*.*)'#0'*.*'#0'Source Files (*.PAS)'#0'*.PAS'#0;
  1101.     OFNFlags := 0;
  1102.     Index := 1;
  1103.     szText[0] := #0;
  1104.     Template := GetSFXTemplateId(ClassName, dlg_OpenSave);
  1105.     if (SFXOpenFile(HWindow, szText, Filters, OFNFlags, Template, False, nil, index, nil)) then
  1106.         SFXMsgBox(HWindow, szText, 'You selected', mb_IconInformation, Style or mws_SFXCaption);
  1107. end;
  1108.  
  1109. procedure TViewWindow.CMFileExOpen (var Msg: TMessage);
  1110. begin
  1111.     Filters := 'All Files (*.*)'#0'*.*'#0'Source Files (*.PAS)'#0'*.PAS'#0;
  1112.     OFNFlags := 0;
  1113.     Index := 1;
  1114.     szText[0] := #0;
  1115.     Template := GetSFXTemplateId(ClassName, dlg_ExOpenSave);
  1116.     if SFXOpenFile(HWindow, szText, Filters, OFNFlags, Template, TRUE, nil, index, nil) then
  1117.         SFXMsgBox(HWindow, szText, 'You selected', mb_IconInformation, Style or mws_SFXCaption);
  1118. end;
  1119.  
  1120. procedure TViewWindow.CMFileOpenExtraFlags (var Msg: TMessage);
  1121. begin
  1122.     Filters := 'All Files (*.*)'#0'*.*'#0'Source Files (*.PAS)'#0'*.PAS'#0;
  1123.     OFNFlags := ofn_ShowHelp;
  1124.     Index := 1;
  1125.     szText[0] := #0;
  1126.     Template := GetSFXTemplateId(ClassName, dlg_OpenSave);
  1127.     if SFXOpenFile(HWindow, szText, Filters, OFNFlags, Template, TRUE, nil, index, nil) then
  1128.         SFXMsgBox(HWindow, szText, 'You selected', mb_IconInformation, Style);
  1129. end;
  1130.  
  1131. procedure TViewWindow.CMFileSaveAs (var Msg: TMessage);
  1132. begin
  1133.     (* The new SFXSaveFile function is the easiest way to display a 'Save File As'
  1134.      * common dialog box. Many of the arguments have defaults and may only require
  1135.      * a 'nil' or '0' value, depending on your requirements.
  1136.      *)
  1137.     Filters := 'All Files (*.*)'#0'*.*'#0'Source Files (*.PAS)'#0'*.PAS'#0;
  1138.     OFNFlags := ofn_FileMustExist or ofn_HideReadOnly;
  1139.     Index := 1;
  1140.     szText[0] := #0;
  1141.     Template := GetSFXTemplateId(ClassName, dlg_OpenSave);
  1142.     if SFXSaveFile(HWindow, szText, Filters, OFNFlags, Template, TRUE, nil, index, nil) then
  1143.         SFXMsgBox(HWindow, szText, 'You selected', mb_IconInformation, Style);
  1144. end;
  1145.  
  1146. procedure TViewWindow.CMOpenDir (var Msg: TMessage);
  1147. begin
  1148.     (* SFXDirBox displays a directory selection common dialog box. This function
  1149.      * displays the dialog box by MWS_XXX style flag (like the SFXMsgBox) not
  1150.      * template ID and it centers the dialog box over the desktop window.
  1151.      *)
  1152.     if SFXDirBox(HWindow, 'Select Directory', Text, 0, Style) = id_OK then
  1153.         SFXMsgBox(HWindow, Text, 'You Selected', mb_IconInformation, Style);
  1154. end;
  1155.  
  1156. procedure TViewWindow.CMOpenDirHelp (var Msg: TMessage);
  1157. begin
  1158.     (* The new SFXOpenDir function is the easiest way to display an 'Open File' style
  1159.      * directory selection common dialog box style. Many of the arguments have defaults
  1160.      * and may only require a 'nil' or '0' value depending on your requirements. This
  1161.      * function is similar to SFXDirBox but gives you more options.
  1162.      *)
  1163.     OFNFlags := ofn_NoChangeDir or ofn_ShowHelp;
  1164.     szText[0] := #0;
  1165.     Template := GetSFXTemplateId(ClassName, dlg_OpenDir);
  1166.     if SFXOpenDir (HWindow, szText, 'Change Directory', OFNFlags, Template, TRUE) then
  1167.         SFXMsgBox(HWindow, szText, 'You selected', mb_IconInformation, Style or mws_SFXCaption);
  1168. end;
  1169.  
  1170. procedure TViewWindow.CMBasicColor (var Msg: TMessage);
  1171. begin
  1172.     (* The new SFXChooseColor function is the easiest way to display a 'Choose color'
  1173.      * common dialog box. Many of the arguments have defaults and may only require
  1174.      * a 'nil' or '0' value, depending on your requirements.
  1175.      *
  1176.      * The basic 'CommDlg.dll' color dialog does not have an Apply button.
  1177.      * ObjectMate adds an Apply button to the color dialog box and displays
  1178.      * it by default. To use the apply button all you have to do is trap the
  1179.      * WM_SFXAPPLYCOLOR message in the parent's window function, SFX200.DLL
  1180.      * handles the button for you. wParam is zero and lParam contains the
  1181.      * selected RGB color value. The Apply button is only activated when the
  1182.      * CC_FULLOPEN flag is specified or the color dialog box has been opened
  1183.      * by the user.
  1184.      *
  1185.      * Specifing CC_SHOWHELP displays a help button instead of an Apply button.
  1186.      * SFX200.DLL manages the help button for you so you don't have to worry about
  1187.      * hooks. When you press the help button a WM_SFXHELP message is sent to the
  1188.      * owner of the dialog box. wParam is zero, LOWORD(lParam) contains the window
  1189.      * handle of the dialog box sending the message and HIWORD(lParam) contains the
  1190.      * dialog-identifier, identifying which type of common dialog box sent
  1191.      * the message. eg dlg_Color or dlg_ExColor.
  1192.      *)
  1193.     CCFlags := cc_RGBInit;
  1194.     Template := GetSFXTemplateId(ClassName, dlg_Color);
  1195.     if SFXChooseColor(HWindow, Color, CCFlags, Template, False, nil) then
  1196.         SendMessage(HWindow, wm_SFXApplyColor, 0, Color);
  1197. end;
  1198.  
  1199. procedure TViewWindow.CMBasicColorHelp (var Msg: TMessage);
  1200. type
  1201.     TLongArray = array [0..15] of Longint;
  1202. const
  1203.     { Establishes a set of custom colors in 15 shades of blue }
  1204.     CustColors: TLongArray = (
  1205.     $000000, $100000, $200000, $300000,
  1206.     $400000, $500000, $600000, $700000,
  1207.     $800000, $900000, $A00000, $B00000,
  1208.     $C00000, $D00000, $E00000, $F00000);
  1209. begin
  1210.     CCFlags := cc_RGBInit or cc_ShowHelp or cc_FullOpen;
  1211.     Template := GetSFXTemplateId(ClassName, dlg_Color);
  1212.     if SFXChooseColor(HWindow, Color, CCFlags, Template, True, @CustColors) then
  1213.         SendMessage(HWindow, wm_SFXApplyColor, 0, Color);
  1214. end;
  1215.  
  1216. procedure TViewWindow.CMExtendedColor (var Msg: TMessage);
  1217. begin
  1218.     (* The extended style color dialog box is customized to display
  1219.      * only 48 basic colors. It does not open. By default it displays an Apply
  1220.      * button. To activate the Apply button in this template you must
  1221.      * specify the CC_FULLOPEN flag. Specifying CC_FULLOPEN activates the
  1222.      * hidden controls SFX200.DLL reads to determine the color selection.
  1223.      *)
  1224.     CCFlags := cc_RGBInit or cc_FullOpen;
  1225.     Template := GetSFXTemplateId(ClassName, dlg_ExColor);
  1226.     if SFXChooseColor(HWindow, Color, CCFlags, Template, True, nil) then
  1227.         SendMessage(HWindow, wm_SFXApplyColor, 0, Color);
  1228. end;
  1229.  
  1230. procedure TViewWindow.CMExtendedColorHelp (var Msg: TMessage);
  1231. begin
  1232.     (* Specifing CC_SHOWHELP displays a help button instead of an Apply button.
  1233.      *)
  1234.     CCFlags := cc_RGBInit or cc_ShowHelp;
  1235.     Template := GetSFXTemplateId(ClassName, dlg_ExColor);
  1236.     if SFXChooseColor(HWindow, Color, CCFlags, Template, False, nil) then
  1237.         SendMessage(HWindow, wm_SFXApplyColor, 0, Color);
  1238. end;
  1239.  
  1240. procedure TViewWindow.CMBasicFont (var Msg: TMessage);
  1241. begin
  1242.     (* The new SFXChooseFont function is the easiest way to display a 'Choose Font'
  1243.      * common dialog box. Many of the arguments have defaults and may only require
  1244.      * a 'nil' or '0' value, depending on your requirements.
  1245.      *)
  1246.     CFFlags := 0;
  1247.     Template := GetSFXTemplateId(ClassName, dlg_Font);
  1248.     if SFXChooseFont(HWindow, LogFont, CFFlags, Template, False, FontColor) then
  1249.     begin
  1250.         EraseObject(Font);
  1251.         Font := CreateFontIndirect(LogFont);
  1252.         UpdateClientRect;
  1253.     end;
  1254. end;
  1255.  
  1256. procedure TViewWindow.CMBasicFontExtraFlags (var Msg: TMessage);
  1257. begin
  1258.     (* When you specify CF_APPLY or CF_SHOWHELP SFX200.DLL activates the Apply and/or
  1259.      * Help buttons for you. You don't have to worry about hooks. When you press the
  1260.      * Apply button a WM_SFXAPPLYFONT message is sent to the owner of the font dialog box.
  1261.      * wParam contains the handle of the newly created font and lParam contains the
  1262.      * selected RGB color value. In reponse to this message you must delete the current font,
  1263.      * and replace it with wParam and you must update the color if color is used.
  1264.      * Everytime you press the Apply button a new font is created. SFX200.DLL does not
  1265.      * delete these fonts, you must do that!
  1266.      *
  1267.      * When you press the help button a WM_SFXHELP message is sent to the
  1268.      * owner of the dialog box. wParam is zero, LOWORD(lParam) contains the window
  1269.      * handle of the dialog box sending the message and HIWORD(lParam) contains the
  1270.      * dialog-identifier identifying which type of common dialog box template sent
  1271.      * the message. eg DLG_FONT or DLG_EXFONT.
  1272.      *)
  1273.     CFFlags := cf_Effects or cf_Both or cf_Apply or cf_ShowHelp;
  1274.     Template := GetSFXTemplateId(ClassName, dlg_Font);
  1275.     if SFXChooseFont(HWindow, LogFont, CFFlags, Template, True, FontColor) then
  1276.     begin
  1277.         EraseObject(Font);
  1278.         Font := CreateFontIndirect(LogFont);
  1279.         UpdateClientRect;
  1280.     end;
  1281. end;
  1282.  
  1283. procedure TViewWindow.CMExtendedFont (var Msg: TMessage);
  1284. begin
  1285.     CFFlags := 0;
  1286.     Template := GetSFXTemplateId(ClassName, dlg_ExFont);
  1287.     if SFXChooseFont(HWindow, LogFont, CFFlags, Template, False, FontColor) then
  1288.     begin
  1289.         EraseObject(Font);
  1290.         FontColor := 0;
  1291.         Font := CreateFontIndirect(LogFont);
  1292.         UpdateClientRect;
  1293.     end;
  1294. end;
  1295.  
  1296. procedure TViewWindow.CMExtendedFontApply (var Msg: TMessage);
  1297. begin
  1298.     CFFlags := cf_Apply;
  1299.     Template := GetSFXTemplateId(ClassName, dlg_ExFont);
  1300.     if SFXChooseFont(HWindow, LogFont, CFFlags, Template, True, FontColor) then
  1301.     begin
  1302.         EraseObject(Font);
  1303.         FontColor := 0;
  1304.         Font := CreateFontIndirect(LogFont);
  1305.         UpdateClientRect;
  1306.     end;
  1307. end;
  1308.  
  1309. procedure TViewWindow.CMExtendedFontHelp (var Msg: TMessage);
  1310. begin
  1311.     CFFlags := cf_ShowHelp;
  1312.     Template := GetSFXTemplateId(ClassName, dlg_ExFont);
  1313.     if SFXChooseFont(HWindow, LogFont, CFFlags, Template, False, FontColor) then
  1314.     begin
  1315.         EraseObject(Font);
  1316.         FontColor := 0;
  1317.         Font := CreateFontIndirect(LogFont);
  1318.         UpdateClientRect;
  1319.     end;
  1320. end;
  1321.  
  1322. procedure TViewWindow.CMButton (var Msg: TMessage);
  1323. var
  1324.     Dlg : PButtonDialog;
  1325. begin
  1326.     Dlg := New(PButtonDialog, Init(@Self, 'ButtonDialog'));
  1327.     Application^.ExecDialog(Dlg);
  1328. end;
  1329.  
  1330. procedure TViewWindow.CMShade (var Msg: TMessage);
  1331. var
  1332.     Dlg : PDefaultDialog;
  1333. begin
  1334.     Dlg := New(PDefaultDialog, Init(@Self, 'ShadeDialog'));
  1335.     Application^.ExecDialog(Dlg);
  1336. end;
  1337.  
  1338. procedure TViewWindow.CMStatic (var Msg: TMessage);
  1339. var
  1340.     Dlg : PStaticDialog;
  1341. begin
  1342.     Dlg := New(PStaticDialog, Init(@Self, 'StaticDialog'));
  1343.     Application^.ExecDialog(Dlg);
  1344. end;
  1345.  
  1346. procedure TViewWindow.CMCheck (var Msg: TMessage);
  1347. var
  1348.     Dlg : PDefaultDialog;
  1349. begin
  1350.     Dlg := New(PDefaultDialog, Init(@Self, 'CheckDialog'));
  1351.     Application^.ExecDialog(Dlg);
  1352. end;
  1353.  
  1354. procedure TViewWindow.CMRadio (var Msg: TMessage);
  1355. var
  1356.     Dlg : PDefaultDialog;
  1357. begin
  1358.     Dlg := New(PDefaultDialog, Init(@Self, 'RadioDialog'));
  1359.     Application^.ExecDialog(Dlg);
  1360. end;
  1361.  
  1362. procedure TViewWindow.CMControl (var Msg: TMessage);
  1363. var
  1364.     Dlg : PControlDialog;
  1365. begin
  1366.     Dlg := New(PControlDialog, Init(@Self, 'ControlDialog'));
  1367.     Application^.ExecDialog(Dlg);
  1368. end;
  1369.  
  1370. procedure TViewWindow.CMToolbar (var Msg: TMessage);
  1371. var
  1372.     Dlg : PToolbarDialog;
  1373. begin
  1374.     Dlg := New(PToolbarDialog, Init(@Self, 'ToolbarDialog'));
  1375.     Application^.ExecDialog(Dlg);
  1376. end;
  1377.  
  1378. procedure TViewWindow.CMMessageBox (var Msg: TMessage);
  1379. var
  1380.     Dlg : PMessageBoxDialog;
  1381. begin
  1382.     Dlg := New(PMessageBoxDialog, Init(@Self, 'MessageInputDialog'));
  1383.     Application^.ExecDialog(Dlg);
  1384. end;
  1385.  
  1386. procedure TViewWindow.CMWindow (var Msg: TMessage);
  1387. begin
  1388.     SFXMsgBox(HWindow, 'To view the various SpecialFX window, edit window, ' +
  1389.                                          'file window and MDI window objects compile the sample ' +
  1390.                                          'applications in the examples directory.', 'Information',
  1391.                                             mb_OK or mb_IconInformation, Style);
  1392. end;
  1393.  
  1394. procedure TViewWindow.CMTop (var Msg: TMessage);
  1395. begin
  1396.     OldToolbarPos := ToolbarPos;
  1397.     if ToolbarPos <> cm_Top then
  1398.     begin
  1399.         (* An SFX Toolbar sizes itself according to the specified flags and the size
  1400.          * of the first button's bitmap, so cx and cy can be zero. x and y have
  1401.          * no effect on an aligned toolbar (here its top aligned as defined by MTB_TOP)
  1402.          * and are set to zero. To re position a toolbar you have to destroy the old
  1403.          * one and create a new one. When you do, you will have to make the MTB_ROWXX and
  1404.          * MTB_COLOUMNXX flags values appropriate for the new positon and change the
  1405.          * toolbar style flags. The style flags are MTB_TOP, MTB_LEFT, MTB_RIGHT,
  1406.          * MTB_BOTTOM, MTB_FLOAT and MTB_STATUS.
  1407.          *)
  1408.         ToolbarPos := cm_Top;
  1409.         if (Toolbar <> nil) and (Toolbar^.HWindow <> 0) then
  1410.             DestroyWindow(Toolbar^.HWindow);
  1411.         Toolbar := New(PToolbar, Init(@Self, id_Toolbar, 'Dialog Classes,801,802,803,804',
  1412.                                                                     0, 0, True));
  1413.         Toolbar^.Attr.Style := Toolbar^.Attr.Style or mtb_Row1 or mtb_Column4 or
  1414.                                                      mtb_BitmapButton or mtb_Top or mtb_Radio;
  1415.         Application^.MakeWindow(Toolbar);
  1416.  
  1417.         (* The toolbar is created with the MTB_RADIO flag so its buttons behave as
  1418.          * a set of mutually exclusive radio buttons. CheckTool sends a WM_SETCHECK
  1419.          * private message (see SFX200 unit) to the toolbar to check the button
  1420.          * identified by tool.
  1421.          *)
  1422.         Toolbar^.CheckTool(Tool);
  1423.  
  1424.         (* GetSFXObject retrieves the handle of the specified stock object. Do not delete
  1425.          * these handles as they are created, used and deleted by SFX200.DLL.
  1426.          * Here it sets the font for the toolbar's status bar to the stock FINE_FONT
  1427.          * object (= MS San Serif 8).
  1428.          *)
  1429.         Toolbar^.SetFont(GetSFXObject(Fine_Font));
  1430.     end;
  1431. end;
  1432.  
  1433. procedure TViewWindow.CMFloat (var Msg: TMessage);
  1434. begin
  1435.     OldToolbarPos := ToolbarPos;
  1436.     if ToolbarPos <> cm_Float then
  1437.     begin
  1438.         ToolbarPos := cm_Float;
  1439.         if (Toolbar <> nil) and (Toolbar^.HWindow <> 0) then
  1440.             DestroyWindow(Toolbar^.HWindow);
  1441.         Toolbar := New(PToolbar, Init(@Self, id_Toolbar, 'Dialog Classes,801,802,803,804',
  1442.                                                              GetSystemMetrics(SM_CXSCREEN), 0, True));
  1443.         Toolbar^.Attr.Style := Toolbar^.Attr.Style or mtb_Row1 or mtb_Column4 or
  1444.                                                      mtb_BitmapButton or mtb_Float or mtb_Radio or
  1445.                                                      mtb_3DFrame or ws_Caption;
  1446.         Application^.MakeWindow(Toolbar);
  1447.         Toolbar^.CheckTool(Tool);
  1448.     end;
  1449. end;
  1450.  
  1451. procedure TViewWindow.CMBottom (var Msg: TMessage);
  1452. begin
  1453.     OldToolbarPos := ToolbarPos;
  1454.     if ToolbarPos <> cm_Bottom then
  1455.     begin
  1456.         ToolbarPos := cm_Bottom;
  1457.         if (Toolbar <> nil) and (Toolbar^.HWindow <> 0) then
  1458.             DestroyWindow(Toolbar^.HWindow);
  1459.         Toolbar := New(PToolbar, Init(@Self, id_Toolbar, 'Dialog Classes,801,802,803,804',
  1460.                                                                     0, 0, True));
  1461.         Toolbar^.Attr.Style := Toolbar^.Attr.Style or mtb_Row1 or mtb_Column4 or
  1462.                                                      mtb_BitmapButton or mtb_Bottom or mtb_Radio;
  1463.         Application^.MakeWindow(Toolbar);
  1464.         Toolbar^.CheckTool(Tool);
  1465.         Toolbar^.SetFont(GetSFXObject(Fine_Font));
  1466.     end;
  1467. end;
  1468.  
  1469. procedure TViewWindow.CMStatus (var Msg: TMessage);
  1470. begin
  1471.     OldToolbarPos := ToolbarPos;
  1472.     if ToolbarPos <> cm_Status then
  1473.     begin
  1474.         ToolbarPos := cm_Status;
  1475.         if (Toolbar <> nil) and (Toolbar^.HWindow <> 0) then
  1476.             DestroyWindow(Toolbar^.HWindow);
  1477.         Toolbar := New(PToolbar, Init(@Self, id_Toolbar, 'Dialog Classes,801,802,803,804',
  1478.                                                                     0, 0, True));
  1479.         Toolbar^.Attr.Style := Toolbar^.Attr.Style or mtb_Row1 or mtb_Column4 or
  1480.                                                      mtb_BitmapButton or mtb_Status or mtb_Radio;
  1481.         Application^.MakeWindow(Toolbar);
  1482.         Toolbar^.CheckTool(Tool);
  1483.         Toolbar^.SetFont(GetSFXObject(Fine_Font));
  1484.     end;
  1485. end;
  1486.  
  1487. procedure TViewWindow.CMHints (var Msg: TMessage);
  1488. begin
  1489.     if UseHints then
  1490.         Toolbar^.SetText('');
  1491.     UseHints := not UseHints;
  1492. end;
  1493.  
  1494. procedure TViewWindow.CMAbout (var Msg: TMessage);
  1495. var
  1496.     Dlg : PDefaultDialog;
  1497. begin
  1498.     Dlg := New(PDefaultDialog, Init(@Self, 'AboutDialog'));
  1499.     Application^.ExecDialog(Dlg);
  1500. end;
  1501.  
  1502. procedure TViewWindow.CMExitWindow (var Msg: TMessage);
  1503. begin
  1504.     CloseWindow;
  1505. end;
  1506.  
  1507. procedure TViewWindow.CMHelp (var Msg: TMessage);
  1508. begin
  1509.     WinHelp(HWindow, 'SFX200.HLP', HELP_INDEX, 0);
  1510. end;
  1511.  
  1512. {********* TSplashWindow **********}
  1513.  
  1514. destructor TSplashWindow.Done;
  1515. begin
  1516.     TSFXStatic.Done;
  1517. end;
  1518.  
  1519. procedure TSplashWindow.SetupWindow;
  1520. begin
  1521.     TSFXStatic.SetupWindow;
  1522.     (* Sets a timer to destroy the splash window after 10 seconds
  1523.      *)
  1524.     SetTimer(HWindow, id_Timer, 10000, nil);
  1525. end;
  1526.  
  1527. procedure TSplashWindow.WMGetDlgCode (var Msg: TMessage);
  1528. begin
  1529.     Msg.Result := dlgc_WantAllKeys;
  1530. end;
  1531.  
  1532. procedure TSplashWindow.WMKeyDown (var Msg: TMessage);
  1533. begin
  1534.     if Msg.wParam = vk_Return then
  1535.         KillTimer(HWindow, id_Timer);
  1536.     CloseWindow;
  1537. end;
  1538.  
  1539. procedure TSplashWindow.WMLButtonDown (var Msg: TMessage);
  1540. begin
  1541.     KillTimer(HWindow, id_Timer);
  1542.     CloseWindow;
  1543. end;
  1544.  
  1545. procedure TSplashWindow.WMNCHitTest (var Msg: TMessage);
  1546. begin
  1547.     (* SFXStatic controls return HTTRANSPARENT. TSplashWindow overrides this
  1548.      * so it can respond to the WM_LBUTTONDOWN message.
  1549.      *)
  1550.     with Msg do
  1551.         DefWindowProc(HWindow, Message, wParam, lParam);
  1552. end;
  1553.  
  1554. procedure TSplashWindow.WMTimer (var Msg: TMessage);
  1555. begin
  1556.     if Msg.wParam = id_Timer then
  1557.     begin
  1558.         KillTimer(HWindow, id_Timer);
  1559.         CloseWindow;
  1560.     end;
  1561. end;
  1562.  
  1563. {********** TToolbar **********}
  1564.  
  1565. procedure TToolbar.WMCommand (var Msg: TMessage);
  1566. begin
  1567.     (* These are the main toolbar buttons clicks. A toolbar button's WM_COMMAND
  1568.      * message is also sent to the toolbar's parent. If you add a toolbar to a
  1569.      * window or dialog and only need to trap the toolbar button clicks you can
  1570.      * save yourself time and effort and trap them in the toolbar's parent's
  1571.      * WM_COMMAND message reponse. If you do this you must make sure the toolbar
  1572.      * button ID's are unique within the parent window or dialog.
  1573.      *)
  1574.     case Msg.wParam of
  1575.         id_One:
  1576.         begin
  1577.             StrCopy(ClassName, 'SFX3DDlg');
  1578.             Style := mws_SFXFrame;
  1579.             Tool := Msg.wParam;
  1580.         end;
  1581.  
  1582.         id_Two:
  1583.         begin
  1584.             StrCopy(ClassName, 'SFXGlazeDlg');
  1585.             Style := mws_3DGlaze;
  1586.             Tool := Msg.wParam;
  1587.         end;
  1588.  
  1589.         id_Three:
  1590.         begin
  1591.             StrCopy(ClassName, 'SFXGrayDlg');
  1592.             Style := mws_3DGray;
  1593.             Tool := Msg.wParam;
  1594.         end;
  1595.  
  1596.         id_Four:
  1597.         begin
  1598.             StrCopy(ClassName, 'SFXSteelDlg');
  1599.             Style := mws_3DSteel;
  1600.             Tool := Msg.wParam;
  1601.         end;
  1602.  
  1603.     else
  1604.         TSFXToolbar.WMCommand(Msg);
  1605.     end;
  1606. end;
  1607.  
  1608. procedure TToolbar.WMMouseMove (var Msg: TMessage);
  1609. var
  1610.     ChildWnd : HWnd;
  1611.     ChildID  : Integer;
  1612.     szTemp   : array[0..144] of Char;
  1613.     szText   : array[0..144] of Char;
  1614. begin
  1615.     (* To set the text in a top toolbar, bottom toolbar or status bar
  1616.      * you need to retrieve the window handle of the toolbar's static control
  1617.      * by specifying the offset MTB_WNDSTATIC in a call to GetWindowWord. The
  1618.      * return value is the window handle of the static control.
  1619.      *)
  1620.     if UseHints then
  1621.     begin
  1622.         if not PtInClient(HWindow, MakePoint(Msg.lParam)) then
  1623.             Exit;
  1624.         ChildWnd := ChildWindowFromPoint(HWindow, MakePoint(Msg.lParam));
  1625.         GetText(szTemp);
  1626.         ChildID := GetDlgCtrlID(ChildWnd);
  1627.  
  1628.         (* The static control's id is -1.
  1629.          *)
  1630.         if ChildId <> -1 then
  1631.         begin
  1632.             szText[0] := #0;
  1633.             LoadString(HInstance, ChildID, szText, SizeOf(szText));
  1634.             if StrIComp(szText, szTemp) <> 0 then
  1635.                 SetText(szText);
  1636.         end;
  1637.     end;
  1638. end;
  1639.  
  1640. {********** TMessageBoxDialog **********}
  1641.  
  1642. procedure TMessageBoxDialog.SetupWindow;
  1643. begin
  1644.     TDialog.SetupWindow;
  1645.  
  1646.     (* Sets the new SFXCaption style - just for show! Since these dialogs don't have
  1647.      * an icon the text in the caption displays flush left.
  1648.      *)
  1649.     SetWindowLong(HWindow, gwl_Style, GetWindowLong(HWindow, gwl_Style) or mws_SFXCaption);
  1650.  
  1651.     (* SpecialFX check boxes and radio buttons respond the standard Windows
  1652.      * button messages. Here BM_SETCHECK is sent to check the first radiobutton.
  1653.      *)
  1654.     SendMessage(GetDlgItem(HWindow, id_SFXFrame), bm_SetCheck, bf_Checked, 0);
  1655.  
  1656.     (* A NULL value for the parent window handle in a call to CenterWindow
  1657.      * will center the specified window (in this case HWindow) over the desktop
  1658.      * window.
  1659.      *)
  1660.     CenterWindow(0, HWindow);
  1661.     MsgStyle := mws_SFXFrame;
  1662. end;
  1663.  
  1664. procedure TMessageBoxDialog.WMCommand (var Msg: TMessage);
  1665. var
  1666.     Reply : Integer;
  1667.     szText : array[0..144] of Char;
  1668. begin
  1669.     (* These button respones use the SFXInputBox and SFXMsgBox functions to display
  1670.      * the 7 Input/Message box styles and the message box button combinations.
  1671.      *)
  1672.     if Msg.lParamHi = bn_Clicked then
  1673.     begin
  1674.         szText[0] := #0;
  1675.         case Msg.wParam of
  1676.             id_SFXFrame: MsgStyle := mws_SFXFrame;
  1677.  
  1678.             id_Gray: MsgStyle := mws_Gray;
  1679.  
  1680.             id_Glaze: MsgStyle := mws_Glaze;
  1681.  
  1682.             id_Steel: MsgStyle := mws_Steel;
  1683.  
  1684.             id_3DGray: MsgStyle := mws_3DGray;
  1685.  
  1686.             id_3DGlaze: MsgStyle := mws_3DGlaze;
  1687.  
  1688.             id_3DSteel: MsgStyle := mws_3DSteel;
  1689.  
  1690.             id_mbOk:
  1691.             begin
  1692.                 Reply := SFXInputBox(HWindow, 'Password', 'Enter password:', szText,
  1693.                                                 SizeOf(szText), MsgStyle);
  1694.                 if Reply = id_OK then
  1695.                     SFXMsgBox(HWindow, szText, 'Your password is:', mb_OK or mb_IconAsterisk, MsgStyle);
  1696.             end;
  1697.  
  1698.             id_mbOkCancel:
  1699.             begin
  1700.                 Reply := SFXInputBox(HWindow, 'Input Box', 'Enter something:', szText,
  1701.                                                 SizeOf(szText), MsgStyle);
  1702.                 if Reply = id_OK then
  1703.                     SFXMsgBox(HWindow, szText, 'Your entered:',
  1704.                                         mb_OKCancel or mb_IconInformation, MsgStyle);
  1705.             end;
  1706.  
  1707.             id_mbAbortRetryIgnore:
  1708.             begin
  1709.                 Reply := SFXInputBox(HWindow, 'Input Box', 'Enter something:', szText,
  1710.                                                 SizeOf(szText), MsgStyle);
  1711.                 if Reply = id_OK then
  1712.                     SFXMsgBox(HWindow, szText, 'Your entered:',
  1713.                                         mb_AbortRetryIgnore or mb_IconQuestion, MsgStyle);
  1714.             end;
  1715.  
  1716.             id_mbRetryCancel:
  1717.             begin
  1718.                 Reply := SFXInputBox(HWindow, 'Input Box', 'Enter something:', szText,
  1719.                                                 SizeOf(szText), MsgStyle);
  1720.                 if Reply = id_OK then
  1721.                     SFXMsgBox(HWindow, szText, 'Your entered:',
  1722.                                         mb_RetryCancel or mb_IconStop, MsgStyle);
  1723.             end;
  1724.  
  1725.             id_mbYesNo:
  1726.             begin
  1727.                 Reply := SFXInputBox(HWindow, 'Input Box', 'Enter something:', szText,
  1728.                                                 SizeOf(szText), MsgStyle);
  1729.                 if Reply = id_OK then
  1730.                     SFXMsgBox(HWindow, szText, 'Your entered:',
  1731.                                         mb_YesNo or mb_IconExclamation, MsgStyle);
  1732.             end;
  1733.  
  1734.             id_mbYesNoCancel:
  1735.             begin
  1736.                 Reply := SFXInputBox(HWindow, 'Input Box', 'Enter something:', szText,
  1737.                                                 SizeOf(szText), MsgStyle);
  1738.                 if Reply = id_OK then
  1739.                     SFXMsgBox(HWindow, szText, 'Your entered:',
  1740.                                         mb_YesNoCancel or mb_IconQuestion, MsgStyle);
  1741.             end;
  1742.  
  1743.             id_mbGo:
  1744.             begin
  1745.                 Reply := SFXInputBox(HWindow, 'Input Box', 'Enter something:', szText,
  1746.                                                 SizeOf(szText), MsgStyle);
  1747.                 if Reply = id_OK then
  1748.                     SFXMsgBox(HWindow, szText, 'Your entered:',
  1749.                                         mb_Go or mb_IconAsterisk, MsgStyle);
  1750.             end;
  1751.  
  1752.             id_mbGoStop:
  1753.             begin
  1754.                 Reply := SFXInputBox(HWindow, 'Input Box', 'Enter something:', szText,
  1755.                                                 SizeOf(szText), MsgStyle);
  1756.                 if Reply = id_OK then
  1757.                     SFXMsgBox(HWindow, szText, 'Your entered:',
  1758.                                         mb_GoStop or mb_IconInformation, MsgStyle);
  1759.             end;
  1760.  
  1761.             id_mbOkCancelHelp:
  1762.             begin
  1763.                 Reply := SFXInputBox(HWindow, 'Input Box', 'Enter something:', szText,
  1764.                                                 SizeOf(szText), MsgStyle);
  1765.                 if Reply = id_OK then
  1766.                     SFXMsgBox(HWindow, szText, 'Your entered:',
  1767.                                         mb_OKCancelHelp or mb_IconStop, MsgStyle);
  1768.             end;
  1769.  
  1770.             id_mbYesNoHelp:
  1771.             begin
  1772.                 Reply := SFXInputBox(HWindow, 'Input Box', 'Enter something:', szText,
  1773.                                                 SizeOf(szText), MsgStyle);
  1774.                 if Reply = id_OK then
  1775.                     SFXMsgBox(HWindow, szText, 'Your entered:',
  1776.                                         mb_YesNoHelp or mb_IconQuestion, MsgStyle);
  1777.             end;
  1778.  
  1779.             id_Help:
  1780.             begin
  1781.                 SFXMsgBox(HWindow, 'You clicked the help button', 'Message Box',
  1782.                                          mb_OK or mb_IconInformation, MsgStyle);
  1783.             end;
  1784.  
  1785.         else
  1786.             TDialog.WMCommand(Msg);
  1787.         end;
  1788.     end
  1789.     else
  1790.         TDialog.WMCommand(Msg);
  1791. end;
  1792.  
  1793. {********** TPopupToolbar **********}
  1794.  
  1795. procedure TPopupToolbar.WMCommand (var Msg: TMessage);
  1796. var
  1797.     szTemp : array[0..25] of Char;
  1798. begin
  1799.     if Msg.lParamHi = bn_Clicked then
  1800.     begin
  1801.         wvsprintf(szTemp, 'You pressed button %u', Msg.wParam);
  1802.         SFXMsgBox(HWindow, szTemp, 'Information', mb_IconInformation, Style);
  1803.     end
  1804.     else
  1805.         TPopupToolbar.WMCommand(Msg);
  1806. end;
  1807.  
  1808. procedure TPopupToolbar.WMNCActivate (var Msg: TMessage);
  1809. begin
  1810.     Msg.wParam := 1;
  1811.     DefWndProc(Msg)
  1812. end;
  1813.  
  1814. {********** TToolbarDialog **********}
  1815.  
  1816. constructor TToolbarDialog.Init(AParent: PWindowsObject; AName: PChar);
  1817. begin
  1818.     TDialog.Init(AParent, AName);
  1819.  
  1820.     (* Creates a popup toolbar. You only need to specifiy MTB_3DFRAME if you
  1821.      * want the toolbar to have a gray 3-dimensional frame. Specifying a WS_XXX
  1822.      * frame style with MTB_3DFRAME has no effect. Popup toolbars should be
  1823.      * created with the WS_POPUPWINDOW style, not WS_OVERLAPPED or
  1824.      * WS_OVERLAPPEDWINDOW.
  1825.      *)
  1826.     TB1 := New(PPopupToolbar, Init(@Self, 120, 'Popup Toolbar,304,305,306,307,308,309', 10, 30, False));
  1827.     TB1^.Attr.Style := TB1^.Attr.Style or mtb_Row1 or mtb_Column6 or mtb_BitmapButton;
  1828.     TB2 := New(PPopupToolbar, Init(@Self, 121, '?,301,302,303,304,305,306', 10, 100, False));
  1829.     TB2^.Attr.Style := TB2^.Attr.Style or mtb_Row3 or mtb_Column2 or mtb_BitmapButton;
  1830.     TB3 := New(PSFXToolbar, InitResource(@Self, 102));
  1831. end;
  1832.  
  1833. procedure TToolbarDialog.SetupWindow;
  1834. begin
  1835.     TDialog.SetupWindow;
  1836.  
  1837.     (* Sets the new SFXCaption style - just for show! Since these dialogs don't have
  1838.      * an icon the text in the caption displays flush left.
  1839.      *)
  1840.     SetWindowLong(HWindow, gwl_Style, GetWindowLong(HWindow, gwl_Style) or mws_SFXCaption);
  1841.     TB3^.SetFont(GetSFXObject(Fine_Font));
  1842.  
  1843.     (* Sets the text in the toolbar's static control. Floating toolbars don't
  1844.      * have a static control.
  1845.      *)
  1846.     TB3^.SetText(' This is where text appears in a status bar');
  1847.     SendMessage(TB1^.HWindow, wm_NCActivate, 1, 0);
  1848.     SendMessage(TB2^.HWindow, wm_NCActivate, 1, 0);
  1849.     CenterWindow(0, HWindow);
  1850. end;
  1851.  
  1852. procedure TToolbarDialog.WMCommand (var Msg: TMessage);
  1853. var
  1854.     szTemp : array[0..25] of Char;
  1855. begin
  1856.     if (Msg.wParam > 2) and (Msg.lParamHi = bn_Clicked) then
  1857.     begin
  1858.         wvsprintf(szTemp, 'You pressed button %u', Msg.wParam);
  1859.         SFXMsgBox(HWindow, szTemp, 'Information', mb_IconInformation, Style);
  1860.     end
  1861.     else
  1862.         TDialog.WMCommand(Msg);
  1863. end;
  1864.  
  1865. {********** TControlDialog **********}
  1866.  
  1867. destructor TControlDialog.Done;
  1868. begin
  1869.     KillTimer(HWindow, id_Timer);
  1870.     TDialog.Done;
  1871. end;
  1872.  
  1873. procedure TControlDialog.SetupWindow;
  1874. begin
  1875.     TDialog.SetupWindow;
  1876.  
  1877.     (* Sets the new SFXCaption style - just for show! Since these dialogs don't have
  1878.      * an icon the text in the caption displays flush left.
  1879.      *)
  1880.     SetWindowLong(HWindow, gwl_Style, GetWindowLong(HWindow, gwl_Style) or mws_SFXCaption);
  1881.     CenterWindow(0, HWindow);
  1882.  
  1883.     (* For display purposes, this timer sets the rate at which the percent
  1884.      * gauge is updated.
  1885.      *)
  1886.     SetTimer(HWindow, id_Timer, 500, nil);
  1887.     i := 0;
  1888. end;
  1889.  
  1890. procedure TControlDialog.WMSFXCtlColor (var Msg: TMessage);
  1891. begin
  1892.     (* An SFX control sends this message to its parent when its about to be painted.
  1893.      * WM_SFXCTLCOLOR can be used to set the colors in various controls. There
  1894.      * are 8 SFXCTLCOLOR_XXX constants defined for this message. You cannot use
  1895.      * the return value to pass a brush or pen handle. Instead you must send a
  1896.      * private message back to the control - eg WM_SETBRUSH, WM_SETPEN. The message
  1897.      * you need to send depends on the control. For this control (SFXPercent)
  1898.      * you need to send a WM_SETBRUSH message if you want to change the percent
  1899.      * gauge background color. The text colors that look the best have been
  1900.      * assigned bit flags. For other colors you will need to use the SetTextColor
  1901.      * function to set the percent gauge text color.
  1902.      *
  1903.      * WM_SFXCTLCOLOR's parameters are the same as WM_CTLCOLOR's. Msg.wParam
  1904.      * is the display context for the control, Msg.lParamLo is its window handle
  1905.      * and Msg.lParamHi is the control identifier. For SFXPercent, this identifier
  1906.      * is SFXCTLCOLOR_PERCENT.
  1907.      *)
  1908.     if Msg.lParamHi = SFXCtlColor_Percent then
  1909.     begin
  1910.         SetBkMode(Msg.wParam, Transparent);
  1911.         if GetDlgCtrlID(Msg.lParamLo) = 109 then
  1912.             SetTextColor(Msg.wParam, RGB(0, 0, 255))
  1913.         else
  1914.             SetTextColor(Msg.wParam, RGB(0, 255, 0));
  1915.  
  1916.         (* GetSFXObject is defined in the SFX200 unit. Here its used to retrieve
  1917.          * a handle for the 'stock' red brush. Do not delete this handle!
  1918.          *)
  1919.         if GetDlgCtrlID(Msg.lParamLo) = 110 then
  1920.             SendMessage(Msg.lParamLo, wm_SetBrush, GetSFXObject(RED_BRUSH), 0);
  1921.     end;
  1922. end;
  1923.  
  1924. procedure TControlDialog.WMTimer (var Msg: TMessage);
  1925. var
  1926.     Reply : Integer;
  1927. begin
  1928.     Inc(i);
  1929.     if i <= 100 then
  1930.     begin
  1931.         (* WM_DRAWPERCENT is a private messge that is sent to the percent gauge
  1932.          * when you want to update the percent display. Msg.wParam is the percentage
  1933.          * to draw and must be a value between 0% and 100%. A value of 100% draws
  1934.          * a full percent gauge. Msg.lParam is zero. The return value is 1 when the
  1935.          * gauge reaches 100%. Otherwise its zero.    When you derive an object for a
  1936.          * percent gauge from TSFXPercent, defined in the SFX200 unit, you can use its
  1937.          * 'SetPercent' and 'Reset' methods instead of sending these messages.
  1938.          *)
  1939.         Reply := SendMessage(GetDlgItem(HWindow, 109), wm_DrawPercent, i, 0);
  1940.         if Reply = 1 then
  1941.         begin
  1942.             { WM_RESETPERCENT sets the percentage displayed to zero }
  1943.             SendMessage(GetDlgItem(HWindow, 109), wm_ResetPercent, 0, 0);
  1944.             i := 0;
  1945.         end;
  1946.         Reply := SendMessage(GetDlgItem(HWindow, 110), wm_DrawPercent, i*2, 0);
  1947.         if Reply = 1 then
  1948.             SendMessage(GetDlgItem(HWindow, 110), wm_ResetPercent, 0, 0);
  1949.     end;
  1950. end;
  1951.  
  1952. {********** TStaticDialog **********}
  1953.  
  1954. procedure TStaticDialog.SetupWindow;
  1955. begin
  1956.     TDialog.SetupWindow;
  1957.     SetWindowLong(HWindow, gwl_Style, GetWindowLong(HWindow, gwl_Style) or mws_SFXCaption);
  1958.     CenterWindow(0, HWindow);
  1959. end;
  1960.  
  1961. procedure TStaticDialog.IDStatBmp (var Msg: TMessage);
  1962. var
  1963.     Dlg : PChildDialog;
  1964. begin
  1965.     Dlg := New(PChildDialog, Init(@Self, 'BitmapAlignmentDialog'));
  1966.     Application^.ExecDialog(Dlg);
  1967. end;
  1968.  
  1969. procedure TStaticDialog.IDStatText (var Msg: TMessage);
  1970. var
  1971.     Dlg : PChildDialog;
  1972. begin
  1973.     Dlg := New(PChildDialog, Init(@Self, 'TextAlignmentDialog'));
  1974.     Application^.ExecDialog(Dlg);
  1975. end;
  1976.  
  1977. {********** TButtonDialog **********}
  1978.  
  1979. procedure TButtonDialog.SetupWindow;
  1980. begin
  1981.     TDialog.SetupWindow;
  1982.     SetWindowLong(HWindow, gwl_Style, GetWindowLong(HWindow, gwl_Style) or mws_SFXCaption);
  1983.     CenterWindow(0, HWindow);
  1984. end;
  1985.  
  1986. procedure TButtonDialog.IDStdBtn (var Msg: TMessage);
  1987. var
  1988.     Dlg : PChildDialog;
  1989. begin
  1990.     Dlg := New(PChildDialog, Init(@Self, 'StandardButtonDialog'));
  1991.     Application^.ExecDialog(Dlg);
  1992. end;
  1993.  
  1994. procedure TButtonDialog.IDBitBtn (var Msg: TMessage);
  1995. var
  1996.     Dlg : PChildDialog;
  1997. begin
  1998.     Dlg := New(PChildDialog, Init(@Self, 'BitmapButtonDialog'));
  1999.     Application^.ExecDialog(Dlg);
  2000. end;
  2001.  
  2002. procedure TButtonDialog.IDTextBtn (var Msg: TMessage);
  2003. var
  2004.     Dlg : PChildDialog;
  2005. begin
  2006.     Dlg := New(PChildDialog, Init(@Self, 'TextButtonDialog'));
  2007.     Application^.ExecDialog(Dlg);
  2008. end;
  2009.  
  2010. {********** TChildDialog **********}
  2011.  
  2012. procedure TChildDialog.SetupWindow;
  2013. begin
  2014.     TDialog.SetupWindow;
  2015.     SetWindowLong(HWindow, gwl_Style, GetWindowLong(HWindow, gwl_Style) or mws_SFXCaption);
  2016.     CenterWindow(0, HWindow);
  2017.  
  2018.     (* To be neat and tidy, when I display a dialog box from within another
  2019.      * dialog box I like to hide the parent dialog, show the child dialog,
  2020.      * and then redisplay the parent dialog when the child dialog closes.
  2021.      *)
  2022.     ShowWindow(Parent^.HWindow, sw_Hide);
  2023. end;
  2024.  
  2025. procedure TChildDialog.OK (var Msg: TMessage);
  2026. begin
  2027.     TDialog.OK(Msg);
  2028.     ShowWindow(Parent^.HWindow, sw_Normal);
  2029. end;
  2030.  
  2031. procedure TChildDialog.Cancel (var Msg: TMessage);
  2032. begin
  2033.     TDialog.OK(Msg);
  2034.     ShowWindow(Parent^.HWindow, sw_Normal);
  2035. end;
  2036.  
  2037. {********** TDefaultDialog **********}
  2038.  
  2039. procedure TDefaultDialog.SetupWindow;
  2040. begin
  2041.     TDialog.SetupWindow;
  2042.     CenterWindow(0, HWindow);
  2043. end;
  2044.  
  2045. {********** Main program **********}
  2046.  
  2047. var
  2048.     App: TViewApp;
  2049. begin
  2050.     App.Init(AppName);
  2051.     App.Run;
  2052.     App.Done;
  2053. end.
  2054.