KEMENTERIAN PENDIDIKAN NASIONAL UNIVERSITAS SUMATERA UTARA FAKULTAS MATEMATIKA DAN ILMU PENGETAHUAN ALAM PROGRAM STUDI D.III TEKNIK INFORMATIKA Jl. Bioteknologi No. 1 Kampus USU MEDAN – Telp/FAX. 061-8214290
KARTU BIMBINGAN TUGAS AKHIR MAHASISWA
Nama Mahasiswa
: JEANY CYNTHYA
NIM
: 082406052
Judul Tugas Akhir
: Perangkat Lunak Simulasi Algoritma Banker
Dosen Pembimbing
: Dra. Normalina Napitupulu, M.Sc
Tanggal Mulai Bimbingan : Tanggal Selesai Bimbingan :
No.
Tanggal Asisten
Pembahasan Pada Asisten
Paraf Dosen
Bimbingan
Mengenai Pada BAB
Pembimbing
Keterangan
1. 2. 3. 4. 5. 6. 7. Kartu ini dikembalikan ke Departemen Matematika bila Bimbingan Mahasiswa telah selesai
Diketahui,
Disetujui,
Departemen Matematika FMIPA USU
Pembimbing Utama/
Ketua
Penanggung Jawab
Prof. Dr. Tulus, M.Si
Dra. Normalina Napitupulu, M.Sc
NIP. 196209011988031002
NIP. 196311061989022001
SURAT KETERANGAN Hasil Uji Program Tugas Akhir
Yang bertanda tangan dibawah ini, menerangkan bahwa Mahasiswa Tugas Akhir Program Diploma III Teknik Informatika/Statistika :
Nama
:
JEANY CYNTHYA
NIM
:
082406052
Prog. Studi
:
Teknik Informatika
Judul TA
:
PERANGKAT LUNAK SIMULASI ALGORITMA BANKER
Telah melaksanakan test program Tugas Akhir Mahasiswa tersebut di atas pada tanggal…………….
Dengan Hasil
:
Sukses / Gagal
Demikian diterangkan untuk digunakan melengkapi syarat pendaftaran Ujian Meja Hijau Tugas Akhir Mahasiswa bersangkutan di Departemen Matematika FMIPA USU Medan.
Medan,
Juli 2011
Dosen Pembimbing Program Studi D3 Teknik Informatika
Dra. Normalina Napitupulu, M.Sc NIP. 196311061989022001
LISTING PROGRAM
1. Form Untuk Menampilkan Splash Screen Option Explicit Private nLoad As Integer Private Sub Form_Load() nLoad = 0 End Sub Private Sub Timer1_Timer() nLoad = nLoad + 1 shpLoad.Width = Int(CDbl(nLoad) * 2280 / 100) If nLoad = 100 Then Sleep 1500 Timer1.Enabled = False Unload Me frmInput.Show End If End Sub
2. Form Untuk Menampilkan Menu Masukkan Option Explicit Private N As Integer Private nBykPinjaman As Integer Private cTmp(5) As String Private Sub cboByk_Click() 'Banyak Pinjaman nBykPinjaman = cboByk.ListIndex + 1 'Tabel Pinjaman Call FormatTabelR 'Tabel Pinjaman Bank Call FormatTabelRBank 'Tabel Pinjaman Call FormatTabelRPlgn End Sub Private Sub chkInput_Click() TblRPlgn.BackColor = IIf(chkInput.Value, &HFFFFFF, &HC0C0C0)
cmdAcak.Enabled = chkInput.Value End Sub Private Sub cmdAbout_Click() frmAbout.Show 1 End Sub Private Sub cmdAcak_Click() 'Simpan banyak Pinjaman bank ke variabel Dim R() As Integer ReDim R(TblRBank.Rows - 1) For N = 1 To UBound(R) R(N) = Val(TblRBank.TextMatrix(N, 1)) Next N 'Acak nilai Pelanggan Dim N1 As Integer Dim Acak As Integer For N = 1 To UBound(Plgn) 'Tipe Pinjaman For N1 = 1 To UBound(R) 'Maksimum Randomize Acak = Int(Rnd * (Int(R(N1) / 3.3) + 1)) TblRPlgn.TextMatrix(N + 1, N1) = Acak 'Allocate Randomize Acak = Int(Rnd * Acak) TblRPlgn.TextMatrix(N + 1, N1 + nBykPinjaman) = Acak Next N1 Next N End Sub Private Sub cmdHelp_Click() Dim m_hwndHelp As Long App.HelpFile = App.Path & "\BankerHelp.chm" m_hwndHelp = HtmlHelp(Me.hWnd, App.HelpFile, HH_DISPLAY_TOPIC, ByVal "Simulasi Banker - Help.htm") End Sub Private Sub cmdKeluar_Click() End End Sub Private Sub cmdSimulasi_Click() 'Lama Simulasi If Val(Text1.Text) = 0 Then MsgBox "Lama simulasi belum di-input !", vbCritical Exit Sub End If
WaktuSimulasi = Val(Text1.Text) JlhIndeks = 0 'Nama Pinjaman ReDim NamaPinjaman(nBykPinjaman) For N = 1 To nBykPinjaman NamaPinjaman(N) = Trim(TblR.TextMatrix(N, 1)) If NamaPinjaman(N) = "" Then MsgBox "Nama Pinjaman R" & N & " belum di-input !", vbCritical Exit Sub End If Next N 'Alokasi Bank ReDim Bank.MaximumR(nBykPinjaman) ReDim Bank.TersediaR(nBykPinjaman) ReDim Bank.TempTersediaR(nBykPinjaman) For N = 1 To nBykPinjaman Bank.MaximumR(N) = Val(TblRBank.TextMatrix(N, 1)) Bank.TersediaR(N) = Val(TblRBank.TextMatrix(N, 1)) If Bank.TersediaR(N) = 0 Then MsgBox "Banyak Pinjaman R" & N & " pada bank belum diinput !", vbCritical Exit Sub ElseIf Bank.TersediaR(N) > 100 Then MsgBox "Banyak Pinjaman R" & N & " pada bank dibatasi maksimum 100 !", vbCritical Exit Sub End If Next N 'Default Properti Pelanggan For N = 1 To UBound(Plgn) Plgn(N).Tipe = 0 Plgn(N).Aktif = False Plgn(N).Aktivitas = "" ReDim Plgn(N).RequestR(nBykPinjaman) ReDim Plgn(N).MaximumR(nBykPinjaman) ReDim Plgn(N).PenempatanR(nBykPinjaman) ReDim Plgn(N).TempPenempatanR(nBykPinjaman) ReDim Plgn(N).NeedsR(nBykPinjaman) ReDim Plgn(N).TempPenempatanR(nBykPinjaman) Next N 'Keadaan awal ditentukan If chkInput.Value Then Dim N1 As Integer For N = 1 To UBound(Plgn) With Plgn(N) .Aktif = True .Aktivitas = "PROSES" JlhIndeks = JlhIndeks + 1 .Indeks = JlhIndeks 'Banyak Pinjaman
For N1 = 1 To nBykPinjaman 'Maksimum R .MaximumR(N1) = Val(TblRPlgn.TextMatrix(N + 1, N1)) If .MaximumR(N1) > 30 Then MsgBox "Maksimum Pinjaman R" & N1 & " pada Pelanggan dibatasi " & _ "maksimum 30 !", vbCritical Exit Sub End If 'Alokasi R .PenempatanR(N1) = Val(TblRPlgn.TextMatrix(N + 1, N1 + nBykPinjaman)) 'Kurangi Pinjaman pada banker Bank.TersediaR(N1) = Bank.TersediaR(N1) .PenempatanR(N1) If Bank.TersediaR(N1) < 0 Then MsgBox "Alokasi Pinjaman R" & N1 & " pada Pelanggan melebihi " & _ "maksimum Pinjaman pada bank !", vbCritical Exit Sub End If 'Needs R = Maksimum - Alokasi .NeedsR(N1) = .MaximumR(N1) - .PenempatanR(N1) If .NeedsR(N1) < 0 Then MsgBox "Alokasi Pinjaman R" & N1 & " pada -" & N & " melebihi maksimum Pinjaman !", vbCritical Exit Sub End If Next N1 End With Next N End If 'Simulasi algoritma banker frmSimulasiBanker.Show vbModal End Sub Private Sub Form_Load() 'Isi combo banyak Pinjaman For N = 1 To 5 cboByk.AddItem N & " tipe" Next N cboByk.ListIndex = 4 'Tabel Pinjaman Call FormatTabelR 'Tabel Pinjaman Bank Call FormatTabelRBank 'Tabel Pinjaman Pelanggan
Call FormatTabelRPlgn 'Contoh Data With TblR .TextMatrix(1, 1) = "Rp" .TextMatrix(2, 1) = "Rp" .TextMatrix(3, 1) = "Rp" .TextMatrix(4, 1) = "Rp" .TextMatrix(5, 1) = "Rp" 'Isi cTmp For N = 1 To .Rows - 1 cTmp(N) = .TextMatrix(N, 1) Next N End With With TblRBank .TextMatrix(1, .TextMatrix(2, .TextMatrix(3, .TextMatrix(4, .TextMatrix(5, End With
1) 1) 1) 1) 1)
= = = = =
"100" "100" "100" "100" "100"
End Sub 'Format Tabel Pinjaman Private Sub FormatTabelR() 'Tabel Pinjaman With TblR .Rows = nBykPinjaman + 1 .Cols = 2 .ColWidth(0) = 2000 .ColAlignment(0) = 4 .TextMatrix(0, 0) = "Tipe Pinjaman" .ColWidth(1) = 2500 .ColAlignment(1) = 4 .TextMatrix(0, 1) = "Nama Pinjaman" 'Isi For N = 1 To .Rows - 1 .TextMatrix(N, 0) = "R" & N .TextMatrix(N, 1) = cTmp(N) Next N End With End Sub 'Format Tabel Pinjaman Bank Private Sub FormatTabelRBank() 'Tabel Pinjaman With TblRBank .Rows = nBykPinjaman + 1 .Cols = 2 .ColWidth(0) = 2000 .ColAlignment(0) = 4 .TextMatrix(0, 0) = "Tipe Pinjaman"
.ColWidth(1) = 2500 .ColAlignment(1) = 4 .TextMatrix(0, 1) = "Banyak Pinjaman" 'Isi For N = 1 To .Rows - 1 .TextMatrix(N, 0) = "R" & N '.TextMatrix(N, 1) = "0" Next N End With End Sub 'Format Tabel Pinjaman Pelanggan Private Sub FormatTabelRPlgn() 'Tabel Pinjaman Pelanggan With TblRPlgn .Redraw = False .Rows = 7 .Cols = 1 + (2 * nBykPinjaman) .ColWidth(0) = 1850 .ColAlignment(0) = 4 .TextMatrix(0, 0) = "Pelanggan" .TextMatrix(1, 0) = "Pelanggan" 'Tulis Pelanggan For N = 2 To .Rows - 1 .TextMatrix(N, 0) = "Pelanggan - " & N - 1 Next N 'Tulis Kolom For N = 1 To nBykPinjaman .ColWidth(N) = Int(3970 \ nBykPinjaman) .ColAlignment(N) = 4 .TextMatrix(0, N) = "MAKSIMUM" .TextMatrix(1, N) = "R" & N .ColWidth(N + nBykPinjaman) = Int(3970 / nBykPinjaman) .ColAlignment(N + nBykPinjaman) = 4 .TextMatrix(0, N + nBykPinjaman) = "PENEMPATAN" .TextMatrix(1, N + nBykPinjaman) = "R" & N Next N .MergeCells = flexMergeFree .MergeCol(0) = True .MergeRow(0) = True .Redraw = True End With End Sub Private Sub TblR_KeyPress(KeyAscii As Integer) Dim cKey As String cKey = Chr(KeyAscii) With TblR
Select Case KeyAscii Case vbKeyReturn 'Enter Key - pindah baris If .Row < .Rows - 1 Then .Row = .Row + 1 End If Case vbKeyBack 'BackSpace - hapus satu karakter If Len(.Text) > 0 Then .Text = Left(.Text, Len(.Text) - 1) End If Case Else 'Only character allowed If Len(.Text) >= 3 Then Exit Sub If IsNumeric(Chr(KeyAscii)) = False Then .Text = .Text & cKey End If End Select End With End Sub Private Sub TblRBank_KeyPress(KeyAscii As Integer) Dim cKey As String cKey = Chr(KeyAscii) With TblRBank Select Case KeyAscii Case vbKeyReturn 'Enter Key - pindah baris If .Row < .Rows - 1 Then .Row = .Row + 1 End If Case vbKeyBack 'BackSpace - hapus satu karakter If Len(.Text) > 0 Then .Text = Left(.Text, Len(.Text) - 1) End If Case Else 'Only number allowed If Len(.Text) >= 3 Then Exit Sub If cKey Like "#" Then .Text = .Text & cKey End If End Select End With End Sub Private Sub TblRPlgn_KeyPress(KeyAscii As Integer) If cmdAcak.Enabled Then Dim cKey As String cKey = Chr(KeyAscii) With TblRPlgn Select Case KeyAscii Case vbKeyReturn 'Enter Key - pindah baris If .Col < .Cols - 1 Then .Col = .Col + 1
ElseIf .Row < .Rows - 1 Then .Col = 1 .Row = .Row + 1 End If Case vbKeyBack
'BackSpace - hapus satu
karakter If Len(.Text) > 0 Then .Text = Left(.Text, Len(.Text) - 1) End If Case Else 'Only number allowed If Len(.Text) >= 3 Then Exit Sub If cKey Like "#" Then .Text = Val(.Text & cKey) 'Cek maksimum, tidak boleh lebih besar dari maksimum bank If .Col < nBykPinjaman + 1 Then If Val(.Text) > Val(TblRBank.TextMatrix(.Col, 1)) Then MsgBox "Maksimum Pinjaman " & .TextMatrix(1, .Col) & " tidak boleh " & _ "melebihi batas maksimum Pinjaman bank !", vbCritical .Text = "" End If ElseIf .Col >= nBykPinjaman + 1 Then 'Cek alokasi, tidak boleh lebih besar dari maksimum If Val(.Text) > Val(.TextMatrix(.Row, .Col - nBykPinjaman)) Then MsgBox "Alokasi Pinjaman " & .TextMatrix(1, .Col) & " tidak boleh " & _ "melebihi maksimum Pinjaman Pelanggan-" & .Row - 1 & " !", vbCritical .Text = "" End If End If End If End Select End With End If End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) If IsNumeric(Chr(KeyAscii)) = False And KeyAscii <> vbKeyBack Then KeyAscii = 0 End Sub
3. Form Untuk Menampilkan Tentang Program
Private Sub cmdOK_Click() Unload Me End Sub
4. Form Untuk Menampilkan Laporan Option Explicit Public TipeForm As String Public Isi As String Private Sub Form_Load() Me.Caption = IIf(TipeForm = "H", "Hasil Transaksi", "Hasil Analisis Transaksi") RTB.Text = Isi End Sub Private Sub Form_Resize() RTB.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight End Sub
5. Form Untuk Menampilkan Menu Simulasi Banker Option Explicit Private nDelayRequest As Long Private N As Integer Private Private Private Private Private Private Private
Temp1 As Integer Temp2 As Integer Temp3 As Integer Temp4 As Integer Temp5 As Integer sTemp1 As String bTemp1 As Boolean
Private TBanker As Integer Private TBankerRnd As Integer Private bIsProses As Boolean Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdHasil Transaksi_Click() Dim cTmp As String
If Timer1.Enabled Then cTmp = "STOP" Timer1.Enabled = False End If frmNote.TipeForm = "H" frmNote.Isi = H frmNote.Show vbModal If cTmp = "STOP" Then Timer1.Enabled = True End Sub Private Sub cmdPause_Click() Timer1.Enabled = False DoEvents DoEvents cmdPlay.Enabled = True cmdPause.Enabled = False cmdExit.Enabled = True End Sub Private Sub cmdPlay_Click() Timer1.Enabled = True cmdPlay.Enabled = False cmdPause.Enabled = True cmdExit.Enabled = False End Sub Private Sub Form_Load() 'Kecepatan proses Slider1.Value = 2 'Hasil Transaksi & Hasil Analisis H = "SIMULASI ALGORITMA BANKER" & vbCrLf & _ "-------------------------" & vbCrLf HA = "" 'T = 0 sekon lblT = "0" 'Nama Pinjaman For N = 1 To UBound(NamaPinjaman) lblR0(N).Caption = NamaPinjaman(N) lblR1(N).Caption = NamaPinjaman(N) lblR2(N).Caption = NamaPinjaman(N) lblR3(N).Caption = NamaPinjaman(N) lblR4(N).Caption = NamaPinjaman(N) lblR5(N).Caption = NamaPinjaman(N) Next N 'Progress bar banker Call AturProgressBar(0) 'Tempat Progress Bar For N = 0 To UBound(Plgn) PProses(N).Height = 75 + (210 * UBound(NamaPinjaman)) Next N 'Keadaan awal disetting - langsung aktif
If Plgn(1).Aktif Then For N = 1 To UBound(Plgn) PPlgn(N).Top = 6945 'Indeks lblIndeks(N).Caption = "Pelanggan " & Plgn(N).Indeks lblIndeks(N).Visible = True 'Progress Bar Call AturProgressBar(N) PProses(N).Visible = True 'Tipe Randomize Temp1 = 1 + Int(Rnd * 3) Plgn(N).Tipe = Val(Temp1) PPlgn(N).Picture = PlgnUp1(Plgn(N).Tipe).Picture PPlgn(N).Tag = "1" Next N End If End Sub Private Sub Form_Unload(Cancel As Integer) Cancel = bIsProses End Sub Private Sub Slider1_Change() Timer1.Interval = Slider1.Value * 100 nDelayRequest = Slider1.Value * 200 lblDelay.Caption = "Kecepatan (Delay = " & Slider1.Value * 100 & ")" End Sub Private Sub Slider1_Scroll() Call Slider1_Change End Sub Private Sub Timer1_Timer() bIsProses = True 'Tambah t (waktu) lblT = Val(lblT) + 1 'Untuk 5 orang Pelanggan For N = 1 To UBound(Plgn) With Plgn(N) If .Aktif = False Then '~~~~~~~~~~~~~~~~~~~~ 'PELANGGAN BELUM AKTIF '~~~~~~~~~~~~~~~~~~~~ 'Random untuk mengaktifkan Pelanggan Randomize Temp1 = 1 + Int(Rnd * 30) If Temp1 = 10 Then '+ Indeks
JlhIndeks = JlhIndeks + 1 'Aktifkan Pelanggan .Aktif = True .Indeks = JlhIndeks .Aktivitas = "UP" 'Tipe Randomize Temp1 = 1 + Int(Rnd * 3) .Tipe = Val(Temp1) End If Else '~~~~~~~~~~~~~~~~~~~~ 'PELANGGAN SUDAH AKTIF '~~~~~~~~~~~~~~~~~~~~ Select Case .Aktivitas '~ Case "UP" 'Kurangi TOP PPlgn(N).Top = PPlgn(N).Top - 75 If PPlgn(N).Tag = "1" Then PPlgn(N).Picture = PlgnUp2(.Tipe).Picture PPlgn(N).Tag = "2" Else PPlgn(N).Picture = PlgnUp1(.Tipe).Picture PPlgn(N).Tag = "1" End If 'Pengaturan Pintu If PPlgn(N).Top = 11445 Then Pintu(N).Visible = Not Pintu(N).Visible ElseIf PPlgn(N).Top = 9945 Then Pintu(N).Visible = Not Pintu(N).Visible End If 'Sampai ke atas -> Ganti jadi Proses If PPlgn(N).Top = 6945 Then .Aktivitas = "PROSES" 'Acak Max Pinjaman For Temp1 = 1 To UBound(NamaPinjaman) Randomize .MaximumR(Temp1) = 1 + Int(Rnd * Int(Bank.MaximumR(Temp1) * 0.5)) .PenempatanR(Temp1) = 0 .NeedsR(Temp1) = .MaximumR(Temp1) .RequestR(Temp1) = 0 Next Temp1 'Progress Bar Call AturProgressBar(N) PProses(N).Visible = True
'Indeks lblIndeks(N).Caption = "Pelanggan " & .Indeks lblIndeks(N).Visible = True 'Hasil Transaksi H = H & vbCrLf & _ "t = " & lblT & ", Pelanggan-" & .Indeks & _ " masuk ke dalam proses permohonan kredit." End If '~ Case "PROSES" 'Status If lblStatus(N).Visible = True Then lblStatus(N).Visible = False If PicState.Visible Then PicState.Visible = False 'Cek sudah pernah ada alokasi Pinjaman Temp2 = 0 For Temp1 = 1 To UBound(NamaPinjaman) If .PenempatanR(Temp1) > 0 Then Temp2 = 1 Exit For End If Next Temp1 'Cek sudah memenuhi maksimum Temp3 = 1 For Temp1 = 1 To UBound(NamaPinjaman) If .PenempatanR(Temp1) < .MaximumR(Temp1) Then Temp3 = 0 Exit For End If Next Temp1 'Random Randomize Temp1 = Int(Rnd * 100) 'Cek Return atau Request If (Temp3 = 1) Or (Temp1 = 20 And Temp2 = 1) Then 'Mengembalikan uang .Aktivitas = "RETURN" ElseIf Temp1 <= 10 Then 'Memohon Kredit .Aktivitas = "REQUEST" End If '~
Case "REQUEST" 'Jenis Request Randomize Temp1 = Int(Rnd * 10) sTemp1 = "(" If Temp1 = 9 Then 'Request maximum Pinjaman For Temp2 = 1 To UBound(NamaPinjaman) .RequestR(Temp2) = .NeedsR(Temp2) If Temp2 > 1 Then sTemp1 = sTemp1 & "," sTemp1 = sTemp1 & .RequestR(Temp2) Next Temp2 Else 'Request not maximum Pinjaman For Temp2 = 1 To UBound(NamaPinjaman) If .NeedsR(Temp2) > 0 Then Randomize .RequestR(Temp2) = 1 + Int(Rnd * .NeedsR(Temp2)) Else .RequestR(Temp2) = 0 End If If Temp2 > 1 Then sTemp1 = sTemp1 & "," sTemp1 = sTemp1 & .RequestR(Temp2) Next Temp2 End If sTemp1 = sTemp1 & ")" 'Hasil Transaksi H = H & vbCrLf & _ "t = " & lblT & ", Plgn-" & .Indeks & _ " memohon kredit " & sTemp1 & " kepada bankir." 'Delay sebentar - REQUEST lblState.ForeColor = 0 Shape1.FillColor = &HFFFF& lblState.Caption = "PERMINTAAN" lblState1.Caption = "Pelanggan-" & .Indeks & _ " memohon kredit " & sTemp1 & " kepada bankir." PicState.Visible = True DoEvents Sleep nDelayRequest '------------------------------------------------' HASIL ANALISIS DENGAN PINJAMAN REQUEST ALGORITHM '------------------------------------------------HA = "KEJADIAN: " & vbCrLf & "---------" & _ vbCrLf & "t = " & lblT & ", Plgn-" & .Indeks & _
" memohon kredit " & sTemp1 & " kepada bankir." 'If Request <= Tersedia HA = HA & vbCrLf & vbCrLf & _ "ANALISIS DENGAN PINJAMAN REQUEST ALGORITHM:" & vbCrLf & _ "-------------------------------------------" & vbCrLf & vbCrLf & _ "1. CEK REQUEST HARUS <= TERSEDIA." & vbCrLf bTemp1 = True For Temp1 = 1 To UBound(NamaPinjaman) If .RequestR(Temp1) <= Bank.TersediaR(Temp1) Then 'REQUEST <= TERSEDIA HA = HA & vbCrLf & _ " - " & .RequestR(Temp1) & " <= " & _ Bank.TersediaR(Temp1) & " (TRUE)" Else 'REQUEST > TERSEDIA HA = HA & vbCrLf & _ " - " & .RequestR(Temp1) & " <= " & _ Bank.TersediaR(Temp1) & " (FALSE)" 'TUNDA HA = HA & vbCrLf & _ " Permintaan lebih besar dari dana yang tersedia." & vbCrLf & _ "
Permohonan kredit Plgn-" & .Indeks
& " ditunda (TUNDA)." 'Hasil Transaksi H = H & vbCrLf & _ "t = " & lblT & ", Permohonan kredit Pelanggan-" & .Indeks & _ " ditunda (TUNDA)." 'Delay sebentar - TUNDA lblStatus(N).Visible = True lblState.ForeColor = &HFFFFFF Shape1.FillColor = &HFF& lblState.Caption = "TUNDA" lblState1.Caption = "Permohonan kredit Pelanggan-" & .Indeks & _ " ditunda (TUNDA)." PicState.Visible = True DoEvents Sleep nDelayRequest 'Tunjukkan Hasil Analisis If Check1.Value Then frmNote.TipeForm = "HA"
frmNote.Isi = HA frmNote.Show vbModal End If .Aktivitas = "TUNDA" bTemp1 = False Exit For End If Next Temp1 'Jika Request <= Tersedia If bTemp1 Then '~~~~~~~~~~~ HA = HA & vbCrLf & vbCrLf & _ "2. BANKER BERPURA-PURA UNTUK MEMENUHI PERMOHONAN PELANGGAN." 'COBA ALOKASI For Temp1 = 1 To UBound(Plgn) Plgn(Temp1).TempPenempatanR = Plgn(Temp1).PenempatanR Plgn(Temp1).TempNeedsR = Plgn(Temp1).NeedsR Plgn(Temp1).Finish = False Next Temp1 'KURANGI & TAMBAH PINJAMAN For Temp1 = 1 To UBound(NamaPinjaman) 'NamaPinjaman sTemp1 = NamaPinjaman(Temp1) 'Kurangi bank Bank.TempTersediaR(Temp1) = Bank.TersediaR(Temp1) _ - .RequestR(Temp1) HA = HA & vbCrLf & vbCrLf & " " & _ sTemp1 & "_Bank = " & sTemp1 & "_Bank - " & sTemp1 & "_Request = " & _ Bank.TersediaR(Temp1) & " - " & .RequestR(Temp1) & " = " & _ Bank.TempTersediaR(Temp1) 'Tambah Penempatan di Pelanggan .TempPenempatanR(Temp1) = .PenempatanR(Temp1) + .RequestR(Temp1) HA = HA & vbCrLf & _ " Penempatan_" & sTemp1 & "_Plgn" & .Indeks & " = " & _ "Penempatan_" & sTemp1 & "_Plgn" & .Indeks & " + " & _ sTemp1 & "_Request = " & .PenempatanR(Temp1) & " + " & _ .RequestR(Temp1) & " = " & .TempPenempatanR(Temp1) 'Kurangi Needs di Pelanggan
.TempNeedsR(Temp1) = .NeedsR(Temp1) .RequestR(Temp1) HA = HA & vbCrLf & _ " Needs_" & sTemp1 & "_Plgn" & .Indeks & " = " & _ "Needs_" & sTemp1 & "_Plgn" & .Indeks & " - " & _ sTemp1 & "_Request = " & .NeedsR(Temp1) & " - " & _ .RequestR(Temp1) & " = " & .TempNeedsR(Temp1) Next Temp1 '~~~~~~~~~~~ HA = HA & vbCrLf & vbCrLf & _ "3. PERIKSA APAKAH KEADAAN SAFE DENGAN SAFETY ALGORIGHTM" 'Indeks yang akan diselesaikan Temp1 = 1 'Cari dimana Need <= Tersedia While Temp1 > 0 Temp1 = 0 'Looping cari temp1 berikutnya For Temp2 = 1 To UBound(Plgn) If Plgn(Temp2).Aktif And _ Plgn(Temp2).Aktivitas <> "UP" And _ Plgn(Temp2).Aktivitas <> "DOWN" Then 'Finish = False bTemp1 = False If Plgn(Temp2).Finish = False Then 'Cek apakah semua need <= Tersedia Temp1 = Temp2 bTemp1 = True For Temp3 = 1 To UBound(NamaPinjaman) If Plgn(Temp2).TempNeedsR(Temp3) > Bank.TempTersediaR(Temp3) Then bTemp1 = False Exit For End If Next Temp3 'Sesuai kriteria If bTemp1 Then Temp1 = Temp2 Exit For End If End If End If
Next Temp2 'Selesaikan Pelanggan Temp1 If Temp1 > 0 Then Plgn(Temp1).Finish = True HA = HA & vbCrLf & vbCrLf & _ " Selesaikan kredit Plgn-" & Plgn(Temp1).Indeks & "." 'Tambah di bank For Temp2 = 1 To UBound(NamaPinjaman) 'NamaPinjaman sTemp1 = NamaPinjaman(Temp2) 'Bank = Bank + Plgn HA = HA & vbCrLf & _ " " & sTemp1 & "_Bank = " & _ sTemp1 & "_Bank + Penempatan_" & sTemp1 & "_Plgn" & Plgn(Temp1).Indeks & " = " & _ Bank.TempTersediaR(Temp2) & " + " & Plgn(Temp1).TempPenempatanR(Temp2) & " = " & _ Bank.TempTersediaR(Temp2) + Plgn(Temp1).TempPenempatanR(Temp2) 'Perhitungan Bank.TempTersediaR(Temp2) = Bank.TempTersediaR(Temp2) + _ Plgn(Temp1).TempPenempatanR(Temp2) Next Temp2 HA = HA & vbCrLf & " Finish(Plgn" & Plgn(Temp1).Indeks & ") = TRUE." End If Wend 'Cek ada Pelanggan = false For Temp1 = 1 To UBound(Plgn) If Plgn(Temp1).Aktif And _ Plgn(Temp1).Aktivitas <> "UP" And _ Plgn(Temp1).Aktivitas <> "DOWN" And _ Plgn(Temp1).Finish = False Then HA = HA & vbCrLf & vbCrLf & _ " Kredit Pelanggan-" & Plgn(Temp1).Indeks & _ " tidak bisa diselesaikan (UNSAFE STATE)." & vbCrLf & _ " Oleh karena itu, permohonan kredit Pelanggan-" & .Indeks & " ditunda (TUNDA)." 'Hasil Transaksi H = H & vbCrLf & _
"t = " & lblT & ", Permohonan kredit Plgn-" & .Indeks & _ " ditunda (TUNDA)." 'Delay sebentar - TUNDA lblStatus(N).Visible = True lblState.ForeColor = &HFFFFFF Shape1.FillColor = &HFF& lblState.Caption = "TUNDA" lblState1.Caption = "Permohonan kredit -" & .Indeks & _ " ditunda (TUNDA)." PicState.Visible = True DoEvents Sleep nDelayRequest 'Tunjukkan Hasil Analisis If Check1.Value Then frmNote.TipeForm = "HA" frmNote.Isi = HA frmNote.Show vbModal End If .Aktivitas = "TUNDA" Exit For End If Next Temp1 'BUKAN TUNDA - BERARTI APPROVED If .Aktivitas <> "TUNDA" Then HA = HA & vbCrLf & vbCrLf & _ " Semua kredit terselesaikan (SAFE STATE)." & vbCrLf & _ " Oleh karena itu, permohonan kredit Pelanggan-" & .Indeks & " disetujui (SETUJU)." 'Delay sebentar - APPROVED lblState.ForeColor = 0 Shape1.FillColor = &HFF00& lblState.Caption = "SETUJU" lblState1.Caption = "Permohonan kredit Pelanggan-" & .Indeks & " disetujui (SETUJU)." PicState.Visible = True PUang(N).Visible = True PKasir(N).Picture = Kasir(2).Picture DoEvents Sleep nDelayRequest 'Tunjukkan Hasil Analisis If Check1.Value Then frmNote.TipeForm = "HA" frmNote.Isi = HA frmNote.Show vbModal End If
PicState.Visible = False PUang(N).Visible = False PKasir(N).Picture = Kasir(1).Picture 'Hasil Transaksi H = H & vbCrLf & _ "t = " & lblT & ", Permohonan kredit Pelanggan-" & .Indeks & _ " disetujui (SETUJU)." 'Tambah Penempatan For Temp1 = 1 To UBound(NamaPinjaman) 'Alokasi .PenempatanR(Temp1) = .PenempatanR(Temp1) + .RequestR(Temp1) 'Needs .NeedsR(Temp1) = .NeedsR(Temp1) .RequestR(Temp1) 'Kurangi Bank Bank.TersediaR(Temp1) = Bank.TersediaR(Temp1) - .RequestR(Temp1) Next Temp1 'Bank Call AturProgressBar(0) 'Plgn Call AturProgressBar(N) .Aktivitas = "PROSES" End If End If '~ Case "TUNDA" sTemp1 = "(" For Temp1 = 1 To UBound(NamaPinjaman) If Temp1 > 1 Then sTemp1 = sTemp1 & "," sTemp1 = sTemp1 & .RequestR(Temp1) Next Temp1 sTemp1 = sTemp1 & ")" '------------------------------------------------' HASIL ANALISIS DENGAN PINJAMAN REQUEST ALGORITHM '------------------------------------------------HA = "KEJADIAN: " & vbCrLf & "---------" & _ vbCrLf & "t = " & lblT & ", Permintaan Pelanggan-" & .Indeks & _ " atas kredit " & sTemp1 & " dicek kembali." 'If Request <= Tersedia HA = HA & vbCrLf & vbCrLf & _
"ANALISIS DENGAN PINJAMAN REQUEST ALGORITHM:" & vbCrLf & _ "-------------------------------------------" & vbCrLf & vbCrLf & _ "1. CEK REQUEST HARUS <= TERSEDIA." & vbCrLf bTemp1 = True For Temp1 = 1 To UBound(NamaPinjaman) If .RequestR(Temp1) <= Bank.TersediaR(Temp1) Then 'REQUEST <= TERSEDIA HA = HA & vbCrLf & _ " - " & .RequestR(Temp1) & " <= " & _ Bank.TersediaR(Temp1) & " (TRUE)" Else 'REQUEST > TERSEDIA HA = HA & vbCrLf & _ " - " & .RequestR(Temp1) & " <= " & _ Bank.TersediaR(Temp1) & " (FALSE)" 'TUNDA HA = HA & vbCrLf & _ " Permintaan lebih besar dari dana yang tersedia." & vbCrLf & _ " .Indeks & " ditunda (TUNDA)."
Permohonan kredit Pelanggan-" &
bTemp1 = False Exit For End If Next Temp1 'Jika Request <= Tersedia If bTemp1 Then '~~~~~~~~~~~ HA = HA & vbCrLf & vbCrLf & _ "2. BANKER BERPURA-PURA UNTUK MEMENUHI PERMOHONAN PELANGGAN." 'COBA ALOKASI For Temp1 = 1 To UBound(Plgn) Plgn(Temp1).TempPenempatanR = Plgn(Temp1).PenempatanR Plgn(Temp1).TempNeedsR = Plgn(Temp1).NeedsR Plgn(Temp1).Finish = False Next Temp1 'KURANGI & TAMBAH PINJAMAN For Temp1 = 1 To UBound(NamaPinjaman) 'NamaPinjaman sTemp1 = NamaPinjaman(Temp1)
'Kurangi bank Bank.TempTersediaR(Temp1) = Bank.TersediaR(Temp1) _ - .RequestR(Temp1) HA = HA & vbCrLf & vbCrLf & _ sTemp1 & "_Bank = " & sTemp1 & "_Bank - " & sTemp1 & "_Request = " & _ Bank.TersediaR(Temp1) & " - " & .RequestR(Temp1) & " = " & _ Bank.TempTersediaR(Temp1) 'Tambah Penempatan di Pelanggan .TempPenempatanR(Temp1) = .PenempatanR(Temp1) + .RequestR(Temp1) HA = HA & vbCrLf & _ "Penempatan_" & sTemp1 & "_Plgn" & .Indeks & " = " & _ "Penempatan_" & sTemp1 & "_Plgn" & .Indeks & " + " & _ sTemp1 & "_Request = " & .PenempatanR(Temp1) & " + " & _ .RequestR(Temp1) & " = " & .TempPenempatanR(Temp1) 'Kurangi Needs di Pelanggan .TempNeedsR(Temp1) = .NeedsR(Temp1) .RequestR(Temp1) HA = HA & vbCrLf & _ "Needs_" & sTemp1 & "_Plgn" & .Indeks & " = " & _ "Needs_" & sTemp1 & "_Plgn" & .Indeks & " - " & _ sTemp1 & "_Request = " & .NeedsR(Temp1) & " - " & _ .RequestR(Temp1) & " = " & .TempNeedsR(Temp1) Next Temp1 '~~~~~~~~~~~ HA = HA & vbCrLf & vbCrLf & _ "3. PERIKSA APAKAH KEADAAN SAFE DENGAN SAFETY ALGORIGHTM" 'Indeks yang akan diselesaikan Temp1 = 1 'Cari dimana Need <= Tersedia While Temp1 > 0 Temp1 = 0 'Looping cari temp1 berikutnya For Temp2 = 1 To UBound(Plgn) If Plgn(Temp2).Aktif And _ Plgn(Temp2).Aktivitas <> "UP" And _ Plgn(Temp2).Aktivitas <> "DOWN" Then
'Finish = False bTemp1 = False If Plgn(Temp2).Finish = False Then 'Cek apakah semua need <= Tersedia Temp1 = Temp2 bTemp1 = True For Temp3 = 1 To UBound(NamaPinjaman) If Plgn(Temp2).TempNeedsR(Temp3) > Bank.TempTersediaR(Temp3) Then bTemp1 = False Exit For End If Next Temp3 'Sesuai kriteria If bTemp1 Then Temp1 = Temp2 Exit For End If End If End If Next Temp2 'Selesaikan Pelanggan Temp1 If Temp1 > 0 Then Plgn(Temp1).Finish = True HA = HA & vbCrLf & vbCrLf & _ " Selesaikan kredit Pelanggan-" & Plgn(Temp1).Indeks & "." 'Tambah di bank For Temp2 = 1 To UBound(NamaPinjaman) 'NamaPinjaman sTemp1 = NamaPinjaman(Temp2) 'Bank = Bank + Plgn HA = HA & vbCrLf & _ " " & sTemp1 & "_Bank = " & _ sTemp1 & "_Bank + Penempatan_" & sTemp1 & "_Plgn" & Plgn(Temp1).Indeks & " = " & _ Bank.TempTersediaR(Temp2) & " + " & Plgn(Temp1).TempPenempatanR(Temp2) & " = " & _ Bank.TempTersediaR(Temp2) + Plgn(Temp1).TempPenempatanR(Temp2) 'Perhitungan Bank.TempTersediaR(Temp2) = Bank.TempTersediaR(Temp2) + _ Plgn(Temp1).TempPenempatanR(Temp2) Next Temp2
HA = HA & vbCrLf & " Finish(Plgn" & Plgn(Temp1).Indeks & ") = TRUE." End If Wend 'Cek ada Pelanggan = false .Aktivitas = "" For Temp1 = 1 To UBound(Plgn) If Plgn(Temp1).Aktif And _ Plgn(Temp1).Aktivitas <> "UP" And _ Plgn(Temp1).Aktivitas <> "DOWN" And _ Plgn(Temp1).Finish = False Then HA = HA & vbCrLf & vbCrLf & _ " Kredit Plgn-" & Plgn(Temp1).Indeks & _ " tidak bisa diselesaikan (UNSAFE STATE)." & vbCrLf & _ " Oleh karena itu, permohonan kredit Pelanggan-" & .Indeks & " ditunda (TUNDA)." .Aktivitas = "TUNDA" Exit For End If Next Temp1 'BUKAN TUNDA - BERARTI APPROVED If .Aktivitas <> "TUNDA" Then HA = HA & vbCrLf & vbCrLf & _ " Semua kredit terselesaikan (SAFE STATE)." & vbCrLf & _ " Oleh karena itu, permohonan kredit Pelanggan-" & .Indeks & " disetujui (SETUJU)." 'Delay sebentar - APPROVED lblState.ForeColor = 0 Shape1.FillColor = &HFF00& lblState.Caption = "SETUJU" lblState1.Caption = "Permohonan kredit Pelanggan-" & _ .Indeks & " disetujui (SETUJU)." PicState.Visible = True PUang(N).Visible = True PKasir(N).Picture = Kasir(2).Picture DoEvents Sleep nDelayRequest 'Tunjukkan Hasil Analisis If Check1.Value Then frmNote.TipeForm = "HA" frmNote.Isi = HA
frmNote.Show vbModal End If PicState.Visible = False PUang(N).Visible = False PKasir(N).Picture = Kasir(1).Picture 'Hasil Transaksi H = H & vbCrLf & _ "t = " & lblT & ", Permohonan kredit Pelanggan-" & .Indeks & _ " yang tertunda telah disetujui (SETUJU)." 'Tambah Penempatan For Temp1 = 1 To UBound(NamaPinjaman) 'Alokasi .PenempatanR(Temp1) = .PenempatanR(Temp1) + .RequestR(Temp1) 'Needs .NeedsR(Temp1) = .NeedsR(Temp1) .RequestR(Temp1) 'Kurangi Bank Bank.TersediaR(Temp1) = Bank.TersediaR(Temp1) - .RequestR(Temp1) Next Temp1 'Bank Call AturProgressBar(0) 'Plgn Call AturProgressBar(N) .Aktivitas = "PROSES" End If End If '~ Case "RETURN" sTemp1 = "(" For Temp1 = 1 To UBound(NamaPinjaman) If Temp1 > 1 Then sTemp1 = sTemp1 & "," sTemp1 = sTemp1 & .PenempatanR(Temp1) Next Temp1 sTemp1 = sTemp1 & ")" 'Hasil Transaksi H = H & vbCrLf & _ "t = " & lblT & ", Pelanggan-" & .Indeks & _ " telah menyelesaian semua permasalahan bisnisnya dan mengembalikan " & _ " semua pinjamannya " & sTemp1 & " kepada bank." 'Pengembalian uang For Temp1 = 1 To UBound(NamaPinjaman)
Bank.TersediaR(Temp1) = Bank.TersediaR(Temp1) + .PenempatanR(Temp1) Next Temp1 Call AturProgressBar(0) 'Turun ke bawah .Aktivitas = "DOWN" PProses(N).Visible = False lblIndeks(N).Visible = False '~ Case "DOWN" 'Tambah TOP PPlgn(N).Top = PPlgn(N).Top + 75 If PPlgn(N).Tag = "1" Then PPlgn(N).Picture = PlgnDw2(.Tipe).Picture PPlgn(N).Tag = "2" Else PPlgn(N).Picture = PlgnDw1(.Tipe).Picture PPlgn(N).Tag = "1" End If 'Pengaturan Pintu If PPlgn(N).Top = 11520 Then Pintu(N).Visible = Not Pintu(N).Visible ElseIf PPlgn(N).Top = 9945 Then Pintu(N).Visible = Not Pintu(N).Visible End If 'Sampai ke bawah -> Aktif = FALSE If PPlgn(N).Top = 11520 Then .Aktif = False .Aktivitas = "" End If End Select End If End With Next N 'ANIMASI BANKER TBanker = TBanker + 1 If Left(PBanker.Tag, 1) = "1" Then 'Berpikir PBanker.Picture = Banker(1).Picture 'Acak waktu berpikir If TBanker = 1 Then Randomize TBankerRnd = 1 + Int(Rnd * 20) End If 'Ganti jadi menulis If TBanker = TBankerRnd Then PBanker.Tag = "21" TBanker = 0
End If Else 'Menulis PBanker.Picture = Banker(Val(Right(PBanker.Tag, 1)) + 1).Picture 'Acak waktu menulis If TBanker = 1 Then Randomize TBankerRnd = 1 + Int(Rnd * 30) End If If TBanker = TBankerRnd Then 'Ganti jadi berpikir TBanker = 0 PBanker.Tag = "1" Else PBanker.Tag = "2" & IIf(Right(PBanker.Tag, 1) = "1", "2", "1") End If End If bIsProses = False 'Batas waktu simulasi If Val(lblT) = WaktuSimulasi Then Timer1.Enabled = False MsgBox "Simulasi telah berakhir !", vbInformation cmdPlay.Enabled = False cmdPause.Enabled = False cmdHasil Transaksi.Enabled = True cmdExit.Enabled = True End If End Sub 'ProgressBar Private Sub AturProgressBar(nPlgn As Integer) Dim P As Integer Select Case nPlgn Case 0 For P = 1 To UBound(NamaPinjaman) shpR0(P).Width = Hitung(Bank.TersediaR(P), 1170, Bank.MaximumR(P)) lblP0(P).Caption = Bank.TersediaR(P) & "/" & Bank.MaximumR(P) 'Bagi(Bank.TersediaR(P) * 100, Bank.MaximumR(P)) & "%" Next P Case 1 For P = 1 To UBound(NamaPinjaman) shpR1(P).Width = Hitung(Plgn(1).PenempatanR(P), 795, Plgn(1).MaximumR(P)) lblP1(P).Caption = Plgn(1).PenempatanR(P) & "/" & Plgn(1).MaximumR(P) 'Bagi(Plgn(1).PenempatanR(P) * 100, Plgn(1).MaximumR(P)) & "%" Next P
Case 2 For P = 1 To UBound(NamaPinjaman) shpR2(P).Width = Hitung(Plgn(2).PenempatanR(P), 795, Plgn(2).MaximumR(P)) lblP2(P).Caption = Plgn(2).PenempatanR(P) & "/" & Plgn(2).MaximumR(P) 'Bagi(Plgn(2).PenempatanR(P) * 100, Plgn(2).MaximumR(P)) & "%" Next P Case 3 For P = 1 To UBound(NamaPinjaman) shpR3(P).Width = Hitung(Plgn(3).PenempatanR(P), 795, Plgn(3).MaximumR(P)) lblP3(P).Caption = Plgn(3).PenempatanR(P) & "/" & Plgn(3).MaximumR(P) 'lblP3(P).Caption = Bagi(Plgn(3).PenempatanR(P) * 100, Plgn(3).MaximumR(P)) & "%" Next P Case 4 For P = 1 To UBound(NamaPinjaman) shpR4(P).Width = Hitung(Plgn(4).PenempatanR(P), 795, Plgn(4).MaximumR(P)) lblP4(P).Caption = Plgn(4).PenempatanR(P) & "/" & Plgn(4).MaximumR(P) 'lblP4(P).Caption = Bagi(Plgn(4).PenempatanR(P) * 100, Plgn(4).MaximumR(P)) & "%" Next P Case 5 For P = 1 To UBound(NamaPinjaman) shpR5(P).Width = Hitung(Plgn(5).PenempatanR(P), 795, Plgn(5).MaximumR(P)) lblP5(P).Caption = Plgn(5).PenempatanR(P) & "/" & Plgn(5).MaximumR(P) 'lblP5(P).Caption = Bagi(Plgn(5).PenempatanR(P) * 100, Plgn(5).MaximumR(P)) & "%" Next P End Select End Sub 'Hitung Private Function Hitung(ByVal A1 As Double, ByVal A2 As Double, ByVal A3 As Double) As Double If A3 = 0 Then Hitung = A2 Else Hitung = Round(A1 * A2 / A3) End If End Function
6. Form Modul Banker Option Explicit 'Hasil Transaksi
Public H As String 'Hasil Analisis Public HA As String 'Indeks Pelanggan Public JlhIndeks As Long 'Nama Pinjaman Public NamaPinjaman() As String 'Waktu Simulasi Public WaktuSimulasi As Long 'Properti Banker Public Type PropBanker MaximumR() As Integer TersediaR() As Integer TempTersediaR() As Integer End Type 'Bank Public Bank As PropBanker 'Properti Pelanggan Public Type PropPlgn 'Indeks Indeks As Integer 'Tipe Tipe As Integer 'Sedang aktif / tidak Aktif As Boolean 'Aktivitas Aktivitas As String 'Request Pinjaman RequestR() As Integer 'Maksimum Pinjaman MaximumR() As Integer 'Alokasi Pinjaman PenempatanR() As Integer TempPenempatanR() As Integer 'Maximum - Penempatan NeedsR() As Integer TempNeedsR() As Integer 'u/ Pinjaman Request Alg Finish As Boolean End Type
'Pelanggan Public Plgn(5) As PropPlgn 'Delay Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'Help Public Const HH_DISPLAY_TOPIC = &H0 Public Const HH_CLOSE_ALL = &H12 Public Declare Function HtmlHelp Lib "HHCtrl.ocx" Alias "HtmlHelpA" _ (ByVal hwndCaller As Long, ByVal pszFile As String, ByVal uCommand As Long, _ dwData As Any) As Long
