📄 使用计划汇总表.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 frmCollection
Caption = "资金使用计划汇总镖"
ClientHeight = 7560
ClientLeft = 660
ClientTop = 1350
ClientWidth = 11190
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 7560
ScaleWidth = 11190
WindowState = 2 'Maximized
Begin prjTBCtrl.CTBCtrl ocxCtbTool
Height = 660
Left = 840
Top = 1440
Width = 1095
_ExtentX = 1931
_ExtentY = 1164
End
Begin MSComctlLib.ImageList IltTool
Left = 1440
Top = 3480
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
MaskColor = 12632256
_Version = 393216
End
Begin MSComDlg.CommonDialog comFile
Left = 4440
Top = 3240
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.ComboBox cboCurName
Height = 300
Left = 3000
Style = 2 'Dropdown List
TabIndex = 1
ToolTipText = "分币种进行统计!"
Top = 1440
Width = 1815
End
Begin CELL2000Lib.Cell ocxCell
Height = 5415
Left = 480
TabIndex = 2
Top = 2040
Width = 10335
_Version = 65536
_ExtentX = 18230
_ExtentY = 9551
_StockProps = 0
End
Begin MSComctlLib.Toolbar tlbTool
Align = 1 'Align Top
Height = 540
Left = 0
TabIndex = 0
Top = 0
Width = 11190
_ExtentX = 19738
_ExtentY = 953
ButtonWidth = 820
ButtonHeight = 953
Wrappable = 0 'False
Style = 1
_Version = 393216
BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
NumButtons = 9
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"
EndProperty
BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "查询"
Key = "query"
EndProperty
BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "刷新"
Key = "refresh"
EndProperty
BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
Style = 3
EndProperty
BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "帮助"
Key = "help"
Object.ToolTipText = "帮助"
EndProperty
BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
Caption = "退出"
Key = "quit"
Object.ToolTipText = "退出"
EndProperty
EndProperty
End
Begin VB.Label lbTitle
Alignment = 2 'Center
Caption = "资金使用计划汇总表"
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3600
TabIndex = 5
Top = 720
Width = 3855
End
Begin VB.Label Label2
Alignment = 2 'Center
Caption = "单位 : 万元"
Height = 255
Left = 6480
TabIndex = 4
Top = 1440
Width = 1815
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "币种 :"
Height = 255
Left = 1800
TabIndex = 3
Top = 1440
Width = 1095
End
End
Attribute VB_Name = "frmCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_objMgr As U8BudgetMgr.IBudgetMgr
Private m_sWhere As String
Private m_sCur As String
Private Const fore_part = "select fd_projdef.bprjclass as bprjclass,fd_projdef.sprjname as sprjname,fd_accunit.cUnitName as sunitname,sum(fd_budgetdata.mdeclare) as mdeclare," & _
"sum(fd_budgetdata.mapprove) as mapprove from fd_budgetdata " & _
"left join fd_budgethead on fd_budgethead.iid=fd_budgetdata.iid " & _
"left join fd_projdef on fd_projdef.iid = fd_budgetdata.islid " & _
"left join fd_accunit on fd_accunit.accunit_id = fd_budgethead.accunit_id "
Private m_objContent As DOMDocument
Private m_objTable As DOMDocument
Public Property Let where(val As String)
m_sWhere = fore_part & val
Query
End Property
Public Property Let Cur(val As String)
m_sCur = val
End Property
Private Sub cboCurName_Click()
Dim Start As Integer
Dim ed As Integer
If m_sWhere <> "" Then
Start = InStr(1, m_sWhere, "scurcode='") + 10
ed = InStr(Start, m_sWhere, "'")
Mid(m_sWhere, Start, ed - Start) = cboCurName.ItemData(cboCurName.ListIndex)
Query
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
bShortCut KeyCode, Shift
End Sub
Private Sub Form_Load()
Dim doc As DOMDocument
LoadToolPic
FillCur cboCurName
SetTableState
' cboCurName.Text = m_sCur
Set m_objMgr = New U8BudgetMgr.clsCollectionImp
m_objMgr.Init zjLogInfo
Set doc = m_objAid.objGenerateUFDom("template", "plan_collection")
m_objMgr.GetTableHead doc, m_objTable, doc
If PrintError(doc) Then Exit Sub
SetTBStyle Me
End Sub
Private Sub Form_Resize()
ResizeTlb Me
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 "query"
QueryIt
Case "refresh"
Reload
Case "help"
SendKeys "{F1}"
Case "quit"
Quit
Case "help"
End Select
If Button.key <> "quit" Then
ocxCtbTool.RefreshEnable
End If
End Sub
Private Sub SetTableState()
ocxCell.ShowPageBreak 0
ocxCell.ShowSideLabel 0, 0
ocxCell.ShowTopLabel 0, 0
ocxCell.ShowSheetLabel 0, 0
ocxCell.ReadOnly = 1
ocxCell.SetRows 2, 0
End Sub
Private Sub MakeRow()
Dim root As IXMLDOMElement
Dim Node As IXMLDOMElement
Dim Col As Integer, Row As Integer
Dim amount As Integer, count As Integer
Set root = m_objContent.documentElement
count = m_objAid.iNodeCount(m_objContent.documentElement) + 1
amount = m_objAid.iNodeCount(m_objTable.documentElement)
ocxCell.SetRows count + 1, 0
For Row = 2 To count
Set Node = root.childNodes(Row - 2)
For Col = 1 To amount
ocxCell.SetCellString Col, Row, 0, m_objAid.GetAttributeVal(GetField(Col, "fieldname"), Node)
ocxCell.SetCellAlign Col, Row, 0, 32 + CInt(GetField(Col, "align"))
ocxCell.SetCellFont Col, Row, 0, ocxCell.FindFontIndex("宋体", 1)
ocxCell.SetCellFontSize Col, Row, 0, 9
Next
Next
ocxCell.SetFixedRow 1, 1
End Sub
Private Function GetField(ByVal Col, ByVal sValue As String) As String
Dim child As IXMLDOMElement
If IsNumeric(Col) Then
Set child = m_objTable.documentElement.childNodes.Item(Col - 1)
Else
Set child = m_objTable.documentElement.selectSingleNode(Col)
End If
GetField = m_objAid.GetAttributeVal(sValue, child)
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -