VERSION 5.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
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   5340
   ScaleWidth      =   6045
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdBrowse 
      Caption         =   "..."
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         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"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         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         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游標
      DefaultType     =   2  '使用 ODBC
      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_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const vbDBName As Byte = 1
Private Const vbPicture As Byte = 2
Private bDirty(1 To 2) As Boolean

Private 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 If

End Sub
Private Sub cmdBrowse_Click(Index As Integer)

    ' Display OpenFile dialog and allow user to
    ' select database or picture file

    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 Select

End 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
    Next

End 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 If

End Sub
Private Sub cmdNew_Click()

    If cmdNew.Caption = "&Update" Then
        datCtl.Recordset.Update
        datCtl.Recordset.Bookmark = datCtl.Recordset.LastModified
    Else
        datCtl.Recordset.AddNew
        If txtPicFile.Enabled = False Then
            Call EnablePicField
        End If
        datCtl.Caption = "[New Record]"
        cmdNew.Caption = "&Update"
    End If

End Sub
Private Sub datCtl_Error(DataErr As Integer, Response As Integer)

    ' Invalid Picture
    If DataErr = 481 Then
        Response = vbDataErrContinue
    End If

End 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 If

End 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) = False

End Sub
Private Sub datCtl_Validate(Action As Integer, Save As Integer)

    cmdNew.Caption = "&New Record"
    txtPicFile = ""
    bDirty(vbPicture) = False

End Sub
Private Sub txtDBName_Change()

    bDirty(vbDBName) = True

End Sub
Private Sub txtDBName_LostFocus()

    If bDirty(vbDBName) Then
        Call DBOpen
    End If

End 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 If

End Sub
Private Sub txtPicFile_LostFocus()

    If Len(txtPicFile) Then
        If bDirty(vbPicture) Then
            imgPreview.Picture = LoadPicture(txtPicFile)
            bDirty(vbPicture) = False
        End If
    End If

End Sub
Sub DisablePicField()

    With txtPicFile
        .Enabled = False
        .BackColor = vbButtonFace
    End With
    cmdBrowse(1).Enabled = False

End Sub
Sub EnablePicField()

    With txtPicFile
        .Enabled = True
        .BackColor = vbWindowBackground
        .Text = ""
    End With
    cmdBrowse(1).Enabled = True
    bDirty(vbPicture) = False

End Sub