Monday, May 2, 2011

program utuh dalam pascal

uses wincrt;
var jum1,jum2,i,j : integer;
    pilihan : char;
label akhir;
procedure inputjum;
begin
    write('masukkan jumlah tabel1 : ');readln(jum1);
    write('masukkan jumlah tabel2 : ');readln(jum2);
end;
procedure simetris;
  var  nilai : array [1..100] of integer;
  jum:integer;
   simetris : boolean;
label keluar;
begin
writeln('-------------------------- Soal PERTAMA by Ncik CECE------------------- ');
writeln('-------------------------- SIMETRIS GAN ------------------------ ');
     writeln('masukkan jumlah isi tabelnya, nilainya harus genap ia.. :) ');
     readln (jum);
            if jum mod 2=0 then
               begin
               for i := 1 to jum do
               begin
                    write('masukkan nilai ke ',i, ' :');
                    readln(nilai [i]);
                    end;
     simetris := true ; 
     for i := 1 to round (jum/2) do
         begin
         j := jum-i+1;                
                       if nilai [i] <> nilai [j] then
                       begin
                            simetris := false;
                            goto keluar;
                            end;
               end;
               writeln;
         keluar:
         if simetris then
            writeln('iya nox simetris dia eee..')
            else
            writeln('nggak simetris tauk');
            end           
            else writeln ('jumlah harus genap ia');
            readkey;
     end;
 procedure sisipkan(jum1,jum2 : integer);
 var nilai1,nilai2:array[1..100] of integer;   
begin
writeln('-------------------------- Soal Dua by Ncik CECE------------------- ');
writeln('-------------------------- sisipkan tabel ------------------------ ');
    for i:=1 to jum1 do
        begin
        write('nilai tabel1 ke ',i,' : ');
        readln(nilai1[i]);
        end;
   for i:=1 to jum2 do
        begin
        write('nilai tabel2 ke ',i,' : ');
        readln(nilai2[i]);
        end;
   if jum1 > jum2 then
      begin
          j:=1;
          for i := jum1+1 to jum2+jum1 do
              begin
              nilai1[i] := nilai2[j];
              j:=j+1;
              end;

        {menampilkan nilai :}

        for i:= 1 to jum1+jum2 do
            writeln(nilai1[i]);
      end
    else
      begin
          j:=1;
          for i := jum2+1 to jum2+jum1 do
              begin
              nilai2[i] := nilai1[j];
              j:=j+1;
              end;
        for i:= 1 to jum1+jum2 do
            writeln(nilai2[i]);
      end;               
    readkey;
end;
procedure bandingkan(jum1,jum2:integer);
var nilai1,nilai2:array[1..100] of integer;
    beda : boolean;
begin
writeln('-------------------------- Soal tiga by Ncik CECE------------------- ');
writeln('-------------------------- sisipkan tabel ------------------------ ');         
   if jum1 = jum2 then
    begin
    for i:=1 to jum1 do
        begin
        write('nilai tabel1 ke ',i,' : ');
        readln(nilai1[i]);
        end;
   for i:=1 to jum2 do
        begin
        write('nilai tabel2 ke ',i,' : ');
        readln(nilai2[i]);
        end;
   beda := false;
          for i := 1 to jum1 do
          if nilai1[i] <> nilai2[i] then
                       beda := true;
   if beda then
      writeln('Tabel 1 dan tabel 2 berbeda')
      else writeln('tabel1 dan tabel 2 sama');
   end
   else  writeln(' jumlah harus sama  ');
     readkey;
end;
procedure tukarisi(jum1,jum2 : integer);
var nilai1,nilai2:array[1..100] of integer;
 temp:integer;
begin
     writeln('-------------------------- Soal empat by Ncik CECE------------------- ');
     writeln('-------------------------- tukar  isi  tabel ------------------------ ');      
   writeln;
    for i:=1 to jum1 do
        begin
        write('nilai tabel1 ke ',i,' : ');
        readln(nilai1[i]);
        end;
   writeln;
   for i:=1 to jum2 do
        begin
        write('nilai tabel2 ke ',i,' : ');
        readln(nilai2[i]);
        end;
   writeln;
   if jum1 < jum2 then
      for i:= 1 to jum1 do
          begin
              temp := nilai2[i];
              nilai2[i] := nilai1[i];
              nilai1[i] := temp;
          end
   else
       for i:= 1 to jum2 do
          begin
              temp := nilai2[i];
              nilai2[i] := nilai1[i];
              nilai1[i] := temp;
          end;
    writeln;
    writeln('tukar-tukar...');
   for i:=1 to jum1 do
       writeln('nilai tabel1 ke ',i, ' : ',nilai1[i]);
   writeln;
   for i:=1 to jum2 do
       writeln('nilai tabel2 ke ',i, ' : ',nilai2[i]);
   readln;
end;
procedure zigzag(jum1,jum2 : integer);
var nilai1,nilai2,hasil:array[1..100] of integer;
    index_a,index_b:integer;
begin
     writeln('-------------------------- Soal empat by Ncik CECE------------------- ');
     writeln('-------------------------- tukar zigzag  tabel ------------------------ ');                      
   writeln;
    for i:=1 to jum1 do
        begin
        write('nilai tabel1 ke ',i,' : ');
        readln(nilai1[i]);     
        end;
   writeln;
   for i:=1 to jum2 do
        begin
        write('nilai tabel2 ke ',i,' : ');
        readln(nilai2[i]);
        end;
   index_a := 1;
          index_b := 1;
if jum1 < jum2 then
begin
  for i:=  1 to jum1*2 do
   begin
       if i mod 2 = 0 then
       begin
       hasil[i] := nilai2[index_b];
        index_b := index_b +1;
       end
       else
       begin
           hasil[i] := nilai1[index_a];
                  index_a := index_A +1;
           end;
     end;
   for i := (jum1*2 +1) to ((jum2-jum1)+jum1*2)  do
       begin
            hasil[i] := nilai2[index_b];
            index_b := index_b +1;
       end;
 end
 else if jum1 > jum2 then
begin
  for i:=  1 to jum2*2 do
   begin
       if i mod 2 = 0 then
       begin
       hasil[i] := nilai1[index_a];
        index_a := index_a +1;
       end
       else
       begin
           hasil[i] := nilai2[index_b];
                  index_b := index_b +1;
           end;
     end;
   for i := (jum2*2 +1) to ((jum1-jum2)+jum2*2)  do
       begin
            hasil[i] := nilai1[index_a];
            index_a := index_a +1;
       end;
 end;    
   for i:= 1 to jum1+jum2 do
       writeln(hasil[i]);
       readkey;
end;
begin
 repeat
 clrscr;
writeln('-----------------------------------------------------');
writeln('                   program Cece                    ');
writeln('-----------------------------------------------------');
Writeln('1. cek tabel simetris ');
Writeln('2. sisipkan tabel 1 dan 2 ');
Writeln('3. bandingkan dua buah tabel ');
Writeln('4. tukar isi tabel');
Writeln('5. gabungkan secara zig-zag');
Writeln('6. keluar');
writeln('masukkan kode yang ingin anda pilih [1-5] : ');
pilihan := readkey;
case pilihan of
     '1' : begin
        simetris;
       end;
    '2' : begin
        inputjum;
        sisipkan(jum1,jum2);
        end;
    '3' : begin
        inputjum;
        bandingkan(jum1,jum2);
end;
    '4' : begin
        inputjum;
        tukarisi(jum1,jum2);
                end;
    '5' : begin
    inputjum;
    zigzag(jum1,jum2);
end;
    '6' : goto akhir;
else
    writeln ('pilihan salah!!!');
end;
 until pilihan = '6';
akhir:
end.

No comments:

Post a Comment