Program data mahasiswa(pascal)

-


contoh program input data mahasiswa dengan pascal.

Listing Programnya ;
Program Data_Mahasiswa;
Uses WinCrt;
Type Mahasiswa = Record
NoMhs : Word;
Nama  : String[20];
IPK   : Real;
Usia  : Byte;
end;
Var Filemhs  : File of Mahasiswa;
Data     : Mahasiswa;
Pil,Ul   : Char;
Procedure Menu;
Begin
Clrscr;
Gotoxy(34,1);Write(‘MENU PILIHAN’);
Gotoxy(34,2);Write(‘============’);
Gotoxy(27,4);Write(’1. Tambah Data Mahasiswa’);
Gotoxy(27,5);Write(’2. Edit Data Mahasiswa’);
Gotoxy(27,6);Write(’3. Hapus Data Mahasiswa’);
Gotoxy(27,7);Write(’4. Tampilkan Data Mahasiswa’);
Gotoxy(27,8);Write(’5. View Mahasiswa Berdasarkan Umur’);
Gotoxy(27,9);Write(’6. Hapus NoMhs Ganjil’);
Gotoxy(27,10);Write(’9. Keluar (Exit)’);
Gotoxy(32,12);Write(‘Pilihan [1..9]: ‘);Pil:=Readkey;
End;
Procedure BukaFile;
Begin
Assign(FileMhs,’Mhs.Dat’);
{$I-};
Reset(FileMhs);
{$I+};
End;
Procedure Tambah;
Var Lagi: Char;
Ada : Boolean;
i   : Integer;
NOCR: Word;
Begin
Ul:=’Y';
Lagi:=’Y';
Clrscr;
BukaFile;
If IOResult<>0 Then
Rewrite(FileMhs);
Repeat
Clrscr;
Ada:=False;
i:=0;
Gotoxy(30,1);Write(‘TAMBAH DATA MAHASISWA’);
Gotoxy(30,2);Write(‘=====================’);
Gotoxy(20,4);Write(‘No. Mahasiswa  : ‘);Readln(NOCR);
While (Ada=False) And (i<>Filesize(FileMhs)) Do
Begin
Seek(FileMhs,i);
Read(FileMhs,Data);
If Data.NoMhs=NOCR Then
Ada:=True
Else
Inc(i);
End;
If (Ada=True) Then
Begin
Gotoxy(20,9);Write(‘Nomor Mahasiswa “‘,NOCR,’” Ini Sudah Ada!’);
End
Else
Begin
Seek(FileMhs,Filesize(FileMhs));
Data.NoMhs:=NOCR;
Gotoxy(20,5);Write(‘Nama Mahasiswa : ‘);Readln(Data.Nama);
Gotoxy(20,6);Write(‘IPK            : ‘);Readln(Data.IPK);
Gotoxy(20,7);Write(‘Umur           : ‘);Readln(Data.Usia);
Write(FileMhs,Data);
End;
Gotoxy(20,10);Write(‘Mau Tambah Data Lagi [Y/T]:’);Lagi:=Upcase(Readkey);
Until Lagi<>’Y';
Close(FileMhs);
End;
Procedure Edit;
Var Lagi: Char;
Ada : Boolean;
i   : Integer;
NOCR: Word;
Begin
Ul:=’Y';
Lagi:=’Y';
Clrscr;
BukaFile;
If IOResult<>0 Then
Write(‘Data Masih Kosong…!’)
Else
Begin
Repeat
Clrscr;
Ada:=False;
i:=0;
Gotoxy(30,1);Write(‘EDIT DATA MAHASISWA’);
Gotoxy(30,2);Write(‘=====================’);
Gotoxy(20,4);Write(‘No. Mahasiswa  : ‘);Readln(NOCR);
While (Ada=False) And (i<>Filesize(FileMhs)) Do
Begin
Seek(FileMhs,i);
Read(FileMhs,Data);
If Data.NoMhs=NOCR Then
Begin
Ada:=True;
Gotoxy(20,5);Write(‘Nama Mahasiswa : ‘,Data.Nama);
Gotoxy(20,6);Write(‘IPK            : ‘,Data.IPK:1:2);
Gotoxy(20,7);Write(‘Umur           : ‘,Data.Usia);
End
Else
Inc(i);
End;
If (Ada=True) Then
Begin
Data.NoMhs:=NOCR;
Gotoxy(20,9);Write(‘Nama Mahasiswa : ‘);Readln(Data.Nama);
Gotoxy(20,10);Write(‘IPK            : ‘);Readln(Data.IPK);
Gotoxy(20,11);Write(‘Umur           :’);Readln(Data.Usia);
Seek(FileMhs,i);
Write(FileMhs,Data);
End
Else
Begin
Gotoxy(20,13);Write(‘Nomor Mahasiswa “‘,NOCR,’” Ini Tidak Ada!’);
End;
Gotoxy(20,14);Write(‘Mau Edit Data Lagi [Y/T]:’);Lagi:=Upcase(Readkey);
Until Lagi<>’Y';
End;
Close(FileMhs);
End;
Procedure Hapus;
Var FileTmp   : File of Mahasiswa;
Lagi,Hapus: Char;
Ada       : Boolean;
i         : Integer;
NOCR      : Word;
Begin
Ul:=’Y';
Lagi:=’Y';
Clrscr;
Repeat
BukaFile;
If IOResult<>0 Then
Write(‘Data Masih Kosong…!’)
Else
Begin
Clrscr;
Assign(FileTmp,’mhs.tmp’);
Rewrite(FileTmp);
Ada:=False;
i:=0;
Gotoxy(30,1);Write(‘HAPUS DATA MAHASISWA’);
Gotoxy(30,2);Write(‘=====================’);
Gotoxy(20,4);Write(‘No. Mahasiswa  : ‘);Readln(NOCR);
While (Ada=False) And (i<>Filesize(FileMhs)) Do
Begin
Seek(FileMhs,i);
Read(FileMhs,Data);
If Data.NoMhs=NOCR Then
Ada:=True
Else
Inc(i);
End;
If (Ada=True) Then
Begin
Gotoxy(20,5);Write(‘Nama Mahasiswa : ‘,Data.Nama);
Gotoxy(20,6);Write(‘IPK            : ‘,Data.IPK:1:2);
Gotoxy(20,7);Write(‘Umur           : ‘,Data.Usia);
Gotoxy(20,9);Write(‘Data Ini Mau Di Hapus [Y/T]:’);Readln(Hapus);
If Upcase(Hapus)=’Y’ Then
Begin
For i := 1 to Filesize(FileMhs) Do
Begin
Seek(FileMhs,i-1);
Read(FileMhs,Data);
If Data.NoMhs<>NOCR Then
Write(FileTmp,Data);
End;
Close(FileMhs);
Assign(FileMhs,’MHS.Dat’);
Erase(FileMhs);
Assign(FileTmp,’Mhs.tmp’);
Rename(FileTmp,’Mhs.Dat’);
Gotoxy(20,10);Write(‘Nomor Mahasiswa “‘,NOCR,’” Sudah Di Hapus!’);
End;
End
Else
Begin
Gotoxy(20,10);Write(‘Nomor Mahasiswa “‘,NOCR,’” Ini Tidak Ada!’);
End;
Gotoxy(20,11);Write(‘Mau Hapus Data Lagi [Y/T]:’);Lagi:=Upcase(Readkey);
End;
Until Lagi<>’Y';
End;
Function RataIPK(TIPK:Real;n:integer):Real;
Begin
RataIPK:=TIPK/n;
End;
Procedure Tampil;
Var i    : Integer;
TIPK : Real;
Begin
Ul:=’Y';
TIPK:=0;
BukaFile;
If IoResult <>  0 Then
Write(‘Maaf Data Masih Kosong ! ‘)
Else
Begin
Clrscr;
Writeln(‘                DATA MAHASISWA                  ‘);
Writeln(‘            STT DUTA BANGSA  BEKASI             ‘);
Writeln;
Writeln(‘================================================’);
Writeln(‘ NO   NIM                NAMA    IPK       UMUR ‘);
Writeln(‘================================================’);
i:=0;
While Not EoF(FileMhs) Do
Begin
Inc(i);
Read(FileMhs,Data);
Writeln(i:3,Data.NoMhs:6,Data.Nama:20,Data.IPK:8:2,Data.Usia:10);
TIPK:=TIPK+Data.IPK;
End;
Writeln(‘================================================’);
Writeln(‘Rata-Rata IPK: ‘,RataIPK(TIPK,i):1:2);
Writeln(‘================================================’);
Close(FileMhs);
End;
Writeln;
Write(‘Press Any Key to Continue…’);Readkey;
End;
Procedure View_Umur;
Var i    : Integer;
Umur : Byte;
Lagi : Char;
Begin
Ul:=’Y';
Lagi:=’Y';
Repeat
Clrscr;
Write(‘Tampilkan Umur Besar Dari: ‘);Readln(Umur);
BukaFile;
If IoResult <>  0 Then
Write(‘Maaf Data Masih Kosong ! ‘)
Else
Begin
Writeln(‘                DATA MAHASISWA                  ‘);
Writeln(‘             UMUR DI ATAS ‘,Umur:2,’ TAHUN’);
Writeln;
Writeln(‘================================================’);
Writeln(‘ NO   NIM                NAMA    IPK       UMUR ‘);
Writeln(‘================================================’);
i:=0;
While Not EoF(FileMhs) Do
Begin
Read(FileMhs,Data);
If Data.Usia>Umur Then
Begin
Inc(i);
Writeln(i:3,Data.NoMhs:6,Data.Nama:20,Data.IPK:8:2,Data.Usia:10);
End;
End;
Writeln(‘================================================’);
Close(FileMhs);
End;
Writeln;
Write(‘Mau Lihat Data Lagi [Y/T]: ‘);Lagi:=Upcase(Readkey);
Until Lagi<>’Y';
End;
Procedure Hapus_NoMhs;
Var FileTmp   : File of Mahasiswa;
Lagi,Hapus: Char;
i         : Integer;
Begin
Ul:=’Y';
Lagi:=’Y';
Clrscr;
Repeat
BukaFile;
If IOResult<>0 Then
Write(‘Data Masih Kosong…!’)
Else
Begin
Clrscr;
Assign(FileTmp,’mhs.tmp’);
Rewrite(FileTmp);
i:=0;
Gotoxy(20,3);Write(‘Mau Menghapus No. Mahasiswa Yang Ganjil [Y/T]: ‘);Readln(Hapus);
If Upcase(Hapus)=’Y’ Then
Begin
For i := 1 to Filesize(FileMhs) Do
Begin
Seek(FileMhs,i-1);
Read(FileMhs,Data);
If (Data.NoMhs Mod 2)=0 Then
Write(FileTmp,Data);
End;
Close(FileMhs);
Assign(FileMhs,’Mhs.Dat’);
Erase(FileMhs);
Assign(FileTmp,’Mhs.tmp’);
Rename(FileTmp,’Mhs.Dat’);
Gotoxy(20,10);Write(‘Nomor Mahasiswa Sudah Di Hapus!’);
End;
Gotoxy(20,11);Write(‘Mau Hapus Data Lagi [Y/T]:’);Lagi:=Upcase(Readkey);
End;
Until Lagi<>’Y';
End;
Begin
Repeat
Menu;
Case Pil Of
’1′ : Tambah;
’2′ : Edit;
’3′ : Hapus;
’4′ : Tampil;
’5′ : View_Umur;
’6′ : Hapus_NoMhs;
End;
Until (Ul<>’Y') Or (Pil=’9′);
DoneWinCrt;
End.

Comments

Post a Comment

Popular posts from this blog

"DAFTAR ALAMAT EMAIL PERUSAHAAN"

-
Harap disimpan dan disebarkan info ini ke teman2 ga_aai@centrin.com PT. AICHIKIKI AUTOPARTS INDONESIA hrd.info@airliquide.com PT. AIRLIQUIDE INDONESIA recruitment@aisin-indonesia.co.id amelia@aisin-indonesia.co.id PT. AISIN INDONESIA recruitment@akebono-astra.co.id PT. AKEBONO BRAKE ASTRA INDONESIA hrd@anekagas.com PT. ANEKA GAS INDUSTRI hrd_recruitment@arnotts.com PT. ARNOTT'S INDONESIA asianet@cbn.net.id PT. ASIANET SPRING INDONESIA ptafmii@indosat.net.id PT. ASIATEC FUJISAWA MANUFACTURING INDONESIA asakura@ahi.co.id PT. ASNO HORIE Intan.Yaniar@component.astra.co.id recruitment@component.astra.co.id PT. ASTRA COMPONENT recruitment@dso.astra.co.id PT. ASTRA DAIHATSU MOTOR arc@ai.astra.co.id PT. ASTRA INTERNATIONAL atsumi@dnet.net.id PT. ATSUMI INDONESIA hiroshi_maruyama@atsumitec.co.jp PT. ATSUMITEC INDONESIA recruitment@tso.astra.co.id AUTO2000 recruitment.fci@faber-castell.co.id PT. AW FABER CASTELL INDONESIA yani@aztecs-ind...
Read more

Menghitung luas kubus,persegi panjang dan lingkaran

-
Image
listing programmnya : Private Sub Command1_Click() Text4.Text = 6 * Val(Text2.Text) * Val(Text2.Text) Text5.Text = Val(Text1.Text) * Val(Text2.Text) Text6.Text = 3.14 * Val(Text3.Text) * Val(Text3.Text) End Sub Private Sub Command2_Click() Unload Me End Sub Filed under: visual basic | 1 Komentar » program cek password Posted on 30 Agustus 2010 by sttdb buat program cek password ,jika password sama makan akan keluar,jika tidak maka akan ada pesan kesalahan(gunakan show mesage) inputanya adalah nama,password ,confirm password. OK kita mulai listing programmnya Private Sub Command1_Click() Dim intKeluar As Integer Do While (True) If (Text1.Text = “admin” And Text2.Text = “sttdb”) Then intpesan = MsgBox(“Password Anda Benar!”, , “informasi”) Unload Form1 ‘akan mengeluakan anda dari form1 End Else intpesan = MsgBox(“password Anda Salah!Ulangi!”, , “informasi”) Text1.Text = “” ‘bila mengulangi mengisi...
Read more

Program menghitung resistor dengan bahasa c

-
Image
Listing Programnya : //PROGRAM MENGHITUNG NILAI SUATU RESISTOR DENGAN MEMBACA GELANG WARNANYA #include <stdio.h> #include <math.h> #include <stdlib.h> #include <conio.h> //pendeklarasian fungsi int salah(); int kerja(); int htgkembali(); int hitungcetak(double x, double y, double z); void main()//bagian utama program { kerja();//memanggil fungsi kerja } int kerja() { int a, b, c, g, z, gel[3]; //pendeklarasian variabel dan array bertipe integer double g1,g2,x,y; //pendeklarasian veriabel bertipe double printf(“PROGRAM MENGHITUNG NILAI SUATU RESISTOR DENGAN MEMBACA GELANG WARNANYA\n”); printf(“[0] Hitam\n[1] Coklat\n[2] Merah\n[3] jingga\n[4] Kuning\n[5] Hijau\n”); printf(“[6] Biru\n[7] Ungu\n[8] Abu-Abu\n[9] Putih\n”); printf(“[10] Emas\n[11] Perak\n[12] Tak Berwarna\n\n”); printf(“nb: ketik angka/hurufnya saja!\n\n”); for (g=0;g<=3;g++) //perulangan untuk menginput warna gelang { printf(“Ketikkan warna g...
Read more