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