home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 10.ddi / TOOLBAR.ZIP / MFILEAPP.PAS next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  14.6 KB  |  457 lines
  1. {************************************************}
  2. {                                                }
  3. {   Toolbar Demo Program                         }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. { This is a modified version of MFILEAPP from the DEMOS\WIN\OWL
  9.   subdirectory that shows how to use the TOOLBAR unit. }
  10.  
  11. program MDIFileEditor;
  12.  
  13. {$R MFILEAPP.RES}
  14.  
  15. uses WinProcs, WinTypes, Objects, OWindows, ODialogs, OStdDlgs,
  16.      OStdWnds, OMemory, Strings, WinDos, Toolbar, MFileC;
  17.  
  18. const
  19.   DskFile = 'MFILEAPP.DSK';
  20.   DskSignature : array [0..23] of Char = 'MFileApp Desktop file'#26#0;
  21.  
  22.   { If we're running under Win 3.1, we'll use this function to prevent flicker }
  23.   Win31LockWindowUpdate: function (Wnd: HWnd): Bool = nil;
  24.  
  25. type
  26.  
  27.   { Declare TMDIFileApp, a TApplication descendant }
  28.   TMDIFileApp = object(TApplication)
  29.     procedure InitMainWindow; virtual;
  30.     procedure InitInstance; virtual;
  31.   end;
  32.  
  33.   { Declare TMDIFileWindow, a TMDIWindow descendant }
  34.   PMDIFileWindow = ^TMDIFileWindow;
  35.   TMDIFileWindow = object(TMDIWindow)
  36.     Toolbar: PToolbar;
  37.     constructor Init(ATitle: PChar; AMenu: HMenu);
  38.     procedure EnableCommand(Command: Word; EnableIt: Boolean);
  39.     procedure SetupWindow; virtual;
  40.     procedure RedoClientRect;
  41.     procedure CalcClientRect(var R: TRect); 
  42.     procedure NewFile(var Msg: TMessage);
  43.       virtual cm_First + cm_MDIFileNew;
  44.     procedure OpenFile(var Msg: TMessage);
  45.       virtual cm_First + cm_MDIFileOpen;
  46.     procedure SaveState(var Msg: TMessage);
  47.       virtual cm_First + cm_SaveState;
  48.     procedure RestoreState(var Msg: TMessage);
  49.       virtual cm_First + cm_RestoreState;
  50.     procedure HorizontalToolbar(var Msg: TMessage);
  51.       virtual cm_First + cm_HorizontalToolbar;
  52.     procedure RightVerticalToolbar(var Msg: TMessage);
  53.       virtual cm_First + cm_RightVerticalToolbar;
  54.     procedure LeftVerticalToolbar(var Msg: TMessage);
  55.       virtual cm_First + cm_LeftVerticalToolbar;
  56.     procedure WMSize(var Msg: TMessage);
  57.       virtual wm_First + wm_Size;
  58.   end;
  59.  
  60.   { Declare TFileEditor, a TFileWindow desendant }
  61.   PFileEditor = ^TFileEditor;
  62.   TFileEditor = object(TFileWindow)
  63.     constructor Init(AParent: PWindowsObject; AFileName: PChar);
  64.     destructor Done; virtual;
  65.     procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  66.     function  GetClassName: PChar; virtual;
  67.   end;
  68.  
  69. const
  70.   RFileEditor: TStreamRec = (
  71.     ObjType: 1000;
  72.     VmtLink: Ofs(TypeOf(TFileEditor)^);
  73.     Load:    @TFileEditor.Load;
  74.     Store:   @TFileEditor.Store);
  75.  
  76. { TFileEditor }
  77.  
  78. const
  79.   EditorCount: Integer = 0;
  80.  
  81. procedure EnableEditorMenuItems(NewState: Boolean);
  82. begin
  83.   { Bail out if the window is already closed }
  84.   if Application^.MainWindow^.HWindow = 0 then Exit;
  85.  
  86.   with PMDIFileWindow(Application^.MainWindow)^ do
  87.   begin
  88.     EnableCommand(cm_FileSave, NewState);
  89.     EnableCommand(cm_FileSaveAs, NewState);
  90.     EnableCommand(cm_ArrangeIcons, NewState);
  91.     EnableCommand(cm_TileChildren, NewState);
  92.     EnableCommand(cm_CascadeChildren, NewState);
  93.     EnableCommand(cm_CloseChildren, NewState);
  94.     EnableCommand(cm_EditCut, NewState);
  95.     EnableCommand(cm_EditCopy, NewState);
  96.     EnableCommand(cm_EditPaste, NewState);
  97.     EnableCommand(cm_EditDelete, NewState);
  98.     EnableCommand(cm_EditClear, NewState);
  99.     EnableCommand(cm_EditUndo, NewState);
  100.     EnableCommand(cm_EditFind, NewState);
  101.     EnableCommand(cm_EditReplace, NewState);
  102.     EnableCommand(cm_EditFindNext, NewState);
  103.   end;
  104. end;
  105.  
  106. procedure IncEditors;
  107. begin
  108.   if EditorCount = 0 then EnableEditorMenuItems(True);
  109.   Inc(EditorCount);
  110. end;
  111.  
  112. procedure DecEditors;
  113. begin
  114.   Dec(EditorCount);
  115.   if EditorCount = 0 then EnableEditorMenuItems(False);
  116. end;
  117.  
  118. constructor TFileEditor.Init(AParent: PWindowsObject; AFileName: PChar);
  119. begin
  120.   TFileWindow.Init(AParent, '', AFileName);
  121.   IncEditors;
  122. end;
  123.  
  124. destructor TFileEditor.Done;
  125. begin
  126.   DecEditors;
  127.   TFileWindow.Done;
  128. end;
  129.  
  130. procedure TFileEditor.GetWindowClass(var AWndClass: TWndClass);
  131. begin
  132.   TFileWindow.GetWindowClass(AWndClass);
  133.   AWndClass.hIcon := LoadIcon(HInstance, 'FILEICON');
  134. end;
  135.  
  136. function TFileEditor.GetClassName: PChar;
  137. begin
  138.   GetClassName := 'FileEditor';
  139. end;
  140.  
  141.  
  142. { The main window object - TMDIFileWindow }
  143.  
  144. constructor TMDIFileWindow.Init(ATitle: PChar; AMenu: HMenu);
  145. begin
  146.   TMDIWindow.Init(ATitle, AMenu);
  147.   Attr.Style := Attr.Style or ws_ClipChildren;
  148.   Toolbar := New(PToolbar, Init(@Self, 'Toolbar_1', tbHorizontal));
  149. end;
  150.  
  151. { Make sure the menus that require an editor are disabled and that the toolbar
  152.   is synchronized with the disabled menu items. }
  153. procedure TMDIFileWindow.SetupWindow;
  154. begin
  155.   TMDIWindow.SetupWindow;
  156.   EnableEditorMenuItems(False);
  157.   CheckMenuItem(Attr.Menu, cm_HorizontalToolbar, mf_ByCommand or mf_Checked);
  158. end;
  159.  
  160.  
  161. { Allow special windows such as the Toolbar the opportunity to say how
  162.   much room they need to take away from the MDI client area AND draw themselves.}
  163. procedure TMDIFileWindow.RedoClientRect;
  164. var R: TRect;
  165.   procedure NotifyChildren( P: PWindow ); far;
  166.   begin
  167.     if P^.HWindow <> 0 then
  168.       SendMessage(P^.HWindow, am_CalcParentClientRect, AllowRepaint, Longint(@R));
  169.   end;
  170. begin
  171.   GetClientRect(HWindow, R);
  172.   ForEach(@NotifyChildren);
  173.   SetWindowPos(ClientWnd^.HWindow, 0, R.Left, R.Top,
  174.                                       R.Right - R.Left,
  175.                                       R.Bottom - R.Top, swp_NoZOrder);
  176. end;
  177.  
  178. { Allow special windows such as the Toolbar the opportunity to say how
  179.   much room they need to take away from the MDI client area BUT NOT draw themselves.}
  180. procedure TMDIFileWindow.CalcClientRect(var R: TRect);
  181.   procedure NotifyChildren( P: PWindow ); far;
  182.   begin
  183.     if P^.HWindow <> 0 then
  184.       SendMessage(P^.HWindow, am_CalcParentClientRect, DenyRepaint, Longint(@R));
  185.   end;
  186. begin
  187.   GetClientRect(HWindow, R);
  188.   ForEach(@NotifyChildren);
  189. end;
  190.  
  191. { Enable or disable menu items and toolbar icons at the request of
  192.   child windows }
  193. procedure TMDIFileWindow.EnableCommand(Command: Word; EnableIt: Boolean);
  194. var
  195.   StateFlags: Word;
  196. begin
  197.   if Attr.Menu <> 0 then
  198.   begin
  199.     if EnableIt then
  200.       StateFlags := mf_ByCommand or mf_Enabled
  201.     else
  202.       StateFlags := mf_ByCommand or mf_Disabled or mf_Grayed;
  203.     EnableMenuItem(Attr.Menu, Command, StateFlags);
  204.     Toolbar^.EnableTool(Command, EnableIt);
  205.   end;
  206. end;
  207.  
  208. { Respond to "New" command by constructing, creating, and setting up a
  209.   new TFileWindow MDI child }
  210. procedure TMDIFileWindow.NewFile(var Msg: TMessage);
  211. begin
  212.   Application^.MakeWindow(New(PFileEditor, Init(@Self, '')));
  213. end;
  214.  
  215. { Respond to "Open" command by constructing, creating, and setting up a
  216.   new TFileWindow MDI child }
  217. procedure TMDIFileWindow.OpenFile(var Msg: TMessage);
  218. var
  219.   FileName: array[0..fsPathName] of Char;
  220. begin
  221.   if Application^.ExecDialog(New(PFileDialog, Init(@Self, PChar(sd_FileOpen),
  222.       StrCopy(FileName, '*.*')))) = id_Ok then
  223.     Application^.MakeWindow(New(PFileEditor, Init(@Self, FileName)));
  224. end;
  225.  
  226. { Save the the position and contents of the windows to the
  227.   "desk top" file. }
  228. procedure TMDIFileWindow.SaveState(var Msg: TMessage);
  229.  
  230.   function FileDelete(Name: PChar): Integer; assembler;
  231.   asm
  232.     PUSH    DS
  233.     LDS    DX,Name
  234.     MOV    AH,41H
  235.     INT    21H
  236.     JC    @@1
  237.     XOR    AX,AX
  238.   @@1:  NEG    AX
  239.     POP    DS
  240.   end;
  241.  
  242. var
  243.   S: PStream;
  244.   R: TRect;
  245. begin
  246.   S := New(PBufStream, Init(DskFile, stCreate, 1024));
  247.   S^.Write(DskSignature, SizeOf(DskSignature));
  248.   PutChildren(S^);
  249.   PutChildPtr(S^, Toolbar);
  250.   S^.Write(EditorCount, SizeOf(EditorCount));
  251.   if S^.Status <> stOk then
  252.   begin
  253.     Dispose(S, Done);
  254.     FileDelete(DskFile);
  255.     MessageBox(HWindow, 'Unable to write desktop file.', 'Disk error',
  256.       mb_Ok or mb_IconExclamation);
  257.   end
  258.   else Dispose(S, Done);
  259. end;
  260.  
  261. { Read windows positions and contents from the "desk top" file. }
  262. procedure TMDIFileWindow.RestoreState(var Msg: TMessage);
  263. var
  264.   S: PStream;
  265.   R: TRect;
  266.   ErrorMsg: PChar;
  267.   OldToolbar: PToolbar;
  268.   X: Integer;
  269.   OldCursor: HCursor;
  270.   TestSignature: array [0..SizeOf(DskSignature)] of Char;
  271. begin
  272.   OldToolbar := nil;
  273.   ErrorMsg := nil;
  274.   S := New(PBufStream, Init(DskFile, stOpenRead, 1024));
  275.   if S^.Status = stOK then
  276.     S^.Read(TestSignature, SizeOf(DskSignature));   
  277.   if S^.Status <> stOk then
  278.     ErrorMsg := 'Unable to open desktop file.'
  279.   else
  280.   if StrComp(TestSignature, DskSignature) <> 0 then
  281.     ErrorMsg := 'Invalid or corrupted desktop file.'
  282.   else
  283.   begin
  284.     OldCursor := SetCursor(LoadCursor(0, PChar(idc_Wait)));
  285.     CloseChildren;            { Close the MDI child windows }
  286.     OldToolbar := Toolbar;    { Save the Toolbar, in case the load fails }
  287.     RemoveChild(Toolbar);     { Remove the Toolbar from the child list }
  288.     GetChildren(S^);          { Read children, including a new Toolbar }
  289.     GetChildPtr(S^, Toolbar);
  290.     S^.Read(X, SizeOf(X));
  291.     if (S^.Status <> stOk) or LowMemory then
  292.     begin                     { Stream error or out of memory }
  293.       CloseChildren;
  294.       EditorCount := 0;
  295.       if Toolbar <> nil then Dispose(Toolbar, Done);
  296.       if S^.Status <> 0 then
  297.         ErrorMsg := 'Error reading desktop file.'
  298.       else
  299.         ErrorMsg := 'Not enough memory to open file.';
  300.       Toolbar := OldToolbar;     { Go back to old toolbar }
  301.       AddChild(Toolbar);
  302.     end
  303.     else
  304.     begin
  305.       if Assigned(Win31LockWindowUpdate) then
  306.         Win31LockWindowUpdate(HWindow);
  307.       CreateChildren;            { Create the MDI child windows just loaded }
  308.       Toolbar^.Show(sw_Hide);
  309.       RedoClientRect;            { Give Toolbar a chance to reorient itself }
  310.       Toolbar^.Show(sw_Show);
  311.       Dispose(OldToolbar, Done);
  312.       if Assigned(Win31LockWindowUpdate) then
  313.         Win31LockWindowUpdate(0);
  314.       EditorCount := X;
  315.       EnableEditorMenuItems(EditorCount > 0);
  316.  
  317.       { Make the menu check match the Toolbar orientation }
  318.       CheckMenuItem(Attr.Menu, cm_HorizontalToolbar, mf_ByCommand or mf_UnChecked);
  319.       CheckMenuItem(Attr.Menu, cm_LeftVerticalToolbar, mf_ByCommand or mf_UnChecked);
  320.       CheckMenuItem(Attr.Menu, cm_RightVerticalToolbar, mf_ByCommand or mf_UnChecked);
  321.       case Toolbar^.GetOrientation of
  322.         tbHorizontal   : X := cm_HorizontalToolbar;
  323.         tbLeftVertical : X := cm_LeftVerticalToolbar;
  324.         tbRightVertical: X := cm_RightVerticalToolbar;
  325.       end;
  326.       CheckMenuItem(Attr.Menu, X, mf_ByCommand or mf_Checked);
  327.     end;
  328.     Dispose(S, Done);
  329.     SetCursor(OldCursor);
  330.   end;
  331.   if ErrorMsg <> nil then
  332.     MessageBox(HWindow, ErrorMsg, 'Disk error', mb_Ok or mb_IconExclamation);
  333. end;
  334.  
  335.  
  336. procedure TMDIFileWindow.HorizontalToolbar(var Msg: TMessage);
  337. begin
  338.   if Toolbar^.GetOrientation <> tbHorizontal then
  339.   begin
  340.     if Assigned(Win31LockWindowUpdate) then
  341.       Win31LockWindowUpdate(HWindow);
  342.     Toolbar^.Show(sw_Hide);
  343.     Toolbar^.SetOrientation(tbHorizontal);
  344.     RedoClientRect;
  345.     Toolbar^.Show(sw_Show);
  346.     if Assigned(Win31LockWindowUpdate) then
  347.       Win31LockWindowUpdate(0);
  348.     CheckMenuItem(Attr.Menu, cm_HorizontalToolbar, mf_ByCommand or mf_Checked);
  349.     CheckMenuItem(Attr.Menu, cm_LeftVerticalToolbar, mf_ByCommand or mf_UnChecked);
  350.     CheckMenuItem(Attr.Menu, cm_RightVerticalToolbar, mf_ByCommand or mf_UnChecked);
  351.   end;
  352. end;
  353.  
  354. procedure TMDIFileWindow.RightVerticalToolbar(var Msg: TMessage);
  355. begin
  356.   if Toolbar^.GetOrientation <> tbRightVertical then
  357.   begin
  358.     if Assigned(Win31LockWindowUpdate) then
  359.       Win31LockWindowUpdate(HWindow);
  360.     Toolbar^.Show(sw_Hide);
  361.     Toolbar^.SetOrientation(tbRightVertical);
  362.     RedoClientRect;
  363.     Toolbar^.Show(sw_Show);
  364.     if Assigned(Win31LockWindowUpdate) then
  365.       Win31LockWindowUpdate(0);
  366.     CheckMenuItem(Attr.Menu, cm_HorizontalToolbar, mf_ByCommand or mf_UnChecked);
  367.     CheckMenuItem(Attr.Menu, cm_LeftVerticalToolbar, mf_ByCommand or mf_UnChecked);
  368.     CheckMenuItem(Attr.Menu, cm_RightVerticalToolbar, mf_ByCommand or mf_Checked);
  369.   end;
  370. end;
  371.  
  372. procedure TMDIFileWindow.LeftVerticalToolbar(var Msg: TMessage);
  373. begin
  374.   if Toolbar^.GetOrientation <> tbLeftVertical then
  375.   begin
  376.     if Assigned(Win31LockWindowUpdate) then
  377.       Win31LockWindowUpdate(HWindow);
  378.     Toolbar^.Show(sw_Hide);
  379.     Toolbar^.SetOrientation(tbLeftVertical);
  380.     RedoClientRect;
  381.     Toolbar^.Show(sw_Show);
  382.     if Assigned(Win31LockWindowUpdate) then
  383.       Win31LockWindowUpdate(0);
  384.     CheckMenuItem(Attr.Menu, cm_HorizontalToolbar, mf_ByCommand or mf_UnChecked);
  385.     CheckMenuItem(Attr.Menu, cm_LeftVerticalToolbar, mf_ByCommand or mf_Checked);
  386.     CheckMenuItem(Attr.Menu, cm_RightVerticalToolbar, mf_ByCommand or mf_UnChecked);
  387.   end;
  388. end;
  389.  
  390. { Allow special windows such as the Toolbar the opportunity to say how much room
  391.  they need outside the MDI client area.  The default Windows processing for
  392.  wm_Size always sets the MDI client area to fill the main window's client area,
  393.  and it forces a repaint.  We don't want that, so we don't call the inherited
  394.  wm_Size or the Windows default message processor. }
  395. procedure TMDIFileWindow.wmSize(var Msg: TMessage);
  396. var
  397.   R: TRect;
  398. begin
  399.   if (Scroller <> nil) and (Msg.WParam <> sizeIconic) then
  400.     Scroller^.SetPageSize;
  401.   if Msg.wParam = sizeNormal then
  402.   begin
  403.     GetWindowRect(HWindow, R);
  404.     Attr.H := R.bottom - R.top;
  405.     Attr.W := R.right - R.left;
  406.   end;
  407.   RedoClientRect;
  408. end;
  409.  
  410.  
  411.  
  412. { Construct the TMDIFileApp's MainWindow of type TMDIFileWindow,
  413.   loading its menu }
  414. procedure TMDIFileApp.InitMainWindow;
  415. var x: PWindowsObject;
  416. begin
  417.   MainWindow := New(PMDIFileWindow, Init('MDI Files',
  418.     LoadMenu(HInstance, 'Commands')));
  419.   PMDIFileWindow(MainWindow)^.ChildMenuPos := 3;
  420.   { Register types to be written to stream }
  421.   RegisterType(RWindow);
  422.   RegisterType(REdit);
  423.   RegisterType(RFileEditor);
  424.   RegisterType(RToolbar);
  425. end;
  426.  
  427. { Initialize each MS-Windows application instance, loading an
  428.   accelerator table }
  429. procedure TMDIFileApp.InitInstance;
  430. begin
  431.   TApplication.InitInstance;
  432.   if Status = 0 then
  433.   begin
  434.     HAccTable := LoadAccelerators(HInstance, 'FileCommands');
  435.     if HAccTable = 0 then
  436.       Status := em_InvalidWindow;
  437.   end;
  438. end;
  439.  
  440. { Declare a variable of type TFileApp }
  441. var
  442.   MDIFileApp : TMDIFileApp;
  443.  
  444. { Run the FileApp }
  445. begin
  446.   { In Windows 3.0, the following GetProcAddress call will return nil,
  447.     but not cause a critical error message.  Any code that uses
  448.     this function variable should always test it first with
  449.     the Assigned system function. }
  450.  
  451.   @Win31LockWindowUpdate :=
  452.     GetProcAddress(GetModuleHandle('User'), PChar(294));
  453.   MDIFileApp.Init('MDIFileApp');
  454.   MDIFileApp.Run;
  455.   MDIFileApp.Done;
  456. end.
  457.