Bài KT pascal - Mới làm xong gần 3 bài nhé,xong sẽ update

Program detai1;

Type mang = array[1..255] of integer;

Var day:mang;n,i:byte;

{*********************************}

Procedure taomang;

Var i : byte;

Begin

Write('Dua ra so phan tu cua mang < 250 phan tu : ');readln(n);

Day[255]:=n;

For i:=1 to n do

Begin

Write('Nhap vao gia tri phan tu thu ',I,' : ');readln(day[i]);

End;

End;

{*********************************}

Procedure timmax;

Var

I,n:byte;max:integer;

Begin

N:=day[255];

For i:=2 to n do

If day[i-1] > day[i] then

max:=day[i-1]

else

max:=day[i];

day[254]:=max;

End;

{*********************************}

Procedure timmin;

Var

I,n:byte;min:integer;

Begin

N:=day[255];

For i:=2 to n do

If day[i-1] < day[i] then

min:=day[i-1]

else

min:=day[i];

day[253]:=min;

End;

{*********************************}

Procedure sapxep;

Var

I,n:byte;tg:integer;

Begin

N:=day[255];

For i:=2 to n do

Begin

If day[i-1] > day[i] then

Begin

day[i-1]:=tg;

Day[i]:=day[i-1];

Day[i-1]:=tg;

End;

End;

end;

{*********************************}

Begin

Taomang;

Sapxep;

timMax;

timMin;

Write('Min : ',day[253]);

Writeln('Max : ',day[254]);

for i:=1 to n do

write(day[i]);

Readln

End.

Program detai2;

Var n,a:integer;

{*********************************}

Function luythua(a,n:integer):longint;

Var I,ketqua,d:longint;

begin

For i:=1 to n do

begin

Ketqua:=a*a;

end;

Luythua:=ketqua;

End;

{*********************************}

Function giaithua(n:integer):longint;

Var ketqua:longint;i:byte;

begin

For i:=1 to n do

begin

Ketqua:=n*I;

end;

Giaithua:=ketqua;

{*********************************}

Begin

Write('Nhap a : ');read(a);write('so mu :');read(n);writeln(luythua(a,n));

Write('Nhap n : ');read(n);writeln(giaithua(n));

Read

End.

Program detai3;

Var

Xaugoc:string[30];

{*********************************}

Function chuhoa(xau:string):string;

Var kitu:char;I,dai:byte;

Begin

Dai:= length(xau);

For i:=1 to dai do

Xau[i]:= upcase(xau[i]);

Chuhoa:=xau;

End;

{*********************************}

Function kitudauinhoa(xau:string):string;

Var I,dai:byte;

begin

dai:=length(xau);

xau[1]:=upcase(xau[1]);

For i:=1 to dai do

If xau[i] = ' ' then

Xau[i+1] := upcase(xau[i+1]);

Kitudauinhoa:=xau;

End;

{*********************************}

Function daonguoc(xau:string):string;

Var I,dai:byte;

kq:string[30];

Begin

Dai:= length(xau);

dai:=dai mod 2;

for i:=1 to dai do

kq[i]:=xau[dai+1-1];

daonguoc:=kq;

end;

{*********************************}

Function xoakhoangtrang(xau:string):string;

Var I,dai:byte;

begin

Dai:=length(xau);

For i:=1 to dai do

If xau[i] = ' ' then

Delete(xau,I,1);

Xoakhoangtrang:=xau;

End;

{*********************************}

Begin

Write('Nhap xau duoi 30 ki tu : ');readln(xaugoc);

Writeln(chuhoa(xaugoc));

Writeln(kitudauinhoa(xaugoc));

Writeln(daonguoc(xaugoc));

Writeln(xoakhoangtrang(xaugoc));

Readln

End.

Program detai4;

var kt:boolean;

{*********************************}

function check(a,b,c:integer):boolean;

var kt,kt_1,kt_2,kt_3 : boolean;

begin

kt:=false;

if a+b>c then

kt_1:=true

else

kt_1:=false;

if a+c>b then

kt_2:=true

else

kt_2:=false;

if b+c>a then

kt_3:=true

else

kt_3:=false;

kt:=kt_1 and kt_2 and kt_3;

if kt=true then

check:=true

else

check:=false;

if kt=true then

Writeln('3 so vua cho co the lap thanh 1 tam giac')

Else

Writeln('3 so tren khong the lap thanh 1 tam giac');

End;

{*********************************}

procedure dientich(a,b,c:integer);

var S:real;

goca:real;

x:real;

Begin

X:=(Sqr(a)+sqr(b)-sqr(c))/(2*a*b);

Goca:= ArcTan (sqrt (1 - sqr(x)) /x);

S:=(a*b*sin(goca))/2;

writeln('Dien tich tam giac : ',S:6:2);

End;

{*********************************}

procedure trungtuyen(a,b,c:integer);

var tt1,tt2,tt3:real;

begin

tt1:= sqrt((((sqr(b)+sqr(c))/2)-(sqr(a))/4));

tt2:= sqrt((((sqr(c)+sqr(a))/2)-(sqr(b))/4));

tt3:= sqrt((((sqr(a)+sqr(b))/2)-(sqr(c))/4));

Writeln('Trung tuyen ung voi canh a la : ',tt1:6:2);

Writeln('Trung tuyen ung voi canh b la : ',tt2:6:2);

Writeln('Trung tuyen ung voi canh c la : ',tt3:6:2);

end;

{*********************************}

procedure nhap;

var a,b,c:integer;

tieptuc:integer;

begin

Write(' a : = ');readln(a);

Write(' b : = ');readln(b);

Write(' c : = ');readln(c);

kt:=check(a,b,c);

if kt=false then

Writeln('Khong the tim ra tiep tuyen vi khong co so lieu cua 1 tam giac')

else

Trungtuyen(a,b,c);

if kt=false then

Writeln('Khong the tim ra dien tich vi khong co so lieu cua 1 tam giac')

else

dientich(a,b,c);

End;

Begin

Nhap;

readln

End.

Program detai5;

Var a,b,c : integer;

ans:char;

{*********************************}

Procedure bac1;

Var a,b,c : integer;

kq:real;

Begin

Write('a = ');readln(a);

Write('b = ');readln(b);

kq:=b/a*-a;

writeln('Ket qua :',kq:6:2);

End;

{*********************************}

procedure bac2;

Var

a,b,c : integer;

x1:real;

x2:real;

delta:real;

begin

Write('a = ');readln(a);

If a=0 then

begin

Writeln('Luu y,a # 0 ');

Write('a = ');readln(a);

end;

Write('b = ');readln(b);

Write('c = ');readln(c);

delta:=sqr(b)-4*a*c;

x1:=((-b+sqrt(delta))/2);

x2:=((-b-sqrt(delta))/2);

Writeln('X1 : ',x1:6:2);

Writeln('X2 : ',x2:6:2);

end;

{*********************************}

Procedure trungtuyen;

Var

a,b,c:integer;





begin

Write('a = ');readln(a);

Write('b = ');readln(b);

Write('c = ');readln(c);













end;

{*********************************}

Begin

Repeat

Writeln('Ban can giai phuong trinh nao : ');

Writeln('1.Bac 1');

Writeln('2.Bac 2');

Writeln('3.Trung tuyen');

Writeln('4.Thoat');

Write('Phuong an : ');read(ans);

if ans = '1' then

bac1;

if ans = '2' then

bac2;

if ans = '3' then

trungtuyen

else

ans := '4'

until ans='4';

end.

[quote="Kid"]
Làm tạm được,nhưng công thức còn tệ lắm

Mù tịt...ghét nhất pascal