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