hitung huruf
program banyak_huruf_dalam_kalimat;
uses wincrt;
var n:array[1..26] of integer;
i,j:integer;
kata : String;
begin
for i:=1 to 26 do n[i]:=0;
write('Ketikkan sebuah kalimat : ');readln(kata);
for i:=1 to length(kata) do
for j:=1 to 26 do
if ord(upcase(kata[i]))=64+j then
inc(n[j]);
for i:=1 to 13 do
writeln(chr(64+2*i-1),' = ',n[2*i-1],' ',chr(64+2*i),' = ',n[2*i]);
end.
hitung vokal
uses wincrt;
var x : string;
jumlah,i , jumVokal, jumKonsonan, jumNonHuruf : integer;
begin
write('Masukkan kata : ');readln(x);
jumlah := 0;
for i:=1 to length(x) do
begin
if x[i] in ['A','a','i] then jumlah := jumlah + 1;
end;
jumVokal := jumlah;
writeln('Jumlah huruf vokal : ',jumVokal);
end.
fibonacci
uses wincrt;
var
i,n,f,f1,f2 : longint;
pil:char;
label A,B,C,D,E;
begin
A: clrscr;
writeln(' --------------------------------');
writeln(' MENAMPILKAN DERET FIBONACCI');
writeln(' --------------------------------');
write(' MASUKKAN SUKU KE- N (1-46) : ');readln(n);
if (n>46) or (n<1) then goto A;
if n=1 then goto B;
write;
write('1 ');
write('1 ');goto C;
B: write('1 ');
C: f1 :=1; f2:=1;
for i:=3 to n do
begin
f:=f1+f2;
write(F,' ');
f2:=f1; f1:=f;
end;
writeln;
write('jadi suku ke ',n);write(' adalah ',f);
end.
program cari_suku_fibonacci;
uses wincrt;
var x:array[1..50] of integer;
i,n:integer;
begin
x[1]:=1; x[2]:=1;
write('Anda mencari suku ke : ');readln(n);
write(x[1],' ');
write(x[2],' ');
for i:=3 to n do
begin
x[i]:=x[i-1]+x[i-2];
write(x[i],' ');
end;
writeln;
writeln('Suku ke ',i,' = ',x[i]);
readln;
end.
matrix
Uses wincrt;
Var bar, kol, I, J, A, B : Integer ;
Begin
write('masukkak bil I : ');readln(A);
write('masukkan bil II : ');readln(B);
Write('masukkan jumlah baris : ');readln(bar);
write('masukkan jumlah kolom : ');readln(kol);
clrscr;
For I := 1 To bar Do
Begin
For J := 1 To kol DO
Write (A,' ',B,' ') ;
Writeln ;
End ;
End.
pangkat
uses wincrt;
var i,n,m: integer;
x: real;
function pangkat(n,m:integer):real;
var x: real;
begin
x:=1;
if (n>0) then
for i:= 1 to n do
x:=x*m
else if (n=0) then
x:=1
else
begin
for i:= 1 to (abs(n)) do
begin
x:=x*(1/m);
end;
end;
pangkat:=x;
end;
begin
writeln('Program Menghitung Pangkat');
writeln('==========================');
writeln;
write('Masukkan Bil. Yang DiPangkat : ');readln(m);
write('Masukkan Jumlah Pangkat : ');readln(n);
writeln;
x:=pangkat(n,m);
writeln('Hasil Pangkat: ',x:6:2);
writeln;
writeln('Tekan sembarang tombol untuk mengakhiri...');readln;
end.
PERMUTASI
uses wincrt;
const Max = 10;
type Larik = array[1..Max] of Char;
var A : Larik;
C_Per,C_El,i : Longint;
Kal : string;
Lagi : char;
procedure Permutasi(var B : longint;A : Larik;K,N : longint);
var Temp : char;
i : integer;
begin
if K = N then
begin
B := Succ(B);
for i := 1 to N do
write(A[i]);
writeln;
end
else
for I := K to N do
begin
Temp := A[i];
A[i] := A[K];
A[K] := Temp;
permutasi(B,A,K+1,N);
end
end;
procedure Isi;
begin
for i := 1 to Length(Kal) do
A[i] := Kal[i];
C_El := Length(Kal);
end;
begin
repeat
write('Karakter anda = ');readln(Kal);
Isi;
C_per := 0;
permutasi(C_Per,A,1,C_El);
writeln('Banyak Permutasi : ',C_Per:3);
write('Ingin lagi (Y/T) ');readln(Lagi);
until Lagi in['t','T'];
end.
permutasi
uses wincrt;
const Max = 10;
type Larik = array[1..Max] of Char;
var A : Larik;
C_Per,C_El,i : Longint;
Kal : string;
Lagi : char;
ang:integer;
procedure Permutasi(var B : longint;A : Larik;K,N : longint);
var Temp : char;
i : integer;
begin
if K = N then
begin
B := Succ(B);
for i := 1 to N do
write(A[i]);
writeln;
end
else
for I := K to N do
begin
Temp := A[i];
A[i] := A[K];
A[K] := Temp;
permutasi(B,A,K+1,N);
end
end;
procedure Isi;
begin
for i := 1 to Length(Kal) do
A[i] := Kal[i];
C_El := Length(Kal);
end;
begin
repeat
write('Karakter anda = ');readln(ang);
if ang =1 then
kal:='A'
else if ang=2 then
kal:= 'AB'
else if ang=3 then
kal:= 'ABC'
else if ang=4 then
kal:= 'ABCD'
else if ang=5 then
kal:= 'ABCDE'
else if ang=6 then
kal:= 'ABCDEF'
else if ang=7 then
kal:= 'ABCDEFG'
else if ang=8 then
kal:= 'ABCDEFGH'
else if ang=9 then
kal:= 'ABCDEFGHI'
else
writeln('kebanyakan');
Isi;
C_per := 0;
permutasi(C_Per,A,1,C_El);
writeln('Banyak Permutasi : ',C_Per:3);
write('Ingin lagi (Y/T) ');readln(Lagi);
until Lagi in['t','T'];
end.
segitiga pascal
uses wincrt;
var
i,j : integer;
s : string;
begin
clrscr;
write('Input : ');
readln(s);
writeln('Output : ');
for i:=1 to length(s) do
begin
for j:=1 to i do
begin
if j > 1 then write ('-');
write(copy(s,j,1));
end;
writeln;
end;
readln;
end.
matrikkk
Uses wincrt;
Var
Matrik : array[1..3,1..2] of shortint;
I, J : Byte;
Begin
Matrik[1,1] := -11;
Matrik[2,1] := -76;
Matrik[3,1] := 8;
Matrik[1,2] := -1;
Matrik[2,2] := 11;
Matrik[3,2] := 18;
For I := 1 to 3 do
Begin
For J := 1 to 2 do
Write (Matrik[I,J]:5);
Writeln;
End;
Readln;
End.
game
uses wincrt;
var
x, jumlah : byte;
ch : char;
hitung : longint;
procedure tampil(kartu :byte);
var
x: byte;
begin
for x:=1 to 255 do
begin
hitung := hitung +1;
if (x and (1shl (kartu-1)) <>0 ) then
write (x:4,' ');
if hitung mod 20 = 0 then
writeln;
end;
end;
begin
clrscr;
writeln ('Konsentrasi, Pikirkan Sebuah Bilangan Antara 1 Sampai 255');
writeln ('Jika Sudah, Tekan Sembarang Tombol');
ch := readkey;
jumlah :=0;
for x:=1 to 8 do
begin
clrscr;
tampil (x);
writeln;
write ('Apakah Bilangan Yang Anda Pikirkan Ada Di Atas?? (Y/T)');
ch :=readkey;
writeln;
if (ch='y') or (ch='Y') then inc (jumlah, 1 shl (x-1));
end;
clrscr;
writeln ('Anda Memikirkan Bilangan : ', jumlah);
readkey;
readln;
end.
bintang
uses wincrt;
var i,j,n : integer;
begin
Writeln;
write('Masukin Jumlah bintang terahir : ');readln(n);
i:=(2-(n mod 2));
repeat
for j:=1 to (abs(n-i) div 2) do write('-');
for j:=1 to (n-(2*(abs(n-i) div 2))) do write('*');writeln;
i:=i+2;
until (i>(n*2));
end.
bintang
uses wincrt;
var i,j,n : integer;
begin
Writeln;
write('Masukin Jumlah bintang terahir : ');readln(n);
i:=(1-(n mod 1));
repeat
for j:=1 to (n-i) div 1 do write(' ');
for j:=1 to (n-(2*((n-i) div 1))) do write('*');
writeln;
i:=i+1;
until (i>n);
end
case
uses wincrt;
var
bil1,bil2,hasil:real;
op,I:integer;
begin
write('Bilangan 1 : ');readln(bil1);
write('Bilangan 2 : ');readln(bil2);
GotoXY(1,5);writeln('1. Tambah 2. Kurang 3. Kali 4. Bagi');
GotoXY(1,4);write('Operator : ');readln(op);
case op of
1:begin
hasil := bil1+bil2;
GotoXY(20,3);writeln('Hasil : ',hasil:0:2);
end;
2:begin
hasil := bil1-bil2;
GotoXY(20,3);writeln('Hasil : ',hasil:0:2);
end;
3:begin
hasil := bil1*bil2;
GotoXY(20,3);writeln('Hasil : ',hasil:0:2);
end;
4:begin
hasil := bil1/bil2;
GotoXY(20,3);writeln('Hasil : ',hasil:0:2);
end;
end;
readln;
clrscr;
begin
writeln('Bilangan 1 : ',hasil:0:2);
bil1:=hasil;
write('Bilangan 2 : ');readln(bil2);
GotoXY(1,5);writeln('1. Tambah 2. Kurang 3. Kali 4. Bagi');
GotoXY(1,4);write('Operator : ');readln(op);
case op of
1:begin
hasil := bil1+bil2;
GotoXY(20,3);writeln('Hasil : ',hasil:0:2);
end;
2:begin
hasil := bil1-bil2;
GotoXY(20,3);writeln('Hasil : ',hasil:0:2);
end;
3:begin
hasil := bil1*bil2;
GotoXY(20,3);writeln('Hasil : ',hasil:0:2);
end;
4:begin
hasil := bil1/bil2;
GotoXY(20,3);writeln('Hasil : ',hasil:0:2);
end;
end;
end;
end.
Tidak ada komentar:
Posting Komentar