Zona ~MIKIR~

Program iseng tahun kemarin

sudah lama aq gak nyentuh programming pascal. Pas liat kerjaan tahun kemaren, waduh jadi lupa-lupa gitu. Tahun kemaren 2007, pas sy kelas 2 SMA, sy ikutan lomba yang ada di STT Telkom (ITT). yah, walaupun gagal dalam babak penyisihan, tapi tim satu lagi berhasil. Ada soal-soal ttg programming gitu. Sya dah bwat penyelesaiannya. Mudah2an bener. (ini dibuat tahun kemaren. jadi, klo ditanya sekarang, aq gak begitu hapal ttg prog ini. Maklum otaknya dah gak dipake selama satu tahun tuk ngeprogram)

1. Chess Board. Tugasnya disuruh bwat papan catur. Berikut kodenya (mudah2an ngarti) :

var a,b,x,y :integer;

begin
  write('Masukkan Input : ');
  readln(a);
  if (a<1) or (a>20) then
  writeln('Masukkan nilai dari 1-20')
  else
  begin
    for x:=1 to a do
    for y:=2 to a+1 do
    begin
      gotoxy(x,y);
      b:=x+y;
      if b mod 2 = 0 then write(' ') else write('*');
    end;
  end;

end.

2. Hourglass.

var
  banyakAngka: integer;
  bBaris, bKolom, i, j,n: integer;

begin
  write('Masukkan angka: ');readln(banyakAngka);
  n:=banyakAngka;
  if (n<3) or (n>25) then writeln('Masukkan nilai antara 3-25 bilangan ganjil') else
  if n mod 2 = 0 then writeln('Masukkan nilai ganjil') else
  begin
  banyakAngka:=(2*(banyakAngka-2))+1;
  bKolom:=banyakAngka;
  bBaris:=banyakAngka div 2 + 1;

  for j:=1 to bBaris-1 do
  begin
    for i:=1 to bKolom do
    begin
      if (i<=j-1) or (i>=BKolom-(j-2)) then
      begin
        write(' ');
      end
      else
      begin
        write('*');
      end;
    end;
    writeln;
  end;

  for j:=bBaris downto 1 do
  begin
    for i:=bKolom downto 1 do
    begin
      if (i<=j-1) or (i>=BKolom-(j-2)) then
      begin
        write(' ');
      end
      else
      begin
        write('*');
      end;
    end;
    writeln;
  end;
  end;
end.

3.Reverse

const
  inp='reverse.in';
  out='reverse.out';

var
  vFileInput : text;
  TempLine   : string ;
  rText      : string ;
  lText,i,j,c: integer;
  vTextFile  : string ;

begin
  writeln('file : reverse.in');
  assign(vFileInput, inp);
  reset(vFileInput);
  if IOResult=0 then
  begin
    while not Eof(vFileInput) do
    begin
      Readln(vFileInput, TempLine);
    end;
    Close(vFileInput);
  end;
  writeln(templine);
  lText:=length(templine)+1;
  rText:=templine;
  for i:=1 to lText do
  begin
    rText[i]:=templine[ltext-i];
  end;
  writeln('file : reverse.out');
  Assign(vFileInput, out);
  {$I-}
  rewrite(vFileInput);

  writeln(vFileInput, rText);

  Close(vFileInput);
  {$I+}
  writeln(rText);
end.

4. Minesweeper….

type  tArChar = array [1..100,1..100] of char;
      tArInte = array [1..100,1..100] of integer;

const cFinp = 'mines.in';
      cFout = 'mines.out';

var   vFile   : Text;
      X,Y,i,j : integer ;
      vText,z : String ;
      MinChar : tArChar ;
      MinInte : tArInte ;
      X2,Y2   : integer ;
      V       : String;

begin
  {Membersihkan Memori}
  begin
    for i:=1 to 100 do
    for j:=1 to 100 do
    begin
      MinChar[i,j]:=' ';
      MinInte[i,j]:=0;
    end;
  end;

  {Membaca File}
  begin
    {Memasukkan File}
    assign(vFile, cFinp);
    reset(vFile);
    readln(vFile, Y, X);
    for j:=1 to Y do
    begin
      readln(vFile,vText);
      for i:=1 to X do MinChar[i+1,j+1] := vText[i];
    end;
    close(vFile);
    {Mencetak File Input}
    begin
      writeln('File   : ',cFinp);
      writeln('Ukuran : ',X,' x ',Y);
      for j:=2 to Y+1 do
      for i:=2 to X+1 do
      if i=X+1 then writeln(MinChar[i,j]) else write(MinChar[i,j]);
    end;
  end;
  {MemProses Data}
  begin
    {Mengubah Data}
    begin
      X2:=X+1;
      Y2:=Y+1;
      for j:=2 to Y2 do
      begin
        for i:=2 to X2 do
        begin
          if MinChar[i,j] = '*' then
          begin
            MinInte[i-1,j-1] := MinInte[i-1,j-1] +1 ;
            MinInte[i-1,j  ] := MinInte[i-1,j  ] +1 ;
            MinInte[i-1,j+1] := MinInte[i-1,j+1] +1 ;
            MinInte[i,  j-1] := MinInte[i,  j-1] +1 ;
            MinInte[i,  j  ] := 0 ;
            MinInte[i,  j+1] := MinInte[i,  j+1] +1 ;
            MinInte[i+1,j-1] := MinInte[i+1,j-1] +1 ;
            MinInte[i+1,j  ] := MinInte[i+1,j  ] +1 ;
            MinInte[i+1,j+1] := MinInte[i+1,j+1] +1 ;
          end;
        end;
      end;
    end;
  end;
  {File Output & Cetak}
  begin
    writeln('File output : ',cFout);
    assign(vFile, cFout);
    reset(vFile);
    rewrite(vFile);
    begin
      writeln(vFile,Y,' ',X);
      for j:=2 to Y2 do
      begin
        v:='';
        for i:=2 to X2 do
        begin
          if MinChar[i,j] = '*' then z:=' ' else str(MinInte[i,j],z);
          V:= v + z;
        end;
        writeln(v);
        writeln(vFile,V);
      end;
    end;
    close(vFile);
  end;
{EOF}
end.