PASCAL

PROGRAM
# =========================================
# Picture Commander for Pokémon Essential
# =========================================
# Scripted by Storm
# Check the main script threat at Pokecommunity for informations.
# =========================================
class Window_PicCMD# < SpriteWindow_Base
  def initialize(scroll,loop,menuPic)
    @scroll = scroll
    #0 - Horizontal
    #1 - Vertical
    @loop = loop
    if @scroll != 0 and @scroll != 1
      @scroll = 0
    end
    #@menu = []
    @menu = menuPic
    @index = 0 #Default
    @lg = @menu.size - 1
    @e = []
    for i in 0..@lg
      @e[i] = true
    end
    @m=IconSprite.new(0,0)
    m = @menu[@index]
    @m.setBitmap(m)
    @way = 0
    @press = false
    update
  end
  def update
    if @scroll = 0
      scroll_l = Input::LEFT
      scroll_r = Input::RIGHT
    elsif @scroll = 1
      scroll_l = Input::UP
      scroll_r = Input::DOWN
    end
  
    if Input.trigger?(scroll_l)
      @index -= 1
      if @loop == true
        @index = @lg if @index == -1
      else
        @index = 0 if @index == -1
      end
      @way = 0
      @press = true
    elsif Input.trigger?(scroll_r)
      @index += 1
      if @loop == true
        @index = 0 if @index == @menu.size
      else
        @index = @lg if @index == @menu.size
      end
      @way = 1
      @press = true
    end
  
    if @press == true
      loop do
        if @e[@index] == false
          if @way == 0
            @index -= 1
          else
            @index += 1
          end
        end
        break if @e[@index] == true
      end
      if @loop == true
        if @way == 0
          @index = @lg if @index == -1
        else
          @index = 0 if @index == @menu.size
        end
      else
        if @way == 0
          @index = 0 if @index == -1
        else
          @index = @lg if @index == @menu.size
        end
      end
      @press = false
    end
  
    m = @menu[@index]
    @m.setBitmap(m)
  
  end
  def enable(index)
    @e[index] = true
  end
  def disable(index)
    @e[index] = false
  end
  def index=(index)
    @index = index
  end
  def index
    return @index
  end
  def dispose
    @m.opacity = 0
  end
  def visible=(b)
    if b
      @m.opacity = 255
    else
      @m.opacity = 0
    end
  end
  def opacity=(i)
    @m.opacity = i
  end
end.


COPPY

uses wincrt;
var
kode,kodejabatan,jabatan,kodejeniskelamin,jeniskelamin:string;
begin
write('input kode pegawai=');readln(kode);
kodejabatan:=copy(kode,1,1);
Kodejeniskelamin:=copy(kode,3,1);       
if (kodejabatan='A') or (kodejabatan='a') then
begin
jabatan:='direktur';
end
else if kodejabatan='B' then
begin
jabatan :='supervisor'
end
else if kodejabatan='C' then
begin
jabatan :='staff'
end;
if (kodejeniskelamin='P') then
begin
jeniskelamin:='Perempuan';
end
else
begin
jeniskelamin:='laki-laki';
end;
writeln('jabatan adalah',jabatan);
writeln('jenis kelamin',jeniskelamin);
end.

ARRAY

Program Fungsi_gotoxy_dan_array;
uses wincrt;
var n,a,i:integer;
kode,nama:array[1..3] of string;
jumlah:array[1..3] of integer;
harga,bayar:array[1..3] of longint;

begin
gotoxy(1,1);write('input banyak pengunjung=');readln(n);
clrscr;
gotoxy(1,1);write('taxi "INDAH"');
gotoxy(1,3);write('kode jumlah pemudik');
gotoxy(2,4);write('A1 Samarinda 15000');
gotoxy(2,5);write('A2 balikpapan 20000');
gotoxy(2,6);write('A3 bontang 25000');
gotoxy(1,7);writeln;
for i:=1 to n do
begin
writeln('pengunjung ke-',1);
write('input kode tiket=');readln(kode[i]);
write('input jumlah HARGA=');readln(jumlah[i]);
writeln;
if (kode[i]='A1')then
begin
nama[i]:='samarinda';
harga[i]:=15000;
end
else if (kode[i]='A2')Then
begin
nama[i]:='balikpapan';
harga[i]:=20000;
end
else if (kode[i]='A3')then
begin
nama[i]:='bontang';
harga[i]:=25000;
end
else
begin
nama[i]:='-';
harga[i]:=0;
end;
bayar[i]:=harga[i]*jumlah[i];
end;
clrscr;
gotoxy(7,1);writeln('data pengunjung taxsi');
gotoxy(1,3);write('no');
gotoxy(5,3);write('kode');
gotoxy(10,3);write('nama jurusan');
gotoxy(25,3);write('jumlah');
gotoxy(32,3);write('harga');
gotoxy(38,3);write('total bayar');
for i:= 1 to n do
begin
writeln;
gotoxy(1,3+i);writeln(i);
gotoxy(5,3+i);writeln(kode[i]);
gotoxy(10,3+i);writeln(nama[i]);
gotoxy(25,3+i);writeln(jumlah[i]);
gotoxy(32,3+i);writeln(harga[i]);
gotoxy(38,3+i);writeln(bayar[i]);
end;
end.

GAME XYZ

uses wincrt;
var pilihanku:string;
    komputer :string;
    a:integer;
    lagi : char;
    z,x,y:string;
begin
     repeat
     clrscr;
     randomize;
     a := Random(3);
     y := 'gunting';
     x := 'batu';
     z := 'kertas';

     writeln('----------------------------------------------------------');
     writeln('-----------------Silahkan Anda Pilihlah ------------------');
     writeln('----------------------------------------------------------');
     writeln('------------------------ gunting -------------------------');
     writeln('------------------------- batu ---------------------------');
     writeln('------------------------ kertas --------------------------');
     writeln('----------------------------------------------------------');
     writeln;
     write('             Masukkan Pilihan anda = '); readln(pilihanku);
     writeln;
     writeln('----------------------------------------------------------');
     writeln;

  
     if (a=0) then
     begin
     komputer:='gunting';
     end
     else if (a=1) then
     begin
     komputer:='batu';
     end
     else if (a=2) then
     begin
     komputer:='kertas';
     end;
     writeln('                Pilihan komputer = ',komputer);

     writeln;
     writeln('----------------------------------------------------------');
     writeln;

     if ( pilihanku= y) and (a = 0) then
     begin
     writeln('             Hasilnya Adalah anda Seri');
     end
     else if ( pilihanku= x) and (a = 0)  then
     begin
     writeln('             Hasilnya Adalah anda Kalah');
     end
     else if ( pilihanku= z) and (a = 0)  then
     begin
     writeln('             Hasilnya Adalah anda Menang');
     end

     else if ( pilihanku= y) and (a = 1)  then
     begin
     writeln('             Hasilnya Adalah anda Kalah');
     end
     else if ( pilihanku= x) and (a = 1)  then
     begin
     writeln('             Hasilnya Adalah anda Seri');
     end
     else if ( pilihanku= z) and (a = 1)  then
     begin
     writeln('             Hasilnya Adalah anda Menang');
     end

     else if ( pilihanku= y) and (a = 2)  then
     begin
     writeln('             Hasilnya Adalah anda Menang');
     end
     else if ( pilihanku= x) and (a = 2)  then
     begin
     writeln('             Hasilnya Adalah anda Kalah');
     end
     else if ( pilihanku= z) and (a = 2)  then
     begin
     writeln('             Hasilnya Adalah anda Seri');
     end;



 writeln('----------------------------------------------------------');
 write('               Apa ingin diUlang ?'); readln(lagi);
until  lagi ='n'
end.

PROCEDURE


program menghitungluas;

uses wincrt;
var p, l,pilihan,a,t,r : integer;
    luas: real;
    ulang:string;

procedure persegipanjang;
begin
writeln(' Menghitung Luas Persegi');
write('input panjang : ');readln(p);
write('input Lebar   : ');readln(l);               
luas:= p*l;
end;

procedure Segitiga;
begin
writeln(' Menghitung Luas Segitiga');
write('input Alas : ');readln(a);
write('input Tinggi   : ');readln(t);               
luas:= 0.5*a*t;
end;
procedure lingkaran;
begin
writeln('menghitung luas lingkaran');
write('input jari-jari: ');readln(r);
luas:=3.14*r*r;
end;
procedure menu;
begin
writeln(' Pilihan Menu ');
writeln(' 1. Menghitung Luas Persegi panjang');
writeln(' 2. Menghitung Luas segitiga');
writeln(' 3. Menghitung Luas lingkaran');
writeln;
write(' Input pilihan Kalian = ');readln(pilihan);
end;

begin
repeat;
clrscr;
menu;

case pilihan of
1 : persegipanjang;
2 : Segitiga;
3 :lingkaran;

end;

write('Luasnya adalah ',luas:0:2);
writeln;
Write(' mau mengitung lagi ?');readln(ulang);
until ulang = 'n';
end.