--laser--
asked on
||||||||URGENT|||||||| progress bar help
i have got some code about steganography that i want to put a progress bar into, i just cant work out how, this is probably a stupid question but oh well.
code for the form is:
Option Explicit
Private Sub start()
Picture1.Move 0, 0
Picture2.Move 0, 0
If Picture2.Height < Picture1.Height Then Picture2.Top = (Picture1.Height - Picture2.Height) / 2
If Picture2.Width < Picture1.Width Then Picture2.Left = (Picture1.Width - Picture2.Width) / 2
HScroll1.Top = Picture1.Height
HScroll1.Left = 0
HScroll1.Width = Picture1.Width
VScroll1.Top = 0
VScroll1.Left = Picture1.Width
VScroll1.Height = Picture1.Height
HScroll1.Max = Picture2.Width - Picture1.Width
VScroll1.Max = Picture2.Height - Picture1.Height
VScroll1.Visible = (Picture1.Height < Picture2.Height)
HScroll1.Visible = (Picture1.Width < Picture2.Width)
HScroll1.Value = 0
VScroll1.Value = 0
End Sub
Private Sub Command1_Click()
PutMessage
End Sub
Private Sub Command2_Click()
Dim d As String
GetMessage
d = " "
End Sub
Private Sub Command3_Click()
Text1.Text = ""
End Sub
Private Sub Command4_Click()
Dialog1.ShowOpen
If Dialog1.FileName <> "" Then
Picture2.Picture = LoadPicture(Dialog1.FileNa me)
Text1.Text = ""
start
End If
End Sub
Private Sub Command5_Click()
Dialog2.ShowSave
If Dialog2.FileName <> "" Then SavePicture Picture2.Image, Dialog2.FileName
End Sub
Private Sub Form_Load()
Picture2.Picture = LoadPicture(App.Path & "/USflag.bmp")
start
End Sub
Private Sub VScroll1_Change()
Picture2.Top = -VScroll1.Value
End Sub
Private Sub HScroll1_Change()
Picture2.Left = -HScroll1.Value
End Sub
Private Sub GetMessage()
Dim i As Long, j As Long, k As Long, n As Long, pix(0 To 2) As Long
Dim tx As String, nmd As Long, start As Integer
Dim endmess As String, comp(1 To 8) As Long, ch As Long
work 1
pass.Text = Trim(pass.Text)
Shuffle (pass.Text)
For i = 0 To Picture2.ScaleWidth - 1
For j = 0 To Picture2.ScaleHeight - 1
nmd = n Mod 3
If nmd = 0 Then
If start < 14 Then
start = start + 1
If start = 14 And tx <> "start message" Then
Text1.Text = "THIS PICTURE HAS NO SECRET MESSAGE"
work 0
Exit Sub
ElseIf start = 14 Then
tx = ""
End If
End If
ch = 0
pix(nmd) = Picture2.Point(i, j)
comp(8) = ((pix(nmd) And RGB(255, 0, 0)) Mod 2)
comp(7) = (((pix(nmd) And RGB(0, 255, 0)) \ 256) Mod 2)
comp(6) = (((pix(nmd) And RGB(0, 0, 255)) \ 65536) Mod 2)
For k = 8 To 6 Step -1
ch = ch + (2 ^ (k - 1)) * comp(k)
Next k
End If
If nmd = 1 Then
pix(nmd) = Picture2.Point(i, j)
comp(5) = ((pix(nmd) And RGB(255, 0, 0)) Mod 2)
comp(4) = (((pix(nmd) And RGB(0, 255, 0)) \ 256) Mod 2)
comp(3) = (((pix(nmd) And RGB(0, 0, 255)) \ 65536) Mod 2)
For k = 5 To 3 Step -1
ch = ch + (2 ^ (k - 1)) * comp(k)
Next k
End If
If nmd = 2 Then
pix(nmd) = Picture2.Point(i, j)
comp(2) = ((pix(nmd) And RGB(255, 0, 0)) Mod 2)
comp(1) = (((pix(nmd) And RGB(0, 255, 0)) \ 256) Mod 2)
For k = 2 To 1 Step -1
ch = ch + (2 ^ (k - 1)) * comp(k)
Next k
End If
n = n + 1
If n = 3 Then
n = 0
tx = tx & getc(Chr(ch))
End If
endmess = Right(tx, 11)
If endmess = "end message" Then
Text1.Text = Left(tx, Len(tx) - 11)
work 0
Exit Sub
End If
Next j
Next i
End Sub
Private Sub PutMessage()
Dim i As Long, j As Long, tx As String, ch As String, NrPix As Long
Dim pix(0 To 2) As Long, wid As Long, hig As Long
Dim r As Long, g As Long, b As Long, comp(1 To 8) As Long
Dim aa(0 To 2) As Long, bb(0 To 2) As Long
work 1
tx = "start message" & Text1.Text & "end message"
wid = Picture2.ScaleWidth
hig = Picture2.ScaleHeight
If Len(tx) * 3 > hig * wid Then
tx = MsgBox("Text is " & Len(tx) * 3 - wid * hig & " characters longer than this picture can store", vbCritical)
work 0
Exit Sub
End If
pass.Text = Trim(pass.Text)
Shuffle (pass.Text)
For i = 1 To Len(tx)
ch = ByteToBin(Asc(putc(Mid(tx, i, 1))))
NrPix = (CLng(i) - 1) * 3
aa(0) = (NrPix Mod hig)
bb(0) = (NrPix \ hig)
pix(0) = Picture2.Point(bb(0), aa(0)) 'the first pixel in the group of three.
r = (pix(0) And RGB(255, 0, 0)) - (pix(0) And RGB(255, 0, 0)) Mod 2: comp(1) = r
g = ((pix(0) And RGB(0, 255, 0)) \ 256) - ((pix(0) And RGB(0, 255, 0)) \ 256) Mod 2: comp(2) = g
b = ((pix(0) And RGB(0, 0, 255)) \ 65536) - ((pix(0) And RGB(0, 0, 255)) \ 65536) Mod 2: comp(3) = b
NrPix = NrPix + 1
aa(1) = (NrPix Mod hig)
bb(1) = (NrPix \ hig)
pix(1) = Picture2.Point(bb(1), aa(1)) 'the second pixel in the group of three.
r = (pix(1) And RGB(255, 0, 0)) - (pix(1) And RGB(255, 0, 0)) Mod 2: comp(4) = r
g = ((pix(1) And RGB(0, 255, 0)) \ 256) - ((pix(1) And RGB(0, 255, 0)) \ 256) Mod 2: comp(5) = g
b = ((pix(1) And RGB(0, 0, 255)) \ 65536) - ((pix(1) And RGB(0, 0, 255)) \ 65536) Mod 2: comp(6) = b
NrPix = NrPix + 1
aa(2) = (NrPix Mod hig)
bb(2) = (NrPix \ hig)
pix(2) = Picture2.Point(bb(2), aa(2)) 'the third pixel in the group of three.
r = (pix(2) And RGB(255, 0, 0)) - (pix(2) And RGB(255, 0, 0)) Mod 2: comp(7) = r
g = ((pix(2) And RGB(0, 255, 0)) \ 256) - ((pix(2) And RGB(0, 255, 0)) \ 256) Mod 2: comp(8) = g
b = ((pix(2) And RGB(0, 0, 255)) \ 65536) 'last component remains unchanged
For j = 1 To 8
comp(j) = comp(j) + CInt(Mid(ch, j, 1)) * 1
Next j
Picture2.PSet (bb(0), aa(0)), RGB(comp(1), comp(2), comp(3))
Picture2.PSet (bb(1), aa(1)), RGB(comp(4), comp(5), comp(6))
Picture2.PSet (bb(2), aa(2)), RGB(comp(7), comp(8), b)
Next i
work 0
End Sub
Private Sub work(i As Integer)
If i = 1 Then Form1.Caption = "Secret Messenger (Working...)"
If i = 0 Then Form1.Caption = "Secret Messenger"
End Sub
the code for the module is
Dim arrayA() As Integer, arrayB() As Integer, ln As Integer
Public Function ByteToBin(n As Integer) As String 'This function transforms an integer (which is the
Dim j As String 'the ascii code of a character) into a string (which
Do While n >= 1 'is the binary representation of the ascii code)
j = n Mod 2 & j
n = n \ 2
Loop
If Len(j) < 8 Then j = String(8 - Len(j), "0") & j
ByteToBin = j
End Function
Public Function putc(c As String) As String 'For each character in the message the program picks randomly
Dim ps As String 'a "deck" of characters, depending on the character itself and
ps = Form1.pass.Text 'and on the length of the password.
If ps <> "" Then
Randomize Asc(Mid(ps, 1 + Int(Len(ps) * Rnd), 1)) * (1 + Int(Len(ps) * Rnd)) * 13
putc = Chr(arrayA(Asc(c), 1 + Int(Len(ps) * Rnd)))
Else
putc = c
End If
End Function
Public Function getc(c As String) As String
Dim ps As String
ps = Form1.pass.Text
If ps <> "" Then
Randomize Asc(Mid(ps, 1 + Int(Len(ps) * Rnd), 1)) * (1 + Int(Len(ps) * Rnd)) * 13
getc = Chr(arrayB(Asc(c), 1 + Int(Len(ps) * Rnd)))
Else
getc = c
End If
End Function
Public Sub Shuffle(pas As String)
Dim i As Integer, j As Integer, k As Double, x As Integer, y As Integer, t As Integer
ln = Len(pas)
If ln > 0 Then
k = 1
For j = 1 To ln
k = k + Asc(Mid(pas, j, 1)) * j
Next j
k = Sqr(k)
ReDim arrayA(0 To 255, 1 To ln) As Integer
ReDim arrayB(0 To 255, 1 To ln) As Integer
For i = 1 To Len(pas)
For j = 0 To 255
arrayA(j, i) = j
Next j
Next i
For j = 1 To ln
f = Rnd(-1)
Randomize Asc(Mid(pas, j, 1)) * CDbl(j) * k
For i = 1 To 10000
y = Int(255 * Rnd)
t = 255 - Int(255 * Rnd)
x = arrayA(y, j)
arrayA(y, j) = arrayA(t, j)
arrayA(t, j) = x
Next i
Next j
For i = 1 To ln
For j = 0 To 255
arrayB(arrayA(j, i), i) = j
Next j
Next i
End If
End Sub
progress bar is called pb1
code for the form is:
Option Explicit
Private Sub start()
Picture1.Move 0, 0
Picture2.Move 0, 0
If Picture2.Height < Picture1.Height Then Picture2.Top = (Picture1.Height - Picture2.Height) / 2
If Picture2.Width < Picture1.Width Then Picture2.Left = (Picture1.Width - Picture2.Width) / 2
HScroll1.Top = Picture1.Height
HScroll1.Left = 0
HScroll1.Width = Picture1.Width
VScroll1.Top = 0
VScroll1.Left = Picture1.Width
VScroll1.Height = Picture1.Height
HScroll1.Max = Picture2.Width - Picture1.Width
VScroll1.Max = Picture2.Height - Picture1.Height
VScroll1.Visible = (Picture1.Height < Picture2.Height)
HScroll1.Visible = (Picture1.Width < Picture2.Width)
HScroll1.Value = 0
VScroll1.Value = 0
End Sub
Private Sub Command1_Click()
PutMessage
End Sub
Private Sub Command2_Click()
Dim d As String
GetMessage
d = " "
End Sub
Private Sub Command3_Click()
Text1.Text = ""
End Sub
Private Sub Command4_Click()
Dialog1.ShowOpen
If Dialog1.FileName <> "" Then
Picture2.Picture = LoadPicture(Dialog1.FileNa
Text1.Text = ""
start
End If
End Sub
Private Sub Command5_Click()
Dialog2.ShowSave
If Dialog2.FileName <> "" Then SavePicture Picture2.Image, Dialog2.FileName
End Sub
Private Sub Form_Load()
Picture2.Picture = LoadPicture(App.Path & "/USflag.bmp")
start
End Sub
Private Sub VScroll1_Change()
Picture2.Top = -VScroll1.Value
End Sub
Private Sub HScroll1_Change()
Picture2.Left = -HScroll1.Value
End Sub
Private Sub GetMessage()
Dim i As Long, j As Long, k As Long, n As Long, pix(0 To 2) As Long
Dim tx As String, nmd As Long, start As Integer
Dim endmess As String, comp(1 To 8) As Long, ch As Long
work 1
pass.Text = Trim(pass.Text)
Shuffle (pass.Text)
For i = 0 To Picture2.ScaleWidth - 1
For j = 0 To Picture2.ScaleHeight - 1
nmd = n Mod 3
If nmd = 0 Then
If start < 14 Then
start = start + 1
If start = 14 And tx <> "start message" Then
Text1.Text = "THIS PICTURE HAS NO SECRET MESSAGE"
work 0
Exit Sub
ElseIf start = 14 Then
tx = ""
End If
End If
ch = 0
pix(nmd) = Picture2.Point(i, j)
comp(8) = ((pix(nmd) And RGB(255, 0, 0)) Mod 2)
comp(7) = (((pix(nmd) And RGB(0, 255, 0)) \ 256) Mod 2)
comp(6) = (((pix(nmd) And RGB(0, 0, 255)) \ 65536) Mod 2)
For k = 8 To 6 Step -1
ch = ch + (2 ^ (k - 1)) * comp(k)
Next k
End If
If nmd = 1 Then
pix(nmd) = Picture2.Point(i, j)
comp(5) = ((pix(nmd) And RGB(255, 0, 0)) Mod 2)
comp(4) = (((pix(nmd) And RGB(0, 255, 0)) \ 256) Mod 2)
comp(3) = (((pix(nmd) And RGB(0, 0, 255)) \ 65536) Mod 2)
For k = 5 To 3 Step -1
ch = ch + (2 ^ (k - 1)) * comp(k)
Next k
End If
If nmd = 2 Then
pix(nmd) = Picture2.Point(i, j)
comp(2) = ((pix(nmd) And RGB(255, 0, 0)) Mod 2)
comp(1) = (((pix(nmd) And RGB(0, 255, 0)) \ 256) Mod 2)
For k = 2 To 1 Step -1
ch = ch + (2 ^ (k - 1)) * comp(k)
Next k
End If
n = n + 1
If n = 3 Then
n = 0
tx = tx & getc(Chr(ch))
End If
endmess = Right(tx, 11)
If endmess = "end message" Then
Text1.Text = Left(tx, Len(tx) - 11)
work 0
Exit Sub
End If
Next j
Next i
End Sub
Private Sub PutMessage()
Dim i As Long, j As Long, tx As String, ch As String, NrPix As Long
Dim pix(0 To 2) As Long, wid As Long, hig As Long
Dim r As Long, g As Long, b As Long, comp(1 To 8) As Long
Dim aa(0 To 2) As Long, bb(0 To 2) As Long
work 1
tx = "start message" & Text1.Text & "end message"
wid = Picture2.ScaleWidth
hig = Picture2.ScaleHeight
If Len(tx) * 3 > hig * wid Then
tx = MsgBox("Text is " & Len(tx) * 3 - wid * hig & " characters longer than this picture can store", vbCritical)
work 0
Exit Sub
End If
pass.Text = Trim(pass.Text)
Shuffle (pass.Text)
For i = 1 To Len(tx)
ch = ByteToBin(Asc(putc(Mid(tx,
NrPix = (CLng(i) - 1) * 3
aa(0) = (NrPix Mod hig)
bb(0) = (NrPix \ hig)
pix(0) = Picture2.Point(bb(0), aa(0)) 'the first pixel in the group of three.
r = (pix(0) And RGB(255, 0, 0)) - (pix(0) And RGB(255, 0, 0)) Mod 2: comp(1) = r
g = ((pix(0) And RGB(0, 255, 0)) \ 256) - ((pix(0) And RGB(0, 255, 0)) \ 256) Mod 2: comp(2) = g
b = ((pix(0) And RGB(0, 0, 255)) \ 65536) - ((pix(0) And RGB(0, 0, 255)) \ 65536) Mod 2: comp(3) = b
NrPix = NrPix + 1
aa(1) = (NrPix Mod hig)
bb(1) = (NrPix \ hig)
pix(1) = Picture2.Point(bb(1), aa(1)) 'the second pixel in the group of three.
r = (pix(1) And RGB(255, 0, 0)) - (pix(1) And RGB(255, 0, 0)) Mod 2: comp(4) = r
g = ((pix(1) And RGB(0, 255, 0)) \ 256) - ((pix(1) And RGB(0, 255, 0)) \ 256) Mod 2: comp(5) = g
b = ((pix(1) And RGB(0, 0, 255)) \ 65536) - ((pix(1) And RGB(0, 0, 255)) \ 65536) Mod 2: comp(6) = b
NrPix = NrPix + 1
aa(2) = (NrPix Mod hig)
bb(2) = (NrPix \ hig)
pix(2) = Picture2.Point(bb(2), aa(2)) 'the third pixel in the group of three.
r = (pix(2) And RGB(255, 0, 0)) - (pix(2) And RGB(255, 0, 0)) Mod 2: comp(7) = r
g = ((pix(2) And RGB(0, 255, 0)) \ 256) - ((pix(2) And RGB(0, 255, 0)) \ 256) Mod 2: comp(8) = g
b = ((pix(2) And RGB(0, 0, 255)) \ 65536) 'last component remains unchanged
For j = 1 To 8
comp(j) = comp(j) + CInt(Mid(ch, j, 1)) * 1
Next j
Picture2.PSet (bb(0), aa(0)), RGB(comp(1), comp(2), comp(3))
Picture2.PSet (bb(1), aa(1)), RGB(comp(4), comp(5), comp(6))
Picture2.PSet (bb(2), aa(2)), RGB(comp(7), comp(8), b)
Next i
work 0
End Sub
Private Sub work(i As Integer)
If i = 1 Then Form1.Caption = "Secret Messenger (Working...)"
If i = 0 Then Form1.Caption = "Secret Messenger"
End Sub
the code for the module is
Dim arrayA() As Integer, arrayB() As Integer, ln As Integer
Public Function ByteToBin(n As Integer) As String 'This function transforms an integer (which is the
Dim j As String 'the ascii code of a character) into a string (which
Do While n >= 1 'is the binary representation of the ascii code)
j = n Mod 2 & j
n = n \ 2
Loop
If Len(j) < 8 Then j = String(8 - Len(j), "0") & j
ByteToBin = j
End Function
Public Function putc(c As String) As String 'For each character in the message the program picks randomly
Dim ps As String 'a "deck" of characters, depending on the character itself and
ps = Form1.pass.Text 'and on the length of the password.
If ps <> "" Then
Randomize Asc(Mid(ps, 1 + Int(Len(ps) * Rnd), 1)) * (1 + Int(Len(ps) * Rnd)) * 13
putc = Chr(arrayA(Asc(c), 1 + Int(Len(ps) * Rnd)))
Else
putc = c
End If
End Function
Public Function getc(c As String) As String
Dim ps As String
ps = Form1.pass.Text
If ps <> "" Then
Randomize Asc(Mid(ps, 1 + Int(Len(ps) * Rnd), 1)) * (1 + Int(Len(ps) * Rnd)) * 13
getc = Chr(arrayB(Asc(c), 1 + Int(Len(ps) * Rnd)))
Else
getc = c
End If
End Function
Public Sub Shuffle(pas As String)
Dim i As Integer, j As Integer, k As Double, x As Integer, y As Integer, t As Integer
ln = Len(pas)
If ln > 0 Then
k = 1
For j = 1 To ln
k = k + Asc(Mid(pas, j, 1)) * j
Next j
k = Sqr(k)
ReDim arrayA(0 To 255, 1 To ln) As Integer
ReDim arrayB(0 To 255, 1 To ln) As Integer
For i = 1 To Len(pas)
For j = 0 To 255
arrayA(j, i) = j
Next j
Next i
For j = 1 To ln
f = Rnd(-1)
Randomize Asc(Mid(pas, j, 1)) * CDbl(j) * k
For i = 1 To 10000
y = Int(255 * Rnd)
t = 255 - Int(255 * Rnd)
x = arrayA(y, j)
arrayA(y, j) = arrayA(t, j)
arrayA(t, j) = x
Next i
Next j
For i = 1 To ln
For j = 0 To 255
arrayB(arrayA(j, i), i) = j
Next j
Next i
End If
End Sub
progress bar is called pb1
What are the captions for command buttons?
That is: What is each command button supposed to do?
That is: What is each command button supposed to do?
Unfortunately I can't seem to get the program working as it should (some confusion about picturebox1 and 2, maybe), but here are my best guesses on where to put code for a progressbar:
Encrypt:
Sub PutMessage, I'd put it inside the "For i = 1 To Len(tx)"-Loop, using i as the current value, len(tx) as the max value
Decrypt:
Sub GetMessage, inside the loop "For i = 0 To Picture2.ScaleWidth - 1", using i as current, picture2.scalewidth as the max value.
To set the progress bar, use the following code:
ProgressBar1.Value = curVal / maxVal * 100
Encrypt:
Sub PutMessage, I'd put it inside the "For i = 1 To Len(tx)"-Loop, using i as the current value, len(tx) as the max value
Decrypt:
Sub GetMessage, inside the loop "For i = 0 To Picture2.ScaleWidth - 1", using i as current, picture2.scalewidth as the max value.
To set the progress bar, use the following code:
ProgressBar1.Value = curVal / maxVal * 100
Maybe you could post you form declaration here, too? Open the file form1.frm with notepad to get it. That way we can be sure to have a controls up and running.
ASKER
form decleration
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9- 08002B2F49 FB}#1.2#0" ; "Comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC- 0000F8754D A1}#2.0#0" ; "MSCOMCTL.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Secret Messenger"
ClientHeight = 6420
ClientLeft = 45
ClientTop = 330
ClientWidth = 14655
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 428
ScaleMode = 3 'Pixel
ScaleWidth = 977
StartUpPosition = 3 'Windows Default
Begin MSComctlLib.ProgressBar pb1
Height = 375
Left = 840
TabIndex = 12
Top = 5760
Width = 5535
_ExtentX = 9763
_ExtentY = 661
_Version = 393216
Appearance = 1
End
Begin VB.TextBox pass
Height = 285
Left = 1080
TabIndex = 10
Top = 4920
Width = 5895
End
Begin VB.CommandButton Command5
Caption = "Save Picture"
Height = 375
Left = 13200
TabIndex = 9
Top = 4920
Width = 1455
End
Begin VB.CommandButton Command4
Caption = "Load Picture"
Height = 375
Left = 11760
TabIndex = 8
Top = 4920
Width = 1455
End
Begin VB.TextBox Text1
Height = 4935
Left = 7200
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 0
Width = 7455
End
Begin VB.CommandButton Command3
Caption = "Clear"
Height = 375
Left = 10320
TabIndex = 6
Top = 4920
Width = 1455
End
Begin VB.CommandButton Command1
Caption = "Encrypt Message"
Height = 375
Left = 8760
TabIndex = 5
Top = 4920
Width = 1575
End
Begin VB.CommandButton Command2
Caption = "Decrypt Message"
Height = 375
Left = 7200
TabIndex = 4
Top = 4920
Width = 1575
End
Begin VB.VScrollBar VScroll1
Height = 4575
Left = 6960
TabIndex = 3
Top = 0
Width = 240
End
Begin VB.HScrollBar HScroll1
Height = 255
Left = 0
TabIndex = 2
Top = 4560
Width = 6975
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 4455
Left = 0
ScaleHeight = 297
ScaleMode = 3 'Pixel
ScaleWidth = 457
TabIndex = 0
Top = 0
Width = 6855
Begin VB.PictureBox Picture2
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 4935
Left = 120
ScaleHeight = 329
ScaleMode = 3 'Pixel
ScaleWidth = 497
TabIndex = 1
Top = 240
Width = 7455
Begin MSComDlg.CommonDialog Dialog2
Left = 3120
Top = 2760
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "Pictures (*.bmp)|*.bmp"
End
Begin MSComDlg.CommonDialog Dialog1
Left = 1800
Top = 2760
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "Pictures (*.bmp;*.jpg;*.jpeg)|*.bmp ;*.jpg;*.j peg"
End
End
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Password::"
Height = 255
Left = 120
TabIndex = 11
Top = 4920
Width = 855
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub start()
Picture1.Move 0, 0
Picture2.Move 0, 0
If Picture2.Height < Picture1.Height Then Picture2.Top = (Picture1.Height - Picture2.Height) / 2
If Picture2.Width < Picture1.Width Then Picture2.Left = (Picture1.Width - Picture2.Width) / 2
HScroll1.Top = Picture1.Height
HScroll1.Left = 0
HScroll1.Width = Picture1.Width
VScroll1.Top = 0
VScroll1.Left = Picture1.Width
VScroll1.Height = Picture1.Height
HScroll1.Max = Picture2.Width - Picture1.Width
VScroll1.Max = Picture2.Height - Picture1.Height
VScroll1.Visible = (Picture1.Height < Picture2.Height)
HScroll1.Visible = (Picture1.Width < Picture2.Width)
HScroll1.Value = 0
VScroll1.Value = 0
End Sub
Private Sub Command1_Click()
PutMessage
End Sub
Private Sub Command2_Click()
Dim d As String
GetMessage
d = " "
End Sub
Private Sub Command3_Click()
Text1.Text = ""
End Sub
Private Sub Command4_Click()
Dialog1.ShowOpen
If Dialog1.FileName <> "" Then
Picture2.Picture = LoadPicture(Dialog1.FileNa me)
Text1.Text = ""
start
End If
End Sub
Private Sub Command5_Click()
Dialog2.ShowSave
If Dialog2.FileName <> "" Then SavePicture Picture2.Image, Dialog2.FileName
End Sub
Private Sub Form_Load()
Picture2.Picture = LoadPicture(App.Path & "/USflag.bmp")
start
End Sub
Private Sub VScroll1_Change()
Picture2.Top = -VScroll1.Value
End Sub
Private Sub HScroll1_Change()
Picture2.Left = -HScroll1.Value
End Sub
Private Sub GetMessage()
Dim i As Long, j As Long, k As Long, n As Long, pix(0 To 2) As Long
Dim tx As String, nmd As Long, start As Integer
Dim endmess As String, comp(1 To 8) As Long, ch As Long
work 1
pass.Text = Trim(pass.Text)
Shuffle (pass.Text)
For i = 0 To Picture2.ScaleWidth - 1
For j = 0 To Picture2.ScaleHeight - 1
nmd = n Mod 3
If nmd = 0 Then
If start < 14 Then
start = start + 1
If start = 14 And tx <> "start message" Then
Text1.Text = "THIS PICTURE HAS NO SECRET MESSAGE"
work 0
Exit Sub
ElseIf start = 14 Then
tx = ""
End If
End If
ch = 0
pix(nmd) = Picture2.Point(i, j)
comp(8) = ((pix(nmd) And RGB(255, 0, 0)) Mod 2)
comp(7) = (((pix(nmd) And RGB(0, 255, 0)) \ 256) Mod 2)
comp(6) = (((pix(nmd) And RGB(0, 0, 255)) \ 65536) Mod 2)
For k = 8 To 6 Step -1
ch = ch + (2 ^ (k - 1)) * comp(k)
Next k
End If
If nmd = 1 Then
pix(nmd) = Picture2.Point(i, j)
comp(5) = ((pix(nmd) And RGB(255, 0, 0)) Mod 2)
comp(4) = (((pix(nmd) And RGB(0, 255, 0)) \ 256) Mod 2)
comp(3) = (((pix(nmd) And RGB(0, 0, 255)) \ 65536) Mod 2)
For k = 5 To 3 Step -1
ch = ch + (2 ^ (k - 1)) * comp(k)
Next k
End If
If nmd = 2 Then
pix(nmd) = Picture2.Point(i, j)
comp(2) = ((pix(nmd) And RGB(255, 0, 0)) Mod 2)
comp(1) = (((pix(nmd) And RGB(0, 255, 0)) \ 256) Mod 2)
For k = 2 To 1 Step -1
ch = ch + (2 ^ (k - 1)) * comp(k)
Next k
End If
n = n + 1
If n = 3 Then
n = 0
tx = tx & getc(Chr(ch))
End If
endmess = Right(tx, 11)
If endmess = "end message" Then
Text1.Text = Left(tx, Len(tx) - 11)
work 0
Exit Sub
End If
Next j
Next i
End Sub
Private Sub PutMessage()
Dim i As Long, j As Long, tx As String, ch As String, NrPix As Long
Dim pix(0 To 2) As Long, wid As Long, hig As Long
Dim r As Long, g As Long, b As Long, comp(1 To 8) As Long
Dim aa(0 To 2) As Long, bb(0 To 2) As Long
work 1
tx = "start message" & Text1.Text & "end message"
wid = Picture2.ScaleWidth
hig = Picture2.ScaleHeight
If Len(tx) * 3 > hig * wid Then
tx = MsgBox("Text is " & Len(tx) * 3 - wid * hig & " characters longer than this picture can store", vbCritical)
work 0
Exit Sub
End If
pass.Text = Trim(pass.Text)
Shuffle (pass.Text)
For i = 1 To Len(tx)
ch = ByteToBin(Asc(putc(Mid(tx, i, 1))))
NrPix = (CLng(i) - 1) * 3
aa(0) = (NrPix Mod hig)
bb(0) = (NrPix \ hig)
pix(0) = Picture2.Point(bb(0), aa(0)) 'the first pixel in the group of three.
r = (pix(0) And RGB(255, 0, 0)) - (pix(0) And RGB(255, 0, 0)) Mod 2: comp(1) = r
g = ((pix(0) And RGB(0, 255, 0)) \ 256) - ((pix(0) And RGB(0, 255, 0)) \ 256) Mod 2: comp(2) = g
b = ((pix(0) And RGB(0, 0, 255)) \ 65536) - ((pix(0) And RGB(0, 0, 255)) \ 65536) Mod 2: comp(3) = b
NrPix = NrPix + 1
aa(1) = (NrPix Mod hig)
bb(1) = (NrPix \ hig)
pix(1) = Picture2.Point(bb(1), aa(1)) 'the second pixel in the group of three.
r = (pix(1) And RGB(255, 0, 0)) - (pix(1) And RGB(255, 0, 0)) Mod 2: comp(4) = r
g = ((pix(1) And RGB(0, 255, 0)) \ 256) - ((pix(1) And RGB(0, 255, 0)) \ 256) Mod 2: comp(5) = g
b = ((pix(1) And RGB(0, 0, 255)) \ 65536) - ((pix(1) And RGB(0, 0, 255)) \ 65536) Mod 2: comp(6) = b
NrPix = NrPix + 1
aa(2) = (NrPix Mod hig)
bb(2) = (NrPix \ hig)
pix(2) = Picture2.Point(bb(2), aa(2)) 'the third pixel in the group of three.
r = (pix(2) And RGB(255, 0, 0)) - (pix(2) And RGB(255, 0, 0)) Mod 2: comp(7) = r
g = ((pix(2) And RGB(0, 255, 0)) \ 256) - ((pix(2) And RGB(0, 255, 0)) \ 256) Mod 2: comp(8) = g
b = ((pix(2) And RGB(0, 0, 255)) \ 65536) 'last component remains unchanged
For j = 1 To 8
comp(j) = comp(j) + CInt(Mid(ch, j, 1)) * 1
Next j
Picture2.PSet (bb(0), aa(0)), RGB(comp(1), comp(2), comp(3))
Picture2.PSet (bb(1), aa(1)), RGB(comp(4), comp(5), comp(6))
Picture2.PSet (bb(2), aa(2)), RGB(comp(7), comp(8), b)
Next i
work 0
End Sub
Private Sub work(i As Integer)
If i = 1 Then Form1.Caption = "Secret Messenger (Working...)"
If i = 0 Then Form1.Caption = "Secret Messenger"
End Sub
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-
Object = "{831FDD16-0C5C-11D2-A9FC-
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Secret Messenger"
ClientHeight = 6420
ClientLeft = 45
ClientTop = 330
ClientWidth = 14655
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 428
ScaleMode = 3 'Pixel
ScaleWidth = 977
StartUpPosition = 3 'Windows Default
Begin MSComctlLib.ProgressBar pb1
Height = 375
Left = 840
TabIndex = 12
Top = 5760
Width = 5535
_ExtentX = 9763
_ExtentY = 661
_Version = 393216
Appearance = 1
End
Begin VB.TextBox pass
Height = 285
Left = 1080
TabIndex = 10
Top = 4920
Width = 5895
End
Begin VB.CommandButton Command5
Caption = "Save Picture"
Height = 375
Left = 13200
TabIndex = 9
Top = 4920
Width = 1455
End
Begin VB.CommandButton Command4
Caption = "Load Picture"
Height = 375
Left = 11760
TabIndex = 8
Top = 4920
Width = 1455
End
Begin VB.TextBox Text1
Height = 4935
Left = 7200
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 7
Top = 0
Width = 7455
End
Begin VB.CommandButton Command3
Caption = "Clear"
Height = 375
Left = 10320
TabIndex = 6
Top = 4920
Width = 1455
End
Begin VB.CommandButton Command1
Caption = "Encrypt Message"
Height = 375
Left = 8760
TabIndex = 5
Top = 4920
Width = 1575
End
Begin VB.CommandButton Command2
Caption = "Decrypt Message"
Height = 375
Left = 7200
TabIndex = 4
Top = 4920
Width = 1575
End
Begin VB.VScrollBar VScroll1
Height = 4575
Left = 6960
TabIndex = 3
Top = 0
Width = 240
End
Begin VB.HScrollBar HScroll1
Height = 255
Left = 0
TabIndex = 2
Top = 4560
Width = 6975
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 4455
Left = 0
ScaleHeight = 297
ScaleMode = 3 'Pixel
ScaleWidth = 457
TabIndex = 0
Top = 0
Width = 6855
Begin VB.PictureBox Picture2
Appearance = 0 'Flat
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 4935
Left = 120
ScaleHeight = 329
ScaleMode = 3 'Pixel
ScaleWidth = 497
TabIndex = 1
Top = 240
Width = 7455
Begin MSComDlg.CommonDialog Dialog2
Left = 3120
Top = 2760
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "Pictures (*.bmp)|*.bmp"
End
Begin MSComDlg.CommonDialog Dialog1
Left = 1800
Top = 2760
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Filter = "Pictures (*.bmp;*.jpg;*.jpeg)|*.bmp
End
End
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Password::"
Height = 255
Left = 120
TabIndex = 11
Top = 4920
Width = 855
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub start()
Picture1.Move 0, 0
Picture2.Move 0, 0
If Picture2.Height < Picture1.Height Then Picture2.Top = (Picture1.Height - Picture2.Height) / 2
If Picture2.Width < Picture1.Width Then Picture2.Left = (Picture1.Width - Picture2.Width) / 2
HScroll1.Top = Picture1.Height
HScroll1.Left = 0
HScroll1.Width = Picture1.Width
VScroll1.Top = 0
VScroll1.Left = Picture1.Width
VScroll1.Height = Picture1.Height
HScroll1.Max = Picture2.Width - Picture1.Width
VScroll1.Max = Picture2.Height - Picture1.Height
VScroll1.Visible = (Picture1.Height < Picture2.Height)
HScroll1.Visible = (Picture1.Width < Picture2.Width)
HScroll1.Value = 0
VScroll1.Value = 0
End Sub
Private Sub Command1_Click()
PutMessage
End Sub
Private Sub Command2_Click()
Dim d As String
GetMessage
d = " "
End Sub
Private Sub Command3_Click()
Text1.Text = ""
End Sub
Private Sub Command4_Click()
Dialog1.ShowOpen
If Dialog1.FileName <> "" Then
Picture2.Picture = LoadPicture(Dialog1.FileNa
Text1.Text = ""
start
End If
End Sub
Private Sub Command5_Click()
Dialog2.ShowSave
If Dialog2.FileName <> "" Then SavePicture Picture2.Image, Dialog2.FileName
End Sub
Private Sub Form_Load()
Picture2.Picture = LoadPicture(App.Path & "/USflag.bmp")
start
End Sub
Private Sub VScroll1_Change()
Picture2.Top = -VScroll1.Value
End Sub
Private Sub HScroll1_Change()
Picture2.Left = -HScroll1.Value
End Sub
Private Sub GetMessage()
Dim i As Long, j As Long, k As Long, n As Long, pix(0 To 2) As Long
Dim tx As String, nmd As Long, start As Integer
Dim endmess As String, comp(1 To 8) As Long, ch As Long
work 1
pass.Text = Trim(pass.Text)
Shuffle (pass.Text)
For i = 0 To Picture2.ScaleWidth - 1
For j = 0 To Picture2.ScaleHeight - 1
nmd = n Mod 3
If nmd = 0 Then
If start < 14 Then
start = start + 1
If start = 14 And tx <> "start message" Then
Text1.Text = "THIS PICTURE HAS NO SECRET MESSAGE"
work 0
Exit Sub
ElseIf start = 14 Then
tx = ""
End If
End If
ch = 0
pix(nmd) = Picture2.Point(i, j)
comp(8) = ((pix(nmd) And RGB(255, 0, 0)) Mod 2)
comp(7) = (((pix(nmd) And RGB(0, 255, 0)) \ 256) Mod 2)
comp(6) = (((pix(nmd) And RGB(0, 0, 255)) \ 65536) Mod 2)
For k = 8 To 6 Step -1
ch = ch + (2 ^ (k - 1)) * comp(k)
Next k
End If
If nmd = 1 Then
pix(nmd) = Picture2.Point(i, j)
comp(5) = ((pix(nmd) And RGB(255, 0, 0)) Mod 2)
comp(4) = (((pix(nmd) And RGB(0, 255, 0)) \ 256) Mod 2)
comp(3) = (((pix(nmd) And RGB(0, 0, 255)) \ 65536) Mod 2)
For k = 5 To 3 Step -1
ch = ch + (2 ^ (k - 1)) * comp(k)
Next k
End If
If nmd = 2 Then
pix(nmd) = Picture2.Point(i, j)
comp(2) = ((pix(nmd) And RGB(255, 0, 0)) Mod 2)
comp(1) = (((pix(nmd) And RGB(0, 255, 0)) \ 256) Mod 2)
For k = 2 To 1 Step -1
ch = ch + (2 ^ (k - 1)) * comp(k)
Next k
End If
n = n + 1
If n = 3 Then
n = 0
tx = tx & getc(Chr(ch))
End If
endmess = Right(tx, 11)
If endmess = "end message" Then
Text1.Text = Left(tx, Len(tx) - 11)
work 0
Exit Sub
End If
Next j
Next i
End Sub
Private Sub PutMessage()
Dim i As Long, j As Long, tx As String, ch As String, NrPix As Long
Dim pix(0 To 2) As Long, wid As Long, hig As Long
Dim r As Long, g As Long, b As Long, comp(1 To 8) As Long
Dim aa(0 To 2) As Long, bb(0 To 2) As Long
work 1
tx = "start message" & Text1.Text & "end message"
wid = Picture2.ScaleWidth
hig = Picture2.ScaleHeight
If Len(tx) * 3 > hig * wid Then
tx = MsgBox("Text is " & Len(tx) * 3 - wid * hig & " characters longer than this picture can store", vbCritical)
work 0
Exit Sub
End If
pass.Text = Trim(pass.Text)
Shuffle (pass.Text)
For i = 1 To Len(tx)
ch = ByteToBin(Asc(putc(Mid(tx,
NrPix = (CLng(i) - 1) * 3
aa(0) = (NrPix Mod hig)
bb(0) = (NrPix \ hig)
pix(0) = Picture2.Point(bb(0), aa(0)) 'the first pixel in the group of three.
r = (pix(0) And RGB(255, 0, 0)) - (pix(0) And RGB(255, 0, 0)) Mod 2: comp(1) = r
g = ((pix(0) And RGB(0, 255, 0)) \ 256) - ((pix(0) And RGB(0, 255, 0)) \ 256) Mod 2: comp(2) = g
b = ((pix(0) And RGB(0, 0, 255)) \ 65536) - ((pix(0) And RGB(0, 0, 255)) \ 65536) Mod 2: comp(3) = b
NrPix = NrPix + 1
aa(1) = (NrPix Mod hig)
bb(1) = (NrPix \ hig)
pix(1) = Picture2.Point(bb(1), aa(1)) 'the second pixel in the group of three.
r = (pix(1) And RGB(255, 0, 0)) - (pix(1) And RGB(255, 0, 0)) Mod 2: comp(4) = r
g = ((pix(1) And RGB(0, 255, 0)) \ 256) - ((pix(1) And RGB(0, 255, 0)) \ 256) Mod 2: comp(5) = g
b = ((pix(1) And RGB(0, 0, 255)) \ 65536) - ((pix(1) And RGB(0, 0, 255)) \ 65536) Mod 2: comp(6) = b
NrPix = NrPix + 1
aa(2) = (NrPix Mod hig)
bb(2) = (NrPix \ hig)
pix(2) = Picture2.Point(bb(2), aa(2)) 'the third pixel in the group of three.
r = (pix(2) And RGB(255, 0, 0)) - (pix(2) And RGB(255, 0, 0)) Mod 2: comp(7) = r
g = ((pix(2) And RGB(0, 255, 0)) \ 256) - ((pix(2) And RGB(0, 255, 0)) \ 256) Mod 2: comp(8) = g
b = ((pix(2) And RGB(0, 0, 255)) \ 65536) 'last component remains unchanged
For j = 1 To 8
comp(j) = comp(j) + CInt(Mid(ch, j, 1)) * 1
Next j
Picture2.PSet (bb(0), aa(0)), RGB(comp(1), comp(2), comp(3))
Picture2.PSet (bb(1), aa(1)), RGB(comp(4), comp(5), comp(6))
Picture2.PSet (bb(2), aa(2)), RGB(comp(7), comp(8), b)
Next i
work 0
End Sub
Private Sub work(i As Integer)
If i = 1 Then Form1.Caption = "Secret Messenger (Working...)"
If i = 0 Then Form1.Caption = "Secret Messenger"
End Sub
ASKER
the following works for the encrypt part
pb1.Value = i / Len(tx) * 100
but the decrypt one dosnt work
pb1.Value = i / Picture2.ScaleWidth * 100
ASKER
sorry i forgot to mention that i want a label to display the percentage of the progressbar, this is probably pretty simple
Check what's the current value of Picture2.ScaleWidth. I noticed on testing your script (i did not get it working though), that picture2 stays empty and has a widht of 0. I thought this was an error just here, but if your picture2 has width 0, too, it will come to an error because of dividing through 0. Check the value of Picture2.Scalewidth in Sub GetMessage.
You could also try to assign Picture2.ScaleWidth to a variable to use for the progress bar.
About the label: you can use pb1.value as this already shows the percent, because the progressbar has a max of 100, so pb1.value=75 would be 75%.
You could also try to assign Picture2.ScaleWidth to a variable to use for the progress bar.
About the label: you can use pb1.value as this already shows the percent, because the progressbar has a max of 100, so pb1.value=75 would be 75%.
ASKER
the value of picture2.scalewidth is 290 i used a label to check this, label2.caption = picture2.scalewidth
when i decrypt it gets a little bit through the progressbar then stops
also where do i put the thing about the percent
sorry i forgot to paste the module code with the form declaration
'just put this in a module called module1
Dim arrayA() As Integer, arrayB() As Integer, ln As Integer
Public Function ByteToBin(n As Integer) As String 'This function transforms an integer (which is the
Dim j As String 'the ascii code of a character) into a string (which
Do While n >= 1 'is the binary representation of the ascii code)
j = n Mod 2 & j
n = n \ 2
Loop
If Len(j) < 8 Then j = String(8 - Len(j), "0") & j
ByteToBin = j
End Function
Public Function putc(c As String) As String 'For each character in the message the program picks randomly
Dim ps As String 'a "deck" of characters, depending on the character itself and
ps = Form1.pass.Text 'and on the length of the password.
If ps <> "" Then
Randomize Asc(Mid(ps, 1 + Int(Len(ps) * Rnd), 1)) * (1 + Int(Len(ps) * Rnd)) * 13
putc = Chr(arrayA(Asc(c), 1 + Int(Len(ps) * Rnd)))
Else
putc = c
End If
End Function
Public Function getc(c As String) As String
Dim ps As String
ps = Form1.pass.Text
If ps <> "" Then
Randomize Asc(Mid(ps, 1 + Int(Len(ps) * Rnd), 1)) * (1 + Int(Len(ps) * Rnd)) * 13
getc = Chr(arrayB(Asc(c), 1 + Int(Len(ps) * Rnd)))
Else
getc = c
End If
End Function
Public Sub Shuffle(pas As String)
Dim i As Integer, j As Integer, k As Double, x As Integer, y As Integer, t As Integer
ln = Len(pas)
If ln > 0 Then
k = 1
For j = 1 To ln
k = k + Asc(Mid(pas, j, 1)) * j
Next j
k = Sqr(k)
ReDim arrayA(0 To 255, 1 To ln) As Integer
ReDim arrayB(0 To 255, 1 To ln) As Integer
For i = 1 To Len(pas)
For j = 0 To 255
arrayA(j, i) = j
Next j
Next i
For j = 1 To ln
f = Rnd(-1)
Randomize Asc(Mid(pas, j, 1)) * CDbl(j) * k
For i = 1 To 10000
y = Int(255 * Rnd)
t = 255 - Int(255 * Rnd)
x = arrayA(y, j)
arrayA(y, j) = arrayA(t, j)
arrayA(t, j) = x
Next i
Next j
For i = 1 To ln
For j = 0 To 255
arrayB(arrayA(j, i), i) = j
Next j
Next i
End If
End Sub
when i decrypt it gets a little bit through the progressbar then stops
also where do i put the thing about the percent
sorry i forgot to paste the module code with the form declaration
'just put this in a module called module1
Dim arrayA() As Integer, arrayB() As Integer, ln As Integer
Public Function ByteToBin(n As Integer) As String 'This function transforms an integer (which is the
Dim j As String 'the ascii code of a character) into a string (which
Do While n >= 1 'is the binary representation of the ascii code)
j = n Mod 2 & j
n = n \ 2
Loop
If Len(j) < 8 Then j = String(8 - Len(j), "0") & j
ByteToBin = j
End Function
Public Function putc(c As String) As String 'For each character in the message the program picks randomly
Dim ps As String 'a "deck" of characters, depending on the character itself and
ps = Form1.pass.Text 'and on the length of the password.
If ps <> "" Then
Randomize Asc(Mid(ps, 1 + Int(Len(ps) * Rnd), 1)) * (1 + Int(Len(ps) * Rnd)) * 13
putc = Chr(arrayA(Asc(c), 1 + Int(Len(ps) * Rnd)))
Else
putc = c
End If
End Function
Public Function getc(c As String) As String
Dim ps As String
ps = Form1.pass.Text
If ps <> "" Then
Randomize Asc(Mid(ps, 1 + Int(Len(ps) * Rnd), 1)) * (1 + Int(Len(ps) * Rnd)) * 13
getc = Chr(arrayB(Asc(c), 1 + Int(Len(ps) * Rnd)))
Else
getc = c
End If
End Function
Public Sub Shuffle(pas As String)
Dim i As Integer, j As Integer, k As Double, x As Integer, y As Integer, t As Integer
ln = Len(pas)
If ln > 0 Then
k = 1
For j = 1 To ln
k = k + Asc(Mid(pas, j, 1)) * j
Next j
k = Sqr(k)
ReDim arrayA(0 To 255, 1 To ln) As Integer
ReDim arrayB(0 To 255, 1 To ln) As Integer
For i = 1 To Len(pas)
For j = 0 To 255
arrayA(j, i) = j
Next j
Next i
For j = 1 To ln
f = Rnd(-1)
Randomize Asc(Mid(pas, j, 1)) * CDbl(j) * k
For i = 1 To 10000
y = Int(255 * Rnd)
t = 255 - Int(255 * Rnd)
x = arrayA(y, j)
arrayA(y, j) = arrayA(t, j)
arrayA(t, j) = x
Next i
Next j
For i = 1 To ln
For j = 0 To 255
arrayB(arrayA(j, i), i) = j
Next j
Next i
End If
End Sub
Thanks to your form declaration I could now get the thing running. I guess the problem about the decryption is, that your programm does not exactly know how long the encrypted information is. Your programm starts searching and as soon as the complete message is found it aborts the search. But since you don't know how long the text to be decrypted is, you can't know the percentage of it found.
If you use the code I gave you, the progress bar will assume that the text takes the whole picture, which won't be the case very often. Usually it should only take a some pixels of it. So if you take a really long text and a small picture, the progress bar should work better.
But if your text only uses 1 percent of the picture, the progress bar will stop at 1 percent because the search is stopped as soon as the whole text is found.
A workaround could be to place the progressbar in the inner loop:
[...]
For i = 0 To Picture2.ScaleWidth - 1
For j = 0 To Picture2.ScaleHeight - 1
pb1.Value = j / Picture2.ScaleHeight * 100
nmd = n Mod 3
[...]
This would increase the progress bar to 100 % for each row of the picture. But if your text takes more than 1 row, the progressbar will start at 0 and fill up, until the end of the message.
Sorry but I can't think of any other way for the decryption process right now.
If you use the code I gave you, the progress bar will assume that the text takes the whole picture, which won't be the case very often. Usually it should only take a some pixels of it. So if you take a really long text and a small picture, the progress bar should work better.
But if your text only uses 1 percent of the picture, the progress bar will stop at 1 percent because the search is stopped as soon as the whole text is found.
A workaround could be to place the progressbar in the inner loop:
[...]
For i = 0 To Picture2.ScaleWidth - 1
For j = 0 To Picture2.ScaleHeight - 1
pb1.Value = j / Picture2.ScaleHeight * 100
nmd = n Mod 3
[...]
This would increase the progress bar to 100 % for each row of the picture. But if your text takes more than 1 row, the progressbar will start at 0 and fill up, until the end of the message.
Sorry but I can't think of any other way for the decryption process right now.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
thanks heaps, i will give you some points for your help, if i find another answer that works for decryption then i will split them
No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area that this question is:
Answered Steiner
Please leave any comments here within the next seven days.
PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!
leonstryker
EE Cleanup Volunteer
I will leave a recommendation in the Cleanup topic area that this question is:
Answered Steiner
Please leave any comments here within the next seven days.
PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!
leonstryker
EE Cleanup Volunteer
ASKER
when i am encrypting or decrypting the text.