home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
j
/
janusw.zip
/
DLGTEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-07-26
|
5KB
|
175 lines
{ Program: DlgTest
Version: 1.01
Purpose: demonstrates tDialogWindow and tJanusDialogWindow as
modeless Dialog Windows and MDI child windows.
Features: - creates a standard Dialog from BorDlg resource
- creates a BorDlg from standard resource
- creates Dialog as is
- demonstrates the use of "non-standard" MDI child styles
under Windows 3.1
Uses: BWCC.DLL if present. If not: it doesn't matter :-)
Date: 26.07.1992
Developer: Peter Sawatzki (PS)
Buchenhof 3, D-5800 Hagen 1, Germany
CompuServe: 100031,3002
FIDO: 2:245/5800.17
BITNET: IN307@DHAFEU11
Copyright (c) 1992 Peter Sawatzki. All Rights Reserved.
Contributing: Jeroen W. Pluimers (jwp)
CompuServe: 100013,1443
Internet: jeroenp@rulfc1.leidenuniv.nl
Fidonet: 2:281/521
History: 22.04.92 - intial release by PS
26.07.92 - added Scroller demo by PS and jwp
}
program DlgTest;
{$R DlgTest.Res}
Uses
WObjects,
WinTypes,
WinProcs,
Strings,
JanusWn;
Type
pTestDlg = ^tTestDlg;
tTestDlg = Object(tJanusDialogWindow)
Constructor Init (aParent: pWindowsObject; aName: pChar; BorStyle: Boolean);
End;
Constructor tTestDlg.Init (aParent: pWindowsObject; aName: pChar; BorStyle: Boolean);
Begin
tJanusDialogWindow.Init(aParent, aName, BorStyle);
Attr.Style := Attr.Style or ws_VScroll or ws_HScroll;
Scroller:= New(pScroller, Init(@self,1,1,0,0));
if Scroller <> nil then Scroller^.AutoMode := True;
End;
Function Dispatch (aParent: pWindow; Msg: tMessage): Boolean;
Var
aWin: pWindow;
Begin
aWin:= Nil;
Case Msg.wParam Of
80: aWin:= New(pTestDlg,Init(aParent, 'aDialog', False)); {standard -> standard}
81: aWin:= New(pTestDlg,Init(aParent, 'aBorDlg', False)); {BorDlg -> standard}
82: aWin:= New(pTestDlg,Init(aParent, 'aDialog', True)); {standard -> BorDlg}
83: aWin:= New(pTestDlg,Init(aParent, 'aBorDlg', True)); {BorDlg -> BorDlg}
84: aWin:= New(pTestDlg,Init(aParent, 'unusual', True)); {unusual Dialog}
Else
aWin:= Nil
End;
If aWin<>Nil Then
Application^.MakeWindow(aWin);
Dispatch:= aWin<>Nil
End;
{-------------------- the MDI part }
Type
paMDIWindow = ^aMDIWindow;
aMDIWindow = object(TMDIWindow)
Procedure InitClientWindow; Virtual;
Procedure DefCommandProc (Var Msg: tMessage); Virtual;
End;
Procedure aMDIWindow.InitClientWindow;
Begin
ClientWnd:= New(pMDIClient,Init(@Self));
With ClientWnd^.Attr do
Style:= Style or WS_VSCROLL or WS_HSCROLL or 1 {mdis_AllChildStyles = $0001}
End;
Procedure aMDIWindow.DefCommandProc (Var Msg: tMessage);
Begin
If Not Dispatch(@Self,Msg) Then
DefCommandProc(Msg)
End;
{-------------------- the normal window part }
Type
paWindow = ^aWindow;
aWindow = Object(tWindow)
Constructor Init (aParent: pWindowsObject; aTitle: pChar);
Procedure GetWindowClass(var WndClass: TWndClass); virtual;
Procedure DefCommandProc (Var Msg: tMessage); Virtual;
End;
Constructor aWindow.Init (aParent: pWindowsObject; aTitle: pChar);
Var
i: Integer;
Begin
tWindow.Init(aParent, aTitle);
Attr.Menu:= LoadMenu(hInstance,'aMenu');
For i:= cm_ArrangeIcons To cm_CloseChildren Do
EnableMenuItem(Attr.Menu,i,mf_ByCommand+mf_Disabled+mf_Grayed);
End;
Procedure aWindow.GetWindowClass(var WndClass: TWndClass);
Begin
tWindow.GetWindowClass(WndClass);
WndClass.lpszMenuName := Nil
End;
Procedure aWindow.DefCommandProc (Var Msg: tMessage);
Begin
If Not Dispatch(Nil,Msg) Then
DefCommandProc(Msg)
End;
{-------------------- the Application part }
Type
tProgApp = Object(TApplication)
MdiStyle: Boolean;
Constructor Init (aName: pChar; asMdi: Boolean);
Procedure InitMainWindow; Virtual;
Function ProcessAppMsg (Var Message: tMsg): Boolean; Virtual;
End;
Constructor tProgApp.Init (aName: pChar; asMdi: Boolean);
Begin
MdiStyle:= asMdi;
tApplication.Init(aName)
End;
Procedure tProgApp.InitMainWindow;
Begin
If MdiStyle Then
MainWindow:= New(paMDIWindow, Init('DlgTest', LoadMenu(HInstance, 'aMenu')))
Else
MainWindow:= New(paWindow, Init(Nil, 'DlgTest'))
end;
Function tProgApp.ProcessAppMsg (Var Message: tMsg): Boolean;
Begin
If MdiStyle Then
ProcessAppMsg:= ProcessMDIAccels(Message)
Or ProcessDlgMsg(Message)
Or ProcessAccels(Message)
Else
ProcessAppMsg:= tApplication.ProcessAppMsg(Message)
End;
Var
App: tProgApp;
Begin
With App Do Begin
Init('DlgTest',
MessageBox(0,'Do you want to run the demo in MDI style','',mb_YesNo)=idYes);
Run;
Done
End
End.