formatdesignlist.frm

金算盘软件代码

                End If
            End If
            UpdateMenuStatus
        End If
    End With
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
    Dim recRecordset As rdoResultset
    
    Set recRecordset = GetByTemplateID(GettemplateID)
    If IsSysTemplate(GettemplateID) Then
        MsgBox "不能停用预制模版！", vbExclamation, "单据模版"
        Exit Sub
    End If
    With recRecordset
        If .EOF Then
            MsgBox "当前模版已被其它用户删除！请刷新列表", vbExclamation
        Else
            If UpdatePaymentMethodInActive(GettemplateID, Not PaymentMethodIsInActive) Then
                With msgTemplate
                    If .TextMatrix(.Row, 1) = "" Then
                        .TextMatrix(.Row, 1) = "√"
                    Else
                        .TextMatrix(.Row, 1) = ""
                    End If
                End With
                mclsMainControl_ToolRefresh
            End If
        End If
    End With
    recRecordset.Close
    UpdateMenuStatus
End Sub

'全部显示/显示未停用记录
Private Sub mclsMainControl_EditShowAll()
    frmMain.mnuEditShowAll.Checked = Not frmMain.mnuEditShowAll.Checked
    If chkShowAll.Value = 0 Then
        chkShowAll.Value = 1
    Else
        chkShowAll.Value = 0
    End If
End Sub

'引用编码
Private Sub mclsMainControl_EditUse()
    UseCode Message.msgTemplate, GettemplateID
    Me.ZOrder 1
End Sub

'搜索
Private Sub mclsMainControl_EditSearch()
    frmTreeFind.ShowFind
End Sub

'刷新
Private Sub mclsMainControl_ToolRefresh()
    Dim strOldText As String
    Dim strOldSort As String
    
    Me.MousePointer = vbHourglass
    With msgTemplate
        
        '保存当前排序列
        strOldSort = cboFindKind.Text
        strOldText = .TextMatrix(.Row, mclsList.SortCol)
        .Redraw = False
        
        '刷新列表记录
        .Cols = 0
        Set datPaymentMethod.Resultset = GetList()
        If datPaymentMethod.Resultset.RowCount > 0 Then datPaymentMethod.Resultset.MoveLast
        datPaymentMethod.Resultset.Close
        mclsList.SetFlexGrid
        
        '恢复以前排序列
        cboFindKind.Text = strOldSort
        cboFindKind.Text = strOldSort
        .Redraw = False
        If .Rows > 1 Then
            TxtFind.Text = strOldText
        End If
        If chkShowAll.Value = 0 Then mclsList.DoShowAll False
        
        '更新菜单状态
        UpdateMenuStatus
        .Redraw = True
        
        '发出付款条件消息
        gclsSys.SendMessage CStr(Me.hWnd), Message.msgTemplate
    End With
    Me.MousePointer = vbDefault
End Sub

'打印
Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    mclsList.ReGetColCaption
    myPrintclass.PrintList gclsBase.BaseDB, mclsList.FlexGrid, 60, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mclsList.AddReGetColCaption
    Set myPrintclass = Nothing
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Select Case intIndex
    Case 0:
        'mclsMainControl_EditEdit
        mblnEdit = True
    Case 1:
        mblnNew = True
        'mclsMainControl_EditNew
    Case 2:
        'FrmNewTemplate.DelCard GettemplateID
        'DelTemplate
        mclsMainControl_EditDel
    Case 4:
         mclsMainControl_EditInActive
    Case 5:
        mclsMainControl_EditShowAll
    Case 7:
        mclsMainControl_EditUse
    Case 8:
        mclsMainControl_EditSearch
    Case 10:
        mclsMainControl_EditFilter
    Case 11:
        mclsMainControl_EditColumn
    Case 13:
        mclsMainControl_ToolRefresh
    Case 14
        mclsMainControl_FilePrint
    End Select
End Sub

'
' 编辑菜单
'
Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        
        Utility.CloneMenu .mnuEditEdit, .mnuListEditMenu(0)
        
        Load .mnuListEditMenu(1)
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(1)
        
        Load .mnuListEditMenu(2)
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2)
        .mnuListEditMenu(2).Caption = "删除(&D)"
        
        Load .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3)
        
        Load .mnuListEditMenu(4)
        Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(4)
        .mnuListEditMenu(4).Caption = "停用(&H)"
        .mnuListEditMenu(4).Visible = True
        
        Load .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(5)
        .mnuListEditMenu(5).Caption = "全部显示(&W)"
        .mnuListEditMenu(5).Visible = True
        
        Load .mnuListEditMenu(6)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(6)
        .mnuListEditMenu(6).Visible = True
        
        Load .mnuListEditMenu(7)
        Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(7)
        
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditSearch, .mnuListEditMenu(8)
        .mnuListEditMenu(8).Visible = False
        
        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9)
        .mnuListEditMenu(9).Visible = False
        
        Load .mnuListEditMenu(10)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(10)
        
        Load .mnuListEditMenu(11)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(11)
        
        Load .mnuListEditMenu(12)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(12)
        
        Load .mnuListEditMenu(13)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(13)
        
        Load .mnuListEditMenu(14)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(14)
    End With
End Sub

Private Sub cmdEdit_Click(Index As Integer)
On Error GoTo ErrHandle
    If Index = 0 Then
        UpdateMenuStatus
        MakeListEditMenu
        mblnEdit = False
        mblnNew = False
        PopupMenu frmMain.mnuListEdit, , cmdEdit(0).Left, cmdEdit(0).top + cmdEdit(0).Height
        If mblnEdit Then
            mclsMainControl_EditEdit
            mblnEdit = False
        End If
        If mblnNew Then
            mclsMainControl_EditNew
            mblnNew = False
        End If
    Else
'        If IsaSysTemplate(GettemplateID) Then
'            ShowMsg 0, "不能修改预制模板！", vbExclamation + vbOKOnly + MB_TASKMODAL, "修改模板"
'           ' Unload Me
'            Exit Sub
'        Else
            Dim XX As FormatDesignClass
            Set XX = New FormatDesignClass
            XX.ShowDesign gclsBase.BaseDB, GettemplateID
       ' End If
    End If
    Exit Sub
ErrHandle:
    MsgBox Err.Description, vbOKOnly + vbCritical, "模板设计"
End Sub

'Private Sub cmdActivity_Click()
'    'MakeListActivityMenu
'
'    PopupMenu frmMain.mnuListActivity, , cmdActivity.Left, cmdActivity.top + cmdActivity.Height
'End Sub
'
' 报表菜单
'
Private Sub MakeListReportMenu()
    Dim intCnt As Integer
    
'    With frmMain
'        For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
'            Unload .mnuListReportMenu(intCnt)
'        Next
'
'        Utility.CloneMenu .mnuReportQuick, .mnuListReportMenu(0)
'    End With
End Sub

Public Function GettemplateID() As Long
    With msgTemplate
        If .TextMatrix(.Row, 0) <> "" And .Row > 0 Then
            GettemplateID = CLng(.TextMatrix(.Row, 0))
        Else
            GettemplateID = 0
        End If
    End With
End Function

Private Sub DelTemplate()
    Dim lngID As Long
    Dim ret As Integer
    lngID = GettemplateID()
    If IsSysTemplate(lngID) Then
        MsgBox "不能删除预制模版！", vbExclamation, "删除单据模版"
        Exit Sub
    End If
    If mIsShowCard Then
        If lngID = FrmNewTemplate.mlngTemplateID Then
            MsgBox "不能删除当前正在编辑的模版！", vbExclamation, "删除单据模版"
            FrmNewTemplate.SetFocus
            Exit Sub
        End If
       End If
    If IsUsePaymentMethodID(lngID) Then
        MsgBox "当前编辑的模版正在使用，不能删除！", vbExclamation, "删除单据模版"
    Else
          ret = MsgBox("您确实要删除 “" & CurrCodeName & "”吗？", vbYesNo Or vbQuestion, "删除单据模版")
          If ret = vbYes Then
 
               If DelByPaymentMethodID(lngID) Then
                    mclsMainControl_ToolRefresh
               End If
          End If
    End If
End Sub
Public Function GetByTemplateID(ByVal lngID As Long) As rdoResultset
    Dim recRecordset As rdoResultset
    Dim strSql As String
    
    strSql = "Select * From template Where lngTemplateID = " & lngID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Set GetByTemplateID = recRecordset
End Function

Private Function IsSysTemplate(ByVal lngID As Long) As Boolean
   IsSysTemplate = GetblnCol(lngID, "blnIsSys")
End Function
Private Function GetblnCol(ByVal lngID As Long, ByVal strCol As String) As Boolean
    Dim recRecordset As rdoResultset
    Dim strSql As String
    
    strSql = "Select " & strCol & " From template Where lngTemplateID = " & lngID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recRecordset
        If Not .EOF Then
            If .rdoColumns(0) Then
                GetblnCol = True
            Else
                GetblnCol = False
            End If
        Else
            GetblnCol = False
        End If
        .Close
    End With
    
End Function
'Private Sub OpenCard(ByVal lngID As Long)
'
'        If Not IsSysTemplate(lngID) Then
'            FrmNewTemplate.EditCard lngID
'        Else
'            MsgBox "不能编辑预制模板！"
'        End If
'End Sub

'停用标志
Public Function IsInActive(ByVal lngID As Long) As Boolean
   IsInActive = GetblnCol(lngID, "blnIsInActive")
End Function

'当前编码名称
Private Function CurrCodeName() As String
    Dim strCode As String
    Dim strName As String
    Dim i As Integer
    With mclsList.FlexGrid
        If .Row > 0 Then
            For i = 0 To mclsList.ListSet.FixColumns - 1
                If .TextMatrix(0, 2 + i) = "单据类型" Or .TextMatrix(0, 2 + i) = "单据类型↑" Or .TextMatrix(0, 2 + i) = "单据类型↓" Then
                    strCode = .TextMatrix(.Row, 2 + i)
                ElseIf .TextMatrix(0, i + 2) = "模版名称" Or .TextMatrix(0, i + 2) = "模版名称↑" Or .TextMatrix(0, i + 2) = "模版名称↓" Then
                    strName = .TextMatrix(.Row, 2 + i)
                End If
            Next
        End If
    End With
    CurrCodeName = Trim(strCode) & "”的模版 “" & Trim(strName)
End Function

'模板ID
Private Function GettemplateTypeID() As Long
    Dim strSql As String
    Dim recTemplete As rdoResultset
    strSql = "Select lngReceiptTypeID from Template where Template.lngTemplateID=" & GettemplateID
    Set recTemplete = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    GettemplateTypeID = recTemplete!lngReceiptTypeID
End Function

'当前列
Private Function GetCol(ByVal strColName As String) As Integer
    Dim i As Integer
    With mclsList.FlexGrid
         For i = 1 To .Cols - 1
             If .TextMatrix(0, i) = strColName Or .TextMatrix(0, i) = strColName & "↑" Or .TextMatrix(0, i) = strColName & "↓" Then
                GetCol = i
                Exit For
             End If
         Next
    End With
End Function

'是否是系统模板
Private Function IsaSysTemplate(ByVal lngID As Long) As Boolean
   IsaSysTemplate = GetIsblnCol(lngID, "blnIsSys")
End Function

Private Function GetIsblnCol(ByVal lngID As Long, ByVal strCol As String) As Boolean
    Dim recRecordset As rdoResultset
    Dim strSql As String
    strSql = "Select " & strCol & " From template Where lngTemplateID = " & lngID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recRecordset
        If Not .EOF Then
            If .rdoColumns(0) Then
                GetIsblnCol = True
            Else
                GetIsblnCol = False
            End If
        Else
            GetIsblnCol = False
        End If
        .Close
    End With
End Function
Public Function BindingResultSet()
    Me.Hide
     '得到付款条件列表记录集
    Set datPaymentMethod.Resultset = GetList()
    If datPaymentMethod.Resultset.RowCount > 0 Then datPaymentMethod.Resultset.MoveLast
    datPaymentMethod.Resultset.Close
    Debug.Print "Load Recorset End: ", Timer
    mclsList.SetFlexGrid
    
    '初始化查找复合列表框
    mclsList.InitcboFindKind
    mclsList.FlexNoChange = False
    mclsList.FindNoChange = False
    
    '设置第一行为选定行
    With msgTemplate
        If .Rows > 1 Then msgTemplate.Row = 1
        .col = 0
        .ColSel = .Cols - 1
    End With
    mclsList.DoShowAll False
    UpdateMenuStatus
    If GetCol("所属单据") > 0 Then mclsList.FlexGrid.ColWidth(GetCol("所属单据")) = 0
    Me.Show
    Me.ZOrder 0
End Function