frmdb.frm

管理电子相片 可以进行上传 评价 浏览 等操作

VERSION 5.00
Begin VB.Form frmDB 
   BorderStyle     =   0  'None
   ClientHeight    =   1200
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1920
   ControlBox      =   0   'False
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1200
   ScaleWidth      =   1920
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.FileListBox MDBs 
      Appearance      =   0  'Flat
      Height          =   1200
      Left            =   0
      MouseIcon       =   "frmDB.frx":0000
      MousePointer    =   99  'Custom
      Pattern         =   "*.mdb"
      TabIndex        =   0
      Top             =   0
      Width           =   1920
   End
End
Attribute VB_Name = "frmDB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Public CancelDBSelection As Boolean



Private Sub Form_Load()

    '-- 获得默认的数据库[Thumbs.mdb]
    MDBs.Path = App.Path
    
    On Error GoTo errDB
    MDBs.ListIndex = 0
    Exit Sub
     '-- 出现"没有发现数据库 :"提示框
errDB:
    MsgBox "没有发现数据库 :" & vbCrLf & vbCrLf & "Check Database/s path : Thumb DB app. path", vbCritical, "Getting DB"
    '-- 卸载主窗体
Unload frmMain
End Sub

Private Sub MDBs_Click()
    
  Dim mdbPath As String

    '-- 选择数据库，刷新数据源
    mdbPath = App.Path & "\" & MDBs.FileName
    
    frmMain.DataCategories.DatabaseName = mdbPath
    '-- 从tblCategories表中选择分类信息并按照分类编号排序
    frmMain.DataCategories.RecordSource = "Select * from tblCategories order by len([IDCat]), [Category]"
    frmMain.DataPictures.DatabaseName = mdbPath
    frmMain.DataCopy.DatabaseName = mdbPath
    '-- 从tblCategories表中选择图片编号等于“-1”的图片信息
    frmMain.DataCopy.RecordSource = "Select * from tblPictures where [IDPict] = -1"
    
    frmAddtoDB.DataPictures.DatabaseName = mdbPath

    CancelDBSelection = False
    Me.Hide
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If (KeyCode = 27) Then
        CancelDBSelection = True
        Me.Hide
    End If
End Sub