String Gadget pour canvas
Publié : jeu. 11/déc./2014 14:08
Dans un canvas gadget on ne peut pas ajouter de gadget, cela peu ce révélé dans certain cas embêtant, voici le premier jet d'un petit module (j'ai encore quelques petites choses à régler surtout si le texte est plus grand que la boîte d'édition) pour créer un string gadget dans un canvas
Nb: Le clignotement du curseur, n'est pas obtenu par l'appel d'api mais réaliser en code
http://www.mediafire.com/download/1h4rq ... ox_1_3.zip
Contenu de l'archive
--> EditBox.pbi -->870 lgn
--> CaractereMasking.pbi -->209 lgn
--> TeseMask.pb -->18 lgn
Les fonctions disponibles
Code Exemple
Code du module (Vers 1.3 04/01/2015)
Vers 1.2 du 2014-12-27
--> Correction de OverEditBox (pour savoir si on est sur l'EditBox)
--> Ajoute de la sélection de tous la caractères avec double click
--> Ajout annulation par Ctrl Z
Vers 1.3 du 2015-01-02
--> Ajout du masque d'affichage numérique (requiere le module CaractereMasking.pbi)
--> Ajout du masque de saisie numérique
Voila n'hésitez pas à donner votre avis
Nb: Le clignotement du curseur, n'est pas obtenu par l'appel d'api mais réaliser en code
http://www.mediafire.com/download/1h4rq ... ox_1_3.zipContenu de l'archive
--> EditBox.pbi -->870 lgn
--> CaractereMasking.pbi -->209 lgn
--> TeseMask.pb -->18 lgn
Les fonctions disponibles
Code : Tout sélectionner
;Create --> Création de l'EditBox
;--- Id --> l'identifiant de l'EditBox, si #Pb_any comme les gadget PB
;--- IdCanvas --> l'identifiant du canvas gadget (doit être créer précédement)
;--- X --> position sur X du CANVAS
;--- Y --> position sur Y du CANVAS
;--- W --> Largeur de l'EditBox
;--- H --> Hauteur de l'EditBox
;--- Value$ --> La valeur initiale de l'EditBox
;--- *ProcedureCallBack la procédure qui sera appelée automatiquement à chaque modification
;SetColor --> Défini des couleurs personalisées
;--- Id --> l'identifiant de l'EditBox
;--- ColorBack --> La couleur de font
;--- ColorFront --> La couleur des caractères
;SetSelectColor --> Défini une couleur personalisé quant des caractères sont sélectionné
;--- Id --> l'identifiant de l'EditBox, si #Pb_any comme les gadget PB
;--- ColorBack --> la couleur du bandeau de sélection
;--- ColorFront --> la couleur des caractères sélectionnés
;SetFont --> Change la police de caractère
;--- Id --> l'identifiant de l'EditBox
;--- Font --> la police de caractère créée précédement avec LoadFont(....)
;SetSelectFont --> Change la police de caractère des caractère sélectionné
;--- Id --> l'identifiant de l'EditBox
;--- Font --> la police de caractère créée précédement avec LoadFont(....)
; Resultat$=GetValue(Id)
;--- Id --> l'identifiant de l'EditBox
;--- Resultat$ --> Le texte réel dans l'EditBox (le résultat affiché peut'être différent suivant les masques d'affichage)
;Event --> gère les évement de l'edit box doit être placer dans la boucle événementielle ATTENTION ;utiliser WindowEvent() et WaitWindowEvent()
;--- Id --> l'identifiant de l'EditBox
;--- Event --> Evènement retourner par WindowEvent()
; SetPosition --> Change la position de l'edit box
;--- Id --> l'identifiant de l'EditBox
;--- X --> position sur X du CANVAS -->#PB_Ignore si pas modifié
;--- Y --> position sur Y du CANVAS -->#PB_Ignore si pas modifié
;--- W --> Largeur de l'EditBox -->#PB_Ignore si pas modifié
;--- H --> Hauteur de l'EditBox -->#PB_Ignore si pas modifié
;Draw --> Dessine l'EditBox --> à utiliser après Create
;--- Id --> l'identifiant de l'EditBox
;--- InitDraw --> #True si vous vouler que le StartDrawing soit appelé automatiquement sinon #False
;GiveFocus --> Donne le focus à l'edit box (vous devez donner manuelement le focus au canvas)
;--- Id --> l'identifiant de l'EditBox
;--- InitDraw --> #True si vous vouler que le StartDrawing soit appelé automatiquement sinon #False
;LostFocus --> Enlève le focus
;--- Id --> l'identifiant de l'EditBox
;SetValue-->Change manuelemnt la valeur réel
;--- Id --> l'identifiant de l'EditBox
;--- Value$ --> La nouvelle valeur
; OverEditBox --> Pour savoir si la souris survole l'editBox
;--- Id --> l'identifiant de l'EditBox
;Free --> Likbère la mémoire et supprime l'editbox
;--- Id --> l'identifiant de l'EditBox
;SetNumeriqueMask --> Crée un marque de type numérique
;Id --> Identifiant de l'éditor box
;DecadeNumber --> Le nombre de dizaines ou #Infinity (-1) si pas prix en compte
;DecimalNumber --> Le nombre de décimales ou #Infinity (-1) si pas prix en compte
;ThousandsSeparator --> Le séparateur des milliers (en code asci) Exemple 46 --> .
;DecimalSeparator --> Le séparateur des décimales (en code asci) Exemple 44 --> ,
;ExtendString$ --> Si vous désirez une extention en début ou fin de chaine Exemple: --> € --> % --> $ etc...
;PositionExtend --> Ou vous voulez vous l'extention --> #FirstPosition en début de chaine -->#EndPosition en fin de chaine
;NegativeOn --> #True Autorise un chiffre négatif --> #False N'autorise pas un chiffre négatif
Code : Tout sélectionner
;-* Teste
XIncludeFile "EditBox.pbi"
EnableExplicit
#MainForm=0
#MainCanvas=0
#MainEditBox=0
Global W=800,H=600,Title$="Teste Edit Box with numerique masking"
Global Flag=#PB_Window_SystemMenu|#PB_Window_ScreenCentered
OpenWindow(#MainForm,0,0,W,H,Title$,Flag)
CanvasGadget(#MainCanvas,0,0,W,H,#PB_Canvas_Keyboard)
SetActiveGadget(#MainCanvas)
EditBox::Create(#MainEditBox,#MainCanvas,50,50,120,30,"")
EditBox::SetNumeriqueMask(#MainEditBox,6,2,46,44," "+Chr(128),EditBox::#EndPosition,#True)
EditBox::GiveFocus(#MainEditBox,#True)
Global Event
Repeat
Event=WindowEvent()
EditBox::Event(#MainEditBox,Event)
Until Event=#PB_Event_CloseWindow
;} FIN Teste
Vers 1.2 du 2014-12-27
--> Correction de OverEditBox (pour savoir si on est sur l'EditBox)
--> Ajoute de la sélection de tous la caractères avec double click
--> Ajout annulation par Ctrl Z
Vers 1.3 du 2015-01-02
--> Ajout du masque d'affichage numérique (requiere le module CaractereMasking.pbi)
--> Ajout du masque de saisie numérique
Code : Tout sélectionner
;////////////////////////////////////////////////////////////////////////////////////////////////////////////
; Nom: EditBox
; Vers 1.0 du 2014-12-12
; Vers 1.1 du 2014-12-26
; Vers 1.2 du 2014-12-27
; --> Correction de OverEditBox
; --> Ajoute de la selection de tous la caractères avec double click
; --> Ajout annulation par Ctrl Z
; Vers 1.3 du 2015-01-02
;--> Ajout du masque d'affichage numérique (requiere le module CaractereMasking.pbi)
;--> Ajout du masque de saisie numérique
; Description:
; Gestion d'un champ éditor par programmation
; © AllDev / MicrodevWeb / Bielen Pierre
;////////////////////////////////////////////////////////////////////////////////////////////////////////////
XIncludeFile "CaractereMasking.pbi"
DeclareModule EditBox
#Infinity=-1
Enumeration
#FirstPosition
#EndPosition
EndEnumeration
;Create --> Création de l'EditBox
;--- Id --> l'identifiant de l'EditBox, si #Pb_any comme les gadget PB
;--- IdCanvas --> l'identifiant du canvas gadget (doit être créer précédement)
;--- X --> position sur X du CANVAS
;--- Y --> position sur Y du CANVAS
;--- W --> Largeur de l'EditBox
;--- H --> Hauteur de l'EditBox
;--- Value$ --> La valeur initiale de l'EditBox
;--- *ProcedureCallBack la procédure qui sera appelée automatiquement à chaque modification Exemple @TraiteMoi(LeTexteRecu$)
;----- si vous ne voulez pas utiliser de procédure renseignez *ProcedureCallBack=-1
Declare Create(Id,IdCanvas,X,Y,W,H,Value$,*ProcedureCallBack=-1)
;SetColor --> Défini des couleurs personalisées
;--- Id --> l'identifiant de l'EditBox
;--- ColorBack --> La couleur de font
;--- ColorFront --> La couleur des caractères
Declare SetColor(Id,ColorBack,ColorFront)
;SetSelectColor --> Défini une couleur personalisé quant des caractères sont sélectionné
;--- Id --> l'identifiant de l'EditBox, si #Pb_any comme les gadget PB
;--- ColorBack --> la couleur du bandeau de sélection
;--- ColorFront --> la couleur des caractères sélectionnés
Declare SetSelectColor(Id,ColorBack,ColorFront)
;SetFont --> Change la police de caractère
;--- Id --> l'identifiant de l'EditBox
;--- Font --> la police de caractère créée précédement avec LoadFont(....)
Declare SetFont(Id,Font)
;SetSelectFont --> Change la police de caractère des caractère sélectionné
;--- Id --> l'identifiant de l'EditBox
;--- Font --> la police de caractère créée précédement avec LoadFont(....)
Declare SetSelectFont(Id,Font)
; Resultat$=GetValue(Id)
;--- Id --> l'identifiant de l'EditBox
;--- Resultat$ --> Le texte réel dans l'EditBox (le résultat affiché peut'être différent suivant les masques d'affichage)
Declare$ GetValue(Id)
;Event --> gère les évement de l'edit box doit être placer dans la boucle événementielle ATTENTION utiliser WindowEvent() et WaitWindowEvent()
;--- Id --> l'identifiant de l'EditBox
;--- Event --> Evènement retourner par WindowEvent()
Declare Event(Id,Event)
; SetPosition --> Change la position de l'edit box
;--- Id --> l'identifiant de l'EditBox
;--- X --> position sur X du CANVAS -->#PB_Ignore si pas modifié
;--- Y --> position sur Y du CANVAS -->#PB_Ignore si pas modifié
;--- W --> Largeur de l'EditBox -->#PB_Ignore si pas modifié
;--- H --> Hauteur de l'EditBox -->#PB_Ignore si pas modifié
Declare SetPosition(Id,X,Y,W,H)
;Draw --> Dessine l'EditBox --> à utiliser après Create
;--- Id --> l'identifiant de l'EditBox
;--- InitDraw --> #True si vous vouler que le StartDrawing soit appelé automatiquement sinon #False
Declare Draw(Id,InitDraw.b=#True)
;GiveFocus --> Donne le focus à l'edit box (vous devez donner manuelement le focus au canvas)
;--- Id --> l'identifiant de l'EditBox
;--- InitDraw --> #True si vous vouler que le StartDrawing soit appelé automatiquement sinon #False
Declare GiveFocus(Id,InitDraw.b=#False)
;LostFocus --> Enlève le focus
;--- Id --> l'identifiant de l'EditBox
Declare LostFocus(Id)
;SetValue-->Change manuelemnt la valeur réel
;--- Id --> l'identifiant de l'EditBox
;--- Value$ --> La nouvelle valeur
Declare SetValue(Id,Value$)
; OverEditBox --> Pour savoir si la souris survole l'editBox
;--- Id --> l'identifiant de l'EditBox
Declare OverEditBox(Id)
;Free --> Likbère la mémoire et supprime l'editbox
;--- Id --> l'identifiant de l'EditBox
Declare Free(Id)
;SetNumeriqueMask --> Crée un marque de type numérique
;Id --> Identifiant de l'éditor box
;DecadeNumber --> Le nombre de dizaines ou #Infinity (-1) si pas prix en compte
;DecimalNumber --> Le nombre de décimales ou #Infinity (-1) si pas prix en compte
;ThousandsSeparator --> Le séparateur des milliers (en code asci) Exemple 46 --> .
;DecimalSeparator --> Le séparateur des décimales (en code asci) Exemple 44 --> ,
;ExtendString$ --> Si vous désirez une extention en début ou fin de chaine Exemple: --> € --> % --> $ etc...
;PositionExtend --> Ou vous voulez vous l'extention --> #FirstPosition en début de chaine -->#EndPosition en fin de chaine
;NegativeOn --> #True Autorise un chiffre négatif --> #False N'autorise pas un chiffre négatif
Declare SetNumeriqueMask(Id,DecadeNumber.i=#Infinity,DecimalNumber=#Infinity,ThousandsSeparator=46,DecimalSeparator=44,ExtendString$="",PositionExtend=#EndPosition,NegativeOn.b=#True)
EndDeclareModule
Module EditBox
;-* Initialisation
EnableExplicit
;} FIN Initialisation
;-* Prototype
Prototype.s ProtoEntChangeText(Txt$)
;} FIN Prototype
;-* Constantes
#None=-1
Enumeration Type
#NumeriqueType
#AlphaOnlyType
#AlphaNumeriqueType
#UserType
EndEnumeration
;} FIN Constantes
;-* Structures
;---------- Pos
Structure Pos
X.i
Y.i
W.i
H.i
EndStructure
;---------- EditBox
Structure EditBox
myCanvas.i
myPos.Pos
myBackColor.i
myFrontColor.i
myLineColor.i
mySelectBackColor.i
mySelectFrontColor.i
mySelectFond.i
myFont.i
Value$
DiplayValue$ ; 1.3
FirstCaractere.i
LastCaractere.i
CaractereSelected.i
*myProcedureCallBack
myMargin.i
myMask.i
myCursorPos.Pos
myThread.i
CurrentTime.i
TimeElapsed.i
CaracteTronquer.i
IhaveFocus.b
OverEditBox.b
myIDMask.i
MaskType.i
DecadeNumber.i
DecimaleNumber.i
NegativeOn.b
List annulation$()
EndStructure
;} FIN Structures
;-* Variables
Global NewMap myEditBox.EditBox()
Global gMouseX,gMouseY,Mask
Global CaractereOver=0
Global LineOn.b,BoxOn.b
Global gClicOn.b=#False
Global gCursorOn.b=#True
Global gCaratereSelected.b=#False
Global gOldMouseX,RightDirection.b=#True
Global gCaractereAllSekected.b=#False
;} FIN Variables
;-* Locales déclaration
Declare DrawBox()
Declare DrawValue()
;} FIN Locales déclaration
;-* Procédures
Procedure SetNumeriqueMask(Id,DecadeNumber.i=#Infinity,DecimalNumber=#Infinity,ThousandsSeparator=46,DecimalSeparator=44,ExtendString$="",PositionExtend=#EndPosition,NegativeOn.b=#True)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error SetNumeriqueMask","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
With myEditBox()
\DecadeNumber=DecadeNumber
\DecimaleNumber=DecimalNumber
\MaskType=#NumeriqueType
\NegativeOn=NegativeOn
\myIDMask=CaractereMasking::SetNumeriqueType(#PB_Any,DecadeNumber,DecimalNumber,ThousandsSeparator,DecimalSeparator,ExtendString$,PositionExtend,NegativeOn)
EndWith
EndProcedure
Procedure UndoValue()
If ListSize(myEditBox()\annulation$())=0
ProcedureReturn
EndIf
LastElement(myEditBox()\annulation$())
With myEditBox()
\Value$=\annulation$()
\FirstCaractere=Len(\Value$)
Draw(Val(MapKey(myEditBox())),#True)
DeleteElement(myEditBox()\annulation$())
EndWith
EndProcedure
Procedure SellectAllCaractere()
gCaractereAllSekected=#True
gCaratereSelected=#True
RightDirection=#True
With myEditBox()
\FirstCaractere=0
\LastCaractere=Len(\Value$)
Draw(Val(MapKey(myEditBox())),#True)
EndWith
EndProcedure
;---------- GiveFocus(Id)
Procedure GiveFocus(Id,InitDraw.b=#False)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error SetColor","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
With myEditBox()
\IhaveFocus=#True
\OverEditBox=#True
;Réafiche le résultat
If InitDraw :StartDrawing(CanvasOutput(\myCanvas)):EndIf
Draw(Val(MapKey(myEditBox())))
If InitDraw :StopDrawing():EndIf
EndWith
EndProcedure
;----------- LostFocus(Id)
Procedure LostFocus(Id)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error SetColor","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
With myEditBox()
\IhaveFocus=#False
;Si un masque d'affichage change la displayvalue
If \MaskType<>-1
Select \MaskType
Case #NumeriqueType
\DiplayValue$=CaractereMasking::GiveResult(\myIDMask,\Value$)
EndSelect
Else ;si pas de masque d'affichage
\DiplayValue$=\Value$
EndIf
;Réafiche le résultat
StartDrawing(CanvasOutput(\myCanvas))
Draw(Val(MapKey(myEditBox())))
StopDrawing()
EndWith
EndProcedure
;------------ TestingFocus()
Procedure TestingFocus()
With myEditBox()
If gMouseX>=\myPos\X And gMouseX<=(\myPos\X+\myPos\W)
If gMouseY>=\myPos\Y And gMouseY<=(\myPos\Y+\myPos\H)
GiveFocus(Val(MapKey(myEditBox())))
ProcedureReturn
EndIf
EndIf
LostFocus(Val(MapKey(myEditBox())))
EndWith
EndProcedure
;----------- DrawCursor(Value)
Procedure DrawCursor(Value)
If gCursorOn=#False:ProcedureReturn :EndIf
With myEditBox()
If \IhaveFocus=#False:ProcedureReturn :EndIf
If \TimeElapsed>400 And LineOn=#False
StartDrawing(CanvasOutput(\myCanvas))
DrawingMode(#PB_2DDrawing_Default)
Line(\myCursorPos\X,\myCursorPos\Y,\myCursorPos\W,\myCursorPos\H,$000000)
LineOn=#True
BoxOn=#False
StopDrawing()
EndIf
If \TimeElapsed>800 And BoxOn=#False
StartDrawing(CanvasOutput(\myCanvas))
DrawingMode(#PB_2DDrawing_Default)
If IsImage(\myMask)<>0
DrawImage(ImageID(\myMask),\myPos\X,\myPos\Y)
EndIf
\CurrentTime=ElapsedMilliseconds()
\TimeElapsed=0
LineOn=#False
BoxOn=#True
StopDrawing()
EndIf
\TimeElapsed=ElapsedMilliseconds()-\CurrentTime
EndWith
EndProcedure
;----------- Create(Id,IdCanvas,X,Y,W,H,Value$,*ProcedureCallBack=-1)
Procedure Create(Id,IdCanvas,X,Y,W,H,Value$,*ProcedureCallBack=-1)
Protected Index
;Si #pb_any crée un id avec le nombre d'EditBox
If #PB_Any
While FindMapElement(myEditBox(),Str(Index))<>0
Index+1
Wend
AddMapElement(myEditBox(),Str(Index))
Else
;Recherche l'id et l'ajoute si ne le treouve pas
If FindMapElement(myEditBox(),Str(Id))=0
AddMapElement(myEditBox(),Str(MapSize(myEditBox())))
EndIf
EndIf
;Remplit les éléments
With myEditBox()
\myCanvas=IdCanvas
\myPos\X=X
\myPos\Y=Y
\myPos\W=W
\myPos\H=H
\myFont=LoadFont(#PB_Any,"Arial",12,#PB_Font_HighQuality)
\myBackColor=$FFFFFF
\myFrontColor=$000000
\mySelectBackColor=$CD0000
\mySelectFrontColor=$FFFFFF
\mySelectFond=LoadFont(#PB_Any,"Arial",12,#PB_Font_HighQuality)
\myProcedureCallBack=*ProcedureCallBack
\myMargin=10
\Value$=Value$
\FirstCaractere=Len(Value$)
\LastCaractere=-1
\CurrentTime=ElapsedMilliseconds()
\IhaveFocus=#False
\DecadeNumber=#Infinity
\DecimaleNumber=#Infinity
\MaskType=#None
EndWith
ProcedureReturn Val(MapKey(myEditBox()))
EndProcedure
;----------- SetColor(Id,ColorBack,ColorFront)
Procedure SetColor(Id,ColorBack,ColorFront)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error SetColor","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
With myEditBox()
\myFrontColor=ColorFront
\myBackColor=ColorBack
EndWith
ProcedureReturn #True
EndProcedure
;----------- SetSelectColor(Id,ColorBack,ColorFront)
Procedure SetSelectColor(Id,ColorBack,ColorFront)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error SetSelectColor","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
With myEditBox()
\mySelectFrontColor=ColorFront
\mySelectBackColor=ColorBack
EndWith
ProcedureReturn #True
EndProcedure
;----------- SetFont(Id,Font)
Procedure SetFont(Id,Font)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error SetFont","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
With myEditBox()
\myFont=Font
EndWith
ProcedureReturn #True
EndProcedure
;----------- SetSelectFont(Id,Font)
Procedure SetSelectFont(Id,Font)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error SetSelectFont","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
With myEditBox()
\mySelectFond=Font
EndWith
ProcedureReturn #True
EndProcedure
;----------- GetValue(Id)
Procedure$ GetValue(Id)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error GetValue","This id "+Str(Id)+" not exist...")
ProcedureReturn ""
EndIf
ProcedureReturn myEditBox()\Value$
EndProcedure
;----------- SetValue(Id,Value$)
Procedure SetValue(Id,Value$)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error SetValue","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
myEditBox()\Value$=Value$
ProcedureReturn #True
EndProcedure
;----------- SetPosition(Id,X,Y,W,H)
Procedure SetPosition(Id,X,Y,W,H)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error SetPosition","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
With myEditBox()\myPos
If X<>#PB_Ignore
\X=X
EndIf
If Y<>#PB_Ignore
\Y=Y
EndIf
If W<>#PB_Ignore
\W=W
EndIf
If H<>#PB_Ignore
\H=H
EndIf
EndWith
EndProcedure
;----------- SetMargin(Id,Margin)
Procedure SetMargin(Id,Margin)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error SetMargin","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
myEditBox()\myMargin=Margin
ProcedureReturn #True
EndProcedure
;----------- DrawBox()
Procedure DrawBox()
Protected X,Y,W,H,ColorB,ColorF
With myEditBox()
X=\myPos\X
Y=\myPos\Y
W=\myPos\W
H=\myPos\H
ColorB=\myBackColor
ColorF=\myFrontColor
EndWith
DrawingMode(#PB_2DDrawing_Default)
Box(X,Y,W,H,ColorB)
DrawingMode(#PB_2DDrawing_Outlined)
Box(X,Y,W,H,ColorF)
EndProcedure
;----------- DrawValue()
Procedure DrawValue()
Protected X,Y,Txt$,maxW,ColorB,ColorF,CarTonquer,Decalage
; Protected FirstCaractere,EndCaractere
With myEditBox()
DrawingFont(FontID(\myFont))
X=\myPos\X+\myMargin
Y=\myPos\Y+(\myPos\H/2)
Y-TextHeight("ABCD")/2
If \IhaveFocus=#True
Txt$=\Value$
Else
Txt$=\DiplayValue$
EndIf
maxW=\myPos\W-(\myMargin *2 )
;Tronque la chaine si elle dépasse de l'éditeur
While TextWidth(Txt$)>maxW
CarTonquer+1
Txt$=Right(Txt$,Len(Txt$)-1)
Wend
;Position du cursseur
\myCursorPos\H=TextHeight("ABCD")
\myCursorPos\W=1
\myCursorPos\Y=Y
\CaracteTronquer=CarTonquer
If CarTonquer>0
Decalage=TextWidth(Left(\Value$,CarTonquer))
EndIf
If \FirstCaractere-\CaracteTronquer<0
Txt$=Mid(\Value$,\FirstCaractere+1,Len(\Value$)-\CaracteTronquer)
Decalage=TextWidth(Left(\Value$,CarTonquer+(\FirstCaractere-\CaracteTronquer)))
EndIf
; ;Si pas de sélection (Lastcaractere=-1)
If gCaratereSelected=#False
\myCursorPos\X=X+(TextWidth(Left(\Value$,\FirstCaractere))-Decalage)
Else
\myCursorPos\X=X+(TextWidth(Left(\Value$,\LastCaractere))-Decalage)
EndIf
Protected N,FirsCaractere,LastCaractere
If RightDirection=#False
FirsCaractere=\LastCaractere-1
LastCaractere=\FirstCaractere-1
Else
FirsCaractere=\FirstCaractere
LastCaractere=\LastCaractere
EndIf
For N=1 To Len(Txt$)
If gCaratereSelected=#True
If (N-1)>=FirsCaractere And (N-1)<=LastCaractere
ColorF=\mySelectFrontColor
ColorB=\mySelectBackColor
Else
ColorF=\myFrontColor
ColorB=\myBackColor
EndIf
Else
ColorF=\myFrontColor
ColorB=\myBackColor
EndIf
DrawText(X,Y,Mid(Txt$,N,1),ColorF,ColorB)
X+TextWidth(Mid(Txt$,N,1))
Next
EndWith
EndProcedure
;----------- CreateMask()
Procedure CreateMask()
;Suppression du masque
If IsImage(myEditBox()\myMask)
FreeImage(myEditBox()\myMask)
EndIf
;Creation du masque
With myEditBox()\myPos
myEditBox()\myMask=GrabDrawingImage(#PB_Any,\X,\Y,\W,\H)
EndWith
EndProcedure
;----------- Draw(Id)
Procedure Draw(Id,InitDraw.b=#True)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error Draw","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
If InitDraw:StopDrawing(): StartDrawing(CanvasOutput(myEditBox()\myCanvas)):EndIf
DrawBox()
DrawValue()
CreateMask()
If InitDraw: StopDrawing():EndIf
ProcedureReturn #True
EndProcedure
;----------- OverCaractere()
Procedure OverCaractere()
EndProcedure
;----------- WhereIsMouse()
Procedure WhereIsMouse()
Protected X1,X2,Y1,Y2,N,XT1,XT2,Txt$
CaractereOver=-1
;Détermine le sens de sélection
If gMouseX>gOldMouseX
RightDirection=#True
Else
RightDirection=#False
EndIf
With myEditBox()\myPos
X1=\X
X2=X1+\W
Y1=\Y
Y2=Y1+\H
EndWith
If (gMouseX>=X1 And gMouseX<=X2) And (gMouseY>=Y1 And gMouseY<=Y2)
With myEditBox()
;On commence à la première lettre
XT1=X1+\myMargin
;Si la chaine a été tronquée
If \CaracteTronquer>0
Txt$=Right(\Value$,Len(\Value$)-\CaracteTronquer)
Else
Txt$=\Value$
EndIf
;Parcours de toutes les lettres
StartDrawing(CanvasOutput(\myCanvas))
DrawingFont(FontID(\myFont))
If gMouseX<XT1
CaractereOver=0
StopDrawing()
ProcedureReturn #True
EndIf
If gMouseX>XT1+TextWidth(Txt$)
CaractereOver=Len(Txt$)
StopDrawing()
ProcedureReturn #True
EndIf
For N=1 To Len(Txt$)
XT2=XT1+TextWidth(Left(Txt$,N))
If gMouseX>=XT1 And gMouseX<(XT2-TextWidth(Mid(Txt$,N,1))/2)
CaractereOver=N-1
StopDrawing()
ProcedureReturn #True
EndIf
If gMouseX>=(XT1+TextWidth(Mid(Txt$,N,1))/2) And gMouseX<XT2
CaractereOver=N
StopDrawing()
ProcedureReturn #True
EndIf
Next
EndWith
StopDrawing()
ProcedureReturn #True
EndIf
StopDrawing()
ProcedureReturn #False
EndProcedure
;----------- DeleteCaractere()
Procedure DeleteCaractere()
Protected FirstCaractere,LastCaractere,N,Txt$
With myEditBox()
If \LastCaractere=-1
FirstCaractere=\FirstCaractere
LastCaractere=-1
Else
If \FirstCaractere>\LastCaractere
FirstCaractere=\LastCaractere
LastCaractere=\FirstCaractere
Else
FirstCaractere=\FirstCaractere
LastCaractere=\LastCaractere
EndIf
EndIf
If LastCaractere=-1
For N=1 To Len(\Value$)
If N<>FirstCaractere
Txt$+Mid(\Value$,N,1)
EndIf
Next
\FirstCaractere=FirstCaractere-1
If \FirstCaractere<0
\FirstCaractere=0
EndIf
Else
For N=1 To Len(\Value$)
If N<FirstCaractere+1 Or N>LastCaractere+1
Txt$+Mid(\Value$,N,1)
EndIf
Next
\LastCaractere=-1
gCaratereSelected=#False
EndIf
;Mémorise l'ancienne valeur pour l'annulation
AddElement(myEditBox()\annulation$())
myEditBox()\annulation$()= \Value$
\Value$=Txt$
;Réafiche le résultat
Draw(Val(MapKey(myEditBox())),#True)
If \myProcedureCallBack<>-1
Protected EventChangeText
EventChangeText.ProtoEntChangeText=\myProcedureCallBack
EventChangeText(\Value$)
EndIf
EndWith
EndProcedure
;----------- Free(Id)
Procedure Free(Id)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error Free","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
DeleteMapElement(myEditBox())
EndProcedure
;----------- EventKeyDown()
Procedure EventKeyDown()
Protected KeyDown
;Gestion des touches enfoncées
With myEditBox()
KeyDown=GetGadgetAttribute(\myCanvas,#PB_Canvas_Key)
If GetGadgetAttribute(\myCanvas,#PB_Canvas_Modifiers)=#PB_Canvas_Control And KeyDown=#PB_Shortcut_Z
UndoValue()
EndIf
Select KeyDown
Case #PB_Shortcut_Home
;Se positionner sur le premier caractère
\FirstCaractere=0
;Réafiche le résultat
StartDrawing(CanvasOutput(\myCanvas))
Draw(Val(MapKey(myEditBox())))
StopDrawing()
Case #PB_Shortcut_End
;Se positionner sur le dernier caractère
\FirstCaractere=Len(\Value$)
Draw(Val(MapKey(myEditBox())),#True)
;Retour arrière
Case #PB_Shortcut_Back,#PB_Shortcut_Delete
DeleteCaractere()
Case #PB_Shortcut_Left
\FirstCaractere-1
If \FirstCaractere<0
\FirstCaractere=0
EndIf
\LastCaractere=-1
gCaratereSelected=#False
StartDrawing(CanvasOutput(\myCanvas))
Draw(Val(MapKey(myEditBox())))
StopDrawing()
Case #PB_Shortcut_Right
\FirstCaractere+1
If \FirstCaractere>Len(\Value$)
\FirstCaractere=Len(\Value$)
EndIf
Draw(Val(MapKey(myEditBox())),#True)
EndSelect
EndWith
EndProcedure
;----------- OverEditBox(Id)
Procedure OverEditBox(Id)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error Event","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
If myEditBox()\OverEditBox
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
;----------- TestingNumeriqueMask(KeyInput)
Procedure TestingNumeriqueMask(KeyInput)
Protected NumCara$="123456789."
Protected DecadeNumber,Position,DecimaleNumber
With myEditBox()
;Si premier caractère
If \FirstCaractere=0
;On n'autorise pas de décimale en premier caractère
If KeyInput=46
ProcedureReturn #False
EndIf
;On regarde si négatif autorisé
If KeyInput=45
If \NegativeOn=#False
ProcedureReturn #False
Else
ProcedureReturn #True
EndIf
EndIf
EndIf
If FindString(NumCara$,Chr(KeyInput))=0
ProcedureReturn #False
EndIf
;On vérifie qu'il y a pas de double décimal
If KeyInput=46 And FindString(\Value$,Chr(46))
ProcedureReturn #False
EndIf
; Vérifie les dizaines et les décimale
; Que saisi l'user des dizaine ou des décimale?
If KeyInput<>46
Position=FindString(\Value$,Chr(46))
; Calcul du nombre de dizaines et décimale
If Position=0 ;des Dizaines
DecadeNumber=Len(\Value$)+1
Else
DecadeNumber=Len(StringField(\Value$,1,"."))
DecimaleNumber=Len(StringField(\Value$,2,"."))
If \FirstCaractere<Position ;des Dizaines
DecadeNumber+1
Else ;Des décimales
DecimaleNumber+1
EndIf
EndIf
If DecadeNumber>\DecadeNumber
ProcedureReturn #False
EndIf
If DecimaleNumber>\DecimaleNumber
ProcedureReturn #False
EndIf
EndIf
EndWith
ProcedureReturn #True
EndProcedure
;----------- TestingInputMask(KeyInput)
Procedure TestingInputMask(KeyInput)
With myEditBox()
Select \MaskType
Case #None
ProcedureReturn #True
Case #NumeriqueType
If Not TestingNumeriqueMask(KeyInput):ProcedureReturn #False:EndIf
EndSelect
ProcedureReturn #True
EndWith
EndProcedure
;----------- EventInput()
Procedure EventInput()
Protected KeyInput
If gCaratereSelected=#True
DeleteCaractere()
EndIf
With myEditBox()
KeyInput=GetGadgetAttribute(\myCanvas,#PB_Canvas_Input)
If Not TestingInputMask(KeyInput):ProcedureReturn :EndIf
;Mémorise l'ancienne valeur pour l'annulation
AddElement(myEditBox()\annulation$())
myEditBox()\annulation$()= \Value$
\Value$=InsertString(\Value$,Chr(KeyInput),\FirstCaractere+1)
;Incrément le premier caractère
\FirstCaractere+1
;Réafiche le résultat
Draw(Val(MapKey(myEditBox())),#True)
If \myProcedureCallBack<>-1
Protected EventChangeText
EventChangeText.ProtoEntChangeText=\myProcedureCallBack
EventChangeText(\Value$)
EndIf
EndWith
EndProcedure
;----------- Event(Id,Event)
Procedure Event(Id,Event)
If FindMapElement(myEditBox(),Str(Id))=0
MessageRequester("Error Event","This id "+Str(Id)+" not exist...")
ProcedureReturn #False
EndIf
DrawCursor(0)
;Pour ne pas désséllectionné ce qui a été été sélectionné avec le double click
If gCaractereAllSekected=#True
gCaractereAllSekected=#False
ProcedureReturn
EndIf
If Event<>#PB_Event_Gadget :ProcedureReturn #False :EndIf
If EventGadget()<>myEditBox()\myCanvas :ProcedureReturn #False :EndIf
gMouseX=GetGadgetAttribute(myEditBox()\myCanvas,#PB_Canvas_MouseX)
gMouseY=GetGadgetAttribute(myEditBox()\myCanvas,#PB_Canvas_MouseY)
Select EventType()
;{ La souris bouge ou le bouton gauche est enfoncé
Case #PB_EventType_MouseMove
If WhereIsMouse()=#True
myEditBox()\OverEditBox=#True
SetGadgetAttribute(myEditBox()\myCanvas,#PB_Canvas_Cursor,#PB_Cursor_IBeam)
;La touche à déjà été pressée donc le premier caractère est déjà mémorisé
If gClicOn=#True And CaractereOver<>-1
myEditBox()\LastCaractere=CaractereOver
;Réafiche le résultat
gCursorOn=#False
gCaratereSelected=#True
Draw(Val(MapKey(myEditBox())),#True)
EndIf
Else
myEditBox()\OverEditBox=#False
EndIf
;} FIN La souris bouge
;{ Click Gauche
Case #PB_EventType_LeftButtonDown
TestingFocus()
If myEditBox()\IhaveFocus=#False:ProcedureReturn :EndIf
;Va servir à derterminé le sens de la sélection
If gClicOn=#False
gOldMouseX=gMouseX
EndIf
If CaractereOver<>-1 And gClicOn=#False
With myEditBox()
\FirstCaractere=CaractereOver
;Nouveau premier caractère donc pas de dernier caractère
\LastCaractere=-1
StartDrawing(CanvasOutput(\myCanvas))
DrawingFont(FontID(\myFont))
\myCursorPos\X=\myPos\X+\myMargin+TextWidth(Left(\Value$,CaractereOver))
;Pour afficher tout de suite le cursseur
\TimeElapsed=400
LineOn=#False
If gCaratereSelected=#True
gCaratereSelected=#False
Draw(Val(MapKey(myEditBox())),#True)
EndIf
StopDrawing()
EndWith
EndIf
gClicOn=#True
;} FIN Click Gauche
;{ Doucle Click
Case #PB_EventType_LeftDoubleClick
SellectAllCaractere()
;} FIN Doucle Click
;{ Bt gauche relaché
Case #PB_EventType_LeftButtonUp
gClicOn=#False
gCursorOn=#True
;} FIN Bt gauche relaché
;{ Une touche de control est préssée
Case #PB_EventType_KeyDown
If myEditBox()\IhaveFocus=#False:ProcedureReturn :EndIf
EventKeyDown()
;} FIN Une touche est préssée
;{ On tape du texte
Case #PB_EventType_Input
If myEditBox()\IhaveFocus=#False:ProcedureReturn :EndIf
EventInput()
;} FIN On tape du texte
EndSelect
EndProcedure
;} FIN Procédures
EndModule
