Il arrive parfois que l'on désire faire des calculs dynamiquement en fonction d'une chaîne de caractères.
Exemple: Vous voulez donner la possibilité à votre utilisateur final de faire un calcul directement dans un champ. Ce petit module va vous donné ce genre de possibilités.
Note: Actuellement les parenthèses ne sont pas supportées et il peut y avoir des bugs, donc n'hésitez pas à me les signaler
Code du module
Code : Tout sélectionner
;************************************************************************************************************************
; Author : MicrodevWeb
; Project Name : DinaCal
; Description : Calcul dynamique en fonction d'une chaine de caractères
; File Name : dinaCal.pbi
; Version: B0.01 Date of begin : 2016/04/11
;************************************************************************************************************************
DeclareModule dinaCal
;-* PUBLIC gloabl declaration
Declare.d Calcul(operation.s)
;}
EndDeclareModule
Module dinaCal
EnableExplicit
;-* PRIVATE global variable
Global gNbrOpenedBracquet
Global gNbrClosedBracuet
Global gOperation.s
;}
;-* LOCAL declaration
Declare GetNbrBraquet()
Declare AvailableCalcul()
Declare.d CalculOperation(operation.s)
Declare.d GetResultat(ValR.d,ValL.d,Operator.s)
;}
;-* PRIVATE procedure
Procedure GetNbrBraquet()
gNbrOpenedBracquet=CountString(gOperation,"(")
gNbrClosedBracuet=CountString(gOperation,")")
If gNbrOpenedBracquet<>gNbrClosedBracuet
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
Procedure AvailableCalcul()
; On remplace les virgules par des points
ReplaceString(gOperation,",",".")
; On supprime tous les espaces
RemoveString(gOperation,Chr(32))
; Lst caractère autorisé
Protected AvailableCaracter.s="0,1,2,3,4,5,6,7,8,9,.,+,-,*,/,(,)"
Protected N
For N=1 To Len(gOperation)
If Not FindString(AvailableCaracter,Mid(gOperation,N,1))
ProcedureReturn #False
EndIf
Next
ProcedureReturn #True
EndProcedure
Procedure.d GetResultat(ValR.d,ValL.d,Operator.s)
Select Operator
Case "+"
ProcedureReturn ValL+ValR
Case "-"
ProcedureReturn ValL-ValR
Case "/"
ProcedureReturn ValL/ValR
Case "*"
ProcedureReturn ValL*ValR
EndSelect
EndProcedure
Procedure.d CalculOperation(operation.s)
Protected AvailableCaracter.s="0,1,2,3,4,5,6,7,8,9"
Dim aOperator.s(3)
aOperator(0)="+"
aOperator(1)="-"
aOperator(2)="*"
aOperator(3)="/"
Structure Operator
Operator.s
LefNumber.d
RigthNumber.d
EndStructure
Protected NewList myLstOperation.Operator()
;{ Vérifie que le premier et le dernier caractère sont bien des chiffre
If FindString(AvailableCaracter,Left(operation,1))=0
ProcedureReturn -1
EndIf
If FindString(AvailableCaracter,Right(operation,1))=0
ProcedureReturn -1
EndIf
;}
; On part de la fin de chaine
Protected Start=Len(operation),valRet.d
Protected RNumberTxt.s,LNumberTxt.s,N,Noperateur,OperatorPosition,B,tmpTxt.s
; Cherche un opérateur
RNumberTxt=""
For N=Start To 1 Step -1
; Regarde si sur un opérateur
For Noperateur=0 To 3
If Mid(operation,N,1)=aOperator(Noperateur)
OperatorPosition=N
;{ Recherhce le numéro de droite
RNumberTxt=""
For B=OperatorPosition+1 To Len(operation)
If FindString(AvailableCaracter,Mid(operation,B,1)) Or Mid(operation,B,1)="."
RNumberTxt+Mid(operation,B,1)
Else
Break
EndIf
Next
; Vérifie qu'il n'y a pas de point en début ou à la fin
If Left(RNumberTxt,1)="." Or Right(RNumberTxt,1)="."
ProcedureReturn -1
EndIf
;}
;{ Recherche le numéro de gauche
tmpTxt=""
LNumberTxt=""
For B=OperatorPosition-1 To 1 Step -1
If FindString(AvailableCaracter,Mid(operation,B,1)) Or Mid(operation,B,1)="."
tmpTxt+Mid(operation,B,1)
Else
Break
EndIf
Next
; Inverse la chaine de caractères
For B=Len(tmpTxt) To 1 Step -1
LNumberTxt+Mid(tmpTxt,B,1)
Next
AddElement(myLstOperation())
With myLstOperation()
\LefNumber=ValD(LNumberTxt)
\RigthNumber=ValD(RNumberTxt)
\Operator=aOperator(Noperateur)
EndWith
Break
EndIf
Next
Next
Protected NbOp=ListSize(myLstOperation()),tmpRes.d
N=0
ForEach myLstOperation()
N+1
With myLstOperation()
;Sur la première opération
If N=1
valRet=GetResultat(\RigthNumber,\LefNumber,\Operator)
Else
tmpRes=GetResultat(valRet,\LefNumber,\Operator)
valRet=tmpRes
EndIf
EndWith
Next
ProcedureReturn valRet
EndProcedure
;}
;-* PUBLIC procedure
Procedure.d Calcul(operation.s)
Protected result.d
gOperation=operation
If operation="":ProcedureReturn -1 :EndIf
If Not GetNbrBraquet():ProcedureReturn -1 :EndIf
If Not AvailableCalcul():ProcedureReturn -1 :EndIf
;{ Calcul sans Bracket
If gNbrOpenedBracquet=0
result=CalculOperation(operation)
ProcedureReturn result
EndIf
;}
ProcedureReturn -1
EndProcedure
;}
EndModule
Code : Tout sélectionner
;************************************************************************************************************************
; Author : MicrodevWeb
; Project Name : DinaCal
; Description : Testing DinaCal
; File Name : main.pb
; Version: B0.01 Date of begin : 2016/04/11
;************************************************************************************************************************
;-* INIT programme
EnableExplicit
XIncludeFile "dinaCal.pbi"
Enumeration
#MainFont
#MainForm
#MainTxtOperation
#MainTxtResult
#MainStrOperation
#MainStrResult
#MainBtExit
EndEnumeration
LoadFont( #MainFont,"Arial",12,#PB_Font_HighQuality)
Global gTitle.s="Teste Calcul dynamique"
;}
;-* DECLARATION
Declare Exit()
Declare OpenMainForm()
Declare EventMainStrOperation()
;}
;-* PROCEDURE
Procedure Exit()
End
EndProcedure
Procedure EventMainStrOperation()
Protected result.d
result=dinaCal::Calcul(GetGadgetText(#MainStrOperation))
If result<>-1 ; L'opération est valide
SetGadgetText(#MainStrResult,StrD(result,2))
SetGadgetColor(#MainTxtResult,#PB_Gadget_FrontColor,#PB_Default)
Else ; L'opération n'est pas valide
SetGadgetText(#MainStrResult,"")
SetGadgetColor(#MainTxtResult,#PB_Gadget_FrontColor,RGB(255, 0, 0))
EndIf
EndProcedure
Procedure OpenMainForm()
Protected flag=#PB_Window_SystemMenu|#PB_Window_ScreenCentered
Protected WF=400,N
Protected M=10,X=M,Y=M,W=WF-(M*2),H=30
Protected HF=(H*5)+(M*4)
; Ouverture de la fenêtre
OpenWindow(#MainForm,0,0,WF,HF,gTitle,flag)
;{ Mise en place des gadgets
TextGadget(#MainTxtOperation,X,Y,W,H,"Opération")
Y+H
StringGadget(#MainStrOperation,X,Y,W,H,"")
Y+H+M
TextGadget(#MainTxtResult,X,Y,W,H,"Résultat")
Y+H
StringGadget(#MainStrResult,X,Y,W,H,"")
DisableGadget(#MainStrResult,#True)
Y+H+M
ButtonGadget(#MainBtExit,X,Y,W,H,"Quitter")
; Attribue une police au gadgets
For N=#MainTxtOperation To #MainBtExit
SetGadgetFont(N,FontID(#MainFont))
Next
;}
;{ CallBack de la fenêtre
BindEvent(#PB_Event_CloseWindow,@Exit(),#MainForm)
BindGadgetEvent(#MainBtExit,@Exit())
BindGadgetEvent(#MainStrOperation,@EventMainStrOperation())
;}
SetActiveGadget(#MainStrOperation)
EndProcedure
;}
;{ START
OpenMainForm()
;}
;{ MAIN LOOP
Repeat:WaitWindowEvent():ForEver
;}
