PureBasic

Forums PureBasic
Nous sommes le Jeu 22/Aoû/2019 6:45

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 12 messages ] 
Auteur Message
 Sujet du message: Dessiner sur une feuille A4 avec vector
MessagePosté: Mer 22/Juin/2016 6:08 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 29/Juin/2011 14:11
Messages: 1645
Localisation: Belgique
Bonjour à tous,

Si vous devez dans un de vos programme en vue d'une impression, dessiner sur par exemple une feuille A4 (210x297 mm). La principale difficulté sera la conversion en pixels, heureusement la bibliothèque vector va grandement nous facilité la vie.

Dans ce tutoriel je vous propose une petit exemple de dessin très simple, bien que vector permette la création d'un logiciel de dessin complet le but de ce tutoriel est de vous monter la conversion de mm en pixel nous ne dessinerons donc que des rectangles

L'exemple reprendra les possibilités suivantes
  • Dessin sur une feuille A4 de rectangles
  • Déplacement et redimensionnement des rectangles
  • Fonction de zoom sur la feuille avec la touche control et la molette de la souris
  • Impression de la feuille A4

Le tutoriel est composé de 4 parties
  • Mise en place et fonction de zoom
  • Dessin de rectangles
  • Déplacement des rectangles
  • Impression de la feuille A4

Remarques: Ne voulant pas utilisé de menu pour l'ajout ou l'édition d'un rectangle j'ai du usé de certains stratagèmes qui malheureusement rendre le code peut-être complexe à comprendre, je m'excuse de cela :wink:

Vous pouvez également télécharger les sources directement sur Github

_________________
Windows 10 64 bits PB: 5.70 ; 5.71 beta 2


Dernière édition par microdevweb le Mer 22/Juin/2016 9:19, édité 7 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Dessiner sur une feuille A4 avec vector
MessagePosté: Mer 22/Juin/2016 6:09 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 29/Juin/2011 14:11
Messages: 1645
Localisation: Belgique
Première partie: mise en place et fonction Zoom

Code:
;************************************************************************************************************************
; Author : MicrodevWeb
; Project Name : Tuto Draw on A4 sheet
; File Name : Draw_on_A4_sheet_01.pb
; Description : Mise ne place et fonction de zoom
;************************************************************************************************************************
EnableExplicit
;-* Global variables and constants
#MainForm=0
#MainArea=0
#MainCanvas=1
; Format A4 en Mm
Global SheetWidh=210,SheetHeight=297
; Format A4 en pixels et suivant le facteur de zoom
Global SheetPxlWidht,SheetPxlHeight
; Facteur de zoom
Global ZoomFactor.d=0.5,MinimumZoom=0.25,MaximumZoom=4
; Couleur de fond au format RGBA pour vector RGB ne fonctionne pas
Global BgColor.q=RGBA(255, 255, 255, 255)
;}
;-* procedures declaration
Declare OpenMainForm()
Declare GetSizeInPxl()
Declare RepositionOfGadget()
Declare Exit()
Declare myCanvasEvent()
Declare Draw()
Declare ManageZoom()
;}
;-* procedures
Procedure OpenMainForm()
    Protected Title.s="Draw on the A4 sheet Part 1"
    Protected Flag=#PB_Window_SystemMenu|#PB_Window_Maximize
    Protected WF,HF
    ; Ouverture de la fenêtre
    OpenWindow(#MainForm,0,0,800,600,Title,Flag)
    ; Relève la taille de la fenêtre
    WF=WindowWidth(#MainForm)
    HF=WindowHeight(#MainForm)
    ; Création d'un SrollArea
    ScrollAreaGadget(#MainArea,0,0,WF,HF,WF-5,HF-5,50)
    ; Création du canvas avec des dimentions quelconques
    CanvasGadget(#MainCanvas,0,0,100,100,#PB_Canvas_Keyboard)
    ; Fermeture du srollArea
    CloseGadgetList()
    ; Redimention et positionement du canvas
    RepositionOfGadget()
    ; Dessin du canvas
    Draw()
    ; Mise en place des callback
    ; Pour la sortie
    BindEvent(#PB_Event_CloseWindow,@Exit(),#MainForm)
    ; Pour la gestion du canvas
    BindGadgetEvent(#MainCanvas,@myCanvasEvent())
EndProcedure
Procedure GetSizeInPxl()
    ; Important ici on choisi l'unité en pixel
    StartVectorDrawing(CanvasVectorOutput(#MainCanvas,#PB_Unit_Millimeter))
    ; On applique le zoom
    ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
    ; On convertis maintenant les dimentions en pixels
    SheetPxlWidht=ConvertCoordinateX(SheetWidh,0,#PB_Coordinate_User,#PB_Coordinate_Device)
    SheetPxlHeight=ConvertCoordinateY(0,SheetHeight,#PB_Coordinate_User,#PB_Coordinate_Device)
    StopVectorDrawing()
EndProcedure
Procedure RepositionOfGadget()
    Protected X,Y
    ; Convertion de la taille en Pxl
    GetSizeInPxl()
    ; Si la largeur du canvas est plus petite que la largeur du srollArea on centre sur l'axe X
    If SheetPxlWidht<GadgetWidth(#MainArea)
        X=(GadgetWidth(#MainArea)/2)-(SheetPxlWidht/2)
    Else
        X=0
    EndIf
    ; Si la hauteur du canvas est plus petite que la hauteur du srollArea on centre sur l'axe Y
    If SheetPxlHeight<GadgetHeight(#MainArea)
        Y=(GadgetHeight(#MainArea)/2)-(SheetPxlHeight/2)
    Else
        Y=0
    EndIf
    ; On positionne est dimentionne le canvas
    ResizeGadget(#MainCanvas,X,Y,SheetPxlWidht,SheetPxlHeight)
    ;Redimentionne la zone interne du scrollArea
    If GadgetWidth(#MainCanvas)-5>GadgetWidth(#MainArea)
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerWidth,GadgetWidth(#MainCanvas)+50)
    Else
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerWidth,GadgetWidth(#MainArea)-5)
    EndIf
    If GadgetHeight(#MainCanvas)-5>GadgetHeight(#MainArea)
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerHeight,GadgetHeight(#MainCanvas)+50)
    Else
         SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerHeight,GadgetHeight(#MainArea)-5)
    EndIf
EndProcedure
Procedure Exit()
    End
EndProcedure
Procedure myCanvasEvent()
    Select EventType()
        Case #PB_EventType_MouseWheel ; La molette de la souris
            ManageZoom()
    EndSelect
EndProcedure
Procedure Draw()
    ; Important ici on choisi l'unité en pixel
    StartVectorDrawing(CanvasVectorOutput(#MainCanvas,#PB_Unit_Millimeter))
    ; On applique le zoom
    ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
    ; J'efface le canvas avec la couleur de fond
    VectorSourceColor(BgColor)
    FillVectorOutput()
   
    StopVectorDrawing()
EndProcedure
Procedure ManageZoom()
    Protected Delta
    ; Si la touche control n'est pas enfoncée je sort
    If GetGadgetAttribute(#MainCanvas,#PB_Canvas_Modifiers)<>#PB_Canvas_Control
        ProcedureReturn
    EndIf
    Delta=GetGadgetAttribute(#MainCanvas,#PB_Canvas_WheelDelta)
    If Delta<0 ;Molette vers le bas
        If ZoomFactor>MinimumZoom
            ZoomFactor-0.1
        EndIf
    Else
        If ZoomFactor<MaximumZoom
            ZoomFactor+0.1
        EndIf
    EndIf
    RepositionOfGadget()
    Draw()
EndProcedure
;}

OpenMainForm()

;-* Main loop
Repeat:WaitWindowEvent():ForEver
;}

_________________
Windows 10 64 bits PB: 5.70 ; 5.71 beta 2


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Dessiner sur une feuille A4 avec vector
MessagePosté: Mer 22/Juin/2016 6:49 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 29/Juin/2011 14:11
Messages: 1645
Localisation: Belgique
Partie 2: Dessin des rectangles

Code:
;************************************************************************************************************************
; Author : MicrodevWeb
; Project Name : Tuto Draw on A4 sheet
; File Name : Draw_on_A4_sheet_01.pb
; Description : Mise ne place et fonction de zoom
;************************************************************************************************************************
EnableExplicit
;-* Global variables and constants
#MainForm=0
#MainArea=0
#MainCanvas=1
; Format A4 en Mm
Global SheetWidh=210,SheetHeight=297
; Format A4 en pixels et suivant le facteur de zoom
Global SheetPxlWidht,SheetPxlHeight
; Facteur de zoom
Global ZoomFactor.d=0.5,MinimumZoom=0.25,MaximumZoom=4
; Couleur de fond au format RGBA pour vector RGB ne fonctionne pas
Global BgColor.q=RGBA(255, 255, 255, 255)
; Positions de la souris
Global gMouseX,gMouseY,OldX,OldY
; Les rectangles
Structure pos
    X.i
    Y.i
    W.i
    H.i
EndStructure
Global NewList myBox.pos()
Global BoxColor=RGBA(178, 58, 238, 255)
; Le rectangle qui sera sélectionné au départ -1 car aucun rectangle n'est sélectionné
Global *CurrentBox=-1
; Le rectangle survolé au départ -1 car aucun rectangle n'est survolé
Global *BoxOver=-1
; L'action, si pas sur un rectangle et clique de la souris on ajoute
; si sur un rectangle on le sélectionne
Enumeration Action
    #Add
    #Edit
EndEnumeration
Global CurrentAction.i=-1 ; -1 pas d'action
                          ;}
                          ;-* procedures declaration
Declare OpenMainForm()
Declare GetSizeInPxl()
Declare RepositionOfGadget()
Declare Exit()
Declare myCanvasEvent()
Declare Draw()
Declare ManageZoom()
Declare GetMousePosition()
Declare ManageNewBox()
Declare WhereIsMouse()
Declare DrawBox()
;}
;-* procedures
Procedure OpenMainForm()
    Protected Title.s="Draw on the A4 sheet Part 1"
    Protected Flag=#PB_Window_SystemMenu|#PB_Window_Maximize
    Protected WF,HF
    ; Ouverture de la fenêtre
    OpenWindow(#MainForm,0,0,800,600,Title,Flag)
    ; Relève la taille de la fenêtre
    WF=WindowWidth(#MainForm)
    HF=WindowHeight(#MainForm)
    ; Création d'un SrollArea
    ScrollAreaGadget(#MainArea,0,0,WF,HF,WF-5,HF-5,50)
    ; Création du canvas avec des dimentions quelconques
    CanvasGadget(#MainCanvas,0,0,100,100,#PB_Canvas_Keyboard)
    ; Fermeture du srollArea
    CloseGadgetList()
    ; Redimention et positionement du canvas
    RepositionOfGadget()
    ; Dessin du canvas
    Draw()
    ; Mise en place des callback
    ; Pour la sortie
    BindEvent(#PB_Event_CloseWindow,@Exit(),#MainForm)
    ; Pour la gestion du canvas
    BindGadgetEvent(#MainCanvas,@myCanvasEvent())
EndProcedure
Procedure GetSizeInPxl()
    ; Important ici on choisi l'unité en pixel
    StartVectorDrawing(CanvasVectorOutput(#MainCanvas,#PB_Unit_Millimeter))
    ; On applique le zoom
    ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
    ; On convertis maintenant les dimentions en pixels
    SheetPxlWidht=ConvertCoordinateX(SheetWidh,0,#PB_Coordinate_User,#PB_Coordinate_Device)
    SheetPxlHeight=ConvertCoordinateY(0,SheetHeight,#PB_Coordinate_User,#PB_Coordinate_Device)
    StopVectorDrawing()
EndProcedure
Procedure RepositionOfGadget()
    Protected X,Y
    ; Convertion de la taille en Pxl
    GetSizeInPxl()
    ; Si la largeur du canvas est plus petite que la largeur du srollArea on centre sur l'axe X
    If SheetPxlWidht<GadgetWidth(#MainArea)
        X=(GadgetWidth(#MainArea)/2)-(SheetPxlWidht/2)
    Else
        X=0
    EndIf
    ; Si la hauteur du canvas est plus petite que la hauteur du srollArea on centre sur l'axe Y
    If SheetPxlHeight<GadgetHeight(#MainArea)
        Y=(GadgetHeight(#MainArea)/2)-(SheetPxlHeight/2)
    Else
        Y=0
    EndIf
    ; On positionne est dimentionne le canvas
    ResizeGadget(#MainCanvas,X,Y,SheetPxlWidht,SheetPxlHeight)
    ;Redimentionne la zone interne du scrollArea
    If GadgetWidth(#MainCanvas)-5>GadgetWidth(#MainArea)
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerWidth,GadgetWidth(#MainCanvas)+50)
    Else
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerWidth,GadgetWidth(#MainArea)-5)
    EndIf
    If GadgetHeight(#MainCanvas)-5>GadgetHeight(#MainArea)
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerHeight,GadgetHeight(#MainCanvas)+50)
    Else
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerHeight,GadgetHeight(#MainArea)-5)
    EndIf
EndProcedure
Procedure Exit()
    End
EndProcedure
Procedure myCanvasEvent()
    Static ClicOn.b=#False
    ; Relève la position de la souris en mm
    GetMousePosition()
    Select EventType()
        Case #PB_EventType_MouseWheel ; La molette de la souris
            ManageZoom()
        Case #PB_EventType_MouseMove
            If Not ClicOn
                WhereIsMouse() ; on verra cela plus tard
                ProcedureReturn
            EndIf
            ; Le bt de la souris est enfoncé
            Select CurrentAction
                Case #Add
                    ManageNewBox()
                Case #Edit
                    ; on verra cela plus tard
            EndSelect
        Case #PB_EventType_LeftButtonDown
            ; On mémorise la position de la souris lord du premier clique
            If Not ClicOn
                OldX=gMouseX
                OldY=gMouseY
                ; Si aucun rectangle n'est survolé on passe en mode ajout
                If *BoxOver=-1
                    CurrentAction=#Add
                    AddElement(myBox())
                EndIf
            EndIf
            ClicOn=#True
        Case #PB_EventType_LeftButtonUp
            ; plus d'action
            CurrentAction=-1
            ClicOn=#False
    EndSelect
EndProcedure
Procedure Draw()
    ; Important ici on choisi l'unité en pixel
    StartVectorDrawing(CanvasVectorOutput(#MainCanvas,#PB_Unit_Millimeter))
    ; On applique le zoom
    ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
    ; J'efface le canvas avec la couleur de fond
    VectorSourceColor(BgColor)
    FillVectorOutput()
    DrawBox()
    StopVectorDrawing()
EndProcedure
Procedure ManageZoom()
    Protected Delta
    ; Si la touche control n'est pas enfoncée je sort
    If GetGadgetAttribute(#MainCanvas,#PB_Canvas_Modifiers)<>#PB_Canvas_Control
        ProcedureReturn
    EndIf
    Delta=GetGadgetAttribute(#MainCanvas,#PB_Canvas_WheelDelta)
    If Delta<0 ;Molette vers le bas
        If ZoomFactor>MinimumZoom
            ZoomFactor-0.1
        EndIf
    Else
        If ZoomFactor<MaximumZoom
            ZoomFactor+0.1
        EndIf
    EndIf
    RepositionOfGadget()
    Draw()
EndProcedure
Procedure GetMousePosition()
    ; Important ici on choisi l'unité en pixel
    StartVectorDrawing(CanvasVectorOutput(#MainCanvas,#PB_Unit_Millimeter))
    ; On applique le zoom
    ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
    ; Conversion de la position de la souris en Mm
    gMouseX=ConvertCoordinateX(GetGadgetAttribute(#MainCanvas,#PB_Canvas_MouseX),0,#PB_Coordinate_Device,#PB_Coordinate_User)
    gMouseY=ConvertCoordinateY(0,GetGadgetAttribute(#MainCanvas,#PB_Canvas_MouseY),#PB_Coordinate_Device,#PB_Coordinate_User)
    StopVectorDrawing()
EndProcedure
Procedure WhereIsMouse()
    ; On verra cela plus tard, mais actuelement on va dire qu'aucun rectangle n'est survolé
    *BoxOver=-1
    ProcedureReturn #False
EndProcedure
Procedure ManageNewBox()
    ; Le déplacement de la souris depuis le premier clique
    Protected DepX,DepY
    DepX=gMouseX-OldX
    DepY=gMouseY-OldY
    ; La taille minimum du rectangle est de 1mm
    If DepX<1 Or DepY<1
        ; On change le curseur de la souris
        SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
        ProcedureReturn
    EndIf
    With myBox()
        \X=OldX
        \Y=OldY
        \W=DepX
        \H=DepY
    EndWith
    ; On change le curseur de la souris
    SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Cross)
    ; On dessine la feuille
    Draw()
EndProcedure
Procedure DrawBox()
    VectorSourceColor(BoxColor)
    ForEach myBox()
        With myBox()
            AddPathBox(\X,\Y,\W,\H)
        EndWith
    Next
    FillPath()
EndProcedure
;}

OpenMainForm()

;-* Main loop
Repeat:WaitWindowEvent():ForEver
;}

_________________
Windows 10 64 bits PB: 5.70 ; 5.71 beta 2


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Dessiner sur une feuille A4 avec vector
MessagePosté: Mer 22/Juin/2016 7:51 
Hors ligne

Inscription: Sam 08/Fév/2014 15:19
Messages: 1592
Merci microdevweb pour ce travail didactique.

Juste un petit détail d'ergonomie: beaucoup de développeurs travaillent sur ordinateur fixe, avec écran 16:9 (enfin c'est ce que j'observe le plus souvent), donc les applications qui s'ouvrent par défaut en mode full-screen c'est un peu envahissant car on perd d'un seul coup la visibilité sur nos autres outils en cours.

Je pense qu'il est plus intéressant du point de vue usage qu'une application s'ouvre par défaut soit dans l'une des dimensions standard (1024x768 ou 800x600) soit de faire une fonction qui teste la largeur de l'écran (non-vrituel) utilisateur au démarrage et de faire par exemple: si largeur > 1024 alors largeur par défaut application = 1/2

La plupart des 16:9 actuels sont en 1920x1080

:wink:

_________________
Windows 10 Famille x64 + Linux (Slackware, Debian sur Oracle VirtualBox 6.0)


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Dessiner sur une feuille A4 avec vector
MessagePosté: Mer 22/Juin/2016 8:53 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 29/Juin/2011 14:11
Messages: 1645
Localisation: Belgique
@Marc56,

J'ai pris ta remarque en considération et modifié l'ouverture de la fenêtre dans ce sens

_________________
Windows 10 64 bits PB: 5.70 ; 5.71 beta 2


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Dessiner sur une feuille A4 avec vector
MessagePosté: Mer 22/Juin/2016 8:54 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 29/Juin/2011 14:11
Messages: 1645
Localisation: Belgique
Partie 3: Déplacement et modification des rectangles

Code:
;************************************************************************************************************************
; Author : MicrodevWeb
; Project Name : Tuto Draw on A4 sheet
; File Name : Draw_on_A4_sheet_03.pb
; Description : Sélection et déplacement des rectangles
;************************************************************************************************************************
EnableExplicit
;-* Global variables and constants
#MainForm=0
#MainArea=0
#MainCanvas=1
; Format A4 en Mm
Global SheetWidh=210,SheetHeight=297
; Format A4 en pixels et suivant le facteur de zoom
Global SheetPxlWidht,SheetPxlHeight
; Facteur de zoom
Global ZoomFactor.d=0.5,MinimumZoom=0.25,MaximumZoom=4
; Couleur de fond au format RGBA pour vector RGB ne fonctionne pas
Global BgColor.q=RGBA(255, 255, 255, 255)
; Positions de la souris
Global gMouseX,gMouseY,OldX,OldY
; Les rectangles
Structure pos
    X.i
    Y.i
    W.i
    H.i
EndStructure
Global NewList myBox.pos()
Global OldBox.pos
Global BoxColor=RGBA(178, 58, 238, 255)
; Le rectangle qui sera sélectionné au départ -1 car aucun rectangle n'est sélectionné
Global *CurrentBox=-1
; Le rectangle survolé au départ -1 car aucun rectangle n'est survolé
Global *BoxOver=-1
; L'action, si pas sur un rectangle et clique de la souris on ajoute
; si sur un rectangle on le sélectionne
Enumeration Action
    #Add
    #Edit
EndEnumeration
Global CurrentAction.i=-1 ; -1 pas d'action
; Les poignées
Enumeration HandleType
    #Lu ; gauche au dessus
    #Lm ; gauche au millieu
    #Ld ; Gauche en bas
    #Ru ; droite au dessus
    #Rm ; droite au millieu
    #Rd ; droite en bas
    #Um ; Haut au millieu
    #Dm ; Bas au millieu
EndEnumeration
Structure Handle Extends pos
    Type.i
EndStructure
Global NewList myHandles.Handle()
; La taille de la poignée Attention en Mm
Global HandleSize=4
Global HandleColor.q=RGBA(139, 136, 120, 255)
Global HandleColorOver.q=RGBA(0, 255, 0, 255)
Global *HandleOver=-1
;}
;-* procedures declaration
Declare OpenMainForm()
Declare GetSizeInPxl()
Declare RepositionOfGadget()
Declare Exit()
Declare myCanvasEvent()
Declare Draw()
Declare ManageZoom()
Declare GetMousePosition()
Declare ManageNewBox()
Declare WhereIsMouse()
Declare DrawBox()
Declare AddHandles()
Declare DrawHandles()
Declare IsOverHandle()
Declare CopyPosition()
Declare ResizeBox()
Declare MoveHandles()
Declare EventResize()
;}
;-* procedures
Procedure OpenMainForm()
    Protected Title.s="Draw on the A4 sheet Part 1"
    Protected Flag=#PB_Window_SystemMenu|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget
    Flag|#PB_Window_ScreenCentered|#PB_Window_SizeGadget
    Protected WF,HF
    ; Ouverture de la fenêtre
    OpenWindow(#MainForm,0,0,800,600,Title,Flag)
    ; Relève la taille de la fenêtre
    WF=WindowWidth(#MainForm)
    HF=WindowHeight(#MainForm)
    ; Création d'un SrollArea
    ScrollAreaGadget(#MainArea,0,0,WF,HF,WF-5,HF-5,50)
    ; Création du canvas avec des dimentions quelconques
    CanvasGadget(#MainCanvas,0,0,100,100,#PB_Canvas_Keyboard)
    ; Fermeture du srollArea
    CloseGadgetList()
    ; Redimention et positionement du canvas
    RepositionOfGadget()
    ; Dessin du canvas
    Draw()
    ; Mise en place des callback
    ; Pour la sortie
    BindEvent(#PB_Event_CloseWindow,@Exit(),#MainForm)
    ; Pour la gestion du canvas
    BindGadgetEvent(#MainCanvas,@myCanvasEvent())
    ; Pour le resize de la fenêtre
    BindEvent(#PB_Event_SizeWindow,@EventResize(),#MainForm)
EndProcedure
Procedure GetSizeInPxl()
    ; Important ici on choisi l'unité en pixel
    StartVectorDrawing(CanvasVectorOutput(#MainCanvas,#PB_Unit_Millimeter))
    ; On applique le zoom
    ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
    ; On convertis maintenant les dimentions en pixels
    SheetPxlWidht=ConvertCoordinateX(SheetWidh,0,#PB_Coordinate_User,#PB_Coordinate_Device)
    SheetPxlHeight=ConvertCoordinateY(0,SheetHeight,#PB_Coordinate_User,#PB_Coordinate_Device)
    StopVectorDrawing()
EndProcedure
Procedure RepositionOfGadget()
    Protected X,Y
    ; Convertion de la taille en Pxl
    GetSizeInPxl()
    ; Si la largeur du canvas est plus petite que la largeur du srollArea on centre sur l'axe X
    If SheetPxlWidht<GadgetWidth(#MainArea)
        X=(GadgetWidth(#MainArea)/2)-(SheetPxlWidht/2)
    Else
        X=0
    EndIf
    ; Si la hauteur du canvas est plus petite que la hauteur du srollArea on centre sur l'axe Y
    If SheetPxlHeight<GadgetHeight(#MainArea)
        Y=(GadgetHeight(#MainArea)/2)-(SheetPxlHeight/2)
    Else
        Y=0
    EndIf
    ; On positionne est dimentionne le canvas
    ResizeGadget(#MainCanvas,X,Y,SheetPxlWidht,SheetPxlHeight)
    ;Redimentionne la zone interne du scrollArea
    If GadgetWidth(#MainCanvas)-5>GadgetWidth(#MainArea)
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerWidth,GadgetWidth(#MainCanvas)+50)
    Else
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerWidth,GadgetWidth(#MainArea)-5)
    EndIf
    If GadgetHeight(#MainCanvas)-5>GadgetHeight(#MainArea)
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerHeight,GadgetHeight(#MainCanvas)+50)
    Else
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerHeight,GadgetHeight(#MainArea)-5)
    EndIf
EndProcedure
Procedure Exit()
    End
EndProcedure
Procedure myCanvasEvent()
    Static ClicOn.b=#False
    Static BoxAdded.b=#False
    ; Relève la position de la souris en mm
    GetMousePosition()
    Select EventType()
        Case #PB_EventType_MouseWheel ; La molette de la souris
            ManageZoom()
        Case #PB_EventType_MouseMove
            If Not ClicOn
                If WhereIsMouse()
                    ; Si pas de poignée survolée et le que le rectangle est sélectionné
                    If *HandleOver=-1 And *CurrentBox>-1 And *CurrentBox=*BoxOver
                        SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Arrows)
                    EndIf
                    ProcedureReturn
                EndIf
                ; Si pas de rectangle sélectionné je change le curseur de la souris
                SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
                ProcedureReturn
            EndIf
            ; Le bt de la souris est enfoncé
            Select CurrentAction
                Case #Add
                    ; Le box n'est pas encore ajouté on l'ajoute
                    If Not BoxAdded
                        AddElement(myBox())
                        BoxAdded=#True
                    EndIf
                    ManageNewBox()
                Case #Edit
                   ResizeBox()
            EndSelect
        Case #PB_EventType_LeftButtonDown
            ; On mémorise la position de la souris lord du premier clique
            If Not ClicOn
                OldX=gMouseX
                OldY=gMouseY
                ; On copie la position du rectangle
                CopyPosition()
                ; Si aucun rectangle n'est survolé on passe en mode ajout
                If *BoxOver=-1 And *HandleOver=-1
                    CurrentAction=#Add
                    ;Le box n'est pas encore ajouté
                    BoxAdded=#False
                    ; On supprime une éventuelle sélection si pas sur une poignée
                    If *HandleOver=-1
                        *CurrentBox=-1
                        ClearList(myHandles())
                        Draw()
                    EndIf
                Else
                    ; Si pas encore d'action
                    If *BoxOver<>*CurrentBox
                        ; Survole un rectangle je passe en mode édition
                        CurrentAction=#Edit
                        *CurrentBox=*BoxOver
                        ; J'ajoute les poignées
                        AddHandles()
                        Draw()
                    EndIf
                EndIf
            EndIf
            ClicOn=#True
        Case #PB_EventType_LeftButtonUp
            ; plus d'action
            If *CurrentBox=-1
                CurrentAction=-1
            EndIf
            ClicOn=#False
    EndSelect
EndProcedure
Procedure Draw()
    ; Important ici on choisi l'unité en pixel
    StartVectorDrawing(CanvasVectorOutput(#MainCanvas,#PB_Unit_Millimeter))
    ; On applique le zoom
    ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
    ; J'efface le canvas avec la couleur de fond
    VectorSourceColor(BgColor)
    FillVectorOutput()
    DrawBox()
    DrawHandles()
    StopVectorDrawing()
EndProcedure
Procedure ManageZoom()
    Protected Delta
    ; Si la touche control n'est pas enfoncée je sort
    If GetGadgetAttribute(#MainCanvas,#PB_Canvas_Modifiers)<>#PB_Canvas_Control
        ProcedureReturn
    EndIf
    Delta=GetGadgetAttribute(#MainCanvas,#PB_Canvas_WheelDelta)
    If Delta<0 ;Molette vers le bas
        If ZoomFactor>MinimumZoom
            ZoomFactor-0.1
        EndIf
    Else
        If ZoomFactor<MaximumZoom
            ZoomFactor+0.1
        EndIf
    EndIf
    RepositionOfGadget()
    Draw()
EndProcedure
Procedure GetMousePosition()
    ; Important ici on choisi l'unité en pixel
    StartVectorDrawing(CanvasVectorOutput(#MainCanvas,#PB_Unit_Millimeter))
    ; On applique le zoom
    ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
    ; Conversion de la position de la souris en Mm
    gMouseX=ConvertCoordinateX(GetGadgetAttribute(#MainCanvas,#PB_Canvas_MouseX),0,#PB_Coordinate_Device,#PB_Coordinate_User)
    gMouseY=ConvertCoordinateY(0,GetGadgetAttribute(#MainCanvas,#PB_Canvas_MouseY),#PB_Coordinate_Device,#PB_Coordinate_User)
    StopVectorDrawing()
EndProcedure
Procedure WhereIsMouse()
    ; Au départ aucun rectangle n'est survolé
    *BoxOver=-1
    If IsOverHandle():ProcedureReturn #True:EndIf
    With myBox()
        ForEach myBox()
            If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\H))
                ; On mémorise l'adresse mémoire du rectangle
                *BoxOver=@myBox()
                ; On change le curseur de la souris
                SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Hand)
                ; Un rectangle est survolé
                ProcedureReturn #True
            EndIf
        Next
    EndWith
    ; Aucun rectangle n'est survolé
    ProcedureReturn #False
EndProcedure
Procedure ManageNewBox()
    ; Le déplacement de la souris depuis le premier clique
    Protected DepX,DepY
    DepX=gMouseX-OldX
    DepY=gMouseY-OldY
    ; La taille minimum du rectangle est de 1mm
    If DepX<1 Or DepY<1
        ; On change le curseur de la souris
        SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
        ProcedureReturn
    EndIf
    With myBox()
        \X=OldX
        \Y=OldY
        \W=DepX
        \H=DepY
    EndWith
    ; On change le curseur de la souris
    SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Cross)
    ; On dessine la feuille
    Draw()
EndProcedure
Procedure DrawBox()
    VectorSourceColor(BoxColor)
    ForEach myBox()
        With myBox()
            AddPathBox(\X,\Y,\W,\H)
        EndWith
    Next
    FillPath()
EndProcedure
Procedure AddHandles()
    Protected X,Y,W,H
    ; Efface les poignées
    ClearList(myHandles())
    ChangeCurrentElement(myBox(),*CurrentBox)
    With myBox()
        X=\X
        Y=\Y
        W=\W
        H=\H
    EndWith
    With myHandles()
        ; Gauche en haut
        AddElement(myHandles())
        \Type=#lu
        \X=X-(HandleSize/2)
        \Y=Y-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Gauche au millieu
        AddElement(myHandles())
        \Type=#lm
        \X=X-(HandleSize/2)
        \Y=(Y+(H/2))-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Gauche en bas
        AddElement(myHandles())
        \Type=#ld
        \X=X-(HandleSize/2)
        \Y=(Y+H)-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
       
        ; Droite en haut
        AddElement(myHandles())
        \Type=#Ru
        \X=(X+W)-(HandleSize/2)
        \Y=Y-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Droite au millieu
        AddElement(myHandles())
        \Type=#Rm
        \X=(X+W)-(HandleSize/2)
        \Y=(Y+(H/2))-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Droite en bas
        AddElement(myHandles())
        \Type=#Rd
        \X=(X+W)-(HandleSize/2)
        \Y=(Y+H)-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
       
        ; Haut au millieu
        AddElement(myHandles())
        \Type=#Um
        \X=(X+(W/2))-(HandleSize/2)
        \Y=Y-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
       
        ; Bas au millieu
        AddElement(myHandles())
        \Type=#Dm
        \X=(X+(W/2))-(HandleSize/2)
        \Y=(Y+H)-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
    EndWith
EndProcedure
Procedure DrawHandles()
    ForEach myHandles()
        With myHandles()
            ; Si la poignée est survolée
            If @myHandles()=*HandleOver
                VectorSourceColor(HandleColorOver)
            Else
                VectorSourceColor(HandleColor)
            EndIf
            AddPathBox(\X,\Y,\W,\H)
            FillPath()
        EndWith
    Next
EndProcedure
Procedure IsOverHandle()
    With myHandles()
        ForEach myHandles()
            If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\H))
                *HandleOver=@myHandles()
                ; Comme on sort de whereismouse on mémorise le Box survolé comme celui sélectionné
                *BoxOver=*CurrentBox
                ; Change le curseur de la souris
                Select \Type
                    Case #Lu,#Rd
                        SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
                    Case #Lm,#RM
                        SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
                    Case #Ld,#Ru
                        SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
                    Case #Um,#Dm
                        SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
                EndSelect
                ; dessine la feuille
                Draw()
                ProcedureReturn #True
            EndIf
        Next
    EndWith
    ; Si une poignée était survolée avant on dessine pour effacé le survol
    If *HandleOver>-1
        *HandleOver=-1
        Draw()
    EndIf
    *HandleOver=-1
    ProcedureReturn #False
EndProcedure
Procedure CopyPosition()
    If *CurrentBox=-1:ProcedureReturn :EndIf
    ChangeCurrentElement(myBox(),*CurrentBox)
    With myBox()
        OldBox\X=\X
        OldBox\Y=\Y
        OldBox\W=\W
        OldBox\H=\H
    EndWith
EndProcedure
Procedure ResizeBox()
    ; Le déplacement de la souris depuis le premier clique
    Protected DepX,DepY
    DepX=gMouseX-OldX
    DepY=gMouseY-OldY
   ChangeCurrentElement(myBox(),*CurrentBox)
    With myBox()
         ;Si pas sur un poignée om bouge le rectangle
        If *HandleOver=-1
            \X=OldBox\X+DepX
            \Y=OldBox\Y+DepY
        Else
            ChangeCurrentElement(myHandles(),*HandleOver)
            Select myHandles()\Type
                Case #Lu
                    If OldBox\W-DepX<1 Or OldBox\H-DepY<1
                        ProcedureReturn
                    EndIf
                    \W=OldBox\W-DepX
                    \X=OldBox\X+DepX
                    \Y=OldBox\Y+DepY
                    \H=OldBox\H-DepY
                Case #Lm
                    If OldBox\W-DepX<1
                        ProcedureReturn
                    EndIf
                    \W=OldBox\W-DepX
                    \X=OldBox\X+DepX
                Case #Ld
                    If OldBox\W-DepX<1 Or OldBox\H+DepY<1
                        ProcedureReturn
                    EndIf
                    \W=OldBox\W-DepX
                    \X=OldBox\X+DepX
                    \H=OldBox\H+DepY
                Case #Ru
                    If OldBox\W+DepX<1 Or OldBox\H-DepY<1
                        ProcedureReturn
                    EndIf
                    \W=OldBox\W+DepX
                    \Y=OldBox\Y+DepY
                    \H=OldBox\H-DepY
                Case #Rm
                    If OldBox\W+DepX<1
                        ProcedureReturn
                    EndIf
                    \W=OldBox\W+DepX
                Case #Rd
                     If OldBox\W+DepX<1 Or OldBox\H+DepY<1
                        ProcedureReturn
                    EndIf
                    \W=OldBox\W+DepX
                    \H=OldBox\H+DepY
                Case #Um
                    If OldBox\H-DepY<1
                        ProcedureReturn
                    EndIf
                    \Y=OldBox\Y+DepY
                    \H=OldBox\H-DepY
                Case #Dm
                   If OldBox\H+DepY<1
                        ProcedureReturn
                    EndIf
                    \H=OldBox\H+DepY 
            EndSelect
        EndIf
        MoveHandles()
        Draw()
    EndWith
EndProcedure
Procedure MoveHandles()
     Protected X,Y,W,H
    With myBox()
        X=\X
        Y=\Y
        W=\W
        H=\H
    EndWith
    With myHandles()
        ; Gauche en haut
        SelectElement(myHandles(),0)
        \X=X-(HandleSize/2)
        \Y=Y-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Gauche au millieu
        SelectElement(myHandles(),1)
        \X=X-(HandleSize/2)
        \Y=(Y+(H/2))-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Gauche en bas
        SelectElement(myHandles(),2)
        \X=X-(HandleSize/2)
        \Y=(Y+H)-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
       
        ; Droite en haut
        SelectElement(myHandles(),3)
        \X=(X+W)-(HandleSize/2)
        \Y=Y-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Droite au millieu
        SelectElement(myHandles(),4)
        \X=(X+W)-(HandleSize/2)
        \Y=(Y+(H/2))-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Droite en bas
        SelectElement(myHandles(),5)
        \X=(X+W)-(HandleSize/2)
        \Y=(Y+H)-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
       
        ; Haut au millieu
        SelectElement(myHandles(),6)
        \X=(X+(W/2))-(HandleSize/2)
        \Y=Y-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
       
        ; Bas au millieu
        SelectElement(myHandles(),7)
        \X=(X+(W/2))-(HandleSize/2)
        \Y=(Y+H)-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
    EndWith
EndProcedure
Procedure EventResize()
    Protected WF,HF
    ; Relève la taille de la fenêtre
    WF=WindowWidth(#MainForm)
    HF=WindowHeight(#MainForm)
    ResizeGadget(#MainArea,#PB_Ignore,#PB_Ignore,WF,HF)
    RepositionOfGadget()
    Draw()
EndProcedure
;}

OpenMainForm()

;-* Main loop
Repeat:WaitWindowEvent():ForEver
;}

_________________
Windows 10 64 bits PB: 5.70 ; 5.71 beta 2


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Dessiner sur une feuille A4 avec vector
MessagePosté: Mer 22/Juin/2016 9:17 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 29/Juin/2011 14:11
Messages: 1645
Localisation: Belgique
Partie 4: Final impression de feuille

Code:
;************************************************************************************************************************
; Author : MicrodevWeb
; Project Name : Tuto Draw on A4 sheet
; File Name : Draw_on_A4_sheet_04.pb
; Description : Final impression de la feuille
;************************************************************************************************************************
EnableExplicit
;-* Global variables and constants
#MainForm=0
#MainArea=0
#MainCanvas=1
; Format A4 en Mm
Global SheetWidh=210,SheetHeight=297
; Format A4 en pixels et suivant le facteur de zoom
Global SheetPxlWidht,SheetPxlHeight
; Facteur de zoom
Global ZoomFactor.d=0.5,MinimumZoom=0.25,MaximumZoom=4
; Couleur de fond au format RGBA pour vector RGB ne fonctionne pas
Global BgColor.q=RGBA(255, 255, 255, 255)
; Positions de la souris
Global gMouseX,gMouseY,OldX,OldY
; Les rectangles
Structure pos
    X.i
    Y.i
    W.i
    H.i
EndStructure
Global NewList myBox.pos()
Global OldBox.pos
Global BoxColor=RGBA(178, 58, 238, 255)
; Le rectangle qui sera sélectionné au départ -1 car aucun rectangle n'est sélectionné
Global *CurrentBox=-1
; Le rectangle survolé au départ -1 car aucun rectangle n'est survolé
Global *BoxOver=-1
; L'action, si pas sur un rectangle et clique de la souris on ajoute
; si sur un rectangle on le sélectionne
Enumeration Action
    #Add
    #Edit
EndEnumeration
Global CurrentAction.i=-1 ; -1 pas d'action
; Les poignées
Enumeration HandleType
    #Lu ; gauche au dessus
    #Lm ; gauche au millieu
    #Ld ; Gauche en bas
    #Ru ; droite au dessus
    #Rm ; droite au millieu
    #Rd ; droite en bas
    #Um ; Haut au millieu
    #Dm ; Bas au millieu
EndEnumeration
Structure Handle Extends pos
    Type.i
EndStructure
Global NewList myHandles.Handle()
; La taille de la poignée Attention en Mm
Global HandleSize=4
Global HandleColor.q=RGBA(139, 136, 120, 255)
Global HandleColorOver.q=RGBA(0, 255, 0, 255)
Global *HandleOver=-1
;}
;-* procedures declaration
Declare OpenMainForm()
Declare GetSizeInPxl()
Declare RepositionOfGadget()
Declare Exit()
Declare myCanvasEvent()
Declare Draw()
Declare ManageZoom()
Declare GetMousePosition()
Declare ManageNewBox()
Declare WhereIsMouse()
Declare DrawBox()
Declare AddHandles()
Declare DrawHandles()
Declare IsOverHandle()
Declare CopyPosition()
Declare ResizeBox()
Declare MoveHandles()
Declare EventResize()
Declare PrintSheet()
;}
;-* procedures
Procedure OpenMainForm()
    Protected Title.s="Draw on the A4 sheet Part 1"
    Protected Flag=#PB_Window_SystemMenu|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget
    Flag|#PB_Window_ScreenCentered|#PB_Window_SizeGadget
    Protected WF,HF
    ; Ouverture de la fenêtre
    OpenWindow(#MainForm,0,0,800,600,Title,Flag)
    ; Relève la taille de la fenêtre
    WF=WindowWidth(#MainForm)
    HF=WindowHeight(#MainForm)
    ; Création d'un SrollArea
    ScrollAreaGadget(#MainArea,0,0,WF,HF,WF-5,HF-5,50)
    ; Création du canvas avec des dimentions quelconques
    CanvasGadget(#MainCanvas,0,0,100,100,#PB_Canvas_Keyboard)
    ; Fermeture du srollArea
    CloseGadgetList()
    ; Redimention et positionement du canvas
    RepositionOfGadget()
    ; Dessin du canvas
    Draw()
    ; Mise en place des callback
    ; Pour la sortie
    BindEvent(#PB_Event_CloseWindow,@Exit(),#MainForm)
    ; Pour la gestion du canvas
    BindGadgetEvent(#MainCanvas,@myCanvasEvent())
    ; Pour le resize de la fenêtre
    BindEvent(#PB_Event_SizeWindow,@EventResize(),#MainForm)
    ; Ajout du raccourcis clavier pour l'impression
    AddKeyboardShortcut(#MainForm,#PB_Shortcut_Control|#PB_Shortcut_P,0)
    BindEvent(#PB_Event_Menu,@PrintSheet(),#MainForm,0)
    MessageRequester("Info","Control + P pour imprimé la feuille")
EndProcedure
Procedure GetSizeInPxl()
    ; Important ici on choisi l'unité en pixel
    StartVectorDrawing(CanvasVectorOutput(#MainCanvas,#PB_Unit_Millimeter))
    ; On applique le zoom
    ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
    ; On convertis maintenant les dimentions en pixels
    SheetPxlWidht=ConvertCoordinateX(SheetWidh,0,#PB_Coordinate_User,#PB_Coordinate_Device)
    SheetPxlHeight=ConvertCoordinateY(0,SheetHeight,#PB_Coordinate_User,#PB_Coordinate_Device)
    StopVectorDrawing()
EndProcedure
Procedure RepositionOfGadget()
    Protected X,Y
    ; Convertion de la taille en Pxl
    GetSizeInPxl()
    ; Si la largeur du canvas est plus petite que la largeur du srollArea on centre sur l'axe X
    If SheetPxlWidht<GadgetWidth(#MainArea)
        X=(GadgetWidth(#MainArea)/2)-(SheetPxlWidht/2)
    Else
        X=0
    EndIf
    ; Si la hauteur du canvas est plus petite que la hauteur du srollArea on centre sur l'axe Y
    If SheetPxlHeight<GadgetHeight(#MainArea)
        Y=(GadgetHeight(#MainArea)/2)-(SheetPxlHeight/2)
    Else
        Y=0
    EndIf
    ; On positionne est dimentionne le canvas
    ResizeGadget(#MainCanvas,X,Y,SheetPxlWidht,SheetPxlHeight)
    ;Redimentionne la zone interne du scrollArea
    If GadgetWidth(#MainCanvas)-5>GadgetWidth(#MainArea)
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerWidth,GadgetWidth(#MainCanvas)+50)
    Else
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerWidth,GadgetWidth(#MainArea)-5)
    EndIf
    If GadgetHeight(#MainCanvas)-5>GadgetHeight(#MainArea)
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerHeight,GadgetHeight(#MainCanvas)+50)
    Else
        SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerHeight,GadgetHeight(#MainArea)-5)
    EndIf
EndProcedure
Procedure Exit()
    End
EndProcedure
Procedure myCanvasEvent()
    Static ClicOn.b=#False
    Static BoxAdded.b=#False
    ; Relève la position de la souris en mm
    GetMousePosition()
    Select EventType()
        Case #PB_EventType_MouseWheel ; La molette de la souris
            ManageZoom()
        Case #PB_EventType_MouseMove
            If Not ClicOn
                If WhereIsMouse()
                    ; Si pas de poignée survolée et le que le rectangle est sélectionné
                    If *HandleOver=-1 And *CurrentBox>-1 And *CurrentBox=*BoxOver
                        SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Arrows)
                    EndIf
                    ProcedureReturn
                EndIf
                ; Si pas de rectangle sélectionné je change le curseur de la souris
                SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
                ProcedureReturn
            EndIf
            ; Le bt de la souris est enfoncé
            Select CurrentAction
                Case #Add
                    ; Le box n'est pas encore ajouté on l'ajoute
                    If Not BoxAdded
                        AddElement(myBox())
                        BoxAdded=#True
                    EndIf
                    ManageNewBox()
                Case #Edit
                   ResizeBox()
            EndSelect
        Case #PB_EventType_LeftButtonDown
            ; On mémorise la position de la souris lord du premier clique
            If Not ClicOn
                OldX=gMouseX
                OldY=gMouseY
                ; On copie la position du rectangle
                CopyPosition()
                ; Si aucun rectangle n'est survolé on passe en mode ajout
                If *BoxOver=-1 And *HandleOver=-1
                    CurrentAction=#Add
                    ;Le box n'est pas encore ajouté
                    BoxAdded=#False
                    ; On supprime une éventuelle sélection si pas sur une poignée
                    If *HandleOver=-1
                        *CurrentBox=-1
                        ClearList(myHandles())
                        Draw()
                    EndIf
                Else
                    ; Si pas encore d'action
                    If *BoxOver<>*CurrentBox
                        ; Survole un rectangle je passe en mode édition
                        CurrentAction=#Edit
                        *CurrentBox=*BoxOver
                        ; J'ajoute les poignées
                        AddHandles()
                        Draw()
                    EndIf
                EndIf
            EndIf
            ClicOn=#True
        Case #PB_EventType_LeftButtonUp
            ; plus d'action
            If *CurrentBox=-1
                CurrentAction=-1
            EndIf
            ClicOn=#False
    EndSelect
EndProcedure
Procedure Draw()
    ; Important ici on choisi l'unité en pixel
    StartVectorDrawing(CanvasVectorOutput(#MainCanvas,#PB_Unit_Millimeter))
    ; On applique le zoom
    ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
    ; J'efface le canvas avec la couleur de fond
    VectorSourceColor(BgColor)
    FillVectorOutput()
    DrawBox()
    DrawHandles()
    StopVectorDrawing()
EndProcedure
Procedure ManageZoom()
    Protected Delta
    ; Si la touche control n'est pas enfoncée je sort
    If GetGadgetAttribute(#MainCanvas,#PB_Canvas_Modifiers)<>#PB_Canvas_Control
        ProcedureReturn
    EndIf
    Delta=GetGadgetAttribute(#MainCanvas,#PB_Canvas_WheelDelta)
    If Delta<0 ;Molette vers le bas
        If ZoomFactor>MinimumZoom
            ZoomFactor-0.1
        EndIf
    Else
        If ZoomFactor<MaximumZoom
            ZoomFactor+0.1
        EndIf
    EndIf
    RepositionOfGadget()
    Draw()
EndProcedure
Procedure GetMousePosition()
    ; Important ici on choisi l'unité en pixel
    StartVectorDrawing(CanvasVectorOutput(#MainCanvas,#PB_Unit_Millimeter))
    ; On applique le zoom
    ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
    ; Conversion de la position de la souris en Mm
    gMouseX=ConvertCoordinateX(GetGadgetAttribute(#MainCanvas,#PB_Canvas_MouseX),0,#PB_Coordinate_Device,#PB_Coordinate_User)
    gMouseY=ConvertCoordinateY(0,GetGadgetAttribute(#MainCanvas,#PB_Canvas_MouseY),#PB_Coordinate_Device,#PB_Coordinate_User)
    StopVectorDrawing()
EndProcedure
Procedure WhereIsMouse()
    ; Au départ aucun rectangle n'est survolé
    *BoxOver=-1
    If IsOverHandle():ProcedureReturn #True:EndIf
    With myBox()
        ForEach myBox()
            If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\H))
                ; On mémorise l'adresse mémoire du rectangle
                *BoxOver=@myBox()
                ; On change le curseur de la souris
                SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Hand)
                ; Un rectangle est survolé
                ProcedureReturn #True
            EndIf
        Next
    EndWith
    ; Aucun rectangle n'est survolé
    ProcedureReturn #False
EndProcedure
Procedure ManageNewBox()
    ; Le déplacement de la souris depuis le premier clique
    Protected DepX,DepY
    DepX=gMouseX-OldX
    DepY=gMouseY-OldY
    ; La taille minimum du rectangle est de 1mm
    If DepX<1 Or DepY<1
        ; On change le curseur de la souris
        SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
        ProcedureReturn
    EndIf
    With myBox()
        \X=OldX
        \Y=OldY
        \W=DepX
        \H=DepY
    EndWith
    ; On change le curseur de la souris
    SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_Cross)
    ; On dessine la feuille
    Draw()
EndProcedure
Procedure DrawBox()
    VectorSourceColor(BoxColor)
    ForEach myBox()
        With myBox()
            AddPathBox(\X,\Y,\W,\H)
        EndWith
    Next
    FillPath()
EndProcedure
Procedure AddHandles()
    Protected X,Y,W,H
    ; Efface les poignées
    ClearList(myHandles())
    ChangeCurrentElement(myBox(),*CurrentBox)
    With myBox()
        X=\X
        Y=\Y
        W=\W
        H=\H
    EndWith
    With myHandles()
        ; Gauche en haut
        AddElement(myHandles())
        \Type=#lu
        \X=X-(HandleSize/2)
        \Y=Y-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Gauche au millieu
        AddElement(myHandles())
        \Type=#lm
        \X=X-(HandleSize/2)
        \Y=(Y+(H/2))-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Gauche en bas
        AddElement(myHandles())
        \Type=#ld
        \X=X-(HandleSize/2)
        \Y=(Y+H)-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
       
        ; Droite en haut
        AddElement(myHandles())
        \Type=#Ru
        \X=(X+W)-(HandleSize/2)
        \Y=Y-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Droite au millieu
        AddElement(myHandles())
        \Type=#Rm
        \X=(X+W)-(HandleSize/2)
        \Y=(Y+(H/2))-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Droite en bas
        AddElement(myHandles())
        \Type=#Rd
        \X=(X+W)-(HandleSize/2)
        \Y=(Y+H)-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
       
        ; Haut au millieu
        AddElement(myHandles())
        \Type=#Um
        \X=(X+(W/2))-(HandleSize/2)
        \Y=Y-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
       
        ; Bas au millieu
        AddElement(myHandles())
        \Type=#Dm
        \X=(X+(W/2))-(HandleSize/2)
        \Y=(Y+H)-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
    EndWith
EndProcedure
Procedure DrawHandles()
    ForEach myHandles()
        With myHandles()
            ; Si la poignée est survolée
            If @myHandles()=*HandleOver
                VectorSourceColor(HandleColorOver)
            Else
                VectorSourceColor(HandleColor)
            EndIf
            AddPathBox(\X,\Y,\W,\H)
            FillPath()
        EndWith
    Next
EndProcedure
Procedure IsOverHandle()
    With myHandles()
        ForEach myHandles()
            If (gMouseX>=\X And gMouseX<=(\X+\W)) And (gMouseY>=\Y And gMouseY<=(\Y+\H))
                *HandleOver=@myHandles()
                ; Comme on sort de whereismouse on mémorise le Box survolé comme celui sélectionné
                *BoxOver=*CurrentBox
                ; Change le curseur de la souris
                Select \Type
                    Case #Lu,#Rd
                        SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
                    Case #Lm,#RM
                        SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
                    Case #Ld,#Ru
                        SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
                    Case #Um,#Dm
                        SetGadgetAttribute(#MainCanvas,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
                EndSelect
                ; dessine la feuille
                Draw()
                ProcedureReturn #True
            EndIf
        Next
    EndWith
    ; Si une poignée était survolée avant on dessine pour effacé le survol
    If *HandleOver>-1
        *HandleOver=-1
        Draw()
    EndIf
    *HandleOver=-1
    ProcedureReturn #False
EndProcedure
Procedure CopyPosition()
    If *CurrentBox=-1:ProcedureReturn :EndIf
    ChangeCurrentElement(myBox(),*CurrentBox)
    With myBox()
        OldBox\X=\X
        OldBox\Y=\Y
        OldBox\W=\W
        OldBox\H=\H
    EndWith
EndProcedure
Procedure ResizeBox()
    ; Le déplacement de la souris depuis le premier clique
    Protected DepX,DepY
    DepX=gMouseX-OldX
    DepY=gMouseY-OldY
   ChangeCurrentElement(myBox(),*CurrentBox)
    With myBox()
         ;Si pas sur un poignée om bouge le rectangle
        If *HandleOver=-1
            \X=OldBox\X+DepX
            \Y=OldBox\Y+DepY
        Else
            ChangeCurrentElement(myHandles(),*HandleOver)
            Select myHandles()\Type
                Case #Lu
                    If OldBox\W-DepX<1 Or OldBox\H-DepY<1
                        ProcedureReturn
                    EndIf
                    \W=OldBox\W-DepX
                    \X=OldBox\X+DepX
                    \Y=OldBox\Y+DepY
                    \H=OldBox\H-DepY
                Case #Lm
                    If OldBox\W-DepX<1
                        ProcedureReturn
                    EndIf
                    \W=OldBox\W-DepX
                    \X=OldBox\X+DepX
                Case #Ld
                    If OldBox\W-DepX<1 Or OldBox\H+DepY<1
                        ProcedureReturn
                    EndIf
                    \W=OldBox\W-DepX
                    \X=OldBox\X+DepX
                    \H=OldBox\H+DepY
                Case #Ru
                    If OldBox\W+DepX<1 Or OldBox\H-DepY<1
                        ProcedureReturn
                    EndIf
                    \W=OldBox\W+DepX
                    \Y=OldBox\Y+DepY
                    \H=OldBox\H-DepY
                Case #Rm
                    If OldBox\W+DepX<1
                        ProcedureReturn
                    EndIf
                    \W=OldBox\W+DepX
                Case #Rd
                     If OldBox\W+DepX<1 Or OldBox\H+DepY<1
                        ProcedureReturn
                    EndIf
                    \W=OldBox\W+DepX
                    \H=OldBox\H+DepY
                Case #Um
                    If OldBox\H-DepY<1
                        ProcedureReturn
                    EndIf
                    \Y=OldBox\Y+DepY
                    \H=OldBox\H-DepY
                Case #Dm
                   If OldBox\H+DepY<1
                        ProcedureReturn
                    EndIf
                    \H=OldBox\H+DepY 
            EndSelect
        EndIf
        MoveHandles()
        Draw()
    EndWith
EndProcedure
Procedure MoveHandles()
     Protected X,Y,W,H
    With myBox()
        X=\X
        Y=\Y
        W=\W
        H=\H
    EndWith
    With myHandles()
        ; Gauche en haut
        SelectElement(myHandles(),0)
        \X=X-(HandleSize/2)
        \Y=Y-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Gauche au millieu
        SelectElement(myHandles(),1)
        \X=X-(HandleSize/2)
        \Y=(Y+(H/2))-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Gauche en bas
        SelectElement(myHandles(),2)
        \X=X-(HandleSize/2)
        \Y=(Y+H)-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
       
        ; Droite en haut
        SelectElement(myHandles(),3)
        \X=(X+W)-(HandleSize/2)
        \Y=Y-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Droite au millieu
        SelectElement(myHandles(),4)
        \X=(X+W)-(HandleSize/2)
        \Y=(Y+(H/2))-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
        ; Droite en bas
        SelectElement(myHandles(),5)
        \X=(X+W)-(HandleSize/2)
        \Y=(Y+H)-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
       
        ; Haut au millieu
        SelectElement(myHandles(),6)
        \X=(X+(W/2))-(HandleSize/2)
        \Y=Y-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
       
        ; Bas au millieu
        SelectElement(myHandles(),7)
        \X=(X+(W/2))-(HandleSize/2)
        \Y=(Y+H)-(HandleSize/2)
        \W=HandleSize
        \H=HandleSize
    EndWith
EndProcedure
Procedure EventResize()
    Protected WF,HF
    ; Relève la taille de la fenêtre
    WF=WindowWidth(#MainForm)
    HF=WindowHeight(#MainForm)
    ResizeGadget(#MainArea,#PB_Ignore,#PB_Ignore,WF,HF)
    RepositionOfGadget()
    Draw()
EndProcedure
Procedure PrintSheet()
    If PrintRequester()=0
        ProcedureReturn
    EndIf
    If StartPrinting("Impression")
        StartVectorDrawing(PrinterVectorOutput(#PB_Unit_Millimeter))
        DrawBox()
        StopVectorDrawing()
        StopPrinting()
    EndIf
EndProcedure
;}

OpenMainForm()

;-* Main loop
Repeat:WaitWindowEvent():ForEver
;}

_________________
Windows 10 64 bits PB: 5.70 ; 5.71 beta 2


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Dessiner sur une feuille A4 avec vector
MessagePosté: Mer 22/Juin/2016 10:27 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6644
Localisation: Isere
Comme DAB, marche nickel. :wink:
Ca devrait m'etre super utile
Merci pour le partage 8)

_________________
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Dessiner sur une feuille A4 avec vector
MessagePosté: Mer 29/Juin/2016 11:16 
Hors ligne

Inscription: Ven 10/Juin/2016 16:11
Messages: 46
Merci microdevweb,

C'est tout à fait ce dont j'ai besoin pour parfaire mon propre travail.
L'organisation générale.
La conversion pixels millimètres.
La sélection, le déplacement d'un "objet".
Les structures.
La zone Declare.
L'impression.
La souris.
Je commence à comprendre les Pointeurs.

Bon au début j'ai cru que les 4 fichiers faisaient partis d'un projet PB. Alors j'ai créé un projet avec les 4 fichiers. On ne rit pas.

Rien ne vaut un Exemple, et ce fichier est un modèle du genre.

Encore Merci,
JM


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Dessiner sur une feuille A4 avec vector
MessagePosté: Mer 29/Juin/2016 12:16 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 29/Juin/2011 14:11
Messages: 1645
Localisation: Belgique
De rien Jm,

Les pointeurs sont très utile déjà pour l'utilisation de BindEvent,BindMenu et BindGadget ou l'on passe la procédure en paramètre également pour mémorisé l'id d'une liste ou pour passé une liste à une procédure par exemple

Code:
Structure pos
    X.i
    Y.i
EndStructure
Global NewList myPos.pos()
With myPos()
    AddElement(myPos())
    \X=10
    \Y=60
EndWith
Procedure move(*myList.pos)
    *myList\X+10
EndProcedure
move(@myPos())

Debug myPos()\X

_________________
Windows 10 64 bits PB: 5.70 ; 5.71 beta 2


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Dessiner sur une feuille A4 avec vector
MessagePosté: Mar 20/Sep/2016 20:30 
Hors ligne
Avatar de l’utilisateur

Inscription: Lun 22/Nov/2004 13:05
Messages: 353
Merci et bravo pour ce tutoriel !

Envoyé de mon SM-G901F en utilisant Tapatalk


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Dessiner sur une feuille A4 avec vector
MessagePosté: Mer 21/Sep/2016 10:29 
Hors ligne
Avatar de l’utilisateur

Inscription: Ven 11/Fév/2005 17:34
Messages: 4222
Localisation: Arras, France
Bravo, très bel exemple !


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 12 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 1 invité


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye