Code : Tout sélectionner
;nico
Global Valeur_Deplacement
Procedure NouvelleProc( hWnd, Msg, wParam, lParam)
;Ici on récupère l'adresse d'origine de la procédure grâce à la
;chaine qui l'identifie: "OriginProc" et le handle de la fenêtre
;voir la fonction SetProp.
OriginProc.l= GetProp_(hWnd, "OriginProc")
Select Msg
Case #WM_VSCROLL; Gestion de la barre verticale
;Debug lParam ;Handle du scrollbar
loword = wParam & $FFFF
Select loword
Case #SB_LINEDOWN
;On traite nous-même ce message
Position= GetScrollPos_(GadgetID(0),#SB_VERT)
SetScrollPos_(GadgetID(0),#SB_VERT,Position + Valeur_Deplacement ,1)
Debug "barre vertical= "+Str(GetScrollPos_(GadgetID(0),#SB_VERT))
ProcedureReturn 0
Case #SB_LINEUP
;On traite nous-même ce message
Position= GetScrollPos_(GadgetID(0),#SB_VERT)
SetScrollPos_(GadgetID(0),#SB_VERT,Position - Valeur_Deplacement ,1)
Debug "barre vertical= "+Str(GetScrollPos_(GadgetID(0),#SB_VERT))
ProcedureReturn 0
Case #SB_PAGEDOWN
;impossible d'utiliser ce message
Case #SB_PAGEUP
;impossible d'utiliser ce message
Case #SB_THUMBPOSITION
Debug "barre vertical= "+Str(wParam >> 16) ;donne la position du déplacement
Case # SB_THUMBTRACK
EndSelect
Case #WM_HSCROLL; Gestion de la barre horizontal
;Debug lParam ;Handle du scrollbar
loword = wParam & $FFFF
Select loword
Case #SB_LINEDOWN
;On traite nous-même ce message
Position= GetScrollPos_(GadgetID(0),#SB_HORZ)
SetScrollPos_(GadgetID(0),#SB_HORZ,Position + Valeur_Deplacement ,1)
Debug "barre horizontal= "+Str(GetScrollPos_(GadgetID(0),#SB_HORZ))
ProcedureReturn 0
Case #SB_LINEUP
;On traite nous-même ce message
Position= GetScrollPos_(GadgetID(0),#SB_HORZ)
SetScrollPos_(GadgetID(0),#SB_HORZ,Position - Valeur_Deplacement ,1)
Debug "barre horizontal= "+Str(GetScrollPos_(GadgetID(0),#SB_HORZ))
ProcedureReturn 0
Case #SB_PAGEDOWN
;impossible d'utiliser ce message
Case #SB_PAGEUP
;impossible d'utiliser ce message
Case #SB_THUMBPOSITION
Debug "barre horizontal= "+Str(wParam >> 16) ;donne la position du déplacement
Case # SB_THUMBTRACK
EndSelect
EndSelect
;On renvoie tous les autres évènements à la procédure d'origine.
ProcedureReturn CallWindowProc_(OriginProc,hWnd,Msg,wParam,lParam)
EndProcedure
If OpenWindow(0,0,0,600,400,#PB_Window_SystemMenu|#PB_Window_ScreenCentered,"StringGadget Flags") And CreateGadgetList(WindowID(0))
Valeur_Deplacement=10
hscroll=ScrollAreaGadget(0, 10, 10,400,120, 600, 300, 2)
;Normalement la valeur de depacement ici est 2, mais elle ne sera pas pris en compte.
ButtonGadget (1, 10, 10,230, 30,"Button 1")
ButtonGadget (2, 50, 50,230, 30,"Button 2")
ButtonGadget (3, 90, 90,230, 30,"Button 3")
TextGadget (4,130,130,230, 20,"This is the content of a ScrollAreaGadget!",#PB_Text_Right)
CloseGadgetList()
;Avec cette fonction, on récupère l'adresse d'origine de la procédure
;pour ensuite la restituer, une fois le traitement terminé.
OriginProc = SetWindowLong_(GadgetID(0), #GWL_WNDPROC, @NouvelleProc())
;Cette fonction est très utile car elle permet d'associer une nouvelle donnée
;à n'importe quelles fenêtres crées en utlisant une chaine de caractère pour
;l'identification; ça évite d'utiliser une valeur globale.
;Ici on associe la valeur OriginProc identifiée par la chaine "OriginProc"
;au ScrollGadget
SetProp_(GadgetID(0), "OriginProc", OriginProc)
Repeat
EventID = WaitWindowEvent()
Select EventID
Case #PB_EventGadget
Select EventGadgetID()
Case 0
Debug "Normal StringGadget"
Case 1
MessageRequester("Info","Bouton 1 cliqué")
EndSelect
Case #WM_CLOSE
;Supprimer avant fermeture du programme la donnée associée à la fenêtre.
RemoveProp_(GadgetID(0),"OriginProc")
Quit=1
EndSelect
Until Quit=1
EndIf