DimWindows Clarion Class

DimWindows.clw

   MEMBER()
   INCLUDE('DimWindows.inc'),ONCE
 
! --- the following equates are normally in their own includes, but I decided to flatten the code here to just the one module
LevelType         EQUATE(BYTE)

Register:Continue EQUATE(0)
Register:Break    EQUATE(3)
Register:Cycle    EQUATE(5)


   MAP
    HookOpen (*WINDOW xWin)
    HookClose(*WINDOW xWin)
    TakeFocus (LONG xWinAddress),LevelType

    MODULE('APIs')
      Win32:GetSysColor(signed nIndex),long,pascal,NAME('GetSysColor')
      Win32:GetWindowLong(LONG hWnd, SIGNED nIndex                ),LONG,PASCAL,NAME('GetWindowLongA')
      Win32:SetWindowLong(LONG hWnd, SIGNED nIndex, LONG dwNewLong),LONG,PASCAL,PROC,NAME('SetWindowLongA')
      !https://docs.microsoft.com/en-us/windows/win32/winmsg/window-features#layered-windows
      Win32:SetLayeredWindowAttributes(LONG _Hwnd, LONG crKey, BYTE bAlpha, LONG dwFlags ),BOOL,PASCAL,PROC,NAME('SetLayeredWindowAttributes') !crKEY is a ColorRef which is a LONG with 0x00bbggrr (alpha must always be 0)
    
	  !Win32:GetLastError(),LONG,PASCAL,NAME('GetLastError')
      !Win32:FormatMessage(DWORD    dwFlags, LPCVOID  lpSource, DWORD    dwMessageID, DWORD    dwLanguageID,|
      !             *CSTRING lpBuffer, DWORD    nSize, *CSTRING Arguments),DWORD,PASCAL,RAW,DLL,NAME('FormatMessageA')

    END

   END


Hide:ODS       EQUATE(TRUE)                 ! for use with a Debuger class, which uses AssertHook2 to make OutputDebugString calls
eqDBG          EQUATE('<4,2,7>') !  D B G - ! for use with a Debuger class, which uses AssertHook2 to make OutputDebugString calls

MOD:DimWindows &DimWindows

!===========================================================
HookOpen PROCEDURE(WINDOW xWin)
   CODE 
   IF MOD:DimWIndows &= NULL 
      SYSTEM{PROP:OpenWindowHook} = 0                    
      OPEN(xWin)
      SYSTEM{PROP:OpenWindowHook} = ADDRESS(HookOpen)
   ELSE 
      MOD:DimWindows.Open(xWin)
   END 

!===========================================================
! no need as we don't need any properties from DimWindows ! HookClose PROCEDURE(WINDOW xWin)
! no need as we don't need any properties from DimWindows !    CODE 
! no need as we don't need any properties from DimWindows !   IF MOD:DimWIndows &= NULL 
! no need as we don't need any properties from DimWindows !      SYSTEM{PROP:CloseWindowHook} = 0                    
! no need as we don't need any properties from DimWindows !      Close(xWin)
! no need as we don't need any properties from DimWindows !      SYSTEM{PROP:CloseWindowHook} = ADDRESS(HookClose)
! no need as we don't need any properties from DimWindows !   ELSE 
! no need as we don't need any properties from DimWindows !      MOD:DimWIndows.Close(xWin)
! no need as we don't need any properties from DimWindows !   END 

!=======================================================================
HookClose           PROCEDURE(WINDOW xWin)
DimFEQ    SIGNED,AUTO
TargetWin &Window
   CODE 
                                                      Assert(Hide:ODS,eqDBG & 'HookClose  Closing Title['& xWin{PROP:Text} & '] DimFEQ['& xWin{'DimFEQ'} &']') ! OrigStyle['& xWin{'OrigStyle'} &']')
   SYSTEM{PROP:CloseWindowHook} = 0 
   CLOSE(xWin)
   SYSTEM{PROP:CloseWindowHook} = ADDRESS(HookClose)

   
   TargetWin &= SYSTEM{PROP:Target}
                                                      Assert(Hide:ODS,eqDBG & 'HookClose  Returning to Title['& TargetWin{PROP:Text} & '] DimFEQ['& TargetWin{'DimFEQ'} &']') !' OrigStyle['& TargetWin{'OrigStyle'} &']')
   IF TargetWin{'DimFEQ'} <> ''
                                                      Assert(Hide:ODS,eqDBG & 'HookClose  Cleaning up')
      DESTROY(TargetWin{'DimFEQ'})
      TargetWin{'DimFEQ'}  = ''  ! I thought about just hiding the control, but thought that might be bad as some windows logic might unintentionally unhide it.
   END 


!=======================================================================
TakeFocus PROCEDURE(LONG xWinAddress)!,LevelType
TargetWin &Window

  CODE 
  TargetWin &= ( xWinAddress )
                                                      !Assert(Hide:ODS,eqDBG & 'TakeFocus, for window xWinAddress['& xWinAddress &']')
                                                       Assert(Hide:ODS,eqDBG & 'TakeFocus, for window title['& TargetWin{PROP:Text} &']')
  TargetWin{PROP:Active}=TRUE

  RETURN Register:Continue


!===========================================================
!===========================================================
!===========================================================
!===========================================================
DimWindows.CONSTRUCT      PROCEDURE()
   CODE
   MOD:DimWIndows &= SELF

!   SELF.ShouldCorrectTakeFocus = FALSE 
   SELF.DimBy                  = 96
   SELF.Color                  = COLOR:Black
   SELF.Frame                 &= NULL

   SYSTEM{PROP:OpenWindowHook } = ADDRESS(HookOpen)   
   SYSTEM{PROP:CloseWindowHook} = ADDRESS(HookClose)

	                                            ASSERT(Hide:ODS, eqDBG & 'DimWindows.Construct')
	                                

!===========================================================
DimWindows.DESTRUCT       PROCEDURE()
   CODE
   MOD:DimWIndows &= NULL

!===========================================================
DimWindows.Open PROCEDURE(WINDOW xWin)
  CODE
                                                                          ASSERT(Hide:ODS,eqDBG & 'v HookOpen xWin   X['& xWin{PROP:XPOS} &'] Y['& xWin{PROP:YPOS} &'] W['& xWin{PROP:Width} &'] H['& xWin{PROP:Height} &'] DimBy['& SELF.DimBy &']') 
  IF SELF.ShouldDimWindow()
     SELF.DimCallingWindow()
  END 
	
  IF SELF.Frame &= NULL                                                          
     SYSTEM{PROP:OpenWindowHook} = 0                    
     OPEN(xWin)
     SYSTEM{PROP:OpenWindowHook } = ADDRESS(HookOpen)   

     IF xWin{PROP:Type} = CREATE:application            
        SELF.Frame &= xWin
     END 
		
  ELSE 
     OPEN(xWin, SELF.Frame)  ! this two parameter Open(Win,Owner) is not affected by OpenWindowHook
  END
                                                                        ASSERT(Hide:ODS,eqDBG & '^ HookOpen xWin Type['& xWin{PROP:Type} &'] Opened Title['& xWin{PROP:Text} &'] X['& xWin{PROP:XPOS} &'] Y['& xWin{PROP:YPOS} &'] W['& xWin{PROP:Width} &'] H['& xWin{PROP:Height} &']') 

!===========================================================
DimWindows.ShouldDimWindow PROCEDURE()
TargetWin   &Window
   CODE 
   TargetWin &= SYSTEM{PROP:Target}
                                                                       Assert(Hide:ODS,eqDBG & '  HookOpen, TargetWin Title['& TargetWin{Prop:Text} &'] X['& TargetWin{PROP:XPOS} &'] Y['& TargetWin{PROP:YPOS} &'] W['& TargetWin{PROP:Width} &'] H['& TargetWin{PROP:Height} &']')

   RETURN CHOOSE(         SELF.DimBy            <> 0         | 
                  AND     THREAD()              <> 1         |   ! There are several windows with no title, and X,Y,W,H = 0,0,1,1  I haven't found another way to suppress them from getting past the early exist of  HookOpen:DimWindowOnSameThread
                  AND(NOT TargetWin             &= NULL     )| 
                  AND     STATUS(TargetWin)      = Window:OK | 
                  AND     TargetWin{PROP:Thread} = THREAD()  |    
                  AND     TargetWin{PROP:Hide}   = FALSE     |
                | AND NOT TargetWin{'DimWin:Skip'} 
                )                                                    

!===========================================================
DimWindows.DimCallingWindow  PROCEDURE()
DimFEQ      SIGNED,AUTO
 CODE 
                                                                      Assert(Hide:ODS,eqDBG & '  DimCallingWindow')
  DimFEQ            = CREATE(0, CREATE:Region )

  IF DimFEQ <> 0
     DimFEQ{PROP:Fill} = SELF.Color
     SETPOSITION( DimFEQ, 0, 0, 0{PROP:Width}, 0{PROP:Height})
   
     IF NOT SELF.MakeTransparent( DimFEQ{PROP:Handle}, SELF.DimBy)
                                                                         Assert(Hide:ODS,eqDBG& '   DimCallingWindow Make Transparent Failed')
        DESTROY(DimFEQ)		
     ELSE
   	 DimFEQ{PROP:Hide}   = FALSE  
        0{'DimFEQ'} = DimFEQ  ! Save the DimFEQ as a user property, used by HookClose
     END 
   END 
                                                                      Assert(Hide:ODS,eqDBG & '  DimCallingWindow DimFEQ['& DimFEQ &'] ')




!========================================================================================  
DimWindows.MakeTransparent PROCEDURE(LONG xHWND, BYTE xbAlpha)!,LONG,PROC
NewStyle    LONG,AUTO
OrigStyle   LONG,AUTO
APISuccess  LONG,AUTO

GWL_EXSTYLE  EQUATE(-20) 

!https://docs.microsoft.com/en-us/windows/win32/winmsg/extended-window-styles
WS_EX_LAYERED EQUATE(00080000h) ! The window is a layered window. 
                                ! This style cannot be used if the window has a class style of either CS_OWNDC or CS_CLASSDC.
                                ! Windows 8: The WS_EX_LAYERED style is supported for top-level windows and child windows. 
                                ! Previous Windows versions support WS_EX_LAYERED only for top-level windows.
                                ! MG: I think this will REQUIRE a manifest specifying >= Win8 Compatability 
                                !     https://stackoverflow.com/questions/42569348/how-to-use-ws-ex-layered-on-child-controls

!LWA_COLORKEY EQUATE(1)
LWA_ALPHA    EQUATE(2)

  CODE 
  OrigStyle = Win32:GetWindowLong( xHWND, GWL_EXSTYLE)
  NewStyle  = BOR( OrigStyle, WS_EX_LAYERED) ! add WS_EX_LAYERED 

     APISuccess = Win32:SetWindowLong(xHWND, GWL_EXSTYLE, NewStyle) ! requires Win8+ non-top level windows
  IF APISuccess = 0
		Assert(Hide:ODS,eqDBG & 'Win32:SetWindowLong(xHWND, GWL_EXSTYLE, NewStyle) - FAILED')
		! should call Win32:GetLastError()
  ELSE 
	     APISuccess = Win32:SetLayeredWindowAttributes( xHWND, 0, xbAlpha, LWA_ALPHA ) ! 0 is a color, but it doesn't seem to be used, given the LWA_ALPHA value
	 IF ~APISuccess
  		Assert(Hide:ODS,eqDBG & 'Win32:SetLayeredWindowAttributes( xHWND, 0, xbAlpha, LWA_ALPHA ) - FAILED')
     END 
  END

  RETURN APISuccess


!   
!DimWindows.GetLastErrorDescription PROCEDURE(DWORD dwMessageID)
!
!FORMAT_MESSAGE_MAX_WIDTH_MASK   EQUATE(0000000FFh) !1..FE => max # of characters in a line
!FORMAT_MESSAGE_ALLOCATE_BUFFER  EQUATE(000000100h)
!FORMAT_MESSAGE_IGNORE_INSERTS   EQUATE(000000200h)
!FORMAT_MESSAGE_FROM_STRING      EQUATE(000000400h)
!FORMAT_MESSAGE_FROM_HMODULE     EQUATE(000000800h)
!FORMAT_MESSAGE_FROM_SYSTEM      EQUATE(000001000h)
!FORMAT_MESSAGE_ARGUMENT_ARRAY   EQUATE(000002000h)
!
!FigureOutLanguageID             EQUATE(0)
!
!ErrCode             DWORD
!dwFlags             DWORD
!szBuffer            CSTRING(8192) !HACK: <-- arbitrary limitation, should use FORMAT_MESSAGE_ALLOCATE_BUFFER and LocalFree() instead
!CharsSetInBuffer    DWORD
!Arguments           CSTRING(2)
!
!  CODE  
!  IF dwMessageID = 0 !<-- no error !TODO
!     RETURN ''
!  END
!  
!  dwFlags = FORMAT_MESSAGE_FROM_SYSTEM    + |
!            FORMAT_MESSAGE_IGNORE_INSERTS + |
!            FORMAT_MESSAGE_MAX_WIDTH_MASK
!  
!                                                      !ASSERT(SELF.HideODS,eqDBG&'FormatMessage, dwMessageID['& dwMessageID &']')
!  CharsSetInBuffer = Win32:FormatMessage(dwFlags, 0, dwMessageID, FigureOutLanguageID, szBuffer, SIZE(szBuffer), Arguments)
!                                                      !ASSERT(SELF.HideODS,eqDBG&'FormatMessage, dwMessageID['& dwMessageID &']=['& SUB(szBuffer, 1, CharsSetInBuffer) &']')
!  RETURN SUB(szBuffer, 1, CharsSetInBuffer - 1)
!

DimWIndows.inc

DimWindows          CLASS,TYPE,MODULE('DimWindows.clw'),LINK('DimWindows.clw')
DimBy                  BYTE ! a transparency level (aka ALPHA) 0--255:  0 - off, 1 - too transprent to notice, 255 - opaque
Color                  LONG 
Frame                  &WINDOW
!------------------------
CONSTRUCT              PROCEDURE()
DESTRUCT               PROCEDURE()
Open                   PROCEDURE(*WINDOW xWin)
ShouldDimWindow        PROCEDURE(),BOOL
DimCallingWindow       PROCEDURE()
MakeTransparent        PROCEDURE(LONG xHWND, BYTE xAlpha),LONG,PROC ! xAlpha 0-255 0 Transparent, 255 Opaqe
                     END