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