Visual Basic

If Adodc1.Recordset.RecordCount <> 0 Then
    res = MsgBox("Are You Sure You Want To Delete This Record?", vbYesNo, "System Message")
    If res = vbYes Then
        Adodc1.Recordset.Delete
        Adodc1.Recordset.Requery
        Adodc1.Refresh
        MsgBox "Recored has been Deleted"
        lstpromo.RemoveItem lstpromo.ListIndex
    End If
Else
    MsgBox "No Record to delete"
End If

Option Explicit
Private Sub ArrangeControls()
Dim wid As Single

    Width = picImage.Left + picImage.Width + Width - ScaleWidth + 120
    Height = picImage.Top + picImage.Height + Height - ScaleHeight + 120
    wid = ScaleWidth - txtMessage.Left - 120
    If wid < 120 Then wid = 120
    txtMessage.Width = wid
    txtPassword.Width = wid
End Sub

' Encode this byte's data.
Private Sub EncodeByte(ByVal Value As Byte, ByVal used_positions As Collection, ByVal wid As Integer, ByVal hgt As Integer, ByVal show_pixels As Boolean)
Dim i As Integer
Dim byte_mask As Integer
Dim r As Integer
Dim c As Integer
Dim pixel As Integer
Dim clrr As Byte
Dim clrg As Byte
Dim clrb As Byte
Dim color_mask As Integer

    byte_mask = 1
    For i = 1 To 8
        ' Pick a random pixel and RGB component.
        PickPosition used_positions, wid, hgt, r, c, pixel

        ' Get the pixel's color components.
        UnRGB picImage.Point(r, c), clrr, clrg, clrb
        If show_pixels Then
            clrr = 255
            clrg = clrg And &H1
            clrb = clrb And &H1
        End If

        ' Get the value we must store.
        If Value And byte_mask Then
            color_mask = 1
        Else
            color_mask = 0
        End If

        ' Update the color.
        Select Case pixel
            Case 0
                clrr = (clrr And &HFE) Or color_mask
            Case 1
                clrg = (clrg And &HFE) Or color_mask
            Case 2
                clrb = (clrb And &HFE) Or color_mask
        End Select

        ' Set the pixel's color.
        picImage.PSet (r, c), RGB(clrr, clrg, clrb)

        byte_mask = byte_mask * 2
    Next i
End Sub
' Decode this byte's data.
Private Function DecodeByte(ByVal used_positions As Collection, ByVal wid As Integer, ByVal hgt As Integer, ByVal show_pixels As Boolean) As Byte
Dim Value As Integer
Dim i As Integer
Dim byte_mask As Integer
Dim r As Integer
Dim c As Integer
Dim pixel As Integer
Dim clrr As Byte
Dim clrg As Byte
Dim clrb As Byte
Dim color_mask As Integer

    byte_mask = 1
    For i = 1 To 8
        ' Pick a random pixel and RGB component.
        PickPosition used_positions, wid, hgt, r, c, pixel

        ' Get the pixel's color components.
        UnRGB picImage.Point(r, c), clrr, clrg, clrb

        ' Get the stored value.
        Select Case pixel
            Case 0
                color_mask = (clrr And &H1)
            Case 1
                color_mask = (clrg And &H1)
            Case 2
                color_mask = (clrb And &H1)
        End Select

        If color_mask Then
            Value = Value Or byte_mask
        End If

        If show_pixels Then
            picImage.PSet (r, c), RGB( _
                clrr And &H1, _
                clrg And &H1, _
                clrb And &H1)
        End If

        byte_mask = byte_mask * 2
    Next i

    DecodeByte = CByte(Value)
End Function
' Translate a password into an offset value.
Private Function NumericPassword(ByVal password As String) As Long
Dim Value As Long
Dim ch As Long
Dim shift1 As Long
Dim shift2 As Long
Dim i As Integer
Dim str_len As Integer

    ' Initialize the shift values to different
    ' non-zero values.
    shift1 = 3
    shift2 = 17

    ' Process the message.
    str_len = Len(password)
    For i = 1 To str_len
        ' Add the next letter.
        ch = Asc(Mid$(password, i, 1))
        Value = Value Xor (ch * 2 ^ shift1)
        Value = Value Xor (ch * 2 ^ shift2)

        ' Change the shift offsets.
        shift1 = (shift1 + 7) Mod 19
        shift2 = (shift2 + 13) Mod 23
    Next i
    NumericPassword = Value
End Function

' Pick an unused (r, c, pixel) combination.
Private Sub PickPosition(ByVal used_positions As Collection, ByVal wid As Integer, ByVal hgt As Integer, ByRef r As Integer, ByRef c As Integer, ByRef pixel As Integer)
Dim position_code As String

    On Error Resume Next
    Do
        ' Pick a position.
        r = Int(Rnd * wid)
        c = Int(Rnd * hgt)
        pixel = Int(Rnd * 3)

        ' See if the position is unused.
        position_code = "(" & r & "," & c & "," & pixel & ")"
        used_positions.Add position_code, position_code
        If Err.Number = 0 Then Exit Do
        Err.Clear
    Loop
End Sub
' Return the color's components.
Private Sub UnRGB(ByVal color As OLE_COLOR, ByRef r As Byte, ByRef g As Byte, ByRef b As Byte)
    r = color And &HFF&
    g = (color And &HFF00&) \ &H100&
    b = (color And &HFF0000) \ &H10000
End Sub

Private Sub cmdDecode_Click()
Dim msg_length As Byte
Dim msg As String
Dim ch As Byte
Dim i As Integer
Dim used_positions As Collection
Dim wid As Integer
Dim hgt As Integer
Dim show_pixels As Boolean
    If txtPassword.Text = "" Then
        MsgBox ("Please Enter The Password to Continue...")
        Exit Sub
    End If
    Screen.MousePointer = vbHourglass
    DoEvents

    ' Initialize the random number generator.
    Rnd -1
    Randomize NumericPassword(txtPassword.Text)

    wid = picImage.ScaleWidth
    hgt = picImage.ScaleHeight
    show_pixels = chkShowPixels.Value
    Set used_positions = New Collection

    ' Decode the message length.
    msg_length = DecodeByte(used_positions, wid, hgt, show_pixels)

    ' Decode the message.
    For i = 1 To msg_length
        ch = DecodeByte(used_positions, wid, hgt, show_pixels)
        msg = msg & Chr$(ch)
    Next i
    picImage.Picture = picImage.Image

    txtMessage.Text = msg

    Screen.MousePointer = vbDefault
    MsgBox ("Decryption Completed....")
End Sub

Private Sub cmdEncode_Click()
Dim msg As String
Dim i As Integer
Dim used_positions As Collection
Dim wid As Integer
Dim hgt As Integer
Dim show_pixels As Boolean

    If txtMessage.Text = "" Then
        MsgBox ("Please Enter Text to Encrypt...")
        Exit Sub
    ElseIf txtPassword.Text = "" Then
        MsgBox ("Please Enter Password To Protect Data...")
        Exit Sub
    End If
    
    Screen.MousePointer = vbHourglass
    DoEvents

    ' Initialize the random number generator.
    Rnd -1
    Randomize NumericPassword(txtPassword.Text)

    wid = picImage.ScaleWidth
    hgt = picImage.ScaleHeight
    msg = Left$(txtMessage.Text, 255)
    show_pixels = chkShowPixels.Value
    Set used_positions = New Collection

    ' Encode the message length.
    EncodeByte CByte(Len(msg)), _
        used_positions, wid, hgt, show_pixels

    ' Encode the message.
    For i = 1 To Len(msg)
        EncodeByte Asc(Mid$(msg, i, 1)), _
            used_positions, wid, hgt, show_pixels
    Next i
    picImage.Picture = picImage.Image

    Screen.MousePointer = vbDefault
    MsgBox ("Encryption Complete..." & vbNewLine & vbNewLine & "You Can Save Picture Using Menu...")
End Sub
Private Sub Form_Load()
    picImage.ScaleMode = vbPixels
    picImage.AutoRedraw = True
    dlgImage.InitDir = App.Path
    ArrangeControls
End Sub