kmz* online shared repository - Viewing Text File

1 program Ngitung_Segitiga; {by Kamilersz}
2 uses wincrt;
3 label
4 1,2,7,11,19,35,13,21,37,25,41,49,14,22,38,26,42,50,28,44,52,56,97,98,99,221;
5 FUNCTION Atan(X, Y: Real): Real;
6
7 CONST
8   Pi180 = 57.2957795;
9
10 VAR
11   A: Real;
12
13 BEGIN { Function Atan }
14   IF X = 0.0 THEN
15     IF Y = 0.0 THEN Atan := 0.0
16     ELSE Atan := 90.0
17   ELSE  { X <> 0 }
18     IF Y = 0.0 THEN  Atan := 0.0
19     ELSE  { X and Y <> 0 }
20       BEGIN
21         A := ArcTan(Abs(Y / X)) * Pi180;
22         IF X > 0.0 THEN
23           IF Y > 0.0 THEN Atan := A  { X, Y > 0 }
24           ELSE  Atan := -A { X>0, Y<0 }
25         ELSE    { X < 0 }
26           IF Y > 0.0 THEN Atan := 180.0 - A  { X<0, Y>0 }
27           ELSE  Atan := 180.0 + A  { X, Y < 0 }
28       END
29 END;
30 FUNCTION ArcSin(X: Real): Real;
31
32 BEGIN
33   IF X = 0.0 THEN  ArcSin := 0.0
34   ELSE
35     IF X = 1.0 THEN ArcSin := 90.0
36     ELSE
37       IF X = -1.0 THEN ArcSin := -90.0
38       ELSE ArcSin := Atan( 1.0, X/ Sqrt(1.0 - Sqr(X)))
39 END;
40
41 FUNCTION ArcCos(X: Real): Real;
42 { Arc cosine in degrees }
43 { Function Atan is required }
44 { From Borland Pascal Programs for Scientists and Engineers }
45 { by Alan R. Miller, Copyright C 1993, SYBEX Inc }
46
47 BEGIN { Function ArcCos }
48   IF X = 0.0 THEN  ArcCos := 90.0
49   ELSE
50     IF X = 1.0 THEN ArcCos := 0.0
51     ELSE
52       IF X = -1.0 THEN ArcCos := 180.0
53       ELSE ArcCos := Atan( X/ Sqrt(1.0 - Sqr(X)),1.0)
54 END; { Function ArcCos }
55
56 var
57 var1,var2,var3,alpha,beta,gama,x1,a,b,c,s,luas:Real;
58 vara,varb,varc:string;
59 varz:integer;
60 begin
61 97:
62 ClrScr;
63 a := 0;b := 0;c := 0;alpha := 0; beta := 0; gama := 0; varz :=0;
64 writeln('Penghitungan Kompleks Segitiga Trigonometri');
65 writeln('Jika tampilan error atau ada bernilai negatif berarti segitiga nampak mustahil');
66 writeln('Pemasukan data sebaiknya menggunakan huruf non kapital');
67 writeln('Written By KaMiLeRsZ');
68 writeln;
69
70 write('Masukan Variabel 1. a, b, c, alpha, beta atau gama ! ');readln(vara);write('Nilainya ? ');readln(var1);
71 if vara = 'a' then
72 begin
73 a := var1;
74 varz :=varz + 1;
75 end
76 else
77 begin
78 if vara = 'b' then
79 begin
80 b := var1;
81 varz :=varz + 2;
82 end
83 else
84 begin
85 if vara = 'c' then
86 begin
87 c := var1;
88 varz :=varz + 4;
89 end
90 else
91 begin
92 if vara = 'alpha' then
93 begin
94 alpha := var1;
95 varz :=varz + 8;
96 end
97 else
98 begin
99 if vara = 'beta' then
100 begin
101 beta := var1;
102 varz :=varz + 16;
103 end
104 else
105 begin
106 if vara = 'gama' then
107 begin
108 gama := var1;
109 varz :=varz + 32;
110 end
111 else
112 begin
113 writeln('Ngawur loe !! Mana ada variabel kayak ',vara,' ??');
114 goto 97;
115 end;
116 end;
117 end;
118 end;
119 end;
120 end;
121 98:
122 write('Masukan Variabel 2. a, b, c, alpha, beta atau gama ! ');readln(varb);write('Nilainya ? ');readln(var2);
123 if varb = vara then
124 begin
125 writeln('Ngawur loe !! kok sama sih ?');
126 goto 98;
127 end
128 else
129 if varb = 'a' then
130 begin
131 a := var2;
132 varz :=varz + 1;
133 end
134 else
135 begin
136 if varb = 'b' then
137 begin
138 b := var2;
139 varz :=varz + 2;
140 end
141 else
142 begin
143 if varb = 'c' then
144 begin
145 c := var2;
146 varz :=varz + 4;
147 end
148 else
149 begin
150 if varb = 'alpha' then
151 begin
152 alpha := var2;
153 varz :=varz + 8;
154 end
155 else
156 begin
157 if varb = 'beta' then
158 begin
159 beta := var2;
160 varz :=varz + 16;
161 end
162 else
163 begin
164 if varb = 'gama' then
165 begin
166 gama := var2;
167 varz :=varz + 32;
168 end
169 else
170 begin
171 writeln('Ngawur loe !! Mana ada variabel kayak ',varb,' ??');
172 goto 98;
173 end;
174 end;
175 end;
176 end;
177 end;
178 end;
179 99:
180 write('Masukan Variabel 3. a, b, c, alpha, beta atau gama ! ');readln(varc);write('Nilainya ? ');readln(var3);
181 if varc = vara then
182 begin
183 writeln('Ngawur loe !! Kok sama kayak yang pertama ?');
184 goto 99;
185 end
186 else
187 if varc = varb then
188 begin
189 writeln('Ngawur loe !! Kok sama kayak yang kedua ?');
190 goto 99;
191 end
192 else
193 if varc = 'a' then
194 begin
195 a := var3;
196 varz :=varz + 1;
197 end
198 else
199 begin
200 if varc = 'b' then
201 begin
202 b := var3;
203 varz :=varz + 2;
204 end
205 else
206 begin
207 if varc = 'c' then
208 begin
209 c := var3;
210 varz :=varz + 4;
211 end
212 else
213 begin
214 if varc = 'alpha' then
215 begin
216 alpha := var3;
217 varz :=varz + 8;
218 end
219 else
220 begin
221 if varc = 'beta' then
222 begin
223 beta := var3;
224 varz :=varz + 16;
225 end
226 else
227 begin
228 if varc = 'gama' then
229 begin
230 gama := var3;
231 varz :=varz + 32;
232 end
233 else
234 begin
235 writeln('Ngawur loe !! Mana ada variabel kayak ',varc,' ??');
236 goto 99;
237 end;
238 end;
239 end;
240 end;
241 end;
242 end;
243
244 if (alpha+beta>=180)or(alpha+gama>=180)or(beta+gama>=180) then
245 begin
246 writeln('Error. Besar Sudut sangat mustahil untuk menjadi segitiga !');
247 goto 221;
248 end;
249
250 case varz of
251
252 7 : goto 7; 49: goto 49;
253 11: goto 11;50: goto 50;
254 19: goto 19;52: goto 52;
255 35: goto 35;56: goto 56;
256
257 13: goto 13;14: goto 14;
258 21: goto 21;22: goto 22;
259 37: goto 37;38: goto 38;
260
261 25: goto 25;26: goto 26;
262 41: goto 41;42: goto 42;
263 28: goto 28;44: goto 44;
264
265 end;
266 7:
267 if (a+b<=c)or(a+c<=b)or(b+c<=a) then
268 begin
269 writeln('Error. Panjang sangat mustahil untuk menjadi segitiga !');
270 goto 221;
271 end;
272 alpha:= arccos((sqr(b)+sqr(c)-sqr(a))/(2*b*c));
273 beta := arccos((sqr(a)+sqr(c)-sqr(b))/(2*a*c));
274 gama := arccos((sqr(b)+sqr(a)-sqr(c))/(2*b*a));
275 s    := (a+b+c) / 2;
276 luas := sqrt(s * (s-a) * (s-b) * (s-c));
277 goto 2;
278
279 11:
280 s  := b * sin(alpha* pi /180) / a;
281 beta := arcsin(s);
282 gama := 180 - alpha - beta;
283 x1 := a / sin(alpha* pi /180);
284 c  := x1 *sin(gama* pi /180);
285 s  := (a+b+c) / 2;
286 luas := sqrt(s * (s-a) * (s-b) * (s-c));
287 goto 2;
288
289 19:
290 s  := a * sin(beta* pi /180) / b;
291 alpha := arcsin(s);
292 gama := 180 - alpha - beta;
293 x1 := a / sin(alpha* pi /180);
294 b  := x1 *sin(beta* pi /180);
295 c  := x1 *sin(gama* pi /180);
296 s  := (a+b+c) / 2;
297 luas := sqrt(s * (s-a) * (s-b) * (s-c));
298 goto 2;
299
300 35:
301 c  := sqrt(sqr(a)+sqr(b)-(2*a*b*cos(gama* pi / 180)));
302 alpha :=arccos((sqr(b)+sqr(c)-sqr(a)) / (2 * b * c));
303 beta  :=arccos((sqr(a)+sqr(c)-sqr(b)) / (2 * a * c));
304 s  := (a+b+c) / 2;
305 luas := sqrt(s * (s-a) * (s-b) * (s-c));
306 goto 2;
307 13:
308 s  := c * sin(alpha* pi /180) / a;
309 gama := arcsin(s);
310 beta := 180 - alpha - gama;
311 x1 := a / sin(alpha* pi /180);
312 b  := x1 *sin(beta* pi /180);
313 s  := (a+b+c) / 2;
314 luas := sqrt(s * (s-a) * (s-b) * (s-c));
315 goto 2;
316
317 21:
318 b  := sqrt(sqr(a)+sqr(c)-(2*a*c*cos(beta*22/7/180)));
319 alpha :=arccos((sqr(b)+sqr(c)-sqr(a)) / (2 * b * c));
320 gama  :=arccos((sqr(a)+sqr(b)-sqr(c)) / (2 * a * b));
321 s  := (a+b+c) / 2;
322 luas := sqrt(s * (s-a) * (s-b) * (s-c));
323 goto 2;
324
325
326 37:
327 s  := a * sin(gama* pi /180) / c;
328 alpha := arcsin(s);
329 beta := 180 - alpha - gama;
330 x1 := a / sin(alpha* pi /180);
331 b  := x1 *sin(beta* pi /180);
332 s  := (a+b+c) / 2;
333 luas := sqrt(s * (s-a) * (s-b) * (s-c));
334 goto 2;
335
336
337 25:
338 gama := 180 - alpha - beta;
339
340 x1 := a / sin(alpha* pi /180);
341 b  := x1 *sin(beta* pi /180);
342 c  := x1 *sin(gama* pi /180);
343
344 s  := (a+b+c) / 2;
345 luas := sqrt(s * (s-a) * (s-b) * (s-c));
346 goto 2;
347 41:
348 beta := 180 - alpha - gama;
349
350 x1 := a / sin(alpha* pi /180);
351 b  := x1 *sin(beta* pi /180);
352 c  := x1 *sin(gama* pi /180);
353
354 s  := (a+b+c) / 2;
355 luas := sqrt(s * (s-a) * (s-b) * (s-c));
356 goto 2;
357
358 49:
359 alpha := 180 - beta - gama;
360
361 x1 := a / sin(alpha* pi /180);
362 b  := x1 *sin(beta* pi /180);
363 c  := x1 *sin(gama* pi /180);
364
365 s  := (a+b+c) / 2;
366 luas := sqrt(s * (s-a) * (s-b) * (s-c));
367 goto 2;
368
369 14:
370 a  := sqrt(sqr(c)+sqr(b)-(2*c*b*cos(alpha*22/7/180)));
371 gama :=arccos((sqr(a)+sqr(b)-sqr(c)) / (2 * b * a));
372 beta  :=arccos((sqr(a)+sqr(c)-sqr(b)) / (2 * a * c));
373 s  := (a+b+c) / 2;
374 luas := sqrt(s * (s-a) * (s-b) * (s-c));
375 goto 2;
376
377 22:
378 s  := c * sin(beta* pi /180) / b;
379 gama := arcsin(s);
380 alpha := 180 - beta - gama;
381 x1 := c / sin(gama* pi /180);
382 a  := x1 *sin(alpha* pi /180);
383 s  := (a+b+c) / 2;
384 luas := sqrt(s * (s-a) * (s-b) * (s-c));
385 goto 2;
386
387 38:
388 s  := b * sin(gama* pi /180) / c;
389 beta := arcsin(s);
390 alpha := 180 - beta - gama;
391 x1 := c / sin(gama* pi /180);
392 a  := x1 *sin(alpha* pi /180);
393 s  := (a+b+c) / 2;
394 luas := sqrt(s * (s-a) * (s-b) * (s-c));
395 goto 2;
396
397
398 26:
399 gama := 180 - alpha - beta;
400
401 x1 := b / sin(beta* pi /180);
402 a  := x1 *sin(alpha* pi /180);
403 c  := x1 *sin(gama* pi /180);
404
405 s  := (a+b+c) / 2;
406 luas := sqrt(s * (s-a) * (s-b) * (s-c));
407 goto 2;
408
409 42:
410 beta := 180 - alpha - gama;
411
412 x1 := b / sin(beta* pi /180);
413 a  := x1 *sin(alpha* pi /180);
414 c  := x1 *sin(gama* pi /180);
415
416 s  := (a+b+c) / 2;
417 luas := sqrt(s * (s-a) * (s-b) * (s-c));
418
419 goto 2;
420
421 50:
422 alpha := 180 - gama - beta;
423
424 x1 := b / sin(beta* pi /180);
425 a  := x1 *sin(alpha* pi /180);
426 c  := x1 *sin(gama* pi /180);
427
428 s  := (a+b+c) / 2;
429 luas := sqrt(s * (s-a) * (s-b) * (s-c));
430 goto 2;
431
432 28:
433 gama := 180 - alpha - beta;
434
435 x1 := c / sin(gama* pi /180);
436 a  := x1 *sin(alpha* pi /180);
437 b  := x1 *sin(beta* pi /180);
438
439 s  := (a+b+c) / 2;
440 luas := sqrt(s * (s-a) * (s-b) * (s-c));
441 goto 2;
442
443 44:
444 beta := 180 - gama - alpha;
445
446 x1 := c / sin(gama* pi /180);
447 a  := x1 *sin(alpha* pi /180);
448 b  := x1 *sin(beta* pi /180);
449
450 s  := (a+b+c) / 2;
451 luas := sqrt(s * (s-a) * (s-b) * (s-c));
452 goto 2;
453
454 52:
455 alpha := 180 - gama - beta;
456
457 x1 := c / sin(gama* pi /180);
458 a  := x1 *sin(alpha* pi /180);
459 b  := x1 *sin(beta* pi /180);
460
461 s  := (a+b+c) / 2;
462 luas := sqrt(s * (s-a) * (s-b) * (s-c));
463 goto 2;
464
465 56:
466 writeln('Karena hanya sudut yang diketahui jadi luasnyapun tidak diketahui');
467 if (alpha+beta+gama)<>180 then writeln('Lagipula itu bukan segitiga yang baik dan benar');
468 goto 221;
469 2:
470 writeln;
471 writeln('----------------------------------------');
472 writeln('-----------------RESULTO----------------');
473 writeln('----------------------------------------');
474 writeln(' Panjang Sisi A       = ',a:8:2);
475 writeln(' Panjang Sisi B       = ',b:8:2);
476 writeln(' Panjang Sisi C       = ',c:8:2);
477 writeln;
478 writeln(' Besarnya Sudul Alpha = ',alpha:8:2);
479 writeln(' Besarnya Sudul Beta  = ',beta:8:2);
480 writeln(' Besarnya Sudul Gama  = ',gama:8:2);
481 writeln;
482 writeln(' Keliling Segitiga    = ',a+b+c:8:2);
483 writeln(' Luas Segitiga        = ',luas:8:2);
484 writeln;
485 writeln(' Radius Lingkaran Dlm = ',luas/s:8:2);
486 writeln(' Luas Lingkaran Dalam = ',sqr(luas/s)*22/7:8:2);
487 writeln(' Radius Lingkaran Luar= ',(a*b*c)/(4*luas):8:2);
488 writeln(' Luas Lingkaran Luar  = ',sqr((a*b*c)/(4*luas))*22/7:8:2);
489 a := sqrt(s*(s-b)*(s-c)/(s-a));
490 writeln(' R Lingkaran Sgg a    = ',a:8:2);
491 writeln(' L Lingkaran Sgg a    = ',sqr(a)*22/7:8:2);
492 b := sqrt(s*(s-a)*(s-c)/(s-b));
493 writeln(' R Lingkaran Sgg b    = ',b:8:2);
494 writeln(' L Lingkaran Sgg b    = ',sqr(b)*22/7:8:2);
495 c := sqrt(s*(s-b)*(s-a)/(s-c));
496 writeln(' R Lingkaran Sgg c    = ',c:8:2);
497 writeln(' L Lingkaran Sgg c    = ',sqr(c)*22/7:8:2);
498 221:
499 writeln('Mau ngitung lagi ? (Y / T)');readln(vara);
500 if (vara= 'Y') or (vara='y') then goto 97;
501 exit;
502 end. {source by Kamilersz}