一个例子:
openfile.bas
Attribute VB_Name = "OpenFileDlg"
Option Explicit
Private Type OPENFILENAME
    lStructSize     As Long
    hWndOwner       As Long
    hInstance       As Long
    lpstrFilter     As String
    lpstrCusFilter  As String
    nMaxCustFilter  As Long
    nFilterIndex    As Long
    lpstrFile       As String
    nMaxFile        As Long
    lpstrFileTitle  As String
    nMaxFileTitle   As Long
    lpstrInitialDir As String
    lpstrTitle      As String
    Flags           As Long
    nFileOffset     As Integer
    nFileExtension  As Integer
    lpstrDefExt     As String
    lCustData       As Long
    lpfnHook        As Long
    lpTemplateName  As String
End Type
Private OFN As OPENFILENAME
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (lpOFN As OPENFILENAME) As Long
Private Declare Function VarPtr Lib "VB40032.DLL" (lpVar As Any) As LongPublic hWndOwner As Long
Public FileName As String
Public Filter As String
Public Title As StringSub Show()    Dim iNull As Integer
    Dim sFilter As String
    Dim sNull As String
    Dim sTitle As String
    Dim sFileName As String * 1024
    
    LSet sFileName = FileName & vbNullChar
    With OFN
        .lStructSize = Len(OFN)
        .hWndOwner = hWndOwner
        .lpstrFilter = Filter
        .lpstrFile = sFileName
        .nMaxFile = Len(sFileName)
        .lpstrTitle = Title
        .Flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
    End With    If GetOpenFileName(OFN) Then
        iNull = InStr(OFN.lpstrFile, vbNullChar)
        If iNull Then
            FileName = Left$(OFN.lpstrFile, iNull - 1)
        Else
            FileName = OFN.lpstrFile
        End If
    Else
        FileName = ""
    End IfEnd Sub
下面还有:

解决方案 »

  1.   

    main.frmVERSION 4.00
    Begin VB.Form frmMain 
       AutoRedraw      =   -1  'True
       BorderStyle     =   3  'Fixed Dialog
       Caption         =   "Q&A Database Picture Editor"
       ClientHeight    =   5340
       ClientLeft      =   1755
       ClientTop       =   975
       ClientWidth     =   6045
       ClipControls    =   0   'False
       Height          =   5745
       Left            =   1695
       LinkTopic       =   "Form1"
       LockControls    =   -1  'True
       MaxButton       =   0   'False
       MinButton       =   0   'False
       ScaleHeight     =   5340
       ScaleWidth      =   6045
       ShowInTaskbar   =   0   'False
       Top             =   630
       Width           =   6165
       Begin VB.CommandButton cmdBrowse 
          Caption         =   "..."
          Enabled         =   0   'False
          BeginProperty Font 
             name            =   "Arial"
             charset         =   0
             weight          =   700
             size            =   8.25
             underline       =   0   'False
             italic          =   0   'False
             strikethrough   =   0   'False
          EndProperty
          Height          =   260
          Index           =   1
          Left            =   4230
          TabIndex        =   7
          TabStop         =   0   'False
          Top             =   1590
          Width           =   260
       End
       Begin VB.CommandButton cmdCancel 
          Cancel          =   -1  'True
          Caption         =   "Cancel"
          Enabled         =   0   'False
          Height          =   375
          Left            =   4680
          TabIndex        =   9
          Top             =   805
          Width           =   1200
       End
       Begin VB.CommandButton cmdBrowse 
          Caption         =   "..."
          BeginProperty Font 
             name            =   "Arial"
             charset         =   0
             weight          =   700
             size            =   8.25
             underline       =   0   'False
             italic          =   0   'False
             strikethrough   =   0   'False
          EndProperty
          Height          =   260
          Index           =   0
          Left            =   4230
          TabIndex        =   2
          TabStop         =   0   'False
          Top             =   390
          Width           =   260
       End
       Begin VB.CommandButton cmdNew 
          Caption         =   "&New Record"
          Enabled         =   0   'False
          Height          =   375
          Left            =   4680
          TabIndex        =   8
          Top             =   360
          Width           =   1200
       End
       Begin VB.Data datCtl 
          Connect         =   ""
          DatabaseName    =   ""
          Exclusive       =   0   'False
          Height          =   300
          Left            =   120
          Options         =   0
          ReadOnly        =   0   'False
          RecordsetType   =   1  'Dynaset
          RecordSource    =   ""
          Top             =   4920
          Width           =   4395
       End
       Begin VB.ComboBox cboField 
          Height          =   315
          Left            =   120
          Style           =   2  'Dropdown List
          TabIndex        =   4
          Top             =   960
          Width           =   4395
       End
       Begin VB.TextBox txtDBName 
          Height          =   315
          Left            =   120
          TabIndex        =   1
          Top             =   360
          Width           =   4395
       End
       Begin VB.TextBox txtPicFile 
          BackColor       =   &H8000000F&
          Enabled         =   0   'False
          Height          =   315
          Left            =   120
          TabIndex        =   6
          Top             =   1560
          Width           =   4395
       End
       Begin VB.Label lblPicture 
          AutoSize        =   -1  'True
          Caption         =   "Picture &File:"
          Height          =   195
          Left            =   120
          TabIndex        =   5
          Top             =   1320
          Width           =   825
       End
       Begin VB.Image imgPreview 
          BorderStyle     =   1  'Fixed Single
          DataSource      =   "datCtl"
          Height          =   2895
          Left            =   120
          Stretch         =   -1  'True
          Top             =   1950
          Width           =   4395
       End
       Begin VB.Label lblField 
          AutoSize        =   -1  'True
          Caption         =   "&Picture Field:"
          Height          =   195
          Left            =   120
          TabIndex        =   3
          Top             =   720
          Width           =   915
       End
       Begin VB.Label lblDBName 
          AutoSize        =   -1  'True
          Caption         =   "&Database Name:"
          Height          =   195
          Left            =   120
          TabIndex        =   0
          Top             =   120
          Width           =   1200
       End
    End
    Attribute VB_Name = "frmMain"
    Attribute VB_Creatable = False
    Attribute VB_Exposed = False
    Option Explicit
    Private Const vbDBName As Byte = 1
    Private Const vbPicture As Byte = 2
    Private bDirty(1 To 2) As BooleanPrivate Sub cboField_Click()    Dim iPeriod As Integer
        Dim sField As String
        Dim sTable As String    iPeriod = InStr(cboField, ".")
        If iPeriod Then
            ' Separate combo box item into table
            ' and field names; remove brackets
            sTable = Left$(cboField, iPeriod - 1)
            If Left$(sTable, 1) = "[" Then
                sTable = Mid$(sTable, 2, Len(sTable) - 2)
            End If
            sField = Mid$(cboField, iPeriod + 1)
            If Left$(sField, 1) = "[" Then
                sField = Mid$(sField, 2, Len(sField) - 2)
            End If
            ' Assign data control's RecordSource
            ' to selected table; bind image control
            ' to selected field
            datCtl.RecordSource = sTable
            imgPreview.DataField = sField
            cmdNew.Enabled = True
            cmdCancel.Enabled = True
            datCtl.Refresh
        End IfEnd Sub
    Private Sub cmdBrowse_Click(Index As Integer)    ' Display OpenFile dialog and allow user to
        ' select database or picture file    还有
      

  2.   

    Dim sFilter As String    OpenFileDlg.hWndOwner = Me.hWnd
        Select Case Index
            Case 0
                txtDBName.SetFocus
                OpenFileDlg.Title = "Select Database"
                sFilter = "Microsoft Access Databases" & vbNullChar & "*.MDB" & vbNullChar
                sFilter = sFilter & "All Files" & vbNullChar & "*.*" & String$(2, 0)
                OpenFileDlg.Filter = sFilter
                OpenFileDlg.FileName = ""
                OpenFileDlg.Show
                If Len(OpenFileDlg.FileName) Then
                    txtDBName = OpenFileDlg.FileName
                    Call DBOpen
                End If
            Case 1
                txtPicFile.SetFocus
                OpenFileDlg.Title = "Select Picture"
                sFilter = "Picture Files" & vbNullChar & "*.BMP;*.ICO;*.RLE;*.WMF" & vbNullChar
                sFilter = sFilter & "All Files" & vbNullChar & "*.*" & String$(2, 0)
                OpenFileDlg.Filter = sFilter
                OpenFileDlg.FileName = ""
                OpenFileDlg.Show
                If Len(OpenFileDlg.FileName) Then
                    txtPicFile = OpenFileDlg.FileName
                    imgPreview.Picture = LoadPicture(txtPicFile)
                    bDirty(vbPicture) = False
                End If
        End SelectEnd Sub
    Private Sub PopulateCombo(db As Database)    ' Populates cboField with names of Long Binary
        ' fields (and the tables containing them) in the
        ' current database.    Dim fld As Field
        Dim tbl As TableDef
        Dim sField As String
        Dim sTable As String
        Const vbSpace As String = " "    cboField.Clear
        For Each tbl In db.TableDefs
            sTable = tbl.Name
            If Left$(sTable, 4) <> "MSys" Then
                For Each fld In tbl.Fields
                    If fld.Type = dbLongBinary Then
                        sField = fld.Name
                        If InStr(sField, vbSpace) Then
                            sField = "[" & sField & "]"
                        End If
                        If InStr(sTable, vbSpace) Then
                            sTable = "[" & sTable & "]"
                        End If
                        cboField.AddItem sTable & "." & sField
                    End If
                Next
            End If
        NextEnd Sub
    Private Sub cmdCancel_Click()    txtPicFile = ""
        bDirty(vbPicture) = False
        cmdNew.Caption = "&New Record"    If datCtl.Recordset.RecordCount = 0 Then
            datCtl.Caption = ""
            Call DisablePicField
        Else
            datCtl.Recordset.MoveFirst
            datCtl.UpdateControls
        End IfEnd Sub
    Private Sub cmdNew_Click()    If cmdNew.Caption = "&Update" Then
            datCtl.Recordset.Update
            datCtl.Recordset.Book = datCtl.Recordset.LastModified
        Else
            datCtl.Recordset.AddNew
            If txtPicFile.Enabled = False Then
                Call EnablePicField
            End If
            datCtl.Caption = "[New Record]"
            cmdNew.Caption = "&Update"
        End IfEnd Sub
    Private Sub datCtl_Error(DataErr As Integer, Response As Integer)    ' Invalid Picture
        If DataErr = 481 Then
            Response = vbDataErrContinue
        End IfEnd Sub
    Private Sub datCtl_Reposition()    Dim lRec As Long    lRec = datCtl.Recordset.AbsolutePosition
        If lRec >= 0 Then
            datCtl.Caption = "Record " & CStr(lRec + 1)
            If txtPicFile.Enabled = False Then
                Call EnablePicField
            End If
        End IfEnd Sub
    Sub DBOpen()    If Len(txtDBName) Then
            Me.MousePointer = vbHourglass
            If Not (datCtl.Database Is Nothing) Then
                datCtl.Caption = ""
                datCtl.Database.Close
                txtPicFile = ""
                bDirty(vbPicture) = False
                Call DisablePicField
                imgPreview.Picture = LoadPicture()
                cmdNew.Caption = "&New Record"
                cmdNew.Enabled = False
            End If
            datCtl.DatabaseName = txtDBName
            datCtl.RecordSource = ""
            datCtl.Refresh
            Call PopulateCombo(datCtl.Database)
            Me.MousePointer = vbDefault
        End If
        bDirty(vbDBName) = FalseEnd Sub
    Private Sub datCtl_Validate(Action As Integer, Save As Integer)    cmdNew.Caption = "&New Record"
        txtPicFile = ""
        bDirty(vbPicture) = FalseEnd Sub
    Private Sub txtDBName_Change()    bDirty(vbDBName) = TrueEnd Sub
    Private Sub txtDBName_LostFocus()    If bDirty(vbDBName) Then
            Call DBOpen
        End IfEnd Sub
    Private Sub txtPicFile_Change()    If Len(txtPicFile) Then
            bDirty(vbPicture) = True
            If datCtl.Recordset.EditMode = dbEditNone Then
                datCtl.Recordset.Edit
                cmdNew.Caption = "&Update"
            End If
        End IfEnd Sub
    Private Sub txtPicFile_LostFocus()    If Len(txtPicFile) Then
            If bDirty(vbPicture) Then
                imgPreview.Picture = LoadPicture(txtPicFile)
                bDirty(vbPicture) = False
            End If
        End IfEnd Sub
    Sub DisablePicField()    With txtPicFile
            .Enabled = False
            .BackColor = vbButtonFace
        End With
        cmdBrowse(1).Enabled = FalseEnd Sub
    Sub EnablePicField()    With txtPicFile
            .Enabled = True
            .BackColor = vbWindowBackground
            .Text = ""
        End With
        cmdBrowse(1).Enabled = True
        bDirty(vbPicture) = FalseEnd Sub
      

  3.   

    不用这么长的,你把你的信箱给我,我给你发过去!
    [email protected]
      

  4.   

    http://www.dapha.net/vb/list.asp?id=1342
      

  5.   

    其实很简单.注意以下几点:
    1.access中存放图片的字段数据类型设为ole对象;
    2.在form中使用image控件,并将其余相应的data控件关联;
    3.使用image.picture=loadpicture(filename)即可.
    如需要源码,告诉我你的邮件地址,发给你.
    ^_^