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

Pascal/Delphi Source File | 1992-07-26 | 5.2 KB | 166 lines

Unit JanusWn;
{ Unit:      JanusWn
  Version:   1.00
  Purpose:   tJanusDialogWindow is a descendant of tDialogWindow that
             is able to create a (modeless) BorDlg from a standard resource
             and vice versa.
  Features:  - no wObjectB is needed
             - let the user decide at runtime whether to use BorDlgs or
               standard dialogs
  Bonus:     national language support for BorButtons: if you intend to
             have for example a german version of Borlands "&No" button
             in your program, it's that simple: just put a "&Nein"
             BorButton with id 7 in your resource and tJanusDialogWindow
             automatically loads the bitmaps for you.
  Date:      22.4.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.
}
Interface
Uses
  WinTypes,
  WObjects,
  DialogWn;
Type
  pJanusDialogWindow = ^tJanusDialogWindow;
  tJanusDialogWindow = Object(tDialogWindow)
    useBWCC: Boolean;
    Constructor Init (aParent: pWindowsObject; aName: pChar; BorStyle: Boolean);
    Procedure SetClassName; Virtual;
    Procedure GetChildClass (Var aChildClass: tChildClass); Virtual;
    Function CreateDialogChild (Var aChildClass: tChildClass): hWnd; Virtual;
  End;

Implementation
Uses
  WinProcs,
  Strings;

Const
  BorDialog = 'BorDlg';
  BorButton = 'BorBtn';
  BorRadio  = 'BorRadio';
  BorStatic = 'BorStatic';
  BorCheck  = 'BorCheck';
  BorShade  = 'BorShade';

  bss_Group = 1; {group box}
  bss_Hdip  = 2; {horizontal border}
  bss_Vdip  = 3; {hertical border}
  bss_Hbump = 4; {horizontal speed bump}
  bss_Vbump = 5; {vertical speed bump}

Const
  BWCCInst: tHandle = tHandle(0);

Function LoadBWCC: Boolean;
Var
  aWndClass: tWndClass;
Begin
  If BWCCInst=0 Then Begin
    BWCCInst:= LoadLibrary('BWCC.DLL');
    If BWCCInst<32 Then Begin
      LoadBWCC:= False;
      BWCCInst:= 0;
      Exit
    End
  End;
  LoadBWCC:= GetClassInfo(System.hInstance,BorStatic,aWndClass)
End;

Constructor tJanusDialogWindow.Init (aParent: pWindowsObject; aName: pChar; BorStyle: Boolean);
Begin
  useBWCC:= BorStyle And LoadBWCC;
  tDialogWindow.Init(aParent, aName);
  If useBWCC Then
    If IsFlagSet(wb_MDIChild) Then
      DefaultProc:= GetProcAddress(BWCCInst,'BWCCDefMdiChildProc')
    Else
      DefaultProc:= GetProcAddress(BWCCInst,'BWCCDefWindowProc')
End;

Procedure tJanusDialogWindow.SetClassName;
Var
  pureClassName,
  tempClassName : Array[0..127] Of Char;
Begin
  tDialogWindow.SetClassName;
  With DialogAttr Do Begin
    If ClassName=Nil Then
      pureClassName[0]:= #0
    Else Begin
      If StrLIComp(ClassName,BorDialog,Length(BorDialog))=0 Then
        StrCopy(pureClassName,ClassName+Length(BorDialog)) {extract without 'BorDlg'}
      Else
        StrCopy(pureClassName,ClassName);
      StrDispose(ClassName)
    End;
    If useBWCC Then
      ClassName:= StrNew(StrCat(StrCopy(tempClassName,BorDialog),pureClassName))
    Else
      ClassName:= StrNew(pureClassName)
  End
End;

Procedure tJanusDialogWindow.GetChildClass (Var aChildClass: tChildClass);
Begin With aChildClass Do
  If useBWCC Then
    Case szClass[0] Of
      #$80: Case dwStyle And $F Of
              bs_CheckBox,
              bs_AutoCheckBox:        StrCopy(szClass,BorCheck);
              bs_RadioButton..bs_Auto3State,
              bs_AutoRadioButton:     StrCopy(szClass,BorRadio);
              bs_GroupBox:            StrCopy(szClass,BorShade);
            Else
              StrCopy(szClass,BorButton)
            End;
      #$82: StrCopy(szClass,BorStatic);
    Else
      tDialogWindow.GetChildClass(aChildClass)
    End
  Else
    If      (StrIComp(szClass,BorCheck)=0)
    Or      (StrIComp(szClass,BorRadio)=0)
    Or      (StrIComp(szClass,BorButton)=0) Then szClass[0]:= #$80
    Else If (StrIComp(szClass,BorStatic)=0) Then szClass[0]:= #$82
    Else If (StrIComp(szClass,BorShade)=0)  Then
      Case dwStyle And $F Of
        bss_Group: Begin szClass[0]:= #$80; dwStyle:= dwStyle And $FFFFFFF0 Or bs_GroupBox End;
        bss_Hdip,
        bss_Hbump,
        bss_Vdip,
        bss_Vbump: Begin szClass[0]:= #$82; dwStyle:= dwStyle And $FFFFFFF0 Or ss_BlackRect End;
      End;
    tDialogWindow.GetChildClass(aChildClass)
End;

Function tJanusDialogWindow.CreateDialogChild (Var aChildClass: tChildClass): hWnd;
Var
  aCtl: hWnd;
  BitHandle: array[0..2] of hBitmap;
Const
  bbm_SetBits = (BM_SETSTYLE+10);
Begin
  aCtl:= tDialogWindow.CreateDialogChild(aChildClass);
  If (aCtl<>0) And useBWCC Then Begin
    BitHandle[0] := LoadBitmap(hInstance,pChar(1000+aChildClass.wID)); { Normal }
    If BitHandle[0]<>0 Then Begin
      BitHandle[1] := LoadBitmap(hInstance,pChar(3000+aChildClass.wID)); { Pressed }
      BitHandle[2] := LoadBitmap(hInstance,pChar(5000+aChildClass.wID)); { Selected }
      If BitHandle[2]=0 Then BitHandle[2]:= BitHandle[0];
      If BitHandle[1]=0 Then BitHandle[1]:= BitHandle[2];
      SendMessage(aCtl,BBM_SETBITS,0,Longint(@BitHandle));
      SetWindowText(aCtl,Nil)
    End
  End;
  CreateDialogChild:= aCtl
End;
End.