home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 11.ddi / OWLDEMOS.ZIP / POPUP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  4.8 KB  |  177 lines
  1. {************************************************}
  2. {                                                }
  3. {   Demo program                                 }
  4. {   Copyright (c) 1991 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Popup;
  9.  
  10. uses WinTypes, WinProcs, Strings, OWindows;
  11.  
  12. {$R POPUP}
  13.  
  14. const
  15.  
  16.   cm_Window = 100;
  17.  
  18. type
  19.  
  20.   TSubWinType = (sw_Child, sw_PopParent, sw_PopNoParent);
  21.  
  22.   PSubWindow = ^TSubWindow;
  23.   TSubWindow = object(TWindow)
  24.     SubWinType: TSubWinType;
  25.     constructor Init(AParent: PWindowsObject; ASubWinType: TSubWinType);
  26.     destructor Done; virtual;
  27.     procedure Paint(PaintDC: HDC; var PaintStruct: TPaintStruct); virtual;
  28.   end;
  29.  
  30.   PMainWindow = ^TMainWindow;
  31.   TMainWindow = object(TWindow)
  32.     constructor Init(ATitle: PChar);
  33.     procedure ShowSubWindow(AParent: PWindowsObject;
  34.       ASubWinType: TSubWinType);
  35.     procedure WMInitMenu(var Msg: TMessage);
  36.       virtual wm_First + wm_InitMenu;
  37.     procedure CMChild(var Msg: TMessage);
  38.       virtual cm_First + cm_Window + Ord(sw_Child);
  39.     procedure CMPopParent(var Msg: TMessage);
  40.       virtual cm_First + cm_Window + Ord(sw_PopParent);
  41.     procedure CMPopNoParent(var Msg: TMessage);
  42.       virtual cm_First + cm_Window + Ord(sw_PopNoParent);
  43.   end;
  44.  
  45.   TPopupApp = object(TApplication)
  46.     procedure InitMainWindow; virtual;
  47.   end;
  48.  
  49. const
  50.  
  51.   SubWinPtr: array[TSubWinType] of PSubWindow = (nil, nil, nil);
  52.  
  53.   SubWinTitle: array[TSubWinType] of PChar = (
  54.     'Child Window', 'Popup with Parent', 'Popup without Parent');
  55.  
  56.   SubWinStyle: array[TSubWinType] of Longint = (
  57.     ws_Child or ws_OverlappedWindow or ws_Visible,
  58.     ws_Popup or ws_OverlappedWindow or ws_Visible,
  59.     ws_Popup or ws_OverlappedWindow or ws_Visible);
  60.  
  61.   SubWinPos: array[TSubWinType] of TPoint = (
  62.     (X: 10; Y: 10), (X: 34; Y: 72), (X: 54; Y: 92));
  63.  
  64.   SubWinText: array[TSubWinType] of PChar = (
  65.     'Child windows cannot be moved outside their parent window.  When ' +
  66.       'minimized, a child window''s icon resides within the parent ' +
  67.       'window.',
  68.     'Popup windows can be moved outside their parent window.  A popup ' +
  69.       'with a parent is always displayed in front of the parent, ' +
  70.       'even when the parent is focused.  To test this, click on the ' +
  71.       'parent window.  When minimized, popup icons reside on the desktop.',
  72.     'Popup windows can be moved outside their parent window.  A popup ' +
  73.       'without a parent allows the parent to be brought to the front ' +
  74.       'when focused. To test this, click on the parent window.  When ' +
  75.       'minimized, popup icons reside on the desktop.');
  76.  
  77. var
  78.  
  79.   PopupApp: TPopupApp;
  80.  
  81. { TSubWindow }
  82.  
  83. constructor TSubWindow.Init(AParent: PWindowsObject;
  84.   ASubWinType: TSubWinType);
  85. begin
  86.   TWindow.Init(AParent, SubWinTitle[ASubWinType]);
  87.   Attr.Style := SubWinStyle[ASubWinType];
  88.   Attr.X := SubWinPos[ASubWinType].X;
  89.   Attr.Y := SubWinPos[ASubWinType].Y;
  90.   Attr.W := 300;
  91.   Attr.H := 150;
  92.   SubWinType := ASubWinType;
  93. end;
  94.  
  95. destructor TSubWindow.Done;
  96. begin
  97.   TWindow.Done;
  98.   SubWinPtr[SubWinType] := nil;
  99. end;
  100.  
  101. procedure TSubWindow.Paint(PaintDC: HDC; var PaintStruct: TPaintStruct);
  102. var
  103.   S: PChar;
  104.   R: TRect;
  105. begin
  106.   GetClientRect(HWindow, R);
  107.   InflateRect(R, -2, 0);
  108.   S := SubWinText[SubWinType];
  109.   DrawText(PaintDC, S, StrLen(S), R, dt_WordBreak);
  110. end;
  111.  
  112. { TMainWindow }
  113.  
  114. constructor TMainWindow.Init(ATitle: PChar);
  115. begin
  116.   TWindow.Init(nil, ATitle);
  117.   Attr.X := 0;
  118.   Attr.Y := 0;
  119.   Attr.W := 400;
  120.   Attr.H := 215;
  121.   Attr.Menu := LoadMenu(HInstance, 'Menu');
  122. end;
  123.  
  124. procedure TMainWindow.ShowSubWindow(AParent: PWindowsObject;
  125.   ASubWinType: TSubWinType);
  126. begin
  127.   if SubWinPtr[ASubWinType] = nil then
  128.     SubWinPtr[ASubWinType] := PSubWindow(Application^.MakeWindow(
  129.       New(PSubWindow, Init(AParent, ASubWinType))))
  130.   else
  131.     SetFocus(SubWinPtr[ASubWinType]^.HWindow);
  132. end;
  133.  
  134. procedure TMainWindow.WMInitMenu(var Msg: TMessage);
  135. var
  136.   Index: TSubWinType;
  137.   MenuState: Word;
  138. begin
  139.   for Index := sw_Child to sw_PopNoParent do
  140.   begin
  141.     if SubWinPtr[Index] = nil then
  142.       MenuState := mf_Unchecked else
  143.       MenuState := mf_Checked;
  144.     CheckMenuItem(Attr.Menu, cm_Window + Ord(Index), MenuState);
  145.   end;
  146. end;
  147.  
  148. procedure TMainWindow.CMChild(var Msg: TMessage);
  149. begin
  150.   ShowSubWindow(@Self, sw_Child);
  151. end;
  152.  
  153. procedure TMainWindow.CMPopParent(var Msg: TMessage);
  154. begin
  155.   ShowSubWindow(@Self, sw_PopParent);
  156. end;
  157.  
  158. procedure TMainWindow.CMPopNoParent(var Msg: TMessage);
  159. begin
  160.   ShowSubWindow(nil, sw_PopNoParent);
  161. end;
  162.  
  163. { TPopupApp }
  164.  
  165. procedure TPopupApp.InitMainWindow;
  166. begin
  167.   MainWindow := New(PMainWindow, Init('Parent Window'));
  168. end;
  169.  
  170. { Main program }
  171.  
  172. begin
  173.   PopupApp.Init('Popup');
  174.   PopupApp.Run;
  175.   PopupApp.Done;
  176. end.
  177.