Senin, 09 Januari 2012

Program Multilisting Sederhana

Berikut adalah contoh program multilisting sederhana :

PROGRAM MULTI_LIST;
USES CRT;
TYPE DBIO = RECORD
NPM : ARRAY [1..10] OF STRING [8];
NIRM : ARRAY [1..10] OF STRING [8];
NAMA : ARRAY [1..10] OF STRING [20];
ALAMAT : ARRAY [1..10] OF STRING [15];
END;
TYPE DNIRM = RECORD
NIRM2 : ARRAY [1..10] OF STRING [8];
TGM : ARRAY [1..10] OF STRING [10];
TGA : ARRAY [1..10] OF STRING [10];
END;

VAR FBIO : ARRAY [1..10] OF DBIO;
FNIRM : ARRAY [1..10] OF DNIRM;
FILEBIO : FILE OF DBIO;
FILENIRM : FILE OF DNIRM;
FILES : TEXT;
FILES2 : TEXT;
PIL : CHAR;
N : INTEGER;

LABEL RETURN;

PROCEDURE INPUT_DATA1;
VAR I,J : INTEGER;
BEGIN
CLRSCR;
ASSIGN(FILES,'F_BIO.TXT');
REWRITE(FILES);
WRITELN(' FILE BIODATA');WRITELN;WRITELN(FILES,' FILE BIODATA');WRITELN(FILES);
WRITE(' BANYAKNYA DATA : ');READLN(N);WRITELN(FILES,' BANYAKNYA DATA : ',N);
FOR I := 1 TO N DO
BEGIN
WITH FBIO[I] DO
BEGIN
WRITELN(' ');WRITELN(FILES);
WRITELN(' DATA KE-',I);WRITELN(FILES,' DATA KE-',I);
WRITE(' NPM : ');READLN(NPM[I]);WRITELN(FILES,' NPM : ',NPM[I]);
WRITE(' NIRM : ');READLN(NIRM[I]);WRITELN(FILES,' NIRM : ',NIRM[I]);
WRITE(' NAMA : ');READLN(NAMA[I]);WRITELN(FILES,' NAMA : ',NAMA[I]);
WRITE(' ALAMAT : ');READLN(ALAMAT[I]);WRITELN(FILES,' ALAMAT : ',ALAMAT[I]);
END;
END;
CLOSE(FILES);
END;

PROCEDURE VIEW_BIO;
VAR I,J : INTEGER;
BEGIN
CLRSCR;
FOR I := 1 TO N DO
BEGIN
FOR J := 1 TO N DO
BEGIN
WITH FBIO[I] DO
BEGIN
WITH FNIRM[J] DO
BEGIN
IF NIRM[I] = NIRM[J] THEN
BEGIN
END;
END;
GOTOXY(22,2);WRITELN('*****FILE BIODATA*****');
GOTOXY(3,5);WRITELN('-------------------------------------------------------------------');
GOTOXY(3,6);WRITELN('| NPM | NIRM | NAMA | ALAMAT |');
GOTOXY(3,7);WRITELN('-------------------------------------------------------------------');
GOTOXY(3,7+I);WRITE('|');
GOTOXY(4,7+I);WRITE(NPM[I]);
GOTOXY(14,7+I);WRITE('|');
GOTOXY(16,7+I);WRITE(NIRM[I]);
GOTOXY(22,7+I);WRITE('|');
GOTOXY(24,7+I);WRITE(NAMA[I]);
GOTOXY(38,7+I);WRITE('|');
GOTOXY(40,7+I);WRITE(ALAMAT[I]);
GOTOXY(62,7+I);WRITE('|');
END;
END;
END;
GOTOXY(3,8+I);WRITELN('-----------------------------------------------------------------');
READLN;
END;

PROCEDURE INPUT_DATA2;
VAR I,J : INTEGER;
BEGIN
CLRSCR;
ASSIGN(FILES2,'F_NIRM.TXT');
REWRITE(FILES2);
WRITELN(' FILE NIRM');WRITELN(FILES2,' FILE NIRM');WRITELN(FILES2);
WRITELN(' BANYAKNYA DATA : ',N);WRITELN(FILES2,' BANYAKNYA DATA : ',N);
FOR J:= 1 TO N DO
BEGIN
WITH FNIRM[J] DO
BEGIN
WRITELN('');WRITELN(FILES2);
WRITELN(' DATA KE-',J);WRITELN(FILES2,' DATA KE-',J);
WRITE(' NIRM : ');READLN(NIRM2[J]);WRITELN(FILES2,' NIRM : ',NIRM2[J]);
WRITE(' TANGGAL MULAI : ');READLN(TGM[J]);WRITELN(FILES2,' TANGGAL MULAI : ',TGM[J]);
WRITE(' TANGGAL HABIS : ');READLN(TGA[J]);WRITELN(FILES2,' TANGGAL HABIS : ',TGA[J]);
END;
END;
CLOSE(FILES2);
END;

PROCEDURE VIEW_NIRM1;
VAR I,J : INTEGER;
BEGIN
CLRSCR;
FOR I := 1 TO N DO
BEGIN
FOR J := 1 TO N DO
BEGIN
WITH FBIO[I] DO
BEGIN
WITH FNIRM[J] DO
BEGIN
IF NIRM[I] = NIRM[J] THEN
BEGIN
GOTOXY(11,5+I);WRITE(TGM[I]);
GOTOXY(24,5+I);WRITE(TGA[I]);
END ELSE
BEGIN
END;
END;
GOTOXY(15,2);WRITELN('*****FILE NIRM*****');
GOTOXY(3,5);WRITELN('----------------------------------------------------------');
GOTOXY(3,6);WRITELN('| NIRM | TANGGAL MASUK | TANGGAL AKHIR |');
GOTOXY(3,7);WRITELN('----------------------------------------------------------');
GOTOXY(3,7+I);WRITE('|');
GOTOXY(4,7+I);WRITE(NIRM[I]);
GOTOXY(10,7+I);WRITE('|');
GOTOXY(22,7+I);WRITE('|');
GOTOXY(34,7+I);WRITE('|');
END;
END;
END;
GOTOXY(3,8+I);WRITELN('-----------------------------------------------------------------');
READLN;
END;

PROCEDURE LINES;
VAR I, J: INTEGER;
BEGIN
FOR I := 1 TO 80 DO
WRITE('-');
END;

PROCEDURE VIEW_DATA;
VAR I,J : INTEGER;
BEGIN
CLRSCR;
FOR I := 1 TO N DO
BEGIN
FOR J := 1 TO N DO
BEGIN
WITH FBIO[I] DO
BEGIN
WITH FNIRM[J] DO
BEGIN
IF NIRM[I] = NIRM2[J] THEN
BEGIN
GOTOXY (55,6+I);WRITE(TGM[J]);
GOTOXY (68,6+I);WRITE(TGA[J]);
END ELSE
BEGIN
GOTOXY (52,6+I);WRITE('TIDAK ADA TANGGAL');
END;
END;
GOTOXY (31,2);WRITELN('DATA MAHASISWA');
GOTOXY (1,4);LINES;
GOTOXY (2,5);WRITELN('| NO | NPM | NIRM | NAMA | ALAMAT | TGL MASUK | TGL HABIS | ');
GOTOXY (1,6);LINES;
GOTOXY (2,6+I);WRITE(I:2);
GOTOXY (7,6+I);WRITE(NPM[I]);
GOTOXY (17,6+I);WRITE(NIRM[I]);
GOTOXY (27,6+I);WRITE(NAMA[I]);
GOTOXY (41,6+I);WRITE(ALAMAT[I]);
END;
END;
END;
GOTOXY (1,7+I);LINES;
READLN;
END;

BEGIN
REPEAT
RETURN:
CLRSCR;
GOTOXY (9,3);WRITELN('***** MENU *****');
GOTOXY (4,5);WRITELN('1. FILE BIODATA');
GOTOXY (4,6);WRITELN('2. TAMPILKAN FILE BIODATA');
GOTOXY (4,7);WRITELN('3. FILE NIRM');
GOTOXY (4,8);WRITELN('4. TAMPILKAN FILE NIRM');
GOTOXY (4,9);WRITELN('5. TAMPILKAN FILE MAHASISWA');
GOTOXY (4,10);WRITELN('6. KELUAR');
GOTOXY (4,11);WRITE('PILIHAN ANDA : ');READLN(PIL);
IF NOT (PIL IN ['1'..'6']) THEN
BEGIN
WRITELN(CHAR(7));
GOTOXY (23,13);WRITELN('PILIHAN SALAH !!!');
READLN;
GOTO RETURN;
END;
CASE PIL OF
'1' : INPUT_DATA1;
'2' : VIEW_BIO;
'3' : INPUT_DATA2;
'4' : VIEW_NIRM1;
'5' : VIEW_DATA;
END;
UNTIL PIL = '6';
END.








1 komentar:

  1. bosan kalah terus?

    silahkan coba daftar di Zeusbola!
    hanya dengan modal 50 ribu sudah bisa menjadi jutawan lohh bosquu


    INFO SELANJUTNYA SEGERA HUBUNGI KAMI DI :
    WHATSAPP :+62 822-7710-4607
    TELEGRAM :@zeusbola
    FACEBOOK :zeusbolame
    INSTAGRAM :@zeusbola.official
    TWITTER :@zeusbola

    #zeusbolaterpercaya#SitusDepositViaPulsa #depositviapulsa #agenSitusDepopulsa #agendepopulsa #agendepopakaiovo #depositviaovo #bonusfreechip #bonusfreebet

    BalasHapus