PureBasic

J'te le fais pas dire.

Je savais au fin fond de moi-même puisque la perfection n'est pas de ce monde qu'il manquerait encore une super mega fonction au génial code de RV.

J'ai cherché pendant tout noel, et j'ai trouvé.

Le MouseWheel

Alors j'ai éssayé et "j'ai pas arrivé"

Pourquoi ma scrollbar elle monte elle descend comme le petit poid dans un ascenseur et que le texte lui il reste à la regarder bouger

Je pense qu'il doit encore y avoir un message dans ce satané callback à envoyer

Si un copain pouvait me dire ce qui coince.
Merci .

Voici l'image :

Et voici le code:

Code : Tout sélectionner

; Code créé par RV avec l'aide de Kwai chang caine :D 
#win=1 
#ScrollBar = 10 
#ImageGadget = 31 
#ImageFond = 32 

#FontArial = 40 

Global event 
Global LigneSelect=-1,LigneSurv=-1,NivScrollBar=0 
Global HautItem=12,nbitems=500 


UseJPEGImageDecoder() 
CatchImage(#ImageGadget,?DebutImageData,?FinImageData - ?DebutImageData ) 
CreateImage(#ImageFond, ImageWidth(#ImageGadget),ImageHeight(#ImageGadget)) 

LoadFont(#FontArial,"arial",9,#PB_Font_Bold) 

Procedure.w MouseWheelDelta() 
 x.w = ((EventwParam()>>16)&$FFFF) 
 ProcedureReturn -(x / 120) 
EndProcedure 

Procedure Drawing() 
  StartDrawing(ImageOutput(#ImageFond)) 
    Box(0,0,ImageWidth(#ImageFond),ImageHeight(#ImageFond),RGB(255,255,255)) 
    DrawImage(ImageID(#ImageGadget),0,0) 
  
    If IsGadget(#ScrollBar) 
      DrawingMode(1) 
      DrawingFont(FontID(#FontArial)) 
      For i=0 To nbitems-1 
       coul=RGB(0,0,0) 
       If i=LigneSurv 
        Box(0,(i-NivScrollBar)*HautItem,ImageWidth(#ImageFond),HautItem,RGB(0,200,0)) 
        coul=RGB(255,255,255) 
       EndIf 
       If i=LigneSelect 
        Box(0,(i-NivScrollBar)*HautItem,ImageWidth(#ImageFond),HautItem,RGB(0,0,150)) 
        coul=RGB(255,255,255) 
       EndIf 
       txt$="Item "+Str(i) 
       DrawText(10,((i-NivScrollBar)*HautItem)+((HautItem-TextHeight(txt$))/2),txt$,coul) 
      Next i 
    EndIf 
  StopDrawing() 
  
  If IsGadget(#ImageGadget) 
    SetGadgetState(#ImageGadget,ImageID(#ImageFond)) 
  EndIf 
EndProcedure 

Procedure ScrollCallback(hwnd,msg,wParam,lParam) 
  ; dont change this procedure ;Oups...trop tard :D 
  Shared DK_OldScrollCallback 
  If ((msg = #WM_HSCROLL) Or (msg = #WM_VSCROLL)) And (wParam & $FFFF) = #SB_THUMBTRACK 
    NivScrollBar=((wParam >> 16) & $FFFF) 
    Drawing() 
  EndIf    
  If DK_OldScrollCallback 
    ProcedureReturn CallWindowProc_(DK_OldScrollCallback,hwnd,msg,wParam,lParam) 
  Else 
    ProcedureReturn 0 
  EndIf 
EndProcedure 

Procedure.l FocusItem() 
 wmx=WindowMouseX(#win):wmy=WindowMouseY(#win) 
 LigneSurv=NivScrollBar+Round((wmy-GadgetY(#ImageGadget))/HautItem,0) 

 If EventGadget()=#ScrollBar And GetGadgetState(#ScrollBar)<>NivScrollBar 
  NivScrollBar=GetGadgetState(#ScrollBar) 
 EndIf 

 If EventGadget()=#ImageGadget And EventType()=#PB_EventType_LeftClick And LigneSurv<=(nbitems-1) 
  LigneSelect=LigneSurv 
 EndIf 
  
 If wmx<=GadgetX(#ImageGadget) Or wmx>=GadgetX(#ImageGadget)+GadgetWidth(#ImageGadget) Or wmy<=GadgetY(#ImageGadget) Or wmy>=GadgetY(#ImageGadget)+GadgetHeight(#ImageGadget) Or LigneSurv>(nbitems-1) 
  LigneSurv=-1 
 EndIf 
 Drawing()  
EndProcedure 

OpenWindow(#win,100,100,ImageWidth(#ImageFond)+24,ImageHeight(#ImageFond)+4,"sdhfjghj",#PB_Window_SystemMenu) 
  CreateGadgetList(WindowID(#win)) 
    ImageGadget(#ImageGadget,0,0,ImageWidth(#ImageFond),ImageHeight(#ImageFond),ImageID(#ImageFond),#PB_Image_Border) 
    ScrollBarGadget(#ScrollBar,GadgetX(#ImageGadget)+GadgetWidth(#ImageGadget),GadgetY(#ImageGadget),20,GadgetHeight(#ImageGadget),0,(nbitems-1),ImageHeight(#ImageGadget)/HautItem,#PB_ScrollBar_Vertical) 

DK_OldScrollCallback = SetWindowLong_(WindowID(#win),#GWL_WNDPROC,@ScrollCallback()) 

Repeat 

 event=WaitWindowEvent() 

 ancLigneSelect=LigneSelect 
 FocusItem() 

 If LigneSelect<>ancLigneSelect 
  MessageRequester("Info","Item "+Str(LigneSelect)) 
 EndIf 
 
 If Event = #WM_MOUSEWHEEL 
   
  If MouseWheelDelta() < 0
   SetGadgetState(#ScrollBar, GetGadgetState(#ScrollBar) - 100) 
  Else
   SetGadgetState(#ScrollBar, GetGadgetState(#ScrollBar) + 100) 
  EndIf 
  
  Drawing() 
 
 EndIf
      
Until event=#PB_Event_CloseWindow 

End 


DataSection 
 DebutImageData : 
 IncludeBinary "c:\Fond2.jpg" 
 FinImageData : 
EndDataSection

Vu qu'apparement personne n'a pu m'aider, j'ai posé la meme question sur le forum de nos amis US.

J'ai eu une reponse de Rook Zimbabwe.

Je la poste si ça peux intérésser quelqu'un.

Code : Tout sélectionner

; Code créé par RV avec l'aide de Kwai chang caine :D 
; Modifié par Rook Zimbabwe pour la gestion du MouseWheel

#win=1 
#ScrollBar = 10 
#ImageGadget = 31 
#ImageFond = 32 

#FontArial = 40 

Global event 
Global LigneSelect=-1,LigneSurv=-1,NivScrollBar=0 
Global HautItem=12,nbitems=500 
Global Niv 

UseJPEGImageDecoder() 
CatchImage(#ImageGadget,?DebutImageData,?FinImageData - ?DebutImageData ) 
CreateImage(#ImageFond, ImageWidth(#ImageGadget),ImageHeight(#ImageGadget)) 

LoadFont(#FontArial,"arial",9,#PB_Font_Bold) 

Procedure.w MouseWheelDelta() 
 x.w = ((EventwParam()>>16)&$FFFF) 
 ProcedureReturn -(x / 120) 
EndProcedure 

Procedure Drawing() 
  StartDrawing(ImageOutput(#ImageFond)) 
    Box(0,0,ImageWidth(#ImageFond),ImageHeight(#ImageFond),RGB(255,255,255)) 
    DrawImage(ImageID(#ImageGadget),0,0) 
  
    If IsGadget(#ScrollBar) 
      DrawingMode(1) 
      DrawingFont(FontID(#FontArial)) 
      For i=0 To nbitems-1 
       coul=RGB(0,0,0) 
       If i=LigneSurv 
        Box(0,(i-NivScrollBar)*HautItem,ImageWidth(#ImageFond),HautItem,RGB(0,200,0)) 
        coul=RGB(255,255,255) 
       EndIf 
       If i=LigneSelect 
        Box(0,(i-NivScrollBar)*HautItem,ImageWidth(#ImageFond),HautItem,RGB(0,0,150)) 
        coul=RGB(255,255,255) 
       EndIf 
       txt$="Item "+Str(i) 
       DrawText(10,((i-NivScrollBar)*HautItem)+((HautItem-TextHeight(txt$))/2),txt$,coul) 
      Next i 
    EndIf 
  StopDrawing() 
  
  If IsGadget(#ImageGadget) 
    SetGadgetState(#ImageGadget,ImageID(#ImageFond)) 
  EndIf 
EndProcedure 

Procedure ScrollCallback(hwnd,msg,wParam,lParam) 
  ; dont change this procedure ;Oups...trop tard :D 
  Shared DK_OldScrollCallback 
  If ((msg = #WM_HSCROLL) Or (msg = #WM_VSCROLL)) And (wParam & $FFFF) = #SB_THUMBTRACK 
    NivScrollBar=((wParam >> 16) & $FFFF) 
    Drawing() 
  EndIf    
  If DK_OldScrollCallback 
    ProcedureReturn CallWindowProc_(DK_OldScrollCallback,hwnd,msg,wParam,lParam) 
  Else 
    ProcedureReturn 0 
  EndIf 
EndProcedure 

Procedure.l FocusItem() 
 wmx=WindowMouseX(#win):wmy=WindowMouseY(#win) 
 LigneSurv=NivScrollBar+Round((wmy-GadgetY(#ImageGadget))/HautItem,0) 

 If Niv = 1 
  NivScrollBar=GetGadgetState(#ScrollBar) 
 EndIf 

 If EventGadget()=#ImageGadget And EventType()=#PB_EventType_LeftClick And LigneSurv<=(nbitems-1) 
  LigneSelect=LigneSurv 
 EndIf 
  
 If wmx<=GadgetX(#ImageGadget) Or wmx>=GadgetX(#ImageGadget)+GadgetWidth(#ImageGadget) Or wmy<=GadgetY(#ImageGadget) Or wmy>=GadgetY(#ImageGadget)+GadgetHeight(#ImageGadget) Or LigneSurv>(nbitems-1) 
  LigneSurv=-1 
 EndIf 
 Drawing()  
EndProcedure 

OpenWindow(#win,100,100,ImageWidth(#ImageFond)+24,ImageHeight(#ImageFond)+4,"sdhfjghj",#PB_Window_SystemMenu) 
  CreateGadgetList(WindowID(#win)) 
    ImageGadget(#ImageGadget,0,0,ImageWidth(#ImageFond),ImageHeight(#ImageFond),ImageID(#ImageFond),#PB_Image_Border) 
    ScrollBarGadget(#ScrollBar,GadgetX(#ImageGadget)+GadgetWidth(#ImageGadget),GadgetY(#ImageGadget),20,GadgetHeight(#ImageGadget),0,(nbitems-1),ImageHeight(#ImageGadget)/HautItem,#PB_ScrollBar_Vertical) 

DK_OldScrollCallback = SetWindowLong_(WindowID(#win),#GWL_WNDPROC,@ScrollCallback()) 


Repeat 

 event=WaitWindowEvent() 

 ancLigneSelect=LigneSelect 
 FocusItem() 

 If LigneSelect<>ancLigneSelect 
  MessageRequester("Info","Item "+Str(LigneSelect)) 
 EndIf 
  
 If Event = #WM_MOUSEWHEEL 
    
  If MouseWheelDelta() < 0 
  
   SetGadgetState(#ScrollBar,GetGadgetState(#ScrollBar)-100) 
   Niv = 1 
   FocusItem() 
  Else 
   SetGadgetState(#ScrollBar, GetGadgetState(#ScrollBar)+100) 
   Niv = 1 
   FocusItem() 
  EndIf 

  Drawing() 
  Niv = 0 
  
 EndIf 
      
Until event=#PB_Event_CloseWindow 

End 


DataSection 
 DebutImageData : 
 IncludeBinary "fond2.bmp" 
 FinImageData : 
EndDataSection

Bonne journée

PureBasic

ListViewGadget style menu démarrer avec MouseWheel [Résolu]