📄 项目附表显示.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{80623D63-54EA-11D5-9618-0050BAA688FF}#1.0#0"; "CellCtrl.ocx"
Object = "{5AD81966-3173-4597-A32E-4F4620DA3B57}#3.4#0"; "U8TBCtl.ocx"
Begin VB.Form frmAddOn
Caption = "项目附表"
ClientHeight = 5505
ClientLeft = 2610
ClientTop = 4665
ClientWidth = 6975
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 5505
ScaleWidth = 6975
StartUpPosition = 1 '所有者中心
Begin prjTBCtrl.CTBCtrl ocxCtbTool
Height = 660
Left = 1680
Top = 2040
Width = 3135
_ExtentX = 5530
_ExtentY = 1164
End
Begin MSComctlLib.ImageList IltTool
Left = 2760
Top = 5040
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
MaskColor = 12632256
_Version = 393216
End
Begin MSComDlg.CommonDialog comFile
Left = 840
Top = 5040
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSComctlLib.Toolbar tlbTool
Align = 1 'Align Top
Height = 540
Left = 0
TabIndex = 0
Top = 0
Width = 6975
_ExtentX = 12303
_ExtentY = 953
ButtonWidth = 820
ButtonHeight = 953
Wrappable = 0 'False
Style = 1
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 15
BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "打印"
Key = "print"
Object.ToolTipText = "打印"
EndProperty
BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "预览"
Key = "preview"
Object.ToolTipText = "预览"
EndProperty
BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "输出"
Key = "output"
Object.ToolTipText = "输出"
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "sep1"
Style = 3
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "增加"
Key = "add"
Object.ToolTipText = "增加"
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "修改"
Key = "edit"
Object.ToolTipText = "修改"
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "删除"
Key = "delete"
Object.ToolTipText = "删除"
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "保存"
Key = "save"
Object.ToolTipText = "保存"
EndProperty
BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "放弃"
Key = "cancel"
Object.ToolTipText = "放弃"
EndProperty
BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
Key = "sep"
Style = 3
EndProperty
BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}
Object.Visible = 0 'False
Caption = "查找"
Key = "query"
Object.ToolTipText = "查找"
EndProperty
BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "刷新"
Key = "refresh"
Object.ToolTipText = "刷新"
EndProperty
BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "帮助"
Key = "help"
Object.ToolTipText = "帮助"
EndProperty
BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出"
Key = "quit"
Object.ToolTipText = "退出"
EndProperty
EndProperty
End
Begin CELL2000Lib.Cell ocxCell
Height = 4335
Left = 0
TabIndex = 2
TabStop = 0 'False
Top = 600
Width = 6975
_Version = 65536
_ExtentX = 12303
_ExtentY = 7646
_StockProps = 0
End
Begin VB.TextBox txtHelp
Height = 270
Left = 3720
TabIndex = 1
Top = 3000
Width = 300
End
End
Attribute VB_Name = "frmAddOn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_objQueryParam As IXMLDOMElement '保存当前的查询信息
Private m_objHead As New DOMDocument '主表信息
Private m_objContent As DOMDocument '子表信息
Private m_iRow As Integer '记录当前列
Private m_iCol As Integer '记录当前行
Private m_sPlanID As String '使用计划编号
Private m_sPrjID As String '项目编号
Private m_iMode As Integer '1.录入 2.查看
Private m_iFlag As Integer '操作标志
Private m_iPreCount As Integer '保存当前(未增加)行数目,包括合计
Private m_objChanged As New Collection
Private m_objRef As New Collection
Private m_objParent As frmPlan
Private m_iParentRow As Integer
Public Property Let iMode(mode As Integer)
m_iMode = mode
End Property
Public Sub SetParent(val As frmPlan, Row As Integer)
Set m_objParent = val
m_iParentRow = Row
m_sPlanID = val.GetHead("iid")
If m_sPlanID = "" Then
m_sPlanID = val.GetHead("addon")
End If
m_sPrjID = val.GetContent(-1, Row, "islid")
End Sub
'获取表头信息
Public Sub Init()
Dim AddOn As New U8BudgetMgr.clsAddOnImp
Dim doc As DOMDocument
Dim root As IXMLDOMElement
Dim Node As IXMLDOMElement
Dim i As Integer
'获取定制信息
Set doc = m_objAid.objGenerateUFDom("proc", "hasaddon", "roottag", "fd")
Set root = m_objAid.objSelectRootTag(doc)
root.setAttribute "iprjid", m_sPrjID
AddOn.Transact doc, m_objHead, zjLogInfo
If m_objAid.iSuccess(m_objHead) <> 0 Then
Set m_objHead = Nothing
Unload Me
Exit Sub
End If
Set root = m_objAid.objSelectRootTag(m_objHead)
Set Node = m_objAid.objMakeNode("fiid", "name", "iid")
root.insertBefore Node, root.firstChild
i = 1
For Each Node In root.childNodes
Node.setAttribute "index", i
i = i + 1
Next
'设置查询参数
Set m_objQueryParam = m_objAid.objMakeNode("fd")
Set Node = m_objAid.objMakeNode("item", "name", "cAutoCode", "value", m_sPrjID, "operation", "=", "logic", "and")
m_objQueryParam.appendChild Node
Set Node = m_objAid.objMakeNode("item", "name", "cAutoName", "value", m_sPlanID, "operation", "=", "logic", "")
m_objQueryParam.appendChild Node
m_objQueryParam.setAttribute "table", GetHead("table")
MakeHead
Query
SetButtonState
SetTBStyle Me
End Sub
Private Sub SetTableState()
ocxCell.ShowSheetLabel 0, 0
ocxCell.ShowTopLabel 1, 0
ocxCell.ShowSideLabel 1, 0
ocxCell.SetSelectMode 0, 2
ocxCell.SetCellString 0, 0, 0, "序号"
ocxCell.MoveDir = 2
End Sub
Private Sub Form_Load()
LoadToolPic
SetTableState
SwitchState CStr(m_iMode)
Init
End Sub
Private Sub Form_Resize()
ocxCell.left = 0
ocxCell.top = 700
If Me.Height > 700 Then
ocxCell.Height = Me.Height - 700
End If
If Me.width > 200 Then
ocxCell.width = Me.width - 200
End If
ResizeTlb Me
End Sub
Private Sub ocxCell_AllowDelCell(ByVal Col As Long, ByVal Row As Long, approve As Long)
approve = 0
End Sub
Private Sub ocxCell_AllowMove(ByVal oldcol As Long, ByVal oldrow As Long, ByVal newcol As Long, ByVal newrow As Long, approve As Long)
approve = 1
End Sub
Private Sub ocxCell_DropCellSelected(ByVal Col As Long, ByVal Row As Long)
If ocxCell.ReadOnly = 1 Then
ocxCell.SetCellString Col, Row, 0, GetContent(Col, Row)
Else
SetContent Col, Row, ocxCell.GetCellString(Col, Row, 0)
End If
End Sub
Private Sub ocxCtbTool_OnCommand(ByVal enumType As prjTBCtrl.ENUM_MENU_OR_BUTTON, ByVal cButtonId As String, ByVal cMenuId As String)
tlbTool_ButtonClick tlbTool.Buttons(cButtonId)
End Sub
Private Sub tlbTool_ButtonClick(ByVal Button As MsComctlLib.Button)
Select Case Button.key
Case "print"
PrintMe
Case "preview"
Preview
Case "output"
Output
Case "save"
SaveData
Case "edit"
SetChange
Case "delete"
DeleteData
Case "cancel"
Cancel
Case "add"
AddNew
Case "help"
SendKeys "{F1}"
Case "quit"
Quit
Case "refresh"
Reload
Case Else
End Select
If Button.key <> "quit" Then
ocxCtbTool.RefreshEnable
End If
End Sub
Private Sub ocxCell_EditFinish(Text As String, approve As Long)
Dim sumname As String '保存合计字段名称
Dim fore_part As String '小数点前
Dim back_part As String '小数点后
Dim pos As Integer '小数点位置
Dim root As IXMLDOMElement '
Dim tp As String
Dim strOrigin As String
approve = 0
Set root = m_objAid.objSelectRootTag(m_objHead)
Text = Trim(Text)
tp = GetField(m_iCol, "type")
If tp = "数字" And Text <> "" Then '检查数字是否正确
sumname = GetHead("sum", root)
If Text = "0" Then
Text = ""
ElseIf Not IsNumeric(Text) Then
iShowMsg "输入不是数字类型!"
Exit Sub
End If
pos = InStr(1, Text, ".")
If pos <> 0 Then
fore_part = mID(Text, 1, pos)
If Len(fore_part) > CInt(GetField(m_iCol, "len")) Then
iShowMsg "小数点前部分超长!"
Exit Sub
End If
back_part = mID(Text, pos + 1)
If Len(fore_part) > CInt(GetField(m_iCol, "declen")) Then
iShowMsg "小数点后部分超长!"
Exit Sub
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -