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 : 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