-
Notifications
You must be signed in to change notification settings - Fork 5
/
Copy pathFM.PAS
112 lines (106 loc) · 3.21 KB
/
FM.PAS
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Program FormuleMathematique;
{$I DEF.INC}
Uses {$IFDEF Adele}Adele,{$ELSE}Chantal,{$ENDIF}
Systex,Isatex,Systems,Video,Mouse,Dials,Numerix;
Const mF2C=1;
mComputeASCII=2;
mComputeRoman=3;
Var K:Wd;L:LstMnu;W:Wins;
Procedure ComputeRoman;Var W:Wins;K,I:Wd;Sm:Long;PC:PChr;PBuf:Array[Byte]of Char;S:String;Begin
WEInitO(W,60,11);
WEPushWn(W);
WEPutWnKrDials(W,'Sommation Romaine');
PC:=@PBuf;FillClr(PBuf,SizeOf(PBuf));
WEPutTxtLn(W,'Entrez la chaŒne de caractŠres … analyser:');
WEBarSpcHorShade(W,0,2,wnMax);
WESetInpColrs(W,$8F,W.XColrs.Sel);
K:=_WEInput(W,0,2,wnMax-1,200,PC);
If(K=kbEsc)Then Begin;WEDone(W);Exit;End;
WESetKr(W,$8F);
WEBarSelHor(W,0,2,wnMax-1);
WESetKrHigh(W);
S:=StrUp(StrPas(PC));Sm:=0;W.Y:=5;
For I:=1to Length(S)do If IsRomanLetter(S[I])Then Inc(Sm,Byte(UpCase(S[I]))-64);
S:=Str(Sm);Sm:=0;
For I:=1to Length(S)do Inc(Sm,Byte(S[I])-48);
WEPutTxtLn(W,'La somme est '+S);
WEPutTxt(W,'D‚composition de la somme est ');
For I:=1to Length(S)do Begin
WEPutCube(W,S[I]);
If I<>Length(S)Then WEPutCube(W,'+');
End;
WEPutCube(W,'=');
WEPutTxt(W,Str(Sm));
While WEOk(W)do;
End;
Procedure ComputeASCII;Var W:Wins;K,I:Wd;Sm:Long;PC:PChr;PBuf:Array[Byte]of Char;S:String;Begin
WEInitO(W,60,11);
WEPushWn(W);
WEPutWnKrDials(W,'Sommation ASCII');
PC:=@PBuf;FillClr(PBuf,SizeOf(PBuf));
WEPutTxtLn(W,'Entrez la chaŒne de caractŠres … analyser:');
WEBarSpcHorShade(W,0,2,wnMax);
WESetInpColrs(W,$8F,W.XColrs.Sel);
K:=_WEInput(W,0,2,wnMax-1,200,PC);
If(K=kbEsc)Then Begin;WEDone(W);Exit;End;
WESetKr(W,$8F);
WEBarSelHor(W,0,2,wnMax-1);
WESetKrHigh(W);
S:=StrPas(PC);Sm:=0;W.Y:=5;
For I:=1to Length(S)do Inc(Sm,Byte(S[I]));
S:=Str(Sm);Sm:=0;
For I:=1to Length(S)do Inc(Sm,Byte(S[I])-48);
WEPutTxtLn(W,'La somme est '+S);
WEPutTxt(W,'D‚composition de la somme est ');
For I:=1to Length(S)do Begin
WEPutCube(W,S[I]);
If I<>Length(S)Then WEPutCube(W,'+');
End;
WEPutCube(W,'=');
WEPutTxt(W,Str(Sm));
While WEOk(W)do;
End;
Procedure F2C;Var W:Wins;R:Real;K,I:Wd;PC:PChr;PBuf:Array[Byte]of Char;S:String;Begin
WEInitO(W,60,11);
WEPushWn(W);
WEPutWnKrDials(W,'Conversion Fahrenheit … Celcius');
PC:=@PBuf;FillClr(PBuf,SizeOf(PBuf));
WEPutTxtLn(W,'Entrez la temp‚rature en Fahrenheit:');
WEBarSpcHorShade(W,0,2,wnMax);
WESetInpColrs(W,$8F,W.XColrs.Sel);
K:=_WEInput(W,0,2,wnMax-1,200,PC);
If(K=kbEsc)Then Begin;WEDone(W);Exit;End;
WESetKr(W,$8F);
WEBarSelHor(W,0,2,wnMax-1);
WESetKrHigh(W);
S:=StrPas(PC);W.Y:=5;Val(S,R,K);
WEPutTxtLn(W,'La temp‚rature en Fahrenheit '+RealStr2(R,4,1));
WEPutTxtLn(W,'La temp‚rature en Celcius '+RealStr2(((R-32.0)*5.0)/9.0,4,1));
While WEOk(W)do;
End;
BEGIN
InitSystems(suIsabel);
{ SetVideoModeDeluxe(vmTxtDef);}
InitVideoDeluxe;
InitEnv;
__InitMouse;
WEInit(W,20,1,MaxXTxts-20,MaxYTxts-1);
WEPushWn(W);
LMInitKrDials(L,20,1,MaxXTxts-20,MaxYTxts-1,'TraŒtement de Formule Math‚matique');
RBAddStrByte(L.X,'Conversion Fahrenheit … Celcius',mF2C);
RBAddStrByte(L.X,'Sommation ASCII',mComputeASCII);
RBAddStrByte(L.X,'Sommation Romaine',mComputeRoman);
Repeat
K:=LMRun(L);
Case(K)of
mF2C:F2C;
mComputeASCII:ComputeASCII;
mComputeRoman:ComputeRoman;
0:K:=kbEsc;
End;
Until K=kbEsc;
WEDone(W);
UnLuxe;
{ DoneLuxeVideo;}
DoneSystems;
END.