📄 frmdataconn.frm
字号:
TabIndex = 2
Top = 570
Width = 6195
End
Begin VB.Line Line3
BorderColor = &H8000000C&
BorderWidth = 2
X1 = 1620
X2 = 780
Y1 = 1860
Y2 = 1860
End
Begin VB.Line Line2
BorderColor = &H8000000C&
BorderWidth = 2
X1 = 780
X2 = 780
Y1 = 1440
Y2 = 1860
End
Begin VB.Line Line1
BorderColor = &H80000010&
Index = 3
X1 = 180
X2 = 6350
Y1 = 2640
Y2 = 2640
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
Index = 2
X1 = 180
X2 = 6350
Y1 = 2655
Y2 = 2655
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
Index = 1
X1 = 180
X2 = 6350
Y1 = 5115
Y2 = 5115
End
Begin VB.Line Line1
BorderColor = &H80000010&
Index = 0
X1 = 180
X2 = 6350
Y1 = 5100
Y2 = 5100
End
Begin VB.Label lblSelPath
BackColor = &H8000000B&
Caption = "Select folder path"
Height = 255
Left = 180
TabIndex = 46
Top = 6480
Width = 1335
End
Begin VB.Label lblFooter
Alignment = 2 'Center
BackColor = &H8000000B&
Caption = "Footer"
Enabled = 0 'False
Height = 195
Left = 5040
TabIndex = 44
Top = 3135
Width = 615
WordWrap = -1 'True
End
Begin VB.Label lblHeader
Alignment = 2 'Center
BackColor = &H8000000B&
Caption = "Header"
Enabled = 0 'False
Height = 195
Left = 4400
TabIndex = 40
Top = 3135
Width = 615
WordWrap = -1 'True
End
Begin VB.Label lblOR
Alignment = 2 'Center
BackColor = &H8000000B&
Caption = "OR"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 180
TabIndex = 36
Top = 7200
Width = 375
End
Begin VB.Label lblImagePathHead
BackColor = &H8000000B&
Caption = "Image Folder Path stored in Database"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 255
Left = 180
TabIndex = 34
Top = 5700
Width = 3315
End
Begin VB.Label lblSortHead
BackColor = &H8000000B&
Caption = "Select sorting and grouping (optional)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 180
TabIndex = 33
Top = 2820
Width = 3375
End
Begin VB.Image Image2
Height = 240
Left = 3960
Picture = "frmDataConn.frx":058A
Top = 3135
Width = 240
End
Begin VB.Image Image1
Height = 240
Left = 3510
Picture = "frmDataConn.frx":0B14
Top = 3135
Width = 240
End
Begin VB.Label lblImgField
BackColor = &H8000000B&
Caption = "Field:"
Height = 240
Left = 2850
TabIndex = 26
Top = 5940
Width = 1065
End
Begin VB.Label lblImgTable
BackColor = &H8000000B&
Caption = "Table:"
Height = 285
Left = 210
TabIndex = 25
Top = 5940
Width = 1170
End
Begin VB.Label lblImgPath
BackColor = &H8000000B&
Caption = "Image Folder path:"
Height = 285
Left = 180
TabIndex = 24
Top = 7680
Width = 1410
End
Begin VB.Label lbl3rd
BackStyle = 0 'Transparent
Caption = "3rd"
Enabled = 0 'False
Height = 225
Left = 450
TabIndex = 22
Top = 4485
Width = 315
End
Begin VB.Label lbl2nd
BackStyle = 0 'Transparent
Caption = "2nd"
Enabled = 0 'False
Height = 285
Left = 420
TabIndex = 21
Top = 3975
Width = 375
End
Begin VB.Label lbl1st
BackStyle = 0 'Transparent
Caption = "1st"
Enabled = 0 'False
Height = 225
Left = 450
TabIndex = 20
Top = 3495
Width = 315
End
Begin VB.Label lblSortField
Alignment = 2 'Center
BackColor = &H8000000B&
Caption = "Select sort field(s)"
Enabled = 0 'False
Height = 240
Left = 840
TabIndex = 19
Top = 3195
Width = 2055
End
Begin VB.Label lblConnStatus
BackColor = &H8000000B&
Height = 255
Left = 1560
TabIndex = 18
Top = 945
Width = 4845
End
Begin VB.Label lblTable
BackColor = &H8000000B&
Caption = "Select an existing Table / Query :"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Index = 0
Left = 1740
TabIndex = 17
Top = 1440
Width = 2925
End
Begin VB.Label lblDbFile
BackColor = &H8000000B&
Caption = "Database file to connect to (currently MS Access only)"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 180
TabIndex = 1
Top = 300
Width = 4725
End
End
Attribute VB_Name = "frmDataConn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim TableIndex As Integer
Dim TablesPerSection(2) As Integer
Dim strSort As String
Dim rstImage As ADODB.Recordset
Dim strOldDataFileName As String
Dim strOldTableName As String
Dim blnConnected As Boolean
Dim blnViewingData As Boolean
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'// BrowseForFolder constants
Private Const BIF_RETURNONLYFSDIRS = &H1
'// BrowseForFolders APIs
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLIST
'// Frees memory allocated by the OLE (shell's) task allocator.
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Function BrowseFolder(hwnd As Long, szDialogTitle As String) As String
'displays the default Windows folder browser dialog
Dim bi As BROWSEINFO
Dim dwIList As Long
Dim szPath As String * 260
bi.hOwner = hwnd
bi.lpszTitle = szDialogTitle
bi.ulFlags = BIF_RETURNONLYFSDIRS
dwIList = SHBrowseForFolder(bi)
If dwIList Then
If SHGetPathFromIDList(dwIList, szPath) Then
BrowseFolder = Left$(szPath, InStr(szPath, vbNullChar) - 1)
End If
' Free the memory the shell allocated for the pidl.
Call CoTaskMemFree(dwIList)
End If
End Function
Private Sub cboFields_Click(Index As Integer)
'fired when user clicks on the combo box to select a field name from the list
Dim i As Integer, j As Integer
If Index = 3 Then 'this is the image folder field name combo box
For i = 0 To rstImage.Fields.count - 1
If rstImage.Fields(i).Name = cboFields(3) Then
If InStr(1, rstImage.Fields(i).value, "\") = 0 Then
Me.txtPicFolder = "Field does not contain a valid path!"
Else
Me.cboFolderPath.Clear
If rstImage.RecordCount > 0 Then
For j = 0 To rstImage.RecordCount - 1
If Not IsNull(rstImage.Fields(i).value) Then
Me.cboFolderPath.AddItem rstImage.Fields(i).value
End If
rstImage.MoveNext
Next j
End If
End If
Exit For
End If
Next i
Else
If cboFields(Index) > "" Then
Me.FraOrder(Index).Enabled = True
Me.chkGrpHVis(Index).Enabled = True
Me.chkGrpFVis(Index).Enabled = True
End If
End If
End Sub
Private Sub cboFolderPath_Click()
If cboFolderPath > "" Then
txtPicFolder = cboFolderPath
strImageFolder = cboFolderPath
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -