PureBasic Forums - English

Code: Select all

EnableExplicit

#SCA_OLDPROC = "_pb_oldProc_"

Procedure.w HIWORD(Value.L)
	ProcedureReturn (((Value) >> 16) & $FFFF)
EndProcedure

Procedure.w LOWORD(Value)
	ProcedureReturn ((Value) & $FFFF)
EndProcedure

Procedure.i GetPBWindow(hwnd.i)
	Protected.i r1
	
	r1 = GetProp_(hwnd, "PB_WINDOWID")
	
	If r1 > 0
		ProcedureReturn r1 - 1
		
	Else
		ProcedureReturn -1
	EndIf
EndProcedure

Procedure.i sca_onMouseHWheel(hwnd.i, msg.l, wparam.i, lparam.i)
	Protected.w delta
	Protected.i gdt
	Protected.l scx, scs
	
	delta = HIWORD(wparam)
	gdt = GetProp_(GetParent_(hwnd), "PB_ID")
	
	scx = GetGadgetAttribute(gdt, #PB_ScrollArea_X)
	scs = GetGadgetAttribute(gdt, #PB_ScrollArea_ScrollStep)
	
	SetGadgetAttribute(gdt, #PB_ScrollArea_X, scx + (delta * scs / #WHEEL_DELTA))
	PostEvent(#PB_Event_Gadget, GetPBWindow(GetAncestor_(hwnd, #GA_ROOT)), gdt)
	
	ProcedureReturn 0
EndProcedure

Procedure.i sca_onMouseWheel(hwnd.i, msg.l, wparam.i, lparam.i)
	Protected.w delta
	Protected.i gdt
	Protected.l scy, scs
	
	delta = HIWORD(wparam)
	gdt = GetProp_(GetParent_(hwnd), "PB_ID")
	
	scy = GetGadgetAttribute(gdt, #PB_ScrollArea_Y)
	scs = GetGadgetAttribute(gdt, #PB_ScrollArea_ScrollStep)
	
	SetGadgetAttribute(gdt, #PB_ScrollArea_Y, scy - (delta * scs / #WHEEL_DELTA))
	PostEvent(#PB_Event_Gadget, GetPBWindow(GetAncestor_(hwnd, #GA_ROOT)), gdt)

	ProcedureReturn 0
EndProcedure

Procedure.i sca_onNcDestroy(hwnd.i, msg.l, wparam.i, lparam.i)
	Protected.i oldProc
	
	oldProc = GetProp_(hwnd, #SCA_OLDPROC)
	SetWindowLongPtr_(hwnd, #GWLP_USERDATA, oldProc)
	RemoveProp_(hwnd, #SCA_OLDPROC)
	
	ProcedureReturn CallWindowProc_(oldProc, hwnd, msg, wparam, lparam)
EndProcedure

Procedure.i sca_proc(hwnd.i, msg.l, wparam.i, lparam.i)
	Select msg
		Case #WM_MOUSEHWHEEL : ProcedureReturn sca_onMouseHWheel(hwnd, msg, wparam, lparam)
			
		Case #WM_MOUSEWHEEL : ProcedureReturn sca_onMouseWheel(hwnd, msg, wparam, lparam)
	
		Case #WM_NCDESTROY : ProcedureReturn sca_onNcDestroy(hwnd, msg, wparam, lparam)
	EndSelect
	
	ProcedureReturn CallWindowProc_(GetProp_(hwnd, #SCA_OLDPROC), hwnd, msg, wparam, lparam)
EndProcedure

Procedure.l sca_setUp(pbID.i)
	Protected.i oldProc, scaChild
	
	scaChild = GetWindow_(GadgetID(pbID), #GW_CHILD)
	oldProc = SetWindowLongPtr_(scaChild, #GWLP_WNDPROC, @sca_proc())
	SetProp_(scaChild, #SCA_OLDPROC, oldProc)
EndProcedure

;- TEST
Enumeration 1
	#ID_SCA1
	#ID_BTN1
	#ID_BTN2
	#ID_BTN3
	#ID_TEXT1
EndEnumeration

Procedure BindScrollDatas()
; 	Debug "X " + GetGadgetAttribute(EventGadget(), #PB_ScrollArea_X)
; 	Debug "Y " + GetGadgetAttribute(EventGadget(), #PB_ScrollArea_Y)
; 	Debug ""
EndProcedure
  
Procedure main()
	Protected.l ev
	
	OpenWindow(0, 0, 0, 405, 240, "ScrollAreaGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
	ScrollAreaGadget(#ID_SCA1, 10, 10, 390,220, 575, 555, 30)
	ButtonGadget(#ID_BTN1, 10, 10, 230, 30,"Button 1")
	ButtonGadget(#ID_BTN2, 50, 50, 230, 30,"Button 2")
	ButtonGadget(#ID_BTN3, 90, 90, 230, 30,"Button 3")
	TextGadget(#ID_TEXT1,130,130, 230, 20,"This is the content of a ScrollAreaGadget!",#PB_Text_Right)
	CloseGadgetList()
	
	sca_setUp(#ID_SCA1)
	SetGadgetAttribute(#ID_SCA1, #PB_ScrollArea_ScrollStep, 50)
	BindGadgetEvent(#ID_SCA1, @BindScrollDatas())
	
	Repeat
	Until	 WaitWindowEvent() = #PB_Event_CloseWindow
	
EndProcedure

main()