Code: Select all
;====================================================================
; Program: Read-only Checkbox gadget
; Author: Lloyd Gallant (netmaestro)
; Date: January 3, 2008
; Target OS: Microsoft Windows 200/XP/Vista
; Target Compiler: PureBasic 4.0 and later
; License: Free, unrestricted, no warranty
;====================================================================
*unpacked = AllocateMemory(2084)
UnpackMemory(?PicPak, *unpacked)
img0 = CatchImage(#PB_Any, *unpacked, 2084)
FreeMemory(*unpacked)
DataSection
PicPak:
Data.b $4A,$43,$24,$08,$00,$00,$66,$F7,$03,$69,$B2,$A9,$D0,$20,$69,$14,$41,$48,$12,$CA
Data.b $08,$B0,$4A,$0D,$25,$9A,$0C,$30,$46,$02,$11,$3A,$E8,$7E,$0C,$02,$5B,$28,$5F,$F4
Data.b $9F,$02,$94,$23,$DF,$6D,$A1,$FD,$6A,$C0,$7B,$F1,$92,$CE,$3A,$F8,$29,$FE,$0A,$AF
Data.b $4E,$AC,$CC,$2F,$60,$2B,$AD,$0E,$AA,$4E,$F1,$71,$DF,$92,$06,$0C,$FC,$F7,$31,$8B
Data.b $D3,$E8,$8F,$D3,$A8,$3A,$38,$AD,$07,$EC,$EC,$08,$CD,$BB,$18,$E0,$9B,$D3,$8A,$D3
Data.b $18,$B0,$CD,$BA,$B1,$EC,$32,$8D,$AB,$38,$D3,$FC,$4F,$B3,$DE,$DA,$E2,$9B,$28,$BB
Data.b $E2,$34,$9F,$D3,$B8,$7C,$CD,$CE,$87,$A2,$ED,$2C,$BE,$39,$D3,$AC,$4F,$A3,$BA,$9B
Data.b $B2,$9E,$B3,$2A,$54,$8E,$32,$CB,$7F,$4E,$AE,$88,$3C,$6F,$CA,$BB,$38,$8D,$C1,$3D
Data.b $BB,$77,$BF,$01,$E3,$AA,$4F,$8C,$E6,$34,$AC,$8E,$D3,$EC,$39,$CD,$7E,$C0,$2E,$AA
Data.b $4E,$8C,$12,$B1,$2F,$28,$00,$00,$00,$20
PicPakend:
EndDataSection
Procedure ThemesEnabled()
dlv.DLLVERSIONINFO
dlv\cbsize=SizeOf(DLLVERSIONINFO)
lib=OpenLibrary(#PB_Any,"comctl32.dll")
If lib
CallFunction(lib,"DllGetVersion",@dlv)
DLLVersion = dlv\dwMajorVersion
CloseLibrary(lib)
EndIf
If DLLVersion = 6
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
If ThemesEnabled()
Global checked = GrabImage(img0, #PB_Any, 26,0,13,13)
Global unchecked = GrabImage(img0, #PB_Any, 39,0,13,13)
Else
Global checked = GrabImage(img0, #PB_Any, 0,0,13,13)
Global unchecked = GrabImage(img0, #PB_Any, 13,0,13,13)
EndIf
Procedure CheckProc(hwnd, msg, wparam, lparam)
oldproc = GetProp_(hwnd, "oldproc")
forecolor = GetProp_(hwnd, "forecolor")
backcolor = GetProp_(hwnd, "backcolor")
readonly = GetProp_(hwnd, "readonly")
If Not readonly
ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wparam, lparam)
EndIf
Select msg
Case #WM_LBUTTONDOWN, #WM_LBUTTONUP, #WM_LBUTTONDBLCLK
ProcedureReturn 0
Case #BM_SETCHECK
InvalidateRect_(hwnd,0,1)
Case #WM_PAINT
BeginPaint_(hwnd, ps.PAINTSTRUCT)
If GetGadgetState(GetProp_(hwnd, "PB_ID"))
dcin = StartDrawing(ImageOutput(checked))
Else
dcin = StartDrawing(ImageOutput(unchecked))
EndIf
BitBlt_(ps\hdc,0,3,13,13,dcin,0,0,#SRCCOPY)
StopDrawing()
txt$ = Space(255)
GetWindowText_(hwnd, @txt$, 254)
SetTextColor_(ps\hdc, forecolor)
SetBkColor_(ps\hdc, backcolor)
SelectObject_(ps\hdc, GetStockObject_(#DEFAULT_GUI_FONT))
TextOut_(ps\hdc, 15,2, @txt$, Len(txt$))
EndPaint_(hwnd, ps)
ProcedureReturn 0
Case #WM_NCDESTROY
RemoveProp_(hwnd, "oldproc")
RemoveProp_(hwnd, "forecolor")
RemoveProp_(hwnd, "backcolor")
RemoveProp_(hwnd, "readonly")
EndSelect
ProcedureReturn CallWindowProc_(oldproc, hwnd, msg, wparam, lparam)
EndProcedure
ProcedureDLL ReadOnlyCheckBoxGadget(gadget,x,y,width,height,text$,forecolor=0,backcolor=#PB_Any)
If backcolor=#PB_Any
backcolor = GetSysColor_(#COLOR_BTNFACE)
EndIf
result = CheckBoxGadget(gadget, x,y,width,height,text$)
If gadget = #PB_Any
returnvalue = result
hwnd = GadgetID(result)
Else
returnvalue = result
hwnd = result
EndIf
SetWindowLong_(hwnd, #GWL_STYLE, GetWindowLong_(hwnd, #GWL_STYLE) &~ #WS_TABSTOP)
SetProp_(hwnd,"oldproc", SetWindowLong_(hwnd,#GWL_WNDPROC, @CheckProc()))
SetProp_(hwnd, "forecolor", forecolor)
SetProp_(hwnd, "backcolor", backcolor)
SetProp_(hwnd, "readonly", 1)
ProcedureReturn returnvalue
EndProcedure
ProcedureDLL SetReadOnlyStatus(gadget, status)
hwnd = GadgetID(gadget)
If status
SetProp_(hwnd, "readonly", 1)
SetWindowLong_(hwnd, #GWL_STYLE, GetWindowLong_(hwnd, #GWL_STYLE) &~ #WS_TABSTOP)
Else
SetProp_(GadgetID(gadget), "readonly", 0)
SetWindowLong_(hwnd, #GWL_STYLE, GetWindowLong_(hwnd, #GWL_STYLE) | #WS_TABSTOP)
EndIf
EndProcedure
Procedure GetReadOnlyStatus(gadget)
ProcedureReturn GetProp_(GadgetID(gadget), "readonly")
EndProcedure
OpenWindow(0,0,0,320,240,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CreateGadgetList(WindowID(0))
gad1 = CheckBoxGadget(#PB_Any, 20,20,200,20,"Normal Checkbox")
gad2 = ReadOnlyCheckBoxGadget(#PB_Any, 20,50,200,20,"Some kind of status")
gad3 = CheckBoxGadget(#PB_Any, 20,80,200,20,"Normal Checkbox")
GadgetToolTip(gad2, "This is a status of some kind")
SetGadgetState(gad2, 1)
SetActiveGadget(gad1)
SetReadOnlyStatus(gad2, 1)
Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
