String Gadget pour canvas

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

String Gadget pour canvas

Message par microdevweb »

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
Image

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

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

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
Voila n'hésitez pas à donner votre avis
Dernière modification par microdevweb le dim. 04/janv./2015 10:32, modifié 9 fois.
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Avatar de l’utilisateur
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: String Gadget pour canvas

Message par falsam »

Ligne 316 : La procédure a() est inexistante.

Code : Tout sélectionner

Decalage=TextWidth(Left(\Value$,CarTonquer+a(\FirstCaractere-\CaracteTronquer)))
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: String Gadget pour canvas

Message par microdevweb »

Merci Falsam, un petit a qui c'est glissé dans mon code à mon insu. Petit farceur :oops:
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
nico
Messages : 3702
Inscription : ven. 13/févr./2004 0:57

Re: String Gadget pour canvas

Message par nico »

C'est très intéressant comme code.

J'ai remarqué que la sélection de texte de la gauche vers la droite se passait bien mais de la droite vers la gauche, il y a le caractère précédent pris en compte.
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: String Gadget pour canvas

Message par microdevweb »

Merci Nico, il à certainement encore beaucoup de corrections à faire, je vais regarder à cela.
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: String Gadget pour canvas

Message par microdevweb »

Suite à la remarque de Nico, le code à été corrigé et permet maintenant une sélection vers la gauche correcte.
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: String Gadget pour canvas

Message par microdevweb »

Nouvelle version 1.2
--> Ajout de OverEditBox()
; --> Ajoute de la sélection de tous la caractères avec double click
; --> Ajout annulation par Ctrl Z
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: String Gadget pour canvas

Message par Micoute »

Bonjour microdevweb et merci pour cette mise à jour très appréciée.
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 !
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: String Gadget pour canvas

Message par microdevweb »

Bonjour Micoute,

De rien
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: String Gadget pour canvas

Message par microdevweb »

Nouvelle version 1.3, on peut maintenant définir une masque numérique de saisie et d'affichage
Le module nécessite maintenant un autre module CaractereMasking.pbi
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Répondre