Coloriser les lignes paire et impair des listiconGadget

[microdevweb]

Module ScrollV

Code : Tout sélectionner

;////////////////////////////////////////////////////////////////////////////////////////////////////////////
; ScrollV
; Vers 1.0 du 2014-08-08
; Vers 1.1 du 2014-12-26
;--> Ajout d'un chronos sur le nombre de click pour eviter trop d'appel
; © 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)
      Declare SetTemporyClick(IdScrool,TemporyClick)
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
            TemporyClick.i ;Ver 1.1
      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)
            Protected N
            If IdScrool=#PB_Any
                  While FindMapElement(myScrool(),Str(N))<>0
                        N+1
                  Wend
                  AddMapElement(myScrool(),Str(N))
            Else
                  If FindMapElement(myScrool(),Str(IdScrool))=0
                        AddMapElement(myScrool(),Str(IdScrool))
                  EndIf
            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
            myScrool()\TemporyClick=100
            ProcedureReturn Val(MapKey(myScrool()))
      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 SetTemporyClick(IdScrool,TemporyClick)
             If FindMapElement(myScrool(),Str(IdScrool))=0
                  MessageRequester("Error Scrool V","This Id not exist...")
                  ProcedureReturn  #False
            EndIf
            myScrool()\TemporyClick=TemporyClick
      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
                  If Click=0
                        Click=1
                  Else 
                        If Click<myScrool()\TemporyClick
                              Click+1
                              ProcedureReturn #False
                        EndIf
                  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
                  If Click=0
                        Click=1
                  Else 
                        If Click<myScrool()\TemporyClick
                              Click+1
                              ProcedureReturn #False
                        EndIf
                  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 petites lignes 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: 
            ; size : 2860 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 $4144499B000000FC,$6032A061639C7854,$FAFAFA063E903519,$EE6F379BFFA90056,$AA401D61A040D8A4
            Data.q $B640DA1A04E6CA1C,$8C503D414186C881,$350206C905686803,$281CAA458657BC82,$31E206AC50CB80C7
            Data.q $1861120618A1A08C,$04839143408CA1B2,$A83281830C1240D5,$744A040DC286E14B,$286AC30C1252A901
            Data.q $C40865202730D40B,$66808C041030C87B,$C810360FDD0D0238,$0A186991F6A407D8,$0008197879792618
            Data.q $793AC825A737DF10,$444E454900000000
            Data.b $AE,$42,$60,$82
            DownArow: 
            ; 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
      EndDataSection
EndModule

[microdevweb]

Module EditBox

Code : Tout sélectionner

;////////////////////////////////////////////////////////////////////////////////////////////////////////////
;  Nom: EditBox
; Vers 1.0 du 2014-12-12
; Vers 1.1 du 2014-12-26
; Description:
; Gestion d'un champ éditor par programmation
; © AllDev / MicrodevWeb / Bielen Pierre
;////////////////////////////////////////////////////////////////////////////////////////////////////////////
DeclareModule EditBox
      Declare Create(Id,IdCanvas,X,Y,W,H,Value$,*ProcedureCallBack=-1)
      Declare SetColor(Id,ColorBack,ColorFront)
      Declare SetSelectColor(Id,ColorBack,ColorFront)
      Declare SetFont(Id,Font)
      Declare SetSelectFont(Id,Font)
      Declare$ GetValue(Id)
      Declare Event(Id,Event)
      Declare SetPosition(Id,X,Y,W,H)
      Declare Draw(Id,InitDraw.b=#True)
      Declare GiveFocus(Id,InitDraw.b=#False)
      Declare LostFocus(Id)
      Declare SetValue(Id,Value$)
      Declare OverEditBox(Id)
      Declare Free(Id)
EndDeclareModule
Module EditBox
      ;-* Initialisation
      EnableExplicit
      ;} FIN Initialisation
      ;-* Prototype
      Prototype.s ProtoEntChangeText(Txt$)
      ;} FIN Prototype
      ;-* Structures
      ;---------- Pos
      Structure Pos
            X.i
            Y.i
            W.i
            H.i
      EndStructure
      ;---------- EditBox
      Structure EditBox
            myCanvas.i
            myPos.Pos
            myBackColor.i
            myFrontColor.i
            myLineColor.i
            mySelectBackColor.i
            mySelectFrontColor.i
            mySelectFond.i
            myFont.i
            Value$
            FirstCaractere.i
            LastCaractere.i
            CaractereSelected.i
            *myProcedureCallBack
            myMargin.i
            myMask.i
            myCursorPos.Pos
            myThread.i
            CurrentTime.i
            TimeElapsed.i
            CaracteTronquer.i
            IhaveFocus.b
            OverEditBox.b
      EndStructure
      ;} FIN Structures
      ;-* Variables
      Global NewMap myEditBox.EditBox()
      Global gMouseX,gMouseY,Mask
      Global CaractereOver=0
      Global  LineOn.b,BoxOn.b
      Global gClicOn.b=#False
      Global gCursorOn.b=#True
      Global gCaratereSelected.b=#False
      Global gOldMouseX,RightDirection.b=#True
      ;} FIN Variables
      ;-* Locales déclaration
      Declare DrawBox()
      Declare DrawValue()
      ;} FIN Locales déclaration
      ;-* Procédures
      ;---------- GiveFocus(Id)
      Procedure GiveFocus(Id,InitDraw.b=#False)
            If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error SetColor","This id "+Str(Id)+" not exist...")
                  ProcedureReturn #False
            EndIf
            With myEditBox()
                  \IhaveFocus=#True
                  ;Réafiche le résultat
                 If InitDraw :StartDrawing(CanvasOutput(\myCanvas)):EndIf
                  Draw(Val(MapKey(myEditBox())))
                  If InitDraw :StopDrawing():EndIf
            EndWith
      EndProcedure
      ;----------- LostFocus(Id)
      Procedure LostFocus(Id)
            If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error SetColor","This id "+Str(Id)+" not exist...")
                  ProcedureReturn #False
            EndIf
            With myEditBox()
                  \IhaveFocus=#False
                  ;Réafiche le résultat
                  StartDrawing(CanvasOutput(\myCanvas))
                  Draw(Val(MapKey(myEditBox())))
                  StopDrawing()
            EndWith
      EndProcedure
      ;------------ TestingFocus()
      Procedure TestingFocus()
            With myEditBox()
                  If gMouseX>=\myPos\X And gMouseX<=(\myPos\X+\myPos\W)
                        If gMouseY>=\myPos\Y And gMouseY<=(\myPos\Y+\myPos\H)
                              GiveFocus(Val(MapKey(myEditBox())))
                              ProcedureReturn 
                        EndIf
                  EndIf
                  LostFocus(Val(MapKey(myEditBox())))
            EndWith
      EndProcedure
       ;----------- DrawCursor(Value)
      Procedure DrawCursor(Value)
            If gCursorOn=#False:ProcedureReturn  :EndIf
            With myEditBox()
                        If \IhaveFocus=#False:ProcedureReturn :EndIf
                        If \TimeElapsed>400 And LineOn=#False
                              StartDrawing(CanvasOutput(\myCanvas))
                              DrawingMode(#PB_2DDrawing_Default)
                              Line(\myCursorPos\X,\myCursorPos\Y,\myCursorPos\W,\myCursorPos\H,$000000)
                              LineOn=#True
                              BoxOn=#False
                              StopDrawing()
                        EndIf
                        If \TimeElapsed>800 And BoxOn=#False
                              StartDrawing(CanvasOutput(\myCanvas))
                              DrawingMode(#PB_2DDrawing_Default)
                              If IsImage(\myMask)<>0
                                    DrawImage(ImageID(\myMask),\myPos\X,\myPos\Y)
                              EndIf
                              \CurrentTime=ElapsedMilliseconds()
                              \TimeElapsed=0
                              LineOn=#False
                              BoxOn=#True
                              StopDrawing()
                        EndIf
                        \TimeElapsed=ElapsedMilliseconds()-\CurrentTime
                  EndWith
      EndProcedure
       ;----------- Create(Id,IdCanvas,X,Y,W,H,Value$,*ProcedureCallBack=-1)
      Procedure Create(Id,IdCanvas,X,Y,W,H,Value$,*ProcedureCallBack=-1)
            Protected Index
            ;Si #pb_any crée un id avec le nombre d'EditBox
            If #PB_Any
                  While FindMapElement(myEditBox(),Str(Index))<>0
                        Index+1
                  Wend
                  AddMapElement(myEditBox(),Str(Index))
            Else
                  ;Recherche l'id et l'ajoute si ne le treouve pas
                  If FindMapElement(myEditBox(),Str(Id))=0
                        AddMapElement(myEditBox(),Str(MapSize(myEditBox())))
                  EndIf
            EndIf
            ;Remplit les éléments
            With myEditBox()
                  \myCanvas=IdCanvas
                  \myPos\X=X
                  \myPos\Y=Y
                  \myPos\W=W
                  \myPos\H=H
                  \myFont=LoadFont(#PB_Any,"Arial",12,#PB_Font_HighQuality)
                  \myBackColor=$FFFFFF
                  \myFrontColor=$000000
                  \mySelectBackColor=$CD0000
                  \mySelectFrontColor=$FFFFFF
                  \mySelectFond=LoadFont(#PB_Any,"Arial",12,#PB_Font_HighQuality)
                  \myProcedureCallBack=*ProcedureCallBack
                  \myMargin=10
                  \Value$=Value$
                  \FirstCaractere=Len(Value$)
                  \LastCaractere=-1
                  \CurrentTime=ElapsedMilliseconds()
                  \IhaveFocus=#False
            EndWith
            ProcedureReturn Val(MapKey(myEditBox()))
      EndProcedure
      ;----------- SetColor(Id,ColorBack,ColorFront)
      Procedure SetColor(Id,ColorBack,ColorFront)
            If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error SetColor","This id "+Str(Id)+" not exist...")
                  ProcedureReturn #False
            EndIf
            With myEditBox()
                  \myFrontColor=ColorFront
                  \myBackColor=ColorBack
            EndWith
            ProcedureReturn #True
      EndProcedure
      ;----------- SetSelectColor(Id,ColorBack,ColorFront)
      Procedure SetSelectColor(Id,ColorBack,ColorFront)
            If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error SetSelectColor","This id "+Str(Id)+" not exist...")
                  ProcedureReturn #False
            EndIf
            With myEditBox()
                  \mySelectFrontColor=ColorFront
                  \mySelectBackColor=ColorBack
            EndWith
            ProcedureReturn #True
      EndProcedure
      ;----------- SetFont(Id,Font)
      Procedure SetFont(Id,Font)
            If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error SetFont","This id "+Str(Id)+" not exist...")
                  ProcedureReturn #False
            EndIf
            With myEditBox()
                  \myFont=Font
            EndWith
            ProcedureReturn #True
      EndProcedure
      ;----------- SetSelectFont(Id,Font)
      Procedure SetSelectFont(Id,Font)
            If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error SetSelectFont","This id "+Str(Id)+" not exist...")
                  ProcedureReturn #False
            EndIf
            With myEditBox()
                  \mySelectFond=Font
            EndWith
            ProcedureReturn #True
      EndProcedure
      ;----------- GetValue(Id)
      Procedure$ GetValue(Id)
            If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error GetValue","This id "+Str(Id)+" not exist...")
                  ProcedureReturn ""
            EndIf
            ProcedureReturn myEditBox()\Value$
      EndProcedure
      ;----------- SetValue(Id,Value$)
      Procedure SetValue(Id,Value$)
            If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error SetValue","This id "+Str(Id)+" not exist...")
                  ProcedureReturn #False
            EndIf
            myEditBox()\Value$=Value$
            ProcedureReturn #True
      EndProcedure
      ;----------- SetPosition(Id,X,Y,W,H)
      Procedure SetPosition(Id,X,Y,W,H)
            If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error SetPosition","This id "+Str(Id)+" not exist...")
                  ProcedureReturn #False
            EndIf
            With myEditBox()\myPos
                  If X<>#PB_Ignore
                        \X=X
                  EndIf
                  If Y<>#PB_Ignore
                        \Y=Y
                  EndIf
                  If W<>#PB_Ignore
                        \W=W
                  EndIf
                  If H<>#PB_Ignore
                        \H=H
                  EndIf
            EndWith
      EndProcedure
      ;----------- SetMargin(Id,Margin)
      Procedure SetMargin(Id,Margin)
            If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error SetMargin","This id "+Str(Id)+" not exist...")
                  ProcedureReturn #False
            EndIf
            myEditBox()\myMargin=Margin
            ProcedureReturn #True
      EndProcedure
      ;----------- DrawBox()
      Procedure DrawBox()
            Protected X,Y,W,H,ColorB,ColorF
            With myEditBox()
                  X=\myPos\X
                  Y=\myPos\Y
                  W=\myPos\W
                  H=\myPos\H
                  ColorB=\myBackColor
                  ColorF=\myFrontColor
            EndWith
            DrawingMode(#PB_2DDrawing_Default)
            Box(X,Y,W,H,ColorB)
             DrawingMode(#PB_2DDrawing_Outlined)
            Box(X,Y,W,H,ColorF)
      EndProcedure
      ;----------- DrawValue()
      Procedure  DrawValue() 
            Protected X,Y,Txt$,maxW,ColorB,ColorF,CarTonquer,Decalage
;             Protected FirstCaractere,EndCaractere
            With myEditBox()
                  DrawingFont(FontID(\myFont))
                  X=\myPos\X+\myMargin
                  Y=\myPos\Y+(\myPos\H/2)
                  Y-TextHeight("ABCD")/2
                  Txt$=\Value$
                  maxW=\myPos\W-(\myMargin *2 )
                  ;Tronque la chaine si elle dépasse de l'éditeur
                  While TextWidth(Txt$)>maxW
                        CarTonquer+1
                        Txt$=Right(Txt$,Len(Txt$)-1)
                  Wend
                  ;Position du cursseur
                  \myCursorPos\H=TextHeight("ABCD")
                  \myCursorPos\W=1
                  \myCursorPos\Y=Y
                  \CaracteTronquer=CarTonquer
                  If CarTonquer>0
                        Decalage=TextWidth(Left(\Value$,CarTonquer))
                  EndIf
                  If \FirstCaractere-\CaracteTronquer<0
                        Txt$=Mid(\Value$,\FirstCaractere+1,Len(\Value$)-\CaracteTronquer)
                        Decalage=TextWidth(Left(\Value$,CarTonquer+(\FirstCaractere-\CaracteTronquer)))
                  EndIf
;                   ;Si pas de sélection (Lastcaractere=-1)
                  If gCaratereSelected=#False
                        \myCursorPos\X=X+(TextWidth(Left(\Value$,\FirstCaractere))-Decalage)
                  Else
                        \myCursorPos\X=X+(TextWidth(Left(\Value$,\LastCaractere))-Decalage)
                  EndIf
                  Protected N,FirsCaractere,LastCaractere
                  If RightDirection=#False
                        FirsCaractere=\LastCaractere-1
                        LastCaractere=\FirstCaractere-1
                  Else
                        FirsCaractere=\FirstCaractere
                        LastCaractere=\LastCaractere
                  EndIf
                  For N=1 To Len(Txt$)
                        If gCaratereSelected=#True
                              If (N-1)>=FirsCaractere And (N-1)<=LastCaractere
                                    ColorF=\mySelectFrontColor
                                    ColorB=\mySelectBackColor
                              Else
                                    ColorF=\myFrontColor
                                    ColorB=\myBackColor
                              EndIf
                        Else
                              ColorF=\myFrontColor
                              ColorB=\myBackColor
                        EndIf
                        DrawText(X,Y,Mid(Txt$,N,1),ColorF,ColorB)
                        X+TextWidth(Mid(Txt$,N,1))
                  Next
            EndWith
      EndProcedure
      ;----------- CreateMask()
      Procedure CreateMask()
            ;Suppression du masque
            If IsImage(myEditBox()\myMask)
                  FreeImage(myEditBox()\myMask)
            EndIf
            ;Creation du masque
            With myEditBox()\myPos
                  myEditBox()\myMask=GrabDrawingImage(#PB_Any,\X,\Y,\W,\H)
            EndWith
      EndProcedure
      ;----------- Draw(Id)
      Procedure Draw(Id,InitDraw.b=#True)
            If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error Draw","This id "+Str(Id)+" not exist...")
                  ProcedureReturn #False
            EndIf
            If InitDraw:StopDrawing(): StartDrawing(CanvasOutput(myEditBox()\myCanvas)):EndIf
            DrawBox()
            DrawValue()
            CreateMask()
            If InitDraw: StopDrawing():EndIf
            ProcedureReturn #True
      EndProcedure
      ;----------- OverCaractere()
      Procedure OverCaractere()
            
      EndProcedure
      ;----------- WhereIsMouse()
      Procedure  WhereIsMouse()
            Protected X1,X2,Y1,Y2,N,XT1,XT2,Txt$
            CaractereOver=-1
            ;Détermine le sens de sélection
            If gMouseX>gOldMouseX
                  RightDirection=#True
            Else
                  RightDirection=#False
            EndIf
            With myEditBox()\myPos
                  X1=\X
                  X2=X1+\W
                  Y1=\Y
                  Y2=Y1+\H
            EndWith
            If (gMouseX>=X1 And gMouseX<=X2) And (gMouseY>=Y1 And gMouseY<=Y2)
                  With myEditBox()
                        ;On commence à la première lettre
                        XT1=X1+\myMargin
                        ;Si la chaine a été tronquée
                        If \CaracteTronquer>0
                              Txt$=Right(\Value$,Len(\Value$)-\CaracteTronquer)
                        Else
                              Txt$=\Value$
                        EndIf
                        ;Parcours de toutes les lettres
                        StartDrawing(CanvasOutput(\myCanvas))
                         DrawingFont(FontID(\myFont))
                         If gMouseX<XT1
                               CaractereOver=0
                               StopDrawing()
                               ProcedureReturn #True
                         EndIf
                         If gMouseX>XT1+TextWidth(Txt$)
                               CaractereOver=Len(Txt$)
                               StopDrawing()
                               ProcedureReturn #True
                         EndIf
                        For N=1 To Len(Txt$)
                              XT2=XT1+TextWidth(Left(Txt$,N))
                              If gMouseX>=XT1 And gMouseX<(XT2-TextWidth(Mid(Txt$,N,1))/2)
                                    CaractereOver=N-1
                                    StopDrawing()
                                    ProcedureReturn #True
                              EndIf
                              If gMouseX>=(XT1+TextWidth(Mid(Txt$,N,1))/2) And gMouseX<XT2
                                    CaractereOver=N
                                    StopDrawing()
                                    ProcedureReturn #True
                              EndIf
                        Next
                  EndWith
                  StopDrawing()
                  ProcedureReturn #True
            EndIf
            StopDrawing()
            ProcedureReturn #False
      EndProcedure
      ;----------- DeleteCaractere()
      Procedure DeleteCaractere()
            Protected FirstCaractere,LastCaractere,N,Txt$
            With myEditBox() 
                  If \LastCaractere=-1
                        FirstCaractere=\FirstCaractere
                        LastCaractere=-1
                  Else
                        If \FirstCaractere>\LastCaractere
                              FirstCaractere=\LastCaractere
                              LastCaractere=\FirstCaractere
                        Else
                              FirstCaractere=\FirstCaractere
                              LastCaractere=\LastCaractere
                        EndIf
                  EndIf
                  If LastCaractere=-1
                        For N=1 To Len(\Value$)
                              If N<>FirstCaractere
                                    Txt$+Mid(\Value$,N,1)
                              EndIf
                        Next
                        \FirstCaractere=FirstCaractere-1
                        If \FirstCaractere<0
                              \FirstCaractere=0
                        EndIf
                  Else
                        For N=1 To Len(\Value$)
                              If N<FirstCaractere+1 Or N>LastCaractere+1 
                                    Txt$+Mid(\Value$,N,1)
                              EndIf
                        Next
                        \LastCaractere=-1
                        gCaratereSelected=#False
                  EndIf
                  
                  \Value$=Txt$
                  ;Réafiche le résultat
                  Draw(Val(MapKey(myEditBox())),#True)
                   If \myProcedureCallBack<>-1
                        Protected EventChangeText
                        EventChangeText.ProtoEntChangeText=\myProcedureCallBack
                        EventChangeText(\Value$)
                  EndIf
            EndWith
      EndProcedure
      ;----------- Free(Id)
      Procedure Free(Id)
            If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error Free","This id "+Str(Id)+" not exist...")
                  ProcedureReturn #False
            EndIf
            DeleteMapElement(myEditBox())
      EndProcedure
      ;----------- EventKeyDown()
      Procedure EventKeyDown()
            Protected KeyDown
            ;Gestion des touches enfoncées
            With myEditBox()
                  KeyDown=GetGadgetAttribute(\myCanvas,#PB_Canvas_Key)
                  Select KeyDown
                        Case #PB_Shortcut_Home
                              ;Se positionner sur le premier caractère
                              \FirstCaractere=0
                              ;Réafiche le résultat
                              StartDrawing(CanvasOutput(\myCanvas))
                              Draw(Val(MapKey(myEditBox())))
                              StopDrawing()
                        Case #PB_Shortcut_End
                              ;Se positionner sur le dernier caractère
                              \FirstCaractere=Len(\Value$)
                              Draw(Val(MapKey(myEditBox())),#True)
                         ;Retour arrière     
                        Case #PB_Shortcut_Back,#PB_Shortcut_Delete
                              DeleteCaractere()
                        Case #PB_Shortcut_Left
                              \FirstCaractere-1
                              If \FirstCaractere<0
                                    \FirstCaractere=0
                              EndIf
                              \LastCaractere=-1
                              gCaratereSelected=#False
                              StartDrawing(CanvasOutput(\myCanvas))
                              Draw(Val(MapKey(myEditBox())))
                              StopDrawing()
                        Case #PB_Shortcut_Right
                              \FirstCaractere+1
                              If \FirstCaractere>Len(\Value$)
                                    \FirstCaractere=Len(\Value$)
                              EndIf
                              Draw(Val(MapKey(myEditBox())),#True)
                  EndSelect
            EndWith
      EndProcedure
      Procedure OverEditBox(Id)
             If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error Event","This id "+Str(Id)+" not exist...")
                  ProcedureReturn #False
            EndIf
            If myEditBox()\OverEditBox
                  ProcedureReturn #True
            EndIf
            ProcedureReturn #False
      EndProcedure
      ;----------- EventInput()
      Procedure EventInput()
            Protected KeyInput
            If gCaratereSelected=#True
                  DeleteCaractere()
            EndIf
            With myEditBox()
                  KeyInput=GetGadgetAttribute(\myCanvas,#PB_Canvas_Input)
                  \Value$=InsertString(\Value$,Chr(KeyInput),\FirstCaractere+1)
                  ;Incrément le prmier caractère
                  \FirstCaractere+1
                  ;Réafiche le résultat
                  Draw(Val(MapKey(myEditBox())),#True)
                  If \myProcedureCallBack<>-1
                        Protected EventChangeText
                        EventChangeText.ProtoEntChangeText=\myProcedureCallBack
                        EventChangeText(\Value$)
                  EndIf
            EndWith
      EndProcedure
      ;----------- Event(Id,Event)
      Procedure Event(Id,Event)
            If FindMapElement(myEditBox(),Str(Id))=0
                  MessageRequester("Error Event","This id "+Str(Id)+" not exist...")
                  ProcedureReturn #False
            EndIf
            DrawCursor(0)
            If Event<>#PB_Event_Gadget :ProcedureReturn #False :EndIf
            If EventGadget()<>myEditBox()\myCanvas :ProcedureReturn #False :EndIf
            gMouseX=GetGadgetAttribute(myEditBox()\myCanvas,#PB_Canvas_MouseX)
            gMouseY=GetGadgetAttribute(myEditBox()\myCanvas,#PB_Canvas_MouseY)
            myEditBox()\OverEditBox=#False
            Select EventType()
                   ;{ La souris bouge  ou le bouton gauche est enfoncé   
                  Case #PB_EventType_MouseMove
                        If WhereIsMouse()=#True 
                              myEditBox()\OverEditBox=#True
                              SetGadgetAttribute(myEditBox()\myCanvas,#PB_Canvas_Cursor,#PB_Cursor_IBeam)
                              ;La touche à déjà été pressée donc le premier caractère est déjà mémorisé
                              If gClicOn=#True And CaractereOver<>-1
                                    myEditBox()\LastCaractere=CaractereOver
                                    ;Réafiche le résultat
                                    gCursorOn=#False
                                    gCaratereSelected=#True
                                    Draw(Val(MapKey(myEditBox())),#True)
                              EndIf
                        EndIf
                   ;} FIN La souris bouge  
                   ;{ Click Gauche     
                  Case #PB_EventType_LeftButtonDown
                        TestingFocus()
                        If myEditBox()\IhaveFocus=#False:ProcedureReturn :EndIf
                        ;Va servir à derterminé le sens de la sélection
                        If  gClicOn=#False
                              gOldMouseX=gMouseX
                        EndIf
                        If CaractereOver<>-1 And gClicOn=#False
                              With myEditBox()
                                    \FirstCaractere=CaractereOver
                                    ;Nouveau premier caractère donc pas de dernier caractère
                                    \LastCaractere=-1
                                    StartDrawing(CanvasOutput(\myCanvas))
                                    DrawingFont(FontID(\myFont))
                                    \myCursorPos\X=\myPos\X+\myMargin+TextWidth(Left(\Value$,CaractereOver))
                                    ;Pour afficher tout de suite le cursseur
                                    \TimeElapsed=400
                                    LineOn=#False
                                    If gCaratereSelected=#True
                                          gCaratereSelected=#False
                                          Draw(Val(MapKey(myEditBox())),#True)
                                    EndIf
                                    StopDrawing()
                              EndWith
                        EndIf
                        gClicOn=#True
                        ;} FIN Click Gauche   
                   ;{ Bt gauche relaché        
                  Case #PB_EventType_LeftButtonUp
                        gClicOn=#False
                        gCursorOn=#True
                        ;} FIN Bt gauche relaché 
                   ;{ Une touche de control est préssée    
                  Case #PB_EventType_KeyDown
                        If myEditBox()\IhaveFocus=#False:ProcedureReturn :EndIf
                        EventKeyDown()
                        ;} FIN Une touche est préssée  
                   ;{ On tape du texte     
                  Case #PB_EventType_Input
                       If myEditBox()\IhaveFocus=#False:ProcedureReturn :EndIf 
                        EventInput()
                        ;} FIN On tape du texte 
            EndSelect
      EndProcedure
      ;} FIN Procédures
EndModule

[microdevweb]

Petit code teste
Nb: Il subsiste des bugs car c'est ancien code que je réadapte (modification par des Bin) je travaille sur un RAD qui utilisera cette table (à suivre) et posterais le tous le code dans un proche avenir (cela risque de faire quelques pages)

Code : Tout sélectionner

;-* Teste
XIncludeFile "Table.pbi"
Procedure TesteSelectLine(NLine)
      Debug "Vous avez sélectionné la ligne ID "+Str(NLine)
EndProcedure
Procedure OpenMainForm()
      Protected W=900,H=600,Flag,N,Txt$,R
      Flag=#PB_Window_SystemMenu|#PB_Window_ScreenCentered
      OpenWindow(0,0,0,W,H,"Teste Table",Flag)
      Table::Create(0,50,50,800,400,"Table")
      Global Column1=Table::AddColumn(0,200,"Colonne 1")
      Global Column2=Table::AddColumn(0,200,"Colonne 2")
      Global Column3=Table::AddColumn(0,200,"Colonne 3")
      Global Column4=Table::AddColumn(0,300,"Colonne 4")
      Table::SetProcedureCallBackSelectLine(0,@TesteSelectLine())
      For N=1 To 3 ;Ajoute 100 lignes pour le teste
                      ;La première ligne commence à 0
            Txt$=""
            For R=1 To Random(10,5)
                  Txt$+Chr(Random(122,97))
            Next
            Table::AddItem(0,Column1,-1,Txt$+Str(N)) ;-1 pour ajouter un ligne et la colonne 1
            Txt$=""
            For R=1 To Random(10,5)
                  Txt$+Chr(Random(122,97))
            Next
            Table::AddItem(0,Column2,N-1,Txt$+Str(N));autre pour ajouter sur la colonne 2  de la même ligne
            Txt$=""
            For R=1 To Random(10,5)
                  Txt$+Chr(Random(122,97))
            Next
            Table::AddItem(0,Column3,N-1,Txt$+Str(N));autre pour ajouter sur la colonne 3  de la même ligne
            Txt$=""
            For R=1 To Random(10,5)
                  Txt$+Chr(Random(122,97))
            Next
            Table::AddItem(0,Column4,N-1,Txt$+Str(N));autre pour ajouter sur la colonne 4  de la même ligne
      Next
      Table::Draw(0)
EndProcedure
Global gEvent
OpenMainForm()
Repeat
      Delay(5)
      gEvent=WindowEvent()
      Table::Event(0,gEvent)
Until gEvent=#PB_Event_CloseWindow
;} FIN Teste

[falsam]

A mon avis tu pourrais aussi faire une piéce jointe car il manque des fichiers

Code : Tout sélectionner

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

Ou alors les poster.

[microdevweb]

@Falsam, tu a peu t’être répondu avant que j'ai fini de tous posté

Quant je posterais le RAD je placerais un lien vers un zip

[falsam]

ça fait plusieurs fois que tu remets en cause mon temoignage a propos de plusieurs sujets

Et voila ça va encore repartir en cacahouette !! Je trouve que j'ai été particulièrement soft avec toi. Une fois de plus, tu tentes de démontrer que je t'agresse avec des mots comme plusieurs fois, remets en cause et plusieurs sujets. Whaouuu que de mots fort !!! Houuuu je suis le vilain !!!!!

Je ne reviendrais pas sur cette histoire de couleur et je ne regarderais pas ton lien. je ne suis même pas désolé que ton matériel ne soit pas suffisamment adéquate pour différencier ces deux couleurs.

Par contre je suis soft avec toi et je te demande de l'être aussi !!!

[falsam]

@Spock : Allez je vais te faire plaisir. Tu vas pouvoir raler. Je vais remettre en cause tes deux codes qui ne donnent pas la solution parce que tu n'as pas encore compris la demande de microdevweb.

Facile avec 50 ligne de montrer que le listicongadget est coloré. Essayes maintenant avec 5 lignes. Seul le début du tableau est coloré. Pas la fin.

Ce que souhaites microdevweb c'est que même les dernières lignes du tableau soient elles aussi colorées. Ce que ne font pas tes deux derniers codes.

Je te le montre en image ce que devrait être le résultat souhaité avec par exemple 5 lignes.

[microdevweb]

@Spock,

Oui j'avais pensé à cette solution, Agir comme dans ma première procédure, lancer un BindGagetEvent sur la ListIcon avec une procédure qui vérifie que la ligne sélectionnée ne soit vide sinon remonter jusqu’à la première ligne non vide. Cela peut être une solution.

[microdevweb]

Voila après les divers idées de chacun, voici un nouveau code fonctionnel
Les lignes sont colorisées Paire en une couleur et impaire dans une autre, et les lignes vides ne sont pas sélectionnable

Code : Tout sélectionner

Procedure ListColor(gadget, gridColor=$13458B,BgColorP=$FFFFFF,BgColorI=$008CFF,FgColorP=$000000,FgColorI=$000000)
      Protected Nb=CountGadgetItems(gadget)
      If SendMessage_(GadgetID(gadget),#LVM_GETCOUNTPERPAGE,0,0)>Nb
            Nb=SendMessage_(GadgetID(gadget),#LVM_GETCOUNTPERPAGE,0,0)
            For N=CountGadgetItems(gadget) To Nb-1
                  AddGadgetItem(gadget,-1,"")
            Next
      EndIf
      SetGadgetColor(gadget,#PB_Gadget_LineColor,gridColor)
      For N=1 To Nb
            If N & 1
                  SetGadgetItemColor(gadget,N-1,#PB_Gadget_BackColor,BgColorI)
                  SetGadgetItemColor(gadget,N-1,#PB_Gadget_FrontColor,FgColorI)
            Else
                  SetGadgetItemColor(gadget,N-1,#PB_Gadget_BackColor,BgColorP)
                  SetGadgetItemColor(gadget,N-1,#PB_Gadget_FrontColor,FgColorP)
            EndIf
      Next
EndProcedure
Procedure NoEmpty()
      Protected G=EventGadget()
      Protected N=GetGadgetState(G)
      If GetGadgetItemText(G,N,0)=""
            SetGadgetState(G,-1)
      EndIf
EndProcedure
OpenWindow(0,0,0,800,600,"teste",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ListIconGadget(1,10,10,504,400,"Item A",100,#PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines)
ListIconGadget(2,10,430,504,100,"Item A",100,#PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines)
AddGadgetColumn(1,1,"Item B",100)
AddGadgetColumn(1,2,"Item C",100)
AddGadgetColumn(1,3,"Item D",100)
AddGadgetColumn(1,4,"Item E",100)
AddGadgetColumn(2,1,"Item B",100)
AddGadgetColumn(2,2,"Item C",100)
AddGadgetColumn(2,3,"Item D",100)
AddGadgetColumn(2,4,"Item E",100)
For N=1 To 14
      AddGadgetItem(1,-1,"qaqqqq")
      AddGadgetItem(2,-1,"qaqqqq")
Next
ListColor(1)
BindGadgetEvent(1,@NoEmpty())
ListColor(2,$000000,$FFFF00,$EEEEAF,$8B0000,$8B0000)
BindGadgetEvent(2,@NoEmpty())
Repeat
      event=WaitWindowEvent()
      If event=#PB_Event_CloseWindow:End:EndIf
ForEver 

[falsam]

Ha ben voila une jolie solution. Microdevweb merci pour cette contribution.

PS: Et toi Spock tu peux aller te parfumer.

[Kwai chang caine]

Merci MicroDevWeb

PS: Et toi Spock tu peux aller te parfumer.

J'sais pas pourquoi...mais si j'peux me rendre utile

[falsam]

@Kwai chang caine: Spock sait pourquoi cette remarque

[Mesa]

Une autre façon de faire.
J'y suis presque, j'ai un bug sur la première ligne qui est désactivée

Code : Tout sélectionner

Global Dim iTem(0),row

Procedure DisableItem(item)
  row +1
  ReDim iTem(row)
  Item(row) = Item
EndProcedure

Procedure WnCallback(hWnd,uMsg,wParam,lParam)
  result = #PB_ProcessPureBasicEvents

  Select uMsg
    Case #WM_NOTIFY
      *nmhdr.NMHDR = lParam      
      If  *nmhdr\hwndFrom = GadgetID(0)
        Select *nmhdr\code  
          Case #LVN_ITEMCHANGING
            *pnmv.NMLISTVIEW  = lParam
            
            If *pnmv\iItem = 0 : ProcedureReturn 1 : EndIf
            
          Case #NM_CUSTOMDRAW
            *lvCD.NMLVCUSTOMDRAW = lParam 
            item = *lvCD\nmcd\dwItemSpec                      
            Select *lvCD\nmcd\dwDrawStage
              Case #CDDS_PREPAINT           
                ProcedureReturn #CDRF_NOTIFYITEMDRAW
                
              Case #CDDS_ITEMPREPAINT
                ProcedureReturn #CDRF_NOTIFYSUBITEMDRAW
                
              Case #CDDS_ITEMPREPAINT | #CDDS_SUBITEM      
                ;subitem = *lvCD\iSubItem
                ;*hDC = *lvCD\nmcd\hdc
                          
                If item & 1
                  *lvCD\clrText=$FFFFFF
                  *lvCD\clrTextBk=$008CFF
                Else
                  *lvCD\clrText=0
                  *lvCD\clrTextBk=$FFFFFF
                EndIf
                For x= 0 To row
                  
                  If  Item = iTem(x)
                    ;Debug Item
                    ;SetGadgetItemText(0,item,"Disabled",1)
                    *lvCD\nmcd\uItemState =  #CDIS_DISABLED ; <====== ligne désactivée
                    
                    ProcedureReturn #CDRF_DODEFAULT
                  EndIf
                Next
                
            EndSelect
        EndSelect
      EndIf
  EndSelect
  
  ProcedureReturn result 
EndProcedure

Procedure ListColor(gadget, gridColor=$13458B,BgColorP=$FFFFFF,BgColorI=$008CFF,FgColorP=$000000,FgColorI=$000000)
  Protected Nb=CountGadgetItems(gadget)
  If SendMessage_(GadgetID(gadget),#LVM_GETCOUNTPERPAGE,0,0)>Nb
    Nb=SendMessage_(GadgetID(gadget),#LVM_GETCOUNTPERPAGE,0,0)
    For N=CountGadgetItems(gadget) To Nb-1
      AddGadgetItem(gadget,-1,"")
      DisableItem(N)
      ;Debug N
    Next
  EndIf
  SetGadgetColor(gadget,#PB_Gadget_LineColor,gridColor)

EndProcedure
OpenWindow(0,0,0,800,600,"teste",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
SetWindowCallback(@WnCallback())
ListIconGadget(0,10,10,504,400,"Item A",100,#PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines)

AddGadgetColumn(0,1,"Item B",100)
AddGadgetColumn(0,2,"Item C",100)
AddGadgetColumn(0,3,"Item D",100)
AddGadgetColumn(0,4,"Item E",100)

For i=1 To 10
  AddGadgetItem(0,-1,"ligne"+i)
Next

ListColor(0)

Repeat
  event=WaitWindowEvent()
  If event=#PB_Event_CloseWindow:End:EndIf
ForEver 

M.

[Micheao]

Ha ben voila une jolie solution. Microdevweb merci pour cette contribution.

PS: Et toi Spock tu peux aller te parfumer.

on est là pour codé ou pour ce bichonné

[falsam]

on est là pour codé ou pour ce bichonné

Seul Spock a compris pourquoi j'ai dit

PS: Et toi Spock tu peux aller te parfumer.