oW! It's very cool! A strange subject.
Welcome Trevor! I was searching a place to post my code. I think it's a good place...
I don't know if you already went to friends with a wine bottle and they surprised you not drinking directly the bottle but waiting one year before. The reason is sometime a wine could be better if we know to wait.
This code is like such a bottle I think. It's a little present! Because now, we start a new year, so it's a good occasion to publish it. But it's too complex to learn its internal algo during only one hour, one day or one week...
Maybe you'll have the pleasure to understand it very correctly in... one year, I hope... (it's less that the time I need to learn english language)
So, welcome here.
Code: Select all
; Actually for Windows only
; By Ollivier
Global.S Message, Tabulation = "§§", Name = "EquationTest", Expr
Global.S TempDir
TempDir = GetTemporaryDirectory()
Global Cpl, Trust, Margin, MarginWidth = 8, ShutDown
Global NewList MathFunction.S()
Procedure Fatal(Message.S)
MessageRequester("Erreur fatale", Message + Chr(10) + Chr(10) + "Cliquez sur [Ok] pour quitter...")
End
EndProcedure
Procedure.S GetMessage(Rank.I, NoUpdate.I = 0)
If Not NoUpdate
Message = ReadProgramString(Cpl)
EndIf
ProcedureReturn StringField(Message, Rank, Chr(9) )
EndProcedure
Procedure SetMessage(MyMessage.S)
Protected Field.S
Message = ""
MyMessage = ReplaceString(MyMessage, Tabulation, Chr(9) )
For I = 0 To CountString(MyMessage, Chr(9) )
Field = StringField(MyMessage, I + 1, Chr(9) )
If I = 0
Field = UCase(Field)
Else
Message + Chr(9)
EndIf
Message + Trim(Field)
Next I
If ProgramRunning(Cpl)
WriteProgramStringN(Cpl, Message)
EndIf
EndProcedure
Procedure Type(MyLine.S)
MyLine = ReplaceString(MyLine, "¤", Chr(34) )
WriteStringN(Trust, Space(MarginWidth * Margin) + MyLine)
EndProcedure
Procedure LogOn()
Cpl = RunProgram("PBCompiler.EXE", "/STANDBY", #PB_Compiler_Home + "\Compilers", #PB_Program_Open | #PB_Program_Read | #PB_Program_Write | #PB_Program_Hide)
If Not Cpl
Fatal("Compilateur non trouvé !")
EndIf
GetMessage(3)
If GetMessage(1) <> "READY"
Fatal("Compilateur non conforme !")
EndIf
EndProcedure
Procedure LogOff()
SetMessage("end")
EndProcedure
Global.S Base
Global Margin = 16, ScreenHeight = 48, ButtonWidth = 48, ButtonHeight = 32
Global ButtonQty, ButtonInter = 8, Rank
Procedure.S Beta(Expr.S)
Protected Result.S
Trust = CreateFile(#PB_Any, TempDir + Name + ".PB")
Type("OpenConsole()")
Type("Global PrivateExpression.S")
Type("Global PrivateMessage.S")
Type("PrivateExpression = StrD(" + Expr + ")")
Type("PrivateMessage = Input()")
Type("PrintN(PrivateExpression)")
Type("CloseConsole()")
CloseFile(Trust)
SetMessage("source §§ " + TempDir + Name + ".PB")
SetMessage("target §§ " + TempDir + Name + ".EXE")
SetMessage("compile")
If GetMessage(1) = "SUCCESS"
Trust = RunProgram(TempDir + Name + ".EXE", "", "", #PB_Program_Open | #PB_Program_Read | #PB_Program_Write | #PB_Program_Hide)
WriteProgramStringN(Trust, "")
Result = ReadProgramString(Trust)
Else
Result = ""
While GetMessage(1) <> "OUTPUT"
Result + GetMessage(2, 1) + Chr(10)
Wend
EndIf
ProcedureReturn Result
EndProcedure
Procedure MainProcess()
Protected.S Title, MyString, More
Protected.I ButtonCount, ScreenG, MyVar, Num, SigleOp = 39
Protected Selec.CHARRANGE
SetMessage("functionlist")
GetMessage(1)
While GetMessage(1) <> "OUTPUT"
AddElement(MathFunction() )
MathFunction() = Trim(StringField(GetMessage(1, 1), 1, "-") )
Wend
ForEach MathFunction()
SetMessage("helpdirectory §§ " + StringField(MathFunction(), 1, "(") )
If Base = ""
Base = GetMessage(1)
Else
If Base <> GetMessage(1)
DeleteElement(MathFunction(), 1)
EndIf
EndIf
Next
ButtonQty = 19 + ListSize(MathFunction() )
Rank = ButtonQty / 5 + 1
InnerWidth = 2 * Margin + Rank * ButtonWidth + (Rank - 1) * ButtonInter
InnerHeight = 3 * Margin + ScreenHeight + 5 * ButtonHeight + (5 - 1) * ButtonInter
CalcWin = OpenWindow(#PB_Any, 0, 0, InnerWidth, InnerHeight, "Calculatrice", $CF0001)
ScreenG = EditorGadget(-1, Margin, Margin, InnerWidth - 2 * Margin, ScreenHeight)
ResetList(MathFunction() )
ButtonCount = 0
MyVar = 7
For J = 0 To (Rank - 1)
For I = 0 To 4
If NextElement(MathFunction() )
Title = StringField(MathFunction(), 1, " ") + "("
Else
If (I > 0) And (I < 4) And (J < (Rank - 1) ) And (J => (Rank - 4) )
Num = 1
Else
Num = 0
If Title = "1"
Title = "0"
Else
Title = "X"
EndIf
EndIf
If Num
Title = Chr(48 + MyVar)
MyVar - 3
If MyVar < 1
MyVar + 10
EndIf
EndIf
EndIf
If ButtonCount => ButtonQty
Y = 2 * Margin + ScreenHeight + (ButtonHeight + ButtonInter) * I
ButtonGadget(-1, Margin + (ButtonWidth + ButtonInter) * J, Y, ButtonWidth, InnerHeight - Margin - Y, "=")
Break 2
EndIf
If Title = "X"
Title = Chr(SigleOp)
If SigleOp = 39
Title = "C"
EndIf
SigleOp + 1
EndIf
ButtonGadget(Zen, Margin + (ButtonWidth + ButtonInter) * J, 2 * Margin + ScreenHeight + (ButtonHeight + ButtonInter) * I, ButtonWidth, ButtonHeight, Title)
Zen + 1
ButtonCount + 1
Next
Next
Repeat
Evt = WaitWindowEvent()
If GetActiveGadget() <> ScreenG
Repeat
Delay(1)
Evt = WindowEvent()
Until Evt = #PB_Event_Gadget
ButtonNo = EventGadget()
More = GetGadgetText(ButtonNo)
If Right(More, 1) = "(" And Len(More) > 1
SelectElement(MathFunction(), ButtonNo)
SetWindowTitle(CalcWin, MathFunction() )
Else
SetWindowTitle(CalcWin, "Calculatrice")
EndIf
If More <> "="
If Ghost
Ghost = 0
If ((Asc(More) => 48) And (Asc(More) <= 57) ) Or Right(More, 1) = "("
SetGadgetText(ScreenG, "")
EndIf
EndIf
SendMessage_(GadgetID(ScreenG), #EM_EXGETSEL, #Null, @Selec)
SetGadgetText(ScreenG, GetGadgetText(ScreenG) + More)
Selec\cpMin + Len(More)
Selec\cpMax = Selec\cpMin
SendMessage_(GadgetID(ScreenG), #EM_EXSETSEL, #Null, @Selec)
Else
SetGadgetText(ScreenG, Beta(GetGadgetText(ScreenG) ) )
Ghost | 1
EndIf
If More = "C"
SetGadgetText(ScreenG, "")
EndIf
SetActiveGadget(ScreenG)
EndIf
Until Evt = #PB_Event_CloseWindow
EndProcedure
LogOn()
MainProcess()
LogOff()
End
?
We all are in one way or another!
Those people are rooted out by the more paranoid among us (OK I am one of the "paraniods!") and ignored.