home *** CD-ROM | disk | FTP | other *** search
/ PC Open 19 / pcopen19.iso / Zipped / CALMIR21.ZIP / SOURCE.ZIP / SRC / CALFORM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-20  |  7.2 KB  |  214 lines
  1. {**************************************************************************}
  2. {                                                                          }
  3. {    Calmira shell for Microsoft« Windows(TM) 3.1                          }
  4. {    Source Release 2.1                                                    }
  5. {    Copyright (C) 1997-1998 Li-Hsin Huang                                 }
  6. {                                                                          }
  7. {    This program is free software; you can redistribute it and/or modify  }
  8. {    it under the terms of the GNU General Public License as published by  }
  9. {    the Free Software Foundation; either version 2 of the License, or     }
  10. {    (at your option) any later version.                                   }
  11. {                                                                          }
  12. {    This program is distributed in the hope that it will be useful,       }
  13. {    but WITHOUT ANY WARRANTY; without even the implied warranty of        }
  14. {    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         }
  15. {    GNU General Public License for more details.                          }
  16. {                                                                          }
  17. {    You should have received a copy of the GNU General Public License     }
  18. {    along with this program; if not, write to the Free Software           }
  19. {    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.             }
  20. {                                                                          }
  21. {**************************************************************************}
  22.  
  23. unit CalForm;
  24.  
  25. { TCalForm is the common ancestor of most of Calmira's modeless windows,
  26.   and you should use it for other modeless windows that you add.  The
  27.   main feature is the use of WMSettingsChanged to trigger the
  28.   SettingsChanged method.  Descendants override this to adjust their
  29.   properties depending on which settings have been modified.
  30.  
  31.   The StretchShift method adjusts the controls on a form when it is
  32.   resized.  Call it from the OnResize handler.
  33.  
  34.   WM_NCRBUTTONDOWN is intercepted to popup the list of open windows.
  35.  
  36.   Finally, ShowNormal is provided to make it easier to display a
  37.   window, whatever state it is in.
  38. }
  39.  
  40. interface
  41.  
  42. uses ExtForm, Messages, Classes, CalMsgs, Settings, Controls, WinTypes;
  43.  
  44. type
  45.  
  46. TStretchFlag = (stLeft, stTop, stWidth, stHeight);
  47. TStretchFlags = set of TStretchFlag;
  48.  
  49.  
  50. TCalForm = class(TExtForm)
  51. private
  52.   FMinimumWidth : Integer;
  53.   FMinimumHeight : Integer;
  54.   OldClientWidth : Integer;
  55.   OldClientHeight : Integer;
  56.   SizeDelta : TPoint;
  57.   procedure WMNCRButtonDown(var Msg: TWMNCRButtonDown); message WM_NCRBUTTONDOWN;
  58.   procedure WMSettingsChanged(var Msg: TMessage); message WM_SETTINGSCHANGED;
  59.   procedure WMGetMinMaxInfo(var Msg : TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
  60. protected
  61.   procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  62.     X, Y: Integer); override;
  63.   procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  64.   procedure CreateParams(var Params : TCreateParams); override;
  65.   procedure Loaded; override;
  66.   procedure Resize; override;
  67.   procedure StretchShift(const C: array of TControl; Flags : TStretchFlags);
  68. public
  69.   procedure SettingsChanged(Changes : TSettingChanges); virtual;
  70.   procedure ShowNormal;
  71.   procedure EnableControls(Enable : Boolean);
  72.   property MinimumWidth : Integer read FMinimumWidth write FMinimumWidth;
  73.   property MinimumHeight : Integer read FMinimumHeight write FMinimumHeight;
  74. end;
  75.  
  76. implementation
  77.  
  78. uses Forms, Desk, WinProcs, MiscUtil;
  79.  
  80. procedure TCalForm.WMNCRButtonDown(var Msg: TWMNCRButtonDown);
  81. begin
  82.   with Msg do
  83.     if (WindowState <> wsMinimized) and (HitTest = HTCAPTION) then
  84.       Desktop.WindowMenu.Popup(XCursor, YCursor)
  85.     else inherited;
  86. end;
  87.  
  88.  
  89. procedure TCalForm.WMSettingsChanged(var Msg: TMessage);
  90. begin
  91.   SettingsChanged(TSettingChanges(Msg.wParam));
  92. end;
  93.  
  94. procedure TCalForm.SettingsChanged(Changes : TSettingChanges);
  95. begin
  96. end;
  97.  
  98. procedure TCalForm.ShowNormal;
  99. begin
  100.   WindowState := wsNormal;
  101.   Show;
  102. end;
  103.  
  104. procedure TCalForm.EnableControls(Enable : Boolean);
  105. var i: Integer;
  106. begin
  107.   for i := 0 to ControlCount-1 do Controls[i].Enabled := Enable;
  108. end;
  109.  
  110. procedure TCalForm.MouseDown(Button: TMouseButton; Shift: TShiftState;
  111.   X, Y: Integer);
  112. const
  113.   { some magic numbers! }
  114.   SC_SIZELEFT        = SC_SIZE + 1;
  115.   SC_SIZERIGHT       = SC_SIZE + 2;
  116.   SC_SIZETOP         = SC_SIZE + 3;
  117.   SC_SIZETOPLEFT     = SC_SIZE + 4;
  118.   SC_SIZETOPRIGHT    = SC_SIZE + 5;
  119.   SC_SIZEBOTTOM      = SC_SIZE + 6;
  120.   SC_SIZEBOTTOMLEFT  = SC_SIZE + 7;
  121.   SC_SIZEBOTTOMRIGHT = SC_SIZE + 8;
  122.   SC_DRAGMOVE        = SC_SIZE + 9;
  123. var
  124.   Cmd : Word;
  125. begin
  126.   inherited MouseDown(Button, Shift, X, Y);
  127.  
  128.   if (WindowState = wsMaximized) or (Button = mbRight) then Exit;
  129.  
  130.   ReleaseCapture;
  131.   if (x <= 16) and (y <= 16) then Cmd := SC_SIZETOPLEFT
  132.   else if (x <= 16) and (y >= ClientHeight - 16) then Cmd := SC_SIZEBOTTOMLEFT
  133.   else if (x >= ClientWidth - 16) and (y <= 16) then Cmd := SC_SIZETOPRIGHT
  134.   else if (x >= ClientWidth - 16) and (y >= ClientHeight - 16) then Cmd := SC_SIZEBOTTOMRIGHT
  135.   else if (x <= 4) then Cmd := SC_SIZELEFT
  136.   else if (y <= 4) then Cmd := SC_SIZETOP
  137.   else if (x >= ClientWidth - 5) then Cmd := SC_SIZERIGHT
  138.   else if (y >= ClientHeight - 5) then Cmd := SC_SIZEBOTTOM
  139.   else Cmd := SC_DRAGMOVE;
  140.  
  141.   Perform(WM_SYSCOMMAND, Cmd, 0);
  142. end;
  143.  
  144.  
  145. procedure TCalForm.MouseMove(Shift: TShiftState; X, Y: Integer);
  146. begin
  147.   inherited MouseMove(Shift, X, Y);
  148.  
  149.   if ((x <= 16) and (y <= 16)) or ((x >= ClientWidth - 16) and (y >= ClientHeight - 16))
  150.     then Cursor := crSizeNWSE
  151.   else if ((x >= ClientWidth - 16) and (y <= 16)) or ((x <= 16) and (y >= ClientHeight - 16))
  152.     then Cursor := crSizeNESW
  153.   else if (x <= 4) or (x >= ClientWidth - 5)
  154.     then Cursor := crSizeWE
  155.   else if (y <= 4) or (y >= ClientHeight - 5) then
  156.     Cursor := crSizeNS
  157.   else
  158.     Cursor := crDefault;
  159. end;
  160.  
  161. procedure TCalForm.CreateParams(var Params : TCreateParams);
  162. begin
  163.   inherited CreateParams(Params);
  164.   if DesktopParent then Params.WndParent := GetDesktopWindow;
  165. end;
  166.  
  167. procedure TCalForm.WMGetMinMaxInfo(var Msg : TWMGetMinMaxInfo);
  168. begin
  169.   inherited;
  170.   with Msg.MinMaxInfo^ do begin
  171.     ptMinTrackSize.X := FMinimumWidth;
  172.     ptMinTrackSize.Y := FMinimumHeight;
  173.   end;
  174. end;
  175.  
  176. procedure TCalForm.Loaded;
  177. begin
  178.   inherited Loaded;
  179.   FMinimumWidth := Width;
  180.   FMinimumHeight := Height;
  181.   OldClientWidth := ClientWidth;
  182.   OldClientHeight := ClientHeight;
  183. end;
  184.  
  185. procedure TCalForm.Resize;
  186. begin
  187.   SizeDelta.X := ClientWidth - OldClientWidth;
  188.   SizeDelta.Y := ClientHeight - OldClientHeight;
  189.   OldClientWidth := ClientWidth;
  190.   OldClientHeight := ClientHeight;
  191.   inherited Resize;
  192. end;
  193.  
  194. procedure TCalForm.StretchShift(const C: array of TControl;
  195.   Flags: TStretchFlags);
  196. var
  197.   i, L, T, W, H: Integer;
  198. begin
  199.   for i := 0 to High(C) do with C[i] do begin
  200.     L := Left;
  201.     T := Top;
  202.     W := Width;
  203.     H := Height;
  204.     if stLeft in Flags then Inc(L, SizeDelta.x);
  205.     if stTop in Flags then Inc(T, SizeDelta.y);
  206.     if stWidth in Flags then Inc(W, SizeDelta.x);
  207.     if stHeight in Flags then Inc(H, SizeDelta.y);
  208.     SetBounds(L, T, W, H);
  209.   end;
  210. end;
  211.  
  212.  
  213. end.
  214.