📄 frmremarkcard.frm
字号:
VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.4#0"; "ATLEDIT1.OCX"
Begin VB.Form frmRemarkCard
BorderStyle = 3 'Fixed Dialog
Caption = "新增摘要"
ClientHeight = 3015
ClientLeft = 45
ClientTop = 330
ClientWidth = 6105
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3015
ScaleWidth = 6105
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.ListBox lstRemark
Height = 1500
ItemData = "frmRemarkCard.frx":0000
Left = 1440
List = "frmRemarkCard.frx":001C
TabIndex = 5
Top = 1320
Width = 1680
End
Begin VB.CommandButton cmdRemark
Caption = "添加(&I)"
Height = 350
Index = 0
Left = 3255
TabIndex = 6
Top = 1320
Width = 1215
End
Begin VB.CommandButton cmdRemark
Caption = "清除(&D)"
Height = 350
Index = 1
Left = 3270
TabIndex = 7
Top = 1710
Width = 1215
End
Begin AtlEdit.TEdit txtInput
Height = 315
Index = 0
Left = 1440
TabIndex = 1
Top = 300
Width = 3045
_ExtentX = 5371
_ExtentY = 556
maxchar = 8
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Text = ""
End
Begin VB.CommandButton cmdOKCancel
Height = 350
Index = 2
Left = 4680
Style = 1 'Graphical
TabIndex = 10
Tag = "1009"
Top = 990
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOKCancel
Height = 350
Index = 0
Left = 4680
Style = 1 'Graphical
TabIndex = 8
Tag = "1001"
Top = 120
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOKCancel
Cancel = -1 'True
Height = 350
Index = 1
Left = 4680
Style = 1 'Graphical
TabIndex = 9
Tag = "1002"
Top = 555
UseMaskColor = -1 'True
Width = 1215
End
Begin AtlEdit.TEdit txtInput
Height = 315
Index = 1
Left = 1440
TabIndex = 3
Top = 810
Width = 3045
_ExtentX = 5371
_ExtentY = 556
maxchar = 40
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Text = ""
End
Begin VB.Label lblContent
Caption = "变动内容(&V)"
Height = 195
Index = 1
Left = 360
TabIndex = 4
Top = 1320
Width = 1035
End
Begin VB.Label lblCode
Caption = "摘要编码(&C)"
Height = 225
Left = 390
TabIndex = 0
Top = 360
Width = 1005
End
Begin VB.Label lblContent
Caption = "摘要内容(&N)"
Height = 195
Index = 0
Left = 360
TabIndex = 2
Top = 870
Width = 1035
End
End
Attribute VB_Name = "frmRemarkCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 摘要卡片
' 作者：郑权
' 日期：1998.07.25
'
' 功能：完成摘要表的增、删、改操作
'
' 接口： AddCard 增加摘要记录。
' 参数：intModal 显示模式，strName 用户输入值
' EditCard 修改摘要记录。
' 参数： lngRecordID 被修改的记录的ID，intModal 显示模式
' DelCard 删除摘要记录。
' 参数： lngRecordID 被删除的记录的ID
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private Type RemarkRecord '处理摘要表的记录
lngRemarkID As Long '摘要ID
strRemarkCode As String '摘要编码
strRemarkName As String '摘要内容
End Type
'Private WithEvents mclsMainControl As MainControl '主控对象
Private mblnAddRecord As Boolean '是增加记录还是修改记录
Private mstrSQLBuffer() As String '暂时存储对数据库的增删改操作
Private mintSQLIndex As Integer 'strSQLBuffer的索引
Private mrmkRemark As RemarkRecord '暂存读写记录的数据
Private mstrInitCode As String '暂存编码的初始值，以备判断是否修改
Private ID As Long
Private mblnIsChanged As Boolean
Private mblnIsSetFocus As Boolean
Private mintCur As Integer
'进入新增摘要
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0) As Long
mblnIsSetFocus = False
mblnAddRecord = True
frmRemarkCard.Caption = "新增摘要"
cmdOKCancel(2).Visible = True
InitAddCard strName
Debug.Print "end:" & Timer
If Me.WindowState = 1 Then Me.WindowState = 0
Show intModal
AddCard = ID
' Refresh
If intModal <> vbModal Then ZOrder 0
End Function
'初始化暂存读写记录的数据的自定义类型变量和卡片
Private Sub InitAddCard(Optional strName As String)
With mrmkRemark
.lngRemarkID = 0
.strRemarkCode = ""
.strRemarkName = ""
End With
If txtInput(0).Text = "Text1" Or txtInput(0).Text = "" Then
txtInput(0).Text = ""
Else
txtInput(0).Text = GetNextCode(txtInput(0).Text)
mstrInitCode = txtInput(0).Text
End If
txtInput(1).Text = strName
InitBuffer '清空暂时存储数据库操作的数组
End Sub
'进入修改摘要
Public Sub EditCard(ByVal lngRecordID As Long, Optional intModal As Integer = 0)
mblnIsSetFocus = False
mblnAddRecord = False
frmRemarkCard.Caption = "修改摘要"
cmdOKCancel(2).Visible = False
If Not SelectRecord(lngRecordID) Then Exit Sub '查找记录
If Me.WindowState = 1 Then Me.WindowState = 0
Show intModal
Refresh
If intModal <> vbModal Then ZOrder 0
End Sub
'查找出想修改的摘要表编码记录，存放在自定义类型变量中，设置想修改项
Private Function SelectRecord(ByVal lngRecordID As Long) As Boolean
Dim strSql As String
Dim recSelect As rdoResultset
Dim intMsg As Integer
SelectRecord = False
With mrmkRemark
.lngRemarkID = lngRecordID
strSql = "SELECT * FROM Remark WHERE lngRemarkID =" & .lngRemarkID
Set recSelect = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If recSelect.EOF Then
ShowMsg 0, "该摘要不存在，不能修改！", vbExclamation + MB_TASKMODAL, "修改摘要"
Unload Me
Exit Function
End If
.strRemarkName = recSelect!strRemarkName
.strRemarkCode = recSelect!strRemarkCode
txtInput(0).Text = .strRemarkCode
txtInput(1).Text = .strRemarkName
InitBuffer '清空暂时存储数据库操作的数组
recSelect.Close
End With
SelectRecord = True
End Function
'进入删除摘要，判断记录是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngRecordID As Long, Optional lnghWnd As Long = 0) As Boolean
Dim strSql As String
Dim recSelect As rdoResultset
Dim intMsgReturn As Integer
Dim blnSQLExec As Boolean
DelCard = False
strSql = "SELECT * FROM Remark WHERE lngRemarkID=" & lngRecordID
Set recSelect = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If recSelect.EOF Then
recSelect.Close
Exit Function
End If
intMsgReturn = ShowMsg(lnghWnd, "你确实要删除“" & recSelect!strRemarkName & "”摘要吗？", _
vbExclamation + vbOKCancel + MB_TASKMODAL, "删除摘要")
If intMsgReturn = vbOK Then
strSql = "DELETE FROM Remark WHERE lngRemarkID = " & lngRecordID
blnSQLExec = gclsBase.ExecSQL(strSql)
If Not blnSQLExec Then
intMsgReturn = ShowMsg(lnghWnd, "删除此摘要编码不成功。", _
vbExclamation + MB_TASKMODAL, "删除摘要")
Else
gclsSys.SendMessage CStr(0), Message.msgRemark
End If
End If
DelCard = blnSQLExec
recSelect.Close
End Function
Private Sub cmdRemark_Click(Index As Integer)
If Index = 0 Then
If mintCur > -1 Then
If txtInput(1).Text = "" Then
txtInput(1).Text = "[" & lstRemark.Text & "]"
ElseIf InStr(txtInput(1).Text, "[" & lstRemark.Text & "]") = 0 Then
txtInput(1).Text = Left(txtInput(1).Text, mintCur) _
& "[" & lstRemark.Text & "]" & Mid(txtInput(1).Text, mintCur + 1)
End If
End If
Else
txtInput(1).Text = ""
End If
End Sub
Private Sub Form_Activate()
SetHelpID C2lng(Me.HelpContextID)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -