Module Règles

microdevweb · Message par **microdevweb** » mar. 07/juin/2016 14:40

Voici un petit module que je fais pour mon usage (règle en mm)

Version 1.1

Les fonctions sont les suivantes:

Rull::Create(mySize,*Callback,Direction.i=0)
- mySize Largueur ou hauteur suivant la direction
- *Callback La procédure qui sera appelée lors d'une action sur la règle
- Direction .0 Horizontal ; 1 Vertical
- Renvoi l'adresse mémoire de la liste
SetZoom(IdRull,ZoomFactor.d=1)
- IdRull adresse mémoire de la liste
- ZoomFactor le facteur de zoom (ex: 1 100% 0.5 50%)
GetPxlWidth(IdRull) retourne la largeur en pxl
GetPxlHeight(IdRull) retourne la hauteur en pxl
SetPosition(IdRull,X,Y) modifie la position de la règle
AddGrid(IdRull,Value,,Color.d,size.d)
- IdRull adresse mémoire de la liste
- Value la valeur ou sera ajouté le taquet en mm
- myData une valeur de votre choix qui sera retournée le taquet est modifié (-1) si pas de modification
- Color la couleur du taquet en RGBA
- size taille du taquet (ex: 0.8,1,1.2)
- Renvoi l'adresse mémoire de la liste
RemoveGrid(IdRull,IdGrid)
- IdRull l'adresse mémoire de la règle
- IdGrid l'adresse mémoire du taquet
FreeRull(IdRull) Libère la mémoire en supprimant la règle (à appelé à la fermeture de la fenêtre par exemple)
- IdRull l'adresse mémoire de la règle
- ClearGrid(IdRull) Efface tous les taquets de la règle
  - IdRull l'adresse mémoire de la règle
- SetGridValue(IdRull,IdGrid,Value) modifie la valeur d'un taquet
  - IdRull l'adresse mémoire de la règle
  - IdGrid l'adresse mémoire du taquet
  - Value la nouvelle valeur du taquet

La procédure CallBack doit être renseignée comme ceci

Exemple: EventRull(*IdRull,Value,LeftButtonUp.b,myData)

*IdRull index de la liste
Value La valeur sélectionnée sur la règle en mm
LeftButtonUp #True si le bouton gauche de la souris est relâche ou en cas de simple clique
myData la valeur renseignée avec AddGrid ou -1 si aucune modification

Remarque: Pour zoomer dans le teste maintenez CTRL et molette de la souris

Télécharger le zip

Le code du module

Le code de teste

Autre exemple d'utilisation:

microdevweb · Message par **microdevweb** » mar. 07/juin/2016 14:41

Code du module

Code : Tout sélectionner

;************************************************************************************************************************
; Author : MicrodevWeb
; Project Name : PbPrint
; File Name : Rull.pbi
; Module : Rull
; Description : 
; Version : 1.1
;************************************************************************************************************************
DeclareModule Rull
    ;-* PUBLIC VARIABLE/LIST/MAP/CONSTANTE
    
    ;}
    ;-* PUBLIC DECLARATION
    Declare Create(mySize,*Callback,Direction.i=0)
    Declare SetZoom(IdRull,ZoomFactor.d=1)
    Declare GetPxlWidth(IdRull)
    Declare GetPxlHeight(IdRull)
    Declare SetPosition(IdRull,X,Y)
    Declare AddGrid(IdRull,Value,myData,Color.d,size.d)
    Declare RemoveGrid(IdRull,IdGrid)
    Declare FreeRull(IdRull)
    Declare ClearGrid(IdRull)
    Declare SetGridValue(IdRull,IdGrid,Value)
    ;}
EndDeclareModule
Module Rull
    EnableExplicit
    ;-* LOCAL VARIABLE/LIST/MAP/CONSTANTE
    Structure Grid
        Value.i
        myData.i
        Color.d
        size.d
    EndStructure
    Structure Rull
        IdCanvas.i
        W.d
        H.d
        Direction.i
        ZoomFactor.d
        Value.d
        *CallBack
        Hover.b
        *IdHover
        List MyGrid.Grid()
    EndStructure
    Global NewList myRull.Rull()
    #BgColor=$FFDEDEDE
    #FgColor=$FF242424
    Global UnitFont=LoadFont(#PB_Any,"Arial",6,#PB_Font_HighQuality)
    Global ModeMove.b
    ;}
    ;-* LOCAL DECLARATION
    Declare Draw()
    Declare DrawUnitH()
    Declare DrawTxtUnitH()
    Declare DrawLineUniH()
    Declare DrawIndexValueH()
    Declare myEvent()
    Declare SendCallback(LeftUp.b)
    Declare DrawUnitV()
    Declare DrawTxtUnitV()
    Declare DrawLineUniV()
    Declare DrawIndexValueV()
    Declare DrawGridH()
    Declare IsHoverGridH(Value)
    Declare IsHoverGridV(Value)
    Declare DrawGridV()
    ;}
    ;-* PRIVATE PROCEDURE
    Procedure Draw()
        With myRull()
            StartVectorDrawing(CanvasVectorOutput(\IdCanvas,#PB_Unit_Millimeter))
            ScaleCoordinates(\ZoomFactor,\ZoomFactor,#PB_Coordinate_User)
            AddPathBox(0,0,\W,\H)
            VectorSourceColor(#BgColor)
            FillPath()
            Select \Direction
                Case 0
                    DrawUnitH()
                Case 1
                    DrawUnitV()
            EndSelect
            StopVectorDrawing()
        EndWith
    EndProcedure
    Procedure DrawUnitH()
        DrawTxtUnitH()
        DrawLineUniH()
        ;         If myRull()\Hover
        ;             DrawIndexValueH()
        ;         EndIf
        DrawGridH()
    EndProcedure
    Procedure DrawTxtUnitH()
        Protected N,X.d=1,Y.d=1,XT
        With myRull()
            VectorSourceColor(#FgColor)
            VectorFont(FontID(UnitFont))
            For N=0 To \W Step 10
                X=1*N
                Select N
                    Case 0
                        XT=0
                    Case \W
                        XT=\W-VectorTextWidth(Str(N))
                    Default
                        XT=X-(VectorTextWidth(Str(N))/2)
                EndSelect
                MovePathCursor(XT,Y)
                DrawVectorText(Str(N))
            Next
        EndWith
    EndProcedure
    Procedure DrawLineUniH()
        Protected N,S.d,H.d,X.d,Y.d,Decade.b=#False,R
        With myRull()
            VectorSourceColor(#FgColor)
            For N=0 To \W
                X=1*N
                Decade=#False
                If R=10
                    Decade=#True
                    R=0
                EndIf
                R+1
                If N=0  Or N=\W 
                    Decade=#True
                EndIf
                Select Decade
                    Case #True
                        S=0.4
                        H=\H*0.4
                        Y=\H-H
                    Default
                        S=0.2
                        H=\H*0.2
                        Y=\H-H
                EndSelect
                MovePathCursor(X,Y,#PB_Path_Relative)
                AddPathLine(0,H,#PB_Path_Relative)
                StrokePath(S)
            Next
        EndWith
    EndProcedure
    Procedure DrawIndexValueH()
        Protected X
        With myRull()
            VectorSourceColor(RGBA(255, 48, 48, 70))
            X=\Value
            MovePathCursor(X,0,#PB_Path_Relative)
            AddPathLine(0,GadgetHeight(\IdCanvas),#PB_Path_Relative)
            StrokePath(0.3)
        EndWith
    EndProcedure
    Procedure myEvent()
        With myRull()
            ChangeCurrentElement(myRull(),GetGadgetData(EventGadget()))
            Protected gMouseX=GetGadgetAttribute(EventGadget(),#PB_Canvas_MouseX)
            Protected gMouseY=GetGadgetAttribute(EventGadget(),#PB_Canvas_MouseY)
            Static  MX,MY,ClicOn.b=#False
            Select EventType()
                Case #PB_EventType_MouseEnter
                    \Hover=#True
                    SetGadgetAttribute(EventGadget(),#PB_Canvas_Cursor,#PB_Cursor_Cross)
                Case #PB_EventType_MouseLeave
                    \Hover=#False
                    Draw()
                Case #PB_EventType_MouseMove
                    Select \Direction
                        Case 0
                            StartVectorDrawing(CanvasVectorOutput(\IdCanvas,#PB_Unit_Millimeter))
                            ScaleCoordinates(\ZoomFactor,\ZoomFactor,#PB_Coordinate_User)
                            MX=ConvertCoordinateX(gMouseX,0,#PB_Coordinate_Device,#PB_Coordinate_User)
                            StopVectorDrawing()
                            If ModeMove And ClicOn
                                ChangeCurrentElement(myRull()\MyGrid(),myRull()\IdHover)
                                myRull()\MyGrid()\Value=MX
                                Draw()
                                \Value=MX
                                SendCallback(#False)
                                ProcedureReturn 
                            EndIf
                            If IsHoverGridH(MX)
                                SetGadgetAttribute(EventGadget(),#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
                                ModeMove=#True
                            Else
                                SetGadgetAttribute(EventGadget(),#PB_Canvas_Cursor,#PB_Cursor_Cross)
                                ModeMove=#False
                            EndIf
                        Case 1
                            StartVectorDrawing(CanvasVectorOutput(\IdCanvas,#PB_Unit_Millimeter))
                            ScaleCoordinates(\ZoomFactor,\ZoomFactor,#PB_Coordinate_User)
                            MY=ConvertCoordinateY(0,gMouseY,#PB_Coordinate_Device,#PB_Coordinate_User)
                            StopVectorDrawing()
                            If ModeMove And ClicOn
                                ChangeCurrentElement(myRull()\MyGrid(),myRull()\IdHover)
                                myRull()\MyGrid()\Value=MY
                                \Value=MY
                                Draw()
                                SendCallback(#False)
                                ProcedureReturn 
                            EndIf
                            If IsHoverGridV(MY)
                                SetGadgetAttribute(EventGadget(),#PB_Canvas_Cursor,#PB_Cursor_UpDown)
                                ModeMove=#True
                            Else
                                SetGadgetAttribute(EventGadget(),#PB_Canvas_Cursor,#PB_Cursor_Cross)
                                ModeMove=#False
                            EndIf
                    EndSelect
                Case #PB_EventType_LeftClick
                    Select \Direction
                        Case 0
                            \Value=MX
                            Draw()
                            SendCallback(#True)
                        Case 1
                            \Value=MY
                            Draw()
                            SendCallback(#True)
                    EndSelect
                Case #PB_EventType_LeftButtonDown
                    ClicOn=#True
                Case #PB_EventType_LeftButtonUp
                    ClicOn=#False
            EndSelect
        EndWith
    EndProcedure
    Procedure SendCallback(LeftUp.b)
        Protected myData=-1
        With myRull()
            If \IdHover>-1
                ChangeCurrentElement(myRull()\MyGrid(),\IdHover)
                myData=\MyGrid()\myData
            EndIf
            CallFunctionFast(\CallBack,@myRull(),\Value,LeftUp,myData)
        EndWith
    EndProcedure
    Procedure DrawUnitV()
        DrawTxtUnitV()
        DrawLineUniV()
        DrawGridV()
    EndProcedure
    Procedure DrawTxtUnitV()
        Protected N,X.d=1,Y.d=1,YT,XR
        With myRull()
            VectorSourceColor(#FgColor)
            VectorFont(FontID(UnitFont))
            X=\W-VectorTextHeight(Str(N))
            RotateCoordinates(X,0,-90,#PB_Coordinate_User)
            For N=0 To \H Step 10
                Y=1*N
                Select N
                    Case 0
                        YT=0
                    Case \H
                        YT=\H-VectorTextWidth(Str(N))
                    Default
                        YT=Y-(VectorTextWidth(Str(N))/2)
                EndSelect
                MovePathCursor(-YT,-1.8)
                DrawVectorText(Str(N))
            Next
        EndWith
    EndProcedure
    Procedure DrawLineUniV()
        Protected N,S.d,H.d,X.d,Y.d,Decade.b=#False,R
        With myRull()
            ResetCoordinates(#PB_Coordinate_User)
            ScaleCoordinates(\ZoomFactor,\ZoomFactor,#PB_Coordinate_User)
            VectorSourceColor(#FgColor)
            X=\W
            For N=0 To \H
                Y=1*N
                Decade=#False
                If R=10
                    Decade=#True
                    R=0
                EndIf
                R+1
                If N=0  Or N=\H 
                    Decade=#True
                EndIf
                Select Decade
                    Case #True
                        S=0.4
                        H=\W*0.4
                    Default
                        S=0.2
                        H=\W*0.2
                EndSelect
                MovePathCursor(X,Y,#PB_Path_Relative)
                AddPathLine(-H,0,#PB_Path_Relative)
                StrokePath(S)
            Next
        EndWith
    EndProcedure
    Procedure DrawIndexValueV()
        Protected Y
        With myRull()
            VectorSourceColor(RGBA(255, 48, 48, 70))
            Y=\Value
            MovePathCursor(0,Y,#PB_Path_Relative)
            AddPathLine(GadgetWidth(\IdCanvas),0,#PB_Path_Relative)
            StrokePath(0.3)
        EndWith
    EndProcedure
    Procedure DrawGridH()
        Protected X.d
        With myRull()\MyGrid()
            ForEach myRull()\MyGrid()
                VectorSourceColor(\Color)
                X=\Value
                MovePathCursor(X,0,#PB_Path_Relative)
                AddPathLine(0,GadgetHeight(myRull()\IdCanvas),#PB_Path_Relative)
                StrokePath(\size)
            Next
        EndWith
    EndProcedure
    Procedure IsHoverGridH(Value)
        With myRull()\MyGrid()
            myRull()\IdHover=-1
            ForEach myRull()\MyGrid()
                If Value>=(\Value-(\size/2)) And Value<=(\Value+\size/2)
                    myRull()\IdHover=@myRull()\MyGrid()
                    ProcedureReturn #True
                EndIf
            Next
            ProcedureReturn #False
        EndWith
    EndProcedure
    Procedure IsHoverGridV(Value)
        With myRull()\MyGrid()
            myRull()\IdHover=-1
            ForEach myRull()\MyGrid()
                If Value>=(\Value-(\size/2)) And Value<=(\Value+\size/2)
                    myRull()\IdHover=@myRull()\MyGrid()
                    ProcedureReturn #True
                EndIf
            Next
            ProcedureReturn #False
        EndWith
    EndProcedure
    Procedure DrawGridV()
        Protected Y.d
        With myRull()\MyGrid()
            ForEach myRull()\MyGrid()
                VectorSourceColor(\Color)
                Y=\Value
                MovePathCursor(0,Y,#PB_Path_Relative)
                AddPathLine(GadgetWidth(myRull()\IdCanvas),0,#PB_Path_Relative)
                StrokePath(\size)
            Next
        EndWith
    EndProcedure
    ;}
    ;-* PUBLIC PROCEDURE
    Procedure Create(mySize,*Callback,Direction.i=0)
        Protected W,H
        With myRull()
            AddElement(myRull())
            \IdCanvas=CanvasGadget(#PB_Any,0,0,100,100)
            SetGadgetData(\IdCanvas,@myRull())
            BindGadgetEvent(\IdCanvas,@myEvent())
            \ZoomFactor=1
            \Direction=Direction
            \Value=0
            \CallBack=*Callback
            Select Direction
                Case 0
                    \W=mySize
                    \H=5
                    StartVectorDrawing(CanvasVectorOutput(\IdCanvas,#PB_Unit_Millimeter))
                    ScaleCoordinates(\ZoomFactor,\ZoomFactor,#PB_Coordinate_User)
                    W=ConvertCoordinateX(\W,1,#PB_Coordinate_User,#PB_Coordinate_Device)
                    H=ConvertCoordinateY(0,\H,#PB_Coordinate_User,#PB_Coordinate_Device)
                    StopVectorDrawing()
                    ResizeGadget(\IdCanvas,#PB_Ignore,#PB_Ignore,W,H)
                Case 1
                    \W=5
                    \H=mySize
                    StartVectorDrawing(CanvasVectorOutput(\IdCanvas,#PB_Unit_Millimeter))
                    ScaleCoordinates(\ZoomFactor,\ZoomFactor,#PB_Coordinate_User)
                    W=ConvertCoordinateX(\W,1,#PB_Coordinate_User,#PB_Coordinate_Device)
                    H=ConvertCoordinateY(0,\H,#PB_Coordinate_User,#PB_Coordinate_Device)
                    StopVectorDrawing()
                    ResizeGadget(\IdCanvas,#PB_Ignore,#PB_Ignore,W,H)
            EndSelect
            Draw()
            ProcedureReturn @myRull()
        EndWith
    EndProcedure
    Procedure SetZoom(IdRull,ZoomFactor.d=1)
        With myRull()
            Protected W,H
            If ChangeCurrentElement(myRull(),IdRull)=0
                MessageRequester("Rull Error","This Id "+Str(IdRull)+" does not exist")
                ProcedureReturn 
            EndIf
            \ZoomFactor=ZoomFactor
            Select \Direction
                Case 0
                    StartVectorDrawing(CanvasVectorOutput(\IdCanvas,#PB_Unit_Millimeter))
                    ScaleCoordinates(\ZoomFactor,\ZoomFactor,#PB_Coordinate_User)
                    W=ConvertCoordinateX(\W,1,#PB_Coordinate_User,#PB_Coordinate_Device)
                    H=ConvertCoordinateY(0,\H,#PB_Coordinate_User,#PB_Coordinate_Device)
                    StopVectorDrawing()
                    ResizeGadget(\IdCanvas,#PB_Ignore,#PB_Ignore,W,H)
                Case 1
                    StartVectorDrawing(CanvasVectorOutput(\IdCanvas,#PB_Unit_Millimeter))
                    ScaleCoordinates(\ZoomFactor,\ZoomFactor,#PB_Coordinate_User)
                    W=ConvertCoordinateX(\W,1,#PB_Coordinate_User,#PB_Coordinate_Device)
                    H=ConvertCoordinateY(0,\H,#PB_Coordinate_User,#PB_Coordinate_Device)
                    StopVectorDrawing()
                    ResizeGadget(\IdCanvas,#PB_Ignore,#PB_Ignore,W,H)
            EndSelect
            Draw()
        EndWith
    EndProcedure
    Procedure GetPxlWidth(IdRull)
        With myRull()
            If ChangeCurrentElement(myRull(),IdRull)=0
                MessageRequester("Rull Error","This Id "+Str(IdRull)+" does not exist")
                ProcedureReturn 
            EndIf
            ProcedureReturn GadgetWidth(\IdCanvas)
        EndWith
    EndProcedure
    Procedure GetPxlHeight(IdRull)
        With myRull()
            If ChangeCurrentElement(myRull(),IdRull)=0
                MessageRequester("Rull Error","This Id "+Str(IdRull)+" does not exist")
                ProcedureReturn 
            EndIf
            ProcedureReturn GadgetHeight(\IdCanvas)
        EndWith
    EndProcedure
    Procedure SetPosition(IdRull,X,Y)
        With myRull()
            If ChangeCurrentElement(myRull(),IdRull)=0
                MessageRequester("Rull Error","This Id "+Str(IdRull)+" does not exist")
                ProcedureReturn 
            EndIf
            ResizeGadget(\IdCanvas,X,Y,#PB_Ignore,#PB_Ignore)
            Draw()
        EndWith
    EndProcedure
    Procedure AddGrid(IdRull,Value,myData,Color.d,size.d)
        With myRull()
            If ChangeCurrentElement(myRull(),IdRull)=0
                MessageRequester("Rull Error","This Id "+Str(IdRull)+" does not exist")
                ProcedureReturn 
            EndIf
            AddElement(\MyGrid())
            \MyGrid()\Value=Value
            \MyGrid()\myData=myData
            \MyGrid()\Color=Color
            \MyGrid()\size=size
            Draw()
            ProcedureReturn @\MyGrid()
        EndWith
    EndProcedure
    Procedure RemoveGrid(IdRull,IdGrid)
        If ChangeCurrentElement(myRull(),IdRull)=0
            MessageRequester("Rull Error","This Id rull "+Str(IdRull)+" does not exist")
            ProcedureReturn #False
        EndIf
        If ChangeCurrentElement(myRull()\MyGrid(),IdGrid)=0
            MessageRequester("Rull Error","This Id grid "+Str(IdGrid)+" does not exist")
            ProcedureReturn #False
        EndIf
        DeleteElement(myRull()\MyGrid())
        myRull()\Hover=#False
        myRull()\IdHover=-1
        ModeMove=#False
        Draw()
        ProcedureReturn #True
    EndProcedure
    Procedure FreeRull(IdRull)
        If ChangeCurrentElement(myRull(),IdRull)=0
            MessageRequester("Rull Error","This Id rull "+Str(IdRull)+" does not exist")
            ProcedureReturn #False
        EndIf
        DeleteElement(myRull())
    EndProcedure
    Procedure ClearGrid(IdRull)
        If ChangeCurrentElement(myRull(),IdRull)=0
            MessageRequester("Rull Error","This Id rull "+Str(IdRull)+" does not exist")
            ProcedureReturn #False
        EndIf
        ClearList(myRull()\MyGrid())
        Draw()
    EndProcedure
    Procedure SetGridValue(IdRull,IdGrid,Value)
        If ChangeCurrentElement(myRull(),IdRull)=0
            MessageRequester("Rull Error","This Id rull "+Str(IdRull)+" does not exist")
            ProcedureReturn #False
        EndIf
        If ChangeCurrentElement(myRull()\MyGrid(),IdGrid)=0
            MessageRequester("Rull Error","This Id grid "+Str(IdGrid)+" does not exist")
            ProcedureReturn #False
        EndIf
        With myRull()\MyGrid()
            \Value=Value
            Draw()
        EndWith
    EndProcedure
    ;}
EndModule

microdevweb · Message par **microdevweb** » mar. 07/juin/2016 14:43

Code de teste

Code : Tout sélectionner

XIncludeFile "Rull.pbi"

Global MainForm
Global MainArea
Global BackCanvas
Global DrawCanvas
Global ZoomFactor.d=1 ; Le zomm de départ est à 100%
Global *myRullH,*myRullV
Global DrawWithPxl,DrawHeightPxl
Global W=210,H=297 ; Format A4
Structure Guide
    Value.i
    Type.i
    *IdGrid
EndStructure
Global NewList myGuide.Guide()
; Déclaration des procédures
Declare Exit()
Declare EventRull(*IdRull,Value,LeftButtonUp.b,myData)
Declare CalculDrawPxlSize()
Declare Resize()
Declare CanvasEvent()
Declare DrawLine()
MainForm=OpenWindow(#PB_Any,0,0,800,600,"teste",#PB_Window_SizeGadget|#PB_Window_SystemMenu|#PB_Window_Maximize)
; Création d'une aire de positionement
MainArea=ScrollAreaGadget(#PB_Any,0,0,WindowWidth(MainForm),WindowHeight(MainForm),WindowWidth(MainForm)-5,WindowHeight(MainForm)-5,50)
; Création de la règle horisontale
*myRullH=Rull::Create(W,@EventRull())
; Création de la règle Verticale
*myRullV=Rull::Create(H,@EventRull(),1)
; Création de la surface de dessin
DrawCanvas=CanvasGadget(#PB_Any,0,0,100,100,#PB_Canvas_Keyboard)
CloseGadgetList() ; ferme le ScrollArea

; Repositionne les canvas
Resize()
; Mise ne place des callback
BindGadgetEvent(DrawCanvas,@CanvasEvent())
BindEvent(#PB_Event_CloseWindow,@Exit(),MainForm)
Procedure Exit()
    Rull::FreeRull(*myRullH)
    Rull::FreeRull(*myRullV)
    End
EndProcedure
Procedure EventRull(*IdRull,Value,LeftButtonUp.b,myData)
    Select *IdRull
        Case *myRullH
            If myData>-1
                ;                 Debug myData
                ChangeCurrentElement(myGuide(),myData)
                If Value>0
                    myGuide()\Value=Value
                    DrawLine()
                    ProcedureReturn 
                Else
                    Rull::RemoveGrid(*myRullH,myGuide()\IdGrid)
                    DeleteElement(myGuide())
                    DrawLine()
                    ProcedureReturn 
                EndIf
            EndIf
            If  LeftButtonUp
                AddElement(myGuide())
                With myGuide()
                    \Type=0
                    \Value=Value
                    \IdGrid=Rull::AddGrid(*myRullH,\Value,@myGuide(),RGBA(0, 0, 128, 100),1)
                    DrawLine()
                    ProcedureReturn 
                EndWith
            EndIf
        Case *myRullV
            If myData>-1
                ChangeCurrentElement(myGuide(),myData)
                If Value>0 ; On modifie la position
                    myGuide()\Value=Value
                    DrawLine()
                    ProcedureReturn 
                Else ; on supprime le guide
                    Rull::RemoveGrid(*myRullV,myGuide()\IdGrid)
                    DeleteElement(myGuide())
                    DrawLine()
                    ProcedureReturn 
                EndIf
            EndIf
            If  LeftButtonUp   
                AddElement(myGuide())
                With myGuide()
                    \Type=1
                    \Value=Value
                    \IdGrid=Rull::AddGrid(*myRullV,\Value,@myGuide(),RGBA(0, 0, 128, 100),1)
                    DrawLine()
                    ProcedureReturn 
                EndWith
            EndIf
    EndSelect
EndProcedure
Procedure CalculDrawPxlSize()
    StartVectorDrawing(CanvasVectorOutput(DrawCanvas,#PB_Unit_Millimeter))
    ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
    DrawWithPxl=ConvertCoordinateX(W,0,#PB_Coordinate_User,#PB_Coordinate_Device)
    DrawHeightPxl=ConvertCoordinateY(0,H,#PB_Coordinate_User,#PB_Coordinate_Device)
    StopVectorDrawing()
EndProcedure
Procedure Resize()
    Protected W,H,X,Y,RullHW,RullHH,RullVW,RullVH
    ; Calcul en Pxl la taille de la zone de dessin
    CalculDrawPxlSize()
    ; Modifie le Zoom des règles
    Rull::SetZoom(*myRullH,ZoomFactor)
    Rull::SetZoom(*myRullV,ZoomFactor)
    ; Récupère les dimentions des règles
    RullHW=Rull::GetPxlWidth(*myRullH)
    RullHH=Rull::GetPxlHeight(*myRullH)
    RullVW=Rull::GetPxlWidth(*myRullV)
    RullVH=Rull::GetPxlHeight(*myRullV)
    ; Calcul le centrage
    If (DrawWithPxl+RullHH)<=GadgetWidth(MainArea)-50
        SetGadgetAttribute(MainArea,#PB_ScrollArea_InnerWidth,GadgetWidth(MainArea)-50)
        X=(GadgetWidth(MainArea)/2)-((DrawWithPxl+RullHH)/2)
    Else
        SetGadgetAttribute(MainArea,#PB_ScrollArea_InnerWidth,(DrawWithPxl+RullHH)+50)
        X=0
    EndIf
    If (DrawHeightPxl+RullW)<=GadgetHeight(MainArea)-50
        SetGadgetAttribute(MainArea,#PB_ScrollArea_InnerHeight,GadgetHeight(MainArea)-50)
        Y=(GadgetHeight(MainArea)/2)-((DrawHeightPxl+RullW)/2)
    Else
        SetGadgetAttribute(MainArea,#PB_ScrollArea_InnerHeight,(DrawHeightPxl+RullW)+50)
    EndIf
    ; Repositionne les règles
    Rull::SetPosition(*myRullH,X+RullVW,Y)
    Rull::SetPosition(*myRullV,X,Y+RullHH)
    ;Repositionne la zone de dessin
    X+RullVW
    Y+RullHH
    ResizeGadget(DrawCanvas,X,Y,DrawWithPxl,DrawHeightPxl)
    DrawLine()
EndProcedure
Procedure CanvasEvent()
    Protected WDelta
    Select EventType()
        Case #PB_EventType_MouseWheel ; Gestion du zoom
            If GetGadgetAttribute(DrawCanvas,#PB_Canvas_Modifiers)=#PB_Canvas_Control
                WDelta= GetGadgetAttribute(DrawCanvas,#PB_Canvas_WheelDelta)
                If WDelta>0
                    ZoomFactor=ZoomFactor+0.1
                    Resize()
                EndIf
                If WDelta<0
                    If ZoomFactor>0.25
                        ZoomFactor=ZoomFactor-0.1
                        Resize()
                    EndIf
                EndIf
            EndIf
    EndSelect
EndProcedure
Procedure DrawLine()
    Protected X,Y,W,H
    StartVectorDrawing(CanvasVectorOutput(DrawCanvas,#PB_Unit_Millimeter))
    ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
    VectorSourceColor($FFFFFFFF)
    FillVectorOutput()
    VectorSourceColor($FFCD0000)
    ForEach myGuide()
        With myGuide()
            Select \Type
                Case 0
                    X=\Value
                    Y=0
                    H=GadgetHeight(DrawCanvas)
                    MovePathCursor(X,Y)
                    AddPathLine(0,H,#PB_Path_Relative)    
                Case 1
                    Y=\Value
                    X=0
                    W=GadgetWidth(DrawCanvas)
                    MovePathCursor(X,Y)
                    AddPathLine(W,0,#PB_Path_Relative)
            EndSelect
            DotPath(0.4,2)
            ResetPath()
        EndWith
    Next
    StopVectorDrawing()
EndProcedure

Repeat:WaitWindowEvent():ForEver

falsam · Message par **falsam** » mar. 07/juin/2016 14:48

Joli travail Micro. Merci ^^

GallyHC · Message par **GallyHC** » mar. 07/juin/2016 15:09

Comme dab bon taff,

GallyHC

microdevweb · Message par **microdevweb** » mer. 08/juin/2016 8:38

Voila la version définitive 1 est en ligne

Kwai chang caine · Message par **Kwai chang caine** » mer. 08/juin/2016 10:14

Et ben encore du bon boulot...t'es pas tout seul, t'as des asiatiques !!!

Encore merci de ce partage parmis tant d'autres

microdevweb · Message par **microdevweb** » ven. 10/juin/2016 8:31

Nouvelle version 1.1

2 nouvelles fonctions
ClearGrid(IdRull)
SetGridValue(IdRull,IdGrid,Value)

nico · Message par **nico** » sam. 11/juin/2016 14:45

Bravo.

Shadow · Message par **Shadow** » sam. 11/juin/2016 17:51

Jolie jolie

Tien nico, fait plaisir de te revoir ici, ça va ?

Bernie · Message par **Bernie** » sam. 11/juin/2016 18:50

Merci du partage

nico · Message par **nico** » dim. 12/juin/2016 7:56

@Shadow

Oui ça va, je passe régulièrement sur le forum, mais je ne programme plus depuis un certain temps.

Micoute · Message par **Micoute** » dim. 12/juin/2016 8:00

Ce sont des choses qui arrivent, surtout quand on s'est investi dans un grand projet, on ne voit pas ce qu'on pourrait faire de mieux.

PureBasic

Module Règles

Module Règles

Re: Module Règles

Re: Module Règles

Re: Module Règles

Re: Module Règles

Re: Module Règles

Re: Module Règles

Re: Module Règles

Re: Module Règles

Re: Module Règles

Re: Module Règles

Re: Module Règles

Re: Module Règles