home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / windows / januswn / dlgtest.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-26  |  4.8 KB  |  175 lines
  1. { Program:   DlgTest
  2.   Version:   1.01
  3.   Purpose:   demonstrates tDialogWindow and tJanusDialogWindow as
  4.              modeless Dialog Windows and MDI child windows.
  5.   Features:  - creates a standard Dialog from BorDlg resource
  6.              - creates a BorDlg from standard resource
  7.              - creates Dialog as is
  8.              - demonstrates the use of "non-standard" MDI child styles
  9.                under Windows 3.1
  10.   Uses:      BWCC.DLL if present. If not: it doesn't matter :-)
  11.   Date:      26.07.1992
  12.  
  13.   Developer: Peter Sawatzki (PS)
  14.              Buchenhof 3, D-5800 Hagen 1, Germany
  15.  CompuServe: 100031,3002
  16.        FIDO: 2:245/5800.17
  17.      BITNET: IN307@DHAFEU11
  18.  
  19.   Copyright (c) 1992 Peter Sawatzki. All Rights Reserved.
  20.   Contributing: Jeroen W. Pluimers (jwp)
  21.                 CompuServe: 100013,1443
  22.                 Internet:   jeroenp@rulfc1.leidenuniv.nl
  23.                 Fidonet:    2:281/521
  24.  
  25.   History:   22.04.92 - intial release by PS
  26.              26.07.92 - added Scroller demo by PS and jwp
  27.  
  28. }
  29. program DlgTest;
  30.  
  31. {$R DlgTest.Res}
  32.  
  33. Uses
  34.   WObjects,
  35.   WinTypes,
  36.   WinProcs,
  37.   Strings,
  38.   JanusWn;
  39.  
  40. Type
  41.   pTestDlg = ^tTestDlg;
  42.   tTestDlg = Object(tJanusDialogWindow)
  43.     Constructor Init (aParent: pWindowsObject; aName: pChar; BorStyle: Boolean);
  44.   End;
  45.  
  46. Constructor tTestDlg.Init (aParent: pWindowsObject; aName: pChar; BorStyle: Boolean);
  47. Begin
  48.   tJanusDialogWindow.Init(aParent, aName, BorStyle);
  49.   Attr.Style := Attr.Style or ws_VScroll or ws_HScroll;
  50.   Scroller:= New(pScroller, Init(@self,1,1,0,0));
  51.   if Scroller <> nil then Scroller^.AutoMode := True;
  52. End;
  53.  
  54.  
  55.  
  56. Function Dispatch (aParent: pWindow; Msg: tMessage): Boolean;
  57. Var
  58.   aWin: pWindow;
  59. Begin
  60.   aWin:= Nil;
  61.   Case Msg.wParam Of
  62.       80: aWin:= New(pTestDlg,Init(aParent, 'aDialog', False)); {standard -> standard}
  63.       81: aWin:= New(pTestDlg,Init(aParent, 'aBorDlg', False)); {BorDlg   -> standard}
  64.       82: aWin:= New(pTestDlg,Init(aParent, 'aDialog', True));  {standard -> BorDlg}
  65.       83: aWin:= New(pTestDlg,Init(aParent, 'aBorDlg', True));  {BorDlg   -> BorDlg}
  66.       84: aWin:= New(pTestDlg,Init(aParent, 'unusual', True));  {unusual Dialog}
  67.     Else
  68.       aWin:= Nil
  69.     End;
  70.   If aWin<>Nil Then
  71.     Application^.MakeWindow(aWin);
  72.   Dispatch:= aWin<>Nil
  73. End;
  74.  
  75.  
  76. {-------------------- the MDI part }
  77.  
  78. Type
  79.   paMDIWindow = ^aMDIWindow;
  80.   aMDIWindow = object(TMDIWindow)
  81.     Procedure InitClientWindow; Virtual;
  82.     Procedure DefCommandProc (Var Msg: tMessage); Virtual;
  83.   End;
  84.  
  85. Procedure aMDIWindow.InitClientWindow;
  86. Begin
  87.  ClientWnd:= New(pMDIClient,Init(@Self));
  88.  With ClientWnd^.Attr do
  89.    Style:= Style or WS_VSCROLL or WS_HSCROLL or 1 {mdis_AllChildStyles = $0001}
  90. End;
  91.  
  92. Procedure aMDIWindow.DefCommandProc (Var Msg: tMessage);
  93. Begin
  94.   If Not Dispatch(@Self,Msg) Then
  95.     DefCommandProc(Msg)
  96. End;
  97.  
  98. {-------------------- the normal window part }
  99.  
  100. Type
  101.   paWindow = ^aWindow;
  102.   aWindow = Object(tWindow)
  103.     Constructor Init (aParent: pWindowsObject; aTitle: pChar);
  104.     Procedure GetWindowClass(var WndClass: TWndClass); virtual;
  105.     Procedure DefCommandProc (Var Msg: tMessage); Virtual;
  106.   End;
  107.  
  108. Constructor aWindow.Init (aParent: pWindowsObject; aTitle: pChar);
  109. Var
  110.   i: Integer;
  111. Begin
  112.   tWindow.Init(aParent, aTitle);
  113.   Attr.Menu:= LoadMenu(hInstance,'aMenu');
  114.   For i:= cm_ArrangeIcons To cm_CloseChildren Do
  115.     EnableMenuItem(Attr.Menu,i,mf_ByCommand+mf_Disabled+mf_Grayed);
  116. End;
  117.  
  118. Procedure aWindow.GetWindowClass(var WndClass: TWndClass);
  119. Begin
  120.   tWindow.GetWindowClass(WndClass);
  121.   WndClass.lpszMenuName := Nil
  122. End;
  123.  
  124. Procedure aWindow.DefCommandProc (Var Msg: tMessage);
  125. Begin
  126.   If Not Dispatch(Nil,Msg) Then
  127.     DefCommandProc(Msg)
  128. End;
  129.  
  130.  
  131.  
  132. {-------------------- the Application part }
  133. Type
  134.   tProgApp = Object(TApplication)
  135.     MdiStyle: Boolean;
  136.     Constructor Init (aName: pChar; asMdi: Boolean);
  137.     Procedure InitMainWindow; Virtual;
  138.     Function ProcessAppMsg (Var Message: tMsg): Boolean; Virtual;
  139.   End;
  140.  
  141. Constructor tProgApp.Init (aName: pChar; asMdi: Boolean);
  142. Begin
  143.   MdiStyle:= asMdi;
  144.   tApplication.Init(aName)
  145. End;
  146.  
  147. Procedure tProgApp.InitMainWindow;
  148. Begin
  149.   If MdiStyle Then
  150.     MainWindow:= New(paMDIWindow, Init('DlgTest', LoadMenu(HInstance, 'aMenu')))
  151.   Else
  152.     MainWindow:= New(paWindow, Init(Nil, 'DlgTest'))
  153. end;
  154.  
  155. Function tProgApp.ProcessAppMsg (Var Message: tMsg): Boolean;
  156. Begin
  157.   If MdiStyle Then
  158.     ProcessAppMsg:= ProcessMDIAccels(Message)
  159.                  Or ProcessDlgMsg(Message)
  160.                  Or ProcessAccels(Message)
  161.   Else
  162.     ProcessAppMsg:= tApplication.ProcessAppMsg(Message)
  163. End;
  164.  
  165. Var
  166.   App: tProgApp;
  167. Begin
  168.   With App Do Begin
  169.     Init('DlgTest',
  170.          MessageBox(0,'Do you want to run the demo in MDI style','',mb_YesNo)=idYes);
  171.     Run;
  172.     Done
  173.   End
  174. End.
  175.