This is an example of changing the background color as well. It seems that the method of the callback function is still valid for changing the background color.
Because the gadget handle is not available within My_DrawThemeText() function, a tricky way is used to distinguish the colored gadgets. So the global "gColor" variable is gone.
Edit:
Fixed bug in Array version code.
Added Map version code. It is more flexible than the array version. But it may be slow.
Edit 2:
Added a pattern brush trick. It is much better.
Code: Select all
; https://www.purebasic.fr/english/viewtopic.php?t=64746
; ====================================================================================================
; Title: API_HookEngine Module
; Description: With this module you can hook procedures and api in windows
; Author: Peyman
; Version: 1.0 (02 FEB 2016) initial version
; 1.1 (07 FEB 2016) added Inject DLL
; 1.2 (11 FEB 2016) improved injector, added Eject DLL & CallRemoteFunction with parrameter
; Platform: Windows (X64 And X86) Unicode And Ansi
; License: Free But Any improvements to be shared with the community.
; ====================================================================================================
DeclareModule API_HookEngine
Declare.i Hook(*OldFunctionAddress, *NewFunctionAddress)
Declare.i UnHook(*hook_ptr)
Declare.i ProcAddress(ModuleName$, ProcName$)
EndDeclareModule
Module API_HookEngine
EnableExplicit
Structure opcode
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
mov.u
CompilerElse
mov.a
CompilerEndIf
addr.i
push.a
ret.a
EndStructure
Structure hookstruct
addr.i
hook.opcode
orig.a[SizeOf(opcode)]
EndStructure
CompilerIf #PB_Compiler_Unicode
Import "kernel32.lib"
GetProcAddress(hModule, lpProcName.p-ascii)
EndImport
CompilerElse
Import "kernel32.lib"
GetProcAddress(hModule, lpProcName.s)
EndImport
CompilerEndIf
Procedure.i ProcAddress(ModuleName$, ProcName$)
Protected moduleH.i
moduleH = GetModuleHandle_(ModuleName$)
If moduleH = #Null
moduleH = LoadLibrary_(ModuleName$)
If moduleH = #Null
ProcedureReturn #Null
EndIf
EndIf
ProcedureReturn GetProcAddress(moduleH, ProcName$)
EndProcedure
Procedure Hook(*OldFunctionAddress, *NewFunctionAddress)
Protected *hook_ptr.hookstruct
If Not *OldFunctionAddress
ProcedureReturn #Null
EndIf
*hook_ptr = AllocateMemory(SizeOf(hookstruct))
*hook_ptr\addr = *OldFunctionAddress
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
*hook_ptr\hook\mov = $B848
CompilerElse
*hook_ptr\hook\mov = $B8
CompilerEndIf
*hook_ptr\hook\addr = *NewFunctionAddress
*hook_ptr\hook\push = $50
*hook_ptr\hook\ret = $C3
CopyMemory(*OldFunctionAddress, @*hook_ptr\orig, SizeOf(opcode))
If Not WriteProcessMemory_(GetCurrentProcess_(), *OldFunctionAddress, @*hook_ptr\hook, SizeOf(opcode), #Null)
FreeMemory(*hook_ptr)
ProcedureReturn #Null
Else
ProcedureReturn *hook_ptr
EndIf
EndProcedure
Procedure.i UnHook(*hook_ptr.hookstruct)
Protected retValue.i
If *hook_ptr
If *hook_ptr\addr
If WriteProcessMemory_(GetCurrentProcess_(), *hook_ptr\addr, @*hook_ptr\orig, SizeOf(opcode), #Null)
retValue = *hook_ptr\addr
FreeMemory(*hook_ptr)
ProcedureReturn retValue
EndIf
EndIf
EndIf
ProcedureReturn #Null
EndProcedure
EndModule
UseModule API_HookEngine
EnumerationBinary
#DTT_TEXTCOLOR ;(1 << 0) ;// crText has been specified
#DTT_BORDERCOLOR ;(1 << 1) ;// crBorder has been specified
#DTT_SHADOWCOLOR ;(1 << 2) ;// crShadow has been specified
#DTT_SHADOWTYPE ;(1 << 3) ;// iTextShadowType has been specified
#DTT_SHADOWOFFSET ;(1 << 4) ;// ptShadowOffset has been specified
#DTT_BORDERSIZE ;(1 << 5) ;// iBorderSize has been specified
#DTT_FONTPROP ;(1 << 6) ;// iFontPropId has been specified
#DTT_COLORPROP ;(1 << 7) ;// iColorPropId has been specified
#DTT_STATEID ;(1 << 8) ;// IStateId has been specified
#DTT_CALCRECT ;(1 << 9) ;// Use pRect as and in/out parameter
#DTT_APPLYOVERLAY ;(1 << 10) ;// fApplyOverlay has been specified
#DTT_GLOWSIZE ;(1 << 11) ;// iGlowSize has been specified
#DTT_CALLBACK ;(1 << 12) ;// pfnDrawTextCallback has been specified
#DTT_COMPOSITED ;(1 << 13) ;// Draws text with antialiased alpha (needs a DIB section)
EndEnumeration
#DTT_VALIDBITS = #DTT_TEXTCOLOR | #DTT_BORDERCOLOR | #DTT_SHADOWCOLOR | #DTT_SHADOWTYPE | #DTT_SHADOWOFFSET |
#DTT_BORDERSIZE | #DTT_FONTPROP | #DTT_COLORPROP | #DTT_STATEID | #DTT_CALCRECT |
#DTT_APPLYOVERLAY | #DTT_GLOWSIZE | #DTT_COMPOSITED
#BP_RADIOBUTTON = 2
#BP_CHECKBOX = 3
Structure DTTOPTS
dwSize.l
dwFlags.l
crText.l
crBorder.l
crShadow.l
iTextShadowType.l
ptShadowOffset.POINT
iBorderSize.l
iFontPropId.l
iColorPropId.l
iStateId.l
fApplyOverlay.l
iGlowSize.l
*pfnDrawTextCallback
lParam.l
EndStructure
Prototype DrawThemeTextEx(hTheme, hdc, iPartId, iStateId, *pszText, cchText, dwTextFlags.l, *pRect, *pOptions)
Global DrawThemeTextEx.DrawThemeTextEx
Structure ColoredGadgetInfo
FrontColor.i
BackColor.i
hBrushBackColor.i
EndStructure
Global MutexColoredGadget = CreateMutex()
Global NewMap ColoredGadget.ColoredGadgetInfo()
#App_BrushWidth = 2000 ;Set the value large enough in consideration of changing a gadget width.
Procedure MainWindow_Callback(hWnd, uMsg, wParam, lParam)
Protected Gadget, Result = #PB_ProcessPureBasicEvents
Select uMsg
Case #WM_CTLCOLORSTATIC
Gadget = GetProp_(lParam, "pb_id")
If IsGadget(Gadget) And (GadgetType(Gadget) = #PB_GadgetType_Option Or GadgetType(Gadget) = #PB_GadgetType_CheckBox)
LockMutex(MutexColoredGadget)
If FindMapElement(ColoredGadget(), Str(lParam))
SetBkMode_(wParam, #TRANSPARENT)
Result = ColoredGadget()\hBrushBackColor
EndIf
UnlockMutex(MutexColoredGadget)
EndIf
EndSelect
ProcedureReturn Result
EndProcedure
Procedure CreateBackgroundBrush(hwnd, BackColor)
Protected hBrush, Img, Color
If hwnd = 0 : ProcedureReturn 0 : EndIf
If BackColor = #PB_Default
Color = GetSysColor_(#COLOR_3DFACE)
Else
Color = BackColor
EndIf
Img = CreateImage(#PB_Any, #App_BrushWidth, 1, 24, Color)
If Img
If StartDrawing(ImageOutput(Img))
;Write the handle value in the last few bytes of the pattern brush.
Plot(#App_BrushWidth - 1, 0, hwnd & $FFFF)
Plot(#App_BrushWidth - 2, 0, (hwnd >> 16) & $FFFF)
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
Plot(#App_BrushWidth - 3, 0, (hwnd >> 32) & $FFFF)
Plot(#App_BrushWidth - 4, 0, (hwnd >> 48) & $FFFF)
CompilerEndIf
StopDrawing()
hBrush = CreatePatternBrush_(ImageID(Img))
EndIf
FreeImage(Img)
EndIf
ProcedureReturn hBrush
EndProcedure
Procedure SetOptionCheckboxGadgetColor(Gadget, FrontColor = #PB_Default, BackColor = #PB_Default)
Protected Result, hwnd, DummyString.s, Color, Img, hBrush
If IsGadget(Gadget)
If GadgetType(Gadget) <> #PB_GadgetType_Option And GadgetType(Gadget) <> #PB_GadgetType_CheckBox
ProcedureReturn 0
EndIf
hwnd = GadgetID(Gadget)
If hwnd
SendMessage_(hwnd, #WM_SETREDRAW, 0, 0)
LockMutex(MutexColoredGadget)
Repeat
With ColoredGadget()
;Check if the gadget already exists in the map.
If FindMapElement(ColoredGadget(), Str(hwnd))
If FrontColor = #PB_Default And BackColor = #PB_Default
;Remove the gadget from the map.
DeleteObject_(\hBrushBackColor)
DeleteMapElement(ColoredGadget())
Result = 1
Break
EndIf
\FrontColor = FrontColor
If \BackColor <> BackColor
\BackColor = BackColor
If \hBrushBackColor
DeleteObject_(\hBrushBackColor)
\hBrushBackColor = 0
EndIf
\hBrushBackColor = CreateBackgroundBrush(hwnd, BackColor)
EndIf
Result = 1
Break
EndIf
;If not, add it to the map.
If AddMapElement(ColoredGadget(), Str(hwnd))
\FrontColor = FrontColor
\BackColor = BackColor
\hBrushBackColor = CreateBackgroundBrush(hwnd, BackColor)
Result = 1
EndIf
Break
EndWith
ForEver
UnlockMutex(MutexColoredGadget)
SendMessage_(hwnd, #WM_SETREDRAW, 1, 0)
RedrawWindow_(hwnd, 0, 0, #RDW_ERASE | #RDW_FRAME | #RDW_INVALIDATE | #RDW_ALLCHILDREN)
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure My_DrawThemeText(hTheme, hdc, iPartId, iStateId, *pszText, cchText, dwTextFlags, dwTextFlags2, *pRect)
Protected opt.DTTOPTS\dwSize = SizeOf(DTTOPTS)
Protected hBrush, BrushInfo.LOGBRUSH, hdcTemp, rt.RECT, hBitmap, old, hwnd
If iPartId = #BP_RADIOBUTTON Or iPartId = #BP_CHECKBOX ;checkbox or option gadget.
hBrush = GetCurrentObject_(hdc, #OBJ_BRUSH)
If hBrush
If GetObject_(hBrush, SizeOf(LOGBRUSH), @BrushInfo)
If BrushInfo\lbStyle = #BS_PATTERN
hdcTemp = CreateCompatibleDC_(hdc)
If hdcTemp
hBitmap = CreateCompatibleBitmap_(hdc, #App_BrushWidth, 1)
If hBitmap
old = SelectObject_(hdcTemp, hBitmap)
rt\right = #App_BrushWidth
rt\bottom = 1
FillRect_(hdcTemp, rt, hBrush)
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
hwnd = (GetPixel_(hdcTemp, #App_BrushWidth - 1, 0) & $FFFF) | ((GetPixel_(hdcTemp, #App_BrushWidth - 2, 0) & $FFFF) << 16) |
((GetPixel_(hdcTemp, #App_BrushWidth - 3, 0) & $FFFF) << 32) | ((GetPixel_(hdcTemp, #App_BrushWidth - 4, 0) & $FFFF) << 48)
CompilerElse
hwnd = (GetPixel_(hdcTemp, #App_BrushWidth - 1, 0) & $FFFF) | ((GetPixel_(hdcTemp, #App_BrushWidth - 2, 0) & $FFFF) << 16)
CompilerEndIf
LockMutex(MutexColoredGadget)
If FindMapElement(ColoredGadget(), Str(hwnd))
If ColoredGadget()\FrontColor <> #PB_Default
opt\dwFlags = #DTT_TEXTCOLOR
opt\crText = ColoredGadget()\FrontColor
EndIf
EndIf
UnlockMutex(MutexColoredGadget)
DeleteObject_(SelectObject_(hdcTemp, old))
EndIf
DeleteDC_(hdcTemp)
EndIf
EndIf
EndIf
EndIf
EndIf
ProcedureReturn DrawThemeTextEx(hTheme, hdc, iPartId, iStateId, *pszText, cchText, dwTextFlags, *pRect, @opt)
EndProcedure
If OpenLibrary(0, "UxTheme.dll")
DrawThemeTextEx = GetFunction(0, "DrawThemeTextEx") ;There is no DrawThemeTextEx in Windows XP, so this method is not available.
EndIf
If DrawThemeTextEx
*DrawThemeText = Hook(ProcAddress("UxTheme.dll", "DrawThemeText"), @My_DrawThemeText())
EndIf
Enumeration Window
#MainWindow
EndEnumeration
Enumeration Gadgets
#Check_1
#Opt_1
#Cont_2
#Txt_2
#Check_2
#Opt_2
#Cont_3
#Txt_3
#Check_3
#Opt_3
#Check_4
#Opt_4
#Check_5
#Opt_5
#Check_6
#Opt_6
EndEnumeration
If OpenWindow(#MainWindow, 0, 0, 400, 350, "Check & Option Color", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
SetWindowColor(#MainWindow, RGB(54, 54, 54))
CheckBoxGadget(#Check_1, 20, 20, 160, 30, "$008000/#Yellow")
OptionGadget(#Opt_1, 200, 20, 160, 30, "Default")
ContainerGadget(#Cont_2, 10, 60, 370, 70, #PB_Container_Flat)
SetGadgetColor(#Cont_2, #PB_Gadget_BackColor, RGB(128, 128, 128))
TextGadget(#Txt_2, 5, 5, 160, 20, "Container_1")
SetGadgetColor(#Txt_2, #PB_Gadget_BackColor, GetGadgetColor(#Cont_2, #PB_Gadget_BackColor))
CheckBoxGadget(#Check_2, 10, 25, 160, 30, "$586CC2/$70B0FB")
OptionGadget(#Opt_2, 190, 25, 160, 30, "#PB_Default/$3E8479")
CloseGadgetList() ; #Cont_2
ContainerGadget(#Cont_3, 10, 140, 370, 70, #PB_Container_Flat)
SetGadgetColor(#Cont_3, #PB_Gadget_BackColor, RGB(23, 23, 23))
TextGadget(#Txt_3, 5, 5, 160, 20, "Container_2")
SetGadgetColor(#Txt_3, #PB_Gadget_BackColor, GetGadgetColor(#Cont_3, #PB_Gadget_BackColor))
SetGadgetColor(#Txt_3, #PB_Gadget_FrontColor, #White)
CheckBoxGadget(#Check_3, 10, 25, 160, 30, "Same text, Diff color")
OptionGadget(#Opt_3, 190, 25, 160, 30, "Same text, Diff color")
CloseGadgetList() ; #Cont_3
CheckBoxGadget(#Check_4, 20, 220, 160, 30, "Default")
CheckBoxGadget(#Check_5, 20, 260, 160, 30, "#PB_Default/#Cyan")
CheckBoxGadget(#Check_6, 20, 300, 160, 30, "#Yellow/#Black")
OptionGadget(#Opt_4, 200, 220, 160, 30, "#Red/#Green")
OptionGadget(#Opt_5, 200, 260, 160, 30, "#Blue/Default")
OptionGadget(#Opt_6, 200, 300, 270, 40, "$FF00FF/$DE23A9")
hFont = LoadFont(0, "arial", 20, #PB_Font_Bold)
SetGadgetFont(#Opt_6, hFont)
SetOptionCheckboxGadgetColor(#Check_1, $008000, #Yellow)
SetOptionCheckboxGadgetColor(#Check_2, $586CC2, $70B0FB)
SetOptionCheckboxGadgetColor(#Opt_2, #PB_Default, $3E8479)
SetOptionCheckboxGadgetColor(#Opt_3, #PB_Default, $2C5428)
SetOptionCheckboxGadgetColor(#Check_3, #Magenta)
SetOptionCheckboxGadgetColor(#Opt_5, #Blue)
SetOptionCheckboxGadgetColor(#Check_5, #PB_Default, #Cyan)
SetOptionCheckboxGadgetColor(#Check_6, #Yellow, #Black)
SetOptionCheckboxGadgetColor(#Opt_4, #Red, #Green)
SetOptionCheckboxGadgetColor(#Opt_6, $FF00FF, $DE23A9)
;SetOptionCheckboxGadgetColor(#Opt_6) ;Remove color settings from the gadget.
SetWindowCallback(@MainWindow_Callback(), #MainWindow)
Repeat
e = WaitWindowEvent()
; If e = #PB_Event_Gadget And EventGadget() = #Check_6
; DisableGadget(#Opt_6, GetGadgetState(#Check_6))
; If GetGadgetState(#Check_6)
; SetOptionCheckboxGadgetColor(#Opt_6, #PB_Default, $DE23A9)
; Else
; SetOptionCheckboxGadgetColor(#Opt_6, $FF00FF, $DE23A9)
; EndIf
;
; EndIf
Until e = #PB_Event_CloseWindow
EndIf
If *DrawThemeText
UnHook(*DrawThemeText)
EndIf
CloseLibrary(0)
ForEach ColoredGadget()
DeleteObject_(ColoredGadget()\hBrushBackColor)
Next
Map version.
Code: Select all
; https://www.purebasic.fr/english/viewtopic.php?t=64746
; ====================================================================================================
; Title: API_HookEngine Module
; Description: With this module you can hook procedures and api in windows
; Author: Peyman
; Version: 1.0 (02 FEB 2016) initial version
; 1.1 (07 FEB 2016) added Inject DLL
; 1.2 (11 FEB 2016) improved injector, added Eject DLL & CallRemoteFunction with parrameter
; Platform: Windows (X64 And X86) Unicode And Ansi
; License: Free But Any improvements to be shared with the community.
; ====================================================================================================
DeclareModule API_HookEngine
Declare.i Hook(*OldFunctionAddress, *NewFunctionAddress)
Declare.i UnHook(*hook_ptr)
Declare.i ProcAddress(ModuleName$, ProcName$)
EndDeclareModule
Module API_HookEngine
EnableExplicit
Structure opcode
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
mov.u
CompilerElse
mov.a
CompilerEndIf
addr.i
push.a
ret.a
EndStructure
Structure hookstruct
addr.i
hook.opcode
orig.a[SizeOf(opcode)]
EndStructure
CompilerIf #PB_Compiler_Unicode
Import "kernel32.lib"
GetProcAddress(hModule, lpProcName.p-ascii)
EndImport
CompilerElse
Import "kernel32.lib"
GetProcAddress(hModule, lpProcName.s)
EndImport
CompilerEndIf
Procedure.i ProcAddress(ModuleName$, ProcName$)
Protected moduleH.i
moduleH = GetModuleHandle_(ModuleName$)
If moduleH = #Null
moduleH = LoadLibrary_(ModuleName$)
If moduleH = #Null
ProcedureReturn #Null
EndIf
EndIf
ProcedureReturn GetProcAddress(moduleH, ProcName$)
EndProcedure
Procedure Hook(*OldFunctionAddress, *NewFunctionAddress)
Protected *hook_ptr.hookstruct
If Not *OldFunctionAddress
ProcedureReturn #Null
EndIf
*hook_ptr = AllocateMemory(SizeOf(hookstruct))
*hook_ptr\addr = *OldFunctionAddress
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
*hook_ptr\hook\mov = $B848
CompilerElse
*hook_ptr\hook\mov = $B8
CompilerEndIf
*hook_ptr\hook\addr = *NewFunctionAddress
*hook_ptr\hook\push = $50
*hook_ptr\hook\ret = $C3
CopyMemory(*OldFunctionAddress, @*hook_ptr\orig, SizeOf(opcode))
If Not WriteProcessMemory_(GetCurrentProcess_(), *OldFunctionAddress, @*hook_ptr\hook, SizeOf(opcode), #Null)
FreeMemory(*hook_ptr)
ProcedureReturn #Null
Else
ProcedureReturn *hook_ptr
EndIf
EndProcedure
Procedure.i UnHook(*hook_ptr.hookstruct)
Protected retValue.i
If *hook_ptr
If *hook_ptr\addr
If WriteProcessMemory_(GetCurrentProcess_(), *hook_ptr\addr, @*hook_ptr\orig, SizeOf(opcode), #Null)
retValue = *hook_ptr\addr
FreeMemory(*hook_ptr)
ProcedureReturn retValue
EndIf
EndIf
EndIf
ProcedureReturn #Null
EndProcedure
EndModule
UseModule API_HookEngine
EnumerationBinary
#DTT_TEXTCOLOR ;(1 << 0) ;// crText has been specified
#DTT_BORDERCOLOR ;(1 << 1) ;// crBorder has been specified
#DTT_SHADOWCOLOR ;(1 << 2) ;// crShadow has been specified
#DTT_SHADOWTYPE ;(1 << 3) ;// iTextShadowType has been specified
#DTT_SHADOWOFFSET ;(1 << 4) ;// ptShadowOffset has been specified
#DTT_BORDERSIZE ;(1 << 5) ;// iBorderSize has been specified
#DTT_FONTPROP ;(1 << 6) ;// iFontPropId has been specified
#DTT_COLORPROP ;(1 << 7) ;// iColorPropId has been specified
#DTT_STATEID ;(1 << 8) ;// IStateId has been specified
#DTT_CALCRECT ;(1 << 9) ;// Use pRect as and in/out parameter
#DTT_APPLYOVERLAY ;(1 << 10) ;// fApplyOverlay has been specified
#DTT_GLOWSIZE ;(1 << 11) ;// iGlowSize has been specified
#DTT_CALLBACK ;(1 << 12) ;// pfnDrawTextCallback has been specified
#DTT_COMPOSITED ;(1 << 13) ;// Draws text with antialiased alpha (needs a DIB section)
EndEnumeration
#DTT_VALIDBITS = #DTT_TEXTCOLOR | #DTT_BORDERCOLOR | #DTT_SHADOWCOLOR | #DTT_SHADOWTYPE | #DTT_SHADOWOFFSET |
#DTT_BORDERSIZE | #DTT_FONTPROP | #DTT_COLORPROP | #DTT_STATEID | #DTT_CALCRECT |
#DTT_APPLYOVERLAY | #DTT_GLOWSIZE | #DTT_COMPOSITED
Structure DTTOPTS
dwSize.l
dwFlags.l
crText.l
crBorder.l
crShadow.l
iTextShadowType.l
ptShadowOffset.POINT
iBorderSize.l
iFontPropId.l
iColorPropId.l
iStateId.l
fApplyOverlay.l
iGlowSize.l
*pfnDrawTextCallback
lParam.l
EndStructure
Global MutexColoredGadget = CreateMutex()
#BP_RADIOBUTTON = 2
#BP_CHECKBOX = 3
Structure ColoredGadgetInfo
Gadget.i
FrontColor.i
BackColor.i
hBrushBackColor.i
EndStructure
Global NewMap ColoredGadget.ColoredGadgetInfo()
Prototype DrawThemeTextEx(hTheme, hdc, iPartId, iStateId, *pszText, cchText, dwTextFlags.l, *pRect, *pOptions)
Global DrawThemeTextEx.DrawThemeTextEx
Procedure MainWindow_Callback(hWnd, uMsg, wParam, lParam)
Protected Gadget, Result = #PB_ProcessPureBasicEvents
Select uMsg
Case #WM_CTLCOLORSTATIC
Gadget = GetProp_(lParam, "pb_id")
If IsGadget(Gadget) And (GadgetType(Gadget) = #PB_GadgetType_Option Or GadgetType(Gadget) = #PB_GadgetType_CheckBox)
LockMutex(MutexColoredGadget)
ForEach ColoredGadget()
With ColoredGadget()
If \Gadget = Gadget
If \BackColor <> #PB_Default
Result = \hBrushBackColor
SetBkMode_(wParam, #TRANSPARENT)
EndIf
Break
EndIf
EndWith
Next
UnlockMutex(MutexColoredGadget)
EndIf
EndSelect
ProcedureReturn Result
EndProcedure
Procedure RemoveColoredGadget(Gadget) ;Remove a gadget from the map.
Protected hwnd
If IsGadget(Gadget)
hwnd = GadgetID(Gadget)
If hwnd
SendMessage_(hwnd, #WM_SETREDRAW, 0, 0)
LockMutex(MutexColoredGadget)
ForEach ColoredGadget()
With ColoredGadget()
If \Gadget = Gadget
SetGadgetText(Gadget, RTrim(GetGadgetText(Gadget), Chr($200B))) ;recover the original string.
DeleteObject_(\hBrushBackColor)
DeleteMapElement(ColoredGadget())
Break
EndIf
EndWith
Next
UnlockMutex(MutexColoredGadget)
SendMessage_(hwnd, #WM_SETREDRAW, 1, 0)
RedrawWindow_(hwnd, 0, 0, #RDW_ERASE | #RDW_FRAME | #RDW_INVALIDATE | #RDW_ALLCHILDREN)
EndIf
EndIf
EndProcedure
Procedure SetOptionCheckboxGadgetColor(Gadget, FrontColor, BackColor = #PB_Default)
Protected Result, hwnd, DummyString.s
Static MaxIndex
If IsGadget(Gadget)
If GadgetType(Gadget) <> #PB_GadgetType_Option And GadgetType(Gadget) <> #PB_GadgetType_CheckBox
ProcedureReturn 0
EndIf
hwnd = GadgetID(Gadget)
If hwnd
;Check if the gadget already exists in the array
SendMessage_(hwnd, #WM_SETREDRAW, 0, 0)
LockMutex(MutexColoredGadget)
ForEach ColoredGadget()
With ColoredGadget()
If \Gadget = Gadget
\FrontColor = FrontColor
If \BackColor <> BackColor
\BackColor = BackColor
If \hBrushBackColor
DeleteObject_(\hBrushBackColor)
\hBrushBackColor = 0
EndIf
If BackColor <> #PB_Default
\hBrushBackColor = CreateSolidBrush_(BackColor)
EndIf
EndIf
UnlockMutex(MutexColoredGadget)
SendMessage_(hwnd, #WM_SETREDRAW, 1, 0)
RedrawWindow_(hwnd, 0, 0, #RDW_ERASE | #RDW_FRAME | #RDW_INVALIDATE | #RDW_ALLCHILDREN)
ProcedureReturn 1
EndIf
EndWith
Next
;If not, add to map
MaxIndex + 1
If AddMapElement(ColoredGadget(), Str(MaxIndex))
; https://en.wikipedia.org/wiki/Zero-width_space
DummyString = Space(MaxIndex)
If DummyString
FillMemory(@DummyString, MaxIndex * SizeOf(Character), $200B, #PB_Unicode)
;SetGadgetText(Gadget, RTrim(GetGadgetText(Gadget), Chr($200B)) + DummyString)
SetGadgetText(Gadget, GetGadgetText(Gadget) + DummyString) ;Add the above string consisting of Zero-width spaces after an existing string as a marker.
ColoredGadget()\Gadget = Gadget
ColoredGadget()\FrontColor = FrontColor
ColoredGadget()\BackColor = BackColor
If BackColor <> #PB_Default
ColoredGadget()\hBrushBackColor = CreateSolidBrush_(BackColor)
EndIf
Result = 1
Else
DeleteMapElement(ColoredGadget()) ;if failed.
EndIf
EndIf
UnlockMutex(MutexColoredGadget)
SendMessage_(hwnd, #WM_SETREDRAW, 1, 0)
RedrawWindow_(hwnd, 0, 0, #RDW_ERASE | #RDW_FRAME | #RDW_INVALIDATE | #RDW_ALLCHILDREN)
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure My_DrawThemeText(hTheme, hdc, iPartId, iStateId, *pszText, cchText, dwTextFlags, dwTextFlags2, *pRect)
Protected opt.DTTOPTS\dwSize = SizeOf(DTTOPTS)
Protected Text.s, Index
If iPartId = #BP_RADIOBUTTON Or iPartId = #BP_CHECKBOX ;checkbox or option gadget.
LockMutex(MutexColoredGadget)
If *pszText
Text = PeekS(*pszText)
If Text
Index = CountString(Text, Chr($200B))
If Index > 0
If FindMapElement(ColoredGadget(), Str(Index))
If ColoredGadget()\FrontColor <> #PB_Default
opt\dwFlags = #DTT_TEXTCOLOR
opt\crText = ColoredGadget()\FrontColor
EndIf
EndIf
EndIf
EndIf
EndIf
UnlockMutex(MutexColoredGadget)
EndIf
ProcedureReturn DrawThemeTextEx(hTheme, hdc, iPartId, iStateId, *pszText, cchText, dwTextFlags, *pRect, @opt)
EndProcedure
If OpenLibrary(0, "UxTheme.dll")
DrawThemeTextEx = GetFunction(0, "DrawThemeTextEx") ;There is no DrawThemeTextEx in Windows XP, so this method is not available.
EndIf
If DrawThemeTextEx
*DrawThemeText = Hook(ProcAddress("UxTheme.dll", "DrawThemeText"), @My_DrawThemeText())
EndIf
Enumeration Window
#MainWindow
EndEnumeration
Enumeration Gadgets
#Check_1
#Opt_1
#Cont_2
#Txt_2
#Check_2
#Opt_2
#Cont_3
#Txt_3
#Check_3
#Opt_3
#Check_4
#Opt_4
#Check_5
#Opt_5
#Check_6
#Opt_6
EndEnumeration
If OpenWindow(#MainWindow, 0, 0, 400, 350, "Check & Option Color", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
SetWindowColor(#MainWindow, RGB(54, 54, 54))
CheckBoxGadget(#Check_1, 20, 20, 160, 30, "$008000/#Yellow")
OptionGadget(#Opt_1, 200, 20, 160, 30, "Default")
ContainerGadget(#Cont_2, 10, 60, 370, 70, #PB_Container_Flat)
SetGadgetColor(#Cont_2, #PB_Gadget_BackColor, RGB(128, 128, 128))
TextGadget(#Txt_2, 5, 5, 160, 20, "Container_1")
SetGadgetColor(#Txt_2, #PB_Gadget_BackColor, GetGadgetColor(#Cont_2, #PB_Gadget_BackColor))
CheckBoxGadget(#Check_2, 10, 25, 160, 30, "$586CC2/$70B0FB")
OptionGadget(#Opt_2, 190, 25, 160, 30, "#PB_Default/$3E8479")
CloseGadgetList() ; #Cont_2
ContainerGadget(#Cont_3, 10, 140, 370, 70, #PB_Container_Flat)
SetGadgetColor(#Cont_3, #PB_Gadget_BackColor, RGB(23, 23, 23))
TextGadget(#Txt_3, 5, 5, 160, 20, "Container_2")
SetGadgetColor(#Txt_3, #PB_Gadget_BackColor, GetGadgetColor(#Cont_3, #PB_Gadget_BackColor))
SetGadgetColor(#Txt_3, #PB_Gadget_FrontColor, #White)
CheckBoxGadget(#Check_3, 10, 25, 160, 30, "Same text, Diff color")
OptionGadget(#Opt_3, 190, 25, 160, 30, "Same text, Diff color")
CloseGadgetList() ; #Cont_3
CheckBoxGadget(#Check_4, 20, 220, 160, 30, "Default")
CheckBoxGadget(#Check_5, 20, 260, 160, 30, "#PB_Default/#Cyan")
CheckBoxGadget(#Check_6, 20, 300, 160, 30, "#Yellow/#Black")
OptionGadget(#Opt_4, 200, 220, 160, 30, "#Red/#Green")
OptionGadget(#Opt_5, 200, 260, 160, 30, "#Blue/Default")
OptionGadget(#Opt_6, 200, 300, 270, 40, "$FF00FF/$DE23A9")
hFont = LoadFont(0, "arial", 20, #PB_Font_Bold)
SetGadgetFont(#Opt_6, hFont)
SetOptionCheckboxGadgetColor(#Check_1, $008000, #Yellow)
SetOptionCheckboxGadgetColor(#Check_2, $586CC2, $70B0FB)
SetOptionCheckboxGadgetColor(#Opt_2, #PB_Default, $3E8479)
SetOptionCheckboxGadgetColor(#Opt_3, #PB_Default, $2C5428)
SetOptionCheckboxGadgetColor(#Check_3, #Magenta)
SetOptionCheckboxGadgetColor(#Opt_5, #Blue)
SetOptionCheckboxGadgetColor(#Check_5, #PB_Default, #Cyan)
SetOptionCheckboxGadgetColor(#Check_6, #Yellow, #Black)
SetOptionCheckboxGadgetColor(#Opt_4, #Red, #Green)
SetOptionCheckboxGadgetColor(#Opt_6, $FF00FF, $DE23A9)
SetWindowCallback(@MainWindow_Callback(), #MainWindow)
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
If *DrawThemeText
UnHook(*DrawThemeText)
EndIf
CloseLibrary(0)
ForEach ColoredGadget()
DeleteObject_(ColoredGadget()\hBrushBackColor)
Next
Array version.
Code: Select all
; https://www.purebasic.fr/english/viewtopic.php?t=64746
; ====================================================================================================
; Title: API_HookEngine Module
; Description: With this module you can hook procedures and api in windows
; Author: Peyman
; Version: 1.0 (02 FEB 2016) initial version
; 1.1 (07 FEB 2016) added Inject DLL
; 1.2 (11 FEB 2016) improved injector, added Eject DLL & CallRemoteFunction with parrameter
; Platform: Windows (X64 And X86) Unicode And Ansi
; License: Free But Any improvements to be shared with the community.
; ====================================================================================================
DeclareModule API_HookEngine
Declare.i Hook(*OldFunctionAddress, *NewFunctionAddress)
Declare.i UnHook(*hook_ptr)
Declare.i ProcAddress(ModuleName$, ProcName$)
EndDeclareModule
Module API_HookEngine
EnableExplicit
Structure opcode
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
mov.u
CompilerElse
mov.a
CompilerEndIf
addr.i
push.a
ret.a
EndStructure
Structure hookstruct
addr.i
hook.opcode
orig.a[SizeOf(opcode)]
EndStructure
CompilerIf #PB_Compiler_Unicode
Import "kernel32.lib"
GetProcAddress(hModule, lpProcName.p-ascii)
EndImport
CompilerElse
Import "kernel32.lib"
GetProcAddress(hModule, lpProcName.s)
EndImport
CompilerEndIf
Procedure.i ProcAddress(ModuleName$, ProcName$)
Protected moduleH.i
moduleH = GetModuleHandle_(ModuleName$)
If moduleH = #Null
moduleH = LoadLibrary_(ModuleName$)
If moduleH = #Null
ProcedureReturn #Null
EndIf
EndIf
ProcedureReturn GetProcAddress(moduleH, ProcName$)
EndProcedure
Procedure Hook(*OldFunctionAddress, *NewFunctionAddress)
Protected *hook_ptr.hookstruct
If Not *OldFunctionAddress
ProcedureReturn #Null
EndIf
*hook_ptr = AllocateMemory(SizeOf(hookstruct))
*hook_ptr\addr = *OldFunctionAddress
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
*hook_ptr\hook\mov = $B848
CompilerElse
*hook_ptr\hook\mov = $B8
CompilerEndIf
*hook_ptr\hook\addr = *NewFunctionAddress
*hook_ptr\hook\push = $50
*hook_ptr\hook\ret = $C3
CopyMemory(*OldFunctionAddress, @*hook_ptr\orig, SizeOf(opcode))
If Not WriteProcessMemory_(GetCurrentProcess_(), *OldFunctionAddress, @*hook_ptr\hook, SizeOf(opcode), #Null)
FreeMemory(*hook_ptr)
ProcedureReturn #Null
Else
ProcedureReturn *hook_ptr
EndIf
EndProcedure
Procedure.i UnHook(*hook_ptr.hookstruct)
Protected retValue.i
If *hook_ptr
If *hook_ptr\addr
If WriteProcessMemory_(GetCurrentProcess_(), *hook_ptr\addr, @*hook_ptr\orig, SizeOf(opcode), #Null)
retValue = *hook_ptr\addr
FreeMemory(*hook_ptr)
ProcedureReturn retValue
EndIf
EndIf
EndIf
ProcedureReturn #Null
EndProcedure
EndModule
UseModule API_HookEngine
EnumerationBinary
#DTT_TEXTCOLOR ;(1 << 0) ;// crText has been specified
#DTT_BORDERCOLOR ;(1 << 1) ;// crBorder has been specified
#DTT_SHADOWCOLOR ;(1 << 2) ;// crShadow has been specified
#DTT_SHADOWTYPE ;(1 << 3) ;// iTextShadowType has been specified
#DTT_SHADOWOFFSET ;(1 << 4) ;// ptShadowOffset has been specified
#DTT_BORDERSIZE ;(1 << 5) ;// iBorderSize has been specified
#DTT_FONTPROP ;(1 << 6) ;// iFontPropId has been specified
#DTT_COLORPROP ;(1 << 7) ;// iColorPropId has been specified
#DTT_STATEID ;(1 << 8) ;// IStateId has been specified
#DTT_CALCRECT ;(1 << 9) ;// Use pRect as and in/out parameter
#DTT_APPLYOVERLAY ;(1 << 10) ;// fApplyOverlay has been specified
#DTT_GLOWSIZE ;(1 << 11) ;// iGlowSize has been specified
#DTT_CALLBACK ;(1 << 12) ;// pfnDrawTextCallback has been specified
#DTT_COMPOSITED ;(1 << 13) ;// Draws text with antialiased alpha (needs a DIB section)
EndEnumeration
#DTT_VALIDBITS = #DTT_TEXTCOLOR | #DTT_BORDERCOLOR | #DTT_SHADOWCOLOR | #DTT_SHADOWTYPE | #DTT_SHADOWOFFSET |
#DTT_BORDERSIZE | #DTT_FONTPROP | #DTT_COLORPROP | #DTT_STATEID | #DTT_CALCRECT |
#DTT_APPLYOVERLAY | #DTT_GLOWSIZE | #DTT_COMPOSITED
Structure DTTOPTS
dwSize.l
dwFlags.l
crText.l
crBorder.l
crShadow.l
iTextShadowType.l
ptShadowOffset.POINT
iBorderSize.l
iFontPropId.l
iColorPropId.l
iStateId.l
fApplyOverlay.l
iGlowSize.l
*pfnDrawTextCallback
lParam.l
EndStructure
Global MutexColoredGadget = CreateMutex()
#BP_RADIOBUTTON = 2
#BP_CHECKBOX = 3
Structure ColoredGadgetInfo
Gadget.i
FrontColor.i
BackColor.i
hBrushBackColor.i
EndStructure
Global Dim ColoredGadget.ColoredGadgetInfo(0)
Prototype DrawThemeTextEx(hTheme, hdc, iPartId, iStateId, *pszText, cchText, dwTextFlags.l, *pRect, *pOptions)
Global DrawThemeTextEx.DrawThemeTextEx
Procedure MainWindow_Callback(hWnd, uMsg, wParam, lParam)
Protected i, Max, Gadget, Result = #PB_ProcessPureBasicEvents
Select uMsg
Case #WM_CTLCOLORSTATIC
Gadget = GetProp_(lParam, "pb_id")
If IsGadget(Gadget) And (GadgetType(Gadget) = #PB_GadgetType_Option Or GadgetType(Gadget) = #PB_GadgetType_CheckBox)
LockMutex(MutexColoredGadget)
Max = ArraySize(ColoredGadget())
For i = 0 To Max
If ColoredGadget(i)\Gadget = Gadget
If ColoredGadget(i)\BackColor <> #PB_Default
Result = ColoredGadget(i)\hBrushBackColor
SetBkMode_(wParam, #TRANSPARENT)
EndIf
Break
EndIf
Next
UnlockMutex(MutexColoredGadget)
EndIf
EndSelect
ProcedureReturn Result
EndProcedure
Procedure SetOptionCheckboxGadgetColor(Gadget, FrontColor, BackColor = #PB_Default)
Protected Result, hwnd, i, DummyString.s
Static MaxIndex = -1
If IsGadget(Gadget)
If GadgetType(Gadget) <> #PB_GadgetType_Option And GadgetType(Gadget) <> #PB_GadgetType_CheckBox
ProcedureReturn 0
EndIf
hwnd = GadgetID(Gadget)
If hwnd
;Check if the gadget already exists in the array
SendMessage_(hwnd, #WM_SETREDRAW, 0, 0)
LockMutex(MutexColoredGadget)
For i = 0 To MaxIndex
If ColoredGadget(i)\Gadget = Gadget
ColoredGadget(i)\FrontColor = FrontColor
If ColoredGadget(i)\BackColor <> BackColor
ColoredGadget(i)\BackColor = BackColor
If ColoredGadget(i)\hBrushBackColor
DeleteObject_(ColoredGadget(i)\hBrushBackColor)
ColoredGadget(i)\hBrushBackColor = 0
EndIf
If BackColor <> #PB_Default
ColoredGadget(i)\hBrushBackColor = CreateSolidBrush_(BackColor)
EndIf
EndIf
UnlockMutex(MutexColoredGadget)
SendMessage_(hwnd, #WM_SETREDRAW, 1, 0)
RedrawWindow_(hwnd, 0, 0, #RDW_ERASE | #RDW_FRAME | #RDW_INVALIDATE | #RDW_ALLCHILDREN)
ProcedureReturn 1
EndIf
Next
;If not, add to array
MaxIndex + 1
ReDim ColoredGadget(MaxIndex)
; https://en.wikipedia.org/wiki/Zero-width_space
;array index = number of Zero-width spaces - 1
DummyString = Space(MaxIndex + 1)
If DummyString
FillMemory(@DummyString, StringByteLength(DummyString), $200B, #PB_Unicode)
;SetGadgetText(Gadget, RTrim(GetGadgetText(Gadget), Chr($200B)) + DummyString)
SetGadgetText(Gadget, GetGadgetText(Gadget) + DummyString) ;Add the above string consisting of Zero-width spaces after an existing string as a marker.
ColoredGadget(MaxIndex)\Gadget = Gadget
ColoredGadget(MaxIndex)\FrontColor = FrontColor
ColoredGadget(MaxIndex)\BackColor = BackColor
If BackColor <> #PB_Default
ColoredGadget(MaxIndex)\hBrushBackColor = CreateSolidBrush_(BackColor)
EndIf
Result = 1
EndIf
UnlockMutex(MutexColoredGadget)
SendMessage_(hwnd, #WM_SETREDRAW, 1, 0)
RedrawWindow_(hwnd, 0, 0, #RDW_ERASE | #RDW_FRAME | #RDW_INVALIDATE | #RDW_ALLCHILDREN)
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure My_DrawThemeText(hTheme, hdc, iPartId, iStateId, *pszText, cchText, dwTextFlags, dwTextFlags2, *pRect)
Protected opt.DTTOPTS\dwSize = SizeOf(DTTOPTS)
Protected Text.s, Index
If iPartId = #BP_RADIOBUTTON Or iPartId = #BP_CHECKBOX ;checkbox or option gadget.
LockMutex(MutexColoredGadget)
If *pszText
Text = PeekS(*pszText)
If Text
;array index = number of Zero-width spaces - 1
Index = CountString(Text, Chr($200B)) - 1
If Index >= 0
If ColoredGadget(Index)\FrontColor <> #PB_Default
opt\dwFlags = #DTT_TEXTCOLOR
opt\crText = ColoredGadget(Index)\FrontColor
EndIf
EndIf
EndIf
EndIf
UnlockMutex(MutexColoredGadget)
EndIf
ProcedureReturn DrawThemeTextEx(hTheme, hdc, iPartId, iStateId, *pszText, cchText, dwTextFlags, *pRect, @opt)
EndProcedure
If OpenLibrary(0, "UxTheme.dll")
DrawThemeTextEx = GetFunction(0, "DrawThemeTextEx") ;There is no DrawThemeTextEx in Windows XP, so this method is not available.
EndIf
If DrawThemeTextEx
*DrawThemeText = Hook(ProcAddress("UxTheme.dll", "DrawThemeText"), @My_DrawThemeText())
EndIf
Enumeration Window
#MainWindow
EndEnumeration
Enumeration Gadgets
#Check_1
#Opt_1
#Cont_2
#Txt_2
#Check_2
#Opt_2
#Cont_3
#Txt_3
#Check_3
#Opt_3
#Check_4
#Opt_4
#Check_5
#Opt_5
#Check_6
#Opt_6
EndEnumeration
If OpenWindow(#MainWindow, 0, 0, 400, 350, "Check & Option Color", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
SetWindowColor(#MainWindow, RGB(54, 54, 54))
CheckBoxGadget(#Check_1, 20, 20, 160, 30, "$008000/#Yellow")
OptionGadget(#Opt_1, 200, 20, 160, 30, "Default")
ContainerGadget(#Cont_2, 10, 60, 370, 70, #PB_Container_Flat)
SetGadgetColor(#Cont_2, #PB_Gadget_BackColor, RGB(128, 128, 128))
TextGadget(#Txt_2, 5, 5, 160, 20, "Container_1")
SetGadgetColor(#Txt_2, #PB_Gadget_BackColor, GetGadgetColor(#Cont_2, #PB_Gadget_BackColor))
CheckBoxGadget(#Check_2, 10, 25, 160, 30, "$586CC2/$70B0FB")
OptionGadget(#Opt_2, 190, 25, 160, 30, "#PB_Default/$3E8479")
CloseGadgetList() ; #Cont_2
ContainerGadget(#Cont_3, 10, 140, 370, 70, #PB_Container_Flat)
SetGadgetColor(#Cont_3, #PB_Gadget_BackColor, RGB(23, 23, 23))
TextGadget(#Txt_3, 5, 5, 160, 20, "Container_2")
SetGadgetColor(#Txt_3, #PB_Gadget_BackColor, GetGadgetColor(#Cont_3, #PB_Gadget_BackColor))
SetGadgetColor(#Txt_3, #PB_Gadget_FrontColor, #White)
CheckBoxGadget(#Check_3, 10, 25, 160, 30, "Same text, Diff color")
OptionGadget(#Opt_3, 190, 25, 160, 30, "Same text, Diff color")
CloseGadgetList() ; #Cont_3
CheckBoxGadget(#Check_4, 20, 220, 160, 30, "Default")
CheckBoxGadget(#Check_5, 20, 260, 160, 30, "#PB_Default/#Cyan")
CheckBoxGadget(#Check_6, 20, 300, 160, 30, "#Yellow/#Black")
OptionGadget(#Opt_4, 200, 220, 160, 30, "#Red/#Green")
OptionGadget(#Opt_5, 200, 260, 160, 30, "#Blue/Default")
OptionGadget(#Opt_6, 200, 300, 270, 40, "$FF00FF/$DE23A9")
hFont = LoadFont(0, "arial", 20, #PB_Font_Bold)
SetGadgetFont(#Opt_6, hFont)
SetOptionCheckboxGadgetColor(#Check_1, $008000, #Yellow)
SetOptionCheckboxGadgetColor(#Check_2, $586CC2, $70B0FB)
SetOptionCheckboxGadgetColor(#Opt_2, #PB_Default, $3E8479)
SetOptionCheckboxGadgetColor(#Opt_3, #PB_Default, $2C5428)
SetOptionCheckboxGadgetColor(#Check_3, #Magenta)
SetOptionCheckboxGadgetColor(#Opt_5, #Blue)
SetOptionCheckboxGadgetColor(#Check_5, #PB_Default, #Cyan)
SetOptionCheckboxGadgetColor(#Check_6, #Yellow, #Black)
SetOptionCheckboxGadgetColor(#Opt_4, #Red, #Green)
SetOptionCheckboxGadgetColor(#Opt_6, $FF00FF, $DE23A9)
SetWindowCallback(@MainWindow_Callback(), #MainWindow)
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf
If *DrawThemeText
UnHook(*DrawThemeText)
EndIf
CloseLibrary(0)
MaxIndex = ArraySize(ColoredGadget())
For i = 0 To MaxIndex
DeleteObject_(ColoredGadget(i)\hBrushBackColor)
Next