Membuat gambar Mosaik menggunakan VB6

Gambar mosaik merupakan gambar seni yang seolah-oleh terlihat seperti kaca, dalam postingan kali ini saya akan sedikit membahas mengenai cara membuatnya menggunakan VB6. Tanpa basa-basi langsung saja ke langkah-langkahnya sebagai berikut:

- Buka VB6 nya kemudian pilih standard exe.

- Masukan 2 buah picturebox dan 1 command button. dan atur properties 2 picturebox sebagai berikut:

	Picture1	Picture2
Autosize	False	True
Border Style	1 – Fixed Single	0 – None
name	NewPic	ThePic
Picture	(none)	(icon)

untuk picture2 masukan sebuah gambar dengan ukuran 16x16 dan buat desain formnya seperti gambar dibawah ini:

- Setelah desainnya selesai, masukan sintak berikut di general deklarasi:

Option Explicit

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long

- Kemudian buat sebuah procedure function dengan sintak sebagai berikut:

Public Function GetFadedColor(c1 As Long, c2 As Long, FN As Integer, FS As Integer) As Long
    Dim i%, red1%, green1%, blue1%, red2%, green2%, blue2%, pat1!, pat2!, pat3!, cx1!, cx2!, cx3!
    

    red1% = (c1 And 255)
    green1% = (c1 \ 256 And 255)
    blue1% = (c1 \ 65536 And 255)
    red2% = (c2 And 255)
    green2% = (c2 \ 256 And 255)
    blue2% = (c2 \ 65536 And 255)
    

    pat1 = (red2% - red1%) / FS
    pat2 = (green2% - green1%) / FS
    pat3 = (blue2% - blue1%) / FS

    cx1 = red1%
    cx2 = green1%
    cx3 = blue1%

    For i% = 1 To FN
        cx1 = cx1 + pat1
        cx2 = cx2 + pat2
        cx3 = cx3 + pat3
    Next
    GetFadedColor = RGB(cx1, cx2, cx3)
End Function

- Masukan sintak berikut di Form untuk event load:

Private Sub Form_Load()
    NewPic.ScaleMode = 3
    ThePic.ScaleMode = 3
    HoldFadedPic.ScaleMode = 3
End Sub

- dan sintak terakhir untuk command1:

Private Sub Command1_Click()
    Dim rows As Integer, cols As Integer
    Dim Color1 As Long, Color2 As Long
    Dim TheColor As Long, i As Integer, i2 As Integer
    On Error Resume Next

    HoldFadedPic.Width = ThePic.Width
    HoldFadedPic.Height = ThePic.Height
    For i = 0 To (ThePic.ScaleWidth - 1) * 16 Step 16
        For i2 = 0 To (ThePic.ScaleHeight - 1) * 16 Step 16
            For cols = 0 To ThePic.ScaleWidth - 1
                For rows = 0 To ThePic.ScaleHeight - 1
                    Color1 = GetPixel(ThePic.hdc, rows, cols)
                    Color2 = GetPixel(ThePic.hdc, i / 16, i2 / 16)
                    If Color1 <> Color2 Then
                        TheColor = GetFadedColor(Color1, Color2, 3, 4)
                    Else
                        TheColor = Color1
                    End If
                    Call SetPixel(HoldFadedPic.hdc, rows, cols, TheColor)
                Next
            Next
        Set HoldFadedPic.Picture = HoldFadedPic.Image
        NewPic.PaintPicture HoldFadedPic.Picture, i, i2, 16, 16
        DoEvents
        Next
    Next
    MsgBox "done"
End Sub

- Setelah itu jalankan programnya, maka akan kita lihat gambar akan berubah menjadi gambar mosaik.

Sekian dulu tutorialnya, lain kali insya Allah akan saya bahas mengenai trik-trik lain tentang picture box. Selamat mencoba & Semoga bermanfaat.