📄 tableobj.frm
字号:
VERSION 5.00
Begin VB.Form frmTableObj
Caption = "表对象"
ClientHeight = 3495
ClientLeft = 1335
ClientTop = 2625
ClientWidth = 5625
HelpContextID = 2016145
Icon = "TABLEOBJ.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 3480
ScaleMode = 0 'User
ScaleWidth = 5639.102
ShowInTaskbar = 0 'False
Tag = "Recordset"
Begin VB.PictureBox picViewButtons
Align = 1 'Align Top
Appearance = 0 'Flat
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 705
Left = 0
ScaleHeight = 705
ScaleMode = 0 'User
ScaleWidth = 5622.27
TabIndex = 1
TabStop = 0 'False
Top = 0
Width = 5625
Begin VB.ComboBox cboIndexes
Height = 300
Left = 720
Style = 2 'Dropdown List
TabIndex = 8
Top = 360
Width = 4695
End
Begin VB.CommandButton cmdSeek
Caption = "搜索(&S)"
Height = 330
Left = 2835
TabIndex = 5
Top = 0
Width = 900
End
Begin VB.CommandButton cmdFilter
Caption = "过滤器(&I)"
Height = 330
Left = 3720
TabIndex = 6
Top = 0
Width = 1020
End
Begin VB.CommandButton cmdClose
Cancel = -1 'True
Caption = "关闭(&C)"
Height = 330
Left = 4680
TabIndex = 7
TabStop = 0 'False
Top = 0
Width = 900
End
Begin VB.CommandButton cmdDelete
Caption = "删除(&D)"
Height = 330
Left = 1935
TabIndex = 4
Top = 0
Width = 900
End
Begin VB.CommandButton cmdEdit
Caption = "编辑(&E)"
Height = 330
Left = 1020
TabIndex = 3
Top = 0
Width = 900
End
Begin VB.CommandButton cmdAdd
Caption = "添加(&A)"
Height = 330
Left = 0
TabIndex = 2
Top = 0
Width = 1020
End
Begin VB.Label lblIndex
Caption = "索引："
Height = 255
Left = 120
TabIndex = 24
Top = 400
Width = 615
End
End
Begin VB.PictureBox picFieldHeader
Appearance = 0 'Flat
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 240
Left = 0
ScaleHeight = 240
ScaleMode = 0 'User
ScaleWidth = 14948.92
TabIndex = 21
Top = 705
Width = 14946
Begin VB.Label lblFieldValue
Caption = " 值 (F4=缩放) "
Height = 255
Left = 1680
TabIndex = 23
Top = 0
Width = 3165
End
Begin VB.Label lblFieldHdr
Caption = "字段名称："
Height = 252
Left = 120
TabIndex = 22
Top = 0
Width = 1212
End
End
Begin VB.PictureBox picChangeButtons
BorderStyle = 0 'None
Height = 690
Left = 0
ScaleHeight = 690
ScaleMode = 0 'User
ScaleWidth = 5658.375
TabIndex = 13
TabStop = 0 'False
Top = 0
Visible = 0 'False
Width = 5655
Begin VB.CommandButton cmdUpdate
Caption = "更新(&U)"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 960
TabIndex = 15
Top = 48
Width = 1212
End
Begin VB.CommandButton cmdCancel
Caption = "取消(&C)"
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 2640
TabIndex = 14
Top = 48
Width = 1212
End
End
Begin VB.PictureBox picStatBox
Align = 2 'Align Bottom
Appearance = 0 'Flat
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 285
Left = 0
ScaleHeight = 298.153
ScaleMode = 0 'User
ScaleWidth = 5629.041
TabIndex = 19
TabStop = 0 'False
Top = 3204
Width = 5625
Begin VB.CommandButton cmdNext
Caption = ">"
Height = 287
Left = 4200
TabIndex = 11
Top = 0
Width = 375
End
Begin VB.CommandButton cmdLast
Caption = ">|"
Height = 287
Left = 4575
TabIndex = 12
Top = 0
Width = 375
End
Begin VB.CommandButton cmdFirst
Caption = "|<"
Height = 287
Left = 0
TabIndex = 9
Top = 0
Width = 375
End
Begin VB.CommandButton cmdPrevious
Caption = "<"
Height = 287
Left = 375
TabIndex = 10
Top = 0
Width = 375
End
Begin VB.Label lblStatus
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 735
TabIndex = 20
Top = 0
Width = 3360
End
End
Begin VB.VScrollBar vsbScrollBar
Height = 2616
LargeChange = 3000
Left = 5160
SmallChange = 300
TabIndex = 18
Top = 960
Visible = 0 'False
Width = 252
End
Begin VB.PictureBox picFields
Appearance = 0 'Flat
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Left = 120
ScaleHeight = 372
ScaleMode = 0 'User
ScaleWidth = 4812
TabIndex = 16
TabStop = 0 'False
Top = 960
Width = 4815
Begin VB.TextBox txtFieldData
DataSource = "Data1"
ForeColor = &H00000000&
Height = 288
Index = 0
Left = 1560
TabIndex = 0
Top = 0
Visible = 0 'False
Width = 3252
End
Begin VB.Label lblFieldName
Height = 252
Index = 0
Left = 0
TabIndex = 17
Top = 60
Visible = 0 'False
Width = 1572
End
End
End
Attribute VB_Name = "frmTableObj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
Const BUTTON1 = "添加(&A)"
Const BUTTON2 = "编辑(&E)"
Const BUTTON3 = "删除(&D)"
Const BUTTON4 = "关闭(&C)"
Const BUTTON5 = "搜索(&S)"
Const BUTTON6 = "过滤器(&I)"
Const BUTTON7 = "取消(&C)"
Const BUTTON8 = "更新(&U)"
Const Label1 = "字段名称："
Const Label2 = "值（F4=缩放）"
Const MSG1 = "添加记录"
Const MSG2 = "字段超长，数据被截断！"
Const MSG3 = "删除当前记录吗？"
Const MSG4 = "编辑记录"
Const MSG5 = "输入过滤器表达式："
Const MSG6 = "正在打开表"
Const MSG7 = "正在改变窗体尺寸"
Const MSG8 = "输入搜索参数"
Const MSG9 = "未找到记录"
'>>>>>>>>>>>>>>>>>>>>>>>>
'窗体变量
Public mrsFormRecordset As Recordset
Dim msTableName As String '窗体记录集表名称
Dim mvBookMark As Variant '窗体书签
Dim mbEditFlag As Integer '编辑模式
Dim mbAddNewFlag As Integer '添加模式
Dim mbDataChanged As Integer
Dim mlNumRows As Long '表中的总行数
Private Sub cmdAdd_Click()
On Error GoTo AddErr
'设置模式
mrsFormRecordset.AddNew
lblStatus.Caption = MSG1
mbAddNewFlag = True
If mrsFormRecordset.RecordCount > 0 Then
mvBookMark = mrsFormRecordset.Bookmark
Else
mvBookMark = vbNullString
End If
picChangeButtons.Visible = True
picViewButtons.Visible = False
cmdNext.Enabled = False
cmdFirst.Enabled = False
cmdLast.Enabled = False
cmdPrevious.Enabled = False
ClearDataFields Me, mrsFormRecordset.Fields.Count
txtFieldData(0).SetFocus
Exit Sub
AddErr:
ShowError
End Sub
Private Sub cmdCancel_Click()
On Error Resume Next
picChangeButtons.Visible = False
picViewButtons.Visible = True
cmdNext.Enabled = True
cmdFirst.Enabled = True
cmdLast.Enabled = True
cmdPrevious.Enabled = True
mbEditFlag = False
mbAddNewFlag = False
If Len(mvBookMark) > 0 Then mrsFormRecordset.Bookmark = mvBookMark
DisplayCurrentRecord Me, mrsFormRecordset, mlNumRows, mbAddNewFlag
mbDataChanged = False
DBEngine.Idle dbFreeLocks
End Sub
Private Sub txtFieldData_Change(Index As Integer)
'数据改变后就设置标志
'新记录显示后，重新设置为 false
mbDataChanged = True
End Sub
Private Sub txtFieldData_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = &H73 Then 'F4
lblFieldName_DblClick Index
ElseIf KeyCode = 34 And vsbScrollBar.Visible Then
'向下翻大于 10 字段
vsbScrollBar.Value = vsbScrollBar.Value - 3000
ElseIf KeyCode = 33 And vsbScrollBar.Visible Then
'向上翻大于 10 字段
vsbScrollBar.Value = vsbScrollBar.Value + 3000
End If
End Sub
Private Sub txtFieldData_KeyPress(Index As Integer, KeyAscii As Integer)
'仅在添加模式的编辑中允许返回
If mbEditFlag Or mbAddNewFlag Then
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{Tab}"
End If
'如果不在添加或编辑模式，忽略按键
ElseIf mbEditFlag = False And mbAddNewFlag = False Then
KeyAscii = 0
End If
End Sub
Private Sub txtFieldData_LostFocus(Index As Integer)
On Error GoTo FldDataErr
If mbDataChanged Then
'在字段中存储数据
mrsFormRecordset(Index) = txtFieldData(Index)
End If
'有效或错误情况下重新设置
mbDataChanged = False
Exit Sub
FldDataErr:
ShowError
mbDataChanged = False
End Sub
Private Sub lblFieldName_DblClick(Index As Integer)
On Error GoTo ZoomErr
If mrsFormRecordset(Index).Type = dbText Or mrsFormRecordset(Index).Type = dbMemo Then
If mrsFormRecordset(Index).Type = dbText Then
gsZoomData = txtFieldData(Index).Text
ElseIf mrsFormRecordset(Index).FieldSize() < gnGETCHUNK_CUTOFF Then
gsZoomData = txtFieldData(Index).Text
Else
'用 getchunk 添加其他的字段数据
MsgBar "正在获得 Memo 字段数据", True
Screen.MousePointer = vbHourglass
gsZoomData = txtFieldData(Index).Text & StripNonAscii(mrsFormRecordset(Index).GetChunk(gnGETCHUNK_CUTOFF, gnMAX_MEMO_SIZE))
Screen.MousePointer = vbDefault
MsgBar vbNullString, False
End If
frmZoom.Caption = Mid(lblFieldName(Index).Caption, 1, Len(lblFieldName(Index).Caption) - 1)
frmZoom.Top = Top + 1200
frmZoom.Left = Left + 250
If mbAddNewFlag Or mbEditFlag Then
frmZoom.cmdSave.Visible = True
frmZoom.cmdCloseNoSave.Visible = True
Else
frmZoom.cmdClose.Visible = True
End If
If mrsFormRecordset(Index).Type = dbText Then
frmZoom.txtZoomData.Text = gsZoomData
frmZoom.Height = 1125
Else
frmZoom.txtMemo.Text = gsZoomData
frmZoom.txtMemo.Visible = True
frmZoom.txtZoomData.Visible = False
frmZoom.Height = 2205
End If
frmZoom.Show vbModal
If (mbAddNewFlag Or mbEditFlag) And gsZoomData <> "__CANCELLED__" Then
If mrsFormRecordset(Index).Type = dbText And Len(gsZoomData) > mrsFormRecordset(Index).Size Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -