sourc kode pascal 7

Program Indeks_Larik;
Uses Wincrt;
Var
   x      : Array [1..100] of Integer;
   i,n    : Integer;
   Ul     : Char;

Procedure CekIndeks(m: integer);
Var t: Integer;
Begin
  Writeln;
  Write('Nomor Indeks > Total Nilai Larik Sebelumnya Adalah: ');
  t:=0;
  For i := 1 to m-1 do



    Begin
      t:=t+x[i];
      if x[i+1]>t then
         Write(i+1,'  ');
    End;
End;

Begin
  Repeat
    ClrScr;
    Writeln('Program Menentukan Indeks Larik');
    Writeln('===============================');
    Writeln;
    Write('Jumlah Data : ');Readln(n);
    Writeln;
    For i := 1 to n do
      Begin
        Write('Data Ke-',i,': ');Readln(x[i]);
      End;
    CekIndeks(n);
    Writeln;Writeln;
    Write('Mau Coba Lagi [Y/T]: ');Readln(Ul);
  Until Upcase(Ul)<>'Y';
End.


Program Acckerman;
Uses Wincrt;

Function ACC(m,n:integer):integer;
Begin
  if m=0 then
    begin
      ACC:=n+1;
      Write(n+1,'  ');
    end
  else if n=0 then
    begin
      ACC:=ACC(m-1,1);
      Writeln(ACC(m-1,1),'  ');
    end
  else
    begin
      ACC:=ACC(m-1,ACC(m,n-1));
      Writeln(ACC(m-1,ACC(m,n-1)),'  ');
    end;
End;

Begin
  Writeln(ACC(2,1));
End.

Program Menghitung_Suku;
Uses Wincrt;
Var tot,suku:real;
    i:integer;
Begin
  tot:=0;
  suku:=2;
  While tot <= 3.9999 Do
    Begin
      tot:=tot+suku;
      i:=i+1;
      suku:=suku/2;
    End;
  writeln(i);
End.

Program Menyusun_Kali_Matrik;
Uses Wincrt;
Var i,j,n:integer;
Begin
  Write('Masukkan Jumlah Perkalian: ');Readln(n);
  Write('*':5);
  For i:= 1 to n do
    Write(i:5);
  Writeln;
  For i:= 1 to n do
    Begin
      Write(i:5);
      For j:= 1 to n do
        write(i*j:5);
      Writeln;
    End;
End.


Program matrik;
uses wincrt;
type data = array[1..10,1..10] of integer;
var matrikI,matrikII : data;
    baris,kolom,pil : integer;

procedure isimatrik;
var i,j : integer;
begin
 writeln('Penentuan ORDO MATRIK I');
 write('Masukan banyak baris matrik I = ');readln(baris);
 write('Masukan banyak kolom matrik I = ');readln(kolom);
 for i:=1 to baris do
   for j:=1 to kolom do
     begin
       gotoxy(j*10,i*5);
       readln(matrikI[i,j]);
     end;
 clrscr;
 writeln('Penentuan ORDO MATRIK II');
 write('Masukan banyak baris matrik II = ');readln(baris);
 write('Masukan banyak kolom matrik II = ');readln(kolom);
 for i:=1 to baris do
   for j:=1 to kolom do
     begin
       gotoxy(j*10,i*5);
       readln(matrikII[i,j]);
     end;
end;
procedure jumlahmatrik(m1,m2 : data);
var hasil : data;
    i,j : integer;
begin
  for i:=1 to baris do
    for j:=1 to kolom do
      begin
        hasil[i,j]:=m1[i,j]+m2[i,j];
      end;
  clrscr;
  writeln('Hasil Penjumlahan MATRIK');
  for i:=1 to baris do
    for j:=1 to kolom do
      begin
        gotoxy(j*10,i*5);
        write(hasil[i,j]);
      end;
end;

procedure kurangmatrik(m1,m2 : data);
var hasil : data;
    i,j : integer;
begin
  for i:=1 to baris do
    for j:=1 to kolom do
      begin
        hasil[i,j]:=m1[i,j]-m2[i,j];
      end;
  clrscr;
  writeln('Hasil Penjumlahan MATRIK');
  for i:=1 to baris do
    for j:=1 to kolom do
      begin
        gotoxy(j*10,i*5);
        write(hasil[i,j]);
      end;
end;

procedure kalimatrik(m1,m2 : data);
var hasil : data;
    i,j,z : integer;
begin
    for i:=1 to baris do
      for j:=1 to kolom do
        begin
          hasil[i,j]:=0;
          for z:=1 to baris do
             hasil[i,j]:=hasil[i,j]+m1[i,z]*m2[z,j];
        end;
    clrscr;
    writeln('Hasil Penjumlahan MATRIK');
    for i:=1 to baris do
      for j:=1 to kolom do
        begin
          gotoxy(j*10,i*5);
          write(hasil[i,j]);
        end;
end;
begin
  writeln(' M E N U');
  writeln('(1) Penjumlahan Matrik');
  writeln('(2) Pengurangan Matrik');
  writeln('(3) Perkalian Matrik');
  write('Pilihan = ');readln(pil);
  clrscr;
  case pil of
  1 : begin
        isimatrik;
        jumlahmatrik(matrikI,matrikII);
      end;
  2 : begin
        isimatrik;
        kurangmatrik(matrikI,matrikII);
      end;
  3 : begin
        isimatrik;
        kalimatrik(matrikI,matrikII);
      end;
  end;
end.