Transparent Clock

Date: 02-16-2022

Return to Index

 
'Compilable Example:  (Jose Includes)
#Compile Exe
#Dim All
%Unicode=1
#Include "win32api.inc"
 
Enum Equates Singular
   %IDC_Graphic = 500
End Enum
 
Global hDlg,hRgn,hGraphic As Dword, Transparency, OldProc As Long
 
Function PBMain () As Long
   Dialog New Pixels, 0, " ",300,300,400,400, %WS_OverlappedWindow, %WS_Ex_Layered To hDlg
   Control Add Graphic, hDlg, %IDC_Graphic,"", 0,0,128,128
   Control Handle hDlg, %IDC_Graphic To hGraphic
   Graphic Attach hDlg, %IDC_Graphic
   Graphic Render "clock.bmp", (0,0)-(127,127)
   hRgn = CreateEllipticRgn(14,36, 130,152)
   SetWindowRgn(hDlg, hrgn, %True)
   Dialog Show Modal hDlg Call DlgProc
   DeleteObject hRgn
End Function
 
CallBack Function DlgProc() As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         Transparency = 128
         OldProc = SetWindowLong(hGraphic, %GWL_WndProc, CodePtr(NewGraphicProc))  'subclass
         SetLayeredWindowAttributes(hDlg, 0, Transparency, %LWA_ALPHA)
      Case %WM_LButtonDblClk
         Transparency = 255
         SetLayeredWindowAttributes(hDlg, 0, Transparency, %LWA_ALPHA)
      Case %WM_LButtonDown
         If Cb.WParam = %MK_LBUTTON Then SendMessage hDlg, %WM_NCLButtonDown, %HTCaption, ByVal %Null  ' force drag
      Case %WM_ContextMenu
         Dialog End Cb.Hndl
   End Select
End Function
 
Function NewGraphicProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   Select Case Msg
      Case %WM_MouseWheel
         Select Case Hi(Integer,WParam)    'note the use of Integer
            Case > 0 : Transparency = Min (255, Transparency + 5)
            Case < 0 : Transparency = Max (0, Transparency - 5)
         End Select
         SetLayeredWindowAttributes(hDlg, 0, Transparency, %LWA_ALPHA)
   End Select
   Function = CallWindowProc(OldProc&, hWnd, Msg, wParam, lParam)
End Function    
 
'gbs_01414
'Date: 10-17-2014

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm