LISTING PROGRAM
1.
Listing Menu Utama
Option Explicit Private nTime As Integer Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) ShowInputForm End Sub Private Sub Form_Load() nTime = 0 End Sub Private Sub Image1_Click() ShowInputForm End Sub Private Sub Timer1_Timer() nTime = nTime + 1 If nTime = 5 Then Timer1.Enabled = False ShowInputForm End If End Sub Private Sub ShowInputForm() Unload Me frmInput.Show End Sub
2.
Listing Menu Input
Option Explicit Private Sub cboSolusi_Click() Select Case cboSolusi.ListIndex Case 0 lblSolusi = "Tidak menggunakan solusi untuk mencegah " &_ "kondisi deadlock." Case 1 lblSolusi = "SOLUSI-A : Mengijinkan paling banyak 4 filsuf_ " & "yang duduk bersama-sama pada satu meja." Case 2 lblSolusi = "SOLUSI-B : Mengijinkan seorang filsuf_ mengambil " & "sumpit hanya jika kedua sumpit itu ada."
Universitas Sumatera Utara
Case 3 lblSolusi = "SOLUSI-C : Solusi asimetrik, yaitu filsuf pada_ nomor " & "ganjil mengambil sumpit kiri dulu baru sumpit_ kanan, sedangkan " & "filsuf pada nomor genap mengambil_ sumpit kanan dulu baru sumpit kiri." End Select End Sub Private Sub chkWaktu_Click() txtWaktu.Enabled = chkWaktu.Value End Sub Private Dim Dim Dim
Sub cmdAcak_Click() I As Integer J1 As Integer J2 As Integer
'Acak Properti filsuf With MProperti For I = 1 To 5 'Nilai acak minimum 2 detik, maks 12 detik 'WAKTU-A Randomize J1 = Int(Rnd * 10) + 2 .TextMatrix(I, 1) = J1 'WAKTU-B Randomize J2 = Int(Rnd * 10) + 2 .TextMatrix(I, 2) = J2 'Kondisi Awal Randomize J1 = Int(Rnd * (J1 + J2 - 3)) + 3 .TextMatrix(I, 3) = J1 Next I End With End Sub Private Sub cmdBuka_Click() On Error GoTo errUserCancel 'Simpan With CDialog .Flags = cdlOFNPathMustExist Or cdlOFNFileMustExist
Universitas Sumatera Utara
.InitDir = App.Path & "\" .ShowOpen cOpenLog = .FileName End With If cOpenLog = "" Then Exit Sub frmOpenLog.Show vbModal errUserCancel: End Sub Private Sub cmdKeluar_Click() Unload Me End Sub Private Sub cmdSimulasi_Click() Dim I As Integer 'Waktu Simulasi If chkWaktu.Value Then If Val(txtWaktu.Text) = 0 Then MsgBox "Waktu simulasi belum diisi !", vbCritical Exit Sub Else nWaktuSimulasi = Val(txtWaktu.Text) End If Else 'Waktu simulasi tidak terhingga nWaktuSimulasi = -1 End If 'Isi Properti filsuf For I = 1 To 5 'Filsuf - I With Filosof(I) .nSumpitKiri = 0 .nSumpitKanan = 0 'Cek minimal 2 detik If Val(MProperti.TextMatrix(I, 1)) < 2 Or _ Val(MProperti.TextMatrix(I, 2)) < 2 Or _ Val(MProperti.TextMatrix(I, 3)) < 2 Then MsgBox "Nilai properti filsuf minimal = 2 detik !", _ vbCritical Exit Sub End If 'Waktu-A & Waktu-B .nWaktuA = Val(MProperti.TextMatrix(I, 1)) .nWaktuB = Val(MProperti.TextMatrix(I, 2)) .nKondisi = Val(MProperti.TextMatrix(I, 3)) 'Get Aksi dan Kondisi If .nKondisi <= .nWaktuB Then .Aksi = "CARI SUMPIT"
Universitas Sumatera Utara
.Kondisi = "LAPAR" Else .Aksi = "BERPIKIR" .Kondisi = "KENYANG" End If 'Cek nKondisi -> tidak boleh lebih besar dari nWaktuA dan_ nWaktuB If .nKondisi > .nWaktuA + .nWaktuB Then MsgBox "Kondisi awal Filsuf harus berada di antara " & _ "range Waktu-A + Waktu-B !" & Chr(13) & "Kondisi awal_ Filsuf-" & I & " tidak memenuhi batas tersebut (Maks. _ " & .nWaktuA + .nWaktuB & " detik).", vbCritical Exit Sub End If 'Jika Solusi - A -> 4 orang filsuf 'Filsuf-5 dianggap mati If cboSolusi.ListIndex = 1 And I = 5 Then .nWaktuA = 0 .nWaktuB = 0 .Aksi = "" .Kondisi = "MATI" .nKondisi = -1 End If End With 'Variabel Sumpit Sumpit(I) = "1" Next I 'Waktu Simulasi (t) nWaktu = 0 'Solusi Pencegahan Deadlock nSolusi = cboSolusi.ListIndex 'Waktu Delay nDelay = Val(txtSekon) 'Dead Condition Available bMati = chkMati.Value 'Hide Me.Hide 'Show frmSimulate.Show End Sub Private Sub Form_Load() With MProperti .ColWidth(0) .ColWidth(1) .ColWidth(2) .ColWidth(3)
= = = =
1612 2100 2100 2100
Universitas Sumatera Utara
.ColAlignment(0) = 4 .TextMatrix(0, 0) = "" .TextMatrix(1, 0) = "Filsuf .TextMatrix(2, 0) = "Filsuf .TextMatrix(3, 0) = "Filsuf .TextMatrix(4, 0) = "Filsuf .TextMatrix(5, 0) = "Filsuf
1" 2" 3" 4" 5"
.ColAlignment(1) = 4 .TextMatrix(0, 1) = "Waktu-A (detik)" .ColAlignment(2) = 4 .TextMatrix(0, 2) = "Waktu-B (detik)" .ColAlignment(3) = 4 .TextMatrix(0, 3) = "Kondisi Awal (detik)" End With cboSolusi.ListIndex = 0 End Sub Private Sub MProperti_KeyPress(KeyAscii As Integer) Dim cKey As String cKey = Chr(KeyAscii) With MProperti Select Case KeyAscii Case vbKeyReturn 'Enter Key - pindah kolom If .Col < .Cols - 1 Then .Col = .Col + 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) >= 2 Then Exit Sub If cKey Like "#" Or cKey Like "-" Then .Text = .Text + cKey End If End Select End With End Sub Private Sub txtSekon_KeyPress(KeyAscii As Integer) If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <>_ vbKeyBack Then KeyAscii = 0 End If End Sub
Universitas Sumatera Utara
Private Sub txtWaktu_KeyPress(KeyAscii As Integer) If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <>_ vbKeyBack Then KeyAscii = 0 End If End Sub
3.
Listing Menu Open Log
Private Sub Form_Load() Text1.LoadFile cOpenLog End Sub Private Sub Form_Resize() Text1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight End Sub
4.
Listing Menu Simulate
Option Explicit Const nPBar = 2010 Private I As Integer Private nTemp1 As Integer Private nTemp2 As Integer Private nTemp3 As Integer Private nSumpitKiri As Integer Private nSumpitKanan As Integer 'Private nRandom As Integer Private nD As Integer Private bDeadlock As Boolean Private Sub cmdCetak_Click() On Error GoTo errCetak If MsgBox("Cetak log ke printer ?", vbYesNo + vbQuestion, "Cetak") _ = vbYes Then Printer.FontName = "Courier New" Printer.FontSize = "9" Printer.PaperSize = vbPRPSA4 Printer.Print txtLog.Text Printer.EndDoc End If Exit Sub errCetak: MsgBox "Printer Device Error !", vbCritical, "Error" End Sub Private Sub cmdKeluar_Click()
Universitas Sumatera Utara
Unload Me frmInput.Show End Sub Private Sub cmdPlay_Click() If txtLog.Text = "" Then txtLog.Text = "DINING PHILOSOPHER LOG" & vbCrLf & _ "----------------------" End If If cmdPlay.Tag = "PLAY" Then 'Command Button cmdSimpan.Enabled = False cmdCetak.Enabled = False cmdKeluar.Enabled = False 'Enable Timer Timer1.Enabled = True cmdPlay.Caption = "Hentik&an Simulasi" cmdPlay.Tag = "PAUSE" Else 'Disable Timer Timer1.Enabled = False cmdPlay.Caption = "Lanjutk&an Simulasi" cmdPlay.Tag = "PLAY" cmdSimpan.Enabled = True cmdCetak.Enabled = True cmdKeluar.Enabled = True End If End Sub Private Dim Dim Dim Dim
Sub cmdSimpan_Click() cSimpan As String cBaris As String nB As Integer nC As Integer
On Error GoTo errUserCancel 'Simpan With CDialog .Flags = cdlOFNPathMustExist Or cdlOFNOverwritePrompt .ShowSave cSimpan = .FileName End With If cSimpan = "" Then Exit Sub Open cSimpan For Output As #1 'Header tabel Print #1, "TABEL KONDISI SIMULASI" Print #1, String(80, "-")
Universitas Sumatera Utara
Print #1, "Filsuf " & vbTab & vbTab & _ "Waktu-A (s)" & vbTab & _ "Waktu-B (s)" & vbTab & _ "Masa Hidup (s)" & vbTab & _ "Kondisi Awal" Print #1, String(80, "-") 'Isi tabel For nB = 1 To MProperti.Rows - 1 cBaris = MProperti.TextMatrix(nB, 0) & vbTab For nC = 1 To MProperti.Cols - 1 cBaris = cBaris & vbTab & vbTab & MProperti.TextMatrix(nB,_ nC) Next nC Print #1, cBaris Next nB Print #1, String(80, "-") & vbCrLf 'Simpan Log Print #1, txtLog.Text Close #1 errUserCancel: End Sub Private Sub Form_Load() nD = 0 bDeadlock = False If nWaktuSimulasi > 0 Then lblWaktuSimulasi = "LAMA SIMULASI = " & nWaktuSimulasi & " DETIK." Else lblWaktuSimulasi = "LAMA SIMULASI TIDAK DITENTUKAN." End If
_
'Informasi Properti Filsuf With MProperti .ColWidth(0) = 1350 .ColWidth(1) = 1450 .ColWidth(2) = 1450 .ColWidth(3) = 1450 .ColWidth(4) = 1180 .ColAlignment(0) = 4 .TextMatrix(0, 0) = "Properti Filsuf" .TextMatrix(1, 0) = "Filsuf 1" .TextMatrix(2, 0) = "Filsuf 2" .TextMatrix(3, 0) = "Filsuf 3" .TextMatrix(4, 0) = "Filsuf 4" .TextMatrix(5, 0) = "Filsuf 5" .ColAlignment(1) = 4 .TextMatrix(0, 1) = "Waktu-A (detik)"
Universitas Sumatera Utara
.ColAlignment(2) = 4 .TextMatrix(0, 2) = "Waktu-B (detik)" .ColAlignment(3) = 4 .TextMatrix(0, 3) = "Masa Hidup (s)" .ColAlignment(4) = 4 .TextMatrix(0, 4) = "Kondisi" For I = 1 To 5 .TextMatrix(I, 1) = IIf(Filosof(I).nWaktuA = 0, "-", _ Filosof(I).nWaktuA) .TextMatrix(I, 2) = IIf(Filosof(I).nWaktuB = 0, "-", _ Filosof(I).nWaktuB) .TextMatrix(I, 3) = IIf(Filosof(I).nKondisi <= 0, "-", _ Filosof(I).nKondisi) .TextMatrix(I, 4) = Filosof(I).Kondisi 'Update p-Bar If Filosof(I).nKondisi > Filosof(I).nWaktuB Then nTemp2 = Filosof(I).nKondisi - Filosof(I).nWaktuB shpA(I).Width = Int((nTemp2 * CDbl(nPBar)) / Filosof(I).nWaktuA) shpB(I).Width = nPBar Else shpA(I).Width = 0 If Filosof(I).nKondisi <> -1 Then shpB(I).Width = Int((Filosof(I).nKondisi * CDbl(nPBar)) / Filosof(I).nWaktuB) Else shpB(I).Width = 0 End If End If
_
_
'Tentukan Legend di Bagan-1 Select Case Filosof(I).Kondisi Case "KENYANG" shpFilosof(I).FillColor = shpKenyang.FillColor Case "LAPAR" shpFilosof(I).FillColor = shpLapar.FillColor Case "MATI" shpFilosof(I).FillColor = shpMati.FillColor End Select 'Gambar di Bagan-2 Call LoadPict(imgFilosof(I), Filosof(I).Kondisi) Next I End With 'Pencegahan Deadlock If nSolusi = 0 Then lblDeadlock = "<TIDAK ADA>" Else lblDeadlock = "menggunakan Solusi-" & Chr(64 + nSolusi)
Universitas Sumatera Utara
End If 'Skala Waktu lblWaktu = "0" Timer1.Interval = nDelay lblSkala = "Nb. 1 detik dalam program = " & nDelay & " milidetik." 'Dead Condition If bMati Then lblDead = "Dead Condition Available (Mengizinkan keadaan mati)." Else lblDead = "Dead Condition Disable (Tidak mengizinkan keadaan mati)." End If DoEvents End Sub Private Sub Timer1_Timer() '---------------------------'SIMULASI DINING PHILOSOPHER '---------------------------'Tambah Waktu nWaktu = nWaktu + 1 lblWaktu = nWaktu 'Filsuf - I For I = 1 To 5 With Filosof(I) 'Variabel sumpit kiri nSumpitKiri = I 'Variabel sumpit kanan If I - 1 = 0 Then nSumpitKanan = 5 Else nSumpitKanan = I - 1 End If 'Update Kondisi Filsuf Select Case Filosof(I).Aksi Case "CARI SUMPIT" If .nKondisi > -1 Then 'Kurangi Kondisi .nKondisi = .nKondisi - 1 End If If .nKondisi >= 0 Then 'Update p-bar shpB(I).Width = Int((.nKondisi * _ CDbl(nPBar)) / .nWaktuB)
Universitas Sumatera Utara
End If If .nKondisi = -1 Then 'Cek Dead Condition Available If bMati Then .Kondisi = "MATI" .Aksi = "MATI" 'Log txtLog.Text = txtLog.Text & _ vbCrLf & "[t = " & nWaktu & "s] _ Filsuf-" & I & " MATI." End If End If Case "MAKAN" 'Tambah Kondisi .nKondisi = .nKondisi + 1 If .nKondisi = .nWaktuA + .nWaktuB Then 'Sekarang filsuf Kenyang, Mulai Berpikir nTemp2 = .nKondisi - .nWaktuB shpA(I).Width = Int((nTemp2 * _ CDbl(nPBar)) / .nWaktuA) .Kondisi = "KENYANG" .Aksi = "KENYANG" 'Log txtLog.Text = txtLog.Text & vbCrLf _ & "[t = " & nWaktu & "s] Filsuf-" _ & I & " kenyang dan mulai berpikir." ElseIf .nKondisi > .nWaktuB Then 'Sekarang Filsuf Hampir Kenyang dan Tetap Makan nTemp2 = .nKondisi - .nWaktuB shpA(I).Width = Int((nTemp2 * _ CDbl(nPBar)) / .nWaktuA) .Kondisi = "KENYANG" Randomize nRandom = Int(Rnd * 3) If nRandom = 2 Then .Aksi = "KENYANG" Else .Aksi = "MAKAN" End If Else 'Filosof Masih Lapar dan Tetap Makan
Universitas Sumatera Utara
shpB(I).Width = Int((.nKondisi * _ CDbl(nPBar)) / .nWaktuB) .Kondisi = "LAPAR" .Aksi = "MAKAN" End If Case "BERPIKIR" 'Kurangi Kondisi .nKondisi = .nKondisi - 1 'Update p-bar nTemp2 = .nKondisi - .nWaktuB shpA(I).Width = Int((nTemp2 CDbl(nPBar)) / .nWaktuA)
*
_
If .nKondisi = .nWaktuB Then 'Sekarang Filsuf Lapar .Kondisi = "LAPAR" .Aksi = "CARI SUMPIT" 'Log txtLog.Text = txtLog.Text & vbCrLf _ & "[t = " & nWaktu & "s] Filsuf-" _ & I & " lapar dan mulai mencari _ sumpit." End If End Select 'Lakukan Aksi Select Case Filosof(I).Aksi Case "MATI" 'Setelah mati, maka habis .nKondisi = -1 .Aksi = "" Call LoadPict(imgFilosof(I), "MATI") 'Cek apakah sedang memegang sumpit di tangan kiri If .nSumpitKiri <> 0 Then 'Ada, maka lepaskan sumpit .nSumpitKiri = 0 Sumpit(nSumpitKiri) = 1 shpSumpit(nSumpitKiri).Visible = True imgSumpit(nSumpitKiri).Visible = True End If 'Cek apakah sedang memegang sumpit di tangan kanan If .nSumpitKanan <> 0 Then 'Ada, maka lepaskan sumpit .nSumpitKanan = 0 Sumpit(nSumpitKanan) = 1 shpSumpit(nSumpitKanan).Visible = True
Universitas Sumatera Utara
imgSumpit(nSumpitKanan).Visible = True End If 'Update bagan-1 shpFilosof(I).FillColor = shpMati.FillColor Case "KENYANG"
'Filsuf tersenyum
'Setelah kenyang, maka filsuf mulai berpikir kembali .Aksi = "BERPIKIR" Call LoadPict(imgFilosof(I), "KENYANG") 'Lepaskan sumpit kiri .nSumpitKiri = 0 Sumpit(nSumpitKiri) = 1 shpSumpit(nSumpitKiri).Visible = True imgSumpit(nSumpitKiri).Visible = True 'Lepaskan sumpit kanan .nSumpitKanan = 0 Sumpit(nSumpitKanan) = 1 shpSumpit(nSumpitKanan).Visible = True imgSumpit(nSumpitKanan).Visible = True 'Update bagan-1 shpFilosof(I).FillColor = shpKenyang.FillColor Case "CARI SUMPIT"
'Filosof Lapar & Mencari Sumpit
If nSolusi = 2 Then 'SOLUSI - B -> SEKALI AMBIL DUA SUMPIT If Sumpit(nSumpitKiri) = 1 And _ Sumpit(nSumpitKanan) = 1 Then 'Hilangkan sumpit kiri Sumpit(nSumpitKiri) = 0 shpSumpit(nSumpitKiri).Visible = False imgSumpit(nSumpitKiri).Visible = False .nSumpitKiri = 1 'Hilangkan sumpit kanan Sumpit(nSumpitKanan) = 0 shpSumpit(nSumpitKanan).Visible = False imgSumpit(nSumpitKanan).Visible = False .nSumpitKanan = 1 End If ElseIf nSolusi = 3 And (I Mod 2) = 0 Then 'Solusi Asimetrik, No. Genap -> Kanan Baru Kiri 'Cek sumpit kanan - baru kiri If .nSumpitKanan = 0 And Sumpit(nSumpitKanan) = 1 Then 'Ambil & Hilangkan sumpit kanan
Universitas Sumatera Utara
Sumpit(nSumpitKanan) = 0 shpSumpit(nSumpitKanan).Visible = False imgSumpit(nSumpitKanan).Visible = False .nSumpitKanan = 1 ElseIf .nSumpitKanan = 1 And .nSumpitKiri = 0 And _ Sumpit(nSumpitKiri) = 1 Then 'Ambil & Hilangkan sumpit kiri Sumpit(nSumpitKiri) = 0 shpSumpit(nSumpitKiri).Visible = False imgSumpit(nSumpitKiri).Visible = False .nSumpitKiri = 1 End If ElseIf nSolusi = 3 And (I Mod 2) = 1 Then 'Solusi Asimetrik, No. Ganjil -> Kiri Baru Kanan 'Cek sumpit kiri - baru kanan If .nSumpitKiri = 0 And Sumpit(nSumpitKiri) = 1 Then 'Ambil & Hilangkan sumpit kiri Sumpit(nSumpitKiri) = 0 shpSumpit(nSumpitKiri).Visible = False imgSumpit(nSumpitKiri).Visible = False .nSumpitKiri = 1 ElseIf .nSumpitKiri = 1 And .nSumpitKanan = 0 And _ Sumpit(nSumpitKanan) = 1 Then 'Ambil & Hilangkan sumpit kanan Sumpit(nSumpitKanan) = 0 shpSumpit(nSumpitKanan).Visible = False imgSumpit(nSumpitKanan).Visible = False .nSumpitKanan = 1 End If Else 'Tidak ada solusi, ambil kiri dulu baru kanan 'Cek sumpit kiri - baru kanan If .nSumpitKiri = 0 And Sumpit(nSumpitKiri) = 1 Then
_
'Ambil & Hilangkan sumpit kiri Sumpit(nSumpitKiri) = 0 shpSumpit(nSumpitKiri).Visible = False imgSumpit(nSumpitKiri).Visible = False .nSumpitKiri = 1 ElseIf .nSumpitKanan = 0 Sumpit(nSumpitKanan) = 1 Then
And
_
'Ambil & Hilangkan sumpit kanan
Universitas Sumatera Utara
Sumpit(nSumpitKanan) = 0 shpSumpit(nSumpitKanan).Visible = False imgSumpit(nSumpitKanan).Visible = False .nSumpitKanan = 1 End If End If 'Load Gambar If .nSumpitKiri = 0 And .nSumpitKanan = 0 Then If imgFilosof(I).Tag <> "LAPAR" Then 'Tidak mendapatkan sumpit Call LoadPict(imgFilosof(I), "LAPAR") imgFilosof(I).Tag = "LAPAR" End If ElseIf .nSumpitKiri = 1 And .nSumpitKanan = 0 Then If imgFilosof(I).Tag <> "LAPAR-L" Then 'Mendapatkan sumpit di tangan kiri saja Call LoadPict(imgFilosof(I), "LAPAR-L") imgFilosof(I).Tag = "LAPAR-L" 'Log txtLog.Text = txtLog.Text & vbCrLf & _ "[t = " & nWaktu & "s] Filsuf-" & _ I & " mendapatkan sumpit di tangan kiri." End If ElseIf .nSumpitKiri = 0 And .nSumpitKanan = 1 Then If imgFilosof(I).Tag <> "LAPAR-R" Then 'Mendapatkan sumpit di tangan kanan saja Call LoadPict(imgFilosof(I), "LAPAR-R") imgFilosof(I).Tag = "LAPAR-R" 'Log txtLog.Text = txtLog.Text & vbCrLf & _ "[t = " & nWaktu & "s] Filsuf-" & _ I & " mendapatkan sumpit di tangan kanan." End If Else 'Mendapatkan sumpit di kedua tangan Call LoadPict(imgFilosof(I), "SUKSES") 'Filosof mulai makan .Aksi = "MAKAN" 'Log txtLog.Text = txtLog.Text & vbCrLf & _ "[t = " & nWaktu & "s] Filsuf-" & _ I & " mendapat 2 sumpit dan mulai makan." End If 'Update bagan-1 shpFilosof(I).FillColor = shpLapar.FillColor
Universitas Sumatera Utara
Case "MAKAN"
'Filosof Sedang Makan If imgFilosof(I).Tag = "MAKAN-1" Then Call LoadPict(imgFilosof(I), "MAKAN-2") imgFilosof(I).Tag = "MAKAN-2" Else Call LoadPict(imgFilosof(I), "MAKAN-1") imgFilosof(I).Tag = "MAKAN-1" End If 'Update bagan-1 shpFilosof(I).FillColor = shpMakan.FillColor
Case "BERPIKIR" 'Filosof Sedang Berpikir 'Load Gambar If imgFilosof(I).Tag = "BERPIKIR-1" Then Call LoadPict(imgFilosof(I), "BERPIKIR-2") imgFilosof(I).Tag = "BERPIKIR-2" Else Call LoadPict(imgFilosof(I), "BERPIKIR-1") imgFilosof(I).Tag = "BERPIKIR-1" End If End Select 'Tampil ke tabel MProperti.TextMatrix(I, 3) = .nKondisi MProperti.TextMatrix(I, 4) = .Kondisi End With Next I 'Cek Kondisi Deadlock If bDeadlock = False Then Dim bD As Boolean bD = True For I = 1 To 5 If Filosof(I).nSumpitKiri = 0 And _ Filosof(I).nSumpitKanan = 1 Then bD = bD And True ElseIf Filosof(I).nSumpitKiri = 1 And _ Filosof(I).nSumpitKanan = 0 Then bD = bD And True Else 'Tidak Deadlock bD = bD And False Exit For End If Next I
Universitas Sumatera Utara
'Hidupkan timer-2 If bD = True Then bDeadlock = True Timer2.Enabled = True End If End If 'Cek waktu simulasi If nWaktuSimulasi > 0 Then If nWaktu = nWaktuSimulasi Then 'Log txtLog.Text = txtLog.Text & vbCrLf & _ "[t = " & nWaktu & "s] " & _ "SIMULASI SELESAI." Timer1.Enabled = False cmdPlay.Enabled = False cmdSimpan.Enabled = True cmdCetak.Enabled = True cmdKeluar.Enabled = True End If End If DoEvents End Sub Private Sub Timer2_Timer() nD = nD + 1 If nD = 5 Then 'Disable Timer1 If Timer1.Enabled Then Call cmdPlay_Click End If cmdPlay.Enabled = False 'Disable Timer2 Timer2.Enabled = False MsgBox "Telah terjadi kondisi DEADLOCK !", vbCritical 'Log txtLog.Text = txtLog.Text & vbCrLf & _ "[t = " & nWaktu & "s] Terjadi kondisi DEADLOCK !" End If End Sub Private Sub txtLog_Change() txtLog.SelStart = Len(txtLog.Text) End Sub Private Sub LoadPict(imgP As Image, pcGbr As String) imgP.Picture = LoadPicture(App.Path & "\Image\" & pcGbr & ".gif") End Sub
Universitas Sumatera Utara
5.
Listing Module1
Option Explicit 'Properti Filsuf Public Type PropFilosof 'Waktu Kenyang -> Lapar nWaktuA As Byte 'Waktu Lapar -> Mati nWaktuB As Byte 'Kondisi Awal nKondisi As Integer 'Sumpit di Tangan Kiri nSumpitKiri As Byte 'Sumpit di Tangan Kanan nSumpitKanan As Byte 'Aksi Filsuf Aksi As String 'Kondisi Kondisi As String End Type 'Variabel Filsuf Public Filosof(5) As PropFilosof '0 = Kosong / 1 = Berisi Public Sumpit(5) As Byte 'Solusi Pencegahan Deadlock Public nSolusi As Byte 'Kecepatan Simulasi Public nDelay As Integer 'Filsuf bisa mati? Public bMati As Boolean 'Waktu Public nWaktu As Long 'Waktu Simulasi Public nWaktuSimulasi As Integer 'Open File Public cOpenLog As String
Universitas Sumatera Utara