Results 1 to 6 of 6

Thread: how can i make a button open the next picture file

  1. #1
    Guest

    Question

    hey everyone again
    i usually get good results coming here and asking questions even though u r probably all sick of me
    anyway
    i am making just a simple picture veiwer and i want to be able to veiw the next picture in the directory where the last picture came from and also how can i put a scroll bar on a picture box so i can see the rest of the image if its too big?
    thanx in advance:-)

  2. #2
    Guest
    I don't know about the scrollbar, but for loading the next picture in the directory, you can use the Dir function. First:

    Code:
    'this will return the first JPG file it finds in the dir.
    Dim FName As String
    FName = Dir(Directory & "\*.jpg", vbNormal)
    Now everytime onwards you use
    Code:
    FName = Dir     'variable does not have to be FName again
    it will return the next filename as specified by the first Dir (*.jpg). It will do this until you specify a new file type/directory or when it finds no more files, in which case it will return an empty string.

    Sunny

  3. #3
    Guest

    I cant work it out

    Thanx for this help but i cant work it out where exaclty do i put all thi s code lol?
    thanx

  4. #4
    Guest
    Now this assumes you have a Open button, and everytime you click it, it will load the next picture in the specified directory with the specified extension.

    Code:
    Option Explicit
    Dim First As Boolean
    
    Private Sub cmdOpen_Click()
       Dim FName As String
    
       If Right(txtDir, 1) <> "\" Then
          txtDir = txtDir & "\"
       End If
    
       If First = True Then
          FName = Dir(txtDir & txtExt, vbNormal)
          First = False
       Else
          FName = Dir
       End If
    
       If Dir = "" Then
          First = True
          Exit Sub
       End If
    
       Picture1.Picture = LoadPicture(txtDir & FName)
    
    End Sub
    
    Private Sub Form_Load()
        First = True
    End Sub
    Hope this helps,
    Sunny

  5. #5
    _______ HeSaidJoe's Avatar
    Join Date
    Jun 1999
    Location
    Canada
    Posts
    3,946

    <?>

    scrollbar on a picture box is here:
    http://www.vb-world.net/tips/tip95.html

    'set a 3Dborder to your form.
    '
    Code:
    'a simple slide projector
    
    'bas module code
    
    Option Explicit
    '
    Sub ThreeDForm(frmForm As Form)
       
        Const cPi = 3.1415926
        Dim intLineWidth As Integer
        intLineWidth = 7
        ' 'save scale mode
        Dim intSaveScaleMode As Integer
        intSaveScaleMode = frmForm.ScaleMode
        frmForm.ScaleMode = 3
        Dim intScaleWidth As Integer
        Dim intScaleHeight As Integer
        intScaleWidth = frmForm.ScaleWidth
        intScaleHeight = frmForm.ScaleHeight
        ' 'clear form
        frmForm.Cls
        ' 'draw white lines
        frmForm.Line (0, intScaleHeight)-(intLineWidth, 0), &HFFFFFF, BF
        frmForm.Line (0, intLineWidth)-(intScaleWidth, 0), &HFFFFFF, BF
        ' 'draw grey lines
        frmForm.Line (intScaleWidth, 0)-(intScaleWidth - intLineWidth, intScaleHeight), &H808080, BF
        frmForm.Line (intScaleWidth, intScaleHeight - intLineWidth)-(0, intScaleHeight), &H808080, BF
        ' 'draw triangles(actually circles) at corners
        Dim intCircleWidth As Integer
        intCircleWidth = Sqr(intLineWidth * intLineWidth + intLineWidth * intLineWidth)
        frmForm.FillStyle = 0
        frmForm.FillColor = QBColor(15)
        frmForm.Circle (intLineWidth, intScaleHeight - intLineWidth), intCircleWidth, QBColor(15), _
        -3.1415926, -3.90953745777778 '-180 * cPi / 180, -224 * cPi / 180
        frmForm.Circle (intScaleWidth - intLineWidth, intLineWidth), intCircleWidth, QBColor(15), _
        -0.78539815, -1.5707963 ' -45 * cPi / 180, -90 * cPi / 180
        ' 'draw black frame
        frmForm.Line (0, intScaleHeight)-(0, 0), 0
        frmForm.Line (0, 0)-(intScaleWidth - 1, 0), 0
        frmForm.Line (intScaleWidth - 1, 0)-(intScaleWidth - 1, intScaleHeight - 1), 0
        frmForm.Line (0, intScaleHeight - 1)-(intScaleWidth - 1, intScaleHeight - 1), 0
        frmForm.ScaleMode = intSaveScaleMode
    End Sub
    
    'form
        
        'I've used a data object...data1
        'A form called frmImage
        'Command Buttons  cmdFirst,cmdNext,cmdPrevious,cdmLast,cmdQuit
        'a Picturebox called Picture1
        'a textbox called Text5
        'a database called Art,table called Art, field called sLocation
        'sLocation is the name of the file  ie.  MaryBrown.jpg
        'images are stored in the app folder
        
        Option Explicit
        '
        'set icon in taskbar
        Private Declare Function SetWindowLong Lib "user32" _
        Alias "SetWindowLongA" (ByVal hwnd As Long, _
        ByVal nIndex As Long, ByVal dwNewLong As Long) _
        As Long
    
        Private Const GWL_STYLE = (-16)
        Private Const WS_SYSMENU = &H80000
        '
        'database declares
        
        Public db As Database      'Access database
        Public rs As Recordset     'Records from that database
        Public cDBsName As String
        Public cTblsName As String
        
        '
        Public Sub OpenDB()
    
            Dim AppPath$
                
            If Right(App.Path, 1) <> "\" Then _
            AppPath = App.Path & "\" _
            Else AppPath = App.Path
            
            'your database sName
            cDBsName = AppPath & "Art.mdb"
            
            'your table sName
            cTblsName = "Art"
    
            Data1.DatabaseName = cDBsName
            Data1.RecordSource = cTblsName
            
            'refresh the data contol
            Data1.Refresh
    
        End Sub
    
        Private Sub cmdFirst_Click()
    
            rs.MoveFirst
            Call checkbtns
            Call loadrec
        
        End Sub
    
        Private Sub cmdLast_Click()
    
            rs.MoveLast
            Call checkbtns
            Call loadrec
        
        End Sub
    
        Private Sub cmdNext_Click()
        
            rs.MoveNext
            Call checkbtns
            Call loadrec
         
        End Sub
    
        Private Sub cmdPrevious_Click()
        
            rs.MovePrevious
            Call checkbtns
            Call loadrec
        
        End Sub
    
        Private Sub cmdQuit_Click()
    
            Call QuitNow
        
        End Sub
    
        Private Sub Form_Activate()
    
            Call ThreeDForm(Me)
        
        End Sub
    
        Private Sub Form_Load()
    '
            Call OpenDB
    '
            Dim reply As Double     'Response in event of error
        '
            Set db = Workspaces(0).OpenDatabase(cDBsName)
            Set rs = db.OpenRecordset(cTblsName)
            
        If (rs.BOF And rs.EOF) Then
            reply = MsgBox("Error!" & vbCrLf & _
            "No data in table!", vbCritical, "ERROR!")
            Call QuitNow        'All stop
        
        End If
        '
            cmdPrevious.Enabled = False
            Call loadrec
        '
     
        '
        'put icon in taskbar
            Call SetWindowLong(Me.hwnd, GWL_STYLE, WS_SYSMENU)
        '
        End Sub
        Private Sub QuitNow()
        '
        ' Shut down
        '
            Dim Form As Form
        '
            For Each Form In Forms
                Unload Form
                Set Form = Nothing
            Next Form
        '
        End
    
        End Sub
        '
        Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
        
            Call QuitNow
            ' All stop
        End Sub
    
        Private Sub loadrec()
        '
        
            Text5.Text = ""
            Picture1.Picture = LoadPicture()
         
        '
            Dim Paint As String
    
        If Not (rs.BOF Or rs.EOF) Then
            
            Text5.Text = rs!slocation
        '
        ' Check text5 for sName of image
        ' Display the image located in [Paint Path]
        '
        Dim AppPath$
        If Right(App.Path, 1) <> "\" Then _
            AppPath = App.Path & "\" _
        Else AppPath = App.Path
           
           Paint = AppPath & rs!slocation
           
        '
            If Len(Text5.Text) > 0 Then
                Picture1.Picture = LoadPicture(Paint)
                Picture1.Left = (frmImage.Width / 2) - (Picture1.Width / 2)
                Picture1.Top = (frmImage.Height / 2) - (Picture1.Height / 2)
            Else
                Picture1.Cls
                Picture1.Print "No Image"
            End If
                End If
    
        '
        End Sub
        Private Sub checkbtns()
        '
        ' Check for button positions
        '
            rs.MovePrevious
            cmdPrevious.Enabled = Not (rs.BOF)
            rs.MoveNext
        '
            rs.MoveNext
            cmdNext.Enabled = Not (rs.EOF)
            rs.MovePrevious
        '
        End Sub
    "A myth is not the succession of individual images,
    but an integerated meaningful entity,
    reflecting a distinct aspect of the real world."

    ___ Adolf Jensen

  6. #6
    Guest

    Thanx for all the help

    thanx for all teh help ill try it out soon and if nothing well then ill get back to ya
    thanx!!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width