Canvas-text

Programmation d'applications complexes
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Canvas-text

Message par microdevweb »

Canvas-text

Canvas text est un module qui permet l'ajout de texte éditable dans un canvas au format A4 (210 x 297) on peut ainsi modifié la position ainsi que la taille

Image

:arrow: Téléchargement ICI

Liste des fonctions
  • Init(IdCanvas,ZoomFactor.f,Mask.l=-1,*Callback=-1)
    Première fonction à appellé initialise le module
    --> IdCanvas --> le canvas ou sera dessiné le texte
    --> ZoomFactor --> le facteur de zoom (ex: 1 pour 100%,0.50 pour 50%)
    --> Mask --> l'id d'une image à dessiner avant le texte
    --> Callback, fonction qui sera appelée à la sélection ou modification
  • Add(*x,*y,*w,*h,font.l,color.l,value.s,myData=0,flags.l=0)
    Ajout d'un texte
    -->*Y,*W,*H --> pointeur des positions et dimensions
    --> font --> id d'une police précédemment chargée avec loadFont
    --> color --> couleur du texte au format RGBA
    --> value --> Texte à affiché
    --> myData --> Valeur retournée par la procédure callback
    --> flags --> Drapeaux pour l'alignement séparé par un OR (|)
    • #HAlignToRight --> Alignement vertical à droite
    • #HAlignToCenter --> Alignement vertical au centre
    • #VAlignToTop --> Alignement horizontal au dessus
    • #VAlignToBottom --> Alignement horizontal en bas
    Note: par défaut le texte est aligné à gauche et centré verticalement
  • SetMinMax(minX,maxX,minY,maxY,minW,maxW,minH,maxH)
    Détermine des position et dimensions minimum ou maximum, #Pb_Ignore pour ignoré un paramètre
    NOTE: Doit être appelé après Add
  • SetZoomfactor(Zoomfactor.f)
    Modifie le facteur de zoom
  • RefreshMask(Mask.l)
    Modifie l'image de fond
  • StartMe()
    Démare la gestion des textes
  • StopMe()
    Stop la gestion
Dernière modification par microdevweb le sam. 08/juil./2017 14:28, modifié 1 fois.
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: Canvas-text

Message par microdevweb »

Code du module

Code : Tout sélectionner

; *******************************************************************************************************************************************************
; AUTHOR        : MicrodevWeb
; MODULE NAME   : CVTXT
; VERSION       : 0.1
; REQUIERED     : PB 5.60
; *******************************************************************************************************************************************************
DeclareModule CVTXT
  ;======================================================================================================================================================
  ;-* PUBLIC CONSTANTE
  ; -----------------------------------------------------------------------------------------------------------------------------------------------------
  EnumerationBinary 
    #HAlignToRight
    #HAlignToCenter
    #VAlignToTop
    #VAlignToBottom
  EndEnumeration
  ;}-----------------------------------------------------------------------------------------------------------------------------------------------------
  ;======================================================================================================================================================
  ;-* PUBLIC PROTOTYPES
  ; -----------------------------------------------------------------------------------------------------------------------------------------------------
  Declare Init(IdCanvas,ZoomFactor.f,Mask.l=-1,*Callback=-1)
  Declare SetZoomfactor(Zoomfactor.f)
  Declare RefreshMask(Mask.l)
  Declare Add(*x,*y,*w,*h,font.l,color.l,value.s,myData=0,flags.l=0)
  Declare StartMe()
  Declare StopMe()
  Declare SetMinMax(minX,maxX,minY,maxY,minW,maxW,minH,maxH) 
  ;}-----------------------------------------------------------------------------------------------------------------------------------------------------
EndDeclareModule
Module CVTXT
  EnableExplicit
  ;======================================================================================================================================================
  ;-* PRIVATE CONSTANTE
  ; -----------------------------------------------------------------------------------------------------------------------------------------------------
  Enumeration 
    #UL
    #UM
    #UR
    #ML
    #MR
    #DL
    #DM
    #DR
    #Move
  EndEnumeration
  
  ;}-----------------------------------------------------------------------------------------------------------------------------------------------------
  ;======================================================================================================================================================
  ;-* PRIVATE STRUCTURES
  ; -----------------------------------------------------------------------------------------------------------------------------------------------------
  Structure sHANDLE
    x.l
    y.l
    Type.l
  EndStructure
  Structure sCVTXT
    *x
    *y
    *w
    *h
    minX.l
    maxX.l
    minY.l
    maxY.l
    minW.l
    maxW.l
    minH.l
    maxH.l
    color.l
    font.l
    value.s
    selected.b
    flags.l
    myData.l
    List myHandle.sHANDLE()
  EndStructure
  ;}-----------------------------------------------------------------------------------------------------------------------------------------------------
  ;======================================================================================================================================================
  ;-* PRIVATE VARIABLES
  ; -----------------------------------------------------------------------------------------------------------------------------------------------------
  Global gCanvas,gZoomFactor.f,gMask,gMouseX,gMouseY,gClicOn.b=#False,*IdHover=-1,*IdHandle=-1
  Global gOldX,gOldY,mode=-1,NoSave.b=#False,*gCallBack
  Global NewList myCVTXT.sCVTXT()
  ;}-----------------------------------------------------------------------------------------------------------------------------------------------------
  ;======================================================================================================================================================
  ;-* PRIVATE PROTOTYPE
  ; -----------------------------------------------------------------------------------------------------------------------------------------------------
  Declare IsAvailable()
  ;}-----------------------------------------------------------------------------------------------------------------------------------------------------
  ;======================================================================================================================================================
  ;-* PRIVATE FUNCTIONS
  ; -----------------------------------------------------------------------------------------------------------------------------------------------------
  Procedure Draw()
    Protected x,y,w,h,xt,yt,text.s,DepX,DepY,xx,yy,hh,ww
    StartVectorDrawing(CanvasVectorOutput(gCanvas,#PB_Unit_Millimeter))
    ScaleCoordinates(gZoomFactor,gZoomFactor,#PB_Coordinate_User)
    VectorSourceColor($FFFFFFFF)
    FillVectorOutput()
    If IsImage(gMask)
      DrawVectorImage(ImageID(gMask))
    EndIf
    With myCVTXT()
      ForEach myCVTXT()
        x=PeekL(\x)
        y=PeekL(\y)
        w=PeekL(\w)
        h=PeekL(\h)
        ; Dessin du texte
        VectorSourceColor(\color)
        VectorFont(FontID(\font))
        ; concatène le texte si nécessaire
        text=\value
        While VectorTextWidth(text)>w
          If Len(text)>3
            text=Left(text,Len(text)-4)
            text+"..."
          Else
            text=""
            Break
          EndIf
        Wend
        ; Par défaut le texte est aligné à gauche horizontalement
        xt=x
        ; Par défaut le texte est aligné au centre verticalement
        yt=y+((h/2)-(VectorTextHeight("W")/2))
        ; si le texte est centré horizontalement
        If \flags & #HAlignToCenter
          xt=x+((w/2)-(VectorTextWidth(text)/2))
        EndIf
        ; si le texte est aligné à droite horizontalement
        If \flags & #HAlignToRight
          xt=x+(w-VectorTextWidth(text))
        EndIf
        ; si le texte est en haut verticalement
        If \flags & #VAlignToTop
          yt=y
        EndIf
        ; si le texte est en bas verticalement
        If \flags & #VAlignToBottom
          yt=y+(h-VectorTextHeight("W"))
        EndIf
        MovePathCursor(xt,yt)
        DrawVectorText(text)
        ; Si le texte est sélectionné on dessine le cadre
        If \selected
          VectorSourceColor($FF808080)
          If mode>-1
            DepX=gMouseX-gOldX
            DepY=gMouseY-gOldY
            xx=x
            yy=y
            ww=w
            hh=h
            Select mode
              Case #Move
                xx=x+DepX
                yy=y+DepY
              Case #DR
                ww=w+DepX
                hh=h+DepY
              Case #MR
                ww=w+DepX
              Case #ML
                DepX=gMouseX-gOldX
                xx=x+DepX
                ww=w-DepX
              Case #DM
                hh=h+DepY
              Case #UR
                yy=y+DepY
                hh=h-DepY
                ww=w+DepX
              Case #DL
                xx=x+DepX
                ww=w-DepX
                hh=h+DepY
              Case #UM
                yy=y+DepY
                hh=h-DepY
              Case #UL
                xx=x+DepX
                yy=y+DepY
                ww=w-DepX
                hh=h-DepY
            EndSelect
            AddPathBox(xx,yy,ww,hh)
            DashPath(0.4,0.6) 
          Else
            AddPathBox(x,y,w,h)
            DashPath(0.4,0.6)
            ForEach \myHandle()
              AddPathBox(\myHandle()\x,\myHandle()\y,0.8,0.8)
            Next
            FillPath()
          EndIf
        EndIf
      Next
    EndWith
    StopVectorDrawing()
  EndProcedure
  Procedure HoverHandle()
    *IdHandle=-1
    With myCVTXT()\myHandle()
      ForEach myCVTXT()\myHandle()
        If (gMouseX>=\x And gMouseX<=(\x+2)) And (gMouseY>=\Y And gMouseY<=(\y+2))
          Select \Type
            Case #UL,#DR
              SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
            Case #UR,#Dl
              SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
            Case #ML,#MR
              SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
            Case #UM,#DM
              SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
          EndSelect
          *IdHandle=@myCVTXT()\myHandle()
          ProcedureReturn #True
        EndIf
      Next
      ProcedureReturn #False
    EndWith
  EndProcedure
  Procedure IsHover()
    Protected x,y,w,h
    *IdHover=-1
    With myCVTXT()
      ForEach myCVTXT()
        If HoverHandle()
          *IdHover=@myCVTXT()
          ProcedureReturn #True
        EndIf
        x=PeekL(\x)
        y=PeekL(\y)
        w=PeekL(\w)
        h=PeekL(\h)
        If (gMouseX>=x And gMouseX<=(x+w)) And (gMouseY>=Y And gMouseY<=(y+h))
          *IdHover=@myCVTXT()
          If Not \selected
            SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_Hand)
          Else
            SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_Arrows)
          EndIf
          ProcedureReturn #True
        EndIf
      Next
      ProcedureReturn #False
    EndWith
  EndProcedure
  Procedure MakeHandle()
    Protected x,y,w,h
    With myCVTXT()\myHandle()
      x=PeekL(myCVTXT()\x)
      y=PeekL(myCVTXT()\y)
      w=PeekL(myCVTXT()\w)
      h=PeekL(myCVTXT()\h)
      ; UL
      AddElement(myCVTXT()\myHandle())
      \Type=#UL
      \x=x
      \y=y
      ; UM
      AddElement(myCVTXT()\myHandle())
      \Type=#UM
      \x=(x+(w/2))
      \y=y
      ; UR
      AddElement(myCVTXT()\myHandle())
      \Type=#UR
      \x=(x+w)-0.8
      \y=y
      ; DL
      AddElement(myCVTXT()\myHandle())
      \Type=#DL
      \x=x
      \y=(y+h)-0.8
      ; DM
      AddElement(myCVTXT()\myHandle())
      \Type=#DM
      \x=(x+(w/2))
      \y=(y+h)-0.8
      ; DR
      AddElement(myCVTXT()\myHandle())
      \Type=#DR
      \x=(x+w)-0.8
      \y=(y+h)-0.8
      ; ML
      AddElement(myCVTXT()\myHandle())
      \Type=#ML
      \x=x
      \y=(y+(h/2))-0.4
      ; MR
      AddElement(myCVTXT()\myHandle())
      \Type=#MR
      \x=(x+w)-0.8
      \y=(y+(h/2))-0.4
    EndWith
  EndProcedure
  Procedure SaveNewPos()
    Protected DepX,DepY,x,y,w,h,xx,yy,ww,hh
    With myCVTXT()
      If NoSave
        mode=-1
        Draw()
      EndIf
      If mode>-1  And ChangeCurrentElement(myCVTXT(),*IdHover)
        x=PeekL(\x)
        y=PeekL(\y)
        w=PeekL(\w)
        h=PeekL(\h)
        xx=x
        yy=y
        ww=w
        hh=h
        DepX=gMouseX-gOldX
        DepY=gMouseY-gOldY
        Select mode
          Case #Move
            xx=x+DepX
            yy=y+DepY
          Case #DR
            ww=w+DepX
            hh=h+Depy
          Case #MR
            ww=w+DepX
          Case #ML
            xx=x+DepX
            ww=w-DepX
          Case #DM
            hh=h+DepY
          Case #UR
            hh=h-DepY
            ww=w+DepX
            yy=y+DepY
          Case #DL
            ww=w-DepX
            xx=x+DepX
            hh=h+DepY
          Case #UM
            yy=y+DepY
            hh=h-DepY
          Case #UL
            xx=x+DepX
            ww=w-DepX
            hh=h-DepY
        EndSelect
        PokeL(\x,xx)
        PokeL(\y,yy)
        PokeL(\w,ww)
        PokeL(\h,hh)
        mode=-1
        Draw()
        If *gCallBack<>-1
          CallFunctionFast(*gCallBack,\myData)
        EndIf
      EndIf
    EndWith
  EndProcedure
  Procedure ChangeCursor()
    Select mode
      Case -1
        SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
      Case #Move
        SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_Arrows)
      Case #Ul,#Dr
        SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftUpRightDown)
      Case #UM,#DM
        SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
      Case #ML,#MR
        SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftRight)
      Case #UR,#DL
        SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_LeftDownRightUp)
    EndSelect
  EndProcedure
  Procedure IsAvailable()
    Protected x,y,w,h,xx,yy,ww,hh,DepX,DepY
    With myCVTXT()
      x=PeekL(\x)
      y=PeekL(\y)
      w=PeekL(\w)
      h=PeekL(\h)
      DepX=gMouseX-gOldX
      DepY=gMouseY-gOldY
      xx=x
      yy=y
      ww=w
      hh=h
      If mode>-1
        Select mode
          Case #Move
            xx=x+DepX
            yy=y+DepY
          Case #DR
            ww=w+DepX
            hh=h+DepY
          Case #MR
            ww=w+DepX
          Case #ML
            DepX=gMouseX-gOldX
            xx=x+DepX
            ww=w-DepX
          Case #DM
            hh=h+DepY
          Case #UR
            yy=y+DepY
            hh=h-DepY
            ww=w+DepX
          Case #DL
            xx=x+DepX
            ww=w-DepX
            hh=h+DepY
          Case #UM
            yy=y+DepY
            hh=h-DepY
          Case #UL
            xx=x+DepX
            yy=y+DepY
            ww=w-DepX
            hh=h-DepY
        EndSelect
        If \minX<>#PB_Ignore
          If xx<\minX
            SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
            NoSave=#True
            ProcedureReturn #False
          EndIf
        EndIf
        If \maxX<>#PB_Ignore
          If xx+ww>\maxX
            SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
            NoSave=#True
            ProcedureReturn #False
          EndIf
        EndIf
        If \minY<>#PB_Ignore
          If yy<\minY
            SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
            NoSave=#True
            ProcedureReturn #False
          EndIf
        EndIf
        If \maxY<>#PB_Ignore
          If yy+hh>\maxY
            SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
            NoSave=#True
            ProcedureReturn #False
          EndIf
        EndIf
        If \minW<>#PB_Ignore
          If ww<\minW
            SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
            NoSave=#True
            ProcedureReturn #False
          EndIf
        EndIf
        If \maxW<>#PB_Ignore
          If ww>\maxW
            SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
            NoSave=#True
            ProcedureReturn #False
          EndIf
        EndIf
        If \minH<>#PB_Ignore
          If hh<\minH
            SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
            NoSave=#True
            ProcedureReturn #False
          EndIf
        EndIf
        If \maxH<>#PB_Ignore
          If hh>\maxH
            SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_Denied)
            NoSave=#True
            ProcedureReturn #False
          EndIf
        EndIf
      EndIf
    EndWith
    ChangeCursor()
    NoSave=#False
    ProcedureReturn #True
  EndProcedure
  Procedure myEvent()
    Select EventType()
      Case #PB_EventType_MouseMove
        ; Important ici on choisi l'unité en pixel
        StartVectorDrawing(CanvasVectorOutput(gCanvas,#PB_Unit_Millimeter))
        ; On applique le zoom
        ScaleCoordinates(gZoomFactor,gZoomFactor,#PB_Coordinate_User)
        ; Conversion de la position de la souris en Mm
        gMouseX=ConvertCoordinateX(GetGadgetAttribute(gCanvas,#PB_Canvas_MouseX),0,#PB_Coordinate_Device,#PB_Coordinate_User)
        gMouseY=ConvertCoordinateY(0,GetGadgetAttribute(gCanvas,#PB_Canvas_MouseY),#PB_Coordinate_Device,#PB_Coordinate_User)
        StopVectorDrawing()
        If Not gClicOn
          If IsHover()
            ProcedureReturn 
          EndIf
          SetGadgetAttribute(gCanvas,#PB_Canvas_Cursor,#PB_Cursor_Default)
        Else
          ; Déplacement
          If *IdHover<>-1 And *IdHandle=-1
            ChangeCurrentElement(myCVTXT(),*IdHover)
            mode=#Move
            If IsAvailable()
              Draw()
            EndIf
          EndIf
          If *IdHover<>-1 And *IdHandle<>-1
            ChangeCurrentElement(myCVTXT(),*IdHover)
            ChangeCurrentElement(myCVTXT()\myHandle(),*IdHandle)
            mode=myCVTXT()\myHandle()\Type
            If IsAvailable()
              Draw()
            EndIf
          EndIf
        EndIf
      Case #PB_EventType_LeftClick
        If Not gClicOn
          ForEach myCVTXT()
            myCVTXT()\selected=#False
            ClearList(myCVTXT()\myHandle())
          Next
          If *IdHover<>-1
            ChangeCurrentElement(myCVTXT(),*IdHover)
            myCVTXT()\selected=#True
            If *gCallBack<>-1
              CallFunctionFast(*gCallBack,myCVTXT()\myData)
            EndIf
            MakeHandle()
          EndIf
          Draw()
        EndIf
      Case #PB_EventType_LeftButtonDown
        If Not gClicOn
          gOldX=gMouseX
          gOldY=gMouseY
          gClicOn=#True
        EndIf
      Case #PB_EventType_LeftButtonUp
        SaveNewPos()
        gClicOn=#False
    EndSelect
  EndProcedure
  ;}-----------------------------------------------------------------------------------------------------------------------------------------------------
  ;======================================================================================================================================================
  ;-* PUBLIC FUNCTIONS
  ; -----------------------------------------------------------------------------------------------------------------------------------------------------
  Procedure RefreshMask(Mask.l)
    gMask=Mask
    Draw()
  EndProcedure
  Procedure Init(IdCanvas,ZoomFactor.f,Mask.l=-1,*Callback=-1)
    gCanvas=IdCanvas
    gZoomFactor=ZoomFactor
    *gCallBack=*Callback
    gMask=Mask
  EndProcedure
  Procedure SetZoomfactor(Zoomfactor.f)
    gZoomFactor=Zoomfactor
    Draw()
  EndProcedure
  Procedure Add(*x,*y,*w,*h,font.l,color.l,value.s,myData=0,flags.l=0)
    With myCVTXT()
      AddElement(myCVTXT())
      \x=*x
      \y=*y
      \w=*w
      \h=*h
      \font=font
      \color=color
      \value=value
      \flags=flags
      \minX=#PB_Ignore
      \maxX=#PB_Ignore
      \minY=#PB_Ignore
      \maxY=#PB_Ignore
      \minW=#PB_Ignore
      \maxW=#PB_Ignore
      \minH=#PB_Ignore
      \maxH=#PB_Ignore
      \myData=myData
    EndWith
  EndProcedure
  Procedure StartMe()
    BindGadgetEvent(gCanvas,@myEvent())
    Draw()
  EndProcedure
  Procedure StopMe()
    ForEach myCVTXT()
      myCVTXT()\selected=#False
    Next
    UnbindGadgetEvent(gCanvas,@myEvent())
    Draw()
  EndProcedure
  Procedure SetMinMax(minX,maxX,minY,maxY,minW,maxW,minH,maxH) 
    With myCVTXT()
      \minX=minX
      \maxX=maxX
      \minY=minY
      \maxY=maxY
      \minW=minW
      \maxW=maxW
      \minH=minH
      \maxH=maxH
    EndWith
  EndProcedure
  ;}-----------------------------------------------------------------------------------------------------------------------------------------------------
EndModule
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: Canvas-text

Message par microdevweb »

Code de l'exemple

Code : Tout sélectionner

XIncludeFile "CVTXT.pbi"
Runtime Enumeration 
  #MainForm
  #MainArea
  #MainCanvas
  #CbZoom
  #BtExit
EndEnumeration
Structure sITEM
  x.l
  y.l
  w.l
  h.l
  idFont.l
  value.s
EndStructure
Global ZoomFactor.f=0.5
Global NewList myItem.sITEM()
Procedure Exit()
  CloseWindow(#MainForm)
  End
EndProcedure
Procedure ResizeCanvas()
  Protected W,H,X,Y,RuleHW,RuleHH,RuleVW,RuleVH,cW,cH
  ; Calcul de la taille en pixel du canvas
  ; selon les dimention A4 210 x 297
  StartVectorDrawing(CanvasVectorOutput(#MainCanvas,#PB_Unit_Millimeter))
  ScaleCoordinates(ZoomFactor,ZoomFactor,#PB_Coordinate_User)
  cW=ConvertCoordinateX(210,0,#PB_Coordinate_User,#PB_Coordinate_Device)
  cH=ConvertCoordinateY(0,297,#PB_Coordinate_User,#PB_Coordinate_Device)
  VectorSourceColor($FF0000FF)
  FillVectorOutput()
  StopVectorDrawing()
  ; Centre horizontalement le canvas  si plus petit que la zone de dessin   
  If cw<GadgetWidth(#MainArea)-50
    SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerWidth,GadgetWidth(#MainArea)-50)
    x=(GadgetWidth(#MainArea)/2)-(cw/2)
  Else
    SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerWidth,cw+50)
    x=0
  EndIf
  ; Centre verticalement le canvas et la règle si plus petit que la zone de dessin
  If ch<GadgetHeight(#MainArea)-50
    SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerHeight,GadgetHeight(#MainArea)-50)
    Y=(GadgetHeight(#MainArea)/2)-(ch/2)
  Else
    SetGadgetAttribute(#MainArea,#PB_ScrollArea_InnerHeight,ch+50)
    Y=0
  EndIf
  ; Repositionne et redimentionne le canvas de dessin
  ResizeGadget(#MainCanvas,X+RuleVW,Y+RuleHH,cW,cH)
  StartVectorDrawing(CanvasVectorOutput(#MainCanvas,#PB_Unit_Millimeter))
  VectorSourceColor($FFFFFFFF)
  FillVectorOutput()
  StopVectorDrawing()
EndProcedure
Procedure MyWindowIsResize()
  ResizeGadget(#MainArea,0,0,WindowWidth(#MainForm),WindowHeight(#MainForm))
  ResizeCanvas()
  CVTXT::SetZoomfactor(ZoomFactor)
EndProcedure

Procedure ZoomEvent()
  Protected z=GetGadgetItemData(#CbZoom,GetGadgetState(#CbZoom))
  ZoomFactor=z/100
  ResizeCanvas()
  CVTXT::SetZoomfactor(ZoomFactor)
EndProcedure
Procedure AddCVTXT()
  With myItem()
    AddElement(myItem())
    \x=2
    \y=2
    \w=50
    \h=8
    \idFont=LoadFont(#PB_Any,"Arial",12,#PB_Font_HighQuality)
    \value="Texte 1"
    CVTXT::Add(@\x,@\y,@\w,@\h,\idFont,$FF000000,\value,@myItem())
    AddElement(myItem())
    \x=2
    \y=10
    \w=50
    \h=8
    \idFont=LoadFont(#PB_Any,"Arial",12,#PB_Font_HighQuality)
    \value="Texte 2"
    CVTXT::Add(@\x,@\y,@\w,@\h,\idFont,$FF000000,\value,@myItem(),CVTXT::#HAlignToCenter)
    CVTXT::SetMinMax(0,210,0,297,2,80,8,20)
  EndWith
EndProcedure
Procedure Callback(myData)
  ChangeCurrentElement(myItem(),myData)
  With myItem()
    Debug \value+Chr(10)+
          " X : "+Str(\x)+" Y : "+Str(\y)+Chr(10)+
          " W : "+Str(\w)+"  H: "+Str(\h)
  EndWith
EndProcedure
Procedure Open()
  Protected xml.s,z=25,i
  Protected font=LoadFont(#PB_Any,"Arial",10,#PB_Font_HighQuality)
  xml="<window name='mainForm' id='#MainForm' "+
      " width='800'"+
      " height='600'"+
      " text='Teste'"+
      " flags='#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget'>"+
      "<vbox expand='item:2'>"+
      "   <hbox expand='no'>"+
      "     <frame text='Facteur de zoom' width='260'>"+
      "         <combobox id='#CbZoom'/>"+
      "     </frame>"+
      "     <button text='Quitter' id='#BtExit' width='90'/>"+
      "   </hbox>"+
      "   <scrollarea id='#MainArea'>"+
      "   </scrollarea>"+
      "</vhbox>"+
      "</window>"
  CatchXML(0,@xml,StringByteLength(xml),0,#PB_UTF8)
  CreateDialog(0)
  SetGadgetFont(#PB_Default,FontID(font))
  OpenXMLDialog(0,0,"mainForm")
  OpenGadgetList(#MainArea)
  CanvasGadget(#MainCanvas,0,0,100,100)
  CloseGadgetList()
  ; Ajout des différent facteurs de zoom
  For i=0 To 11
    AddGadgetItem(#CbZoom,-1,Str(z)+" %")
    SetGadgetItemData(#CbZoom,i,z)
    z+25
  Next
  SetGadgetState(#CbZoom,3)
  BindEvent(#PB_Event_CloseWindow,@Exit(),#MainForm)
  BindEvent(#PB_Event_SizeWindow,@MyWindowIsResize(),#MainForm)
  BindGadgetEvent(#BtExit,@Exit())
  BindGadgetEvent(#CbZoom,@ZoomEvent())
  ResizeCanvas() 
  CVTXT::Init(#MainCanvas,ZoomFactor,-1,@Callback())
  AddCVTXT()
  CVTXT::StartMe()
EndProcedure

Open()

Repeat
  WaitWindowEvent()
ForEver


Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Canvas-text

Message par Micoute »

Merci beaucoup pour le partage.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Marc56
Messages : 2146
Inscription : sam. 08/févr./2014 15:19

Re: Canvas-text

Message par Marc56 »

Je n'en n'ai pas l'usage pour l'instant, mais je suis admiratif (même si je ne le dis pas à chaque fois) par toutes tes productions.

8)
Tonio
Messages : 95
Inscription : ven. 07/avr./2017 14:49
Localisation : Sud Est

Re: Canvas-text

Message par Tonio »

Merci beaucoup pour ce partage
Avatar de l’utilisateur
Zorro
Messages : 2185
Inscription : mar. 31/mai/2016 9:06

Re: Canvas-text

Message par Zorro »

oui, la grande classe !
rien a dire :)

ps: je ne comprends meme pas comment tu geres les redimensionnement de ton text :lol:
mais c'est pas grave , du moment que ça marche :)
Image
Image
Site: http://michel.dobro.free.fr/
Devise :"dis moi ce dont tu as besoin, je t'expliquerai comment t'en passer"
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Canvas-text

Message par Kwai chang caine »

Le déplacement marche nickel, le texte ne suivant le cadre que lorsque le déplacement est terminé
Le cadre se redimensionne très bien, mais le texte reste de la même taille
Mais je suppose que tout ça est l'effet désiré
Merci du partage 8)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: Canvas-text

Message par microdevweb »

@Kwai chang caine, si en effet tu vois le cursor (denied) alors le déplacement, redimensionnement est hors limite (dans l'exemple je n'ai renseigné des limites que pour Texte 2) et ne sera pas modifié. Je penses d'ailleurs modifié cela pour que le texte soit déplacé malgré tout mais au (maximum ou minimum) autorisé.

A noter que ce module fait partie d'un projet plus ambitieux, un éditeur d'état imprimé.
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Répondre