Printable View
I want to be able to have a current project of mine scroll through the jpegs of the folder my program is placed. I want to have it show one picture at a time in a picture box. The next button goes to the next picture in the folder, and the previous button goes to the previous image in a folder. How will i have the picturebox open an unknown named picture?
try a filelistbox, set the pattern to *.jpg or *.gif or somethingQuote:
Originally Posted by stevevb6
you will need to add these to you form and name them as below:
1 tmrPic <a timer
2 picHolder < a Picture box
3 imgPreview < and image control, set to stretch
4 CmdImg <a button
then just paste the rest in your form.
this was set up to take a list of photos, i used it in a tv-photo viewer.
i enclosed a sub to make a list for you of jpeg in the app's dir.
you should call it the before the first time you click the button;
put the line below in your form_load()
makelist()
and that should do it.
the reason for all of this code is that is keeps the LxH (aspect) ratio in proportion, gives you slideshow options, and can fullscreen the image.
i reworked it a little bit on here, so let me know if something's awry.
Code:
dim fileN as string
Private Sub CmdImg_Click()
Mode = "pic"
hideall
'Maximize2 picHolder, form1
picHolder.Width = form1.Width
picHolder.Height = form1.Height
Dim Photos() As String
Dim xc As Long
Dim wt As Long
Photos = Split(LdFile(app.path & "\" & "images.txt"), vbCrLf)
For xc = 1 To ubound(Photos)
fileN = Photos(xc)
picHolder.Picture = LoadPicture(fileN)
imgPreview.Picture = picHolder.Picture
Call SizePreview
Refresh
tmrPic.Interval = 4000
DoEvents
Sleep 200
DoEvents
Do Until advance = True
Sleep 30
DoEvents
Loop
advance = False
Next xc
End Sub
Private Sub tmrPic_Timer()
tmrPic.Interval = 4500
advance = True
End Sub
Private Sub SizePreview()
Dim lDif As Double
Dim lPercent As Double
Dim lx As Long
Dim ly As Long
Dim Xscaled As Double
Dim Yscaled As Double
With imgPreview
.Visible = False
If .Picture.Height = 0 Then Exit Sub
.Stretch = False
Xscaled = .Picture.Width * 0.5712
Yscaled = .Picture.Height * 0.5712
If Yscaled > picHolder.Height Or Xscaled > picHolder.Width Then
If (Yscaled > picHolder.Height) Then
lDif = Yscaled - picHolder.Height
lPercent = lDif * 100 / Yscaled
.Width = Xscaled - (lPercent * Xscaled \ 100)
.Height = Yscaled - (lPercent * Yscaled \ 100)
Xscaled = .Width 'Update Width
Yscaled = .Height 'Update Height
End If
If (Xscaled > picHolder.Width) Then
lDif = Xscaled - picHolder.Width
lPercent = lDif * 100 / Xscaled
.Width = Xscaled - (lPercent * Xscaled \ 100)
.Height = Yscaled - (lPercent * Yscaled \ 100)
End If
.Stretch = True
End If
'this centers the image
lx = ly = 0
' If .Width < form1.Width Then lx = (form1.Width - .Width) \ 2
' If .Height < form1.Height Then ly = (form1.Height - .Height)
If .Width < picHolder.Width Then lx = (picHolder.Width - .Width) \ 2
If .Height < picHolder.Height Then ly = (picHolder.Height - .Height) \ 2
.Move lx, ly ' , .Width, .Height
' .Left = 200 'lx
' .Top = 400 ' ly
.Refresh
.Visible = True
End With
End Sub
Public Sub SvFile(sFileName As String, FileContent As String)
Dim ff As Integer
ff = FreeFile
Open sFileName For Output As #ff
Print #ff, FileContent;
Close #ff
End Sub
Public Function LdFile(lFileName As String) As String
Dim F As Integer
F = FreeFile
Open lFileName For Input As #F
LdFile = Input$(LOF(F), #F)
Close #F
End Function
sub makelist()
dim dirstr as string
dirstr = app.path & "\*.jpg"
shell environ$("COMSPEC") & " /c dir " & dirstr & " > " & split(dirstr, "*")(0) & "images.txt"
end sub
I have a simple Idea
add to the form File control
Note :
next Button Name Is cmdnext
back button name is cmdback
vb Code:
I hope this is useful
Or just find all the .jpg files with the Dir() function, add them to a collection and step through the collection (returning to the first item after doing the last item).