[win] Borderless Window : Drop shadow / Transparency

Share your advanced PureBasic knowledge/code with the community.
User avatar
eddy
Addict
Addict
Posts: 1479
Joined: Mon May 26, 2003 3:07 pm
Location: Nantes

[win] Borderless Window : Drop shadow / Transparency

Post by eddy »

Code: Select all

EnableExplicit
CompilerIf #PB_Compiler_OS=#PB_OS_Windows
   Procedure SetWindowTranparency(Window, TransparencyColor=#Cyan, Transparency=255)
      Protected hWnd=WindowID(window)
      
      ;transform into opaque layered window
      SetWindowLongPtr_(hWnd, #GWL_EXSTYLE, GetWindowLongPtr_(hWnd, #GWL_EXSTYLE) | #WS_EX_LAYERED)
      SetLayeredWindowAttributes_(hWnd, TransparencyColor, Transparency, #LWA_COLORKEY | #LWA_ALPHA)
   EndProcedure
   
   Procedure SetWindowShadow(Window, IsEnabled=1)
      Static *dwmapi
      Static *DwmExtendFrameIntoClientArea
      Static *DwmSetWindowAttribute
      Protected hWnd=WindowID(window)
      
      If Not *dwmapi
         *dwmapi=GetModuleHandle_("dwmapi")
         If *dwmapi And Not *DwmExtendFrameIntoClientArea And Not *DwmSetWindowAttribute
            *DwmExtendFrameIntoClientArea=GetProcAddress_(*dwmapi, Ascii("DwmExtendFrameIntoClientArea"))
            *DwmSetWindowAttribute=GetProcAddress_(*dwmapi, Ascii("DwmSetWindowAttribute"))
         EndIf
      EndIf
      
      If *DwmExtendFrameIntoClientArea And *DwmSetWindowAttribute 
         CompilerIf Not Defined(DWMNCRP_ENABLED, #PB_Constant) : #DWMNCRP_ENABLED=2 : CompilerEndIf
         CompilerIf Not Defined(DWMWA_NCRENDERING_POLICY, #PB_Constant) : #DWMWA_NCRENDERING_POLICY=2 : CompilerEndIf
         
         ;enable shadow
         Protected value.Integer\i=#DWMNCRP_ENABLED
         CallFunctionFast(*DwmSetWindowAttribute, hWnd, #DWMWA_NCRENDERING_POLICY, value, SizeOf(value))
         Protected *Margins=AllocateMemory(4*SizeOf(Long))
         FillMemory(*Margins, 4*SizeOf(Long), IsEnabled, #PB_Long)
         CallFunctionFast(*DwmExtendFrameIntoClientArea, hWnd, *Margins)
      EndIf
      ProcedureReturn -1
   EndProcedure
CompilerEndIf

CompilerIf #PB_Compiler_IsMainFile
   ; ********************
   ; EXAMPLE
   ; ********************
Procedure CreateWindowTest(x, y, parentWindowID=0)
   Protected container, Window
   Window=OpenWindow(#PB_Any, x, y, 150, 100, "Shadow / Transparency Test", #PB_Window_BorderLess, parentWindowID)
   SetWindowColor(Window, #Gray)
      
   container=ContainerGadget(#PB_Any, 5, 5, 50, 50) : CloseGadgetList()
   SetGadgetColor(container, #PB_Gadget_BackColor, #Red)
      
   container=ContainerGadget(#PB_Any, 60, 5, 50, 50) : CloseGadgetList()
   SetGadgetColor(container, #PB_Gadget_BackColor, #Green)
   
   ProcedureReturn Window
EndProcedure

Procedure Main()
   Define FirstWindow=CreateWindowTest(300, 300) ;borderless drop shadow without glow
   SetWindowTranparency(FirstWindow, #Cyan)
   SetWindowShadow(FirstWindow, 1)
   Define FirstWindowID=WindowID(FirstWindow)
   
   Define Window=CreateWindowTest(300, 500, FirstWindowID) ;borderless drop shadow with glow
   SetWindowShadow(Window, 1)
   
   Define Window=CreateWindowTest(500, 300, FirstWindowID)
   SetWindowTranparency(Window, #Red)
   SetWindowShadow(Window, 1)
   
   Define Window=CreateWindowTest(700, 300, FirstWindowID)
   SetWindowTranparency(Window, #Green, 100)
   SetWindowShadow(Window, 1)
   
   Define Window=CreateWindowTest(700, 500, FirstWindowID)
   SetWindowTranparency(Window, #Gray, 100)
   SetWindowShadow(Window, 0)
   
   Repeat
      Define e=WaitWindowEvent()
      If e=#PB_Event_LeftClick
         Break
      EndIf
   Until e=#PB_Event_CloseWindow      
EndProcedure
End Main()
CompilerEndIf
Imagewin10 x64 5.72 | IDE | PB plugin | Tools | Sprite | JSON | visual tool
User avatar
minimy
Enthusiast
Enthusiast
Posts: 344
Joined: Mon Jul 08, 2013 8:43 pm

Re: [win] Borderless Window : Drop shadow / Transparency

Post by minimy »

Very nice! More windows!! :mrgreen:
Thanks for share eddy!
If translation=Error: reply="Sorry, Im Spanish": Endif
User avatar
gurj
Enthusiast
Enthusiast
Posts: 658
Joined: Thu Jan 22, 2009 3:48 am
Location: china
Contact:

Re: [win] Borderless Window : Drop shadow / Transparency

Post by gurj »

winxp:
setwindowshadow() is spare
win7:
unknown
my pb for chinese:
http://ataorj.ys168.com
User avatar
minimy
Enthusiast
Enthusiast
Posts: 344
Joined: Mon Jul 08, 2013 8:43 pm

Re: [win] Borderless Window : Drop shadow / Transparency

Post by minimy »

win10 x64 home premiun + PB 5.60 beta3 work fine!
Five windows with diferent transparency, or may be my glass.. tired eyes?.. :mrgreen: :mrgreen:
If translation=Error: reply="Sorry, Im Spanish": Endif
User avatar
eddy
Addict
Addict
Posts: 1479
Joined: Mon May 26, 2003 3:07 pm
Location: Nantes

Re: [win] Borderless Window : Drop shadow / Transparency

Post by eddy »

gurj wrote:winxp:
setwindowshadow() is spare
win7:
unknown
- windows XP does not support AERO effect.
- On windows vista/7/8/10, shadows are not visible if you disabled the following option in your windows preferences:
Image
Imagewin10 x64 5.72 | IDE | PB plugin | Tools | Sprite | JSON | visual tool
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: [win] Borderless Window : Drop shadow / Transparency

Post by Kwai chang caine »

Cool windows
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
User avatar
DoubleDutch
Addict
Addict
Posts: 3219
Joined: Thu Aug 07, 2003 7:01 pm
Location: United Kingdom
Contact:

Re: [win] Borderless Window : Drop shadow / Transparency

Post by DoubleDutch »

@Eddy Do you think something like this could be used to make a program used Windows Dark mode?

Here is what Microsoft added to Terminal for Dark mode:
https://github.com/mintty/wsltty/issues/157
https://deluxepixel.com <- My Business website
https://reportcomplete.com <- School end of term reports system
Post Reply