Sekilas Saya

Foto saya
batam, riau, Indonesia
Sinar matamu tajam namun ragu Kokoh sayapmu semua tahu Tegap tubuhmu takkan tergoyahkan Kuat jarimu kalau mencengkeram Bermacam suku yang berbeda Bersatu dalam cengkeramanmu Angin genit mengelus merah putihku Yang berkibar sedikit malu-malu Merah membara tertanam wibawa Putihmu suci penuh kharisma Pulau pulau yang berpencar Bersatu dalam kibarmu Terbanglah garudaku Singkirkan kutu-kutu di sayapmu Berkibarlah benderaku Singkirkan benalu di tiangmu Jangan ragu dan jangan malu Tunjukkan pada dunia Bahwa sebenarnya kita mampu

Jumat, 02 Maret 2012

turbo pascal







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: