Unit
H_CALCUL;
Interface
Type
ST5 =string
[5
];
Function
HexStr(Number: WORD
): ST5;
Procedure
Calculatrice(X1,Y1:Byte
;SS2,SS3:string
;Tot,TotM:extended
);
Procedure
DONNE_ROTATION_G3(X1,Y1:Byte
);
Procedure
Cherche_Rayon(X1,Y1:Byte
);
Procedure
Calcul_Centre_ARC(X1,Y1:Byte
);
Var
Calculatrice_Total : extended
;
Calculatrice_TotalM : extended
;
Calculatrice_S2 : string
;
Calculatrice_S3 : string
;
Implementation
Uses
Crt,Box13,Mathes,Get_Key;
Const
Sqr_Limit = 1E2466;
var
Error_Real:Integer
;
Procedure
Printnum(x,y:Byte
;NN:Real
);
var
s:string
[10
];
begin
Putxy(x,y,'
'
);
Str(NN:5
:3
,s);
Putxy(x,y,s);
end
;
Function
HexStr(Number: WORD
): ST5;
Function
HexChar(Number: Word
): Char
;
begin
if
Number<10
Then
HexChar:=Char
(Number+48
)
else
HexChar:=Char
(Number+55
);
end
;
VAR
s: ST5;
begin
s:= '
'
;
if
Number>255
Then
begin
S := HexChar( (Number SHR
1
) div
2048
);
Number := ( ((Number SHR
1
) MOD
2048
) SHL
1
)+(Number and
1
);
S := S+HexChar(Number div
256
);
Number := Number MOD
256
;
end
;
S := S+HexChar(Number DIV
16
);
Number := Number MOD
16
;
S := S+HexChar(Number);
HexStr:=S+'
h
'
;
end
;
Procedure
Calculatrice(X1,Y1:Byte
;SS2,SS3:string
;Tot,TotM:extended
);
Const
Eff='
'
;
N=10
;
bac:Array
[1
..10
] OF
Word
=(1
,2
,4
,8
,16
,32
,64
,128
,256
,512
);
MaxReal=9999999999999999
.0
;
MinReal=-9999999999999999
.0
;
Var
Total,TotalM : extended
;
aff_3,S : string
;
aff_2 : string
;
Keyy,Xc,Yc : byte
;
Worde : Longint
;
Err : integer
;
Rnn,nn : Extended
;
Nstr : string
[10
];
Ch : Char
;
i,nc : byte
;
y,X : byte
;
Ecran : byte
;
ColorAttr : byte
;
Mode : Char
;
Function
Control_Valeur(num:extended
):string
;
Var
SN2,Sn:string
[20
];
begin
if
(NUM>999999999999999
.0
) or
(NUM<-99999999999999
.0
) Then
begin
Sn:='
'
;
Sn2:='
'
;
Str(NUM,Sn);
SN2:=Copy(Sn,Pos('
E
'
,Sn),Length(Sn));
Sn:=Copy(sn,1
,9
)+Sn2;
Control_Valeur:=Sn;
Error_Real:=0
;
end
else
begin
Str(Num:9
:3
,Sn);
Error_Real:=0
;
Control_Valeur:=Sn;
end
;
end
;
Function
Bin(n:Word
):string
;
var
ss,s : string
;
S1 : string
[1
];
nx : Word
;
begin
s:='
'
;
ss:='
'
;
While
n>1
Do
begin
Nx:=n Mod
2
;
Str(nx,S1);
S:=S+S1;
n:=n div
2
;
end
;
Str(n,S1);
S:=S+S1;
if
Length(S)>8
Then
Insert('
'
,S,9
);
if
Length(S)>4
Then
Insert('
'
,S,5
);
for
nx:=Length(s) Downto
1
DO
SS:=SS+S[nx];
Bin:=SS;
end
;
begin
Ecran :=Lo(WindMin);
Total :=Tot;
TotalM :=TotM;
NN:=0
;Rnn :=0
;
ColorAttr :=TextAttr;
textAttr :=Menu_Color;
BoxFill(X1,Y1,X1+26
,Y1+11
,'
'
);
textAttr:=116
;
Rectangle(X1,Y1,X1+26
,Y1+11
,Double
);
Putxy(X1+8
,Y1,'
Calculator
'
);
Rectangle(X1+1
,Y1+5
,X1+25
,Y1+7
,Simple);
textAttr:=Menu_Color;
Putxy(X1+2
,Y1+8
,'
+
-
Hex
M+
Dec
AC
'
);
Putxy(X1+2
,Y1+9
,'
*
/
Bin
M-
=
MC
'
);
Putxy(X1+2
,Y1+10
,'
Sin
Cos
Tan
Rac
Xý
PI
'
);
Str(total:8
:3
,S);
Putxy(X1+24
-Length(S),Y1+2
,S);
BoxFill(X1+1
,Y1+5
,X1+25
,Y1+7
,'
'
);
Rectangle(X1+1
,Y1+5
,X1+25
,Y1+7
,Simple);
Xc:=X1+18
;
Yc:=Y1+9
;
HighBox(xc,yc,xc+2
,yc,BX);
X:=X1+3
;
Y:=Y1+6
;
Err:=1
;
nn:=0
;
Nc:=1
;
Posxy(x,y);
Nstr :='
'
;
Mode :='
D
'
;
KeyNum(On
);
if
totalM <> 0
Then
begin
Putxy(X1+2
,Y1+1
,'
M
'
);
Str(TotalM:10
:3
,S);
Putxy(X1+4
,Y1+1
,S);
end
;
Putxy(X1+24
-Length(SS2),Y1+2
,SS2);
Aff_2:=SS2;
Putxy(X1+24
-Length(SS3),Y1+3
,SS3);
aff_3:=SS3;
S:=Control_Valeur(Total);
S:='
=
'
+S;
Putxy(X1+24
-Length(S),Y1+4
,S);
Repeat
Ch:=ReadKey;
if
(Ord(Ch)=8
) and
(nc>1
) Then
begin
NStr:=Copy(NStr,1
,LengTh(NStr)-1
);
Posxy(Ecran+WhereX-1
,Y);
Write
('
'
);
Posxy(Ecran+WhereX-1
,Y);
Nc:=Nc-1
;
end
else
if
(Yc=Y1+8
) and
(Xc=X1+10
) and
(Ord(Ch)<>13
) and
(Nc<=N) and
(Ch in
['
A
'
..'
F
'
,'
a
'
..'
f
'
,'
0
'
..'
9
'
]) then
begin
if
Mode<>'
H
'
Then
begin
Nstr:='
'
;
Putxy(X1+2
,Y1+6
,eff);
X:=X1+3
;
Posxy(x,Y);
Nc:=1
;
Mode:='
H
'
;
end
;
NStr:=NStr+Ch;
Write
(Ch);
Nc:=nc+1
;
end
else
if
(Yc=Y1+9
) and
(Xc=X1+10
) and
(Ord(Ch)<>13
) and
(Nc<=N) and
(Ch in
['
0
'
,'
1
'
]) then
begin
if
Mode<>'
B
'
Then
begin
Nstr:='
'
;
Putxy(X1+2
,Y1+6
,eff);
X:=X1+3
;
Posxy(x,Y);
Nc:=1
;
Mode:='
B
'
;
end
;
NStr:=NStr+Ch;
Write
(Ch);
Nc:=nc+1
;
end
else
if
(Ord(Ch)<>13
) and
(Nc<=N) and
(Ch in
['
0
'
..'
9
'
,'
-
'
,'
.
'
]) and
(((Yc-Y1=8
) and
(XC-X1 In
[2
,6
])) or
((Yc-Y1=9
) and
(XC-X1 In
[2
,6
,18
])) or
((Yc-Y1=10
) and
(XC-X1 In
[2
,6
,10
,14
,18
]))) then
begin
if
Mode<>'
D
'
Then
begin
Nstr:='
'
;
Putxy(X1+2
,Y1+6
,eff);
X:=X1+3
;
Posxy(x,Y);
Nc:=1
;
Mode:='
D
'
;
end
;
NStr:=NStr+Ch;
Write
(Ch);
Nc:=nc+1
;
end
else
if
(ORD(CH)=77
) and
( (Xc-X1<22
)) Then
begin
HighBox(xc,yc,xc+2
,yc,BX);
inc(xc,4
);
HighBox(xc,yc,xc+2
,yc,BX);
end
else
if
(ORd(CH)=75
) and
((Xc-X1)>2
) Then
begin
HighBox(xc,yc,xc+2
,yc,BX);
dec(xc,4
);
HighBox(xc,yc,xc+2
,yc,BX);
end
else
if
(Ord(CH)=80
) and
(Yc<Y1+10
) Then
begin
HighBox(xc,yc,xc+2
,yc,BX);
inc(Yc);
HighBox(xc,yc,xc+2
,yc,BX);
end
else
if
(ORd(CH)=72
) and
(yc>Y1+8
) Then
begin
HighBox(xc,yc,xc+2
,yc,BX);
dec(Yc);
HighBox(xc,yc,xc+2
,yc,BX);
end
else
if
ORD(Ch)=13
Then
begin
Putxy(X1+2
,Y1+6
,eff);
Str(Total:10
:3
,S);
Putxy(X1+3
,Y1+2
,eff);
Putxy(X1+24
-Length(S),Y1+2
,S);
Aff_2:=S;
X:=X1+3
;
Posxy(x,Y);
Nc:=1
;
if
((Nstr<>'
'
) and
((xc-X1) in
[2
,6
]) and
(Yc<=Y1+9
)) OR
((Yc-Y1=10
) and
(XC-X1 In
[2
,6
,10
,14
,18
,22
])) Then
begin
if
((Yc-Y1=10
) and
(XC-X1 In
[2
,6
,10
,14
,18
,22
])) and
(Nstr='
'
) Then
Nstr:='
0
'
;
Val(Nstr,nn,Err);
if
Err<>0
Then
begin
Ch:='
'
;
NStr:='
'
;
end
else
begin
if
(NN=0
) and
(Yc-Y1=10
) Then
Case
(Xc-X1) of
2
,6
,10
: if
(Total>0
.3
) and
(total<=360
) Then
Str(Total:10
:3
,S)
else
S:='
NUL
'
;
14
: if
(Total>0
) Then
Str(Abs(Total):10
:3
,S)
else
S:='
NUL
'
;
18
: Str(Total:10
:3
,S);
22
: begin
Str(PI:2
:6
,S);
S:='
'
+S;
end
;
end
else
S:=Control_Valeur(nn);
if
Yc=Y1+8
Then
Case
(Xc-X1) OF
2
: S:='
+
'
+S;
6
: S:='
-
'
+S;
end
else
if
Yc=Y1+9
Then
Case
(Xc-X1) OF
2
: S:='
*
'
+S;
6
: S:='
/
'
+S;
end
else
if
Yc=Y1+10
Then
Case
(Xc-X1) OF
2
: S:='
Sin
'
+S;
6
: S:='
Cos
'
+S;
10
: S:='
Tan
'
+S;
14
: S:='
Rac
'
+S;
18
: S:='
Xý
'
+S;
22
: S:='
PI
'
+S;
end
;
if
(Yc=Y1+8
) Then
Case
(xc-X1) OF
2
: if
((Total+nn)<MaxReal) and
((Total+nn)>MinReal) Then
Total:=Total+nn
else
Error_Real:=1
;
6
: if
((Total-nn)<MaxReal) and
((Total-nn)>MinReal) Then
Total:=Total-nn
else
Error_Real:=1
;
end
else
if
(Yc=Y1+9
) Then
Case
(Xc-X1) OF
2
: if
((Total*nn)<MaxReal) and
((Total*nn)>MinReal) Then
Total:=Total*nn
else
Error_Real:=1
;
6
: if
(NN <>0
) and
((Total*nn)<MaxReal) and
((Total*nn)>MinReal) Then
Total:=Total/nn
else
Error_Real:=1
;
end
else
if
(Yc=Y1+10
) Then
Case
(Xc-X1) OF
2
: if
(NN>0
) and
(NN<=360
) Then
Total:=Sinu(nn)
else
if
(total>0
) and
(total<=360
) Then
Total:=Sinu(total)
else
Total:=0
;
6
: if
(NN>0
) and
(NN<=360
) Then
Total:=Cosi(nn)
else
if
(total>0
) and
(total<=360
) Then
Total:=Cosi(total)
else
Total:= 0
;
10
: if
(NN>0
) and
(NN<=360
) Then
Total:=Tang(nn)
else
if
(total>0
) and
(total<=360
) Then
Total:=Tang(total)
else
Total:= 0
;
14
: if
(NN>0
) Then
begin
Total:=SQRT(ABS(nn));
if
Ioresult<> 0
Then
begin
Error_Real:=1
;
Total:=0
;
end
;
end
else
if
Total>0
Then
begin
Total:=SQRT(ABS(Total));
if
Ioresult <> 0
Then
begin
Error_Real:=1
;
Total:=0
;
end
;
end
else
begin
Error_Real:=1
;
Total:=0
;
end
;
18
: begin
if
(nn = 0
) Then
nn:=Total;
if
(nn < -SQR_LIMIT) or
(nn > SQR_LIMIT) then
begin
Error_Real:=1
;
Total:=0
;
end
else
begin
if
((nn*nn)<MaxReal) and
((nn*nn)>MinReal) Then
begin
Total:=Sqr(NN);
if
Ioresult<> 0
Then
begin
Error_Real:=1
;
Total:=0
;
end
;
end
else
begin
Error_Real:=1
;
Total:=0
;
end
;
end
;
end
;
22
: begin
Total:=PI;
if
Ioresult <> 0
Then
begin
Error_Real:=1
;
Total:=0
;
end
else
Error_Real:=0
;
end
;
end
;
if
Error_Real = 0
Then
begin
Putxy(X1+3
,Y1+3
,eff);
Putxy(X1+24
-Length(S),Y1+3
,S);
aff_3:=S;
Putxy(X1+1
,Y1+4
,Eff);
S:=Control_Valeur(Total);
S:='
=
'
+S;
Putxy(X1+24
-Length(S),Y1+4
,S);
end
else
begin
Putxy(X1+1
,Y1+4
,Eff);
S:='
Error
'
;
Putxy(X1+24
-Length(S),Y1+4
,S);
end
;
NStr:='
'
;
RNN:=NN;
NN:=0
;
Error_Real:=0
;
end
;
end
else
if
(xc-X1=22
) and
(yc=Y1+8
) Then
begin
Putxy(X1+1
,Y1+2
,eff);
Putxy(X1+1
,Y1+3
,eff);
Putxy(X1+1
,Y1+4
,eff);
Aff_2:='
'
;
Aff_3:='
'
;
Total:=0
;
Str(Total:10
:3
,S);
Putxy(X1+24
-Length(S),Y1+4
,S);
NStr:='
'
;
NN:=0
;
RNN:=0
;
HighBox(xc,yc,xc+2
,yc,BX);
xc:=X1+18
;
yc:=Y1+9
;
HighBox(xc,yc,xc+2
,yc,BX);
Mode:='
D
'
;
end
else
if
(xc-X1=10
) and
(yc=Y1+8
) Then
begin
if
(Nstr<>'
'
) Then
begin
if
Mode='
H
'
Then
Nstr:='
$
'
+Nstr;
Val(Nstr,Worde,Err);
if
(Err=0
) and
(Worde>=0
) and
(Worde<=65535
) Then
S:=HexStr(Worde)
else
begin
S:='
Error
'
;
Worde:=0
;
end
;
Putxy(X1+1
,Y1+3
,eff);
Putxy(X1+1
,Y1+4
,eff);
Putxy(X1+24
-Length(S),Y1+3
,S);
aff_3:=S;
Str(Worde,S);
total:=Worde;
S:=Control_Valeur(Total);
S:='
=
'
+S;
Putxy(X1+24
-Length(S),Y1+4
,S);
NStr:='
'
;
Rnn:=Worde;
Worde:=0
;
end
else
if
((Rnn <= 65535
) and
(Rnn >= 0
)) Then
begin
Putxy(X1+1
,Y1+3
,eff);
Putxy(X1+1
,Y1+4
,eff);
S:=HexStr(Trunc(RNN));
Putxy(X1+24
-Length(S),Y1+3
,S);
aff_3:=S;
Str(Rnn:10
:3
,S);
total:=Rnn;
S:=Control_Valeur(Total);
S:='
=
'
+S;
Putxy(X1+24
-Length(S),Y1+4
,S);
end
;
end
else
if
(xc-X1=18
) and
(yc=Y1+9
) Then
begin
Val(Nstr,nn,Err);
if
Err <> 0
Then
begin
Ch :='
'
;
X :=X1+3
;
Nstr:='
'
;
end
else
begin
Putxy(X1+3
,Y1+2
,eff);
Putxy(X1+3
,Y1+3
,eff);
S:=Control_Valeur(NN);
Putxy(X1+3
,Y1+4
,eff);
Putxy(X1+24
-Length(S),Y1+2
,S);
Aff_2:=S;
Putxy(X1+24
-Length(S),Y1+3
,S);
aff_3:=S;
Putxy(X1+24
-Length(S),Y1+4
,S);
NStr:='
'
;
Total:=NN;
RNN:=NN;
NN:=0
;
end
;
end
else
if
(xc-X1=14
) and
(yc=Y1+8
) Then
begin
if
((Total+TotalM)<=MaxReal) and
((Total+TotalM)>=MinReal) Then
begin
TotalM:=TotalM+Total;
Putxy(X1+2
,Y1+1
,'
M
'
);
Str(TotalM:10
:3
,S);
Putxy(X1+4
,Y1+1
,S);
end
;
end
else
if
(xc-X1=14
) and
(yc=Y1+9
) Then
begin
if
((Total-TotalM)<=MaxReal) and
((Total-TotalM)>=MinReal) Then
begin
TotalM:=TotalM-Total;
Putxy(X1+2
,Y1+1
,'
M
'
);
Str(TotalM:10
:3
,S);
Putxy(X1+4
,Y1+1
,S);
end
;
end
else
if
(xc-X1=22
) and
(yc=Y1+9
) Then
begin
TotalM:=0
;
Putxy(X1+1
,Y1+1
,eff+'
'
);
HighBox(xc,yc,xc+2
,yc,BX);
xc:=X1+18
;
yc:=Y1+9
;
HighBox(xc,yc,xc+2
,yc,BX);
end
else
if
(xc-X1=10
) and
(yc=Y1+9
) Then
begin
if
Nstr<>'
'
Then
begin
RNN:=0
;
Nc:=1
;
For
i:=Length(Nstr) Downto
1
DO
begin
if
Nstr[i]='
1
'
Then
Rnn:=Rnn+Bac[Nc];
Inc(Nc);
end
;
S:=Bin(Trunc(Rnn))+'
b
'
;
Nc:=1
;
end
else
begin
if
(RNN<64000
) and
(RNN>0
) Then
S:=Bin(Trunc(RNN))+'
b
'
else
S:='
Error
'
;
end
;
Putxy(X1+1
,Y1+3
,eff);
Putxy(X1+1
,Y1+4
,eff);
Putxy(X1+24
-Length(S),Y1+3
,S);
aff_3:=S;
total:=Rnn;
S:=Control_Valeur(Total);
S:='
=
'
+S;
Putxy(X1+24
-Length(S),Y1+4
,S);
NStr:='
'
;
NN:=0
;
end
else
if
(xc-X1=18
) and
(yc=Y1+8
) Then
begin
Str(Rnn:10
:3
,S);
Putxy(X1+1
,Y1+3
,eff);
Putxy(X1+1
,Y1+4
,eff);
Putxy(X1+24
-Length(S),Y1+3
,S);
aff_3:=S;
S:=Control_Valeur(Total);
S:='
=
'
+S;
Putxy(X1+24
-Length(S),Y1+4
,S);
end
;
end
;
Until
ORd(Ch)=27
;
Calculatrice_Total :=Total;
Calculatrice_TotalM:=TotalM;
Calculatrice_S2 :=aff_2;
Calculatrice_S3 :=aff_3;
textAttr:=ColorAttr;
end
;
Procedure
G3_XY2(Var
X,y:Real
;Rayon:Real
;grd:Integer
);
Var
X1,Y1:Real
;
begin
Y1:=(Sin(Pi*grd/180
)*Rayon);
X1:=SQRT(SQR(Rayon)-SQR(Y1));
if
(grd<91
) OR
(grd>270
) Then
x:=Round(X1)+X
else
x:=X-Round(X1);
Y:=Round(Y1)+Y;
end
;
Procedure
Rotation_SUR_G3(Var
X,Y:Real
;Angle:REAL
);
Var
XX,YY:Real
;
begin
if
(Angle>=0
) and
(Angle<=360
) Then
begin
XX:= (X*Cosi(Angle)) - (Y*Sinu(Angle));
YY:= (X*Sinu(Angle)) + (Y*cosi(Angle));
X:=XX;
Y:=YY;
end
;
end
;
Procedure
DONNE_ROTATION_G3(X1,Y1:Byte
);
Var
Key,Y,Chois : Byte
;
n,DX1,DY1,
CENX,CENY,
RX,RY :REAL
;
Ang :Real
;
Snx,snY :string
[9
];
ColorAttr :byte
;
begin
DX1 :=0
.0
;
DY1 :=0
.0
;
Rx :=0
.0
;
Ry :=0
.0
;
CenX:=0
.0
;
CenY:=0
.0
;
Ang :=0
.0
;
ColorAttr:=textAttr;
textAttr:=Menu_Color;
BoxFill(X1,Y1,X1+30
,Y1+8
,'
'
);
Rectangle(X1,Y1,X1+30
,Y1+8
,Double
);
Putxy(X1+10
,Y1,'
Rotation
G3
'
);
Putxy(X1+10
,Y1+8
,'
F1
=
Calcul
'
);
Putxy(X1+3
,Y1+1
,'
Centre
X
:
'
);
Putxy(X1+3
,Y1+2
,'
Centre
Y
:
'
);
Putxy(X1+3
,Y1+3
,'
Angle
:
'
);
Putxy(X1+3
,Y1+4
,'
Coordinate
X
:
'
);
Putxy(X1+3
,Y1+5
,'
Coordinate
Y
:
'
);
Y:=1
;
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
Repeat
CSOFF;
Key:=KeyBoard;
if
(Key=80
) and
(Y<5
) Then
begin
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
inc(Y);
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
end
else
if
(Key=72
) and
(Y>1
) Then
begin
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
Dec(Y);
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
end
else
if
(Not
Key_Code) and
((Key=13
) OR
(Key In
[45
,48
..57
])) Then
begin
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
N:=0
;
N:=READREAL(X1+19
,Y+Y1,10
,key);
if
(N>100000
) OR
(N<-100000
) Then
Key:=27
;
Case
y Of
1
: if
Key=27
Then
Printnum(X1+19
,Y+Y1,CenX)
else
cenX:=N;
2
: if
Key=27
Then
Printnum(X1+19
,Y+Y1,CenY)
else
CenY:=N;
3
: if
(Key=27
) OR
((N<=0
) OR
(N>360
)) Then
Printnum(X1+19
,Y+Y1,Ang)
else
Ang:=N;
4
: if
Key=27
Then
Printnum(X1+19
,Y+Y1,DX1)
else
DX1:=N;
5
: if
Key=27
Then
Printnum(X1+19
,Y+Y1,DY1)
else
DY1:=N;
end
;
if
Y<5
Then
Inc(Y)
else
Y:=1
;
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
Key:=0
;
end
;
if
(Key_Code) and
(Key=59
) Then
begin
RX:=DX1-CenX;RY:=DY1-CenY;
Rotation_SUR_G3(RX,RY,Ang);
Str(RX+CenX:5
:3
,Snx);
Str(RY+CenY:5
:3
,Sny);
textAttr:=116
;
Putxy(X1+3
,Y1+6
,'
Rotation
X
:
'
); Putxy(X1+19
,Y1+6
,Snx);
Putxy(X1+3
,Y1+7
,'
Rotation
Y
:
'
); Putxy(X1+19
,Y1+7
,Sny);
textAttr:=Menu_Color;
end
;
Until
Key=27
;
textAttr:=ColorAttr;
end
;
Function
Angle__G3(XX1,YY1,CXX,CYY,RR:REal
):Integer
;
var
Angle:Real
;
begin
Angle:=400
;
if
YY1>CYY Then
begin
if
XX1>CXX Then
Angle:=Radian_Degre(ArcSin((YY1-CYY)/RR))
else
if
XX1<CXX Then
Angle:=Radian_Degre(ArcSin((CXX-XX1)/RR))+90
else
if
(Round((YY1-RR))=Round(CYY)) and
(Round(XX1)=Round(CXX)) Then
Angle:=90
;
end
else
if
(CYY>YY1) Then
begin
if
(Round(CYY-RR)=Round(YY1)) and
(Round(CXX)=Round(XX1)) Then
Angle:=270
else
if
CXX>XX1 Then
Angle:=180
+Radian_Degre(ArcSin((CYY-YY1)/RR))
else
if
CXX<XX1 Then
Angle:=270
+Radian_Degre(ArcSin((XX1-CXX)/RR));
end
else
if
(Round(CYY)=Round(YY1)) and
(Round(CXX+RR)=Round(XX1)) Then
Angle:=0
else
if
(Round(YY1)=Round(CYY)) and
(Round(CXX)=Round(XX1+RR)) Then
Angle:=180
;
if
(Angle>=0
) and
(Angle<=360
) Then
Angle__G3:=Round(Angle)
else
Angle__G3:=400
;
end
;
Function
Calcul_Rayon(Cx,Cy,X,Y:Real
;Var
Angle:Real
):Real
;
Var
R,c,b,AG:Real
;
begin
C:=ABS(cx-X);
B:=ABS(cy-Y);
if
C=0
Then
C:=0
.00001
;
if
B=0
Then
B:=0
.00001
;
R:=SQRT(Abs(Sqr(C))+Abs(Sqr(B)));
Ag:=Angle__G3(X,Y,Cx,Cy,R);
if
Ag=400
Then
Ag:=-1
;
Angle:=Ag;
Calcul_Rayon:=R;
end
;
Procedure
Cherche_Rayon(X1,Y1:Byte
);
Var
Key,Y,Chois : byte
;
n,DX1,DY1,
CENX,CENY,
Ray : REAL
;
Ang : Real
;
Snx,snY : string
[9
];
ColorAttr : byte
;
begin
DX1:=0
.0
;
DY1:=0
.0
;
CenX:=0
.0
;
CenY:=0
.0
;
Ang:=0
.0
;
Ray:=0
.0
;
ColorAttr:=TextAttr;
TextAttr:=Menu_Color;
BoxFill(X1,Y1,X1+30
,Y1+7
,'
'
);
Rectangle(X1,Y1,X1+30
,Y1+7
,Double
);
Putxy(X1+10
,Y1,'
Distance
'
);
Putxy(X1+10
,Y1+7
,'
F1
=
Calcul
'
);
Putxy(X1+3
,Y1+1
,'
begin
X
:
'
);
Putxy(X1+3
,Y1+2
,'
begin
Y
:
'
);
Putxy(X1+3
,Y1+3
,'
end
X
:
'
);
Putxy(X1+3
,Y1+4
,'
end
Y
:
'
);
Y:=1
;
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
Repeat
CsOff;
Key:=KeyBoard;
if
(Key=80
) and
(Y<4
) Then
begin
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
inc(Y);
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
end
else
if
(Key=72
) and
(Y>1
) Then
begin
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
dec(Y);
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
end
else
if
(Not
Key_Code) and
((Key=13
) OR
(Key In
[45
,48
..57
])) Then
begin
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
N:=0
;
N:=READREAL(X1+16
,Y+Y1,10
,key);
if
(N>100000
) OR
(N<-100000
) Then
Key:=27
;
Case
y Of
1
: if
Key=27
Then
Printnum(X1+16
,Y+Y1,CenX)
else
cenX:=N;
2
: if
Key=27
Then
Printnum(X1+16
,Y+Y1,CenY)
else
CenY:=N;
3
: if
Key=27
Then
Printnum(X1+16
,Y+Y1,DX1)
else
DX1:=N;
4
: if
Key=27
Then
Printnum(X1+16
,Y+Y1,DY1)
else
DY1:=N;
end
;
if
Y<4
Then
Inc(Y)
else
Y:=1
;
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
Key:=0
;
end
;
if
(Key_Code) and
(Key=59
) Then
begin
snx:='
'
;
sny:='
'
;
Ang:=0
.0
;
Ray:=Calcul_Rayon(CENX,CenY,DX1,DY1,Ang);
Str(Ray:5
:3
,Snx);
Str(Ang:5
:3
,Sny);
textAttr:=116
;
Putxy(X1+3
,Y1+5
,'
Rayon
:
'
);Putxy(X1+16
,Y1+5
,Snx);
Putxy(X1+3
,Y1+6
,'
Angle
¦
:
'
);Putxy(X1+16
,Y1+6
,Sny+#
167
);
textAttr:=Menu_Color;
end
;
Until
Key=27
;
textAttr:=ColorAttr;
end
;
Procedure
CentreG3(XX1,YY1,XX2,YY2,RR:Real
;Var
CX,Cy,Ray,Ang,Flech:Real
);
var
a,b,aa,MM,MM2,AB,RF,MT,XO,YO,QQ1 : Real
;
begin
if
XX1=XX2 Then
a:=70000
.00075
else
a:=(YY2-YY1)/(XX1-XX2);
b:=-YY1-(a*XX2);
if
a=0
Then
aa:=99999
.99525
else
aa:=1
/a;
MM :=ABS((XX1-XX2)/2
);
MM2:=ABS((YY1-YY2)/2
);
QQ1:=Sqr(XX1-XX2)+Sqr(YY1-YY2);
AB :=Sqrt(ABS(QQ1));
QQ1:=Sqr(RR);
QQ1:=QQ1-Sqr(AB)/4
;
RF :=Sqrt(ABS(QQ1));
QQ1:=sqr(RF);
QQ1:=QQ1/(Sqr(aa)+1
);
MT :=Sqrt(Abs(QQ1));
if
(YY2<YY1) OR
((YY2=YY1) and
(XX1<XX2)) Then
begin
if
XX1<=XX2 Then
QQ1:=XX1
else
QQ1:=XX2;
CX:=MM+MT+QQ1;
if
YY1<=YY2 Then
QQ1:=YY1
else
QQ1:=YY2;
CY:=(aa*MT)+MM2+QQ1;
end
else
if
(YY2>YY1) OR
((YY2=YY1) and
(XX1>XX2)) Then
begin
if
XX1<=XX2 Then
QQ1:=XX1
else
QQ1:=XX2;
CX:=MM-MT+QQ1;
if
YY1<=YY2 Then
QQ1:=YY1
else
QQ1:=YY2;
CY:=-(aa*MT)+MM2+QQ1;
end
;
QQ1:=AB/2
;
QQ1:=Sqr(QQ1);
QQ1:=QQ1+Sqr(RF);
QQ1:=Sqrt(Abs(QQ1));
Ray:=QQ1;
QQ1:=(AB/2
)/Ray;
if
QQ1=1
Then
Ang:=90
else
Ang:=Radian_Degre(ArcSin(QQ1));
a:=2
*Ray*Sinu(Ang);
if
Round(AB)=Round(a) Then
begin
Ang:=Ang*2
;
Flech:=Ray-RF;
end
else
begin
Ang:=0
;
Flech:=0
;
end
;
end
;
Procedure
Calcul_Centre_ARC(X1,Y1:Byte
);
Var
Key,Y,Chois : byte
;
N,DX1,DY1,
CENX,CENY,
DX2,DY2 : REAL
;
RC,Ray,
Angl,fle : Real
;
Snx,snY : string
[9
];
ColorAttr : byte
;
begin
DX1 :=0
.0
;
DY1 :=0
.0
;
DX2 :=0
.0
;
DY2 :=0
.0
;
Ray :=0
.0
;
RC :=0
.0
;
CenX:=0
.0
;
CenY:=0
.0
;
Angl:=0
.0
;
Fle :=0
.0
;
ColorAttr:=TextAttr;
textAttr:=Menu_Color;
BoxFill(X1,Y1,X1+30
,Y1+11
,'
'
);
Rectangle(X1,Y1,X1+30
,Y1+11
,Double
);
Putxy(X1+8
,Y1,'
Arc
Centre
G3
'
);
Putxy(X1+10
,Y1+10
,'
F1
=
Calcul
'
);
Putxy(X1+3
,Y1+1
,'
Coordinate
X1
:
'
);
Putxy(X1+3
,Y1+2
,'
Coordinate
Y1
:
'
);
Putxy(X1+3
,Y1+3
,'
Coordinate
X2
:
'
);
Putxy(X1+3
,Y1+4
,'
Coordinate
Y2
:
'
);
Putxy(X1+3
,Y1+5
,'
Rayon
:
'
);
Y:=1
;
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
Repeat
CSOFF;
Key:=KeyBoard;
if
(Key=80
) and
(Y<5
) Then
begin
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
inc(Y);
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
end
else
if
(Key=72
) and
(Y>1
) Then
begin
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
dec(Y);
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
end
else
if
(Not
Key_Code) and
((Key=13
) OR
(Key In
[45
,48
..57
])) Then
begin
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
N:=0
;
N:=READREAL(X1+19
,Y+Y1,10
,key);
if
(N>100000
) OR
(N<-100000
) Then
Key:=27
;
Case
y Of
1
: if
Key=27
Then
Printnum(X1+19
,Y+Y1,DX1)
else
DX1:=N;
2
: if
Key=27
Then
Printnum(X1+19
,Y+Y1,DY1)
else
DY1:=N;
3
: if
Key=27
Then
Printnum(X1+19
,Y+Y1,DX2)
else
DX2:=N;
4
: if
Key=27
Then
Printnum(X1+19
,Y+Y1,DY2)
else
DY2:=N;
5
: if
Key=27
Then
Printnum(X1+19
,Y+Y1,Ray)
else
Ray:=N;
end
;
if
Y<5
Then
inc(Y)
else
Y:=1
;
HighBox(x1+2
,y+Y1,x1+28
,y+Y1,BX);
Key:=0
;
end
;
if
(Key_Code) and
(Key=59
) Then
begin
CENX:=0
;
CENY:=0
;
RC:=0
.0
;
CentreG3(DX1,DY1,DX2,DY2,Ray,CENX,CENY,RC,Angl,fle);
Str(CenX:5
:3
,Snx);
Str(CenY:5
:3
,Sny);
textAttr:=116
;
Putxy(X1+3
,Y1+6
,'
Centre
X
:
'
); Putxy(X1+19
,Y1+6
,Snx);
Putxy(X1+3
,Y1+7
,'
Centre
Y
:
'
); Putxy(X1+19
,Y1+7
,Sny);
Str(RC:5
:3
,Sny);
if
Angl=0
Then
Snx:='
Err
'
else
Str(Angl:5
:3
,Snx);
Putxy(X1+3
,Y1+8
,'
Rayon
:
'
); Putxy(X1+19
,Y1+8
,Sny);
Str(Fle:5
:3
,Sny);
Putxy(X1+3
,Y1+9
,'
Fleche
:
'
); Putxy(X1+19
,Y1+9
,Sny);
Putxy(X1+3
,Y1+10
,'
Angle
:
'
); Putxy(X1+19
,Y1+10
,Snx);
if
(Round(RC)=Round(Ray)) Then
begin
RC:=Abs((Frac(RC)-Frac(Ray)));
if
(RC>=0
) and
(RC<=0
.5
) Then
Putxy(X1+11
,Y1+8
,#
241
+'
0.5
'
)
else
Putxy(X1+11
,Y1+8
,#
63
+#
63
+#
63
);
end
else
Putxy(X1+11
,Y1+8
,'
error
'
);
textAttr:=Menu_Color;
end
;
Until
Key=27
;
textAttr:=ColorAttr;
end
;
end
.