VB 6.0, Implementasi Algoritma Buble Sort

Berikut adalah implementasi Algoritma Buble Sort menggunakan VB 6.0

Dim arrAngka() As Integer

Dim bolAdaPerubahan As Boolean

Dim strTmp As String

Dim i, j As Integer



Private Sub cmdOK_Click()

    ReDim Preserve arrAngka(Len(Trim(txt1.Text)) - 1)

    

    'Masukan data ke array

    For i = 0 To Len(Trim(txt1.Text)) - 1

        arrAngka(i) = Mid(txt1.Text, i + 1, 1)

    Next i

    

    bolAdaPerubahan = True

    

    'Lakukan pembandingan selama masih ada perubahan

    Do While bolAdaPerubahan = True



x:

    i = 0

    bolAdaPerubahan = False

        

        'Bandingan data dengan data di sebelahnya

        For i = 0 To UBound(arrAngka())

            'Jika masih ada perubahan dan pembandingan sudah dilakukan sampai ke data terakhir

            'Maka ulangi pembandingan dari data pada deretan paling awal

            If bolAdaPerubahan = True And i = UBound(arrAngka()) Then GoTo x:

            

            'Jika sudah tidak ada perubahan dan pembandingan sudah dilakukan sampai ke data terakhir

            'Maka hentikan pembandingan, artinya data sudah terurut dari kecil ke besar

            If bolAdaPerubahan = False And i = UBound(arrAngka()) Then Exit For:

                                                    

            'Apakah angka di sebelahnya lebih kecil?

            If arrAngka(i + 1) < arrAngka(i) Then

                'Jika ya

                

                bolAdaPerubahan = False

                

                'Tukar posisi

                strTmp = arrAngka(i)

                arrAngka(i) = arrAngka(i + 1)

                arrAngka(i + 1) = strTmp

                

                bolAdaPerubahan = True

            End If

            

        Next i

        

    Loop

    

    txt2.Text = ""

    

    'Masukan ke teks hasil

    For i = 0 To UBound(arrAngka)

        txt2.Text = txt2.Text + CStr(arrAngka(i))

    Next i

    

End Sub

SQL Server 2008, Nested Case

Berikut contoh penggunan Case di dalam Case atau Nested Case di Sql Server 2008

SELECT
    col1,
    col2,
    col3,
    CASE WHEN condition THEN
      CASE WHEN condition1 THEN
        CASE WHEN condition2 THEN calculation1
        ELSE calculation2 END
      ELSE
        CASE WHEN condition2 THEN calculation3
        ELSE calculation4 END
      END
    ELSE CASE WHEN condition1 THEN 
      CASE WHEN condition2 THEN calculation5
      ELSE calculation6 END
    ELSE CASE WHEN condition2 THEN calculation7
         ELSE calculation8 END
    END AS 'calculatedcol1',
    col4,
    col5 -- etc
FROM table

SQL Server 2008, ROW_NUMBER()

ROW_NUMBER() digunakan untuk membuat nomor yang berurutan pada suatu result set, berikut contoh penggunaan ROW_NUMBER()

select top 10 ROW_NUMBER() over(order by NoPendaftaran) as No, NoPendaftaran from detailBiayaPelayanan

--Menggunakan partition, agar nomornya direset ke 1 ketika beda NoPendaftaran
select top 10 ROW_NUMBER() over(partition by nopendaftaran order by NoPendaftaran) as No,NoPendaftaran from detailBiayaPelayanan

SQL Server 2008, Convert

Fungsi convert mirip dengan fungsi cast, yaitu untuk merubah tipe data dari suatu data atau variabel, tetapi fungsi convert mempunya tambahan parameter style untuk merubah format data, misalkan untuk merubah format tanggal, berikut contoh penggunaan convert.

declare @a float
declare @b varchar(20)
declare @c varchar(20)

set @a=1.5
set @b=1
set @c=2

select CONVERT(Int,@a) --Konversi dari float ke int akan ditruncate
select @b+@c --Menghasilkan 12
select CONVERT(int,@b)+CONVERT(int,@c) --Menghasilkan 3
select CONVERT(datetime,'2016-02-19',101) --Menghasilkan 2016-02-19 00:00:00.000

SQL Server 2008, Cast

Cast digunakan untuk merubah tipe data suatu data atau variabel, contoh penggunaanya adalah sebagai berikut.

declare @a varchar(10)
declare @b varchar(10)
declare @c varchar(10)

set @a=1
set @b=2

set @c =@a+@b
print @c --Hasilnya 12

set @c=CAST(@a as int)+CAST(@b as int)
print @c --Hasilnya 3

SQL Server 2008, Isnull dan Coalesce

declare @a varchar(25)
declare @b varchar(25)
declare @c varchar(25)
declare @d varchar(4)

set @a=Null
set @b =Null
set @c='Variabel @c ada isinya'
set @d=null

--Isnull
--Mereplace nilai yang Null menggunakan nilai yang dispesifikasikan
--Tipe data dari ekspresi ditentukan oleh tipe data input pertama
select ISNULL(@a,'Variabel @a Kosong') as [Tes Isnull]

--Jika inputan yang pertama adalah literal null tak bertipe, maka tipe data ekspresi ditentukan oleh input yang kedua
select ISNULL(Null,'Variabel @a Kosong') as [Tes Isnull]

--Jika kedua inputan adalah literal tak bertipe maka tipe data ekspresinya adalah Int
select ISNULL(null,null)

--Akan menampilkan kata 'Saya', karena kepotong, ngikutnya ke tipe dan panjang data input pertama
select ISNULL(@d,'Saya ganteng')

--Coalse
--Mirip dengan Isnull, tapi bisa banyak input
--Tipe data hasil ekspresi ditentukan oleh tipe data input argumen dengan precedence paling tinggi
select coalesce(@a,'Variabel @a Kosong')
select coalesce(@a,@b,'Variabel @a kosong')
select coalesce(@a,@b,@c)

--Error, ini terjadi karena semua inputnya adalah literal null tak bertipe
select coalesce(null,null)
--Tidak akan error karena literal nullnya dicast dulu ke int
select coalesce(cast(null as int),null)

--Akan error, karena tipe data ekspresi ditentukan oleh tipe data yang kedua yg merupakan tipe data int
--Sql mencoba mngkonversi 'abc' ke int
select coalesce('abc',1)

SQL Server 2008, Union dan Union All

Contoh penggunaan Union dan Union All

select nocm,namalengkap,namapanggilan from Pasien where NoCM ='11500418'

select NoCM,NamaLengkap from Pasien where NoCM='11500418'
union all
select NoCM,NamaPanggilan from Pasien where NoCM='11500418'

select NoCM,NamaLengkap from Pasien where NoCM='11500418'
union
select NoCM,NamaPanggilan from Pasien where NoCM='11500418'

VB 6, Pengurutan Angka

Dim arrAngka() As Integer
Dim intAngkaTerkecil As Integer
Dim tmpAngka As Integer
Dim i, j As Integer 'Untuk counting

Private Sub cmdUrut_Click()
    ReDim Preserve arrAngka(Len(Trim(txtUrut.Text)))
   
     'Masukan seluruh angka ke array
     For i = 0 To Len(Trim(txtUrut.Text)) - 1
        arrAngka(i) = Mid(Trim(txtUrut.Text), i + 1, 1)
     Next i
    
     For i = 0 To UBound(arrAngka) - 1
        'Ambil angka satu2, masukan ke variabel sebagai kandidat angka terkecil
        intAngkaTerkecil = arrAngka(i)
       
        'Angka yang dijadikan kandidat terkecil dibandingkan dengan deretan angka2 berikutnya
        For j = i + 1 To UBound(arrAngka) - 1
            'Apakah angka di array lebih kecil dari kandidat angka terkecil?
            If arrAngka(j) < intAngkaTerkecil Then
                'Ubah kandidat angka terkecil dengan angka di array
                intAngkaTerkecil = arrAngka(j)
               
                'Tukarkan posisinya
                tmpAngka = arrAngka(i)
                arrAngka(i) = intAngkaTerkecil
                arrAngka(j) = tmpAngka
            End If
        Next j
    
     Next i
    
     txtUrut.Text = ""
     'Ubah text box dengan deretan angka yang sudah di urut
     For i = 0 To UBound(arrAngka) - 1
        txtUrut.Text = txtUrut.Text + CStr(arrAngka(i))
     Next i
End Sub

Tabel Variabel Di Sql Server 2008

declare @tbTes table(
    id int,
    nama varchar(50)
)

insert into @tbTes values(1,'Mamang')
select * from @tbTes

Tabel Temporari di Sql Server 2008

Gunakan # untuk membuat tabel temporari lokal, tabel temporari lokal hanya bisa diakses pada satu session Gunakan ## untuk membuat tabel temporari global, tabel temporari global bisa diakses pada semua session yang aktif

create table #TmpTes
(
    id int,
    nama varchar(50)
)
insert into #TmpTes values(1,'Udin')
select * from #TmpTes

Derived Table di Sql Server 2008

select jmlKarakter from

(

    select len(namalengkap) jmlKarakter from Pasien 

)tbPasien

Contoh Penggunaan Where, Group By dan Having Secara Bersamaan

Select field,COUNT(field) from table
where field=''
group by field
having count(field)>1

Contoh Penggunaan Perintah Having di Sql Server 2008

Having digunakan untuk memfilter data yang kolomnya berasal dari hasil fungsi agregat

Select Top 10 field,COUNT(field) From table
Group By field
Having Count(field)>1 and field=[filter]

Contoh Subquery di Sql Server 2008

--Subquery

select top 10 field1,field2
(Select field from table2
where field=table1.field
) alias
from table1

SQL Server 2008, Cursor

Contoh penggunaan cursor di Sql Server 2008

--Deklarasi variabel

declare @nama as varchar(50) 

declare @alamat as varchar(50)



--Deklarasi cursor

declare myCursor cursor for

--Isi cursor dengan value dari queri berikut

select top 10 namalengkap, alamat from pasien where alamat is not null and alamat<>'' 

-------------------------------------------------------------------------------------

open myCursor --Buka cursor

fetch next from myCursor into @nama,@alamat --Masukan value dari baris pertama ke variabel



--Selama @@FETCH_STATUS bernilai 0 lakukan looping

--@@FETCH_STATUS akan bernilai 1 jika data yang ada di cursor sudah habis

while @@FETCH_STATUS=0

begin

    print @nama + ' ' +@alamat --Cetak variabel

fetch next from myCursor into @nama,@alamat --Masukan data berikutya ke variabel

end

Tips Mendapatkan Wanita Impian Kita

Berdasarkan fakta-fakta yang saya lihat di kehidupan jaman sekarang, saya punya 2 tips untuk mendapatkan wanita impian kita, yaitu :
Tingkat kemudahan untuk mendapatkan wanita impian kita, tergantung dari
1. Seberapa banyak harta yang kita miliki
2. Seberapa tidak baiknya diri kita

Secara hati, saya pribadi tidak percaya teori tersebut, tetapi secara fakta sehari-hari hal itu justru sering terjadi. Saya sering melihat wanita yang menurut saya wanita tersebut adalah wanita yang termasuk kriteria wanita impian saya, pacarnya selalu :
1. Pria kaya raya
2. Pria yang menurut saya bukan pria baik-baik(Anggota geng, pake tato, suka minum miras, pake anting dll)

Untuk alasan no. 1 masih bisa saya mengerti, tapi untuk yang no. 2 saya jujur masih tidak mengerti kenapa pria seperti itu bisa jadi pilihan. Terkadang saya sering punya niat untuk menjadi seseorang yang tidak baik untuk mencoba teori saya, tapi rasanya tidak mungkin untuk dilakukan saat ini :)

VB 6, Mengubah Posisi Objek Sesuai Koordinat Klik Mouse

Objek textbox akan berubah posisinya sesuai koordinat klik mouse pada form

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Text1.Top = Y
    Text1.Left = X
End Sub

VB 6, Notifikasi Menggunakan Winsock

Alur : ketika user dari ruangan IGD melakukan klik simpan setelah mengisi data reservasi, notifikasi reservasi di loket pendaftaran akan muncul. Kodingan di modul pendaftaran

'Cari setingan port dari seting global
'Potongan kode di event Form Load
'----------------------------------------------------------------------------------------------
    strSQL5 = "Select Value From SettingGlobal Where prefix='PortNotifikasiReservasi'"
    Call msubRecFO(rsE, strSQL5)
   
    'Buka port
    With Winsock1
        .Close
        .LocalPort = Trim(rsE(0))
        .Listen
    End With
'----------------------------------------------------------------------------------------------

Private Sub Winsock1_Close()
    Winsock1.Close
    Winsock1.Listen
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
   
    On Error GoTo duaTambahDuaSamaDenganLima

    Winsock1.Close
    Winsock1.Accept requestID

    Exit Sub

duaTambahDuaSamaDenganLima:
    Call Winsock1.Close
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    On Error GoTo duaTambahDuaSamaDenganLima

    Dim data$
   
    Winsock1.getData data$
    Call PlaySound
   
    If Left(data$, 3) = mstrKdRuanganLogin Then 'Hanya akan tampil di ruangan yang seharusnya menerima notifikasi
        If MsgBox("Reservasi pasien " & data$ & ", Klik Yes untuk membuka Form Daftar Reservasi", vbYesNo + vbInformation) = vbYes Then
            frmDaftarReservasiPasien.Show
        End If
    End If

duaTambahDuaSamaDenganLima:
End Sub

Kodingan di Modul Gawat Darurat Fungsi yang ditempatkan di event Form Load

Private Function koneksiNotifikasi()
   
    On Error GoTo duaTambahDuaSamaDenganLima
   
    'Ambil setingan IP
    strSQL6 = "Select Value From SettingGlobal Where prefix='IPUntukNotifikasi'"
    Call msubRecFO(rsF, strSQL6)
   
    'Ambil setingan port
    strSQL7 = "Select Value From SettingGlobal Where Prefix='PortNotifikasiReservasi'"
    Call msubRecFO(rsG, strSQL7)
   
    jumlahTitikKoma = 0
    ReDim tmpIP(0)
   
   
    'Ekstrak IP
    For X = 1 To Len(rsF(0))
        If Mid(rsF(0), X, 1) = ";" Then
            jumlahTitikKoma = jumlahTitikKoma + 1
           
            If jumlahTitikKoma = 1 Then
                tmpIP(0) = Left(rsF(0), X - 1)
            Else
                ReDim Preserve tmpIP(UBound(tmpIP) + 1)
                tmpIP(UBound(tmpIP)) = Mid(rsF(0), posisiTitikKomaSebelumnya + 1, (X - 1) - posisiTitikKomaSebelumnya)
            End If
           
            posisiTitikKomaSebelumnya = X
        End If
    Next X
   
    'Konekkan ke IP
    For i = 0 To UBound(tmpIP)
        If i <> 0 Then 'Index 0 jangan diload lagi, kan sudah ada
            Load Winsock1(i)
        End If
       
        Winsock1(i).Close
        Winsock1(i).Connect tmpIP(i), CInt(rsG(0))
       
    Next i
   
 
Exit Function

duaTambahDuaSamaDenganLima:
End Function

'Potongan kode di tombol simpan, di form input data reservasi
'Tampilkan notifikasi di loket yang seharusnya
    strSQL5 = "Select KdInstalasi From Ruangan Where KdRuangan='" & dcRuangan.BoundText & "'"
    Call msubRecFO(rsE, strSQL5)
   
    'Kirim pesan ke semua ip yang ada di setingan
    For i = 0 To UBound(tmpIP)
        If Winsock1(i).State = 7 Then
            If rsE(0) = "03" Then 'Tampilkan notifikasi di loket yang seharusnya
                Winsock1(i).SendData "193" & txtNamaPasien.Text
            Else
                Winsock1(i).SendData "195" & txtNamaPasien.Text
            End If
        End If
    Next i

Kodingan di Event Form Unload
'Putuskan koneksi winsock
    For i = 0 To UBound(tmpIP)
        Winsock1(i).Close
    Next i

VB 6 Array, Redim dan Redim Preserve

Kodingan dasar array Deklarasi array :

Dim mahasiswa() as String

Mengetahui jumlah elemen array :

Ubound(mahasiswa)

Mendefinisikan ulang jumlah elemen array sekaligus mengosongkan isi array :

Redim mahasiswa(8)

Mendefinisikan ulang jumlah elemen array tanpa mengosongkan isi array jika array tersebut sudah ada isinya :

Redim preserve mahasiswa(8)

VB 6 Cek Null Value Datagrid

Kode sederhana tapi sering terlupakan :), kodingan untuk mengecek apakah nilai dari cell grid yang kita pilih bernilai Null atau tidak :)

IsNull(DataGrid1.Columns(6).CellValue(DataGrid1.Bookmark))

VB 6.0 Select baris datagrid lebih dari satu

Misalkan nama datagridnya dgDaftarPasienLab Untuk melakukan select lebih dari 1 gunakan tombol Ctrl

Dim i As Integer
Dim intCount As Integer
   
intCount = dgDaftarPasienLab.SelBookmarks.Count - 1
ReDim ArrSelBK(intCount)
   
For i = 0 To intCount
           ArrSelBK(i) = dgDaftarPasienLab.SelBookmarks(i)
           dgDaftarPasienLab.Row = ArrSelBK(i) - 1
     
           'Perintah'

Next i