一般看來文字與圖片是毫不相同的，但是它們卻有共同點。圖片是由一個個點組成的，而這些點的顏色值可由數字組成，文字可由ASCII碼錶示，這就使得數字成爲它們之間溝通道橋樑。因此就可以將文本藏入圖片中。
這可以用Visual Basic 6.0實現，首先我們將文字轉化爲數字，再將圖片中的每個點的RGB值取出，將數字每三個分別與Ｒ值，G值，B值相加或相減，接着把RGB值還原爲圖片中的點，至此我們已經將文本藏入圖片。要取出文本怎麼辦呢？我們可以把源圖片與目標圖片進行對比，將到的差值轉化爲文本，就實現了文本的還原。
具體作法：先建立窗體文件frmPictureText.frm和模塊文件modPictureText.bas
模塊文件：
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal _
hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
'用於獲得圖片的象素
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x _
As Long, ByVal y As Long) As Long '用於獲得圖片指定點的RGB值
Public Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Function HexDec(ByVal Number As String) As Integer '將十六進制轉化爲十進制
Dim n As Integer, dec As String, tmp As Integer
For n = 1 To Len(Number)
dec = Mid(Number, n, 1)
If Asc(dec) >= 65 Then
dec = UCase(dec)
dec = Format(Asc(dec) - 55)
End If
tmp = Val(dec) * 16 ^ (Len(Number) - n)
HexDec = HexDec + tmp
Next n
End Function
窗體文件：建立兩個圖片框:picSource用於顯示源圖片，picObject用於顯示目標圖片，
建立兩個文本框：txtSource用於顯示源文本，txtObject用於顯示還原的文本，並設置爲各多行顯示，建立兩個命令按鈕：cmdTextToPicture用於把文本藏入圖片，cmdPictureToText用於還原文本。
Private Sub Form_Load()
picSource.AutoRedraw = True : picObject.AutoRedraw = True
picSource.AutoSize = True : picObject.AutoSize = True
picSource.Picture = LoadPicture("c:/test.bmp")
picObject.Height = picSource.Height '設置目標圖片框的Height和
picObject.Width = picSource.Width 'Width屬性與源圖片相同,保證
'目標圖片的大小和源文件相同
End Sub
Private Sub cmdTextToPicture_Click()
Dim numX As Integer, chrTmp As String, numTmp As Integer, numY As Integer, word As String
Dim souPixel As BITMAP, souTop As Integer, souLeft As Integer
Dim souColor As Long, souGetcolor As String, numN As Integer
Dim tmpWord As String, numDifRed As Integer, numDifGreen As Integer, numDifBlue As Integer
Dim newRed As Integer, newGreen As Integer, newBlue As Integer
On Error Resume Next
Kill("c:/temp1.txt")
Open "c:/temp1.txt" For Append As #1 '將文本轉化爲數字,並存入文件
For numX = 1 To Len(txtSource.Text)
numTmp = Asc(Mid(txtSource.Text, numX, 1))
chrTmp = Format(numTmp)
If numTmp >= 0 Then chrTmp = "+" & chrTmp
For numY = 1 To Len(chrTmp)
word = Format(Asc(Mid(chrTmp, numY, 1)))
Print #1, word;
Next numY
Next numX
Close #1
Open "c:/temp1.txt" For Input As #2
GetObject(picSource.Picture.Handle, Len(souPixel), souPixel)
picObject.Picture = Nothing : picObject.Cls()
For souTop = 0 To souPixel.bmHeight - 1
For souLeft = 0 To souPixel.bmWidth - 1
'取出圖片各點的RGB值
souColor = GetPixel(picSource.hdc, souLeft, souTop)
souGetcolor = Hex(souColor)
numN = 6 - Len(souGetcolor)
souGetcolor = String(numN, "0") & souGetcolor
'取出三個數字
If Not (EOF(2)) Then
tmpWord = Input(3, #2)
numDifRed = Val(Left(tmpWord, 1))
numDifGreen = Val(Mid(tmpWord, 2, 1))
numDifBlue = Val(Right(tmpWord, 1))
End If
'把數字與R值,G值,B值相加或相減
newRed = HexDec(Right(souGetcolor, 2)) - numDifRed
If newRed < 0 Then newRed = HexDec(Right(getcolor, 2)) + numDifRed
newGreen = HexDec(Mid(souGetcolor, 3, 2)) - numDifGreen
If newGreen < 0 Then newGreen = HexDec(Mid(souGetcolor, 3, 2)) + numDifGreen
newBlue = HexDec(Left(souGetcolor, 2)) - numDifBlue
If newBlue < 0 Then newBlue = HexDec(Left(souGetcolor, 2)) + numDifBlue
numDifRed = 0 : numDifGreen = 0 : numDifBlue = 0
DoEvents()
'形成目標圖片
picObject.PSet (souLeft, souTop), RGB(newRed, newGreen, newBlue)
Next souLeft
Next souTop
Close #2
SavePicture(picObject.Image, "c:/object.bmp")
picObject.Picture = LoadPicture("c:/object.bmp")
End Sub
Private Sub cmdPictureToText_Click()
Dim Pixel As BITMAP
Dim souTop As Integer, souLeft As Integer
Dim souColor As Long, objColor As Long, souGetcolor As String, objGetcolor As String
Dim souRed As Integer, souGreen As Integer, souBlue As Integer
Dim objRed As Integer, objGreen As Integer, objBlue As Integer
Dim souN As Integer, objN As Integer
Dim numDifRed As Integer, chrDifRed As String
Dim numDifGreen As Integer, chrDifGreen As String
Dim numDifBlue As Integer, chrDifBlue As String
Dim Difference As String, numTmp As Integer, chrTmp As String, tmpWord As String, word As String
On Error Resume Next
GetObject(picSource.Picture.Handle, Len(Pixel), Pixel) '獲取圖片的象素
Kill("c:/temp2.txt") '如果存在"temp2.txt"文件,則將它清除
Open "c:/temp2.txt" For Append As #3
For souTop = 0 To Pixel.bmHeight - 1
For souLeft = 0 To Pixel.bmWidth - 1
'獲得源圖片各點的RGB值
souColor = GetPixel(picSource.hdc, souLeft, souTop)
souGetcolor = Hex(souColor)
souN = 6 - Len(souGetcolor)
souGetcolor = String(souN, "0") & souGetcolor
souRed = HexDec(Right(souGetcolor, 2)) '轉化爲Red,Green,Blue的值
souGreen = HexDec(Mid(souGetcolor, 3, 2))
souBlue = HexDec(Left(souGetcolor, 2))
'獲得目標圖片各點的RGB值
objColor = GetPixel(picObject.hdc, souLeft, souTop)
objGetcolor = Hex(objColor)
objN = 6 - Len(objGetcolor)
objGetcolor = String(objN, "0") & objGetcolor
objRed = HexDec(Right(objGetcolor, 2))
objGreen = HexDec(Mid(objGetcolor, 3, 2))
objBlue = HexDec(Left(objGetcolor, 2))
numDifRed = souRed - objRed '將差值存入文件
chrDifRed = Format(numDifRed)
If numDifRed < 0 Then chrDifRed = Format(objRed - souRed)
numDifGreen = souGreen - objGreen
chrDifGreen = Format(numDifGreen)
If numDifGreen < 0 Then chrDifGreen = Format(objGreen - souGreen)
numDifBlue = souBlue - objBlue
chrDifBlue = Format(numDifBlue)
If numDifBlue < 0 Then chrDifBlue = Format(objBlue - souBlue)
Difference = chrDifRed & chrDifGreen & chrDifBlue
Print #3, Difference;
Next souLeft
Next souTop
Close #3
Open "c:/temp2.txt" For Input As #4 '從文件還原文字
Do While Not EOF(4)
numTmp = Input(2, #4)
chrTmp = Chr(Val(numTmp))
If (Len(tmpWord) > 1) And (chrTmp = "+" Or chrTmp = "-") Then
word = Chr(Val(tmpWord))
txtobject.Text = txtobject.Text & word
tmpWord = ""
End If
tmpWord = tmpWord & chrTmp
Loop
txtobject.Text = txtobject.Text & Chr(Val(tmpWord))
Close #4
End Sub
以上程序在Windows98系統中VB6.0中調試通過。
綜上所述，此方法對圖片各點的RGB值的修改範圍爲～，很難區別目標圖片與源圖片，因此可以用於文件的加密。