home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
library
/
windows
/
januswn
/
dialogwn.pas
next >
Wrap
Pascal/Delphi Source File
|
1992-07-25
|
12KB
|
387 lines
Unit DialogWn;
{ Unit: DialogWn
Version: 1.01
Purpose: make a descendant of tWindow named tDialogWindow that behaves like
a modeless dialog.
Features: - tDialogWindow descends from tWindow
- tDialogWindow and descendants may be used as MDI childs
- support for calculated resources is included e.g. a dialog
childs class & style may be changed on-the-fly (see GetChildClass)
tJanusDialogWindow object is an example for this: it decides at
runtime whether to uses BorDlg's or standard dialogs
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 support by PS and jwp
}
Interface
Uses
WinTypes,
WObjects;
Type
tChildClass = Record
wX, wY, wCX, wCY, wID: Integer;
dwStyle: LongInt;
szClass: Array[0..63] Of Char;
szTitle: Array[0..131] Of Char;
CtlDataSize: Byte;
CtlData: Array[0..255] Of Byte;
End;
tDialogWindowAttr = Record
Name: pChar;
ItemCount: Integer;
MenuName,
ClassName,
FontName: pChar;
Font: hFont;
PointSize: Integer;
DlgItems: Pointer;
ResW,
ResH: Integer;
wUnitsX,
wUnitsY: Word
End;
pDialogWindow = ^tDialogWindow;
tDialogWindow = Object(tWindow)
DialogAttr: tDialogWindowAttr;
Constructor Init (aParent: pWindowsObject; aName: pChar);
Destructor Done; Virtual;
Function Create: Boolean; Virtual;
Procedure Destroy; Virtual;
Procedure SetupWindow; Virtual;
Function GetClassName: pChar; Virtual;
Function NewClassName: pChar; Virtual;
Procedure SetClassName; Virtual;
Procedure GetChildClass (Var aChildClass: tChildClass); Virtual;
Function CreateDialogChild (Var aChildClass: tChildClass): hWnd; Virtual;
Procedure CreateDialogChildren;
Procedure CreateDialogFont;
Procedure GetDialogInfo (aPtr: Pointer);
Procedure UpdateDialog;
Procedure Ok (Var Msg: tMessage); Virtual id_First+id_Ok;
Procedure Cancel (Var Msg: tMessage); Virtual id_First+id_Cancel;
Procedure wmMDIActivate (Var Msg: tMessage); Virtual wm_First+wm_MDIActivate;
(*Procedure wmNCActivate (Var Msg: tMessage); Virtual wm_First+$46;*)
procedure WMSize(var Msg: TMessage); virtual wm_First + wm_Size;
End;
Implementation
Uses
WinProcs,
Strings;
Const
sztDialogWindow = 'tDialogWindow';
Function DlgToClientX (x, Units: Integer): Integer;
{DlgToClientX:= x*Units Div 4}
Inline($59/$58/ {Pop Cx Ax}
$F7/$E1/ {Mul Cx}
$D1/$E8/ {Shr Ax,1}
$D1/$E8); {Shr Ax,1}
Function DlgToClientY (y, Units: Integer): Integer;
{DlgToClientY:= y*Units Div 8}
Inline($59/$58/ {Pop Cx Ax}
$F7/$E1/ {Mul Cx}
$D1/$E8/ {Shr Ax,1}
$D1/$E8/ {Shr Ax,1}
$D1/$E8); {Shr Ax,1}
Constructor tDialogWindow.Init (aParent: pWindowsObject; aName: pChar);
Begin
tWindow.Init(aParent,sztDialogWindow); {fake title}
FillChar(DialogAttr,SizeOf(DialogAttr),0);
With DialogAttr Do
If PtrRec(aName).Seg=0 Then Name:= aName Else Name:= StrNew(aName)
End;
Destructor tDialogWindow.Done;
Begin
With DialogAttr Do Begin
If PtrRec(Name).Seg<>0 Then StrDispose(Name);
StrDispose(MenuName);
StrDispose(ClassName);
If FontName<>Nil Then
StrDispose(FontName)
End;
tWindow.Done
End;
Function tDialogWindow.Create: Boolean;
Var
aRes: tHandle;
Begin
EnableKBHandler;
If DialogAttr.Name=Nil Then
Exit;
aRes:= LoadResource(hInstance,
FindResource(hInstance, DialogAttr.Name, rt_Dialog));
If aRes=0 Then
Status:= em_InvalidWindow
Else Begin
GetDialogInfo(LockResource(aRes));
SetClassName; {let descendants change the class name}
CreateDialogFont;
UpdateDialog;
Create:= tWindow.Create;
UnlockResource(aRes);
FreeResource(aRes)
End
End;
Procedure tDialogWindow.Destroy;
Begin
If DialogAttr.FontName<>Nil Then
DeleteObject(DialogAttr.Font);
tWindow.Destroy
End;
Procedure tDialogWindow.SetupWindow;
const
BorDialog = 'BorDlg';
Begin
SendMessage(hWindow,wm_SetFont,DialogAttr.Font,0);
CreateDialogChildren;
tWindow.SetupWindow;
If (Scroller<>Nil)
And (StrLIComp(DialogAttr.ClassName,BorDialog,Length(BorDialog)) = 0) Then
With Scroller^ Do Begin
{fix BWCC background quirk}
XUnit:= (XUnit + 1) And Not 1; { make even }
YUnit:= (YUnit + 1) And Not 1
End
End;
Function tDialogWindow.GetClassName: pChar;
Begin
If NewClassName=Nil Then
If DialogAttr.ClassName=Nil Then
GetClassName:= sztDialogWindow
Else
GetClassName:= DialogAttr.ClassName
Else
GetClassName:= NewClassName
End;
Function tDialogWindow.NewClassName: pChar;
Begin
{-tDialogWindow gets the Class name from the dialog resource}
NewClassName:= Nil
End;
Procedure tDialogWindow.SetClassName;
Begin
If NewClassName<>Nil Then Begin
StrDispose(DialogAttr.ClassName);
DialogAttr.ClassName:= StrNew(NewClassName)
End
End;
Procedure tDialogWindow.GetChildClass (Var aChildClass: tChildClass);
{-change a childs window class. Standard windows behaviour is simulated here:
change special resource shortcuts (#$80..#$85) to their appropriate class names}
Const
PreDefClasses: Array[#$80..#$85] Of pChar =
('BUTTON','EDIT','STATIC','LISTBOX','SCROLLBAR','COMBOBOX');
Begin
With aChildClass Do
Case szClass[0] Of
#$80..#$85: StrCopy(szClass,PreDefClasses[szClass[0]])
End
End;
Function tDialogWindow.CreateDialogChild (Var aChildClass: tChildClass): hWnd;
Var
aCtl: hWnd;
lpDlgItemInfo: Pointer;
Begin
With DialogAttr, aChildClass Do Begin
If CtlDataSize=0 Then
lpDlgItemInfo:= Nil
Else
lpDlgItemInfo:= @CtlData;
aCtl:= CreateWindow(szClass, szTitle, dwStyle,
DlgToClientX(wX,wUnitsX), DlgToClientY(wY,wUnitsY),
DlgToClientX(wCX,wUnitsX), DlgToClientY(wCY,wUnitsY),
hWindow, wID, System.hInstance,
lpDlgItemInfo);
If aCtl<>0 Then
SendMessage(aCtl, wm_SetFont, Font, 0)
End;
CreateDialogChild:= aCtl
End;
Procedure tDialogWindow.CreateDialogChildren;
Var
i: Integer;
sp: Pointer;
anItem: tChildClass;
Begin
sp:= DialogAttr.DlgItems;
With DialogAttr,anItem Do
For i:= 1 To DialogAttr.ItemCount Do Begin
{-copy fixed header and first byte of szClass}
Move(sp^,anItem,15); Inc(Word(sp),15);
Case szClass[0] Of
#$80..#$85: szClass[1]:= #0; {be safe}
Else
StrCopy(szClass+1,sp); {copy rest of classname}
Inc(Word(sp),StrLen(sp)+1)
End;
StrCopy(szTitle,sp); Inc(Word(sp),StrLen(sp)+1);
Move(sp^,CtlDataSize,Byte(sp^)+1);
Inc(Word(sp),CtlDataSize+1);
{-maybe a descendant class wants to change child names :-) }
GetChildClass(anItem);
If CreateDialogChild(anItem)=0 Then Begin
Status:= em_InvalidChild;
Exit
End
End
End;
Procedure tDialogWindow.GetDialogInfo (aPtr: Pointer);
Begin
With Attr,DialogAttr Do Begin
Style:= LongInt(aPtr^); Inc(Word(aPtr),SizeOf(LongInt));
ItemCount:= Byte(aPtr^); Inc(Word(aPtr),SizeOf(Byte));
If Not IsFlagSet(wb_MdiChild) Then
X:= Integer(aPtr^); Inc(Word(aPtr),SizeOf(Integer));
Y:= Integer(aPtr^); Inc(Word(aPtr),SizeOf(Integer));
W:= Integer(aPtr^); Inc(Word(aPtr),SizeOf(Integer));
H:= Integer(aPtr^); Inc(Word(aPtr),SizeOf(Integer));
MenuName:= StrNew(aPtr); Inc(Word(aPtr),StrLen(aPtr)+1);
ClassName:= StrNew(aPtr); Inc(Word(aPtr),StrLen(aPtr)+1);
Title:= StrNew(aPtr); Inc(Word(aPtr),StrLen(aPtr)+1);
If Style And ds_SetFont>0 Then Begin
PointSize:= Integer(aPtr^); Inc(Word(aPtr),SizeOf(Integer));
FontName:= StrNew(aPtr); Inc(Word(aPtr),StrLen(aPtr)+1)
End Else Begin
PointSize:= 0;
FontName:= Nil
End;
DlgItems:= aPtr
End
End;
Procedure tDialogWindow.UpdateDialog;
{-update and resize dialog window according to its style}
Var
TheMDIClient: pMdiClient;
aRect: tRect;
Begin With Attr, DialogAttr Do Begin
{-update style bits for MDI}
If isFlagSet(wb_MdiChild) Then Begin
{-reject use of ws_PopUp for a MDI child!}
If Style And ws_PopUp<>0 Then
Style:= (Style Or ws_Child) And Not ws_PopUp;
TheMDIClient:= Parent^.GetClient;
{-check if the Client window has the MDIs_allChildStyles bit set}
If (TheMDIClient=Nil)
Or (GetWindowLong(TheMDIClient^.hWindow,gwl_Style) And 1=0) Then
Style:= Style Or ws_Child Or ws_ClipSiblings Or ws_ClipChildren
Or ws_SysMenu Or ws_Caption Or ws_ThickFrame
Or ws_MinimizeBox Or ws_MaximizeBox
End;
{-resize the window according to its style and size}
With aRect Do Begin
left:= 0;
top:= 0;
right:= DlgToClientX(w, wUnitsX);
bottom:= DlgToClientY(h, wUnitsY);
AdjustWindowRect(aRect, Style, Menu<>0);
w:= right-left;
h:= bottom-top;
ResW:= w;
ResH:= h;
End
End End;
Procedure tDialogWindow.CreateDialogFont;
{-create the dialog font and calculate dialog units based on font}
Const
aWidthString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
Var
aDC: hDC;
anOldFont: hFont;
aLogFont: tLogFont;
aTextMetric: tTextMetric;
Begin With DialogAttr Do Begin
aDC:= GetDC(0);
If FontName=Nil Then
Font:= GetStockObject(System_Font)
Else Begin
FillChar(aLogFont,SizeOf(aLogFont),0);
With aLogFont Do Begin
StrCopy(lfFaceName,FontName);
lfHeight:= -MulDiv(DialogAttr.PointSize,GetDeviceCaps(aDC, LogPixelsY),72);
lfWeight:= FW_BOLD
End;
Font:= CreateFontIndirect(aLogFont)
End;
anOldFont:= SelectObject(aDC, Font);
GetTextMetrics(aDC, aTextMetric);
{-use the Microsoft recommended way to retrieve average width}
wUnitsX:= Word(GetTextExtent(aDC, aWidthString, Length(aWidthString))) Div Length(aWidthString);
wUnitsY:= aTextMetric.tmHeight;
SelectObject(aDC, anOldFont);
ReleaseDC(0, aDC)
End End;
Procedure tDialogWindow.Ok (Var Msg: tMessage);
Begin
CloseWindow
End;
Procedure tDialogWindow.Cancel (Var Msg: tMessage);
Begin
CloseWindow
End;
Procedure tDialogWindow.wmMDIActivate(Var Msg: tMessage);
Begin
wmActivate(Msg)
End;
(*Procedure tDialogWindow.wmNCActivate(Var Msg: tMessage);
Begin
{If Msg.wParam=0 Then}
Msg.Result:= 0
{Else
With Msg Do Result:= DefWindowProc(Receiver, Message, wParam, lParam)
}
End; *)
Procedure tDialogWindow.WMSize(var Msg: TMessage);
Begin
TWindow.WMSize(Msg);
If Scroller <> Nil Then With Scroller^ Do Begin
AutoOrg:= Msg.wParam <> sizeIconic;
If Msg.WParam <> sizeIconic Then Begin
With DialogAttr, Attr Do
SetRange(ResW - W, ResH - H);
ScrollTo(0, 0);
InvalidateRect(HWindow, nil, True)
End
End
End;
End.