frmdefinesetcard.frm

金算盘软件代码

End
Attribute VB_Name = "frmDefineSetCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  自定项目设置卡片
'  作者：邓江
'  日期：1998.06.24
'
'  功能：设置自定项目的标题、可否使用、和是否编码
'
'  接口： EditCard  修改自定项目设置。
'                   参数：intModal 显示模式
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mblnChange As Boolean    '判断是否修改
Private mblnIsInit As Boolean
Private mrecDefineSet As rdoResultset
Private mintCounter As Integer
Private mstrSql As String
Private mintMsgReturn As Integer

'进入修改自定项目设置
Public Sub EditCard()
    
    On Error Resume Next
    mblnIsInit = True
    SelectRecord
    mblnChange = False
     
    Show vbModal
End Sub

'读出数据库内的相应的自定项目设置数据
Private Sub SelectRecord()
    Set mrecDefineSet = gclsBase.BaseDB.OpenResultset _
      ("SELECT strSetting FROM Setting WHERE lngModuleID=8 ORDER BY strKey", _
      rdOpenStatic)
    For mintCounter = 0 To 5
        If mrecDefineSet.EOF Then Exit For
        txtTitle(mintCounter).Text = mrecDefineSet!strSetting

        mrecDefineSet.MoveNext
        If mrecDefineSet.EOF Then Exit For
        If mrecDefineSet!strSetting = "True" Then
            chkUse(mintCounter).Value = Checked
        Else
            chkUse(mintCounter).Value = Unchecked
        End If
        mrecDefineSet.MoveNext
    Next mintCounter
    mblnIsInit = False
End Sub

Private Sub chkUse_Click(Index As Integer)
    mblnChange = True
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub

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

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
'    SetHelpID hwnd, 16009
    Utility.LoadFormResPicture Me
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_Paint()
    FrameBox Me.hwnd, 150, 180, 3470, 2800  '画边框
End Sub

'检查标题的有效性
Private Function validityCheck() As Boolean
    Dim intCounter As Integer
    
    For mintCounter = 0 To 5
        If StrLen(Trim(txtTitle(mintCounter).Text)) = 0 Then
            ShowMsg Me.hwnd, "自定项目标题不能为空。", _
                vbExclamation + vbOKOnly, "商品自定项目设置"
            validityCheck = False
            txtTitle(mintCounter).SelStart = 0
            txtTitle(mintCounter).SelLength = StrLen(txtTitle(mintCounter).Text)
            txtTitle(mintCounter).SetFocus
            Exit Function
        End If
        If mintCounter < 5 Then
            For intCounter = mintCounter + 1 To 5
                If txtTitle(mintCounter).Text = txtTitle(intCounter).Text Then
                    ShowMsg Me.hwnd, "自定项目标题已重复，请重新输入。", _
                        vbExclamation + vbOKOnly, "商品自定项目设置"
                    validityCheck = False
                    txtTitle(intCounter).SelStart = 0
                    txtTitle(intCounter).SelLength = StrLen(txtTitle(intCounter).Text)
                    txtTitle(intCounter).SetFocus
                    Exit Function
                End If
            Next intCounter
        End If
    Next mintCounter
    validityCheck = True
End Function

'数据库的修改操作
Private Function SaveCard() As Boolean
    Dim blnSQLExec As Boolean
    
    On Error GoTo ErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
    For mintCounter = 0 To 5
        If chkUse(mintCounter).Value = Checked Then '修改使用记录
            mstrSql = "UPDATE Setting SET strSetting = 'True' " _
                & " WHERE strKey = '自定项目" & mintCounter & "使用'"
        Else
            mstrSql = "UPDATE Setting SET strSetting = 'False' " _
                & " WHERE strKey = '自定项目" & mintCounter & "使用'"
        End If
        blnSQLExec = gclsBase.ExecSQL(mstrSql)
        If Not blnSQLExec Then
            mintMsgReturn = ShowMsg(Me.hwnd, "设置" & txtTitle(mintCounter).Text _
                & "的使用不成功,是否重新设置？", vbExclamation + vbOKCancel, _
                "商品自定项目设置")
            If mintMsgReturn = vbOK Then
                txtTitle(mintCounter).SelStart = 0
                txtTitle(mintCounter).SelLength = StrLen(txtTitle(mintCounter).Text)
                txtTitle(mintCounter).SetFocus
                SaveCard = False
                GoTo ErrHandle
            End If
        End If
        
        mstrSql = "UPDATE TemplateFormat SET blnCanShow=" _
            & chkUse(mintCounter).Value & ",blnIsCanPrint=" _
            & chkUse(mintCounter).Value & " WHERE strFieldDesc='" _
            & "自定项目" & mintCounter & "'"
        If Not gclsBase.ExecSQL(mstrSql) Then GoTo ErrHandle
        
        mstrSql = "UPDATE Setting  SET strSetting = '" & txtTitle(mintCounter).Text _
            & "' WHERE strKey = '自定项目" & mintCounter & "名称'"    '修改标题记录
        blnSQLExec = gclsBase.ExecSQL(mstrSql)
        If Not blnSQLExec Then
            mintMsgReturn = ShowMsg(Me.hwnd, "设置" & txtTitle(mintCounter).Text _
                & "的名称不成功,是否重新设置？", vbExclamation + vbOKCancel, _
                "商品自定项目设置")
            If mintMsgReturn = vbOK Then
                txtTitle(mintCounter).SelStart = 0
                txtTitle(mintCounter).SelLength = StrLen(txtTitle(mintCounter).Text)
                txtTitle(mintCounter).SetFocus
                SaveCard = False
                GoTo ErrHandle
            End If
        End If
        
        mstrSql = "UPDATE TemplateFormat SET strControlLabel='" _
            & txtTitle(mintCounter).Text & "' WHERE strFieldDesc='" _
            & "自定义项目" & mintCounter & "'"
        If Not gclsBase.ExecSQL(mstrSql) Then GoTo ErrHandle
        
        mstrSql = "UPDATE ViewField SET strViewFieldDesc='" & txtTitle(mintCounter).Text _
            & "编码' WHERE lngViewID=" & mintCounter + 24 & " AND strViewFieldDesc LIKE " _
            & "'*编码'"
        If Not gclsBase.ExecSQL(mstrSql) Then GoTo ErrHandle
        mstrSql = "UPDATE ViewField SET strViewFieldDesc='" & txtTitle(mintCounter).Text _
            & "名称' WHERE lngViewID=" & mintCounter + 24 & " AND strViewFieldDesc LIKE " _
            & "'*名称'"
        If Not gclsBase.ExecSQL(mstrSql) Then GoTo ErrHandle
        mstrSql = "UPDATE ViewField SET strViewFieldDesc='" & txtTitle(mintCounter).Text _
            & "全称' WHERE lngViewID=" & mintCounter + 24 & " AND strViewFieldDesc LIKE " _
            & "'*全称'"
        If Not gclsBase.ExecSQL(mstrSql) Then GoTo ErrHandle
        mstrSql = "UPDATE ViewField SET strViewFieldDesc='" & txtTitle(mintCounter).Text _
            & "' WHERE lngViewFieldID=" & mintCounter + 577
        If Not gclsBase.ExecSQL(mstrSql) Then GoTo ErrHandle
    Next mintCounter
    gclsBase.BaseWorkSpace.CommitTrans
    SaveCard = True
    mblnChange = False
    gclsSys.SendMessage Me.hwnd, Message.msgDefinedSetTittle
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
End Function

Private Sub cmdOKOrCancel_Click(Index As Integer)
    Select Case Index
        Case 0   '确定
            If validityCheck Then
                If SaveCard Then Unload Me
            End If
        Case 1   '取消
            Unload Me
    End Select
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsgReturn As Integer
    
    If UnloadMode <> vbFormControlMenu Then Exit Sub
    If mblnChange Then
        intMsgReturn = ShowMsg(Me.hwnd, "当前自定项目设置已被修改，是否保存？", _
        vbExclamation + vbYesNoCancel, "商品自定项目设置")
        If intMsgReturn = vbYes Then
            Cancel = Not SaveCard()
        ElseIf intMsgReturn = vbCancel Then
            Cancel = True
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Utility.UnLoadFormResPicture Me
    mblnChange = False
End Sub

Private Sub txtTitle_Change(Index As Integer)
    If ContainErrorChar(txtTitle(Index).Text, ",-_ '""`~@#$^^!&*(){}[]:;./?") Then BKKEY txtTitle(Index).hwnd
    If Not mblnIsInit Then mblnChange = True
End Sub