📄 frmmutiaccount.frm
字号:
VERSION 5.00
Object = "{9C4B12C2-D5CE-11D1-9ABC-444553540000}#1.0#0"; "GACEDIT.DLL"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{F6125AB1-8AB1-11CE-A77F-08002B2F4E98}#2.0#0"; "MSRDC20.OCX"
Object = "{81110CCB-022B-11D3-A348-0080C89152FF}#1.3#0"; "ORAGLIST.OCX"
Begin VB.Form frmMutiAccount
BorderStyle = 3 'Fixed Dialog
Caption = "固定资产折旧科目"
ClientHeight = 3735
ClientLeft = 45
ClientTop = 330
ClientWidth = 5490
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3735
ScaleWidth = 5490
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin MSRDC.MSRDC datAcc
Height = 330
Left = 360
Top = 0
Visible = 0 'False
Width = 1200
_ExtentX = 2117
_ExtentY = 582
_Version = 393216
Options = 0
CursorDriver = 0
BOFAction = 0
EOFAction = 0
RecordsetType = 1
LockType = 3
QueryType = 0
Prompt = 3
Appearance = 1
QueryTimeout = 30
RowsetSize = 100
LoginTimeout = 15
KeysetSize = 0
MaxRows = 0
ErrorThreshold = -1
BatchSize = 15
BackColor = -2147483643
ForeColor = -2147483640
Enabled = -1 'True
ReadOnly = 0 'False
Appearance = -1 'True
DataSourceName = ""
RecordSource = ""
UserName = ""
Password = ""
Connect = ""
LogMessages = ""
Caption = "MSRDC1"
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 GATLCTRLLibCtl.CalEdit txtEdit
Height = 285
Left = 4140
OleObjectBlob = "frmMutiAccount.frx":0000
TabIndex = 4
Top = 1530
Width = 1230
End
Begin ListRefer.ListText ltxtAcc
Height = 315
Left = 4125
TabIndex = 3
Top = 1050
Visible = 0 'False
Width = 1275
_ExtentX = 2249
_ExtentY = 556
CodeSort = -1 'True
BackColor = -2147483643
Appearance = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.CommandButton cmdOk
Height = 350
Index = 1
Left = 4155
Style = 1 'Graphical
TabIndex = 2
Tag = "1002"
Top = 510
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOk
Height = 350
Index = 0
Left = 4155
Style = 1 'Graphical
TabIndex = 1
Tag = "1001"
Top = 120
UseMaskColor = -1 'True
Width = 1215
End
Begin MSFlexGridLib.MSFlexGrid msgMutiAcc
Bindings = "frmMutiAccount.frx":0081
Height = 3555
Left = 60
TabIndex = 0
Top = 90
Width = 3930
_ExtentX = 6932
_ExtentY = 6271
_Version = 393216
Rows = 21
Cols = 3
FixedCols = 0
RowHeightMin = 250
End
Begin VB.Menu MenuPopup
Caption = "Main"
Visible = 0 'False
Begin VB.Menu mnuNew
Caption = "新增折旧科目(&N)"
End
Begin VB.Menu mnuDelete
Caption = "删除折旧科目(&D)"
End
End
End
Attribute VB_Name = "frmMutiAccount"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''
' 固定资产折旧科目
' 作者:肖宇
' 日期:98-07-03
'
' 功能:录入固资的折旧费用科目及分摊比例
'
'''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private Const mlngColID = 0
Private Const mlngColAccountID = 1
Private Const mlngColAccount = 2
Private Const mlngColRate = 3
Private WithEvents mclsList As Grid 'Grid类
Attribute mclsList.VB_VarHelpID = -1
Private mstrAccountStr As String
Private mlngAccID As Long '与参照框内容对应的部门ID
Private mlngAlterID As Long
Private mblnLocked As Boolean
Private mblnCopyMode As Boolean
Private mblnChanged As Boolean
'科目，比例
Public Sub LoadFromString(ByVal strValue As String)
Dim strResult As String
Dim intCount As Integer, lngRow As Long
intCount = msgMutiAcc.Rows
If AlterID = -1 Then
AlterID = 0
End If
mblnCopyMode = True
intCount = 1
If GetString(strValue, strResult, intCount, Asc("=")) Then
lngRow = msgMutiAcc.Rows
ltxtAcc.Text = strResult
msgMutiAcc.Rows = lngRow + 1
msgMutiAcc.TextMatrix(lngRow, mlngColAccountID) = ltxtAcc.ID
msgMutiAcc.TextMatrix(lngRow, mlngColAccount) = ltxtAcc.Text
msgMutiAcc.Row = lngRow
End If
intCount = intCount + 1
If GetString(strValue, strResult, intCount, Asc("=")) Then
lngRow = msgMutiAcc.Row
msgMutiAcc.TextMatrix(lngRow, mlngColRate) = C2Dbl(strResult)
End If
End Sub
Public Sub EditCard(lngAlterID As Long, Optional blnLock As Boolean = False, Optional ByVal blnShow As Boolean = True)
Dim lngCnt As Long
lngCnt = msgMutiAcc.Rows
mblnLocked = blnLock
If AlterID <> lngAlterID Or AlterID = -1 Then
AlterID = lngAlterID
End If
For lngCnt = 1 To msgMutiAcc.Cols - 1
mclsList.ReadOnlyCol(lngCnt) = mblnLocked
Next lngCnt
cmdOk(1).Enabled = (Not mblnLocked)
RefreshLtxtAcc
If blnShow Then
Show vbModal
End If
End Sub
Public Property Get AlterID() As Long
AlterID = mlngAlterID
End Property
Public Property Let AlterID(ByVal vNewValue As Long)
msgMutiAcc.Rows = 1
mlngAlterID = vNewValue
RefreshGrid
End Property
Public Property Get AccountStr() As String
Dim lngRow As Long
Dim strAccount As String
With msgMutiAcc
For lngRow = 1 To .Rows - 1
If .RowHeight(lngRow) > 100 And .TextMatrix(lngRow, mlngColAccount) <> "" Then
If strAccount <> "" Then
strAccount = strAccount & " / "
End If
strAccount = strAccount & .TextMatrix(lngRow, mlngColAccount) & "(" & .TextMatrix(lngRow, mlngColRate) & "%)"
End If
Next lngRow
End With
AccountStr = strAccount
End Property
Public Property Get Changed() As Boolean
Changed = mblnChanged
End Property
Public Sub Save(Optional lngAlterID As Long)
Dim lngRow As Long
Dim strSql As String
Dim lngAccountID As Long
Dim dblRate As Double
Dim lngID As Long
Dim blnNew As Boolean
Dim lngFixedAlterID As Long
If lngAlterID <> 0 Then
lngFixedAlterID = lngAlterID
Else
lngFixedAlterID = mlngAlterID
End If
blnNew = False
If mlngAlterID <> lngFixedAlterID Then
blnNew = True
If lngFixedAlterID > 0 Then
mlngAlterID = lngFixedAlterID
Else
strSql = "DELETE FROM FixedAccount WHERE lngFixedAlterID=-1"
gclsBase.ExecSQL strSql
End If
End If
With msgMutiAcc
For lngRow = 1 To .Rows - 1
lngID = GetValue(lngRow, mlngColID)
lngAccountID = GetValue(lngRow, mlngColAccountID)
dblRate = GetValue(lngRow, mlngColRate)
If lngAccountID > 0 Then
If lngID > 0 And (Not blnNew) Then
If .RowHeight(lngRow) > 100 Then
strSql = "UPDATE FixedAccount SET lngAccountID=" & lngAccountID _
& ",dblRate=" & dblRate & ",lngFixedAlterID=" & lngFixedAlterID _
& " WHERE lngFixedAccountID=" & lngID
Else
strSql = "DELETE FROM FixedAccount WHERE lngFixedAccountID=" & lngID
End If
ElseIf .RowHeight(lngRow) > 100 Then
strSql = "INSERT INTO FixedAccount (lngFixedAccountID,lngFixedAlterID,lngAccountID,dblRate) " _
& "VALUES (" & GetNewID("FixedAccount") & "," & lngFixedAlterID & "," & lngAccountID & "," & dblRate & ")"
Else
strSql = ""
End If
If strSql <> "" Then
gclsBase.ExecSQL strSql
End If
End If
Next lngRow
End With
If mlngAlterID = -1 Then mlngAlterID = 0
End Sub
Function GetAccount() As rdoResultset
Dim strSql As String
strSql = "SELECT lngFixedAccountID,FixedAccount.lngAccountID,strAccountCode || ' ' || strAccountName As 科目," _
& "dblRate As ""分摊比例(%)"" FROM FixedAccount " _
& ", Account WHERE FixedAccount.lngAccountID=Account.lngAccountID " _
& "AND lngFixedAlterID=" & IIf(mlngAlterID = 0, -1, mlngAlterID)
Set GetAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
End Function
'确定
Public Function DataIsVoid(Msg As String, Optional blnCheckAfterSave As Boolean = False) As Boolean
Dim lngRow As Long
Dim lngRow1 As Long
Dim lngCnt As Long
Dim dblTotalRate As Double
Dim strAcc As String
Dim dblRate As Double
Dim strSql As String
Dim recAccount As rdoResultset
DataIsVoid = True
lngCnt = 0
dblTotalRate = 0
Msg = ""
With msgMutiAcc
For lngRow = 1 To .Rows - 1
If .RowHeight(lngRow) > 100 Then
strAcc = GetValue(lngRow, mlngColAccount, "String")
Else
strAcc = ""
End If
If .RowHeight(lngRow) > 100 And strAcc <> "" Then
dblRate = GetValue(lngRow, mlngColRate)
If strAcc <> "" And dblRate > 0 Then
lngCnt = lngCnt + 1
dblTotalRate = dblTotalRate + dblRate
ElseIf strAcc <> "" And dblRate = 0 Then
DataIsVoid = False
Msg = "分摊比例必须大于0！"
ElseIf strAcc = "" And dblRate > 0 Then
DataIsVoid = False
Msg = "科目不能为空！"
End If
If DataIsVoid Then
For lngRow1 = 1 To .Rows - 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -