Link to home
Start Free TrialLog in
Avatar of --laser--
--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.FileName)
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
Avatar of --laser--
--laser--

ASKER

sorry i forgot to tell where i want the progressbar to come into play

when i am encrypting or decrypting the text.
What are the captions for command buttons?
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
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.
form decleration



VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#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;*.jpeg"
         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.FileName)
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 following works for the encrypt part

pb1.Value = i / Len(tx) * 100


but the decrypt one dosnt work

pb1.Value = i / Picture2.ScaleWidth * 100





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%.
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
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.
ASKER CERTIFIED SOLUTION
Avatar of Steiner
Steiner

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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