LISTING PROGRAM. Form Utama. Dim Red, Green, Blue As Integer

LISTING PROGRAM Form Utama Dim Red, Green, Blue As Integer Private Sub Timer1_Timer() If Blue <= 255 Then Blue = Blue + 50 Else Blue = 0 Green = Green + 50 End If If Green >= 255 Then Green = 0 Red = Red + 50 End If If Red >= 255 Then Red = 0 End If Label1.ForeColor = Int(RGB(Red, Green, Blue)) Label1.Refresh End Sub Private Sub Timer2_Timer() Label2.Left = Label2.Left - 15 If Label2.Left <= -Label2.Left Then Label2.Left = Menu.Width End If End Sub Private Sub mnuAboutProgram_Click() frmAbout.Show End Sub Private Sub mnuProgram_Click() frmAbout.Show End Sub Private Sub mnuExit_Click() End End Sub Private Sub mnuKeluar_Click() Unload Me End Sub Private Sub mnuLogIn_Click() frmLogin.Show End Sub Private Sub mnuObat_Click() frmObat.Show End Sub

Private Sub mnuPelanggan_Click()

Universitas Sumatera Utara

frmPelanggan.Show End Sub Private Sub mnuPembelian_Click() frmPembelian.Show End Sub Private Sub mnuPenjualan_Click() frmPenjualan.Show End Sub Private Sub mnuSupplier_Click() frmSupplier.Show End Sub Private Sub mnuSelesai_Click() Unload Me End Sub Private Sub MDIForm_QueryUnload(Cancel Integer) Dim Msg As VbMsgBoxResult

As

Integer,

UnloadMode

As

Msg = MsgBox("Anda ingin keluar dari aplikasi ? Terima kasih Telah Menggunakan Program Ini...", vbYesNo + vbQuestion, App.Title) If Msg = vbYes Then End Else Cancel = 1 End If End Sub Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Index Case 1: mnuObat_Click Case 2: mnuPelanggan_Click Case 3: mnuSupplier_Click Case 4: mnuPenjualan_Click Case 5: mnuPembelian_Click Case 6: mnuProgram_Click Case 7: mnuKeluar_Click End Select End Sub Private Sub mnuLapDataObat_Click() With LapDataObat .SelectionFormula = " " .WindowMinButton = False .WindowShowCancelBtn = True .WindowShowCloseBtn = True .WindowShowPrintBtn = True .WindowShowPrintSetupBtn = True .WindowState = crptMaximized .Action = 1 .RetrieveDataFiles End With End Sub Private Sub mnuLapDataJual_Click()


With LapDataPenjualan .SelectionFormula = " " .WindowMinButton = False .WindowShowCancelBtn = True .WindowShowCloseBtn = True .WindowShowPrintBtn = True .WindowShowPrintSetupBtn = True .WindowState = crptMaximized .Action = 1 .RetrieveDataFiles End With End Sub Private Sub mnuLapDatSup_Click() With LapDataSupplier .SelectionFormula = "" .WindowMinButton = False .WindowShowCancelBtn = True .WindowShowCloseBtn = True .WindowShowPrintBtn = True .WindowShowPrintSetupBtn = True .WindowState = crptMaximized .Action = 1 .RetrieveDataFiles End With End Sub Private Sub mnuLaporanPelanggan_Click() With LapPelanggan .SelectionFormula = "" .WindowMinButton = False .WindowShowCancelBtn = True .WindowShowCloseBtn = True .WindowShowPrintBtn = True .WindowShowPrintSetupBtn = True .WindowState = crptMaximized .Action = 1 .RetrieveDataFiles End With End Sub Private Sub mnuLapPembelian_Click() With LapBeli .SelectionFormula = "" .WindowMinButton = False .WindowShowCancelBtn = True .WindowShowCloseBtn = True .WindowShowPrintBtn = True .WindowShowPrintSetupBtn = True .WindowState = crptMaximized .Action = 1 .RetrieveDataFiles End With End Sub Private Sub Timer4_Timer() Label4 = Time End Sub


Form Splash Public WaktuStart As Single Option Explicit Private Sub Form_KeyPress(Keyascii As Integer) Unload Me End Sub Private Sub Frame1_Click() Unload Me End Sub Private Sub Form_Load() WaktuStart = Timer Tmrcover.Enabled = True End Sub Private Sub Tmrcover_Timer() Dim Persen As Single Persen = 100 * (Timer - WaktuStart) / 2 If Persen <= 100 Then pbcover.Value = Persen Lblpersen.Caption = Str(Int(Persen)) + " %" Else pbcover.Value = 100 Lblpersen.Caption = "100 %" Tmrcover.Enabled = False Load frmLogin frmLogin.Show Unload Me End If End Sub

Form Login Dim teksJalan As String Dim Red, Green, Blue As Integer Public conn As New ADODB.Connection Public rs As New ADODB.Recordset Private Sub CmdLogin_Click() If conn.State = 1 Then conn.Close conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source = " App.Path & "\DataApotik\Apotik.mdb"

&

If rs.State = 1 Then rs.Close rs.Open "select * from login where username = '" & TxtUser.Text & "' And password = '" & TxtPass.Text & "'", conn, 3, 3 If Not rs.EOF Then MsgBox "SELAMAT,,, ANDA BERHASIL" Menu.Show Else MsgBox "Data Yang Anda Masukkan Salah", vbCritical, "L O G I N"


TxtUser.Text = "" TxtPass.Text = "" TxtUser.SetFocus End If End Sub Private Sub cmdExit_Click() Unload Me End Sub Private Sub Form_Load() teksJalan = "..::Masukkan Username dan Password::.. " End Sub Private Sub Timer2_Timer() a = Left(teksJalan, 1) c = Len(teksJalan) b = Right(teksJalan, c - 1) teksJalan = b + a frmLogin.Caption = teksJalan End Sub Private Sub Timer3_Timer() If Blue <= 255 Then Blue = Blue + 50 Else Blue = 0 Green = Green + 50 End If If Green >= 255 Then Green = 0 Red = Red + 50 End If If Red >= 255 Then Red = 0 End If Label3.ForeColor = Int(RGB(Red, Green, Blue)) Label3.Refresh End Sub Private Sub Timer4_Timer() Label4.Left = Label4.Left - 15 If Label4.Left <= -Label4.Left Then Label4.Left = Menu.Width End If End Sub


Form About Option Explicit ' Reg Const Const Const Const Const Const Const Const

Key Security Options... READ_CONTROL = &H20000 KEY_QUERY_VALUE = &H1 KEY_SET_VALUE = &H2 KEY_CREATE_SUB_KEY = &H4 KEY_ENUMERATE_SUB_KEYS = &H8 KEY_NOTIFY = &H10 KEY_CREATE_LINK = &H20 KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _ KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS +

_ KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL ' Reg Key ROOT Types... Const HKEY_LOCAL_MACHINE = &H80000002 Const ERROR_SUCCESS = 0 Const REG_SZ = 1 string Const REG_DWORD = 4 Const Const Const Const

' Unicode nul terminated ' 32-bit number

gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location" gREGVALSYSINFOLOC = "MSINFO" gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO" gREGVALSYSINFO = "PATH"

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long Private Sub cmdSysInfo_Click() Call StartSysInfo End Sub Private Sub Form_Aktivate() Me.Caption = "About " & App.Title lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision lblTitle.Caption = App.Title End Sub Public Sub StartSysInfo() On Error GoTo SysInfoErr Dim rc As Long Dim SysInfoPath As String ' Try To Get System Info Program Path\Name From Registry... If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then ' Try To Get System Info Program Path Only From Registry...


ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then ' Validate Existance Of Known 32 Bit File Version If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then SysInfoPath = SysInfoPath & "\MSINFO32.EXE" ' Error - File Can Not Be Found... Else GoTo SysInfoErr End If ' Error - Registry Entry Can Not Be Found... Else GoTo SysInfoErr End If Call Shell(SysInfoPath, vbNormalFocus) Exit Sub SysInfoErr: MsgBox "System Information Is Unavailable At This Time", vbOKOnly End Sub Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean Dim i As Long ' Loop Counter Dim rc As Long ' Return Code Dim hKey As Long ' Handle To An Open Registry Key Dim hDepth As Long ' Dim KeyValType As Long ' Data Type Of A Registry Key Dim tmpVal As String ' Tempory Storage For A Registry Key Value Dim KeyValSize As Long ' Size Of Registry Key Variable '-----------------------------------------------------------' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...} '-----------------------------------------------------------rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError Error... tmpVal = String$(1024, 0) Variable Space KeyValSize = 1024 Variable Size

' Handle

' Allocate ' Mark

'-----------------------------------------------------------' Retrieve Registry Key Value... '-----------------------------------------------------------rc = RegQueryValueEx(hKey, SubKeyRef, 0, _ KeyValType, tmpVal, KeyValSize) Get/Create Key Value If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError Errors

'

' Handle


If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String... tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String Else ' WinNT Does NOT Null Terminate String... tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only End If '-----------------------------------------------------------' Determine Key Value Type For Conversion... '-----------------------------------------------------------Select Case KeyValType ' Search Data Types... Case REG_SZ ' String Registry Key Data Type KeyVal = tmpVal ' Copy String Value Case REG_DWORD ' Double Word Registry Key Data Type For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By Char. Next KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To String End Select GetKeyValue = True Success rc = RegCloseKey(hKey) Registry Key Exit Function

' Return ' Close ' Exit

GetKeyError: ' Cleanup After An Error Has Occured... KeyVal = "" Return Val To Empty String GetKeyValue = False Failure rc = RegCloseKey(hKey) Registry Key End Function

' Set ' Return ' Close

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Image1.BorderStyle = 1 Then Image1.BorderStyle = 0 End If End Sub Private Sub FrmMe_Click() FrmMe.Visible = False End Sub Private Sub Image1_Click() Image2.Picture = Image1.Picture FrmMe.Visible = True End Sub


Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Image1.BorderStyle = 0 Then Image1.BorderStyle = 1 End If End Sub Private Sub Image2_Click() Call FrmMe_Click End Sub Private Sub cmdOK_Click() Unload Me End Sub

Form Obat Sub kosong() Dim ctrl As Control For Each ctrl In frmObat If TypeName(ctrl) = "TextBox" Then ctrl.Text = "" Next End Sub Sub aktif() TxtKode.Enabled = True TxtNama.Enabled = True CmbSatuan.Enabled = True TxtHrgPokok.Enabled = True TxtHrgJual.Enabled = True TxtStok.Enabled = True End Sub Sub nonaktif() TxtKode.Enabled = False TxtNama.Enabled = False CmbSatuan.Enabled = False TxtHrgPokok.Enabled = False TxtHrgJual.Enabled = False TxtStok.Enabled = False End Sub Private Sub CmdEdit_Click() Data1.Recordset.Edit aktif TxtKode.SetFocus End Sub Private Sub CmdCari_Click() Data1.Recordset.FindFirst "kdobat='" & TxtCari.Text & "'" If Data1.Recordset.NoMatch Then MsgBox "DATA TIDAK DITEMUKAN", vbOKOnly, "INFORMASI" TxtCari = "" TxtCari.SetFocus Else tampilkan End If End Sub


Private Sub cmdHapus_Click() del = MsgBox("yakin akan dihapus???", vbYesNo, "KONFIRMASI") If del = vbYes Then Data1.Recordset.Delete Data1.Recordset.MoveFirst End If tampilkan End Sub Private Sub CmdKeluar_Click() kel = MsgBox("YAKIN AKAN KELUAR", 36, "konfirmasi") If kel = vbYes Then Unload Me End If End Sub Private Sub CmdLast_Click() Data1.Recordset.MoveLast tampilkan End Sub Private Sub CmdNext_Click() Data1.Recordset.MoveNext If Data1.Recordset.EOF Then MsgBox "DATA SUDAH DIAKHIR RECORD", vbOKOnly, "INFORMASI" Data1.Recordset.MoveLast End If tampilkan End Sub Private Sub CmdPrev_Click() Data1.Recordset.MovePrevious If Data1.Recordset.BOF Then MsgBox "DATA SUDAH DIAWAL RECORD", vbOKOnly, "INFORMASI" Data1.Recordset.MoveFirst End If tampilkan End Sub Private Sub CmdSimpan_Click() With Data1.Recordset !kdobat = TxtKode !nmobat = TxtNama !satuan = CmbSatuan !hrgpokok = TxtHrgPokok !hrgjual = TxtHrgJual !stok = TxtStok .Update End With nonaktif tampilkan End Sub Private Sub CmdTambah_Click() Data1.Recordset.AddNew Call aktif TxtKode.SetFocus kosong End Sub


Private Sub CmsFirst_Click() Data1.Recordset.MoveFirst tampilkan End Sub Private Sub Form_Activate() nonaktif Label6 = Date tampilkan End Sub Sub tampilkan() With Data1.Recordset TxtKode = "" TxtNama = "" CmbSatuan = "" TxtHarPok = "" TxtHarJu = "" TxtStok = "" End With End Sub Private Sub Timer1_Timer() Label7 = Time End Sub Private Sub Form_Load() CmbSatuan.AddItem "BOTOL" CmbSatuan.AddItem "ZAK" CmbSatuan.AddItem "DUS" CmbSatuan.AddItem "TABLET" CmbSatuan.AddItem "CREAM" CmbSatuan.AddItem "SUNTIK" CmbSatuan.AddItem "KAPSUL" CmbSatuan.AddItem "SYRUP" End Sub

Form Supplier Sub aktif() TxtKode.Enabled = True TxtNama.Enabled = True TxtAlamat.Enabled = True TxtKota.Enabled = True TxtTelepon.Enabled = True End Sub Sub nonaktif() Dim b As Control For Each b In Me If TypeName(b) = "TextBox" Then b.Enabled = False End If Next End Sub Sub kosong() TxtKode = "" TxtNama = ""


TxtAlamat = "" TxtKota = "" TxtTelepon = "" End Sub Private Sub CmdBatal_Click() nonaktif Data1.Recordset.MoveFirst kosong nonaktif End Sub Private Sub CmdEdit_Click() Y = InputBox("KETIK KODE BARANG YANG AKAN DIEDIT") X = "KdSupplier = '" & Y & "'" Data1.Recordset.FindFirst X If Not Data1.Recordset.EOF Then tampilkan aktif TxtKode.SetFocus Else MsgBox "KODE TIDAK DITEMUKAN", 0, "INFO" End If End Sub Private Sub cmdHapus_Click() Y = InputBox("KETIK KODE BARANG YANG AKAN DIHAPUS") X = "kdsupplier = '" & Y & "'" If Not Data1.Recordset.EOF Then tampilkan del = MsgBox("YAKIN AKAN DIHAPUS..?", vbYesNo, "KONFIRMASI") If del = vbYes Then Data1.Recordset.Delete Data1.Recordset.MoveFirst tampilkan End If Else MsgBox "DATA TIDAK DITEMUKAN", 0, "KONFIRMSI" End If End Sub Private Sub CmdKeluar_Click() Unload Me End Sub Private Sub CmdSimpan_Click() With Data1.Recordset !kdsupplier = TxtKode !nmsupplier = TxtNama !alamat = TxtAlamat !kota = TxtKota !telepon = TxtTelepon .Update End With nonaktif tampilkan End Sub


Private Sub CmdTambah_Click() aktif kosong TxtKode.SetFocus Data1.Recordset.AddNew End Sub Private Sub Form_Activate() nonaktif tampilkan End Sub Sub tampilkan() With Data1.Recordset TxtKode = "" TxtNama = "" TxtAlamat = "" TxtKota = "" TxtTelepon = "" End With End Sub Private Sub TxtKode_KeyPress(Keyascii As Integer) Keyascii = Asc(UCase(Chr(Keyascii))) If Keyascii = 13 Then sy = "kdsupplier = '" & TxtKode & "'" Data1.Recordset.Find sy, , adSearchForward, 1 If Not Data1.Recordset.EOF Then MsgBox "KODE SUDAH ADA", 0, "info" TxtKode = "" TxtKode.SetFocus Else TxtNama.SetFocus Data1.Recordset.AddNew End If End If End Sub

Form Pelanggan Sub kosong() For Each ctrl In Me If TypeName(ctrl) = "TextBox" Then ctrl.Text = "" Next End Sub Sub aktif() For Each ctrl In Me If TypeName(ctrl) = "TextBox" Then ctrl.Enabled = True End If Next End Sub Sub nonaktif() For Each ctrl In Me If TypeName(ctrl) = "TextBox" Then ctrl.Enabled = False End If


Next End Sub Sub Tampil() With Data1.Recordset TxtKode = "" TxtNama = "" TxtAlamat = "" TxtKota = "" TxtTelepon = "" End With End Sub Private Sub CmdEdit_Click() aktif Data1.Recordset.Edit TxtKode.SetFocus End Sub Private Sub cmdHapus_Click() del = MsgBox("YAKIN AKAN DIHAPUS", vbYesNo, "KONFIRMSI") If del = vbYes Then Data1.Recordset.Delete Data1.Recordset.MoveFirst End If Tampil End Sub Private Sub CmdKeluar_Click() Unload Me End Sub Private Sub CmdSimpan_Click() With Data1.Recordset !kdpelanggan = TxtKode !nmpelanggan = TxtNama !alamat = TxtAlamat !kota = TxtKota !telepon = TxtTelepon .Update End With nonaktif Tampil End Sub Private Sub CmdTambah_Click() Data1.Recordset.AddNew Call aktif TxtKode.SetFocus kosong End Sub Private Sub Form_Activate() nonaktif Tampil End Sub


Form Penjualan Private Sub CmdBatal_Click() Bersih End Sub Private Sub CmdKeluar_Click() X = MsgBox("YAKIN MAU KELUAR...?", vbYesNo, "KONFIRMASI") If X = vbYes Then Unload Me End If End Sub Private Sub CmdSimpan_Click() With Data3.Recordset .AddNew !faktur = TxtFaktur !Tgl = DtTgl !kdpelanggan = DBCombo1 !kdobat = DBCombo2 !harga = TxtHarga !jumlah = TxtJmlh !total = TxtTotal .Update End With MsgBox "data sudah tersimpan...", "informasi" Bersih End Sub

vbOKOnly

+

vbInformation,

Private Sub DBCombo1_Change() Data1.Recordset.FindFirst "KdPelanggan = '" & DBCombo1 & "'" If Data1.Recordset.NoMatch Then DBCombo1.SetFocus Exit Sub Else TxtPelanggan = Data1.Recordset!NmPelanggan DBCombo2.SetFocus End If End Sub Private Sub DBCombo2_Change() Data2.Recordset.FindFirst "KdObat = '" & DBCombo2 & "'" If Data2.Recordset.NoMatch Then DBCombo2.SetFocus Exit Sub Else TxtObat = Data2.Recordset!NmObat TxtHarga = Data2.Recordset!HrgJual End If TxtJmlh.SetFocus End Sub Private Sub Timer1_Timer() Label15 = Time End Sub


Private Sub TxtBayar_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If Val(TxtBayar) < TxtTotal Then MsgBox "UANG BAYARNYA KURANG TUH!!!", 0, "INFO" TxtBayar = "" TxtBayar.SetFocus Else TxtKembali = Val(TxtBayar) - Val(TxtTotal) End If End If End Sub Private Sub TxtJmlh_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then TxtTotal = Val(TxtHarga) * Val(TxtJmlh) TxtBayar.SetFocus End If End Sub Private Sub cbaru_Click() tabelkosong TxtFaktur = "" TxtFaktur.SetFocus TxtPelanggan = "" End Sub Private Sub Bersih() DBCombo1 = "" DBCombo2 = "" TxtFaktur = "" TxtPelanggan = "" TxtObat = "" TxtHarga = "" TxtJmlh = "" TxtTotal = "" TxtBayar = "" TxtKembali = "" TxtFaktur.SetFocus End Sub Private Sub Form_Activate() TxtFaktur.SetFocus End Sub Private Sub Form_Load() TxtTgl = Date End Sub

Form Pembelian Private Sub CmdBatal_Click() kosong DBCombo1 = "" DBCombo2 = "" TxtFaktur.SetFocus With Data3.Recordset .MoveFirst Do While Not .EOF .Delete


.MoveNext Loop End With End Sub Sub kosong() Dim a As Control For Each a In Me If TypeName(a) = "TextBox" Then a.Text = "" End If Next End Sub Private Sub CmdKeluar_Click() del = MsgBox("yakin akan keluar", vbYesNo + vbCritical, "konfirmasi") If del = vbYes Then Unload Me End If End Sub Private Sub CmdSimpan_Click() With Data3.Recordset.MoveFirst Do While Not Data3.Recordset.EOF Data4.Recordset.AddNew Data4.Recordset!faktur = TxtFaktur Data4.Recordset!tanggal = DtTgl Data4.Recordset!kdsupplier = DataCombo1 Data4.Recordset!kdobat = TxtObat Data3.Recordset!kdobat = TxtObat Data4.Recordset!harga = TxtHarga Data3.Recordset!harga = TxtHarga Data4.Recordset!jmlhbeli = TxtJmlhBeli Data3.Recordset!jmlhbeli = TxtJmlhBeli Data4.Recordset!total = TxtTotal Data3.Recordset!total = TxtTotal Data4.Recordset.Update Data3.Recordset.MoveNext Loop DBCombo1 = "" TxtNmSupplier = "" TxtJmlhByr = "" TxtFaktur = "" DataCombo2 = "" TxtNmObat = "" TxtStok = "" TxtHarga = "" TxtJmlhBeli = "" TxtFaktur.SetFocus With Data3.Recordset .MoveFirst Do While Not .EOF .Delete .MoveNext Loop End With End Sub Private Sub DBCombo1_Change()


Dim sy As String Data1.Recordset.FindFirst "kdSupplier='" & DBCombo1 & "'" If Not Data1.Recordset.EOF Then TxtNmSupplier = Data1.Recordset!nmsupplier DBCombo2.SetFocus End If End Sub Private Sub DBCombo2_Change() Dim sy As String sy = "kdobat = '" & DBCombo2 & "'" Data2.Recordset.FindFirst sy If Not Data2.Recordset.EOF Then TxtNmObat = Data2.Recordset!NmObat TxtStok = Data2.Recordset!Stok TxtHarga = Data2.Recordset!HrgPokok TxtJmlhBeli.SetFocus End If End Sub Private Sub Form_Load() Label3 = Date End Sub Private Sub Timer1_Timer() Label2 = Time End Sub Private Sub TxtJmlhBeli_KeyPress(KeyAscii As Integer) Dim TxtTotal As Double If KeyAscii = 13 Then TxtTotal = Val(TxtJmlhBeli) * Val(TxtHarga) With Data3.Recordset .AddNew !KdObat = DBCombo2 !NmObat = TxtNmObat !JmlhBeli = TxtJmlhBeli !Harga = TxtHarga !Total = TxtTotal .Update End With DBCombo2 = "" TxtNmObat = "" TxtHarga = "" TxtStok = "" TxtJmlhBeli = "" If TxtJmlhByr = "" Then TxtJmlhByr = Data3.Recordset!Total Else TxtJmlhByr = TxtTotal + Val(TxtJmlhByr) End If DBCombo2.SetFocus End If End Sub Private Sub Form_Activate() TxtFaktur.SetFocus End Sub


KEMENTERIAN PENDIDIKAN NASIONAL UNIVERSITAS SUMATERA UTARA FAKULTAS MATEMATIKA DAN ILMU PENGETAHUAN ALAM Jl. Bioteknologi No. 1 Kampus USU Padang Bulan Medan-20155 Telp. (061) 8211050, Fax. (061) 8214290

Medan, 15 Maret 2011 Nomor Lamp Hal

: 1931/H5.2.1.8/SPB/2011 :: Permohonan Pengumpulan Data Riset

Yth : Saudara Bapak Pimpinan Apotik Sekata Sarah Jl. Setia Budi No. 272 C di Medan

Dengan hormat, bersama dengan ini kami memohon kesediaan Saudara Bapak Pimpinan Apotik Sekata Sarah untuk menerima Mahasiswa/i Program Diploma III Teknik Informatika untuk melakukan penelitian atau pengumpulan data di Apotik yang Saudara pimpin. Untuk dipergunakan dalam menyusun Tugas Akhir Mahasiswa/i yang bersangkutan atas nama: NIM 082406199

NAMA Tutur Yeni Oktavia Br Silalahi

PROGRAM STUDI D-III Teknik Informatika

Data yang dimaksud khusus dipergunakan untuk menyusun Tugas Akhir Mahasiswa/i yang berjudul “Sistem Informasi Persediaan Obat Pada Apotik Sekata Sarah Menggunakan Microsoft Visual Basic 6.0” pada program studi Diploma III Teknik Informatika FMIPA-USU. Demikian kami sampaikan, atas kerjasama dan bantuannya diucapkan terima kasih.

an.Dekan Pembantu Dekan I

Dr.Marpongahtun, M.Sc NIP. 196111151988032002

Tembusan : 1. Ketua Program Studi D-III Teknik Informatika


2. Arsip APOTIK SEKATA SARAH Jl. Setia Budi No. 272 C Tanjung Sari Medan Telp. (061) 8222795 Medan, 26 April 2011 Nomor Lampiran Hal

: :: Pemberian izin melaksanakan Pengumpulan Data Riset Di Apotik Sekata Sarah Medan

Kepada Yth : Dekan Fakultas Matematika dan IPA USU Di Medan

1.

Menunjuk Surat Dekan Fakultas Matematika dan IPA Universitas Sumatera Utara No : 1931/H5.2.1.8/SPB/2011 15 Maret 2011 tentang permohonan izin melaksanakan Pengumpulan Data Riset.

2.

Sehubungan dengan hal tersebut diatas, disampaikan kepada Dekan Fakultas Matematika dan IPA Universitas Sumatera Utara, bahwa pada prinsipnya Pimpinan Apotik Sekata Sarah tidak keberatan dan memberikan izin kepada mahasiswa Tutur Yeni Oktavia Br Silalahi untuk melaksanakan pengumpulan data riset di Apotik Sekata Sarah Medan.

3.

Demikian disampaikan untuk diketahui dan atas kerja sama yang baik diucapkan terima kasih.

Pimpinan Apotik Sekata Sarah

Josefyus, SE MBA


SURAT KETERANGAN Hasil Uji Program Tugas Akhir

Yang bertanda tangan di bawah ini, menerangkan bahwa Tugas Akhir Mahasiswa Program D-3 Teknik Informatika:

Nama

: TUTUR YENI OKTAVIA BR SILALAHI

Nomor Induk Mahasiswa

: 082406199

Program Studi

: D-3 TEKNIK INFORMATIKA

Judul Tugas Akhir

:SISTEM

INFORMASI

PERSEDIAAN

OBAT

APOTIK SEKATA SARAH MENGGUNAKAN MICROSOFT VISUAL BASIC 6.0.

Telah melaksanakan test program Tugas Akhir dari mahasiswa tersebut yang dilaksanakan pada tanggal

Mei 2011

Dengan Hasil : Sukses/Gagal

Demikian diterangkan untuk digunakan melengkapi syarat pendaftaran meja hijau Tugas Akhir Mahasiswa yang bersangkutan di Departemen Matematika FMIPA USU Medan.

Medan, Mei 2011 Dosen Pembimbing

Drs. Liling Perangin-angin, M.Si NIP. 19470741 198403 1 001


KEMENTERIAN PENDIDIKAN NASIONAL

UNIVERSITAS SUMATERA UTARA FAKULTAS MATEMATIKA DAN ILMU PENGETAHUAN ALAM (FMIPA) JL. BIOTEKNOLOGI NO. 1 KAMPUS USU Telp. (061) 8214290s

MEDAN – 20155, EMAIL : [email protected]

KARTU BIMBINGAN TUGAS AKHIR MAHASISWA

Nama Mahasiswa Nomor Stambuk Judul Tugas Akhir Dosen Pembimbing 1 Tanggal Mulai Bimbingan Tanggal Selesai Bimbingan

No

TANGGAL ASSISTEN BIMBINGAN

: Tutur Yeni Oktavia Br Silalahi : 082406199 : Sistem Informasi Persediaan Obat Apotik Sekata Sarah Menggunakan Microsoft Visual Basic 6.0 : Drs. Liling Perangin-angin, M.Si : ………………………………… : …………………………………

PEMBAHASAN PADA ASSISTEN MENGENAI PADA BAB

PARAF DOSEN PEMBIMBING

KETERANGAN

1 2 3 4 5 6 7  Kartu ini harap dikembalikan kejurusan Matematika Bila Bimbingan Mahasiswa telah Selesai

Diketahui Ketua Jurusan Matematika

Disetujui Pembimbing Utama/ Penanggung Jawab

Prof.Dr. Tulus, M.Si NIP. 19620901198803100

Drs. Liling Perangin-angin, M.Si NIP. 19470741 198403 1 001


LISTING PROGRAM. Form Utama. Dim Red, Green, Blue As Integer

Recommend Documents