Find below source code that extends what can be done with Gadgets & Windows.
So far it works (tested) on Windows and Linux. I have yet to pick apart the MacOS API documentation... But if you know the solutions for MacOS, please do share them.
Change Log
- Rev 2: Added optional 'State' argument to FreezeGadget & FreezeWindow as suggested by Kiffi.
- Rev 4: Utilised SetWindowLongPtr for x64 compatiability on Windows operating systems.
- FreezeGadget(Gadget [,State]) - Stops this gadget from being drawn. Useful for updating items.
- ThawGadget(Gadget) - Re-Enables drawing of this gadget.
- FreezeWindow(Window [,State]) - Stops this window from being drawn.
- ThawWindow(Window) - Re-Enables drawing of this window.
- SetGadgetProperty(Gadget, Key$, *Data) - Set a property of this gadget.
- GetGadgetProperty(Gadget, Key$) - Returns the associated data with the property.
- RemoveGadgetProperty(Gadget, Key$) - Removes a property from the gadget.
- AddWindowProperty(Window, Property$, *Data) - Same as the Gadget implementation.
- GetWindowProperty(Window, Property$) - Same as the Gadget implementation.
- RemoveWindowProperty(Window, Property$) - Same as the Gadget implementation.
- SetWindowOpacity(Window, Opacity) - Change the Opacity of the window. Opacity: 0.0 - 1.0
Code: Select all
; ----------------------------------------------------------------------------------------------------
; Title: Utility Functions for Windows & Gadgets.
; Description: Functions to extend the control over Windows & Gadgets within PureBasic.
; Author(s): Michael R. King (mrking2910@gmail.com)
; Revision: 4
; Support: Windows (Tested), Linux (Tested), MacOS (Partial)
;
; Notes:
; [Linux] SetWindowOpacity() requires 'gtk2-engines-pixbuf' to be installed.
; ----------------------------------------------------------------------------------------------------
; - Change Log -
; Rev 1: Bug Fixes
; Rev 2: Added optional 'State' argument to FreezeGadget & FreezeWindow as suggested by Kiffi.
; Rev 3: Bug Fixes
; Rev 4: Utilised SetWindowLongPtr for x64 compatiability on Windows operating systems.
EnableExplicit
CompilerIf Defined(_PBI_CONTROLUTILITIES_, #PB_Constant) = #False
#_PBI_CONTROLUTILITIES_ = #True
; - Freeze Gadget -
Procedure FreezeGadget(Gadget, State = #True)
Protected *hCtrl
If IsGadget(Gadget)
*hCtrl = GadgetID(Gadget)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
If State
SendMessage_(*hCtrl, #WM_SETREDRAW, #False, 0)
Else
SendMessage_(*hCtrl, #WM_SETREDRAW, #True, 0)
RedrawWindow_(*hCtrl, 0, 0, #RDW_INTERNALPAINT | #RDW_INVALIDATE)
EndIf
CompilerCase #PB_OS_Linux
If State
gdk_window_freeze_updates_(__GdkWindow(*hCtrl))
Else
gdk_window_thaw_updates_(__GdkWindow(*hCtrl))
EndIf
CompilerCase #PB_OS_MacOS
;- TODO: Add MacOS Code Here
CompilerEndSelect
EndIf
EndProcedure
; - Thaw Gadget -
Macro ThawGadget(Gadget)
FreezeGadget(Gadget, #False)
EndMacro
; - Freeze Window -
Procedure FreezeWindow(Window, State = #True)
Protected *hCtrl
If IsWindow(Window)
*hCtrl = WindowID(Window)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
If State
SendMessage_(*hCtrl, #WM_SETREDRAW, #False, 0)
Else
SendMessage_(*hCtrl, #WM_SETREDRAW, #True, 0)
RedrawWindow_(*hCtrl, 0, 0, #RDW_INTERNALPAINT | #RDW_INVALIDATE)
EndIf
CompilerCase #PB_OS_Linux
If State
gdk_window_freeze_updates_(__GdkWindow(*hCtrl))
Else
gdk_window_thaw_updates_(__GdkWindow(*hCtrl))
EndIf
CompilerCase #PB_OS_MacOS
;- TODO: Add MacOS Code Here
CompilerEndSelect
EndIf
EndProcedure
; - Thaw Window -
Macro ThawWindow(Window)
FreezeWindow(Window, #False)
EndMacro
; - Set Gadget Property -
Procedure SetGadgetProperty(Gadget, PropertyKey$, *PropertyData)
Protected *hCtrl
If IsGadget(Gadget) And Len(PropertyKey$) > 0
*hCtrl = GadgetID(Gadget)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
ProcedureReturn SetProp_(*hCtrl, PropertyKey$, *PropertyData)
CompilerCase #PB_OS_Linux
ProcedureReturn g_object_set_data_(*hCtrl, PropertyKey$, *PropertyData)
CompilerCase #PB_OS_MacOS
;- TODO: Add MacOS Code Here
CompilerEndSelect
EndIf
EndProcedure
; - Get Gadget Property -
Procedure.i GetGadgetProperty(Gadget, PropertyKey$)
Protected *hCtrl
If IsGadget(Gadget) And Len(PropertyKey$) > 0
*hCtrl = GadgetID(Gadget)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
ProcedureReturn GetProp_(*hCtrl, PropertyKey$)
CompilerCase #PB_OS_Linux
ProcedureReturn g_object_get_data_(*hCtrl, PropertyKey$)
CompilerCase #PB_OS_MacOS
;- TODO: Add MacOS Code Here
CompilerEndSelect
EndIf
EndProcedure
; - Remove Gadget Property -
Procedure RemoveGadgetProperty(Gadget, PropertyKey$)
Protected *hCtrl
If IsGadget(Gadget) And Len(PropertyKey$) > 0
*hCtrl = GadgetID(Gadget)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
ProcedureReturn RemoveProp_(*hCtrl, PropertyKey$)
CompilerCase #PB_OS_Linux
ProcedureReturn g_object_steal_data_(*hCtrl, PropertyKey$)
CompilerCase #PB_OS_MacOS
;- TODO: Add MacOS Code Here
CompilerEndSelect
EndIf
EndProcedure
; - Set Window Property -
Procedure SetWindowProperty(Window, PropertyKey$, *PropertyData)
Protected *hCtrl
If IsWindow(Window) And Len(PropertyKey$) > 0
*hCtrl = WindowID(Window)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
ProcedureReturn SetProp_(*hCtrl, PropertyKey$, *PropertyData)
CompilerCase #PB_OS_Linux
ProcedureReturn g_object_set_data_(*hCtrl, PropertyKey$, *PropertyData)
CompilerCase #PB_OS_MacOS
;- TODO: Add MacOS Code Here
CompilerEndSelect
EndIf
EndProcedure
; - Get Window Property -
Procedure.i GetWindowProperty(Window, PropertyKey$)
Protected *hCtrl
If IsWindow(Window) And Len(PropertyKey$) > 0
*hCtrl = WindowID(Window)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
ProcedureReturn GetProp_(*hCtrl, PropertyKey$)
CompilerCase #PB_OS_Linux
ProcedureReturn g_object_get_data_(*hCtrl, PropertyKey$)
CompilerCase #PB_OS_MacOS
;- TODO: Add MacOS Code Here
CompilerEndSelect
EndIf
EndProcedure
; - Remove Window Property -
Procedure RemoveWindowProperty(Window, PropertyKey$)
Protected *hCtrl
If IsWindow(Window) And Len(PropertyKey$) > 0
*hCtrl = WindowID(Window)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
ProcedureReturn RemoveProp_(*hCtrl, PropertyKey$)
CompilerCase #PB_OS_Linux
ProcedureReturn g_object_steal_data_(*hCtrl, PropertyKey$)
CompilerCase #PB_OS_MacOS
;- TODO: Add MacOS Code Here
CompilerEndSelect
EndIf
EndProcedure
; - Set Window Opacity -
Procedure SetWindowOpacity(Window, Opacity.d = 1.0)
Protected *hCtrl
If IsWindow(Window)
*hCtrl = WindowID(Window)
If Opacity < 0 : Opacity = 0 : EndIf
If Opacity > 255 : Opacity = 255 : EndIf
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
SetWindowLongPtr_(*hCtrl, #GWL_EXSTYLE, GetWindowLongPtr_(*hCtrl, #GWL_EXSTYLE) | #WS_EX_LAYERED)
SetLayeredWindowAttributes_(*hCtrl, 0, 255 * Opacity / 1.0, 2)
CompilerCase #PB_OS_Linux
If gtk_widget_is_composited(*hCtrl)
gtk_window_set_opacity(*hCtrl, Opacity)
EndIf
CompilerCase #PB_OS_MacOS
SetWindowAlpha(*hCtrl, Opacity)
CompilerEndSelect
EndIf
EndProcedure
CompilerEndIf ;_PBI_CONTROLUTILITIES_
; -------------------------------------------------------------------------------------
; - DEMONSTRATION CODE - DEMONSTRATION CODE - DEMONSTRATION CODE - DEMONSTRATION CODE -
; -------------------------------------------------------------------------------------
; - Open Window -
OpenWindow(0, 0, 0, 400, 300, "Test", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
; - Set Window Opacity -
SetWindowOpacity(0, 0.8)
; - Window Property -
SetWindowProperty(0, "TestProperty", 123)
Debug "Window Property Value: " + Str(GetWindowProperty(0, "TestProperty"))
RemoveWindowProperty(0, "TestProperty")
; - Main Loop -
Repeat
Select WindowEvent()
Case #PB_Event_CloseWindow
End
EndSelect
ForEver
Thanks
