home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / windows / c / mobjm260 / mditool.pa_ / mditool.pa
Encoding:
Text File  |  1994-09-06  |  13.3 KB  |  446 lines
  1. (*******************************************************************)
  2. (*                                                                 *)
  3. (*          Microworks ObjectMate 2.6                                                      *)
  4. (*                                                                 *)
  5. (*     Windows Interface Develpment Kit the Borland Languages.     *)
  6. (*                                                                 *)
  7. (*         SFXMDI.PAS : Basic SFX MDI window                             *)
  8. (*                                                                                                                           *)
  9. (*     Copyright 1992-94 Microworks Sydney, Australia.               *)
  10. (*                                                                 *)
  11. (*******************************************************************)
  12.  
  13. (* MDITool displays a moveable tool bar in a MDI window. There are only two
  14.  * window styles that can be used with an SFX Edit, File or MDI window:
  15.  * MWS_3DFRAME or MWS_SFXFRAME. MDITool uses the MWS_3DFRAME style and the
  16.  * new SFXChooseFont function to display an SFX font common dialog box.
  17.  *)
  18.  
  19. program MDITool;
  20.  
  21. {$R MDITOOL.RES}
  22.  
  23. uses WinTypes, WinProcs, SFX200, CommDlg,
  24.          {$IFDEF Ver15}
  25.              WObjects;
  26.          {$ELSE}
  27.              Objects, OWindows, ODialogs;
  28.          {$ENDIF}
  29.  
  30. const
  31.  
  32.     id_Toolbar      = 100;
  33.     cm_Popup        = 101;
  34.     cm_Top          = 102;
  35.     cm_Left         = 103;
  36.     cm_Right        = 104;
  37.     cm_Bottom       = 105;
  38.     cm_Status       = 106;
  39.     cm_ExitWindow   = 107;
  40.     cm_Font         = 201;
  41.     cm_Show         = 202;
  42.     cm_About        = 203;
  43.     AppName : PChar = 'MDITool';
  44.     Title   : PChar = 'MDITool - Toolbar Demonstration';
  45.  
  46. type
  47.  
  48.     PAboutDialog = ^TAboutDialog;
  49.     TAboutDialog = object(TDialog)
  50.         procedure SetupWindow; virtual;
  51.     end;
  52.  
  53.     PMDIChild = ^TMDIChild;
  54.     TMDIChild = object(TSFXWindow)
  55.         constructor Init(AParent: PWindowsObject; AName: PChar);
  56.         destructor Done; virtual;
  57.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  58.         procedure WMPaint (var Msg: TMessage); virtual wm_First + wm_Paint;
  59.     end;
  60.  
  61.     PMDITool = ^TMDITool;
  62.     TMDITool = object(TSFXMDIWindow)
  63.         OldToolbarPos : Integer;
  64.         ToolbarPos    : Integer;
  65.         Toolbar       : PSFXToolbar;
  66.         constructor Init (ATitle : PChar; AMenu : HMenu);
  67.         destructor Done; virtual;
  68.         function  GetClassName : PChar; virtual;
  69.         procedure GetWindowClass (var AWndClass: TWndClass); virtual;
  70.         procedure SetUpWindow; virtual;
  71.         function  InitChild : PWindowsobject; virtual;
  72.         procedure InitClientWindow; virtual;
  73.         procedure WMInitMenuPopup (var Msg: TMessage); virtual wm_First + wm_InitMenuPopup;
  74.         procedure WMSize (var Msg: TMessage); virtual wm_First + wm_Size;
  75.         procedure UpdateClientArea(Width, Height: Integer);
  76.         procedure CMPopup (var Msg: TMessage); virtual cm_First + cm_Popup;
  77.         procedure CMTop (var Msg: TMessage); virtual cm_First + cm_Top;
  78.         procedure CMLeft (var Msg: TMessage); virtual cm_First + cm_Left;
  79.         procedure CMRight (var Msg: TMessage); virtual cm_First + cm_Right;
  80.         procedure CMBottom (var Msg: TMessage); virtual cm_First + cm_Bottom;
  81.         procedure CMStatus (var Msg: TMessage); virtual cm_First + cm_Status;
  82.         procedure CMExitWindow (var Msg: TMessage); virtual cm_First + cm_ExitWindow;
  83.         procedure CMFont (var Msg: TMessage); virtual cm_First + cm_Font;
  84.         procedure CMShow (var Msg: TMessage); virtual cm_First + cm_Show;
  85.         procedure CMAbout (var Msg: TMessage); virtual cm_First + cm_About;
  86.     end;
  87.  
  88.     PMDIToolApp = ^TMDIToolApp;
  89.     TMDIToolApp = object(TApplication)
  90.         procedure InitMainWindow; virtual;
  91.     end;
  92.  
  93. var
  94.  
  95.     Font      : HFont;
  96.     FontColor : TColorRef;
  97.     LogFont   : TLogFont;
  98.  
  99. {********** TMDIToolApp **********}
  100.  
  101. procedure TMDIToolApp.InitMainWindow;
  102. begin
  103.     MainWindow := New(PMDITool, Init(Title, LoadMenu(HInstance, 'MDITool')));
  104. end;
  105.  
  106. {********** TMDITool **********}
  107.  
  108. constructor TMDITool.Init(ATitle : PChar; AMenu : HMenu);
  109. begin
  110.     TMDIWindow.Init(ATitle, AMenu);
  111.     Attr.Style := Attr.Style or mws_3DFrame or mws_SFXCaption;
  112.     Toolbar := nil;
  113.     ToolbarPos := 0;
  114. end;
  115.  
  116. destructor TMDITool.Done;
  117. begin
  118.     TMDIWindow.Done;
  119. end;
  120.  
  121. function TMDITool.GetClassName;
  122. begin
  123.     GetClassName := AppName;
  124. end;
  125.  
  126. procedure TMDITool.GetWindowClass (var AWndClass: TWndClass);
  127. begin
  128.     TMDIWindow.GetWindowClass(AWndClass);
  129.     AWndClass.hbrBackground := GetStockObject(NULL_BRUSH);
  130.     AWndClass.HIcon := LoadIcon(HInstance, AppName);
  131. end;
  132.  
  133. procedure TMDITool.SetUpWindow;
  134. var
  135.     Msg : TMessage;
  136. begin
  137.     TMDIWindow.SetUpWindow;
  138.  
  139.     (* Create a top aligned toolbar
  140.      *)
  141.     CMTop(Msg);
  142.  
  143.     (* Create MDI child window
  144.      *)
  145.     CreateChild;
  146. end;
  147.  
  148. function TMDITool.InitChild : PWindowsObject;
  149. begin
  150.     InitChild := New(PMDIChild, Init(@Self, 'MDI Child Window'));
  151. end;
  152.  
  153. procedure TMDITool.InitClientWindow;
  154. begin
  155.     (* Use the standard Windows MDIClient window instead of the
  156.      * default SFXMDIClient window.
  157.      *)
  158.     ClientWnd := New(PMDIClient, Init(@Self));
  159. end;
  160.  
  161. procedure TMDITool.WMSize(var Msg: TMessage);
  162. begin
  163.     Toolbar^.AlignToolbar;
  164.     UpdateClientArea(Msg.lParamLo, Msg.lParamHi);
  165. end;
  166.  
  167. procedure TMDITool.WMInitMenuPopup (var Msg: TMessage);
  168. begin
  169.     (* Use WM_INITPOPUPMENU to check/uncheck and enable/disable menu items
  170.      *)
  171.     if (Msg.lParamHi = 0) and (Msg.lParamLo = 0) and (ToolbarPos <> OldToolbarPos) then
  172.     begin
  173.         CheckMenuItem(Msg.wParam, ToolbarPos, MF_CHECKED);
  174.         CheckMenuItem(Msg.wParam, OldToolbarPos, MF_UNCHECKED);
  175.     end
  176.     else
  177.     if (Msg.lParamHi = 0) and (Msg.lParamLo = 1) then
  178.     begin
  179.         if IsWindowVisible(Toolbar^.HWindow) then
  180.             EnableMenuItem(Msg.wParam, cm_Show, MF_GRAYED)
  181.         else
  182.             EnableMenuItem(Msg.wParam, cm_Show, MF_ENABLED);
  183.     end
  184.     else
  185.         TSFXMDIWindow.DefWndProc(Msg);
  186. end;
  187.  
  188. procedure TMDITool.UpdateClientArea(Width, Height: Integer);
  189. var
  190.     X, Y  : Integer;
  191.     CRect : TRect;
  192. begin
  193.     (* Resize the client window depending on the toolbar position
  194.      *)
  195.     if (ClientWnd <> nil) and (ClientWnd^.HWindow <> 0) then
  196.     begin
  197.         X := 0;
  198.         Y := 0;
  199.         if (Width = 0) and (Height = 0) then
  200.         begin
  201.             GetClientRect(HWindow, CRect);
  202.             Width := CRect.Right - CRect.Left;
  203.             Height := CRect.Bottom - CRect.Top;
  204.         end;
  205.         if ToolbarPos = cm_Top then
  206.             Y := 29
  207.         else
  208.         if ToolbarPos = cm_Left then
  209.             X := 29
  210.         else
  211.         if ToolbarPos = cm_Right then
  212.             Dec(Width, 29)
  213.         else
  214.         if (ToolbarPos = cm_Bottom) or (ToolbarPos = cm_Status) then
  215.             Dec(Height, 29);
  216.         MoveWindow(ClientWnd^.HWindow, X, Y, Width, Height, TRUE);
  217.     end;
  218. end;
  219.  
  220. procedure TMDITool.CMPopup (var Msg: TMessage);
  221. begin
  222.     OldToolbarPos := ToolbarPos;
  223.     if ToolbarPos <> cm_Popup then
  224.     begin
  225.         ToolbarPos := cm_Popup;
  226.         if (Toolbar <> nil) and (Toolbar^.HWindow <> 0) then
  227.             DestroyWindow(Toolbar^.HWindow);
  228.  
  229.         (* A popup toolbar is confined to the Windows' desktop and cannot be moved
  230.          * outside. The x value 'GetSystemMetrics(SM_CXSCREEN)' and the y value '0'
  231.          * ensure that the toolbar is positioned in the top-left corner of the
  232.          * desktop window.
  233.          *)
  234.         Toolbar := New(PSFXToolbar, Init(@Self, id_Toolbar, '?,301,302,303,304,305,306,307,308',
  235.                                                                          GetSystemMetrics(SM_CXSCREEN), 0, FALSE));
  236.         Toolbar^.Attr.Style := Toolbar^.Attr.Style or mtb_Row4 or mtb_Column2 or
  237.                                                      mtb_BitmapButton or mtb_Float or mtb_3DFrame or ws_Caption;
  238.  
  239.         (* Set the WB_MDICHILD flag to FALSE
  240.          *)
  241.         Toolbar^.SetFlags(WB_MDICHILD, FALSE);
  242.         Application^.MakeWindow(Toolbar);
  243.         UpdateClientArea(0, 0);
  244.     end;
  245. end;
  246.  
  247. procedure TMDITool.CMTop (var Msg: TMessage);
  248. begin
  249.     OldToolbarPos := ToolbarPos;
  250.     if ToolbarPos <> cm_Top then
  251.     begin
  252.         (* An SFX Toolbar sizes itself according to the specified flags and the size
  253.          * of the first button's first bitmap, so cx and cy can be zero. x and y have
  254.          * no effect on an aligned toolbar and should be set to zero. To re position a
  255.          * toolbar you have to destroy the current one and create a new one. When you
  256.          * do, you will have to change the MTB_ROWXX, MTB_COLOUMNXX and the toolbar
  257.          * style flags: MTB_TOP, MTB_LEFT, MTB_RIGHT, MTB_BOTTOM, MTB_FLOAT and MTB_STATUS.
  258.          *)
  259.         ToolbarPos := cm_Top;
  260.         if (Toolbar <> nil) and (Toolbar^.HWindow <> 0) then
  261.             DestroyWindow(Toolbar^.HWindow);
  262.         Toolbar := New(PSFXToolbar, Init(@Self, id_Toolbar, '?,301,302,303,304,305,306,307,308',
  263.                                                                          0, 0, True));
  264.         Toolbar^.Attr.Style := Toolbar^.Attr.Style or mtb_Row1 or mtb_Column8 or
  265.                                                      mtb_BitmapButton or mtb_Top;
  266.         Toolbar^.SetFlags(WB_MDICHILD, FALSE);
  267.         Application^.MakeWindow(Toolbar);
  268.         UpdateClientArea(0, 0);
  269.     end;
  270. end;
  271.  
  272. procedure TMDITool.CMLeft (var Msg: TMessage);
  273. begin
  274.     OldToolbarPos := ToolbarPos;
  275.     if ToolbarPos <> cm_Left then
  276.     begin
  277.         ToolbarPos := cm_Left;
  278.         if (Toolbar <> nil) and (Toolbar^.HWindow <> 0) then
  279.             DestroyWindow(Toolbar^.HWindow);
  280.         Toolbar := New(PSFXToolbar, Init(@Self, id_Toolbar, '?,301,302,303,304,305,306,307,308',
  281.                                                                          0, 0, True));
  282.         Toolbar^.Attr.Style := Toolbar^.Attr.Style or mtb_Row8 or mtb_Column1 or
  283.                                                      mtb_BitmapButton or mtb_Left;
  284.         Toolbar^.SetFlags(WB_MDICHILD, FALSE);
  285.         Application^.MakeWindow(Toolbar);
  286.         UpdateClientArea(0, 0);
  287.     end;
  288. end;
  289.  
  290. procedure TMDITool.CMRight (var Msg: TMessage);
  291. begin
  292.     OldToolbarPos := ToolbarPos;
  293.     if ToolbarPos <> cm_Right then
  294.     begin
  295.         ToolbarPos := cm_Right;
  296.         if (Toolbar <> nil) and (Toolbar^.HWindow <> 0) then
  297.             DestroyWindow(Toolbar^.HWindow);
  298.         Toolbar := New(PSFXToolbar, Init(@Self, id_Toolbar, '?,301,302,303,304,305,306,307,308',
  299.                                                                          0, 0, True));
  300.         Toolbar^.Attr.Style := Toolbar^.Attr.Style or mtb_Row8 or mtb_Column1 or
  301.                                                      mtb_BitmapButton or mtb_Right;
  302.         Toolbar^.SetFlags(WB_MDICHILD, FALSE);
  303.         Application^.MakeWindow(Toolbar);
  304.         UpdateClientArea(0, 0);
  305.     end;
  306. end;
  307.  
  308. procedure TMDITool.CMBottom (var Msg: TMessage);
  309. begin
  310.     OldToolbarPos := ToolbarPos;
  311.     if ToolbarPos <> cm_Bottom then
  312.     begin
  313.         ToolbarPos := cm_Bottom;
  314.         if (Toolbar <> nil) and (Toolbar^.HWindow <> 0) then
  315.             DestroyWindow(Toolbar^.HWindow);
  316.         Toolbar := New(PSFXToolbar, Init(@Self, id_Toolbar, '?,301,302,303,304,305,306,307,308',
  317.                                                                          0, 0, True));
  318.         Toolbar^.Attr.Style := Toolbar^.Attr.Style or mtb_Row1 or mtb_Column8 or
  319.                                                      mtb_BitmapButton or mtb_Bottom;
  320.         Toolbar^.SetFlags(WB_MDICHILD, FALSE);
  321.         Application^.MakeWindow(Toolbar);
  322.         UpdateClientArea(0, 0);
  323.     end;
  324. end;
  325.  
  326. procedure TMDITool.CMStatus (var Msg: TMessage);
  327. begin
  328.     OldToolbarPos := ToolbarPos;
  329.     if ToolbarPos <> cm_Status then
  330.     begin
  331.         ToolbarPos := cm_Status;
  332.         if (Toolbar <> nil) and (Toolbar^.HWindow <> 0) then
  333.             DestroyWindow(Toolbar^.HWindow);
  334.         Toolbar := New(PSFXToolbar, Init(@Self, id_Toolbar, '?,301,302,303,304,305,306,307,308',
  335.                                                                          0, 0, True));
  336.         Toolbar^.Attr.Style := Toolbar^.Attr.Style or mtb_Row1 or mtb_Column8 or
  337.                                                      mtb_BitmapButton or mtb_Status;
  338.         Toolbar^.SetFlags(WB_MDICHILD, FALSE);
  339.         Application^.MakeWindow(Toolbar);
  340.         UpdateClientArea(0, 0);
  341.     end;
  342. end;
  343.  
  344. procedure TMDITool.CMExitWindow (var Msg: TMessage);
  345. begin
  346.     CloseWindow;
  347. end;
  348.  
  349. procedure TMDITool.CMFont (var Msg: TMessage);
  350. var
  351.     ChildWnd : HWnd;
  352.     CFFlags  : LongInt;
  353.     Template : Integer;
  354. begin
  355.     CFFlags := CF_EFFECTS or CF_BOTH;
  356.     Template := GetSFXTemplateId('SFXSteelDlg', DLG_FONT);
  357.     if SFXChooseFont(HWindow, LogFont, CFFlags, Template, True, FontColor) then
  358.     begin
  359.         EraseObject(Font);
  360.         Font := CreateFontIndirect(LogFont);
  361.         ChildWnd := SendMessage(ClientWnd^.HWindow, wm_MDIGetActive, 0, 0);
  362.         InvalidateRect(ChildWnd, nil, FALSE);
  363.     end;
  364. end;
  365.  
  366. procedure TMDITool.CMShow (var Msg: TMessage);
  367. begin
  368.     ShowWindow(Toolbar^.HWindow, SW_SHOWNORMAL);
  369. end;
  370.  
  371. procedure TMDITool.CMAbout (var Msg: TMessage);
  372. begin
  373.     Application^.ExecDialog(New(PAboutDialog, Init(@Self, 'AboutDialog')));
  374. end;
  375.  
  376. {********** TMDIChild **********}
  377.  
  378. constructor TMDIChild.Init (AParent: PWindowsObject; AName: PChar);
  379. begin
  380.     TSFXWindow.Init(AParent, AName);
  381.     Attr.Style := Attr.Style or MWS_3DFRAME or MWS_SFXCAPTION;
  382.     FillChar(LogFont, SizeOf(TLogFont), #0);
  383.     with LogFont do
  384.     begin
  385.         lfHeight         := -35;
  386.         lfWeight         := 700;
  387.         lfItalic         := 1;
  388.         lfUnderLine      := 1;
  389.         lfOutPrecision   := Out_Stroke_Precis;
  390.         lfClipPrecision  := Clip_Stroke_Precis;
  391.         lfQuality        := Default_Quality;
  392.         lfPitchAndFamily := Variable_Pitch;
  393.         lstrcpy(lfFaceName, 'Times New Roman');
  394.     end;
  395.     Font := CreateFontIndirect(LogFont);
  396.     FontColor  := RGB(255, 0, 0);
  397. end;
  398.  
  399. destructor TMDIChild.Done;
  400. begin
  401.     EraseObject(Font);
  402.     TSFXWindow.Done;
  403. end;
  404.  
  405. procedure TMDIChild.GetWindowClass (var AWndClass: TWndClass);
  406. begin
  407.     TWindow.GetWindowClass(AWndClass);
  408.     AWndClass.HBrBackground := GetStockObject(Black_Brush);
  409. end;
  410.  
  411. procedure TMDIChild.WMPaint (var Msg: TMessage);
  412. var
  413.     PS      : TPaintStruct;
  414.     CRect   : TRect;
  415.     PaintDC : HDC;
  416.     OldFont : HFont;
  417. begin
  418.     PaintDC    := BeginPaint(HWindow, PS);
  419.     GetClientRect(HWindow, CRect);
  420.     FillRect(PaintDC, CRect, GetStockObject(Black_Brush));
  421.     SetBkMode(PaintDC, Transparent);
  422.     SetTextColor(PaintDC, FontColor);
  423.     OldFont := SelectObject(PaintDC, Font);
  424.     DrawText(PaintDC, 'Borland Pascal 7.0', -1, CRect, dt_Center or dt_vCenter or dt_Singleline);
  425.     SelectObject(PaintDC, OldFont);
  426.     EndPaint(HWindow, PS);
  427. end;
  428.  
  429. {********** TAboutDialog **********}
  430.  
  431. procedure TAboutDialog.SetUpWindow;
  432. begin
  433.     TDialog.Setupwindow;
  434.     CenterWindow(Parent^.HWindow, HWindow);
  435. end;
  436.  
  437. {********** Main Program **********}
  438.  
  439. var
  440.     App: TMDIToolApp;
  441. begin
  442.     App.Init(AppName);
  443.     App.Run;
  444.     App.Done;
  445. end.
  446.