PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Comment faire une entrée strictement décimale

http://forums.purebasic.com/french/viewtopic.php?t=14975

Page 1 sur 2

Comment faire une entrée strictement décimale

Publié : dim. 07/déc./2014 15:15
par Micoute
Bonjour à tous, j'ai fait ce petit programme et je souhaiterais faire des entrées strictement numérique avec des décimales.

Pourriez-vous m'aider à trouver une solution, car avec les modules, c'est assez difficile.

Je vous remercie par anticipation.

Code : Tout sélectionner

EnableExplicit

DeclareModule Police

Global FontID1
Global FontID2
Global FontID3

EndDeclareModule

;carré
DeclareModule Carre
  
  Enumeration Fenetre
    #Fenetre_Carre = 1
  EndEnumeration
  
  Enumeration Gadgets
    #Str_cote_carre
    #Str_Surface_carre
    #Str_Diagonale_carre
    #Str_perimetre_carre
    #Carre
  EndEnumeration
  
  Structure ObjetCarre
    ID.i
    Cote.d
    Surface.d
    Diagonale.d
    Perimetre.d
  EndStructure
  
  Global.ObjetCarre *Carre
  
  Declare Ouvrir_Fenetre_Carre()
  Declare CreerCarre(ID, Co.d)
  
EndDeclareModule
;cercle
DeclareModule Cercle
  
  Enumeration Fenetre
    #Fenetre_Cercle = 2
  EndEnumeration
  
  Enumeration Gadgets
    #Str_perimetre_cercle = 5
    #Str_Rayon_cercle
    #Str_Surface_Cercle
    #Str_Diametre_Cercle
    #Cercle
  EndEnumeration
  
  Structure ObjetCercle
    ID.i
    Rayon.d
    Diametre.d    
    Perimetre.d
    Surface.d
  EndStructure
  
  Global.ObjetCercle *Cercle
  
  Declare Ouvrir_Fenetre_Cercle()
  Declare CreerCercle(ID, Rayon.d)
  
EndDeclareModule
;rectangle
DeclareModule Rectangle
  
  Enumeration Fenetre
    #Fenetre_Rectangle = 3
  EndEnumeration
  
  Enumeration Gadgets
    #Str_perimetre_Rectangle = 10
    #Str_Largeur_Rectangle
    #Str_Longueur_Rectangle
    #Str_Surface_rectangle
    #Str_Diagonale_rectangle
    #Rectangle
  EndEnumeration
  
  Structure ObjetRectangle
    Id.i
    Longueur.d
    Largeur.d
    Perimetre.d
    Surface.d
    Diagonale.d
  EndStructure
  
  Global.ObjetRectangle *Rectangle
    
  Declare Ouvrir_Fenetre_Rectangle()
  Declare CreerRectangle(Id, Longueur.d, Largeur.d)
  
EndDeclareModule
;anneau
DeclareModule Anneau
  
  Enumeration Fenetre
    #Fenetre_Anneau = 4
  EndEnumeration
  
  Enumeration gadgets
    #Str_DE = 16
    #Str_DI
    #Str_DIn
    #Str_La
    #Str_SU
    #Anneau
  EndEnumeration
  
  Structure ObjetAnneau
    ID.i
    DiametreInterne.d
    DiametreExterne.d
    DiametreIntermediaire.d
    Largeur.d
    Surface.d
  EndStructure
  
  Global.ObjetAnneau *Anneau
  
  Declare Ouvrir_Fenetre_Anneau()
  Declare CreerAnneau(ID, Di.d, De.d)
  
EndDeclareModule
;triangle rectangle
DeclareModule TriangleRectangle
  Enumeration Fenetre
    #Fenetre_TriangleR = 5
  EndEnumeration
  Enumeration Gadgets
    #Str_Base_TR = 22
    #Str_Hauteur_TR
    #Str_Hypothenuse_TR
    #Str_Perimetre_TR
    #Str_Surface_TR
    #TriangleRectangle
  EndEnumeration
  
  Structure ObjetTriangleRectangle
    ID.i
    Base.d
    Hauteur.d
    Hypothenuse.d
    Perimetre.d
    Surface.d
  EndStructure
  
  Global.ObjetTriangleRectangle *TriangleRectangle
  
  Declare Ouvrir_Fenetre_TriangleRectangle()
  Declare CreerTriangleRectangle(Id, Base.d, Hauteur.d)
EndDeclareModule  
;losange
DeclareModule Losange
  
  Enumeration Fenetre
    #Fenetre_Losange = 6
  EndEnumeration
  
  Enumeration Gadgets
    #Str_Cote_Losange = 28
    #Str_Surface_Losange
    #Str_Perimetre_Losange
    #Losange
  EndEnumeration
  
  Structure ObjetLosange
    ID.i
    Cote_Losange.d
    Surface_Losange.d
    Perimetre_Losange.d
  EndStructure
  
  Global.ObjetLosange *Losange
  
  Declare Ouvrir_Fenetre_Losange()
  Declare CreerLosange(ID, Cote_Losange.d)
EndDeclareModule
;parallelogramme
DeclareModule Parallelogramme
  
  Enumeration Fenetre
    #Fenetre_Parallelogramme = 7
  EndEnumeration
  
  Enumeration gadgets
    #Str_Longueur_Parallelogramme = 32
    #Str_Largeur_Parallelogramme
    #Str_Hauteur_Parallelogramme
    #Str_Surface_Parallelogramme
    #Str_Perimetre_Parallelogramme
    #Parallelogramme
  EndEnumeration
  
  Structure ObjetParallelogramme
    ID.i
    Longueur_Parallelogramme.d
    Largeur_Parallelogramme.d
    Hauteur_Parallelogramme.d
    Surface_Parallelogramme.d
    Perimetre_Parallelogramme.d
  EndStructure  
  
  Global.ObjetParallelogramme *Parallelogramme
  
  Declare Ouvrir_fenetre_Parallelogramme()
  Declare CreerParallelogramme(Id, Longueur_Parallelogramme.d, Largeur_Parallelogramme.d, Hauteur_Parallelogramme.d)  
EndDeclareModule
;trapèze
DeclareModule Trapeze
  Enumeration Fenetre
    #Fenetre_Trapeze
  EndEnumeration
  Enumeration Gadgets
    #Str_Cote_1_Trapeze = 38
    #Str_Cote_2_Trapeze
    #Str_Cote_3_Trapeze
    #Str_Cote_4_Trapeze
    #Str_Longueur_Mediane_Trapeze
    #Str_Hauteur_Trapeze
    #Str_Surface_Trapeze
    #Str_Perimetre_Trapeze
    #Trapeze
  EndEnumeration
  Structure ObjetTrapeze
    Id.i
    Cote_1.d
    Cote_2.d
    Cote_3.d
    Cote_4.d
    Longueur_Mediane.d
    Hauteur.d
    Surface.d
    Perimetre.d
  EndStructure
  Global.ObjetTrapeze *Trapeze
  Declare CreerTrapeze(ID, Cote_1.d, Cote_2.d, Cote_3.d, Cote_4.d,Hauteur.d)
  Declare Ouvrir_Fenetre_Trapeze()
EndDeclareModule  

;Partie publique
Enumeration Fenetres
  #Fenetre_Geometrie
  #Fenetre_Carre
  #Fenetre_Cercle
  #Fenetre_Rectangle
  #Fenetre_Anneau
  #Fenetre_TriangleR
  #Fenetre_Losange
  #Fenetre_Parallelogramme  
  #Fenetre_Trapeze
EndEnumeration

Enumeration Gadgets
  #Str_cote_carre
  #Str_Surface_carre
  #Str_Diagonale_carre
  #Str_perimetre_carre
  #Carre
EndEnumeration

Enumeration Gadgets
  #Str_perimetre_cercle = 5
  #Str_Rayon_cercle
  #Str_Surface_Cercle
  #Str_Diametre_Cercle
  #Cercle
EndEnumeration

Enumeration Gadgets
  #Str_perimetre_Rectangle = 10
  #Str_Largeur_Rectangle
  #Str_Longueur_Rectangle
  #Str_Surface_rectangle
  #Str_Diagonale_rectangle
  #Rectangle
EndEnumeration

Enumeration gadgets
  #Str_DE = 16
  #Str_DI
  #Str_DIn
  #Str_La
  #Str_SU
  #Anneau
EndEnumeration

Enumeration Gadgets
  #Str_Base_TR = 22
  #Str_Hauteur_TR
  #Str_Hypothenuse_TR
  #Str_Perimetre_TR
  #Str_Surface_TR
  #TriangleRectangle
EndEnumeration

Enumeration Gadgets
  #Str_Cote_Losange = 28
  #Str_Surface_Losange
  #Str_Perimetre_Losange
  #Losange
EndEnumeration

Enumeration gadgets
  #Str_Longueur_Parallelogramme = 32
  #Str_Largeur_Parallelogramme
  #Str_Hauteur_Parallelogramme
  #Str_Surface_Parallelogramme
  #Str_Perimetre_Parallelogramme
  #Parallelogramme
EndEnumeration

Enumeration Gadgets
  #Str_Cote_1_Trapeze = 38
  #Str_Cote_2_Trapeze
  #Str_Cote_3_Trapeze
  #Str_Cote_4_Trapeze
  #Str_Longueur_Mediane_Trapeze
  #Str_Hauteur_Trapeze
  #Str_Surface_Trapeze
  #Str_Perimetre_Trapeze
  #Trapeze
EndEnumeration  

Enumeration Gadgets
  #Btn_Carre = 47
  #Btn_Cercle
  #Btn_Anneau
  #Btn_Rectangle
  #Btn_TR
  #Btn_Losange
  #Btn_Parallelogramme
  #Btn_Trapeze
EndEnumeration


Procedure Ouvrir_Fenetre_Geometrie()
  OpenWindow(#Fenetre_Geometrie,380,100,470,341,"Choisissez une figure géométrique",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  ButtonGadget(#Btn_Carre,35,40,200,50,"Carré")
  ButtonGadget(#Btn_Cercle,35,110,200,50,"Cercle")
  ButtonGadget(#Btn_Rectangle,35,180,200,50,"Rectangle")
  ButtonGadget(#Btn_Anneau,35,250,200,50,"Anneau")
  ButtonGadget(#Btn_TR, 250,40,200,50,"Triangle Rectangle")
  ButtonGadget(#Btn_Losange, 250, 110, 200, 50, "Losange")
  ButtonGadget(#Btn_Parallelogramme, 250, 180, 200, 50,"Parallélogramme")
  ButtonGadget(#Btn_Trapeze, 250, 250, 200, 50, "Trapèze")
  
EndProcedure


Module Police
  
  FontID1 = LoadFont(1,"Segoe UI",16,#PB_Font_Bold)
  FontID2 = LoadFont(2,"Segoe UI",40,#PB_Font_Bold)
  FontID3 = LoadFont(3,"Segoe UI",30,#PB_Font_Bold)
  
EndModule


Module Carre
  
  Procedure CreerCarre(ID, Co.d)
    *Carre = AllocateMemory(SizeOf(objetCarre))
    *Carre\Surface = Co * Co
    *Carre\Perimetre = Co * 4
    *Carre\Diagonale = Co * Sqr(2)
  EndProcedure
    
  Procedure Ouvrir_Fenetre_Carre()
    If OpenWindow(#Fenetre_carre, 216, 0, 375, 399, "Calcule d'un carré",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar|#PB_Window_ScreenCentered )
      
      StringGadget(#Str_cote_carre, 130, 120, 200, 40, "",#ES_RIGHT)
      GadgetToolTip(#Str_cote_carre, "Veuillez entrer le côté du carré")
      SetGadgetFont(#Str_cote_carre, Police::FontID1)
      StringGadget(#Str_Surface_carre, 130, 180, 200, 40, "",#ES_RIGHT)
      SetGadgetFont(#Str_Surface_carre, Police::FontID1)
      StringGadget(#Str_Diagonale_carre, 130, 240, 200, 40, "",#ES_RIGHT)
      SetGadgetFont(#Str_Diagonale_carre, Police::FontID1)
      StringGadget(#Str_perimetre_carre, 130, 300, 200, 40, "",#ES_RIGHT)
      SetGadgetFont(#Str_perimetre_carre, Police::FontID1)
      
      If StartDrawing(WindowOutput(#Fenetre_Carre))
        BackColor(Point(0, 0))
        
        DrawingFont(Police::FontID2)
        
        FrontColor(#Red)
        DrawText(100, 30, "Carré")
        
        
        DrawingFont(Police::FontID1)
        
        FrontColor(#Black)
        DrawText(20, 120, "Largeur :")        
        DrawText(20, 180, "Surface :")        
        DrawText(20, 240, "Diagonale :")        
        DrawText(20, 300, "Périmètre :")
        
      EndIf

    EndIf
    SetActiveGadget(#Str_cote_carre)
  EndProcedure
EndModule

Module Cercle
  
  Procedure CreerCercle(ID, Rayon.d)
    *Cercle = AllocateMemory(SizeOf(ObjetCercle))
    *Cercle\Diametre = Rayon * 2
    *Cercle\Perimetre = 2 * #PI * Rayon
    *Cercle\Surface = #PI / 4 * Pow(*Cercle\Diametre, 2)
  EndProcedure
;{  
  ;/ Ra   = Rayon
  ;/ Di   = Diamètre
  ;/ Su   = Surface
  ;/ La   = Rayon de l'arc
  
;  Procedure.d Peri_Cercle_R(Ra.d) ; Périmètre du cercle par rapport au rayon
;    ProcedureReturn 2 * #PI * Ra
;  EndProcedure
  
;  Procedure.d Peri_Cercle_D(Di.d) ; Périmètre du cercle par rapport au diamètre
;    ProcedureReturn #PI * Di
;  EndProcedure
  
;  Procedure.d Surf_Cercle_R(Ra.d) ; Surface du cercle par rapport au rayon
;    ProcedureReturn #PI * (Pow(Ra, 2))
;  EndProcedure
  
;  Procedure.d Surf_Cercle_D(Di.d) ; Surface du cercle par rapport au diamètre
;    ProcedureReturn#PI/4 * Pow(Di, 2)
;  EndProcedure
  
;  Procedure.d Ra_Cercle_S(Su.d) ; Rayon du cercle par rapport à sa surface
;    ProcedureReturn Sqr(Su / #PI)
;  EndProcedure
  
;  Procedure.d Di_Cercle_S(Su.d) ; Diamètre du cercle par rapport à sa surface
;    ProcedureReturn Sqr(Su / (#PI/4))
;  EndProcedure
  
;  Procedure.d Peri_Cercle_S(Su.d) ; Perimètre du cercle par rapport à sa surface
;    ProcedureReturn #PI * Sqr(Su / (#PI/4))
;  EndProcedure
  
;  Procedure.d Lng_Arc_Cercle(Ra.d, An.d) ; Rayon d'un arc de cercle
;    ProcedureReturn #PI * Ra * (An / 180)
;  EndProcedure
  
;  Procedure.d Lng_Crd_Cercle(Ra.d, An.d) ; Rayon de la corde
;    ProcedureReturn 2 * Ra * Sin(Radian(An)/2)
;  EndProcedure
  
;  Procedure.d Surf_Arc_Cercle(Di.d, An.d) ; Surface d'un arc de cercle
;    ProcedureReturn #PI * Pow(Di, 2) * An /1440
;  EndProcedure
  
;  Procedure.d Surf_Arc_From_LArc(La.d, Ra.d) ; Surface d'un arc de cercle par rapport à la Rayon de l'arc
;    ProcedureReturn La * Ra / 2
;  EndProcedure
 ;} 
  Procedure Ouvrir_Fenetre_Cercle()
    If OpenWindow(#Fenetre_Cercle, 216, 0, 375, 420, "Calcul d'un Cercle", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
      
      StringGadget(#Str_Rayon_cercle, 130, 150, 200, 40, "",#ES_RIGHT)
      GadgetToolTip(#Str_Rayon_cercle, "Veuillez entrer la Rayon du Cercle")
      SetGadgetFont(#Str_Rayon_cercle, Police::FontID1)
      
      StringGadget(#Str_Surface_Cercle, 130, 210, 200, 40, "",#ES_RIGHT)
      SetGadgetFont(#Str_Surface_Cercle, Police::FontID1)
      
      StringGadget(#Str_Diametre_Cercle, 130, 270, 200, 40, "",#ES_RIGHT)
      SetGadgetFont(#Str_Diametre_Cercle, Police::FontID1)
      
      StringGadget(#Str_perimetre_cercle, 130, 330, 200, 40, "",#ES_RIGHT)
      SetGadgetFont(#Str_perimetre_cercle, Police::FontID1)
      
      If StartDrawing(WindowOutput(#Fenetre_Cercle))
        BackColor(Point(0, 0))
        
        DrawingFont(Police::FontID2)
        
        FrontColor(#Red)
        DrawText(100, 30, "Cercle")        
        
        DrawingFont(Police::FontID1)
        
        FrontColor(#Black)
        DrawText(20, 150, "Rayon :")        
        DrawText(20, 210, "Surface :")        
        DrawText(20, 270, "Diamètre:")        
        DrawText(20, 330, "Périmètre :")
        
      EndIf      
      SetActiveGadget(#Str_Rayon_cercle)
    EndIf
  EndProcedure
  
EndModule

Module Rectangle
  
  Procedure CreerRectangle(Id, Longueur.d, Largeur.d)
    *Rectangle = AllocateMemory(SizeOf(ObjetRectangle))
    *Rectangle\Perimetre = (Longueur + Largeur) * 2
    *Rectangle\Surface = Longueur * Largeur
    *Rectangle\Diagonale = Sqr(Pow(Longueur, 2) + Pow(Largeur, 2))
  EndProcedure 
  
  Procedure Ouvrir_Fenetre_Rectangle()
    If OpenWindow(#Fenetre_Rectangle, 216, 0, 375, 420, "Calcul d'un rectangle", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
      
      StringGadget(#Str_Longueur_Rectangle, 130, 120, 200, 40, "",#ES_RIGHT)
      GadgetToolTip(#Str_Longueur_Rectangle, "Veuillez entrer la longueur du rectangle")
      SetGadgetFont(#Str_Longueur_Rectangle,Police::FontID1)
      StringGadget(#Str_Largeur_Rectangle,130,180,200,40,"",#ES_RIGHT)
      GadgetToolTip(#Str_Largeur_Rectangle,"Veuillez entrer la largeur du rectangle")
      SetGadgetFont(#Str_Largeur_Rectangle, Police::FontID1)      
      StringGadget(#Str_Surface_rectangle, 130, 240, 200, 40, "", #PB_String_ReadOnly|#ES_RIGHT)
      SetGadgetFont(#Str_Surface_rectangle, Police::FontID1)
      StringGadget(#Str_Diagonale_rectangle, 130, 300, 200, 40, "", #PB_String_ReadOnly|#ES_RIGHT)
      SetGadgetFont(#Str_Diagonale_rectangle, Police::FontID1)
      StringGadget(#Str_perimetre_Rectangle, 130, 360, 200, 40, "", #PB_String_ReadOnly|#ES_RIGHT)
      SetGadgetFont(#Str_perimetre_Rectangle, Police::FontID1)
      
      If StartDrawing(WindowOutput(#Fenetre_Rectangle))
        BackColor(Point(0,0))
        
        DrawingFont(Police::FontID2)
        
        FrontColor(#Red)
        DrawText(60, 30, "Rectangle")        
        
        DrawingFont(Police::FontID1)
        
        FrontColor(#Black)
        DrawText(20, 120, "Longueur :")
        DrawText(20, 180, "Largeur :")
        DrawText(20, 240, "Surface :")        
        DrawText(20, 300, "Diagonale :")        
        DrawText(20, 360, "Périmètre :")
        
      EndIf
      SetActiveGadget(#Str_Longueur_Rectangle)
    EndIf
  EndProcedure
EndModule

Module Anneau
  
  Procedure CreerAnneau(ID,Di.d,De.d)
    *Anneau = AllocateMemory(SizeOf(ObjetAnneau))
    *Anneau\DiametreIntermediaire = (De+Di)/2
    *Anneau\Largeur = De-Di
    *Anneau\Surface = #PI * *Anneau\DiametreIntermediaire * *Anneau\Largeur
  EndProcedure
  
  Procedure Ouvrir_Fenetre_Anneau()
    If OpenWindow(#Fenetre_Anneau,0,0,400,420,"Anneau",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
      
      StringGadget(#Str_DE,250,120,100,40,"",#ES_RIGHT)
      StringGadget(#Str_DI,250,180,100,40,"",#ES_RIGHT)
      StringGadget(#Str_DIn,250,240,100,40,"",#PB_String_ReadOnly|#ES_RIGHT)
      StringGadget(#Str_La,250,300,100,40,"",#PB_String_ReadOnly|#ES_RIGHT)
      StringGadget(#Str_SU,250,360,100,40,"",#PB_String_ReadOnly|#ES_RIGHT)
      
      For i = #Str_DE To #Str_SU
        SetGadgetFont(i, Police::FontID1)
      Next
      
      If StartDrawing(WindowOutput(#Fenetre_Anneau))
        BackColor(Point(0,0))
        
        DrawingFont(Police::FontID2)
        
        FrontColor(#Red)
        DrawText(100,30,"Anneau")        
        
        DrawingFont(Police::FontID1)
        
        FrontColor(#Black)
        DrawText(5,120,"Diamètre externe :")
        DrawText(5,180,"Diamètre interne :")
        DrawText(5,240,"Diamètre intermédiaire :")
        DrawText(5,300,"Epaisseur :")      
        DrawText(5,360,"Surface :")
        
      EndIf
      SetActiveGadget(#Str_DE)
    EndIf
  EndProcedure
  
EndModule

Module TriangleRectangle
  
  Procedure CreerTriangleRectangle(Id, Base.d, Hauteur.d)
    *TriangleRectangle = AllocateMemory(SizeOf(ObjetTriangleRectangle))
    *TriangleRectangle\Surface = (Base * Hauteur) / 2
    *TriangleRectangle\Hypothenuse = Sqr(Pow(Base, 2) + Pow(Hauteur, 2))
    *TriangleRectangle\Perimetre = Base + Hauteur + *TriangleRectangle\Hypothenuse
  EndProcedure
  
  Procedure Ouvrir_Fenetre_TriangleRectangle()
    If OpenWindow(#Fenetre_TriangleR,216,0,400,420,"Calcul d'un triangle rectangle",#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
      
      StringGadget(#Str_Base_TR,170,120,200,40,"",#ES_RIGHT)
      GadgetToolTip(#Str_Base_TR,"Veuillez entrer la base")
      SetGadgetFont(#Str_Base_TR,Police::FontID1)
      StringGadget(#Str_Hauteur_TR,170,180,200,40,"",#ES_RIGHT)
      GadgetToolTip(#Str_Hauteur_TR,"Veuillez entrer la hauteur")
      SetGadgetFont(#Str_Hauteur_TR,Police::FontID1)
      StringGadget(#Str_Hypothenuse_TR,170,240,200,40,"",#PB_String_ReadOnly|#ES_RIGHT)
      SetGadgetFont(#Str_Hypothenuse_TR,Police::FontID1)
      StringGadget(#Str_Surface_TR,170,300,200,40,"",#PB_String_ReadOnly|#ES_RIGHT)
      SetGadgetFont(#Str_Surface_TR,Police::FontID1)
      StringGadget(#Str_Perimetre_TR,170,360,200,40,"",#PB_String_ReadOnly|#ES_RIGHT)
      SetGadgetFont(#Str_Perimetre_TR,Police::FontID1)
      
      If StartDrawing(WindowOutput(#Fenetre_TriangleR))
        BackColor(Point(0,0))
        
        DrawingFont(Police::FontID3)
        
        FrontColor(#Red)
        DrawText(20,30,"Triangle Rectangle")
        
        DrawingFont(Police::FontID1)
        FrontColor(#Black)
        DrawText(20,120,"Longueur :")
        DrawText(20,180,"Largeur :")
        DrawText(20,240,"Hypothénuse :")
        DrawText(20,300,"Surface :")
        DrawText(20,360,"Périmètre :")
        
      EndIf
      SetActiveGadget(#Str_Base_TR)
    EndIf
  EndProcedure
EndModule

Module Losange
  
  Procedure CreerLosange(ID, Cote_Losange.d)
    *Losange = AllocateMemory(SizeOf(ObjetLosange))
    *Losange\Perimetre_Losange = Cote_Losange * 4
    *Losange\Surface_Losange = Cote_Losange * Cote_Losange
  EndProcedure
  
  Procedure Ouvrir_Fenetre_Losange()
    If OpenWindow(#Fenetre_Losange,216,0,400,420,"Calcul d'un losange",#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
      
      StringGadget(#Str_Cote_Losange,170,120,200,40,"",#ES_RIGHT)
      GadgetToolTip(#Str_Cote_Losange,"Veuillez entrer la longueur du côté")
      SetGadgetFont(#Str_Cote_Losange,Police::FontID1)
      StringGadget(#Str_Surface_Losange,170,240,200,40,"",#PB_String_ReadOnly|#ES_RIGHT)
      SetGadgetFont(#Str_Surface_Losange,Police::FontID1)
      StringGadget(#Str_Perimetre_Losange,170,360,200,40,"",#PB_String_ReadOnly|#ES_RIGHT)
      SetGadgetFont(#Str_Perimetre_Losange,Police::FontID1)
      
      If StartDrawing(WindowOutput(#Fenetre_Losange))
        BackColor(Point(0,0))
        
        DrawingFont(Police::FontID2)
        
        FrontColor(#Red)
        DrawText(60,30,"Losange")
        
        
        DrawingFont(Police::FontID1)
        
        FrontColor(#Black)
        DrawText(20,120,"Côté :")
        DrawText(20,240,"Surface :")
        DrawText(20,360,"Périmètre :")
        
      EndIf
      SetActiveGadget(#Str_Cote_Losange)
    EndIf
  EndProcedure
EndModule

Module Parallelogramme
  Procedure CreerParallelogramme(Id, Longueur_Parallelogramme.d, Largeur_Parallelogramme.d, Hauteur_Parallelogramme.d)
    *Parallelogramme = AllocateMemory(SizeOf(ObjetParallelogramme))
    *Parallelogramme\Perimetre_Parallelogramme = (2 * Longueur_Parallelogramme) + (2 * Largeur_Parallelogramme)
    *Parallelogramme\Surface_Parallelogramme = Longueur_Parallelogramme * Hauteur_Parallelogramme
  EndProcedure
  
  Procedure Ouvrir_fenetre_Parallelogramme()
    If OpenWindow(#Fenetre_Parallelogramme,216,0,375,420,"Calcul d'un parallélogramme",#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
      
      StringGadget(#Str_Longueur_Parallelogramme,130,120,200,40,"",#ES_RIGHT)
      GadgetToolTip(#Str_Longueur_Parallelogramme,"Veuillez entrer la longueur du parallélogramme")
      SetGadgetFont(#Str_Longueur_Parallelogramme,Police::FontID1)
      StringGadget(#Str_Largeur_Parallelogramme,130,180,200,40,"",#ES_RIGHT)
      GadgetToolTip(#Str_Largeur_Parallelogramme,"Veuillez entrer la largeur du parallélogramme")
      SetGadgetFont(#Str_Largeur_Parallelogramme,Police::FontID1)
      StringGadget(#Str_Hauteur_Parallelogramme,130,240,200,40,"",#ES_RIGHT)
      GadgetToolTip(#Str_Hauteur_Parallelogramme,"Veuillez entrer la hauteur du parallélogramme")
      SetGadgetFont(#Str_Hauteur_Parallelogramme,Police::FontID1)
      StringGadget(#Str_Surface_Parallelogramme,130,300,200,40,"",#PB_String_ReadOnly|#ES_RIGHT)
      SetGadgetFont(#Str_Surface_Parallelogramme,Police::FontID1)
      StringGadget(#Str_Perimetre_Parallelogramme,130,360,200,40,"",#PB_String_ReadOnly|#ES_RIGHT)
      SetGadgetFont(#Str_Perimetre_Parallelogramme,Police::FontID1)
      
      If StartDrawing(WindowOutput(#Fenetre_Parallelogramme))
        BackColor(Point(0,0))
        
        DrawingFont(Police::FontID1)
        
        FrontColor(#Red)
        DrawText(100,30,"Parallélogramme")
                
        FrontColor(#Black)
        DrawText(20,120,"Longueur :")
        DrawText(20,180,"Largeur :")
        DrawText(20,240,"Hauteur :")
        DrawText(20,300,"Surface :")
        DrawText(20,360,"Périmètre :")
        
      EndIf
      SetActiveGadget(#Str_Longueur_Parallelogramme)
    EndIf
    
  EndProcedure  
EndModule

Module Trapeze
  
  Procedure CreerTrapeze(ID, Cote_1.d, Cote_2.d, Cote_3.d, Cote_4.d, Hauteur.d)
    *Trapeze = AllocateMemory(SizeOf(ObjetTrapeze))
    *Trapeze\Surface = (Cote_1 + Cote_3) / (2 * Hauteur)
    *Trapeze\Longueur_Mediane = (Cote_1 + Cote_3) / 2
    *Trapeze\Perimetre = Cote_1 + Cote_2 + Cote_3 + Cote_4
  EndProcedure
  
  Procedure Ouvrir_Fenetre_Trapeze()
    If OpenWindow(#Fenetre_Trapeze,216,0,375,600,"Calcul d'un trapèze",#PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
      
      StringGadget(#Str_Cote_1_Trapeze,130,120,200,40,"",#ES_RIGHT)
      GadgetToolTip(#Str_Cote_1_Trapeze,"Veuillez entrer le côté 1")
      SetGadgetFont(#Str_Cote_1_Trapeze,Police::FontID1)
      StringGadget(#Str_Cote_2_Trapeze,130,180,200,40,"",#ES_RIGHT)
      GadgetToolTip(#Str_Cote_2_Trapeze,"Veuillez entrer le côté 2")
      SetGadgetFont(#Str_Cote_2_Trapeze,Police::FontID1)
      StringGadget(#Str_Cote_3_Trapeze,130,240,200,40,"",#ES_RIGHT)
      GadgetToolTip(#Str_Cote_3_Trapeze,"Veuillez entrer le côté 3")
      SetGadgetFont(#Str_Cote_3_Trapeze,Police::FontID1)
      StringGadget(#Str_Cote_4_Trapeze,130,300,200,40,"",#ES_RIGHT)
      GadgetToolTip(#Str_Cote_4_Trapeze,"Veuillez entrer le côté 4")
      SetGadgetFont(#Str_Cote_4_Trapeze,Police::FontID1)
      StringGadget(#Str_Hauteur_Trapeze,130,360,200,40,"",#ES_RIGHT)
      GadgetToolTip(#Str_Hauteur_Trapeze,"Veuillez entrer la hauteur")
      SetGadgetFont(#Str_Hauteur_Trapeze,Police::FontID1)
      StringGadget(#Str_Longueur_Mediane_Trapeze,130,420,200,40,"",#PB_String_ReadOnly|#ES_RIGHT)
      SetGadgetFont(#Str_Longueur_Mediane_Trapeze,Police::FontID1)
      StringGadget(#Str_Surface_Trapeze,130,480,200,40,"",#PB_String_ReadOnly|#ES_RIGHT)
      SetGadgetFont(#Str_Surface_Trapeze,Police::FontID1)
      StringGadget(#Str_Perimetre_Trapeze,130,540,200,40,"",#PB_String_ReadOnly|#ES_RIGHT)
      SetGadgetFont(#Str_Perimetre_Trapeze,Police::FontID1)
      
      If StartDrawing(WindowOutput(#Fenetre_Trapeze))
        BackColor(Point(0,0))
        
        DrawingFont(Police::FontID2)
        
        FrontColor(#Red)
        DrawText(80,30,"Trapèze")
        
        
        DrawingFont(Police::FontID1)
        
        FrontColor(#Black)
        DrawText(20,120,"Côté 1 :")
        DrawText(20,180,"Côté 2 :")
        DrawText(20,240,"Côté 3 :")
        DrawText(20,300,"Côté 4 :")
        DrawText(20,360,"Hauteur :")
        DrawText(20,420,"Médiane :")
        DrawText(20,480,"Surface :")
        DrawText(20,540,"Périmètre")
        
      EndIf
      SetActiveGadget(#Str_Cote_1_Trapeze)
    EndIf

  EndProcedure
  
EndModule


Ouvrir_Fenetre_Geometrie()


Define.i Evenement, EvenementFenetre, EvenementGadget

Repeat
  Evenement = WaitWindowEvent()
  Select Evenement
      ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    Case #PB_Event_Gadget
      EvenementGadget = EventGadget()
      Select EvenementGadget
        Case #Btn_Carre
          StopDrawing()
          Carre::Ouvrir_Fenetre_Carre()
        Case #Btn_Cercle
          StopDrawing()
          Cercle::Ouvrir_Fenetre_Cercle()
        Case #Btn_Rectangle
          StopDrawing()
          Rectangle::Ouvrir_Fenetre_Rectangle()
        Case #Btn_Anneau
          StopDrawing()
          Anneau::Ouvrir_Fenetre_Anneau()
        Case #Btn_TR
          StopDrawing()
          TriangleRectangle::Ouvrir_Fenetre_TriangleRectangle()
        Case #Btn_Losange
          StopDrawing()
          Losange::Ouvrir_Fenetre_Losange()
        Case #Btn_Parallelogramme
          StopDrawing()
          Parallelogramme::Ouvrir_fenetre_Parallelogramme()
        Case #Btn_Trapeze
          StopDrawing()
          Trapeze::Ouvrir_Fenetre_Trapeze()
          
          
          ;carré
        Case #Str_cote_carre
          If Val(GetGadgetText(#Str_cote_carre)) <> 0
            Carre::CreerCarre(#Carre, ValD(GetGadgetText(#Str_cote_carre)))
            SetGadgetText(#Str_perimetre_carre, StrD(Carre::*Carre\Perimetre))
            SetGadgetText(#Str_Surface_carre, StrD(Carre::*Carre\Surface))
            SetGadgetText(#Str_Diagonale_carre, StrD(Carre::*Carre\Diagonale))
          EndIf
          
          ;cercle    
        Case #Str_Rayon_cercle
          If Val(GetGadgetText(#Str_Rayon_cercle)) <> 0
            Cercle::CreerCercle(#Cercle, ValD(GetGadgetText(#Str_Rayon_cercle)))
            SetGadgetText(#Str_Surface_Cercle, StrD(Cercle::*Cercle\Surface))
            SetGadgetText(#Str_Diametre_Cercle, StrD(Cercle::*Cercle\Diametre))
            SetGadgetText(#Str_perimetre_cercle, StrD(Cercle::*Cercle\Perimetre))
          EndIf
          
          ;rectangle
          
        Case #Str_Largeur_Rectangle, #Str_Longueur_Rectangle
          If Val(GetGadgetText(#Str_Largeur_Rectangle)) <> 0 And Val(GetGadgetText(#Str_Longueur_Rectangle)) <> 0
            Rectangle::CreerRectangle(#Rectangle, ValD(GetGadgetText(#Str_Longueur_Rectangle)), 
                                      ValD(GetGadgetText(#Str_Largeur_Rectangle)))
            SetGadgetText(#Str_Surface_rectangle, StrD(Rectangle::*Rectangle\Surface))
            SetGadgetText(#Str_Diagonale_rectangle, StrD(Rectangle::*Rectangle\Diagonale))
            SetGadgetText(#Str_perimetre_Rectangle, StrD(Rectangle::*Rectangle\Perimetre))
          EndIf
          ;anneau
          
        Case Anneau::#Str_DE,Anneau::#Str_DI
          If Val(GetGadgetText(Anneau::#Str_DE)) <> 0 And Val(GetGadgetText(Anneau::#Str_DI)) <> 0
            Anneau::CreerAnneau(#Anneau,ValD(GetGadgetText(Anneau::#Str_DI)),ValD(GetGadgetText(Anneau::#Str_DE)))
            SetGadgetText(Anneau::#Str_DIn,StrD(Anneau::*Anneau\DiametreIntermediaire))
            SetGadgetText(Anneau::#Str_La,StrD(Anneau::*Anneau\Largeur))
            SetGadgetText(Anneau::#Str_SU, StrD(Anneau::*Anneau\Surface))
          EndIf
          
          ;triangle rectangle
        Case #Str_Base_TR, #Str_Hauteur_TR
          If Val(GetGadgetText(#Str_Base_TR)) <> 0 And Val(GetGadgetText(#Str_Hauteur_TR)) <> 0
            TriangleRectangle::CreerTriangleRectangle(#TriangleRectangle, ValD(GetGadgetText(#Str_Base_TR)),
                                                      ValD(GetGadgetText(#Str_Hauteur_TR)))
            SetGadgetText(#Str_Hypothenuse_TR, StrD(TriangleRectangle::*TriangleRectangle\Hypothenuse))
            SetGadgetText(#Str_Surface_TR, StrD(TriangleRectangle::*TriangleRectangle\Surface))
            SetGadgetText(#Str_Perimetre_TR, StrD(TriangleRectangle::*TriangleRectangle\Perimetre))
          EndIf
          
          ;losange
        Case #Str_Cote_Losange
          If Val(GetGadgetText(#Str_Cote_Losange)) <> 0
            Losange::CreerLosange(#Losange, ValD(GetGadgetText(#Str_Cote_Losange)))
            SetGadgetText(#Str_Perimetre_Losange, StrD(Losange::*Losange\Perimetre_Losange))
            SetGadgetText(#Str_Surface_Losange, StrD(Losange::*Losange\Surface_Losange))
          EndIf
          
          ;parallelogramme
        Case #Str_Longueur_Parallelogramme,#Str_Largeur_Parallelogramme,#Str_Hauteur_Parallelogramme
          If Val(GetGadgetText(#Str_Longueur_Parallelogramme)) <> 0 And
             Val(GetGadgetText(#Str_Largeur_Parallelogramme))  <> 0 And
             Val(GetGadgetText(#Str_Hauteur_Parallelogramme))  <> 0
            Parallelogramme::CreerParallelogramme(#Parallelogramme, ValD(GetGadgetText(#Str_Longueur_Parallelogramme)),
                                                  ValD(GetGadgetText(#Str_Largeur_Parallelogramme)),
                                                  ValD(GetGadgetText(#Str_Hauteur_Parallelogramme)))
            SetGadgetText(#Str_Perimetre_Parallelogramme, StrD(Parallelogramme::*Parallelogramme\Perimetre_Parallelogramme))
            SetGadgetText(#Str_Surface_Parallelogramme, StrD(Parallelogramme::*Parallelogramme\Surface_Parallelogramme))
          EndIf  
          
          ;trapèze
        Case #Str_Cote_1_Trapeze, #Str_Cote_2_Trapeze, #Str_Cote_3_Trapeze, #Str_Cote_4_Trapeze, #Str_Hauteur_Trapeze
          If Val(GetGadgetText(#Str_Cote_1_Trapeze)) <> 0 And
             Val(GetGadgetText(#Str_Cote_2_Trapeze)) <> 0 And
             Val(GetGadgetText(#Str_Cote_3_Trapeze)) <> 0 And
             Val(GetGadgetText(#Str_Cote_4_Trapeze)) <> 0 And
             Val(GetGadgetText(#Str_Hauteur_Trapeze)) <> 0
            Trapeze::CreerTrapeze(#Trapeze,ValD(GetGadgetText(#Str_Cote_1_Trapeze)),
                                  ValD(GetGadgetText(#Str_Cote_2_Trapeze)),
                                  ValD(GetGadgetText(#Str_Cote_3_Trapeze)),
                                  ValD(GetGadgetText(#Str_Cote_4_Trapeze)),
                                  ValD(GetGadgetText(#Str_Hauteur_Trapeze)))
            SetGadgetText(#Str_Longueur_Mediane_Trapeze, StrD(Trapeze::*Trapeze\Longueur_Mediane))
            SetGadgetText(#Str_Perimetre_Trapeze, StrD(Trapeze::*Trapeze\Perimetre))
            SetGadgetText(#Str_Surface_Trapeze, StrD(Trapeze::*Trapeze\Surface))
          EndIf  
            
      EndSelect ; Fin EvenementGadget
      ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    Case #PB_Event_CloseWindow
      EvenementFenetre = EventWindow()
      Select EvenementFenetre
        Case #Fenetre_Geometrie
          CloseWindow(#Fenetre_Geometrie)
          Break
        Case #Fenetre_Carre
          CloseWindow(#Fenetre_Carre)
          Ouvrir_Fenetre_Geometrie()
        Case #Fenetre_Cercle
          CloseWindow(#Fenetre_Cercle)
          Ouvrir_Fenetre_Geometrie()
        Case #Fenetre_Rectangle
          CloseWindow(#Fenetre_Rectangle)
          Ouvrir_Fenetre_Geometrie()
        Case #Fenetre_Anneau
          CloseWindow(#Fenetre_Anneau)
          Ouvrir_Fenetre_Geometrie()
        Case #Fenetre_TriangleR
          CloseWindow(#Fenetre_TriangleR)
          Ouvrir_Fenetre_Geometrie()
        Case #Fenetre_Losange
          CloseWindow(#Fenetre_Losange)
          Ouvrir_Fenetre_Geometrie()
        Case #Fenetre_Parallelogramme
          CloseWindow(#Fenetre_Parallelogramme)
          Ouvrir_Fenetre_Geometrie()
        Case #Fenetre_Trapeze
          CloseWindow(#Fenetre_Trapeze)
          Ouvrir_Fenetre_Geometrie()
      EndSelect
      ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  EndSelect
ForEver
End

Re: Comment faire une entrée strictement décimale

Publié : dim. 07/déc./2014 15:18
par falsam
Peut être le topic de Lord Nelson ?
http://www.purebasic.fr/french/viewtopi ... =6&t=14974

Re: Comment faire une entrée strictement décimale

Publié : dim. 07/déc./2014 15:33
par Micoute
Falsam tu pourrais être plus sérieux !

Re: Comment faire une entrée strictement décimale

Publié : dim. 07/déc./2014 15:57
par kernadec
bonjour Micoute
Perso le code posté par "skywalk" c'est celui que j'utilise depuis 2010, je pense qu'il te plaira aussi

Code : Tout sélectionner

http://www.purebasic.fr/english/viewtopic.php?f=3&t=60510
Cordialement

Re: Comment faire une entrée strictement décimale

Publié : dim. 07/déc./2014 16:05
par Micoute
Merci beaucoup Kernadec.

Re: Comment faire une entrée strictement décimale

Publié : dim. 07/déc./2014 16:07
par Marc56
J'aime bien celui-là (sur la même page)

Proposé par Danilo, repris du forum Allemand

J'ai modifié l'expression régulière pour qu'il accepte le point aussi bien que la virgule comme séparateur numérique
J'ai remplacé \, par [\,\.] :wink:

Code : Tout sélectionner

;
; by Danilo
;
; http://www.purebasic.fr/german/viewtopic.php?f=16&t=26388&start=7
;
; Nummern-Eingabe Beispiele: 123  567,88  -12  -4,5
;
OpenWindow(0, #PB_Ignore, #PB_Ignore, 250, 80, "")
StringGadget(0, 10, 10, 200, 20, "")

CreateRegularExpression(0,"^\-{0,1}\d*$|^\-{0,1}\d+[\,\.]\d{0,2}$|^$") ; ^       = Anfang des Strings
                                                                   ; $       = Ende des Strings
                                                                   ; \d      = Dezimalzahl 0-9
                                                                   ; +       = 1 oder mehr Vorkommen
                                                                   ; *       = 0 oder mehr Vorkommen
                                                                   ; |       = alternative Moeglichkeit (Or in PureBasic)
                                                                   ; \,      = Komma
                                                                   ; \-{0,1} = Minus{0 oder 1 mal}
                                                                   ; \d{0,2} = Dezimalzahl 0-9 { 0 bis 2 mal }
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_Gadget
      If EventGadget() = 0 And EventType() = #PB_EventType_Change
        txt$ = GetGadgetText(0)
        If MatchRegularExpression(0,txt$)=0                           ; wenn kein Treffer, dann wieder vorherigen text setzen
          SendMessage_(GadgetID(0),#EM_GETSEL,0,@endpos) : endpos - 1 ; cursor position holen
          SetGadgetText(0,old$)                                       ; alten text wieder setzen
          SendMessage_(GadgetID(0),#EM_SETSEL,endpos,endpos)          ; cursor position wieder setzen
        Else
          old$ = txt$
        EndIf
      EndIf
  EndSelect
ForEver

Re: Comment faire une entrée strictement décimale

Publié : dim. 07/déc./2014 16:07
par falsam
Ce code que j'ai utilisé quelques temps permet d'être informer visuellement qu'un nombre est numérique/décimal (vert) ou pas (rouge)

Subclasser le string gadget afin de contrôler la saisie avant de l'afficher me parait une meilleure solution.

Re: Comment faire une entrée strictement décimale

Publié : dim. 07/déc./2014 16:21
par kernadec
bonjour
c'est vrai tu as raison falsam
j' utilisais celui de skywalk et je ne cherchais plus à régler ce problème, et donc ! j'ai raté ce code :D

Cordialement

Re: Comment faire une entrée strictement décimale

Publié : dim. 07/déc./2014 16:35
par falsam
C'est nico qui m'a fait découvrir cette technique.

J'avais fait ceci il y a 4 ans. je connaissais à peine PureBasic.

Code : Tout sélectionner

; StrMaskDec - V1.00
;
;Using : StrMaskDec(Gadget,IntegerLenght,DecimalLenght)
;
;Compatibility : Windows 
;
Procedure StrMaskDec(Gadget,IntegerLenght,DecimalLenght)
  ValText.s  ;String Value 
  ValASCII.b ;ASCII Value
  PartEnt.s   ;Integer Value
  PartDec.s  ;Décimal Value
  x.b           ;Longueur de la chaine en cours de saisie
  y.b           ;Position du point decimal
  
  ValText=GetGadgetText(gadget)
  
  Select EventType()
    Case #PB_EventType_Focus 
      ;Le texte de l'edit control est selectionné totalement
      SendMessage_(GadgetID(Gadget), #EM_SETSEL, 0, -1)  
      
    Case #PB_EventType_LostFocus
      ;Il est temps de mettre en forme le résultat
      
      x = Len(ValText) 
      y = FindString(ValText,".",1)
      
      If y<>0
        PartEnt=Left(ValText,y-1)
        If PartEnt=""
          PartEnt="0"
        EndIf
        PartDec=Right(ValText,x-y)
        SetGadgetText(Gadget,PartEnt+"."+LSet(PartDec,Len(PartDec)+(DecimalLenght-Len(PartDec)),"0"))
      Else
        SetGadgetText(Gadget,ValText+"."+LSet("0",DecimalLenght,"0"))
      EndIf
  
    Case #PB_EventType_Change 
      ;Il y a du changement dans notre string 
      x=Len(ValText)
      y = FindString(ValText,".",1)
      
      ;Seul les caractéres de 0 à 9 ainsi que le point décimal sont autorisés
      ValASCII = Asc(Right(GetGadgetText(Gadget),1))  
      
      Select ValASCII 
        Case 46
          ;Un point est saisi. On teste qu'il y en a bien qu'un seul
          If CountString(GetGadgetText(Gadget),".")>1
             keybd_event_(#VK_BACK,0,0,0)
          EndIf
            
        Case 48 To 57 
          ; Chiffres de 0 à 9
          ;Il y a t'il un point decimal et en quelle position
          y = FindString(ValText,".",1)
                    
          If y>0
              ;La taille de la partie entiére ne doit etre > à celle autorisée (IntegerLenght)
              If Len(Left(ValText,y-1))>IntegerLenght
                keybd_event_(#VK_BACK,0,0,0)
              EndIf
              
              ;La taille de la partie décimale ne doit etre > à celle autorisée (DecimalLenght)
              If Len(Right(ValText,x-y))>DecimalLenght
                keybd_event_(#VK_BACK,0,0,0)
              EndIf
              
            Else
      
              ;Pas de partie decimale pour le moment dans notre saisie
              ;La taille de la partie entiére ne doit etre > à celle autorisée (IntegerLenght)
              If Len(ValText)>IntegerLenght
                keybd_event_(#VK_BACK,0,0,0)
              EndIf      
          EndIf
            
        Default 
            ;Ce n'est pas des chiffres 
            keybd_event_(#VK_BACK,0,0,0)
              
        EndSelect
  EndSelect
EndProcedure


;-Zone de test
Enumeration
  #MainForm
  #MntHt
  #MntTtc
EndEnumeration

Procedure MainFormShow()
  If OpenWindow(#MainForm,0,0,400,150,"Nouvelle application",#PB_Window_ScreenCentered |#PB_Window_SizeGadget | #PB_Window_SystemMenu)
  
  TextGadget(#PB_Any,10,23,80,23,"Montant Ht")
  StringGadget(#MntHt,100,20,80,23,"0.00",#ES_RIGHT) 
  
  TextGadget(#PB_Any,10,43,80,23,"Montant Ttc")
  StringGadget(#MntTtc,100,40,80,23,"0.00",#PB_String_ReadOnly | #ES_RIGHT)
  SetGadgetColor(#MntTtc,#PB_Gadget_BackColor,$F9F9F9)
  TextGadget(#PB_Any,200,43,80,23,"Taux 19,60%")
  
  SetActiveGadget(#MntHt)
  EndIf
EndProcedure

Procedure CalculTTC()
  MntHt.f=ValF(GetGadgetText(#MntHt))
  MntTtc.f=MntHt*(1.196)
  SetGadgetText(#MntTtc,StrD(MntTtc,2))
EndProcedure

MainFormShow()

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      End
      
    Case #PB_Event_Gadget
      If EventGadget() = #MntHt
        StrMaskDec(#MntHt,5,2)
        CalculTTC()
      EndIf
    
  EndSelect
ForEver
Nico m'a conseillé de ne pas utiliser cette méthode en me préconisant l'utilisation d'un subclassing de stringgadget.
nico a écrit :Je serais toi, j'éviterais ce genre d'instruction.

Sinon, il aurait été plus judicieux de faire un Subclassing de l'Edit ; ainsi tu gère l'affichage des caractères avant que celles-ci s'affichent.
Sub quoi ? Meme pas une explication ? Qu'est qu'il dit le Nico ? 8O haha

J'avoue que par la suite j'ai continué à utiliser ma méthode.

Re: Comment faire une entrée strictement décimale

Publié : dim. 07/déc./2014 18:56
par TazNormand
Salut

un exemple de "subclassing" trouvé sur le forum anglais sur ce lien, et en particulier pour Micoute, ce message de RASHAD

Code : Tout sélectionner

If OpenWindow(0, 0, 0, 400, 200, "Test",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
		
	StringGadget(0,10,10,180, 24, "")
	StringGadget(1,210,10,180, 24, "")
	
	Repeat
		Select WaitWindowEvent()
		
			Case #PB_Event_Menu
;
					
			Case #PB_Event_CloseWindow
					Quit = 1
			
			Case #PB_Event_Gadget
	
				Select EventGadget()
					Case 0
								Select EventType()
										Case #PB_EventType_Focus
												AddKeyboardShortcut(0, #PB_Shortcut_A, 15)
												AddKeyboardShortcut(0, #PB_Shortcut_Shift|#PB_Shortcut_A, 16)
												AddKeyboardShortcut(0, #PB_Shortcut_B, 17)
												
										Case #PB_EventType_LostFocus
												RemoveKeyboardShortcut(0,#PB_Shortcut_A)
												RemoveKeyboardShortcut(0,#PB_Shortcut_Shift|#PB_Shortcut_A)
												RemoveKeyboardShortcut(0,#PB_Shortcut_B)
												
								EndSelect
								
					Case 1

				EndSelect

		EndSelect

	Until Quit = 1

EndIf

End
ou ce code sur le forum Pureboard

Code : Tout sélectionner

;
; by Danilo
;
; http://www.purebasic.fr/german/viewtopic.php?f=16&t=26388&start=7
;
; Nummern-Eingabe Beispiele: 123  567,88  -12  -4,5
;
OpenWindow(0, #PB_Ignore, #PB_Ignore, 250, 80, "")
StringGadget(0, 10, 10, 200, 20, "")

CreateRegularExpression(0,"^\-{0,1}\d*$|^\-{0,1}\d+\,\d{0,2}$|^$") ; ^       = Anfang des Strings
																																		; $       = Ende des Strings
																																		; \d      = Dezimalzahl 0-9
																																		; +       = 1 oder mehr Vorkommen
																																		; *       = 0 oder mehr Vorkommen
																																		; |       = alternative Moeglichkeit (Or in PureBasic)
																																		; \,      = Komma
																																		; \-{0,1} = Minus{0 oder 1 mal}
																																		; \d{0,2} = Dezimalzahl 0-9 { 0 bis 2 mal }
Repeat
	Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			Break
		Case #PB_Event_Gadget
			If EventGadget() = 0 And EventType() = #PB_EventType_Change
				txt$ = GetGadgetText(0)
				If MatchRegularExpression(0,txt$)=0                           ; wenn kein Treffer, dann wieder vorherigen text setzen
					SendMessage_(GadgetID(0),#EM_GETSEL,0,@endpos) : endpos - 1 ; cursor position holen
					SetGadgetText(0,old$)                                       ; alten text wieder setzen
					SendMessage_(GadgetID(0),#EM_SETSEL,endpos,endpos)          ; cursor position wieder setzen
				Else
					old$ = txt$
				EndIf
			EndIf
	EndSelect
ForEver

Re: Comment faire une entrée strictement décimale

Publié : dim. 07/déc./2014 19:23
par nico
En se passanr des API, on faire un truc de ce genre:

Code : Tout sélectionner

;-Zone de test
Enumeration
  #MainForm
  #MntHt
  #MntTtc
EndEnumeration


Procedure StrMaskDec(Gadget.l, MaxNumAutorise.f, DecimalAutorise.l)
  Protected Texte.s
  Protected AffichageParDefaut.s ="0"
  Protected TexteDecimale.s
  Protected Erreur.b = 0
  Protected LenTexte.l
  Protected TexteAutorise.s = ".0123456789"
  Protected LenDecimal.l
  Protected MaxNum.f
  
  Texte.s = GetGadgetText(Gadget)
  LenTexte = Len(Texte)
  
  PosPoint = CountString(Texte, ".")
  If PosPoint > 1
    Goto Reset
  Else
    PosPoint = FindString(Texte, ".")
  EndIf
  
  For a = 1 To LenTexte
    Caratere.s = Mid(Texte, a, 1)
    If FindString(TexteAutorise, Caratere) = 0
      Erreur = 1
      Break
    EndIf 
  Next
  
  If Erreur = 1
    Goto Reset
  EndIf
  
  If PosPoint
    LenDecimal = LenTexte - PosPoint
    If LenDecimal > DecimalAutorise
      Goto Reset
    EndIf
  EndIf 
  
  MaxNum = ValF(Texte)
  If MaxNum > MaxNumAutorise
    Goto Reset
  EndIf
  
  Goto Continu
  
  Reset:
  If DecimalAutorise > 0
    TexteDecimale = " et pas plus de " + Str(DecimalAutorise) + " décimale(s)"
    AffichageParDefaut = "0."
    For a = 1 To DecimalAutorise
      AffichageParDefaut = AffichageParDefaut + "0"
    Next
  EndIf 
  
  MessageRequester("Attention", "Vous devez entrer un nombre entre 0 et " + Str(MaxNumAutorise) + TexteDecimale)
  SetGadgetText(#MntHt, AffichageParDefaut)
  
  Continu:
EndProcedure


Procedure CalculTTC()
  MntHt.f=ValF(GetGadgetText(#MntHt))
  MntTtc.f=MntHt*(1.196)
  SetGadgetText(#MntTtc,StrD(MntTtc,2))
EndProcedure


Procedure MainFormShow()
  If OpenWindow(#MainForm,0,0,400,150,"Nouvelle application",#PB_Window_ScreenCentered |#PB_Window_SizeGadget | #PB_Window_SystemMenu)
    
    TextGadget(#PB_Any,10,23,80,23,"Montant Ht")
    StringGadget(#MntHt,100,20,80,23,"0.00",#ES_RIGHT) 
    
    TextGadget(#PB_Any,10,47,80,23,"Montant Ttc")
    StringGadget(#MntTtc,100,44,80,23,"0.00",#PB_String_ReadOnly | #ES_RIGHT)
    SetGadgetColor(#MntTtc,#PB_Gadget_BackColor,$F9F9F9)
    TextGadget(#PB_Any,200,43,80,23,"Taux 19,60%")
    
    SetActiveGadget(#MntHt)
  EndIf
EndProcedure

MainFormShow()

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      End
      
    Case #PB_Event_Gadget
      Select  EventGadget()
        Case #MntHt
          Select EventType()
            Case #PB_EventType_Change 
              StrMaskDec(#MntHt,1254, 2)
              CalculTTC()
          EndSelect
      EndSelect
  EndSelect
ForEver

Re: Comment faire une entrée strictement décimale

Publié : dim. 07/déc./2014 20:55
par Lord Nelson
Ou tous simplement:

Code : Tout sélectionner

Procedure.l IsNumerique(Chaine$)

  If Chaine$ = "" Or Chaine$ = "."
    ProcedureReturn #False
  EndIf

  For Caractere = 0 To 255
   
    Select Caractere
       
      Case 0 To 45, 47, 58 To 255
       
        If FindString(Chaine$, Chr(Caractere), 1)
          ProcedureReturn #False
        EndIf
       
    EndSelect
   
  Next

  If CountString(Chaine$, ".") > 1
    ProcedureReturn #False
  EndIf

  ProcedureReturn #True
EndProcedure

If OpenWindow(0, 0, 0, 322, 205, "Entrez un nombre", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  StringGadget(1, 8,  35, 306, 20, "")
 
  Repeat
   
    Evenement = WaitWindowEvent(1)
    EventType = EventType()
   
    If EventType = #PB_EventType_Change
     
      Chaine$ = GetGadgetText(1)
     
      If Not IsNumerique(Chaine$)
       
        If SauvegardeChaine$ > ""
         
          If Chaine$ = ""
            SauvegardeChaine$ = ""
          EndIf
         
          SetGadgetText(1, SauvegardeChaine$)
         
          keybd_event_(#VK_END,0,0,0)
          keybd_event_(#VK_END,0,2,0)
         
        Else
          SetGadgetText(1, "")
         
        EndIf
       
      Else
       
        SauvegardeChaine$ = Chaine$
       
      EndIf
     
    EndIf
   
  Until Evenement = #PB_Event_CloseWindow
 
EndIf

Re: Comment faire une entrée strictement décimale

Publié : dim. 07/déc./2014 21:34
par falsam
@Nico: Merci pour la reprise de mon code le rendant ainsi multiplate-forme :)

Re: Comment faire une entrée strictement décimale

Publié : lun. 08/déc./2014 2:07
par falsam
Micoute a écrit :Falsam tu pourrais être plus sérieux !
J'ai vu pas mal de code défiler dans ce topic alors tu ne m'en voudras pas si j'en ajoute une.
:arrow: http://www.purebasic.fr/french/viewtopi ... =1&t=14977

:)

Re: Comment faire une entrée strictement décimale

Publié : lun. 08/déc./2014 9:14
par Micoute
Bonjour falsam et merci pour ce code, c'est quand même autre chose que ce que tu m'avais proposé, car ce qui compte pour moi, c'est qu'il ne laisse pas passer les lettres !
Fuseau horaire sur UTC+01:00
Page 1 sur 2

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru