frmfixedmethodcard.frm

金算盘软件代码

'Private WithEvents mclsMainControl As MainControl '主控对象
Private mblnAddRecord As Boolean                  '是增加记录还是修改记录
Private mblnIsExist As Boolean
Private mblnIsList As Boolean
Private mblnIsRefer As Boolean
Private mstrListTextBuffer(3) As String           '暂存列表框输入值，以备新增
Private mlngListIDBuffer(3) As Long               '暂存列表框选择的ID，以备修改或删除
Private mfmrFixedMethod As FixedMethodRecord      '暂存读写记录的数据
Private mstrSQLBuffer() As String                 '暂时存储对数据库的增删改操作
Private mintSQLIndex As Integer                   'strSQLBuffer的索引
Private mstrInitCode As String                    '暂存编码的初始值，以备判断是否修改
Private ID As Long
Private mlngTemplateID As Long
Private mblnIsEditAdd As Boolean   'listtext框的edit和Add事件是否发生
Private mblnIsChanged As Boolean  '编辑是否改变
Private mtext As String   '直接输入的摘要内容
Private mblnIsCancel As Boolean     '是否是敲了CANCEL键

Public Function AddFixedMethod(ByVal strFixed As String) As Integer
    Dim strFixedMethodCode As String, strFixedMethodName As String
    Dim blnIsInActive As Boolean, strFixedMethodType As String
    Dim lngAccountID As Long, lngVoucherTypeID As Long
    Dim lngTemplateID As Long, strRemark As String
    Dim strTemp As String
    
    AddFixedMethod = 0
    If Not GetString(strFixed, strFixedMethodCode, 1) Then Exit Function
    If Not GetString(strFixed, strFixedMethodName, 2) Then Exit Function
    If Not GetString(strFixed, strTemp, 6) Then Exit Function
    blnIsInActive = (strTemp = "1")
    If Not GetString(strFixed, strFixedMethodType, 7) Then Exit Function
    If Not GetString(strFixed, strTemp, 5) Then Exit Function
    lngAccountID = CLng(strTemp)
    If Not GetString(strFixed, strTemp, 3) Then Exit Function
    lngVoucherTypeID = CLng(strTemp)
    If Not GetString(strFixed, strTemp, 4) Then Exit Function
    lngTemplateID = CLng(strTemp)
    If Not GetString(strFixed, strRemark, 8) Then Exit Function
    
    If strFixedMethodCode = "" Or strFixedMethodName = "" Then Exit Function
'    txtInput(0).Text = strFixedMethodCode
'    txtInput(1).Text = strFixedMethodName
    mfmrFixedMethod.strFixedMethodCode = strFixedMethodCode
    mfmrFixedMethod.strFixedMethodName = strFixedMethodName
    If ItemIsExist("Account", "lngAccountID", lngAccountID) Then
        mfmrFixedMethod.lngAccountID = lngAccountID
    Else
        mfmrFixedMethod.lngAccountID = 0
    End If
    If ItemIsExist("VoucherType", "lngVoucherTypeID", lngVoucherTypeID) Then
        mfmrFixedMethod.lngVoucherTypeID = lngVoucherTypeID
    Else
        mfmrFixedMethod.lngVoucherTypeID = 0
    End If
    If ItemIsExist("Template", "lngTemplateID", lngTemplateID) Then
        mfmrFixedMethod.lngTemplateID = lngTemplateID
    Else
        Exit Function
    End If
    mfmrFixedMethod.blnIsInActive = blnIsInActive
    mfmrFixedMethod.strFixedMethodType = strFixedMethodType
    mfmrFixedMethod.strRemark = strRemark
    mintSQLIndex = 0
'    chkPause.Value = IIf(blnIsInActive, Checked, Unchecked)
    mblnAddRecord = True
    If Not SaveCard(True, True) Then Exit Function
    AddFixedMethod = 1
End Function


'进入新增固资变动方式
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0, _
    Optional ByVal IsList As Boolean = False) As Long
    mblnAddRecord = True
    frmFixedMethodCard.Caption = "新增固资变动方式"
    cmdOKCancel(2).Visible = True
    mblnIsList = IsList
    InitAddCard strName
    Show intModal
    AddCard = ID
End Function

'初始化暂存读写记录的数据的自定义类型变量和卡片
Private Sub InitAddCard(Optional strName As String)
    Dim intCounter As Integer
    
    With mfmrFixedMethod
        .lngFixedMethodID = 0
        .strFixedMethodName = ""
        .strFixedMethodCode = ""
        .blnIsInActive = False
        .strFixedMethodType = "1"
        .lngTemplateID = 0
        .lngAccountID = 0
        .lngVoucherTypeID = 0
        .strRemark = ""
    End With
    
    If txtInput(0).Text = "Text1" Or txtInput(0).Text = "" Then
        txtInput(0).Text = ""
    Else
        txtInput(0).Text = GetNextCode(txtInput(0).Text)
        mstrInitCode = txtInput(0).Text
    End If
    txtInput(1).Text = strName
    For intCounter = 0 To 3
        lstMethod(intCounter).Text = ""
        mstrListTextBuffer(intCounter) = ""
        mlngListIDBuffer(intCounter) = 0
    Next intCounter
    mtext = ""
    chkPause.Value = Unchecked
    InitBuffer '清空暂时存储数据库操作的数组
End Sub

'进入修改固资变动方式
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0)
    mblnAddRecord = False
    frmFixedMethodCard.Caption = "修改固资变动方式"
    cmdOKCancel(2).Visible = False
    SelectRecord lngID   '查找记录
'    SendKeys "%C"
    Show intModal
End Sub

'查找出想修改的固资变动方式编码记录，存放在自定义类型变量中，设置想修改项
Private Sub SelectRecord(ByVal lngRecordID As Long)
    Dim strSql As String
    Dim recSetting As rdoResultset
    Dim lngID As Long
    
    With mfmrFixedMethod
        .lngFixedMethodID = lngRecordID
        strSql = "SELECT * FROM FixedMethod WHERE lngFixedMethodID=" & .lngFixedMethodID
        Set recSetting = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recSetting.EOF Then
            mblnAddRecord = True
            InitAddCard
            recSetting.Close
            Exit Sub
        End If
        .strFixedMethodName = recSetting!strFixedMethodName
        .strFixedMethodCode = recSetting!strFixedMethodCode
        .blnIsInActive = (recSetting!blnIsInActive = 1)
        .strFixedMethodType = recSetting!strFixedMethodType
        .lngAccountID = recSetting!lngAccountID
        .lngTemplateID = recSetting!lngTemplateID
        .lngVoucherTypeID = recSetting!lngVoucherTypeID
        .strRemark = recSetting!strRemark
        
        txtInput(0).Text = .strFixedMethodCode
        txtInput(1).Text = .strFixedMethodName
        If .blnIsInActive Then
            chkPause.Value = Checked
        Else
            chkPause.Value = Unchecked
        End If
        If .strFixedMethodType = "1" Then
            optType(0).Value = True
        Else
            optType(1).Value = True
        End If
        strSql = "SELECT lngAccountID FROM Account WHERE lngAccountID =" & .lngAccountID
        Set recSetting = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recSetting.EOF Then
          ' lstMethod(0).Text = recSetting!strAccountName
           lngID = recSetting!lngAccountID
           settlistbox lstMethod(0), 0
           lstMethod(0).SeekCol = "1,2,3"
           lstMethod(0).SeekId lngID
        End If
        strSql = "SELECT lngTemplateID FROM Template  WHERE lngTemplateID=" & .lngTemplateID
        Set recSetting = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recSetting.EOF Then
           'lstMethod(1).Text = recSetting!strTemplateName
           lngID = recSetting!lngTemplateID
           settlistbox lstMethod(1), 1
           lstMethod(1).SeekCol = "1,2"
           lstMethod(1).SeekId lngID
        End If
        strSql = "SELECT lngVoucherTypeID FROM VoucherType WHERE lngVoucherTypeID=" _
            & .lngVoucherTypeID
        Set recSetting = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recSetting.EOF Then
               'lstMethod(2).Text = recSetting!strVoucherTypeName
               lngID = recSetting!lngVoucherTypeID
               settlistbox lstMethod(2), 2
               lstMethod(2).SeekCol = "1,2,3"
               lstMethod(2).SeekId lngID
            End If
'        Strsql = "select * from remark where strRemarkCode='" & .strRemark & "'"
'        Set recSetting = gclsBase.BaseDB.openresultset(Strsql, rdopenstatic)
'        If Not recSetting.EOF Then
'           lngID = recSetting!lngRemarkID
           setlistbox lstMethod(3), 14
'           lstMethod(3).SeekCol = "1,2,3"
'           lstMethod(3).SeekId lngID
'        Else
'           lstMethod(3).Text = ""
'        End If
        lstMethod(3).Text = .strRemark
        mtext = .strRemark
        InitBuffer '清空暂时存储数据库操作的数组
        txtInput(0).SelStart = 0
        txtInput(0).SelLength = StrLen(txtInput(0).Text)
'        txtInput(0).SetFocus
        recSetting.Close
    End With
End Sub

'进入删除固资变动方式，判断记录是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngID As Long, Optional ByVal lnghWnd As Long = 0) As Boolean
    Dim strSql As String
    Dim recSelect As rdoResultset
    Dim intMsgReturn As Integer
    Dim blnSQLExec As Boolean

    DelCard = False
    strSql = "SELECT * FROM FixedMethod WHERE lngFixedMethodID=" & lngID
    Set recSelect = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recSelect.EOF Then
        recSelect.Close
        Exit Function
    End If
'    If frmFixedTypeList.IsShowCard(1) Then
'       If lngID = frmFixedMethodListCard.FixedMethodID Then
'          ShowMsg lnghWnd, "不能删除正在修改的固资变动方式！", _
'                     vbExclamation + MB_TASKMODAL, "删除固资变动方式"
'          'frmFixedMethodCard.Show
'          Exit Function
'       End If
'    End If
    If CodeUsed(lngID) Then
        intMsgReturn = ShowMsg(lnghWnd, "“" & recSelect!strFixedMethodName & "”固资变动方式已经有业务发生，不能删除！", _
            vbExclamation + MB_TASKMODAL, "删除固资变动方式")
    Else
        intMsgReturn = ShowMsg(lnghWnd, "你确实要删除" & recSelect!strFixedMethodName & "固资变动方式？", _
            vbQuestion + vbYesNo + MB_TASKMODAL, "删除固资变动方式")
        If intMsgReturn = vbYes Then
            strSql = "DELETE FROM FixedMethod  WHERE lngFixedMethodID = " & lngID
            blnSQLExec = gclsBase.ExecSQL(strSql)
            If blnSQLExec Then
               gclsSys.SendMessage CStr(Me.hwnd), Message.msgFixedMethod
            End If
        End If
    End If
    DelCard = blnSQLExec
   ' frmFixedMethodList.IsShowCard = False
    recSelect.Close
End Function

'判断记录是否被使用（可能有多张表会使用此编码）
Private Function CodeUsed(lngID As Long) As Boolean
    CodeUsed = True
    If CheckIDUsed("FixedAlter", "lngFixedMethodID", lngID) Then Exit Function
    CodeUsed = False
End Function


Private Sub chkPause_Click()
    mblnIsChanged = True
End Sub

Private Sub cmdOKCancel_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Index = 1 Then mblnIsCancel = True
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
    frmMain.mnuEditShowList.Enabled = True
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim i As Integer
    
    mblnIsRefer = False
    If KeyCode = vbKeyEscape Or KeyCode = vbKeyReturn Then
        For i = 0 To 3
            If lstMethod(i).ReferVisible Then mblnIsRefer = True
        Next i
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If mblnIsList Then
        mblnIsList = False
        Exit Sub
    End If
    If KeyAscii = vbKeyReturn Then
        If Not mblnIsRefer Then
            BKKEY Me.ActiveControl.hwnd, vbKeyTab
        End If
    ElseIf KeyAscii = vbKeyEscape Then
        cmdOKCancel(1).Value = Not mblnIsRefer
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdOKCancel(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    On Error GoTo ErrHandle
    Utility.LoadFormResPicture Me

    'Set mclsMainControl = gclsSys.MainControls.Add(Me)
'    SetHelpID Me.hwnd, 30049
   ' frmFixedMethodList.IsShowCard = True
    mlngTemplateID = 41
'    SendKeys "%{C}"