home *** CD-ROM | disk | FTP | other *** search
/ Prima Shareware 3 / DuCom_Prima-Shareware-3_cd1.bin / PROGRAMO / PASCAL / JANUSW / DIALOGWN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-15  |  32.1 KB  |  974 lines
  1. Unit DialogWn;
  2. { Unit:      DialogWn
  3.   Version:   1.31
  4.   Purpose:   make a descendant of tWindow named tDialogWindow that behaves like
  5.              a modeless or modal dialog.
  6.   Developer: Peter Sawatzki (ps)
  7.              Buchenhof 3, D58091 Hagen, Germany
  8.  CompuServe: 100031,3002
  9.  
  10.   Date:    Author:
  11.   04/22/92 ps     initial release by ps
  12.   07/25/92 ps/jwp added Scroller support
  13.   08/01/92 ps     added RunModal and modal support
  14.   08/12/92 ps     removed SetClassName and NewClass, fixed bug in MDI support
  15.   08/14/92 ps     fixed Focus problems in MDI, give focus to first ws_TabStop child
  16.   08/30/92 ps     fixed more focus problems in MDI, added SysModal support
  17.   09/27/92 ps     call DefDlgProc to support DropDownBoxes and Multiline edit controls
  18.   10/21/92 ps     some changes for new OWL
  19.   01/28/93 ps     add LoadMenu for automatic menu load
  20.   02/06/93 ps     add support for InitResource, fix BWCC's WM_NCCREATE glitch
  21.   06/10/93 ps     added CanClose method to cancel modal dialogs
  22.   06/15/93 dob    removed CanClose, added WMQueryEndSession
  23.   06/17/93 dob/ps added wmKillFocus and wmNCActivate methods, modified wmSetFocus method
  24.   06/29/93 ps     added tAdvApplication object to resolve focus problems
  25.   07/01/93 ps     added tAdvMdiWindow object to solve MessageBox problem
  26.   07/05/93 ps     added hEditBuffer to save system resources for Edit Ctls
  27.   07/23/93 ps     added wm_EnterIdle sending to RunModal
  28.   08/10/93 ps     fixed ListBox focus problem
  29.   08/28/93 ps     added dm_SetDefId and dm_GetDefId handling
  30.   08/30/93 ps     added calls to DefDialogProc() for proper default PushButton handling
  31.   09/02/93 ps     included tJanusDialogWindow properties in tDialogWindow
  32.   09/11/93 ps     added Ctl3D support
  33.   10/01/93 ps     added use of DynLink to DYNAMICALLY link DLLs
  34.   10/15/93 ps     added focus autofollow
  35.   12/10/93 ps     added BorDlg_Gray support
  36.   01/01/94 ms/ps  fixed Ctl-Tab bug in wmSysCommand, change wmSetFocus
  37.   01/01/94 ps     remove all calls to DefDlgProc, do all DefDlg stuff in tDialogWindow
  38.   01/21/94 ps     fix bug in resource parsing when menuname is an integer atom of form #$xx00
  39.   02/14/94 ps     added support for VBX control
  40.   03/03/94 ps     fix OWL wm_Activate bug
  41.   03/14/94 pl/ps  make MapDialogRect compatible
  42.  
  43.   Contributing: Jeroen W. Pluimers (jwp)
  44.                 Dan O. Butler (dob) [72134,633]
  45.                 Andy Cook [71331,501]
  46.                 Dean Wyant [75110,3253]
  47.                 Max Stempfhuber (ms) [100140,2034]
  48.                 Per Larsen (pl) [100121,1514]
  49.  
  50.   Copyright (c) 1994 Peter Sawatzki. All Rights Reserved.
  51.  
  52. }
  53. {$A+,B-,F-,G+,I-,K+,P-,Q-,R-,S-,T-,V-,X+}
  54. Interface
  55. Uses
  56.   DynLink,
  57.   Vbx,
  58.   WinTypes,
  59.   Win31,
  60. {$IfDef Custom}
  61.   CustomWn,
  62. {$EndIf}
  63. {$IfDef Debug}
  64.   Debug,
  65. {$EndIf}
  66.   Objects,
  67.   oWindows;
  68. Const
  69.   wm_EnterMenuLoop = $0211;   {undocumented}
  70.   MdiS_AllChildStyles = $0001;
  71.  
  72.   {-private message for tDialogWindow}
  73.   wm_TrackFocus = (wm_User+3);
  74.  
  75.   {-style bits for DlgStyle}
  76.   OrgStyle   = $00;
  77.   ForceStd   = $01; {Force BorDlgs to appear as Std dialogs}
  78.   ForceBor   = $02; {Force Std dialogs to appear as BorDlgs}
  79.   EnableCtl3D= $04; {Enable Ctl3D}
  80.   ForceGrayBk= $08; {Force a gray background}
  81.   GrayBorDlg = $10; {gray Borland dialogs}
  82.   DefStyle: Word = OrgStyle Or EnableCtl3D Or ForceGrayBk; {use OrgStyle by default}
  83.   DefCtl3DStyle: LongInt = Ctl3D_All;
  84.   DefFontWeight: Integer = fw_Bold; {standard Windows behaviour}
  85.  
  86. Type
  87.   tChildClass = Record
  88.     wX, wY, wCX, wCY: Integer;
  89.     wID: Word;
  90.     dwStyle: LongInt;
  91.     szClass: Array[0..63] Of Char;
  92.     szTitle: Array[0..131] Of Char;
  93.     CtlDataSize: Byte;
  94.     CtlData: Array[0..255] Of Byte;
  95.   End;
  96.  
  97.   tDialogWindowAttr = Record
  98.     Name: pChar;
  99.     ItemCount: Integer;
  100.     MenuName,
  101.     ClassName,
  102.     FontName: pChar;
  103.     Font: hFont;
  104.     FontWeight: Integer;
  105.     PointSize: Integer;
  106.     DlgItems: Pointer; {only valid ...}
  107.     VbInfo: Pointer;   {... during Create}
  108.     ResW,              {dialogs initial width ...}
  109.     ResH: Integer;     {... and height}
  110.     wUnitsX,
  111.     wUnitsY: Word;
  112.     hEditBuffer: tHandle;
  113.   End;
  114.  
  115. {$IfDef Custom}
  116.   Ancestor = tCustomWindow;
  117. {$Else}
  118.   Ancestor = tWindow;
  119. {$EndIf}
  120.   pDialogWindow = ^tDialogWindow;
  121.   tDialogWindow = Object(Ancestor)
  122.     DialogAttr: tDialogWindowAttr;
  123.     ModalCode: pInteger;
  124.  
  125.     DlgStyle: Word;
  126.     Ctl3DStyle: LongInt;
  127.     DefId: hWnd;
  128.     IsBorDlg: Boolean;
  129.     Constructor Init       (aParent: pWindowsObject; aName: pChar);
  130.     Constructor InitCustom (aParent: pWindowsObject; aName: pChar; aDlgStyle: Word);
  131.     Destructor Done;                                 Virtual;
  132.     Procedure AllocateEditBuffer;                    Virtual;
  133.     Function  Create: Boolean;                       Virtual;
  134.     Procedure Destroy;                               Virtual;
  135.     Procedure SetupWindow;                           Virtual;
  136.     Function  GetClassName: pChar;                   Virtual;
  137.     Procedure GetWindowClass (Var aWndClass: tWndClass); Virtual;
  138.     Procedure GetChildClass (Var aChildClass: tChildClass); Virtual;
  139.     Procedure MangleChildClass (Var aChildClass: tChildClass); Virtual;
  140.     Function  CreateDialogChild ({Bp7.01: Const} Var aChildClass: tChildClass): hWnd; Virtual;
  141.     Function  CreateDialogChildren: Boolean;         Virtual;
  142.     Procedure CreateDialogFont;
  143.     Procedure GetDialogInfo (aPtr: Pointer);
  144.     Procedure StoreDMInfo;
  145.     Procedure UpdateDialog;                          Virtual;
  146.     Procedure MangleClass;                           Virtual;
  147.     Procedure SetWindowProcs;                        Virtual;
  148.     Function  RunModal: Integer;                     Virtual;
  149.     Function  IsModal: Boolean;
  150.     Procedure EndDlg (aRetValue: Integer);           Virtual;
  151.     Function  GetItemHandle (DlgItemID: Integer): hWnd;
  152.     Function  SendDlgItemMsg (DlgItemID: Integer; aMsg, wParam: Word; lParam: LongInt): LongInt;
  153.     Procedure Ok (Var Msg: tMessage);                Virtual id_First+id_Ok;
  154.     Procedure Cancel (Var Msg: tMessage);            Virtual id_First+id_Cancel;
  155.     Procedure wmClose (Var Msg: tMessage);           Virtual wm_First+wm_Close;
  156.     Procedure wmQueryEndSession (Var Msg: tMessage); Virtual wm_First+wm_QueryEndSession;
  157.     Procedure wmSize (Var Msg: tMessage);            Virtual wm_First+wm_Size;
  158.     Procedure wmLButtonDown (Var Msg: tMessage);     Virtual wm_First+wm_LButtonDown;
  159.     Procedure wmNcLButtonDown (Var Msg: tMessage);   Virtual wm_First+wm_NcLButtonDown;
  160.     Procedure wmEnterMenuLoop (Var Msg: tMessage);   Virtual wm_First+wm_EnterMenuLoop;
  161.     Procedure wmActivate (Var Msg: tMessage);        Virtual wm_First+wm_Activate;
  162.     Procedure HideComboListBox;
  163.     Procedure wmNextDlgCtl (Var Msg: tMessage);      Virtual wm_First+wm_NextDlgCtl;
  164.     Procedure dmGetDefId (Var Msg: tMessage);        Virtual wm_First+dm_GetDefId;
  165.     Procedure wmTrackFocus (Var Msg: tMessage);      Virtual wm_First+wm_TrackFocus;
  166.     Procedure wmSetFocus (Var Msg: tMessage);        Virtual wm_First+wm_SetFocus;
  167.     Procedure wmCtlColor (Var Msg: tMessage);        Virtual wm_First+wm_CtlColor;
  168.     Procedure wmPaint (Var Msg: tMessage);           Virtual wm_First+wm_Paint;
  169.     Procedure wmEraseBkGnd (Var Msg: tMessage);      Virtual wm_First+wm_EraseBkGnd;
  170.     Procedure wmVbxFireEvent (Var Msg: tMessage);    Virtual wm_First+wm_VbxFireEvent;
  171.     Procedure DefaultEventProc (Var Event: tVbxEvent); Virtual;
  172.   End;
  173.  
  174.   pAdvApplication = ^tAdvApplication;
  175.   tAdvApplication = Object(tApplication)
  176.     Function ProcessDlgMsg (Var Message: tMsg): Boolean; Virtual;
  177.     Function ProcessAppMsg (Var Message: tMsg): Boolean; Virtual;
  178.   End;
  179.  
  180.   pAdvMdiWindow = ^tAdvMdiWindow;
  181.   tAdvMdiWindow = Object(tMdiWindow)
  182.     Procedure wmActivate (Var Msg: tMessage); Virtual wm_First+wm_Activate;
  183.   End;
  184.  
  185.   Function ExecDialogWindow (aDialogWindow: pDialogWindow): Integer;
  186.  
  187. Implementation
  188. Uses
  189.   WinProcs,
  190.   Strings;
  191.  
  192. Const
  193.   sztDialogWindow = 'tDialogWindow';
  194.  
  195.   ws_MdiChild   = ws_Child Or ws_ClipSiblings Or ws_SysMenu Or ws_Caption Or
  196.                   ws_ThickFrame Or ws_MinimizeBox Or ws_MaximizeBox Or ws_Visible;
  197.   ws_MdiAllowed = ws_MdiChild Or ws_Minimize Or ws_Maximize Or ws_ClipChildren Or
  198.                   ws_Disabled Or ws_HScroll Or ws_VScroll Or ws_ThickFrame Or $FFFF;
  199.   {dialog window words}
  200.   dwl_MsgResult     = 0;
  201.   dwl_DlgProc       = 4;
  202.   dwl_User          = 8;
  203.   dww_wUnitsX       = 12;
  204.   dww_wUnitsY       = 14;
  205.   dww_hWndFocusSave = 16;
  206.   dww_fEnd          = 18; {DM's flag for end dialog}
  207.   dww_Result        = 22; {default id and dialog result}
  208.   dww_hData         = 24; {handle to edit memory block}
  209.   dww_hUserFont     = 26; {handle to dialog font}
  210.  
  211. Function DlgToClientX (x, Units: Integer): Integer;
  212. {DlgToClientX:= x*Units Div 4}
  213. Inline($59/$58/    {Pop Cx Ax}
  214.        $F7/$E1/    {Mul Cx}
  215.        $D1/$E8/    {Shr Ax,1}
  216.        $D1/$E8);   {Shr Ax,1}
  217.  
  218. Function DlgToClientY (y, Units: Integer): Integer;
  219. {DlgToClientY:= y*Units Div 8}
  220. Inline($59/$58/    {Pop Cx Ax}
  221.        $F7/$E1/    {Mul Cx}
  222.        $D1/$E8/    {Shr Ax,1}
  223.        $D1/$E8/    {Shr Ax,1}
  224.        $D1/$E8);   {Shr Ax,1}
  225.  
  226. Constructor tDialogWindow.Init (aParent: pWindowsObject; aName: pChar);
  227. Begin
  228.   Inherited Init(aParent,sztDialogWindow); {fake title}
  229.   FillChar(DialogAttr,SizeOf(DialogAttr),0);
  230.   ModalCode:= Nil;                         {assume modeless window}
  231.   DlgStyle:= DefStyle;                     {assume default style}
  232.   Ctl3DStyle:= DefCtl3DStyle;
  233.   IsBorDlg:= False;                        {really unknown at this moment}
  234.   DefId:= 0;
  235.   With DialogAttr Do Begin
  236.     hEditBuffer:= 0;                       {no edit buffer allocated yet}
  237.     FontWeight:= DefFontWeight;            {Windows standard dialogs are bold}
  238.     If PtrRec(aName).Seg=0 Then Name:= aName Else Name:= StrNew(aName)
  239.   End
  240. End;
  241.  
  242. Constructor tDialogWindow.InitCustom (aParent: pWindowsObject; aName: pChar; aDlgStyle: Word);
  243. Begin
  244.   tDialogWindow.Init (aParent, aName); {very important to use 'tDialogWindow.' !!!}
  245.   DlgStyle:= aDlgStyle
  246. End;
  247.  
  248. Destructor tDialogWindow.Done;
  249. Begin
  250.   With DialogAttr Do Begin
  251.     If PtrRec(Name).Seg<>0 Then StrDispose(Name);
  252.     If PtrRec(MenuName).Seg<>0 Then StrDispose(MenuName);
  253.     StrDispose(ClassName);
  254.     StrDispose(FontName)
  255.   End;
  256.   Inherited Done
  257. End;
  258.  
  259. Procedure tDialogWindow.AllocateEditBuffer;
  260. {-allocate a local heap for edit controls}
  261. Begin
  262.   DialogAttr.hEditBuffer:= GlobalAlloc(GHnd, 4096)
  263. End;
  264.  
  265. Function tDialogWindow.Create: Boolean;
  266. Var
  267.   aRes, VbRes: tHandle;
  268. Begin
  269.   Create:= False;
  270.   If (Status<>0) Or (DialogAttr.Name=Nil) Then
  271.     Exit;
  272.   aRes:= FindResource(hInstance, DialogAttr.Name, rt_Dialog);
  273.   If aRes<>0 Then
  274.     aRes:= LoadResource(hInstance, aRes);
  275.   If aRes=0 Then
  276.     Status:= em_InvalidWindow
  277.   Else Begin
  278.     If Assigned(ModalCode) Then Begin
  279.       If Assigned(Parent) Then
  280.         EnableWindow(Parent^.hWindow, False); {disable Parent}
  281.       ModalCode^:= 0                          {begin modal state}
  282.     End;
  283.     VbRes:= FindResource(hInstance, DialogAttr.Name, rt_DlgInit);
  284.     If VbRes<>0 Then Begin
  285.       VbRes:= LoadResource(hInstance, VbRes);
  286.       DialogAttr.VbInfo:= LockResource(VbRes)
  287.     End;
  288.     GetDialogInfo(LockResource(aRes));
  289.     If Assigned(DialogAttr.MenuName) Then
  290.       Attr.Menu:= LoadMenu(hInstance, DialogAttr.MenuName);
  291.     CreateDialogFont;
  292.     UpdateDialog;
  293.     MangleClass;
  294.     SetWindowProcs;
  295.     EnableKBHandler;
  296.     Create:= Inherited Create;
  297.     UnlockResource(aRes);
  298.     FreeResource(aRes);
  299.     If VbRes<>0 Then Begin
  300.       UnlockResource(VbRes);
  301.       FreeResource(VbRes)
  302.     End
  303.   End
  304. End;
  305.  
  306. Procedure tDialogWindow.Destroy;
  307. Begin
  308.   If Assigned(ModalCode) Then Begin
  309.     If Assigned(Parent) Then
  310.       EnableWindow(Parent^.hWindow,True); {enable Parent}
  311.     If ModalCode^=0 Then {terminate modal window if not already terminated}
  312.       ModalCode^:= id_Cancel
  313.   End;
  314.  
  315.   Inherited Destroy;
  316.   With DialogAttr Do Begin
  317.     If Assigned(FontName) Then
  318.       DeleteObject(Font);
  319.     If hEditBuffer<>0 Then
  320.       hEditBuffer:= GlobalFree(hEditBuffer)
  321.   End;
  322. End;
  323.  
  324. Procedure tDialogWindow.SetupWindow;
  325. Begin
  326.   StoreDMInfo;
  327.   SendMessage(hWindow,wm_SetFont,DialogAttr.Font,0);
  328.   If Not CreateDialogChildren Then
  329.     Status:= em_InvalidChild;
  330.   Inherited SetupWindow
  331. End;
  332.  
  333. Procedure tDialogWindow.wmPaint(Var Msg: tMessage);
  334. Var
  335.   PaintInfo: tPaintStruct;
  336.   aRect: tRect;
  337. Begin
  338.   PaintInfo.hDC:= GetDC(hWindow); {BeginPaint does not do the job}
  339.   GetClientRect(hWindow, PaintInfo.rcPaint);
  340.   If Assigned(Scroller) Then Scroller^.BeginView(PaintInfo.hDC, PaintInfo);
  341.   Paint(PaintInfo.hDC, PaintInfo);
  342.   If Assigned(Scroller) Then Scroller^.EndView;
  343.   ReleaseDC(hWindow, PaintInfo.hDC);
  344.   DefWndProc(Msg)
  345. End;
  346.  
  347. Function tDialogWindow.GetClassName: pChar;
  348. Begin
  349.   If Assigned(DialogAttr.ClassName) Then
  350.     GetClassName:= DialogAttr.ClassName
  351.   Else
  352.     GetClassName:= wc_Dialog
  353. End;
  354.  
  355. Procedure tDialogWindow.GetWindowClass (Var aWndClass: tWndClass);
  356. Begin
  357.   Inherited GetWindowClass(aWndClass);
  358.   aWndClass.cbWndExtra:= DlgWindowExtra
  359. End;
  360.  
  361. Procedure tDialogWindow.GetChildClass (Var aChildClass: tChildClass);
  362. {-change a childs window class. Standard windows behaviour is simulated here:
  363.   change special resource shortcuts (#$80..#$85) to their appropriate class names}
  364. Const
  365.   PreDefClasses: Array[#$80..#$85] Of pChar =
  366.     ('Button','Edit','Static','ListBox','ScrollBar','ComboBox');
  367. Begin
  368.   MangleChildClass(aChildClass);
  369.   With aChildClass Do
  370.     Case szClass[0] Of
  371.       #$80..#$85: StrCopy(szClass,PreDefClasses[szClass[0]])
  372.     End
  373. End;
  374.  
  375. Procedure tDialogWindow.MangleChildClass (Var aChildClass: tChildClass);
  376. Begin With aChildClass Do Begin
  377.   If DlgStyle And ForceBor<>0 Then Begin
  378.     If szClass[0]=#$80 Then
  379.       Case dwStyle And $F Of
  380.         bs_CheckBox,
  381.         bs_AutoCheckBox:        StrCopy(szClass,BorCheck);
  382.         bs_RadioButton..bs_Auto3State,
  383.         bs_AutoRadioButton:     StrCopy(szClass,BorRadio);
  384.         bs_GroupBox:            StrCopy(szClass,BorShade);
  385.       End
  386.   End Else
  387.   If DlgStyle And ForceStd<>0 Then Begin
  388.     If      (StrIComp(szClass,BorCheck)=0)
  389.     Or      (StrIComp(szClass,BorRadio)=0)
  390.     Or      (StrIComp(szClass,BorButton)=0) Then szClass[0]:= #$80
  391.     Else If (StrIComp(szClass,BorShade)=0)  Then
  392.       Case dwStyle And $F Of
  393.         bss_Group: Begin szClass[0]:= #$80; dwStyle:= (dwStyle And $FFFF0FF0) Or bs_GroupBox End;
  394.         bss_Hdip,
  395.         bss_Hbump,
  396.         bss_Vdip,
  397.         bss_Vbump: Begin szClass[0]:= #$82; dwStyle:= (dwStyle And $FFFFFFF0) Or ss_BlackRect End;
  398.       End
  399.   End
  400. End End;
  401.  
  402. Function tDialogWindow.CreateDialogChild ({Bp7.01: Const} Var aChildClass: tChildClass): hWnd;
  403. Var
  404.   aCtl: hWnd;
  405.   lpDlgItemInfo: Pointer;
  406.   Inst: tHandle;
  407. Begin
  408.   With DialogAttr, aChildClass Do Begin
  409.     If CtlDataSize=0 Then
  410.       lpDlgItemInfo:= Nil
  411.     Else
  412.       lpDlgItemInfo:= @CtlData;
  413.  
  414.     Inst:= System.hInstance;
  415.     If (Attr.Style And ds_LocalEdit=0) And (StrIComp(szClass, 'Edit')=0) Then Begin
  416.       If hEditBuffer=0 Then
  417.         AllocateEditBuffer;
  418.       If hEditBuffer<>0 Then
  419.         Inst:= hEditBuffer
  420.     End;
  421.  
  422.     If StrIComp(szClass,'VBControl')=0 Then
  423.       aCtl:= dVbx.CreateControl(hWindow, wId, szTitle, dwStyle,
  424.                                 DlgToClientX(wX,wUnitsX),  DlgToClientY(wY,wUnitsY),
  425.                                 DlgToClientX(wCX,wUnitsX), DlgToClientY(wCY,wUnitsY),
  426.                                 VbInfo)
  427.     Else Begin
  428.       aCtl:= CreateWindowEx(ws_Ex_NoParentNotify, szClass, szTitle, dwStyle,
  429.                             DlgToClientX(wX,wUnitsX),  DlgToClientY(wY,wUnitsY),
  430.                             DlgToClientX(wCX,wUnitsX), DlgToClientY(wCY,wUnitsY),
  431.                             hWindow, wID, Inst,
  432.                             lpDlgItemInfo);
  433.       If aCtl<>0 Then Begin
  434.         If Inst=hEditBuffer Then
  435.           SendMessage(aCtl, em_LimitText, 0, 0);
  436.         SendMessage(aCtl, wm_SetFont, Font, 0)
  437.       End
  438.     End;
  439. {$IfDef Debug}
  440.     If (aCtl=0) Or Not IsWindow(aCtl) Then
  441.       WriteLn('err DialogWn: CreateDialogChild failed! Class= ',
  442.               StrPasEx(szClass),' Title=', StrPasEx(szTitle));
  443. {$EndIf}
  444.     CreateDialogChild:= aCtl
  445.   End
  446. End;
  447.  
  448. Function tDialogWindow.CreateDialogChildren: Boolean;
  449. Var
  450.   i: Integer;
  451.   aPtr: pChar;
  452.   anItem: tChildClass;
  453.   aCtl: hWnd;
  454. Begin
  455.   CreateDialogChildren:= False;
  456.   aPtr:= DialogAttr.DlgItems;
  457.   With DialogAttr, anItem Do
  458.   For i:= 1 To DialogAttr.ItemCount Do Begin
  459.     {-copy fixed header and first byte of szClass}
  460.     Move(aPtr^,anItem,15); Inc(Word(aPtr),15);
  461.     Case szClass[0] Of
  462.       #$80..#$85: szClass[1]:= #0; {be safe}
  463.     Else
  464.       StrCopy(szClass+1, aPtr);       {copy rest of classname}
  465.       Inc(Word(aPtr),StrLen(aPtr)+1)
  466.     End;
  467.     If aPtr^=#255 Then Begin {fiddle with Caption as a number}
  468.       Str(pWord(aPtr+1)^, szTitle); {convert to '#xxx' form}
  469.       Move(szTitle[0], szTitle[1], StrLen(szTitle)+1);
  470.       szTitle[0]:= '#';
  471.       Inc(Word(aPtr), SizeOf(Byte)+SizeOf(Word))
  472.     End Else Begin
  473.       StrCopy(szTitle,aPtr);
  474.       Inc(Word(aPtr),StrLen(aPtr)+1)
  475.     End;
  476.     Move(aPtr^,CtlDataSize,Byte(aPtr^)+1);
  477.     Inc(Word(aPtr),CtlDataSize+1);
  478.     {-give descendants a chance to change child class}
  479.     GetChildClass(anItem);
  480.     aCtl:= CreateDialogChild(anItem);
  481.     If aCtl<>0 Then Begin
  482.       If (dwStyle And ws_TabStop<>0) And (FocusChildHandle=0) Then
  483.         FocusChildHandle:= aCtl; {set focus to first tab ctl}
  484.       If  (dwStyle And bs_DefPushButton<>0)
  485.       And (SendMessage(aCtl, wm_GetDlgCode, 0, 0) And DlgC_DefPushButton<>0) Then
  486.         DefId:= wId
  487.     End
  488.   End;
  489.  
  490.   {-subclass the dialog for Ctl3D}
  491.   If DlgStyle And EnableCtl3D<>0 Then
  492.     dCtl3D.SubClassDlgEx(hWindow, Ctl3DStyle);
  493.  
  494.   If (DefId=0) And (GetDlgItem(hWindow, 1)<>0) Then
  495.     DefId:= 1;  {Windows forces the Ok button to be the default button}
  496.   If DefId<>0 Then
  497.     SendMessage(GetDlgItem(hWindow, DefId), bm_SetStyle, bs_DefPushButton, 0); {so let the buttons style reflect this}
  498.   DialogAttr.DlgItems:= Nil; {no longer valid}
  499.   CreateDialogChildren:= True
  500. End;
  501.  
  502. Procedure tDialogWindow.GetDialogInfo (aPtr: Pointer);
  503. Begin
  504.   With Attr,DialogAttr Do Begin
  505.     Style:= LongInt(aPtr^);   Inc(Word(aPtr),SizeOf(LongInt));
  506.     ItemCount:= Byte(aPtr^);  Inc(Word(aPtr),SizeOf(Byte));
  507.     If Not IsFlagSet(wb_MdiChild) Then
  508.       X:= Integer(aPtr^);     Inc(Word(aPtr),SizeOf(Integer));
  509.     Y:= Integer(aPtr^);       Inc(Word(aPtr),SizeOf(Integer));
  510.     W:= Integer(aPtr^);       Inc(Word(aPtr),SizeOf(Integer));
  511.     H:= Integer(aPtr^);       Inc(Word(aPtr),SizeOf(Integer));
  512.     If Byte(aPtr^)=255 Then Begin
  513.       MenuName:= pChar(pWord(pChar(aPtr)+1)^); {<g>}
  514.       Inc(Word(aPtr), SizeOf(Byte)+SizeOf(Word))
  515.     End Else Begin
  516.       MenuName:= StrNew(aPtr);Inc(Word(aPtr),StrLen(aPtr)+1)
  517.     End;
  518.     ClassName:= StrNew(aPtr); Inc(Word(aPtr),StrLen(aPtr)+1);
  519.     Title:= StrNew(aPtr);     Inc(Word(aPtr),StrLen(aPtr)+1);
  520.     If Style And ds_SetFont>0 Then Begin
  521.       PointSize:= Integer(aPtr^); Inc(Word(aPtr),SizeOf(Integer));
  522.       FontName:= StrNew(aPtr); Inc(Word(aPtr),StrLen(aPtr)+1)
  523.     End Else Begin
  524.       PointSize:= 0;
  525.       FontName:= Nil
  526.     End;
  527.     If Style And ds_ModalFrame>0 Then
  528.       ExStyle:= ExStyle Or ws_Ex_DlgModalFrame;
  529.     DlgItems:= aPtr
  530.   End
  531. End;
  532.  
  533. Procedure tDialogWindow.StoreDMInfo;
  534. {store information in window extra words to be dialog manager compatible}
  535. Begin
  536.   SetWindowLong(hWindow, dwl_DlgProc, GetWindowLong(hWindow, gwl_WndProc)); {CTL3D compatible}
  537.   SetWindowWord(hWindow, dww_wUnitsX, DialogAttr.wUnitsX); {satisfy MapDialogRect}
  538.   SetWindowWord(hWindow, dww_wUnitsY, DialogAttr.wUnitsY); {satisfy MapDialogRect}
  539. End;
  540.  
  541. Procedure tDialogWindow.UpdateDialog;
  542. {-update and resize dialog window according to its style}
  543. Var
  544.   TheMDIClient: pMdiClient;
  545.   aRect: tRect;
  546. Begin With Attr, DialogAttr Do Begin
  547.   {-update style bits for MDI}
  548.   If isFlagSet(wb_MdiChild) Then Begin
  549.     TheMDIClient:= Parent^.GetClient;
  550.     {-check if the Client window has the MdiS_AllChildStyles bit set}
  551.     If (TheMDIClient=Nil)
  552.     Or (GetWindowLong(TheMDIClient^.hWindow, gwl_Style) And MdiS_AllChildStyles=0) Then
  553.       Style:= ws_MdiChild
  554.     Else
  555.       Style:= Style And ws_MdiAllowed Or ws_Child {reject disallowed styles}
  556.   End Else
  557.     If Style And (ws_PopUp+ws_ThickFrame)=ws_PopUp+ws_ThickFrame Then
  558.       ExStyle:= ExStyle And Not ws_Ex_DlgModalFrame; {correct Windows bug}
  559.   {-reject invisible modal window}
  560.   If Assigned(ModalCode) Then
  561.     Attr.Style:= Attr.Style Or ws_Visible;
  562.  
  563.   {-resize the window according to its style and size}
  564.   SetRect(aRect, 0, 0, DlgToClientX(w, wUnitsX), DlgToClientY(h, wUnitsY));
  565.   AdjustWindowRectEx(aRect, Style, Menu<>0, ExStyle);
  566.   w:= aRect.right-aRect.left;
  567.   h:= aRect.bottom-aRect.top;
  568.   ResW:= w;
  569.   ResH:= h
  570. End End;
  571.  
  572. Procedure tDialogWindow.MangleClass;
  573. Var
  574.   szClass: Array[0..63] Of Char;
  575.   ClassIsBorDlg: Boolean;
  576. Begin
  577.   {-if we can't find Ctl3D, disable it's usage}
  578.   If (DlgStyle And EnableCtl3D<>0) And Not dCtl3D.LibLink Then
  579.     DlgStyle:= DlgStyle And Not EnableCtl3D;
  580.   ClassIsBorDlg:= Assigned(DialogAttr.ClassName) And
  581.                   (StrLIComp(DialogAttr.ClassName, BorDialog, Length(BorDialog))=0);
  582.   If ClassIsBorDlg And (StrLIComp(DialogAttr.ClassName, BorDialogGray, Length(BorDialogGray))=0) Then
  583.     DlgStyle:= DlgStyle Or GrayBorDlg;
  584.  
  585.   {-load BWCC if the dialog needs to be a BorDlg}
  586.   If ClassIsBorDlg Or (DlgStyle And ForceBor<>0) Then
  587.     If Not dBWCC.LibLink Then {force std dialogs if BWCC can not be loaded}
  588.       DlgStyle:= DlgStyle Or ForceStd And Not ForceBor;
  589.   If DlgStyle And (ForceStd Or ForceBor)<>0 Then With DialogAttr Do Begin
  590.     If DlgStyle And ForceBor<>0 Then
  591.       StrCopy(szClass, BorDialog)
  592.     Else
  593.       szClass[0]:= #0;
  594.     If ClassIsBorDlg Then
  595.       StrCat(szClass, ClassName+Length(BorDialog))
  596.     Else
  597.       StrCat(szClass, ClassName);
  598.  
  599.     StrDispose(ClassName);
  600.     ClassName:= StrNew(szClass)
  601.   End;
  602.   IsBorDlg:= Assigned(DialogAttr.ClassName) And (StrLIComp(DialogAttr.ClassName, BorDialog, Length(BorDialog))=0)
  603. End;
  604.  
  605. Procedure tDialogWindow.SetWindowProcs;
  606. Begin
  607.   If IsBorDlg Then Begin
  608.     {-Class is of type BorDlg}
  609.     If IsFlagSet(wb_MDIChild) Then
  610.       DefaultProc:= @dBWCC.DefMdiChildProc
  611.     Else
  612.       DefaultProc:= @dBWCC.DefWindowProc;
  613.   End Else Begin
  614.     If IsFlagSet(wb_MDIChild) Then
  615.       DefaultProc:= @DefMdiChildProc
  616.     Else
  617.       DefaultProc:= @DefWindowProc;
  618.   End
  619. End;
  620.  
  621. Procedure tDialogWindow.CreateDialogFont;
  622. {-create the dialog font and calculate dialog units based on font}
  623. Const
  624.   aWidthString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  625. Var
  626.   aDC: hDC;
  627.   anOldFont: hFont;
  628.   aLogFont: tLogFont;
  629.   aTextMetric: tTextMetric;
  630. Begin With DialogAttr Do Begin
  631.   aDC:= GetDC(0);
  632.   If FontName=Nil Then
  633.     Font:= GetStockObject(System_Font)
  634.   Else Begin
  635.     FillChar(aLogFont,SizeOf(aLogFont),0);
  636.     With aLogFont Do Begin
  637.       StrCopy(lfFaceName,FontName);
  638.       lfHeight:= -MulDiv(DialogAttr.PointSize,GetDeviceCaps(aDC, LogPixelsY),72);
  639.       lfWeight:= FontWeight
  640.     End;
  641.     Font:= CreateFontIndirect(aLogFont)
  642.   End;
  643.   anOldFont:= SelectObject(aDC, Font);
  644.   GetTextMetrics(aDC, aTextMetric);
  645.   {-use the Microsoft recommended method to retrieve average width}
  646.   wUnitsX:= (Word(GetTextExtent(aDC, aWidthString, Length(aWidthString)))
  647.              Div (Length(aWidthString) Div 2) + 1) Div 2;
  648.   wUnitsY:= aTextMetric.tmHeight;
  649.   SelectObject(aDC, anOldFont);
  650.   ReleaseDC(0, aDC)
  651. End End;
  652.  
  653. Function tDialogWindow.RunModal: Integer;
  654. Var
  655.   aMsg: tMsg;
  656.   ReturnCode: Integer;
  657.   IdleParent: tHandle;
  658. Begin
  659.   ReturnCode:= 0;
  660.   ModalCode:= @ReturnCode;  {Trick OWL}
  661.   SetFlags(wb_MDIChild, False);
  662.   Create;
  663.  
  664.   If Status<>0 Then Begin
  665.     RunModal:= Status;
  666.     Exit
  667.   End;
  668.  
  669.   If Attr.Style And ds_SysModal>0 Then
  670.     SetSysModalWindow(hWindow); {support SysModal dialogs as well}
  671.   If Attr.Style And ds_NoIdleMsg>0 Then
  672.     IdleParent:= 0
  673.   Else
  674.     IdleParent:= GetParent(hWindow);
  675.   Repeat
  676.     If PeekMessage(aMsg, 0, 0, 0, pm_Remove) Then Begin
  677.       If IdleParent<>0 Then
  678.         SendMessage(IdleParent, wm_EnterIdle, MsgF_DialogBox, hWindow);
  679.       If Not Application^.ProcessDlgMsg(aMsg) Then Begin
  680.         TranslateMessage(aMsg);
  681.         DispatchMessage(aMsg)
  682.       End
  683.     End
  684.   Until ReturnCode<>0; {until window is no longer modal}
  685.   CloseWindow;
  686.   RunModal:= ReturnCode
  687. End;
  688.  
  689. Function tDialogWindow.IsModal: Boolean;
  690. Begin
  691.   IsModal:= Assigned(ModalCode)
  692. End;
  693.  
  694. Procedure tDialogWindow.EndDlg (aRetValue: Integer);
  695. Begin
  696.   If Assigned(ModalCode) Then {set return code if it's a modal window}
  697.     ModalCode^:= aRetValue
  698.   Else
  699.     CloseWindow
  700. End;
  701.  
  702. Function tDialogWindow.GetItemHandle (DlgItemID: Integer): hWnd;
  703. Begin
  704.   GetItemHandle:= GetDlgItem(hWindow, DlgItemID)
  705. End;
  706.  
  707. Function tDialogWindow.SendDlgItemMsg (DlgItemID: Integer; aMsg, wParam: Word; lParam: LongInt): LongInt;
  708. Begin
  709.   SendDlgItemMsg:= SendDlgItemMessage(hWindow, DlgItemID, AMsg, WParam, LParam)
  710. End;
  711.  
  712. Procedure tDialogWindow.Ok (Var Msg: tMessage);
  713. Begin
  714.   If Not Assigned(ModalCode) Then
  715.     CloseWindow
  716.   Else
  717.     If CanClose Then Begin
  718.       TransferData(tf_GetData);
  719.       EndDlg(id_Ok)
  720.     End
  721. End;
  722.  
  723. Procedure tDialogWindow.Cancel (Var Msg: tMessage);
  724. Begin
  725.   EndDlg(id_Cancel)
  726. End;
  727.  
  728. Procedure tDialogWindow.wmClose (Var Msg:  tMessage);
  729. Begin
  730.   EndDlg(id_Cancel)
  731. End;
  732.  
  733. Procedure tDialogWindow.wmQueryEndSession (Var Msg: tMessage);
  734. Begin
  735.   If Assigned(ModalCode) Then
  736.     If @Self=Application^.MainWindow Then
  737.       Msg.Result:= Integer(Not Application^.CanClose)
  738.     Else
  739.       Msg.Result:= Integer(Not CanClose)
  740.   Else
  741.     Inherited wmQueryEndSession(Msg)
  742. End;
  743.  
  744. Procedure tDialogWindow.wmSize (Var Msg: tMessage);
  745. Begin
  746.   Inherited wmSize(Msg);
  747.   If Assigned(Scroller) Then With Scroller^ Do Begin
  748.     AutoOrg:= Msg.wParam<>sizeIconic;
  749.     If AutoOrg Then Begin
  750.       With DialogAttr, Attr Do
  751.         SetRange(ResW-W, ResH-H);
  752.       ScrollTo(0, 0);
  753.       InvalidateRect(hWindow, Nil, True)
  754.     End
  755.   End
  756. End;
  757.  
  758. Procedure tDialogWindow.wmLButtonDown (Var Msg: tMessage);
  759. Begin
  760.   HideComboListBox;
  761.   Inherited wmLButtonDown(Msg)
  762. End;
  763.  
  764. Procedure tDialogWindow.wmNcLButtonDown (Var Msg: tMessage);
  765. Begin
  766.   HideComboListBox;
  767.   {$IfDef Custom} Inherited wmNcLButtonDown(Msg) {$Else} DefWndProc(Msg) {$EndIf}
  768. End;
  769.  
  770. Procedure tDialogWindow.wmEnterMenuLoop (Var Msg: tMessage);
  771. Begin
  772.   HideComboListBox;
  773.   DefWndProc(Msg)
  774. End;
  775.  
  776. Procedure tDialogWindow.wmActivate (Var Msg: tMessage);
  777. Begin
  778.   Inherited wmActivate(Msg);
  779.   If Msg.wParam<>0 Then
  780.     InvalidateRect(hWindow, Nil, True);
  781.  
  782.   {-this fixes an OWL bug when the last MDI child is closed}
  783.   If (Msg.wParam=0) And (Application^.kbHandlerWnd=@Self) Then
  784.     Application^.SetKBHandler(Nil)
  785. End;
  786.  
  787. Procedure tDialogWindow.HideComboListBox;
  788. Begin
  789.   SendMessage(FocusChildHandle, cb_ShowDropDown, 0, 0);
  790. End;
  791.  
  792. Procedure tDialogWindow.wmNextDlgCtl (Var Msg: tMessage);
  793. Var
  794.   OldFocus, NewFocus: hWnd;
  795. Begin
  796.   OldFocus:= FocusChildHandle;
  797.   If Msg.lParamLo=0 Then Begin
  798.     If OldFocus=0 Then Begin
  799.       {-set focus to the first tab item}
  800.       NewFocus:= 0;
  801.       OldFocus:= hWindow
  802.     End Else
  803.       If IsChild(hWindow, OldFocus) Then
  804.         NewFocus:= GetNextDlgTabItem(hWindow, OldFocus, WordBool(Msg.wParam))
  805.       Else
  806.         Exit {ignore message if current focus is not a dialog ctl}
  807.   End Else Begin
  808.     If OldFocus=0 Then
  809.       OldFocus:= hWindow;
  810.     NewFocus:= Msg.wParam
  811.   End;
  812.   FocusChildHandle:= NewFocus;
  813.   FocusChild;
  814.   Msg.Result:= 0
  815. End;
  816.  
  817. Procedure tDialogWindow.dmGetDefId (Var Msg: tMessage);
  818. Begin
  819.   If DefId=0 Then
  820.     Msg.Result:= 0
  821.   Else Begin
  822.     Msg.ResultLo:= DefId;
  823.     Msg.ResultHi:= dc_HasDefId
  824.   End
  825. End;
  826.  
  827. Procedure tDialogWindow.wmSetFocus (Var Msg: tMessage);
  828. Begin
  829.   If IsFlagSet(wb_KBHandler) And Not IsIconic(hWindow) Then Begin
  830.     Application^.SetKBHandler(@Self);
  831.     FocusChild;
  832.   End Else
  833.     Application^.SetKBHandler(Nil);
  834.   Msg.Result:= 0
  835. End;
  836.  
  837. Procedure tDialogWindow.wmCtlColor (Var Msg: tMessage);
  838. Begin
  839.   If DlgStyle And EnableCtl3D<>0 Then With Msg Do Begin
  840.     Result:= dCtl3D.CtlColorEx(Message, wParam, lParam);
  841.     If Result<>0 Then
  842.       Exit
  843.   End;
  844.   DefWndProc(Msg)
  845. End;
  846.  
  847. Procedure tDialogWindow.wmEraseBkGnd (Var Msg: tMessage);
  848. Var
  849.   aBrush,
  850.   OldBrush: hBrush;
  851.   aRect: tRect;
  852. Begin
  853.   aBrush:= 0;
  854.   If Not IsBorDlg And (DlgStyle And EnableCtl3D<>0) Then
  855.     With Msg Do
  856.       aBrush:= dCtl3D.CtlColorEx(CtlColor_Dlg, wParam, MakeLong(0, CtlColor_Dlg));
  857.   If DlgStyle And (ForceGrayBk Or GrayBorDlg)<>0 Then
  858.     aBrush:= GetStockObject(LtGray_Brush);
  859.   If aBrush<>0 Then Begin
  860.     UnrealizeObject(aBrush);
  861.     OldBrush:= SelectObject(Msg.wParam, aBrush);
  862.     GetClientRect(hWindow, aRect);
  863.     With aRect Do PatBlt(Msg.wParam, left, top, right-left, bottom-top, PatCopy);
  864.     SelectObject(Msg.wParam, OldBrush);
  865.     Msg.Result:= 1
  866.   End Else
  867.     DefWndProc(Msg)
  868. End;
  869.  
  870. Procedure tDialogWindow.wmTrackFocus (Var Msg: tMessage);
  871. Var
  872.   aRect,
  873.   ClientRect: tRect;
  874.   dX, dY: Integer;
  875. Begin
  876.   FocusChildHandle:= Msg.wParam;
  877.   If Not IsIconic(hWindow) And Assigned(Scroller) And Scroller^.AutoMode Then Begin
  878.     GetWindowRect(FocusChildHandle, aRect);
  879.     GetClientRect(hWindow, ClientRect);
  880.     MapWindowPoints(0, hWindow, aRect, 2); {Screen->hWindow}
  881.     With aRect, Scroller^ Do {test if control is outside the client area}
  882.       If (left<0) Or (right>ClientRect.right)
  883.       Or (top<0)  Or (bottom>ClientRect.bottom) Then Begin
  884.         {-try to center the control in the client area}
  885.         dX:= (ClientRect.right-(right-left)) Div 2; If dX<0 Then dX:= 0;
  886.         dY:= (ClientRect.bottom-(bottom-top)) Div 2; If dY<0 Then dY:= 0;
  887.         ScrollTo((left-dX+XPos*XUnit) Div XUnit, (top-dY+YPos*YUnit) Div YUnit)
  888.       End
  889.   End
  890. End;
  891.  
  892. Procedure tDialogWindow.wmVbxFireEvent (Var Msg: tMessage);
  893. Begin
  894.   If Not EventPerform(@Self, pVbxEvent(Msg.lParam)^, id_First+pVbxEvent(Msg.lParam)^.Id) Then
  895.     DefaultEventProc(pVbxEvent(Msg.lParam)^);
  896.   Msg.Result:= 0
  897. End;
  898.  
  899. Procedure tDialogWindow.DefaultEventProc (Var Event: tVbxEvent);
  900. Begin
  901.   With Event Do If GetObjectPtr(Window)<>Nil Then {route to object}
  902.     SendMessage(Window, wm_VbxFireEvent, 0, LongInt(@Event))
  903. End;
  904.  
  905. Function ExecDialogWindow (aDialogWindow: pDialogWindow): Integer;
  906. Var
  907.   ExecReturn: Integer;
  908. Begin
  909.   ExecDialogWindow:= id_Cancel;
  910.   If Application^.ValidWindow(aDialogWindow)<>Nil Then Begin
  911.     ExecReturn:= aDialogWindow^.RunModal;
  912.     If ExecReturn<0 Then
  913.       Application^.Error(ExecReturn)
  914.     Else
  915.       ExecDialogWindow:= ExecReturn
  916.   End
  917. End;
  918.  
  919. Function tAdvApplication.ProcessDlgMsg (Var Message: tMsg): Boolean;
  920. Var
  921.   hKbdWnd,
  922.   hFocus: tHandle;
  923. Begin
  924.   ProcessDlgMsg:= False;
  925.  
  926.   If KBHandlerWnd=Nil Then Exit;
  927.   hKbdWnd:= KBHandlerWnd^.hWindow;
  928.   If hKbdWnd=0 Then Exit;
  929.  
  930.   If Not IsDialogMessage(hKbdWnd, Message) Then Exit;
  931.  
  932.   ProcessDlgMsg:= True;
  933.   If IsWindow(hKbdWnd) And Not IsIconic(hKbdWnd) Then Begin
  934.     hFocus:= GetFocus;
  935.  
  936.     If IsChild(hKbdWnd, hFocus)
  937.     And (pWindow(KBHandlerWnd)^.FocusChildHandle<>hFocus) Then
  938.       SendMessage(hKbdWnd, wm_TrackFocus, hFocus, 0)
  939.   End
  940. End;
  941.  
  942. Function tAdvApplication.ProcessAppMsg (Var Message: tMsg): Boolean;
  943. Const
  944.   MdiTest: (NotTested, IsMdi, IsNotMdi) = NotTested;
  945. Begin
  946.   If (MdiTest=NotTested) And Assigned(MainWindow) Then
  947.     If MainWindow^.GetClient=Nil Then
  948.       MdiTest:= IsNotMdi
  949.     Else
  950.       MdiTest:= IsMdi;
  951.   If MdiTest=IsMdi Then
  952.     ProcessAppMsg:= ProcessMDIAccels(Message)
  953.                  Or ProcessAccels(Message)
  954.                  Or ProcessDlgMsg(Message)
  955.   Else
  956.     ProcessAppMsg:= ProcessDlgMsg(Message)
  957.                  Or ProcessMDIAccels(Message)
  958.                  Or ProcessAccels(Message)
  959. End;
  960.  
  961. Procedure tAdvMdiWindow.wmActivate (Var Msg: tMessage);
  962. Var
  963.   TopWnd: hWnd;
  964. Begin
  965.   Inherited wmActivate(Msg);
  966.   If (Msg.wParam<>0) And Assigned(ClientWnd) Then Begin
  967.     TopWnd:= LoWord(SendMessage(ClientWnd^.hWindow, wm_MdiGetActive, 0, 0));
  968.     If TopWnd<>0 Then
  969.       SendMessage(TopWnd, wm_Activate, wa_Active, 0)
  970.   End
  971. End;
  972.  
  973. End.
  974.