Sabtu, 26 Mei 2012

contoh program pascal sederhana

uses crt;
Type
    Larik = Array [1..1000] of Integer;
var
    pil, I, N, J, Tmp, Temp, Mx, Min, U: Integer;
    L: Larik;
    mat : array[1..2,1..2] of byte;
    jb : char;

Procedure InputData;
Begin
    For I := 1 To N Do
    Begin
        Write('Data Ke-', I, ': '); Readln(L[I]);
    end;
end;

Procedure SORT(L : Larik; N : Integer);


label awal;
begin
awal:
clrscr;
textcolor(4);
    writeLn('PROGRAM SORTING SEDERHANA');
    WriteLn('=====================================');
    WriteLn('Di Susun Oleh:');
    WriteLn('=====================================');
    WriteLn('ADIP');
    WriteLn('AMAD');
    WriteLn('HARJANTO');
    textcolor(14);
    WriteLn('=====================================');
    writeln('Tanggal pembuatan program 07 Mei 2012');
    WriteLn('=====================================');
    writeln('--PILIHAN SORT--');
    WriteLn('=====================================');
textcolor(2);
writeln(' 1. Bubble Sort ASCENDING');
writeln(' 2. Bubble Sort DESCENDING');
writeln(' 3. Maximum Sort ASCENDING');
writeln(' 4. Maximum Sort DESSCENDING');
writeln(' 5. Minimum Sort ASCENDING');
writeln(' 6. Minimum Sort DESCENDING');
writeln(' 7. Insertion Sort ASCENDING');
writeln(' 8. Insertion Sort DESCENDING');
writeln(' 9. EXIT Program ATAU Masukkan Data Yang Baru');
    WriteLn('=====================================');
writeln;
write('PILIHAN ANDA ADALAH :');readln(pil);
case pil of
1:begin
    ClrScr;
    For I := 1 To N-1 Do
    Begin
        For J := N-1 DownTo I Do
        Begin
            If L[J] > L[J+1] Then
            Begin
                Tmp := L[J];
                L[J] := L[J+1];
                L[J+1] := Tmp;
            End;
        End;
    End;
    WriteLn('PROGRAM BUBBLE SORTING ASCENDING');
    WriteLn('==================================');
    writeln('Data setelah diurutkan : ');
    WriteLn;
    For I := 1 To N Do
    Begin
        Write(L[I], ' ');
    End;
    WriteLn;
    WriteLn;
    WriteLn('==================================');
    WriteLn('Tekan ENTER Untuk Kembali Ke Menu');
    ReadLn;
    goto awal;
End;

2:Begin
    ClrScr;
    For I := 1 To N-1 Do
    Begin
        For J := N-1 DownTo I Do
        Begin
            If L[J] < L[J+1] Then
            Begin
                Tmp := L[J];
                L[J] := L[J+1];
                L[J+1] := Tmp;
            End;
        End;
    End;
    WriteLn('PROGRAM BUBBLE SORTING DESCENDING');
    WriteLn('==================================');
    writeln('Data setelah diurutkan : ');
    WriteLn;
    For I := 1 To N Do
    Begin
        Write(L[I], ' ');
    End;
    WriteLn;
    WriteLn;
    WriteLn('==================================');
    WriteLn('Tekan ENTER Untuk Kembali Ke Menu');
    ReadLn;
    goto awal;
End;

3:Begin
    ClrScr;
    U := N;
    For I := 1 To N-1 Do
    Begin
        Mx := 1;
        For J := 2 To U Do
        Begin
            If L[J] > L[Mx] Then Mx := J;
        End;
        Tmp := L[U];
        L[U] := L[Mx];
        L[Mx] := Tmp;
        U := U-1;
    End;

    WriteLn('PROGRAM SELECTION MAXIMUM ASCENDING');
    WriteLn('==================================');
    writeln('Data setelah diurutkan : ');
    WriteLn;

    For I := 1 To N Do
    Begin
        Write(L[I], ' ');
    End;
    WriteLn;
    WriteLn;
    WriteLn('==================================');
    WriteLn('Tekan ENTER Untuk Kembali Ke Menu');
    ReadLn;
    goto awal;
end;

4:Begin
    ClrScr;
    U := N;
    For I := 1 To N-1 Do
    Begin
        Mx := 1;
        For J := 2 To U Do
        Begin
            If L[J] < L[Mx] Then Mx := J;
        End;
        Tmp := L[U];
        L[U] := L[Mx];
        L[Mx] := Tmp;
        U := U-1;
    End;

    WriteLn('PROGRAM SELECTION MAXIMUM DESCENDING');
    WriteLn('==================================');
    writeln('Data setelah diurutkan : ');
    WriteLn;

    For I := 1 To N Do
    Begin
        Write(L[I], ' ');
    End;
    WriteLn;
    WriteLn;
    WriteLn('==================================');
    WriteLn('Tekan ENTER Untuk Kembali Ke Menu');
    ReadLn;
    goto awal;
end;

5:Begin
    clrscr;
    U := N;
    for i:= 1 to N-1 do
    begin
        Min := 1;
        for J:=2 to U do
        begin
            if L[J] > L[Min] then Min :=J;
        end;
        temp:= L[U];
        L[U] := L[Min];
        L[Min] := Temp;
        U:= U-1;
    end;
    writeln('PROGRAM SELECTION MINIMUM ASCENDING');
    WriteLn('==================================');
    writeln('Data setelah diurutkan : ');
    writeln;
    for i:=1 to N do
    begin
        write(L[i], ' ' );
    end;
    WriteLn;
    WriteLn;
    WriteLn('==================================');
    WriteLn('Tekan ENTER Untuk Kembali Ke Menu');
    readln;
    goto awal;
end;

6:Begin
    clrscr;
    U := N;
    for i:= 1 to N-1 do
    begin
        Min := 1;
        for J:=2 to U do
        begin
            if L[J] < L[Min] then Min :=J;
        end;
        temp:= L[U];
        L[U] := L[Min];
        L[Min] := Temp;
        U:= U-1;
    end;
    writeln('PROGRAM SELECTION MINIMUM DESCENDING');
    WriteLn('==================================');
    writeln('Data setelah diurutkan : ');
    writeln;
    for i:=1 to N do
    begin
        write(L[i], ' ' );
    end;
    WriteLn;
    WriteLn;
    WriteLn('==================================');
    WriteLn('Tekan ENTER Untuk Kembali Ke Menu');
    readln;
    goto awal;
end;

7:Begin
    clrscr;
    for i:=2 to N do
    begin
        Temp:= L[i];
        J:= i-1;
        while (L[J] > Temp) and (J > 0) do
        begin
            L[J+1] := L[J];
            Dec(J);
        end;
        L[J+1] := Temp;
    end;

    writeln('PROGRAM INSERTION ASCENDING');
    WriteLn('==================================');
    writeln('Data setelah diurutkan : ');
    writeln;
    for i:=1 to N do
    begin
        write(L[i], ' ' );
    end;
    WriteLn;
    WriteLn;
    WriteLn('==================================');
    WriteLn('Tekan ENTER Untuk Kembali Ke Menu');
    readln;
    goto awal;
end;

8:Begin
    clrscr;
    for i:=2 to N do
    begin
        Temp:= L[i];
        J:= i-1;
        while (L[J] < Temp) and (J > 0) do
        begin
            L[J+1] := L[J];
            Dec(J);
        end;
        L[J+1] := Temp;
    end;

    writeln('PROGRAM INSERTION DESCENDING');
    WriteLn('==================================');
    writeln('Data setelah diurutkan : ');
    writeln;
    for i:=1 to N do
    begin
        write(L[i], ' ' );
    end;
    WriteLn;
    WriteLn;
    WriteLn('==================================');
    WriteLn('Tekan ENTER Untuk Kembali Ke Menu');
    readln;
        goto awal;
end;

9:begin
     clrscr;
textcolor(14);
     writeln('--Thank you for using this Simple Program--');
     readln;
end;
end;
end;
Begin
    jb:='y';
repeat
    ClrScr;
textcolor(14);
    Write('Masukkan jumlah data : ');ReadLn(N);
    InputData;
    SORT(L, N);
    write('Apakah ingin memasukkan data yang baru (Y/T)? ');Readln(jb);
until (jb='T') or (jb='t');

end.

Tidak ada komentar: