Ascenseur dans canvas

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Ascenseur dans canvas

Message par microdevweb »

Les canvas ne supportent pas les gadget (ou alors il faut le désactivé) voici deux modules pour y ajouter des ascenseurs il fonctionnent comme suit

Code : Tout sélectionner

ScrollH::Init(IdScrool,IdCanvas,X,Y,W,H,*ProcedureCallBack)
IdScrool=identifient de l'ascenseur
IdCanvas=le canvas dans le quelle il va être dessine
ProcedureCallBack (procedure appellée quand l'ascenseur est modifié)

A placer dans le code événementielle

exemple

Code : Tout sélectionner

Repeat
  Event=WindowEvent()
  If ScrollV::Event(1,Event)
    StartDrawing(CanvasOutput(myCanvas))
    ScrollV::Draw(1)
    StopDrawing()                        
  EndIf
Until Event=#PB_Event_CloseWindow_
cela permet l'affichage de la coloration en survol,Je n'ai pas mis le StartDrawing directement dans le module, pour pouvoir gérer ces dernier sans trop d'appel et ne pas ralentir le cpu
Idem pour l'ascenseur horizontal

Code : Tout sélectionner

ScrollH::Event(1,Event)
Exemple pour la procédure CallBack

Code : Tout sélectionner

 Procedure MoveAnalysis()
            Protected DecX=0,DecY=0,W,H
            If ScroolVOn=#True
                  DecX=30
            Else
                  DecX=10
            EndIf
            If ScroolHOn=#True
                  DecY=20
            Else
                  DecY=0
            EndIf
            W=GadgetWidth(myCanvas)-DecX
            H=GadgetHeight(myCanvas)-DecY
            If TreeDisplayed=#True Or TreeOpen=#True
                  W-TreeWidth
            EndIf
             If IsImage(CopiImgAnalysis) :FreeImage(CopiImgAnalysis) :EndIf
            CopiImgAnalysis=GrabImage(ImgAnalysis,#PB_Any,ScrollH::GetState(1),ScrollV::GetState(1),W,H)
            StartDrawing(CanvasOutput(myCanvas))
            Box(0,0,W,H,CanvasColor)
            DrawImage(ImageID(CopiImgAnalysis),0,0)
            StopDrawing()
      EndProcedure
Le lien ici https://www.mediafire.com/?vc1bchtckm6g8m2
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Avatar de l’utilisateur
GallyHC
Messages : 1703
Inscription : lun. 17/déc./2007 12:44

Re: Ascenseur dans canvas

Message par GallyHC »

Bonjour,

Sa a l'air vraiment sympa mais, je ne testerais pas. A peine cliquer sur le liens le résultat est l'ouverture de popup avec :

Image

Les sites de download avec "trop" de pub et surtout des sites "Méchant" je passe.

Désolé,
GallyHC
Configuration : Tower: Windows 10 (Processeur: i7 "x64") (Mémoire: 16Go) (GeForce GTX 760 - 2Go) - PureBasic 5.72 (x86 et x64)
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: Ascenseur dans canvas

Message par microdevweb »

un autre lien et le code
http://www.partage-facile.com/KKUXDT1SZR/tools.zip.html

Code : Tout sélectionner

;////////////////////////////////////////////////////////////////////////////////////////////////////////////
; ScrollH
; Vers 1.0 du 2014-08-08
; © AllDev / MicrodevWeb / Bielen Pierre
;////////////////////////////////////////////////////////////////////////////////////////////////////////////
DeclareModule ScrollH
      Declare Init(IdScrool,IdCanvas,X,Y,W,H,*ProcedureCallBack)
      Declare Draw(IdScrool)
      Declare SetMinMaxStep(IdScrool,Min,Max,StepValue=1)
      Declare GetState(IdScrool)
      Declare SetActifOf(IdScrool)
      Declare SetState(IdScrool,State)
      Declare Event(IdScrool,Event)
EndDeclareModule
Module ScrollH
      UsePNGImageDecoder()
      EnableExplicit
      Global LeftArow=CatchImage(#PB_Any,?LeftArow)
      Global RigthArow=CatchImage(#PB_Any,?RigthArow)
      Structure pos
            X.i
            Y.i
            W.i
            H.i
      EndStructure
      Structure Scrool
            ActifOn.b
            myIdCanvas.i
            myPos.pos
            OverArowRigth.b
            OverArowLeft.b
            OverButton.b
            OverStepDown.b
            OverStepUp.b
            myMin.i
            myMax.i
            UnityMove.f
            myState.i
            myStep.i
            DecalButton.i
            Margin.i
            PosArrowRigth.pos
            PosArrowLeft.pos
            PosButton.pos
            RefreshOn.b
            ClicOn.b
            *ProcedureCallBack
      EndStructure
      Global NewMap myScrool.Scrool()
      Procedure Init(IdScrool,IdCanvas,X,Y,W,H,*ProcedureCallBack)
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  AddMapElement(myScrool(),Str(IdScrool))
            EndIf
            myScrool()\myIdCanvas=IdCanvas
            myScrool()\myPos\X=X
            myScrool()\ myPos\Y=Y
            myScrool()\myPos\W=W
            myScrool()\myPos\H=H
            myScrool()\OverArowRigth=#False
            myScrool()\OverArowLeft=#False
            myScrool()\OverButton=#False
            myScrool()\OverStepDown=#False
            myScrool()\OverStepUp=#False
            myScrool()\ProcedureCallBack=*ProcedureCallBack
      EndProcedure
      Procedure SetActifOf(IdScrool)
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  MessageRequester("Error Scrool V","This Id not exist...")
                  ProcedureReturn  -1
            EndIf
            myScrool()\ActifOn=#False
      EndProcedure
      Procedure GetState(IdScrool)
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  MessageRequester("Error Scrool V","This Id not exist...")
                  ProcedureReturn  -1
            EndIf
            ProcedureReturn myScrool()\myState
      EndProcedure
      Procedure SetState(IdScrool,State)
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  MessageRequester("Error Scrool V","This Id not exist...")
                  ProcedureReturn  -1
            EndIf
            myScrool()\myState=State
            ProcedureReturn myScrool()\myState
      EndProcedure
      Procedure SetMinMaxStep(IdScrool,Min,Max,StepValue=1)
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  MessageRequester("Error Scrool V","This Id not exist...")
                  ProcedureReturn  -1
            EndIf
            myScrool()\myMin=Min
            myScrool()\myMax=Max
            myScrool()\myStep=StepValue
            ProcedureReturn IdScrool
      EndProcedure
      Procedure DrawBox()
            Protected Y,H
            DrawingMode(#PB_2DDrawing_Default)
            Box(myScrool()\myPos\X,myScrool()\myPos\Y,myScrool()\myPos\W,myScrool()\myPos\H,$F6F6F6)
            Y=myScrool()\myPos\Y
            H=myScrool()\myPos\H*0.20
            DrawingMode(#PB_2DDrawing_Gradient)
            BackColor($E3E3E3)
            GradientColor(0.2,$F8F8F8)
            FrontColor($E7E7E7)
            LinearGradient(myScrool()\myPos\X,Y,myScrool()\myPos\X,Y+(H*0.4))
            Box(myScrool()\myPos\X,Y,myScrool()\myPos\W,H)
            DrawingMode(#PB_2DDrawing_Outlined)
            Box(myScrool()\myPos\X,Y,myScrool()\myPos\W,H,$D9D9D9)
            Y+(myScrool()\myPos\H-H)
            DrawingMode(#PB_2DDrawing_Gradient)
            BackColor($E3E3E3)
            GradientColor(0.2,$F8F8F8)
            FrontColor($E7E7E7)
            LinearGradient(myScrool()\myPos\X,Y,myScrool()\myPos\X,Y+(H*0.4))
            Box(myScrool()\myPos\X,Y,myScrool()\myPos\W,H)
            DrawingMode(#PB_2DDrawing_Outlined)
            Box(myScrool()\myPos\X,Y,myScrool()\myPos\W,H,$D9D9D9)
      EndProcedure
      Procedure DrawLeftArrow()
            Protected HG,X,Y,H,W
            HG=(myScrool()\myPos\H*0.20)-2
            H=myScrool()\myPos\H-(HG*2)
            H=H*0.8
            ;Centrage
            Y=(myScrool()\myPos\Y+(myScrool()\myPos\H/2))-(H/2)
            X=(myScrool()\myPos\X+myScrool()\myPos\W)-(H+2)
            If myScrool()\OverStepUp Or myScrool()\OverStepDown Or myScrool()\OverArowLeft
                  DrawingMode(#PB_2DDrawing_Gradient)
                  If myScrool()\OverArowLeft=#True
                        BackColor($FEFEF1)
                        GradientColor(0,$FDFDDC)
                        GradientColor(0.5,$FCFBC0)
                        GradientColor(0.6,$FBF88A)
                        GradientColor(0.8,$F7F21B)
                        GradientColor(1,$CECA05)
                        FrontColor($FEFEF1)
                  Else
                        BackColor($F4F4F4)
                        GradientColor(0,$D6D6D6)
                        GradientColor(0.5,$CFCFCF)
                        GradientColor(0.6,$D5D5D5)
                        GradientColor(0.8,$DEDEDE)
                        GradientColor(1,$CCCCCC)
                        FrontColor($F4F4F4)
                  EndIf
                  LinearGradient(X,Y,X,Y+(H*0.5))
                  Box(X,Y,H,H)
                  DrawingMode(#PB_2DDrawing_Outlined)
                  Box(X,Y,H,H,$9D9D9D)
            EndIf
            DrawingMode(#PB_2DDrawing_AlphaClip)
            DrawImage(ImageID(LeftArow),X,Y,H,H)
            myScrool()\PosArrowLeft\X=X
            myScrool()\PosArrowLeft\Y=Y
            myScrool()\PosArrowLeft\W=H
            myScrool()\PosArrowLeft\H=H
      EndProcedure
      Procedure DrawRightArrow()
            Protected HG,X,Y,H,W
            X=myScrool()\myPos\X+2
            HG=(myScrool()\myPos\H*0.20)-2
            H=myScrool()\myPos\H-(HG*2)
            H=H*0.8
            ;Centrage
            Y=(myScrool()\myPos\Y+(myScrool()\myPos\H/2))-(H/2)
            If myScrool()\OverStepUp Or myScrool()\OverStepDown Or myScrool()\OverArowRigth
                  DrawingMode(#PB_2DDrawing_Gradient)
                  If myScrool()\OverArowRigth=#True
                        BackColor($FEFEF1)
                        GradientColor(0,$FDFDDC)
                        GradientColor(0.5,$FCFBC0)
                        GradientColor(0.6,$FBF88A)
                        GradientColor(0.8,$F7F21B)
                        GradientColor(1,$CECA05)
                        FrontColor($FEFEF1)
                  Else
                        BackColor($F4F4F4)
                        GradientColor(0,$D6D6D6)
                        GradientColor(0.5,$CFCFCF)
                        GradientColor(0.6,$D5D5D5)
                        GradientColor(0.8,$DEDEDE)
                        GradientColor(1,$CCCCCC)
                        FrontColor($F4F4F4)
                  EndIf
                  LinearGradient(X,Y,X,Y+(H*0.5))
                  Box(X,Y,H,H)
                  DrawingMode(#PB_2DDrawing_Outlined)
                  Box(X,Y,H,H,$9D9D9D)
            EndIf
            DrawingMode(#PB_2DDrawing_AlphaClip)
            DrawImage(ImageID(RigthArow),X,Y,H,H)
            myScrool()\PosArrowRigth\X=X
            myScrool()\PosArrowRigth\Y=Y
            myScrool()\PosArrowRigth\W=H
            myScrool()\PosArrowRigth\H=H
      EndProcedure
      Procedure DrawButton()
            Protected HG,X,Y,H,W,Image
            HG=(myScrool()\myPos\H*0.20)-2
            H=myScrool()\myPos\H-(HG*2)
            W=(myScrool()\myPos\W-(H*2))-(myScrool()\myMax-myScrool()\myMin)
            H=H*0.8
            X=myScrool()\myPos\X+H+Round(myScrool()\UnityMove*myScrool()\myState,#PB_Round_Up)
            Y=(myScrool()\myPos\Y+myScrool()\myPos\H/2)-(H/2)
            If W<10
                  W=10
            EndIf
            X+myScrool()\DecalButton
            If X+W>myScrool()\PosArrowLeft\X
                  X=myScrool()\PosArrowLeft\X-W
            EndIf
            If  X<myScrool()\PosArrowRigth\X+myScrool()\PosArrowRigth\W
                  X=myScrool()\PosArrowRigth\X+myScrool()\PosArrowRigth\W
            EndIf
            myScrool()\UnityMove=((myScrool()\myPos\W-(H*2))-W)/(myScrool()\myMax-myScrool()\myMin)
            DrawingMode(#PB_2DDrawing_Gradient)
            If myScrool()\OverButton=#False
                  DrawingMode(#PB_2DDrawing_Gradient)
                  BackColor($F4F4F4)
                  GradientColor(0,$D6D6D6)
                  GradientColor(0.5,$CFCFCF)
                  GradientColor(0.6,$D5D5D5)
                  GradientColor(0.8,$DEDEDE)
                  GradientColor(1,$CCCCCC)
                  FrontColor($F4F4F4)
            Else
                  DrawingMode(#PB_2DDrawing_Gradient)
                  BackColor($FCFBC0)
                  GradientColor(0,$FDFCD2)
                  GradientColor(0.5,$F7F219)
                  GradientColor(0.6,$C5C106)
                  GradientColor(0.8,$B5B106)
                  GradientColor(1,$8B8804)
                  FrontColor($FCFBC0)
            EndIf
            LinearGradient(X,Y,X,Y+(H*0.9))
            Box(X,Y,W,H)
            myScrool()\PosButton\X=X
            myScrool()\PosButton\Y=Y
            myScrool()\PosButton\W=W
            myScrool()\PosButton\H=H
            DrawingMode(#PB_2DDrawing_Outlined)
            Box(X,Y,W,H,$B5B5B5)
            ;Dessin des petite ligne du bouton
            If W>20
                  X+(W/2)-2
                  ResetGradientColors()
                  DrawingMode(#PB_2DDrawing_Gradient)
                  BackColor($9D9D9D)
                  FrontColor($EEEEEE )
                  W=3
                  H=H*0.5
                  Y=(myScrool()\myPos\Y+myScrool()\myPos\H/2)-(H/2)
                  LinearGradient(X,Y,X,Y+(H*0.8))
                  Box(X,Y,W,H)
                  DrawingMode(#PB_2DDrawing_Outlined)
                  Box(X,Y,W,H,$B5B5B5)
                  X-5
                  DrawingMode(#PB_2DDrawing_Gradient)
                  BackColor($9D9D9D)
                  FrontColor($EEEEEE )
                  W=3
                  Y=(myScrool()\myPos\Y+myScrool()\myPos\H/2)-(H/2)
                  LinearGradient(X,Y,X,Y+(H*0.8))
                  Box(X,Y,W,H)
                  DrawingMode(#PB_2DDrawing_Outlined)
                  Box(X,Y,W,H,$B5B5B5)
                  X+10
                  DrawingMode(#PB_2DDrawing_Gradient)
                  BackColor($9D9D9D)
                  FrontColor($EEEEEE )
                  W=3
                  Y=(myScrool()\myPos\Y+myScrool()\myPos\H/2)-(H/2)
                  LinearGradient(X,Y,X,Y+(H*0.8))
                  Box(X,Y,W,H)
                  DrawingMode(#PB_2DDrawing_Outlined)
                  Box(X,Y,W,H,$B5B5B5)
            EndIf
      EndProcedure
      Procedure Draw(IdScrool)
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  MessageRequester("Error Scrool H","This Id not exist...")
                  ProcedureReturn  -1
            EndIf
            myScrool()\ActifOn=#True
            DrawBox()
            DrawRightArrow()
            DrawLeftArrow()
            DrawButton()
      EndProcedure
      Procedure WhereIsMouse()
            Protected mouseX,mouseY
            mouseX=GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseX)
            mouseY=GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseY)
            myScrool()\OverArowRigth=#False
            myScrool()\OverArowLeft=#False
            myScrool()\OverButton=#False
            myScrool()\OverStepDown=#False
            myScrool()\OverStepUp=#False
            
            If mouseX>=myScrool()\PosArrowRigth\X And mouseX<=myScrool()\PosArrowRigth\X+myScrool()\PosArrowRigth\W
                  If mouseY>=myScrool()\PosArrowRigth\Y And mouseY<=myScrool()\PosArrowRigth\Y+myScrool()\PosArrowRigth\H
                        myScrool()\OverArowRigth=#True
                  EndIf
            EndIf
            If mouseX>=myScrool()\PosArrowLeft\X And mouseX<=myScrool()\PosArrowLeft\X+myScrool()\PosArrowLeft\W
                  If mouseY>=myScrool()\PosArrowLeft\Y And mouseY<=myScrool()\PosArrowLeft\Y+myScrool()\PosArrowLeft\H
                        myScrool()\OverArowLeft=#True
                  EndIf
            EndIf
            If mouseX>=myScrool()\PosButton\X And mouseX<=myScrool()\PosButton\X+myScrool()\PosButton\W
                  If mouseY>=myScrool()\PosButton\Y And mouseY<=myScrool()\PosButton\Y+myScrool()\PosButton\H
                        myScrool()\OverButton=#True
                  EndIf
            EndIf
            If myScrool()\OverArowRigth=#False And myScrool()\OverArowLeft=#False And myScrool()\OverButton=#False
                  If mouseX>=myScrool()\myPos\X And mouseX<=myScrool()\myPos\X+myScrool()\myPos\W
                        If mouseY>=myScrool()\myPos\Y And mouseY<=myScrool()\myPos\Y+myScrool()\myPos\H
                              If mouseX>myScrool()\PosButton\X+myScrool()\PosButton\W
                                    myScrool()\OverStepDown=#True
                              EndIf
                              If mouseX<myScrool()\PosButton\X
                                    myScrool()\OverStepUp=#True
                              EndIf
                        EndIf
                  EndIf
            EndIf
            If myScrool()\OverArowRigth=#True Or myScrool()\OverArowLeft=#True Or myScrool()\OverButton=#True Or myScrool()\OverStepUp=#True Or myScrool()\OverStepDown=#True
                  ;SetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_Cursor,#PB_Cursor_Hand)
                  myScrool()\RefreshOn=#True
                  ProcedureReturn #True
                  ;                   Draw(Val(MapKey(myScrool())))
            Else
                  ;SetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
                  If myScrool()\RefreshOn=#True
                        myScrool()\RefreshOn=#False
                        ProcedureReturn #True
                  EndIf
                  ProcedureReturn #False
            EndIf
            
      EndProcedure
      Procedure Event(IdScrool,Event)
            Static  OldX,Click
            Protected DepX,Temp,TempSate,DepXP
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  MessageRequester("Error Scrool V","This Id not exist...")
                  ProcedureReturn  #False
            EndIf
            If myScrool()\ActifOn=#False : ProcedureReturn  :EndIf
            If myScrool()\ClicOn=#True And myScrool()\OverArowLeft=#True
                  If Event=#PB_Event_Gadget
                        If EventGadget()=myScrool()\myIdCanvas
                              If EventType()=#PB_EventType_LeftButtonUp
                                    myScrool()\ClicOn=#False
                                    Click=0
                                    ProcedureReturn #True
                              EndIf
                        EndIf
                  EndIf
                  Click+1
                  If Click<10
                        Delay(30)
                  Else
                        Delay(1)
                  EndIf
                  If myScrool()\myState<myScrool()\myMax
                        myScrool()\myState+1
                        If myScrool()\ProcedureCallBack<>-1
                              CallFunctionFast(myScrool()\ProcedureCallBack)
                        EndIf
                        ProcedureReturn #True
                  EndIf
            EndIf
            If myScrool()\ClicOn=#True And myScrool()\OverArowRigth=#True
                  If Event=#PB_Event_Gadget
                        If EventGadget()=myScrool()\myIdCanvas
                              If EventType()=#PB_EventType_LeftButtonUp
                                    myScrool()\ClicOn=#False
                                    Click=0
                                    ProcedureReturn #True
                              EndIf
                        EndIf
                  EndIf
                  Click+1
                  If Click<10
                        Delay(10)
                  Else
                        Delay(1)
                  EndIf
                  If myScrool()\myState>myScrool()\myMin
                        myScrool()\myState-1
                        If myScrool()\ProcedureCallBack<>-1
                              CallFunctionFast(myScrool()\ProcedureCallBack)
                        EndIf
                        ProcedureReturn #True
                  EndIf
            EndIf
            Select Event
                  Case #PB_Event_Gadget
                        Select EventGadget()
                              Case myScrool()\myIdCanvas
                                    Select EventType()
                                          Case #PB_EventType_MouseMove
                                                If myScrool()\ClicOn=#False
                                                      If WhereIsMouse()=#True
                                                            ProcedureReturn #True 
                                                      EndIf
                                                EndIf
                                                If myScrool()\ClicOn=#True And myScrool()\OverButton=#True
                                                       DepX=GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseX)-OldX
                                                      myScrool()\DecalButton=DepX
                                                      If DepX>0
                                                            Temp=Round(DepX/myScrool()\UnityMove,#PB_Round_Up)
                                                            If Temp>0
                                                                  myScrool()\myState+Temp
                                                                  If myScrool()\myState>myScrool()\myMax
                                                                        myScrool()\myState=myScrool()\myMax
                                                                  EndIf
                                                                  OldX=GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseX)
                                                                  myScrool()\DecalButton=0
                                                            EndIf
                                                      EndIf
                                                      If DepX<0
                                                            DepXP=OldX-GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseX)
                                                            Temp=Round(DepXP/myScrool()\UnityMove,#PB_Round_Up)
                                                            If Temp>0
                                                                  myScrool()\myState-Temp
                                                                  If myScrool()\myState<myScrool()\myMin
                                                                        myScrool()\myState=myScrool()\myMin
                                                                  EndIf
                                                                  OldX=GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseX)
                                                                  myScrool()\DecalButton=0
                                                            EndIf
                                                      EndIf
                                                      If myScrool()\ProcedureCallBack<>-1
                                                            CallFunctionFast(myScrool()\ProcedureCallBack)
                                                      EndIf
                                                      ProcedureReturn #True 
                                                EndIf
                                          Case #PB_EventType_LeftButtonDown
                                                If myScrool()\ClicOn=#False
                                                      OldX=GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseX)
                                                EndIf
                                                myScrool()\ClicOn=#True
                                          Case #PB_EventType_LeftButtonUp
                                                myScrool()\ClicOn=#False
                                          Case #PB_EventType_LeftClick
                                                If myScrool()\OverStepDown=#True And myScrool()\OverButton=#False
                                                      myScrool()\myState+myScrool()\myStep
                                                      If myScrool()\myState>myScrool()\myMax
                                                            myScrool()\myState=myScrool()\myMax
                                                      EndIf
                                                      If myScrool()\ProcedureCallBack<>-1
                                                            CallFunctionFast(myScrool()\ProcedureCallBack)
                                                      EndIf
                                                      ProcedureReturn #True
                                                EndIf
                                                If myScrool()\OverStepUp=#True And myScrool()\OverButton=#False
                                                      myScrool()\myState-myScrool()\myStep
                                                      If myScrool()\myState<myScrool()\myMin
                                                            myScrool()\myState=myScrool()\myMin
                                                      EndIf
                                                      If myScrool()\ProcedureCallBack<>-1
                                                            CallFunctionFast(myScrool()\ProcedureCallBack)
                                                      EndIf
                                                      ProcedureReturn #True 
                                                EndIf
                                          Case #PB_EventType_MouseLeave
                                                myScrool()\OverArowLeft=#False
                                                myScrool()\OverArowRigth=#False
                                                myScrool()\OverButton=#False
                                                myScrool()\OverStepDown=#False
                                                myScrool()\OverStepUp=#False
                                          Case #PB_EventType_MouseWheel
                                                If GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_WheelDelta)>0
                                                      myScrool()\myState-myScrool()\myStep/2
                                                      If myScrool()\myState<myScrool()\myMin
                                                            myScrool()\myState=myScrool()\myMin
                                                      EndIf
                                                      If myScrool()\ProcedureCallBack<>-1
                                                            CallFunctionFast(myScrool()\ProcedureCallBack)
                                                      EndIf
                                                      ProcedureReturn #True
                                                Else
                                                      myScrool()\myState+myScrool()\myStep/2
                                                      If myScrool()\myState>myScrool()\myMax
                                                            myScrool()\myState=myScrool()\myMax
                                                      EndIf
                                                      If myScrool()\ProcedureCallBack<>-1
                                                            CallFunctionFast(myScrool()\ProcedureCallBack)
                                                      EndIf
                                                      ProcedureReturn #True
                                                EndIf
                                    EndSelect
                        EndSelect
            EndSelect
            ProcedureReturn #False
      EndProcedure
      DataSection
            LeftArow: :IncludeBinary "IMG\ArowLeft.png"
            RigthArow: :IncludeBinary "IMG\ArowRigth.png"
      EndDataSection        
EndModule

Code : Tout sélectionner

;////////////////////////////////////////////////////////////////////////////////////////////////////////////
; ScrollV
; Vers 1.0 du 2014-08-08
; © AllDev / MicrodevWeb / Bielen Pierre
;////////////////////////////////////////////////////////////////////////////////////////////////////////////
DeclareModule ScrollV
      Declare Init(IdScrool,IdCanvas,X,Y,W,H,*ProcedureCallBack)
      Declare Draw(IdScrool)
      Declare SetMinMaxStep(IdScrool,Min,Max,StepValue=1)
      Declare Event(IdScrool,Event)
      Declare GetState(IdScrool)
      Declare SetActifOf(IdScrool)
      Declare SetState(IdScrool,State)
EndDeclareModule 

Module ScrollV
      UsePNGImageDecoder()
      EnableExplicit
      Global UpArow=CatchImage(#PB_Any,?UpArow)
      Global UpArowOver=CatchImage(#PB_Any,?UpArowOver)
      Global DownArow=CatchImage(#PB_Any,?DownArow)
      Global DownArowOver=CatchImage(#PB_Any,?DownArowOver)
      Structure pos
            X.i
            Y.i
            W.i
            H.i
      EndStructure
      Structure Scrool
            ActifOn.b
            myIdCanvas.i
            myPos.pos
            OverArowUp.b
            OverArowDown.b
            OverButton.b
            OverStepDown.b
            OverStepUp.b
            myMin.i
            myMax.i
            UnityMove.f
            myState.i
            myStep.i
            DecalButton.i
            PosArrowUp.pos
            PosArrowDown.pos
            PosButton.pos
            RefreshOn.b
            ClicOn.b
            *ProcedureCallBack
      EndStructure
      Global NewMap myScrool.Scrool()
      Procedure SetActifOf(IdScrool)
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  MessageRequester("Error Scrool V SetActifOf","This Id "+Str(IdScrool)+" Not exist...")
                  ProcedureReturn  -1
            EndIf
            myScrool()\ActifOn=#False
      EndProcedure
      Procedure Init(IdScrool,IdCanvas,X,Y,W,H,*ProcedureCallBack)
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  AddMapElement(myScrool(),Str(IdScrool))
            EndIf
            myScrool()\myIdCanvas=IdCanvas
            myScrool()\myPos\X=X
            myScrool()\ myPos\Y=Y
            myScrool()\myPos\W=W
            myScrool()\myPos\H=H
            myScrool()\OverArowUp=#False
            myScrool()\OverArowDown=#False
            myScrool()\OverButton=#False
            myScrool()\OverStepDown=#False
            myScrool()\OverStepUp=#False
            myScrool()\ProcedureCallBack=*ProcedureCallBack
      EndProcedure
      Procedure SetState(IdScrool,State)
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  MessageRequester("Error Scrool V SetState","This Id "+Str(IdScrool)+" Not exist...")
                  ProcedureReturn  -1
            EndIf
            myScrool()\myState=State
            ProcedureReturn myScrool()\myState
      EndProcedure
      Procedure SetMinMaxStep(IdScrool,Min,Max,StepValue=1)
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  MessageRequester("Error Scrool V SetMinMaxStep","This Id "+Str(IdScrool)+" Not exist...")
                  ProcedureReturn  -1
            EndIf
            myScrool()\myMin=Min
            myScrool()\myMax=Max
            myScrool()\myStep=StepValue
            ProcedureReturn IdScrool
      EndProcedure
      Procedure GetState(IdScrool)
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  MessageRequester("Error Scrool V GetState","This Id "+Str(IdScrool)+" Not exist...")
                  ProcedureReturn  -1
            EndIf
            ProcedureReturn myScrool()\myState
      EndProcedure
      Procedure WhereIsMouse()
            Protected mouseX,mouseY
            mouseX=GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseX)
            mouseY=GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseY)
            myScrool()\OverArowUp=#False
            myScrool()\OverArowDown=#False
            myScrool()\OverButton=#False
            myScrool()\OverStepDown=#False
            myScrool()\OverStepUp=#False
            
            If mouseX>=myScrool()\PosArrowUp\X And mouseX<=myScrool()\PosArrowUp\X+myScrool()\PosArrowUp\W
                  If mouseY>=myScrool()\PosArrowUp\Y And mouseY<=myScrool()\PosArrowUp\Y+myScrool()\PosArrowUp\H
                        myScrool()\OverArowUp=#True
                  EndIf
            EndIf
            If mouseX>=myScrool()\PosArrowDown\X And mouseX<=myScrool()\PosArrowDown\X+myScrool()\PosArrowDown\W
                  If mouseY>=myScrool()\PosArrowDown\Y And mouseY<=myScrool()\PosArrowDown\Y+myScrool()\PosArrowDown\H
                        myScrool()\OverArowDown=#True
                  EndIf
            EndIf
            If mouseX>=myScrool()\PosButton\X And mouseX<=myScrool()\PosButton\X+myScrool()\PosButton\W
                  If mouseY>=myScrool()\PosButton\Y And mouseY<=myScrool()\PosButton\Y+myScrool()\PosButton\H
                        myScrool()\OverButton=#True
                  EndIf
            EndIf
            If myScrool()\OverArowUp=#False And myScrool()\OverArowDown=#False And myScrool()\OverButton=#False
                  If mouseX>=myScrool()\myPos\X And mouseX<=myScrool()\myPos\X+myScrool()\myPos\W
                        If mouseY>=myScrool()\myPos\Y And mouseY<=myScrool()\myPos\Y+myScrool()\myPos\H
                              If mouseY>myScrool()\PosButton\Y+myScrool()\PosButton\H
                                    myScrool()\OverStepDown=#True
                              EndIf
                              If mouseY<myScrool()\PosButton\Y
                                    myScrool()\OverStepUp=#True
                              EndIf
                        EndIf
                  EndIf
            EndIf
            If myScrool()\OverArowUp=#True Or myScrool()\OverArowDown=#True Or myScrool()\OverButton=#True Or myScrool()\OverStepUp=#True Or myScrool()\OverStepDown=#True
                  ;SetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_Cursor,#PB_Cursor_Hand)
                  myScrool()\RefreshOn=#True
                  ProcedureReturn #True
                  ;                   Draw(Val(MapKey(myScrool())))
            Else
                  ;SetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
                  If myScrool()\RefreshOn=#True
                        myScrool()\RefreshOn=#False
                        ProcedureReturn #True
                  EndIf
                  ProcedureReturn #False
            EndIf
            
      EndProcedure
      Procedure Event(IdScrool,Event)
            Static  OldY,Click
            Protected DepY,Temp,TempSate,DepYP
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  MessageRequester("Error Scrool V Event","This Id "+Str(IdScrool)+" Not exist...")
                  ProcedureReturn  #False
            EndIf
            If myScrool()\ActifOn=#False : ProcedureReturn  :EndIf
            If myScrool()\ClicOn=#True And myScrool()\OverArowDown=#True
                  If Event=#PB_Event_Gadget
                        If EventGadget()=myScrool()\myIdCanvas
                              If EventType()=#PB_EventType_LeftButtonUp
                                    myScrool()\ClicOn=#False
                                    Click=0
                                    ProcedureReturn #True
                              EndIf
                        EndIf
                  EndIf
                  Click+1
                  If Click<10
                        Delay(30)
                  Else
                        Delay(1)
                  EndIf
                  If myScrool()\myState<myScrool()\myMax
                        myScrool()\myState+1
                        If myScrool()\ProcedureCallBack<>-1
                              CallFunctionFast(myScrool()\ProcedureCallBack)
                        EndIf
                        ProcedureReturn #True
                  EndIf
            EndIf
            If myScrool()\ClicOn=#True And myScrool()\OverArowUp=#True
                  If Event=#PB_Event_Gadget
                        If EventGadget()=myScrool()\myIdCanvas
                              If EventType()=#PB_EventType_LeftButtonUp
                                    myScrool()\ClicOn=#False
                                    Click=0
                                    ProcedureReturn #True
                              EndIf
                        EndIf
                  EndIf
                  Click+1
                  If Click<10
                        Delay(10)
                  Else
                        Delay(1)
                  EndIf
                  If myScrool()\myState>myScrool()\myMin
                        myScrool()\myState-1
                        If myScrool()\ProcedureCallBack<>-1
                              CallFunctionFast(myScrool()\ProcedureCallBack)
                        EndIf
                        ProcedureReturn #True
                  EndIf
            EndIf
            Select Event
                  Case #PB_Event_Gadget
                        Select EventGadget()
                              Case myScrool()\myIdCanvas
                                    Select EventType()
                                          Case #PB_EventType_MouseMove
                                                If myScrool()\ClicOn=#False
                                                      If WhereIsMouse()=#True
                                                            ProcedureReturn #True 
                                                      EndIf
                                                EndIf
                                                If myScrool()\ClicOn=#True And myScrool()\OverButton=#True
                                                      DepY=GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseY)-OldY
                                                      myScrool()\DecalButton=DepY
                                                      If DepY>0
                                                            Temp=Round(DepY/myScrool()\UnityMove,#PB_Round_Up)
                                                            If Temp>0
                                                                  myScrool()\myState+Temp
                                                                  If myScrool()\myState>myScrool()\myMax
                                                                        myScrool()\myState=myScrool()\myMax
                                                                  EndIf
                                                                  OldY=GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseY)
                                                                  myScrool()\DecalButton=0
                                                            EndIf
                                                      EndIf
                                                      If DepY<0
                                                            DepYP=OldY-GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseY)
                                                            Temp=Round(DepYP/myScrool()\UnityMove,#PB_Round_Up)
                                                            If Temp>0
                                                                  myScrool()\myState-Temp
                                                                  If myScrool()\myState<myScrool()\myMin
                                                                        myScrool()\myState=myScrool()\myMin
                                                                  EndIf
                                                                  OldY=GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseY)
                                                                  myScrool()\DecalButton=0
                                                            EndIf
                                                      EndIf
                                                      If myScrool()\ProcedureCallBack<>-1
                                                            CallFunctionFast(myScrool()\ProcedureCallBack)
                                                      EndIf
                                                      ProcedureReturn #True 
                                                EndIf
                                          Case #PB_EventType_LeftButtonDown
                                                If myScrool()\ClicOn=#False
                                                      OldY=GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_MouseY)
                                                EndIf
                                                myScrool()\ClicOn=#True
                                          Case #PB_EventType_LeftButtonUp
                                                myScrool()\ClicOn=#False
                                          Case #PB_EventType_LeftClick
                                                If myScrool()\OverStepDown=#True And myScrool()\OverButton=#False
                                                      myScrool()\myState+myScrool()\myStep
                                                      If myScrool()\myState>myScrool()\myMax
                                                            myScrool()\myState=myScrool()\myMax
                                                      EndIf
                                                      If myScrool()\ProcedureCallBack<>-1
                                                            CallFunctionFast(myScrool()\ProcedureCallBack)
                                                      EndIf
                                                      ProcedureReturn #True
                                                EndIf
                                                If myScrool()\OverStepUp=#True And myScrool()\OverButton=#False
                                                      myScrool()\myState-myScrool()\myStep
                                                      If myScrool()\myState<myScrool()\myMin
                                                            myScrool()\myState=myScrool()\myMin
                                                      EndIf
                                                       If myScrool()\ProcedureCallBack<>-1
                                                            CallFunctionFast(myScrool()\ProcedureCallBack)
                                                      EndIf
                                                      ProcedureReturn #True 
                                                EndIf
                                          Case #PB_EventType_MouseLeave
                                                myScrool()\OverArowDown=#False
                                                myScrool()\OverArowUp=#False
                                                myScrool()\OverButton=#False
                                                myScrool()\OverStepDown=#False
                                                myScrool()\OverStepUp=#False
                                          Case #PB_EventType_MouseWheel
                                                If GetGadgetAttribute(myScrool()\myIdCanvas,#PB_Canvas_WheelDelta)>0
                                                      myScrool()\myState-myScrool()\myStep/2
                                                      If myScrool()\myState<myScrool()\myMin
                                                            myScrool()\myState=myScrool()\myMin
                                                      EndIf
                                                      If myScrool()\ProcedureCallBack<>-1
                                                            CallFunctionFast(myScrool()\ProcedureCallBack)
                                                      EndIf
                                                      ProcedureReturn #True
                                                Else
                                                      myScrool()\myState+myScrool()\myStep/2
                                                      If myScrool()\myState>myScrool()\myMax
                                                            myScrool()\myState=myScrool()\myMax
                                                      EndIf
                                                      If myScrool()\ProcedureCallBack<>-1
                                                            CallFunctionFast(myScrool()\ProcedureCallBack)
                                                      EndIf
                                                      ProcedureReturn #True
                                                EndIf
                                    EndSelect
                        EndSelect
            EndSelect
            ProcedureReturn #False
      EndProcedure
      Procedure DrawBox()
            Protected X,W
            DrawingMode(#PB_2DDrawing_Default)
            Box(myScrool()\myPos\X,myScrool()\myPos\Y,myScrool()\myPos\W,myScrool()\myPos\H,$F6F6F6)
            X=myScrool()\myPos\X
            W=myScrool()\myPos\W*0.20
            DrawingMode(#PB_2DDrawing_Gradient)
            BackColor($E3E3E3)
            GradientColor(0.2,$F8F8F8)
            FrontColor($E7E7E7)
            LinearGradient(X,myScrool()\myPos\Y,X+W*(0.4),myScrool()\myPos\Y)
            Box(X,myScrool()\myPos\Y,W,myScrool()\myPos\H)
            DrawingMode(#PB_2DDrawing_Outlined)
            Box(X,myScrool()\myPos\Y,W,myScrool()\myPos\H,$D9D9D9)
            X+(myScrool()\myPos\W-W)
            DrawingMode(#PB_2DDrawing_Gradient)
            BackColor($E3E3E3)
            GradientColor(0.2,$F8F8F8)
            FrontColor($E7E7E7)
            LinearGradient(X,myScrool()\myPos\Y,X+W*(0.1),myScrool()\myPos\Y)
            Box(X,myScrool()\myPos\Y,W,myScrool()\myPos\H)
            DrawingMode(#PB_2DDrawing_Outlined)
            Box(X,myScrool()\myPos\Y,W,myScrool()\myPos\H,$D9D9D9)
      EndProcedure
      Procedure DrawUpArrow()
            Protected WG,X,Y,H,W
            Y=myScrool()\myPos\Y+2
            WG=(myScrool()\myPos\W*0.20)-2
            W=myScrool()\myPos\W-(WG*2)
            W=W*0.8
            X=(myScrool()\myPos\X+(myScrool()\myPos\W/2))-(W/2)
            If myScrool()\OverStepUp Or myScrool()\OverStepDown Or myScrool()\OverArowUp
                  DrawingMode(#PB_2DDrawing_Gradient)
                  If myScrool()\OverArowUp=#True
                        BackColor($FEFEF1)
                        GradientColor(0,$FDFDDC)
                        GradientColor(0.5,$FCFBC0)
                        GradientColor(0.6,$FBF88A)
                        GradientColor(0.8,$F7F21B)
                        GradientColor(1,$CECA05)
                        FrontColor($FEFEF1)
                  Else
                        BackColor($F4F4F4)
                        GradientColor(0,$D6D6D6)
                        GradientColor(0.5,$CFCFCF)
                        GradientColor(0.6,$D5D5D5)
                        GradientColor(0.8,$DEDEDE)
                        GradientColor(1,$CCCCCC)
                        FrontColor($F4F4F4)
                  EndIf
                  LinearGradient(X,Y,X+W*0.5,Y)
                  Box(X,Y,W,W)
                  ;ResetGradientColors()
                  DrawingMode(#PB_2DDrawing_Outlined)
                  Box(X,Y,W,W,$9D9D9D)
            EndIf
            
            DrawingMode(#PB_2DDrawing_AlphaClip)
            DrawImage(ImageID(UpArow),X,Y,W,W)
            myScrool()\PosArrowUp\X=X
            myScrool()\PosArrowUp\Y=Y
            myScrool()\PosArrowUp\W=W
            myScrool()\PosArrowUp\H=W
      EndProcedure
      Procedure DrawDownArrow()
            Protected WG,X,Y,H,W,Image
            WG=(myScrool()\myPos\W*0.20)-2
            W=myScrool()\myPos\W-(WG*2)
            W=W*0.8
            Y=(myScrool()\myPos\Y+myScrool()\myPos\H)-(W+2)
            X=(myScrool()\myPos\X+(myScrool()\myPos\W/2))-(W/2)
            If myScrool()\OverStepUp Or myScrool()\OverStepDown Or myScrool()\OverArowDown
                  DrawingMode(#PB_2DDrawing_Gradient)
                  If myScrool()\OverArowDown=#True
                        BackColor($FEFEF1)
                        GradientColor(0,$FDFDDC)
                        GradientColor(0.5,$FCFBC0)
                        GradientColor(0.6,$FBF88A)
                        GradientColor(0.8,$F7F21B)
                        GradientColor(1,$CECA05)
                        FrontColor($FEFEF1)
                  Else
                        BackColor($F4F4F4)
                        GradientColor(0,$D6D6D6)
                        GradientColor(0.5,$CFCFCF)
                        GradientColor(0.6,$D5D5D5)
                        GradientColor(0.8,$DEDEDE)
                        GradientColor(1,$CCCCCC)
                        FrontColor($F4F4F4)
                  EndIf
                  LinearGradient(X,Y,X+W*0.5,Y)
                  Box(X,Y,W,W)
                  ;ResetGradientColors()
                  DrawingMode(#PB_2DDrawing_Outlined)
                  Box(X,Y,W,W,$9D9D9D)
            EndIf
            DrawingMode(#PB_2DDrawing_AlphaClip)
            DrawImage(ImageID(DownArow),X,Y,W,W)
            myScrool()\PosArrowDown\X=X
            myScrool()\PosArrowDown\Y=Y
            myScrool()\PosArrowDown\W=W
            myScrool()\PosArrowDown\H=W
      EndProcedure
      Procedure DrawButton()
            Protected WG,X,Y,H,W,Image
            WG=(myScrool()\myPos\W*0.20)-2
            W=myScrool()\myPos\W-(WG*2)
            H=(myScrool()\myPos\H-(W*2))-(myScrool()\myMax-myScrool()\myMin)
            W=W*0.8
            Y=myScrool()\myPos\Y+W+Round(myScrool()\UnityMove*myScrool()\myState,#PB_Round_Up)
            X=(myScrool()\myPos\X+myScrool()\myPos\W/2)-(W/2)
            If H<10
                  H=10
            EndIf
            Y+myScrool()\DecalButton
            If Y+H>myScrool()\PosArrowDown\Y
                  Y=myScrool()\PosArrowDown\Y-H
            EndIf
            If  Y<myScrool()\PosArrowUp\Y+myScrool()\PosArrowUp\H
                  Y=myScrool()\PosArrowUp\Y+myScrool()\PosArrowUp\H
            EndIf
            myScrool()\UnityMove=((myScrool()\myPos\H-(W*2))-H)/(myScrool()\myMax-myScrool()\myMin)
            DrawingMode(#PB_2DDrawing_Gradient)
            If myScrool()\OverButton=#False
                  DrawingMode(#PB_2DDrawing_Gradient)
                  BackColor($F4F4F4)
                  GradientColor(0,$D6D6D6)
                  GradientColor(0.5,$CFCFCF)
                  GradientColor(0.6,$D5D5D5)
                  GradientColor(0.8,$DEDEDE)
                  GradientColor(1,$CCCCCC)
                  FrontColor($F4F4F4)
            Else
                  DrawingMode(#PB_2DDrawing_Gradient)
                  BackColor($FCFBC0)
                  GradientColor(0,$FDFCD2)
                  GradientColor(0.5,$F7F219)
                  GradientColor(0.6,$C5C106)
                  GradientColor(0.8,$B5B106)
                  GradientColor(1,$8B8804)
                  FrontColor($FCFBC0)
            EndIf
            LinearGradient(X,Y,X+(W*0.9),Y)
            Box(X,Y,W,H)
            myScrool()\PosButton\X=X
            myScrool()\PosButton\Y=Y
            myScrool()\PosButton\W=W
            myScrool()\PosButton\H=H
            DrawingMode(#PB_2DDrawing_Outlined)
            Box(X,Y,W,H,$B5B5B5)
            ;Dessin des petite ligne du bouton
            If H>20
                  Y+(H/2)-2
                  ResetGradientColors()
                  DrawingMode(#PB_2DDrawing_Gradient)
                  BackColor($9D9D9D)
                  FrontColor($EEEEEE )
                  H=3
                  W=W*0.5
                  X=(myScrool()\myPos\X+myScrool()\myPos\W/2)-(W/2)
                  LinearGradient(X,Y,X+(W*0.8),Y)
                  Box(X,Y,W,H)
                  DrawingMode(#PB_2DDrawing_Outlined)
                  Box(X,Y,W,H,$B5B5B5)
                  Y-5
                  DrawingMode(#PB_2DDrawing_Gradient)
                  BackColor($9D9D9D)
                  FrontColor($EEEEEE )
                  H=3
                  X=(myScrool()\myPos\X+myScrool()\myPos\W/2)-(W/2)
                  LinearGradient(X,Y,X+(W*0.8),Y)
                  Box(X,Y,W,H)
                  DrawingMode(#PB_2DDrawing_Outlined)
                  Box(X,Y,W,H,$B5B5B5)
                  Y+10
                  DrawingMode(#PB_2DDrawing_Gradient)
                  BackColor($9D9D9D)
                  FrontColor($EEEEEE )
                  H=3
                  X=(myScrool()\myPos\X+myScrool()\myPos\W/2)-(W/2)
                  LinearGradient(X,Y,X+(W*0.8),Y)
                  Box(X,Y,W,H)
                  DrawingMode(#PB_2DDrawing_Outlined)
                  Box(X,Y,W,H,$B5B5B5)
            EndIf
      EndProcedure
      Procedure Draw(IdScrool)
            If FindMapElement(myScrool(),Str(IdScrool))=0
                  MessageRequester("Error Scrool V","This Id "+Str(IdScrool)+" Not exist...")
                  ProcedureReturn  -1
            EndIf
            ;StartDrawing(CanvasOutput(myScrool()\myIdCanvas))
            myScrool()\ActifOn=#True
            DrawBox()
            DrawUpArrow()
            DrawDownArrow()
            DrawButton()
            ;StopDrawing()
      EndProcedure
      DataSection
            UpArow: :IncludeBinary "IMG/ArowUp.png"
            UpArowOver: :IncludeBinary "IMG/ArowUpOver.png"
            DownArow: :IncludeBinary "IMG/ArowDown.png"
            DownArowOver: :IncludeBinary "IMG/ArowDownOver.png"
      EndDataSection
EndModule

Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Ascenseur dans canvas

Message par falsam »

Bonjour microdevweb.

Merci pour le partage. (ça c'est fait :) )

Je suis entrain de tester tes deux includes et je voulais juste t'informer qu'il manque dans le fichier compressé les images ArowUpOver.png et ArowDownOver.png

N'étant pas handicapé des doigts, je me suis débrouillé et j'ai maintenant les deux images manquantes.

Par contre je n'ai pas réussi à faire fonctionner tes includes. Je n'ai pas d'erreur mais il ne se passe rien à l'écran. Il est vrai que je n'ai eu qu'à peine deux heures de sommeil aussi :mrgreen:

Pourrais tu poster un code minimal stp ? merci :) (Avec le sourire ...si si)
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Ascenseur dans canvas

Message par falsam »

Je pensais qu'avec ce simple code je verrais l'apparition d'un ascenceur vertical sur le canvas. Apparement non
IncludeFile "ScroolV.pbi"

Enumeration
  #Mainform
  #Canvas
EndEnumeration

Procedure CanvasCallback()
  ;Rien  pour le moment
EndProcedure

OpenWindow(#Mainform, 0, 0, 800, 600, "Canvas Scroll Bar Vertical", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CanvasGadget(#Canvas, 0, 0, 400, 300) 

ScrollV::Init(1,#Canvas,X,Y,W,H,@CanvasCallback())

Repeat : Until WaitWindowEvent(10) = #PB_Event_CloseWindow
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: Ascenseur dans canvas

Message par microdevweb »

Bonjour Falsam Voila

Code : Tout sélectionner

XIncludeFile "ScroolV.pbi"

OpenWindow(0,0,0,800,600,"Teste")
CanvasGadget(1,0,0,400,400,#PB_Canvas_Keyboard)
Procedure Teste()
      Debug ScrollV::GetState(1)
EndProcedure
ScrollV::Init(1,1,50,100,20,300,@Teste())
ScrollV::SetMinMaxStep(1,0,150,10)
StartDrawing(CanvasOutput(1))
ScrollV::Draw(1)
StopDrawing()

Repeat
      Event=WindowEvent()
     Delay(1)
     If ScrollV::Event(1,Event)
           StartDrawing(CanvasOutput(1))
           ScrollV::Draw(1)
           StopDrawing() 
     EndIf
Until Event=#PB_Event_CloseWindow

Tiens une petite question au passage comment inclure une image en data pure, j'avais vu que dobro avais cela pour son éditeur de fenêtre cela éviterais de devoir livré les images?
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Ascenseur dans canvas

Message par Micoute »

Bonjour falsam, voici ma petite contribution

Code : Tout sélectionner

Enumeration Fenetre
  #Fenetre_principale
EndEnumeration

Enumeration Gadget
  #Gadget
EndEnumeration


Global NewList Element.s()
Global PositionAscenseur.i, AutoriserAscenseur.i
Define I

For I = 1 To 100
  AddElement(Element())
  Element() = "Rangée " + Str(I)
Next

Procedure CanvasGadgetUpdate(Gadget)
  Protected HauteurPolice.i, X.i, Y.i, Hauteur.i
  If StartDrawing(CanvasOutput(Gadget))
    Box(0, 0, OutputWidth(), OutputHeight(), $FFFFFF)
    
    DrawingMode(#PB_2DDrawing_Transparent)
    HauteurPolice = TextHeight("#")
    
    ;- Liste des Elements
    If SelectElement(Element(), PositionAscenseur)
      Repeat
        DrawText(0, Y, Element(), $000000)
        
        Y + HauteurPolice
      Until NextElement(Element()) = #False Or Y > OutputHeight()
    EndIf
    
    ;- Ascenseur
    X = OutputWidth() - 20
    Box(X, 0, 20,OutputHeight(), $F0F0F0)
    
    Hauteur = OutputHeight() * OutputHeight() / (ListSize(Element()) * HauteurPolice)
    If Hauteur < OutputHeight()
      If Hauteur < 20
        Hauteur = 20
      EndIf
      Y = (OutputHeight()-Hauteur) * (PositionAscenseur * HauteurPolice) / ((ListSize(Element()) - 1) * HauteurPolice)
      If GetGadgetAttribute(Gadget, #PB_Canvas_MouseX) >= X
        AutoriserAscenseur = #True
        Box(X, Y, 20, Hauteur, $A0A0A0)
        
        If GetGadgetAttribute(Gadget, #PB_Canvas_Buttons) & #PB_Canvas_LeftButton
          PositionAscenseur = (ListSize(Element())-1) * (GetGadgetAttribute(Gadget, 
                                                                            #PB_Canvas_MouseY) - Hauteur / 2) / (OutputHeight() - Hauteur)
          If PositionAscenseur < 0
            PositionAscenseur = 0
          ElseIf PositionAscenseur > ListSize(Element()) - 1
            PositionAscenseur = ListSize(Element()) - 1
          EndIf
        EndIf
      Else
        AutoriserAscenseur = #False
        Box(X, Y, 20, Hauteur, $D0D0D0)
      EndIf
    Else
      AutoriserAscenseur = #False
    EndIf
    StopDrawing()
  EndIf
EndProcedure

Procedure CanvasGadgetEvent(Gadget)
  Select EventType()
    Case #PB_EventType_MouseWheel
      PositionAscenseur - 3 * GetGadgetAttribute(Gadget, #PB_Canvas_WheelDelta)
      If PositionAscenseur < 0
        PositionAscenseur = 0
      ElseIf PositionAscenseur > ListSize(Element()) - 1
        PositionAscenseur = ListSize(Element()) - 1
      EndIf
      CanvasGadgetUpdate(Gadget)
    Case #PB_EventType_MouseMove, #PB_EventType_LeftButtonDown
      CanvasGadgetUpdate(Gadget)
  EndSelect
EndProcedure


OpenWindow(#Fenetre_principale, 
           0, 0, 400, 300, "Ascenseur Canvas", #PB_Window_MinimizeGadget|
                                               #PB_Window_ScreenCentered|#PB_Window_SizeGadget)

CanvasGadget(#Gadget, 0, 0, WindowWidth(#Fenetre_principale), WindowHeight(#Fenetre_principale), 
             #PB_Canvas_Keyboard)

CanvasGadgetUpdate(#Gadget)

Repeat
  
  Select WaitWindowEvent()
      
    Case #PB_Event_CloseWindow
      End
      
    Case #PB_Event_SizeWindow
      ResizeGadget(#Gadget, 0, 0, WindowWidth(#Fenetre_principale), WindowHeight(#Fenetre_principale))
      CanvasGadgetUpdate(#Gadget)
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #Gadget
          CanvasGadgetEvent(#Gadget)
      EndSelect
      
  EndSelect
  
ForEver
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Ascenseur dans canvas

Message par falsam »

microdevweb a écrit :Tiens une petite question au passage comment inclure une image en data pure, j'avais vu que dobro avais cela pour son éditeur de fenêtre cela éviterais de devoir livré les images?
la réponse de fortix
:idea: http://www.purebasic.fr/french/viewtopi ... 38#p166238

Merci pour ton code :)

@Micoute: Merci aussi pour ta contribution, mais elle n'était pas en rapport avec le module de Fortix qui est le sujet de ce topic. (Vais je me faire encore engueuler ? :mrgreen: )
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: Ascenseur dans canvas

Message par microdevweb »

Merci falsam bien pratique... :lol:
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: Ascenseur dans canvas

Message par microdevweb »

Hum ne fonctionne pas avec cette image
Image
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Ascenseur dans canvas

Message par Kwai chang caine »

Merci à MicrodevWeb 8)
Mais aussi à Micoute, c'est bien de pouvoir utiliser un PBI d'un seul clic :wink:
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Ascenseur dans canvas

Message par falsam »

microdevweb a écrit :Hum ne fonctionne pas avec cette image
Image
Souci dans la gestion des transparences.

Le code de ts-soft (Forum Anglais) fonctionne. On peut aussi mettre des sons en datasection
:arrow: Lien du code https://dl.dropboxusercontent.com/u/3086026/Bin2Data.pb

Et le lien du topic en anglais.
:arrow: http://www.purebasic.fr/english/viewtopic.php?p=374183
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Ascenseur dans canvas

Message par falsam »

Exemple avec une de tes images

Code : Tout sélectionner

UsePNGImageDecoder()

Image = CatchImage(#PB_Any, ?ArowDown_png_start)  
OpenWindow(0, 0, 0, ImageWidth(Image), ImageHeight(Image), "Preview")
ImageGadget(0, 0, 0, 0, 0, ImageID(Image))
Repeat : Until WaitWindowEvent(100) = #PB_Event_CloseWindow


DataSection
  ArowDown_png_start:
    ; size : 2854 bytes
    Data.q $0A1A0A0D474E5089,$524448490D000000,$1400000014000000,$1D898D0000000608,$434369370A00000D
    Data.q $4549204247527350,$322D363639313643,$969D9C780000312E,$BDCF8716D9535477,$D0948A109250BD37
    Data.q $48BD0D480252686B,$C04A1009312A2E91,$4470544436220090,$80E0283208A69151,$01858A22B19143A3
    Data.q $71D4441904EBB151,$19AD6449961B1470,$1FDF9BCDEF79BCDF,$67DDCFBD9F6B7EF7,$83FC9000BAD67DEF
    Data.q $A10C8009584CC205,$8B8D88C5E7E11458,$0300F00C01076067,$1642B3B370E0006C,$8CD87C02990246F8
    Data.q $0EBABD17F813996C,$C18C3FD32AFBF920,$312259B9949FFF00,$D9F8F2E78C985000,$9C573D38C917195C
    Data.q $4D34B698C94FB725,$32825922CE4A30CE,$F67C5B2CF2739356,$3C8432F3390F6599,$E4F065E2CE73CB19
    Data.q $8CBE12398DE327DC,$B9F808E717196091,$864974836326BE32,$4E7C19B1E46FC640,$73E62EDC92280036
    Data.q $322892632D6C6453,$C948E00079E32D82,$13CFCC582FD2F05F,$122E5ACCCEC50FCB,$86535C261988A724
    Data.q $4DCFCFE18B13938D,$8D370E30CCC58BE7,$1C591999D831E223,$1459FCCF660072E1,$38D83B22B2196D79
    Data.q $28BE6D2D6D303839,$76F7929BFC5D7FD4,$1F4419EE7F845E96,$000D997E57F6C3F8,$6D87FAD9B565A6B0
    Data.q $BB5001EB5D001569,$B28A002F60CD87FD,$7CBA1E717D0E75BE,$AB2B672CE2C4525E,$296B9F014B5CDCDC
    Data.q $437F0E9FFAEFE82F,$E5EFDDBE52CF7C5F,$3174923893F37861,$44A67A666E375E43,$E60CF970E2CEC8C4
    Data.q $1E75FE071FF8879F,$942F88BE24FC1116,$964C204CA6CB4445,$4299058813C85BB5,$C30FF89A9FF84086
    Data.q $F8DA8996B9D9A4FE,$1A21A5025896D011,$20112A28001E7E40,$0B7DEFD02B647B09,$99D18BCDF90347C6
    Data.q $577DFE82CFFB9D98,$8E7F2416C8FE4CB8,$CE5112B832444763,$002034025AFC9AEC,$03E81B40EA034045
    Data.q $00B811C0B604C013,$048828410203E00F,$01901482E0316071,$18A0B58014172044,$7506A82760AD8294
    Data.q $74187036833411A0,$812E073834E06381,$0E305201DC0460CB,$1040CC0AF029809E,$7487521510C88584
    Data.q $905885B21CC84320,$1C5011430503E41B,$1502484243250894,$86AA1CA852A0EB40,$7428E85BE866A1EA
    Data.q $51A0B7430D00BA1A,$3023077A15FA1268,$056C11B05AC1A609,$17848E08384F60B3,$822E1F3832F0C9C1
    Data.q $EE107C037095C0B7,$0A5811E097C34F84,$3A11108011A7813F,$4246C21611308BA2,$90AB211109247891
    Data.q $1E90DA406902A412,$C8A791488AB91FA4,$4C5031454506145B,$A2E285151FCA0B94,$51AAA336A156A196
    Data.q $D455D43EA89D5007,$6B464D11F50A6A28,$2C7400E8CED1CDA2,$A057462E8B9D193A,$F411E8B3E81DD09B
    Data.q $8C63A1830615FA38,$15261C4C7F188E31,$8ED31BB319B302B3,$B1A6618CC6198539,$0D8AEB1CD63AAC58
    Data.q $0AB6316C62B072C5,$8E3B057B127B107B,$38B67074E223837D,$55C42B884E3C5C5F,$1370577027705AE0
    Data.q $8CEF10DE12BC19B8,$F865F1CBF0F3C50F,$9F8E3F087E0F7C46,$4884AE098C132821,$46D092A12D612A42
    Data.q $122441784BB84B38,$B880A270C44E88F5,$1C4F3C443C495886,$362466485125BE25,$27ED216D21248129
    Data.q $C99320BD22DD229D,$DE4C593C720F6446,$BF27DF219F266E42,$F028042A582AA051,$5C2A7428D42B5614
    Data.q $F454345788A67851,$78A158AF98AC5C54,$C95E12A9F1487144,$54A55A51C4AD8948,$32B4D286E95474A3
    Data.q $794339543946D955,$1447E505F28B72B3,$8A51E143E288C52C,$845463286728FB28,$D475D4B953654FAA
    Data.q $33430D38EA59EA46,$6FB4A56952D005A6,$9D8A8A1529B48368,$71CA8D4A9E4AB44A,$E803D11BA11D2915
    Data.q $FA75FA61FA32F4E9,$EABE554F552D553B,$D5AFAA2BD536D526,$D44AD5F1A879A8E6,$D433A9DED446D5DA
    Data.q $A977A9B7D4D3D47D,$6B8469986940D3DF,$74F1AB38D1EC6AE4,$929CEE1CCB8E6D0E,$CD3584D6DCE78739
    Data.q $1CD3EE6857342334,$CAD3F2D6D2D69CD0,$9B54F5A33AD2AAD2,$FB43BDAA9DA1EDAE,$474DC7550EA4F684
    Data.q $8663CEA4E743B3A0,$F464A8CE9193C30A,$2575FD753574A631,$C67A33BA83BAF5BA,$F77AED7A857A517A
    Data.q $1DFD24FD2CFA09F4,$21063A0653FABDFA,$F10DB706AD060506,$FD865DC314C32C86,$368C628D8C8DAF86
    Data.q $0E3356323D197518,$426BBE356E37CE30,$7260D26659377136,$DD334D32CA6314CD,$4B37B3360CD97A6D
    Data.q $1DCD87321B31AB31,$D02D87CDBBE605CC,$1B8B068B42164E16,$656CC39993D3124C,$2D0B2D832DD25A8E
    Data.q $5BC55819599F2CBB,$6F6D68FAB7EAB36D,$6286C77D68DD6E9D,$ABF363D368536813,$DAF6C6B6D72D99AD
    Data.q $76E7ABB9DF5CF25C,$DBB7C76E676E7DCF,$BF621F6A9ED37763,$83A38383FED7BEC1,$31C0D1D261CDA1C8
    Data.q $0AC68B06F1D6B1D1,$793B42779D666D63,$D9D6F4E63A76AD39,$1717F9D87CEC59C1,$79A3CB8B4B9A4BA6
    Data.q $B98DE71AF3F8F3C6,$6EA55DEB5C72B9EA,$77526EBDB744B70C,$0F03FB837B8E775D,$A784C793479E0F7D
    Data.q $5E67CF41E7AA67A9,$6CD7AF0EAF225ED6,$DBC46F29F64AF667,$13E287D07BC4BBCF,$37CF57DF73ED53E5
    Data.q $6FDECFCA77D5B7D9,$FF907FB47F29DF85,$80DC015A011BFF36,$8195C0C740A980E6,$41D54105A0A4417D
    Data.q $213DC14582CD820F,$F3BB90F6C8604870,$D0828577E70BE70D,$C38CC2F7A1EDD080,$0B0F098E1F7D8596
    Data.q $10511361187F09AF,$9682C960BA80BFD1,$EF22CB22BD22AF05,$15A37AA249449944,$78C75FA39BA213A3
    Data.q $5762AD6348C794C7,$75C41388D38A5EC6,$A7E29BE3A3E363C7,$C13C70B9DC2CFA17,$45E322FAE138A13E
    Data.q $BE9C58D62C2E8B79,$47259C25C512F8F8,$EF892D893189D112,$80D2F4CE069CA139,$2EEE6CB8A74BB5A5
    Data.q $926F076F079E13EE,$26B9244FE72FCAEF,$9EDE4D764A3D2795,$54F291529EE2993C,$A7FAA79E0B5416C0
    Data.q $9FDB4D0B4EBEA5D6,$97033DBD263D29F6,$09A6114854719891,$B38732F333B532FB,$979CCBA4B38AB3CC
    Data.q $6535120A25365CED,$D934C5BBB28BD943,$325EB244C480D4CF,$3726F3935396E39A,$6F309E729E48F73A
    Data.q $F227CB4DF2D9B960,$5DC15A815EBFF37D,$7460B6B05BA05BD1,$A5AAD055FACAE7A5,$3D5A2EAFEB577AAB
    Data.q $B584B581CD6FC6BE,$2F2C2EB4287F6B69,$56914F5D662EB97C,$5BEB7EF5B1A29AD1,$B83637C5458A158B
    Data.q $38D828DA88DBA86C,$4B1F4DAAA6EE69B8,$4A2B4BAD4B172578,$CD95F8BE6EE66FDF,$65B492DA7D5F9557
    Data.q $56CC56CF6CA1CCB0,$281DB7DCDBEBD6E1,$B21EDB1F2FCF2E57,$978EC947630773BD,$51576150BCEC973B
    Data.q $195A4BB24BB08BB7,$EAB5B550655DD95C,$4D578D48F54A757D,$BBD7DAA6ED66AD7B,$56D3D8F1ECAFBB79
    Data.q $60AF6EF75A5755A7,$A306CEFABF7ACDEF,$1EFB397D987D8A86,$BAFACD7FF6374636,$7EC3E9B4A9A349B9
    Data.q $CD7D038881E97EE1,$AD652D9A2DCDCD8E,$C1C260F275A4AB70,$6CC6DDD37F78DFCB,$87021E97B7A76FAB
    Data.q $F5EDF89B7F1E8724,$B48EB08F7B8741C3,$A3B5076D5DF8677D,$95D539DE5CEA13A4,$1A3E1EEB8EED25D2
    Data.q $7BE3A7A5C7B7B478,$73563DD31FF7EFCB,$A289C209D978E55C,$953E9C9FE64E9F13,$BD63D3E4E9E9EA75
    Data.q $AD733D899CEF7A4B,$F3D9D06CF06FBC2F,$3FECF7E99DCF7CE7,$17CE0BB1FCF5DE79,$70E4BAEC5D645E8E
    Data.q $FB07E3A07EC073A9,$1C873B061D063A1F,$9E19EE5D3B2FBA87,$57D395FB8AE27C37,$D2ED7016BB9EAFBD
    Data.q $6FD751EBE191FCC8,$F9BBC9BD21B848DE,$6E73B7E7ADFA56E8,$E4B77D177359DCCF,$1BF79AFB8ABDD29E
    Data.q $3D20EA5DB1FD347E,$83C160F03A3DEA3E,$FF653F27B1DC633B,$C561F921E8BC7EF4,$C747DB23F344CE84
    Data.q $78F85E3F2F277D26,$3FC5A79993D649FC,$77D9E4CCFB5CFF2B,$353B153032FC78BF,$5F9BAFD3FCF45CFE
    Data.q $EF65EED2FFD8BFA8,$66AF1957FDF4D874,$2DE0737F51BC975E,$33137798BBFF6DEB,$7E983F2BEFB1EFB9
    Data.q $8CA7EEF1F418F9E8,$FBF384F7037E9F4F,$090000002A66708F,$120B000073594870,$7EDDD201120B0000
    Data.q $41444995000000FC,$400EBDD3ED9C7854,$B3662F1260051430,$E9C7BF9B0B1075F4,$AA28972A71B163CE
    Data.q $FBDE9A7A5D090655,$3F787879CF5A69A5,$6E4A63E6319052F8,$16844099BCE7395A,$96C0B5625A188068
    Data.q $4AD02C75011A1213,$09502D0EE90BCEF4,$7BB68C40742B81DB,$AA93A6342410EC3A,$EC52D06A094C43D0
    Data.q $623DA121DF4EFAA9,$1DA033424169826A,$0A7E8DEAE85C8BA2,$3E32BC18CEA4D2A0,$9ECE1B43A1158E08
    Data.q $4549000000003E65
    Data.b $4E,$44,$AE,$42,$60,$82
  ArowDown_png_end:
EndDataSection
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
blendman
Messages : 2017
Inscription : sam. 19/févr./2011 12:46

Re: Ascenseur dans canvas

Message par blendman »

Salut


Merci microdevweb pour ce code, je vais certainement m'en servir ;).
Voici un petit exemple plus complet.

Code : Tout sélectionner


XIncludeFile "ScroolV.pbi"
XIncludeFile "ScroolH.pbi"

Procedure Teste()
    Debug ScrollV::GetState(1)
EndProcedure
Procedure TesteH()
    Debug ScrollH::GetState(2)
EndProcedure

OpenWindow(0,0,0,800,600,"Test")
CanvasGadget(1,0,0,400,420,#PB_Canvas_Keyboard)

ScrollV::Init(1,1,0,0,20,380,@Teste())
ScrollV::SetMinMaxStep(1,0,200,10)

ScrollH::Init(2,1,0,382,400,20,@TesteH())
ScrollH::SetMinMaxStep(2,0,200,10)

StartDrawing(CanvasOutput(1))
Box(50,50,200,200,RGBA(200,120,120,255))

ScrollV::Draw(1)
ScrollH::Draw(2)

StopDrawing()

Repeat
    Event=WindowEvent()
    Delay(1)
    If ScrollV::Event(1,Event) Or ScrollH::Event(2,Event)
        StartDrawing(CanvasOutput(1))
        Box(0,0,GadgetWidth(1),GadgetHeight(1),RGBA(255,255,255,255))
        Box(50-ScrollH::GetState(2),50-ScrollV::GetState(1),200,200,RGBA(200,120,120,255))
              
        ScrollV::Draw(1)
        ScrollH::Draw(2)
        StopDrawing()
    EndIf
Until Event=#PB_Event_CloseWindow


@Micoute : merci aussi pour ton code, il est pas mal du tout (simple et fonctionnel) ;).
Répondre