Power-Programmierung/CD1.mdf/pascal/library/windows/januswn/dialogwn.pas

Pascal/Delphi Source File | 1992-07-26 | 11.4 KB | 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:   [e-mail]
                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.