📄 frmbalckcard.frm
字号:
VERSION 5.00
Object = "{D252F124-F62C-11D1-9ABD-444553540000}#1.0#0"; "GADATE.DLL"
Object = "{81110CCB-022B-11D3-A348-0080C89152FF}#1.3#0"; "ORAGLIST.OCX"
Begin VB.Form frmBalCKCard
BorderStyle = 3 'Fixed Dialog
Caption = "审批金额平衡检查"
ClientHeight = 2445
ClientLeft = 45
ClientTop = 330
ClientWidth = 6630
Icon = "frmBalCKCard.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2445
ScaleWidth = 6630
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.ComboBox cboProject
Height = 300
Left = 1890
Style = 2 'Dropdown List
TabIndex = 1
Top = 210
Width = 3285
End
Begin ListRefer.ListText lstBalCK
Height = 300
Left = 1890
TabIndex = 3
Top = 600
Width = 3285
_ExtentX = 5794
_ExtentY = 529
CodeSort = -1 'True
BackColor = -2147483643
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.ComboBox cboBalCK
Height = 300
Left = 810
Style = 2 'Dropdown List
TabIndex = 5
Top = 1035
Width = 885
End
Begin GACALENDARLibCtl.Calendar dteBalCK
Height = 300
Index = 0
Left = 2010
OleObjectBlob = "frmBalCKCard.frx":000C
TabIndex = 7
Top = 1035
Width = 1425
End
Begin VB.CommandButton cmdOK
Height = 350
Index = 1
Left = 5310
Style = 1 'Graphical
TabIndex = 13
Tag = "1022"
Top = 600
Width = 1215
End
Begin VB.CommandButton cmdOK
Caption = "平衡检查(&C)"
Height = 350
Index = 0
Left = 5310
TabIndex = 12
Top = 210
Width = 1215
End
Begin GACALENDARLibCtl.Calendar dteBalCK
Height = 300
Index = 1
Left = 3750
OleObjectBlob = "frmBalCKCard.frx":0095
TabIndex = 9
Top = 1035
Width = 1425
End
Begin VB.Label lblBalCk
Caption = "工程项目(&J)"
Height = 180
Index = 8
Left = 180
TabIndex = 0
Top = 270
Width = 1710
End
Begin VB.Label lblBalCk
AutoSize = -1 'True
Caption = "审批金额："
Height = 180
Index = 7
Left = 3000
TabIndex = 15
Top = 1890
Width = 900
End
Begin VB.Label lblBalCk
AutoSize = -1 'True
Caption = "审批金额："
Height = 180
Index = 6
Left = 330
TabIndex = 14
Top = 1890
Width = 900
End
Begin VB.Line Line2
BorderColor = &H000000FF&
BorderWidth = 2
Visible = 0 'False
X1 = 2220
X2 = 2775
Y1 = 1710
Y2 = 2025
End
Begin VB.Line Line1
BorderColor = &H0000FF00&
BorderWidth = 3
Index = 1
X1 = 2100
X2 = 2820
Y1 = 1920
Y2 = 1920
End
Begin VB.Line Line1
BorderColor = &H0000FF00&
BorderWidth = 3
Index = 0
X1 = 2100
X2 = 2820
Y1 = 1830
Y2 = 1830
End
Begin VB.Label lblBalCk
AutoSize = -1 'True
Caption = "审批金额："
Height = 180
Index = 5
Left = 2970
TabIndex = 11
Top = 1710
Width = 900
End
Begin VB.Label lblBalCk
AutoSize = -1 'True
Caption = "上级拨入："
Height = 180
Index = 4
Left = 300
TabIndex = 10
Top = 1710
Width = 900
End
Begin VB.Label lblBalCk
AutoSize = -1 'True
Caption = "到"
Height = 180
Index = 3
Left = 3540
TabIndex = 8
Top = 1095
Width = 180
End
Begin VB.Label lblBalCk
AutoSize = -1 'True
Caption = "从"
Height = 180
Index = 2
Left = 1800
TabIndex = 6
Top = 1095
Width = 180
End
Begin VB.Label lblBalCk
AutoSize = -1 'True
Caption = "日期(&D)"
Height = 180
Index = 1
Left = 180
TabIndex = 4
Top = 1035
Width = 630
End
Begin VB.Label lblBalCk
Caption = "上级拨入资金科目(&F)"
Height = 180
Index = 0
Left = 180
TabIndex = 2
Top = 660
Width = 1710
End
End
Attribute VB_Name = "frmBalCKCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const corUnPass = &HFF&
Private Const corPass = &HFF00&
Private mdteS As Date
Private mdteE As Date
Private mblnIsInit As Boolean
Private mblnIsChanged As Boolean
Private mlngAcnID As Long
Private mstrProject As String
Public Property Let Project(ByVal NewValue As String)
mstrProject = NewValue
End Property
Private Sub CheckBalance()
Dim lngProjID As Long
Dim dblEnter As Double, dblExam As Double
Dim strSql As String
mlngAcnID = lstBalCK.ID
lngProjID = cboProject.ItemData(cboProject.ListIndex)
dblEnter = EnterSum(mlngAcnID)
dblExam = ExamSum(mlngAcnID)
lblBalCk(6).Caption = FormatShow(dblExam, gclsBase.NaturalCurDec)
lblBalCk(7).Caption = FormatShow(dblEnter, gclsBase.NaturalCurDec)
If dblEnter = dblExam Then
Line2.Visible = False
Line1(0).Bordercolor = corPass
Line1(1).Bordercolor = corPass
Else
Line2.Visible = True
Line1(0).Bordercolor = corUnPass
Line1(1).Bordercolor = corUnPass
End If
If lngProjID <> 0 Then
strSql = "UPDATE Project SET lngFundAccountID=" & mlngAcnID & " WHERE lngProjectID=" & lngProjID
gclsBase.ExecSQL strSql
Else
strSql = "INSERT INTO Setting(lngModuleID,strSection,strKey,strSetting,strTypeName) VALUES(16," _
& "'所有的工程','拨入资金科目'," & mlngAcnID & ",'Long')"
If Not gclsBase.ExecSQL(strSql) Then
strSql = "UPDATE Setting SET strSetting=" & mlngAcnID & " WHERE lngModuleID=16 AND strSection" _
& "='所有的工程' AND strKey='拨入资金科目'"
gclsBase.ExecSQL strSql
End If
End If
End Sub
Private Function EnterSum(ByVal lngAID As Long)
Dim recX As rdoResultset
Dim strBDate As String, strEDate As String, strSql As String
strBDate = dteBalCK(0).Text
strEDate = dteBalCK(1).Text
EnterSum = 0
strSql = "SELECT SUM(dblUnVoucherCredit+dblUnPostedCredit+dblPostedCredit) dblCredit FROM " _
& "AccountDaily WHERE lngAccountID=" & lngAID & " AND strDate>='" & strBDate _
& "' AND strDate<='" & strEDate & "'"
Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
If Not recX.EOF Then
EnterSum = Format(recX("dblCredit"), "@;0")
End If
recX.Close
End Function
Private Function ExamSum(ByVal lngAID As Long)
Dim recX As rdoResultset
Dim strBDate As String, strEDate As String, strSql As String
strBDate = dteBalCK(0).Text
strEDate = dteBalCK(1).Text
ExamSum = 0
' strSql = "SELECT SUM(ProjectFundIn.dblAmount) dblCredit FROM Project,ProjectFundIn " _
' & "WHERE Project.lngAccountID=" & lngAID & " AND ProjectFundIn.strDate>='" & strBDate _
' & "' AND ProjectFundIn.strDate<='" & strEDate & "' AND ProjectFundIn.lngProjectID=" _
' & "Project.lngProjectID"
If cboProject.ItemData(cboProject.ListIndex) <> 0 Then
strSql = Left(cboProject.Text, InStr(cboProject.Text, " ") - 1)
strSql = "SELECT SUM(ProjectFundIn.dblAmount) dblCredit FROM ProjectFundIn,Project " _
& "WHERE ProjectFundIn.lngProjectID=Project.lngProjectID AND ProjectFundIn.strDate>='" & strBDate _
& "' AND ProjectFundIn.strDate<='" & strEDate & "' " _
& " AND (Project.strProjectCode='" & strSql & "' OR Project.strProjectCode Like '" & strSql & "-%') "
Else
strSql = "SELECT SUM(ProjectFundIn.dblAmount) dblCredit FROM ProjectFundIn " _
& "WHERE ProjectFundIn.strDate>='" & strBDate _
& "' AND ProjectFundIn.strDate<='" & strEDate & "'"
End If
Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
If Not recX.EOF Then
ExamSum = Format(recX("dblCredit"), "@;0")
End If
recX.Close
End Function
'Private Function GetAccount() As String
' Dim recA As rdoResultset, strSql As String
'
' strSql = "SELECT Account.strAccountCode || ' ' || Account.strAccountName strAccount " _
' & "FROM Project,Account WHERE Project.lngAccountID=Account.lngAccountID"
' Set recA = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
' If Not recA.EOF Then
' GetAccount = recA("strAccount")
' Else
' GetAccount = ""
' End If
' recA.Close
'End Function
Private Sub cboBalCK_Click()
Dim dteBDate As Date, dteEDate As Date
If cboBalCK.Text = "自定义" Then
dteBDate = mdteS
dteEDate = mdteE
ElseIf cboBalCK.Text = "所有" Then
dteBDate = gclsBase.BeginDate
dteEDate = gclsBase.EndDate
Else
gclsBase.GetBeginAndEndDate cboBalCK.Text, , dteBDate, dteEDate
End If
dteBalCK(0).Value = dteBDate
dteBalCK(1).Value = dteEDate
End Sub
Private Sub cboProject_Click()
mlngAcnID = GetProjectAccount
lstBalCK.SeekId mlngAcnID
End Sub
Private Function GetProjectAccount() As Long
Dim lngProjID As Long
Dim recX As rdoResultset, strSql As String
lngProjID = cboProject.ItemData(cboProject.ListIndex)
If lngProjID <> 0 Then
strSql = "SELECT lngFundAccountID lngAcnID FROM Project WHERE lngProjectID=" & lngProjID
Else
strSql = "SELECT strSetting lngAcnID FROM Setting WHERE lngModuleID=16 AND strSection" _
& "='所有的工程' AND strKey='拨入资金科目'"
End If
Set recX = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
If Not recX.EOF Then
GetProjectAccount = Format(recX("lngAcnID"), "@;0;")
Else
GetProjectAccount = 0
End If
recX.Close
End Function
Private Sub cmdOK_Click(Index As Integer)
If Index = 0 Then
CheckBalance
Else
Unload Me
End If
End Sub
Private Sub dteBalCK_LostFocus(Index As Integer)
If cboBalCK.Text = "自定义" Then
mdteS = dteBalCK(0).Value
mdteE = dteBalCK(1).Value
End If
End Sub
Private Sub InitProjectCbo()
Dim recP As rdoResultset, strSql As String
cboProject.Clear
strSql = "SELECT * FROM Project ORDER BY strProjectCode"
Set recP = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
While Not recP.EOF
cboProject.AddItem recP("strProjectCode") & " " & recP("strProjectName")
cboProject.ItemData(cboProject.NewIndex) = recP("lngProjectID")
recP.MoveNext
Wend
recP.Close
cboProject.AddItem "所有的工程"
cboProject.ItemData(cboProject.NewIndex) = 0
cboProject.Text = mstrProject
End Sub
Private Sub Form_Load()
Dim i As Integer, strA As String
Dim edtErrReturn As ErrDealType
On Error GoTo ErrHandle
#If conVersionType = 1 Then
lblBalCk(8).Caption = "在建工程(&J)"
#Else
lblBalCk(8).Caption = "工程项目(&J)"
#End If
mblnIsInit = True
mblnIsChanged = False
Utility.LoadFormResPicture Me
mdteS = gclsBase.BaseDate
mdteE = gclsBase.EndDate
' setlistbox lstBalCK, 0, 0, True
InitProjectCbo
setlistbox lstBalCK, 0, mlngAcnID, True
' If lstBalCK.Text = "" Then
' strA = GetAccount
' If strA = "" Then
'' lstBalCK.ReferRow = lstBalCK.Referrows - 1
' Else
' lstBalCK.Text = strA
' End If
' End If
Utility.InitDate cboBalCK
cboBalCK.Text = "本期"
CheckBalance
Exit Sub
ErrHandle:
edtErrReturn = Errors.ErrorsDeal
If edtErrReturn = edtResume Then
Resume
Else
On Error Resume Next
Unload MsgForm
Unload Me
End If
End Sub
Private Sub Form_Paint()
FrameBox hwnd, 180, 1500, 180 + 4995, 1500 + 795
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Utility.UnLoadFormResPicture Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -