📄 frmmuticurr.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 frmMutiCurr
BorderStyle = 3 'Fixed Dialog
Caption = "固定资产原值"
ClientHeight = 4200
ClientLeft = 45
ClientTop = 330
ClientWidth = 7275
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4200
ScaleWidth = 7275
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin MSRDC.MSRDC datCurr
Height = 330
Left = 6000
Top = 3240
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 = 5910
OleObjectBlob = "frmMutiCurr.frx":0000
TabIndex = 6
Top = 1770
Width = 1140
End
Begin ListRefer.ListText ltxtCurr
Height = 270
Left = 5925
TabIndex = 3
Top = 1275
Visible = 0 'False
Width = 1215
_ExtentX = 2143
_ExtentY = 476
CodeSort = -1 'True
SeekCol = "1,2"
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 = 0
Left = 5925
Style = 1 'Graphical
TabIndex = 2
Tag = "1001"
Top = 105
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton cmdOk
Height = 350
Index = 1
Left = 5925
Style = 1 'Graphical
TabIndex = 1
Tag = "1002"
Top = 495
UseMaskColor = -1 'True
Width = 1215
End
Begin MSFlexGridLib.MSFlexGrid msgMutiCurr
Bindings = "frmMutiCurr.frx":0081
Height = 3705
Left = 90
TabIndex = 0
Top = 90
Width = 5670
_ExtentX = 10001
_ExtentY = 6535
_Version = 393216
Rows = 21
Cols = 5
FixedCols = 0
RowHeightMin = 250
End
Begin VB.Label hLb
Alignment = 1 'Right Justify
BackColor = &H80000005&
Height = 255
Index = 1
Left = 1290
TabIndex = 5
Top = 3855
Width = 855
End
Begin VB.Label hLb
Alignment = 1 'Right Justify
BackColor = &H80000005&
Height = 255
Index = 0
Left = 90
TabIndex = 4
Top = 3855
Width = 855
End
Begin VB.Menu mnuPopup
Caption = "Main"
Visible = 0 'False
Begin VB.Menu mnuNew
Caption = "新增原值(&N)"
End
Begin VB.Menu mnuDelete
Caption = "删除原值(&D)"
End
End
End
Attribute VB_Name = "frmMutiCurr"
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 mlngColCurrID = 1
Private Const mlngColInDirect = 2
Private Const mlngColCurrDec = 3
Private Const mlngColRateDec = 4
Private Const mlngColCurr = 5
Private Const mlngColRate = 6
Private Const mlngColCurrAmount = 7
Private Const mlngColAmount = 8
Private WithEvents mclsList As Grid 'Grid类
Attribute mclsList.VB_VarHelpID = -1
Private mstrCurrencyStr As String
Private mlngCurrID As Long '与参照框内容对应的币种ID
Private mlngAlterID As Long
Private mdblTotal As Double
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
Dim lngID As Long
intCount = msgMutiCurr.Rows
If AlterID = -1 Then
AlterID = 0
End If
mblnCopyMode = True
intCount = 1
If GetString(strValue, strResult, intCount, Asc(",")) Then
For lngRow = 4 To ltxtCurr.Referrows
If Trim(ltxtCurr.TextMatrix(lngRow, 2)) = strResult Then
lngID = C2lng(ltxtCurr.TextMatrix(lngRow, 1))
Exit For
End If
Next lngRow
msgMutiCurr.col = mlngColCurr
lngRow = msgMutiCurr.Rows
msgMutiCurr.Rows = lngRow + 1
msgMutiCurr.Row = lngRow
msgMutiCurr.TextMatrix(lngRow, mlngColCurrID) = lngID
msgMutiCurr.TextMatrix(lngRow, mlngColCurr) = strResult
LoadCurrencyOther lngID, lngRow
msgMutiCurr.Row = lngRow
End If
intCount = intCount + 1
If GetString(strValue, strResult, intCount, Asc(",")) Then
lngRow = msgMutiCurr.Row
msgMutiCurr.TextMatrix(lngRow, mlngColRate) = C2Dbl(strResult)
End If
intCount = intCount + 1
If GetString(strValue, strResult, intCount, Asc(",")) Then
lngRow = msgMutiCurr.Row
msgMutiCurr.TextMatrix(lngRow, mlngColCurrAmount) = C2Dbl(strResult)
End If
intCount = intCount + 1
If GetString(strValue, strResult, intCount, Asc(",")) Then
lngRow = msgMutiCurr.Row
msgMutiCurr.TextMatrix(lngRow, mlngColAmount) = C2Dbl(strResult)
End If
mclsList_AfterRefresh lngRow
End Sub
Private Sub LoadCurrencyOther(ByVal lngID As Long, ByVal lngRow As Long)
Dim lngCol As Long
Dim dblRate As Double
Dim strSql As String
Dim recCurrencys As rdoResultset
strSql = "SELECT * FROM Currencys WHERE lngCurrencyID=" & lngID
Set recCurrencys = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If Not recCurrencys.EOF Then
With msgMutiCurr
.TextMatrix(lngRow, mlngColInDirect) = recCurrencys!blnIsIndirect
.TextMatrix(lngRow, mlngColCurrDec) = recCurrencys!bytCurrencydec
.TextMatrix(lngRow, mlngColRateDec) = recCurrencys!bytRateDec
If GetValue(lngRow, mlngColAmount) = 0 Then
If mlngCurrID = gclsBase.NaturalCurId Then
.TextMatrix(lngRow, mlngColRate) = 1
Else
dblRate = BillPublic.RateValue(lngID, gclsBase.BaseDate)
If dblRate <> 0 Then
.TextMatrix(lngRow, mlngColRate) = dblRate
End If
End If
End If
End With
End If
recCurrencys.Close
Set recCurrencys = Nothing
End Sub
Public Sub EditCard(lngAlterID As Long, Optional blnLock As Boolean = False)
Dim lngCnt As Long
lngCnt = msgMutiCurr.Rows
mblnLocked = blnLock
If AlterID <> lngAlterID Or AlterID = -1 Then
AlterID = lngAlterID
End If
For lngCnt = 1 To msgMutiCurr.Cols - 1
mclsList.ReadOnlyCol(lngCnt) = mblnLocked
Next lngCnt
cmdOk(1).Enabled = (Not mblnLocked)
' RefreshLtxtCurr gclsBase.NaturalCurId
Show vbModal
End Sub
Public Property Get AlterID() As Long
AlterID = mlngAlterID
End Property
Public Property Let AlterID(ByVal vNewValue As Long)
msgMutiCurr.Rows = 1
mlngAlterID = vNewValue
RefreshGrid
End Property
Public Property Get Total() As Double
If DataIsVoid("") Then
Total = mdblTotal
Else
Total = 0
End If
End Property
Public Property Get CurrencyStr() As String
Dim lngRow As Long
Dim strCurrency As String
With msgMutiCurr
For lngRow = 1 To .Rows - 1
If .RowHeight(lngRow) > 100 And .TextMatrix(lngRow, mlngColCurr) <> "" Then
If strCurrency <> "" Then
strCurrency = strCurrency & " / "
End If
strCurrency = strCurrency & .TextMatrix(lngRow, mlngColCurr) & "(" & .TextMatrix(lngRow, mlngColCurrAmount) & ")"
End If
Next lngRow
End With
CurrencyStr = strCurrency
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 lngCurrID As Long
Dim dblRate As Double
Dim dblCurrAmount As Double
Dim dblAmount As Double
Dim lngID As Long
Dim blnNew As Boolean
Dim lngFixedAlterID As Long
Dim lngAutoID 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 FixedCost WHERE lngFixedAlterID=-1"
gclsBase.ExecSQL strSql
End If
End If
With msgMutiCurr
For lngRow = 1 To .Rows - 1
lngID = GetValue(lngRow, mlngColID)
lngCurrID = GetValue(lngRow, mlngColCurrID)
dblRate = GetValue(lngRow, mlngColRate)
dblCurrAmount = GetValue(lngRow, mlngColCurrAmount)
dblAmount = GetValue(lngRow, mlngColAmount)
If lngCurrID > 0 Then
If lngID > 0 And (Not blnNew) Then
If .RowHeight(lngRow) > 100 Then
strSql = "UPDATE FixedCost SET lngCurrencyID=" & lngCurrID _
& ",dblRate=" & dblRate & ",dblCurrAmount=" & dblCurrAmount _
& ",dblAmount=" & dblAmount & ",lngFixedAlterID=" & lngFixedAlterID _
& " WHERE lngFixedCostID=" & lngID
Else
strSql = "DELETE FROM FixedCost WHERE lngFixedCostID=" & lngID
End If
ElseIf .RowHeight(lngRow) > 100 Then
lngAutoID = GetNewID("FixedCost")
strSql = "INSERT INTO FixedCost (lngFixedCostID,lngFixedAlterID,lngCurrencyID,dblRate,dblCurrAmount,dblAmount) " _
& "VALUES (" & lngAutoID & "," & lngFixedAlterID & "," & lngCurrID & "," & dblRate & "," & dblCurrAmount & "," & dblAmount & ")"
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 GetCost() As rdoResultset
Dim strSql As String
strSql = "SELECT lngFixedCostID,FixedCost.lngCurrencyID,blnIsIndirect,bytCurrencyDec,bytRateDec," _
& "strCurrencyName As 币种," _
& "dblRate As 汇率,dblCurrAmount As 原币金额,dblAmount As 本币金额" _
& " FROM FixedCost " _
& ", Currencys WHERE FixedCost.lngCurrencyID=Currencys.lngCurrencyID " _
& "AND lngFixedAlterID=" & IIf(mlngAlterID = 0, -1, mlngAlterID)
Set GetCost = 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 strCurr As String
Dim dblRate As Double
Dim dblCurrAmount As Double
Dim dblAmount As Double
Dim strSql As String
Dim recCurrency As rdoResultset
DataIsVoid = True
lngCnt = 0
mdblTotal = 0
Msg = ""
With msgMutiCurr
For lngRow = 1 To .Rows - 1
strCurr = GetValue(lngRow, mlngColCurr, "String")
If .RowHeight(lngRow) <= 100 Then
strCurr = ""
End If
If .RowHeight(lngRow) > 100 And strCurr <> "" Then
dblRate = GetValue(lngRow, mlngColRate)
dblCurrAmount = GetValue(lngRow, mlngColCurrAmount)
dblAmount = GetValue(lngRow, mlngColAmount)
If strCurr <> "" And dblCurrAmount > 0 And dblAmount > 0 Then
lngCnt = lngCnt + 1
mdblTotal = mdblTotal + dblAmount
ElseIf strCurr = "" And dblAmount > 0 Then
DataIsVoid = False
Msg = "币种不能为空！"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -