frmiteminitlist.frm

金算盘软件代码

            
'            FormatGridMe
            '初始化查找复合列表框
            mclsList(.Tab).InitcboFindKind
            '重画窗体
             mclsList(.Tab).FlexGrid.Redraw = False
           ' RedrawForm
            '定位到第一行
            With mclsList(.Tab).FlexGrid
                If .Rows > 1 Then
                    mclsList(sstItemInit.Tab).FlexNoChange = False
                    .Row = 1
                    mclsList(sstItemInit.Tab).FlexNoChange = True
                End If
                .col = 0
                .ColSel = .Cols - 1
            End With
            mclsList(.Tab).DoShowAll False
            '重画列表线
           ' mclsList(.Tab).gridLineRefresh
            
            UpdateMenuStatus
            blnIsLoad(.Tab) = True
            mclsList(.Tab).FlexGrid.Redraw = True
        Else
            '恢复查找复合列表项
            mblnComboxNoClick = True
            mclsList(.Tab).InitcboFindKind
            mblnComboxNoClick = False
            '恢复查找内容
            If mclsList(.Tab).FlexGrid.Rows > 1 And mclsList(.Tab).FlexGrid.ColSel > 0 Then
                txtfind.Text = mclsList(.Tab).FlexGrid.TextMatrix(mclsList(.Tab).FlexGrid.Row, mclsList(.Tab).SortCol)
            Else
                txtfind.Text = ""
            End If
            UpdateMenuStatus
        End If
        '恢复“全部显示”复选框
        mblnCheckNoChange = True
        chkShowAll.Value = IIf(mclsList(.Tab).ShowAll, 1, 0)
        mblnCheckNoChange = False
        
        RedrawForm
        mclsList(.Tab).FlexNoChange = False
        mclsList(.Tab).FindNoChange = False
        
    End With
End Sub
'
'查找内容 TextBox 控件
'
Private Sub txtFind_Change()
    mclsList(sstItemInit.Tab).TextFind txtfind.Text
End Sub


'
'响应主控对象事件
'

'编辑卡片
Private Sub mclsMainControl_EditEdit()
    Dim lngActivityID As Long
    
    lngActivityID = ListID(sstItemInit.Tab)
    If lngActivityID = 0 Then Exit Sub
    frmStartPeriod.ShowAOldBill lngActivityID
    
End Sub

'新增卡片
Private Sub mclsMainControl_EditNew()
    Dim intReceiptType As Integer
    
    Select Case sstItemInit.Tab
        Case 6
            intReceiptType = 52
        Case Else
            intReceiptType = 42 + sstItemInit.Tab
    End Select
    frmStartPeriod.ShowANewTypeBill intReceiptType
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngID As Long
    
    lngID = ListID(sstItemInit.Tab)
    If Not GetOperator(lngID) Then Exit Sub
    If mlngoldOperator <> gclsBase.OperatorID Then
       ShowMsg Me.hwnd, "不能删除别人制作的期初单据！", vbExclamation + MB_SYSTEMMODAL, Me.Caption
       Exit Sub
    End If
         
    If Not mclsItemInit.DeleteStartPeriod(lngID, False) Then
       Exit Sub
    Else
       With mclsList(sstItemInit.Tab).FlexGrid
            If .Rows = 2 Then
               mclsMainControl_ToolRefresh
            Else
              .RowHeight(.Row) = 0
              .RowData(.Row) = 1
              mclsList(sstItemInit.Tab).SetFlexRow
            End If
       End With
    End If
    UpdateMenuStatus
End Sub
Private Function GetOperator(ByVal lngActivityID As Long) As Boolean
    Dim strSql As String
    Dim recOperator As rdoResultset
    
    GetOperator = False
    strSql = "select lngOperatorID from ItemActivity where ItemActivity.lngActivityID=" & lngActivityID
    Set recOperator = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recOperator.EOF Then Exit Function
    mlngoldOperator = recOperator.rdoColumns(0)
    recOperator.Close
    GetOperator = True
End Function

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
    With sstItemInit
         If mclsList(.Tab).FlexGrid.TextMatrix(mclsList(.Tab).FlexGrid.Row, 1) = "√" Then Exit Sub
         If Not GetOperator(ListID(.Tab)) Then Exit Sub
         If mlngoldOperator <> gclsBase.OperatorID Then
            ShowMsg Me.hwnd, "不能作废别人制作的期初单据！", vbExclamation + MB_SYSTEMMODAL, Me.Caption
            Exit Sub
         End If
         If ShowMsg(Me.hwnd, "本张期初单作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, Me.Caption) <> IDYES Then Exit Sub
         If Not mclsItemInit.DeleteStartPeriod(ListID(.Tab), True) Then
            Exit Sub
         Else
            With mclsList(.Tab).FlexGrid
            If .Row > 0 Then
               If chkShowAll.Value Then
                  If .TextMatrix(.Row, 1) = "" Then
                     .TextMatrix(.Row, 1) = "√"
                  Else
                     .TextMatrix(.Row, 1) = ""
                  End If
               Else
                  .TextMatrix(.Row, 1) = "√"
                  .RowHeight(.Row) = 0
                  mclsList(sstItemInit.Tab).SetFlexRow
                  chkShowAll.Enabled = True
                  frmMain.mnuEditShowAll.Enabled = True
               End If
            End If
            End With
         End If
    End With
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_EditSearch()
    frmTreeFind.ShowFind
End Sub

'刷新
Private Sub mclsMainControl_ToolRefresh()
    Me.MousePointer = vbHourglass
    
    ToolRefresh sstItemInit.Tab
    Me.MousePointer = vbDefault
End Sub

Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    Dim title As String
    
    Set myPrintclass = New PrintClass
    title = sstItemInit.TabCaption(sstItemInit.Tab)
    title = Mid(title, 1, Len(title) - 4) & "列表"
    mclsList(sstItemInit.Tab).ReGetColCaption
    Select Case sstItemInit.Tab
        Case 0
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstItemInit.Tab).FlexGrid, 72, title & Chr(1) & Trim(gclsBase.BaseName) & Chr(1) & gclsBase.OperatorName
        Case 1
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstItemInit.Tab).FlexGrid, 73, title & Chr(1) & Trim(gclsBase.BaseName) & Chr(1) & gclsBase.OperatorName
        Case 2
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstItemInit.Tab).FlexGrid, 74, title & Chr(1) & Trim(gclsBase.BaseName) & Chr(1) & gclsBase.OperatorName
        Case 3
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstItemInit.Tab).FlexGrid, 75, title & Chr(1) & Trim(gclsBase.BaseName) & Chr(1) & gclsBase.OperatorName
        Case 4
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstItemInit.Tab).FlexGrid, 76, title & Chr(1) & Trim(gclsBase.BaseName) & Chr(1) & gclsBase.OperatorName
        Case 5
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstItemInit.Tab).FlexGrid, 77, title & Chr(1) & Trim(gclsBase.BaseName) & Chr(1) & gclsBase.OperatorName
        Case 6
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstItemInit.Tab).FlexGrid, 78, title & Chr(1) & Trim(gclsBase.BaseName) & Chr(1) & gclsBase.OperatorName
    End Select
    mclsList(sstItemInit.Tab).AddReGetColCaption
    Set myPrintclass = Nothing
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Select Case intIndex
        Case 0:
            mclsMainControl_EditEdit
        Case 1:
            mclsMainControl_EditNew
        Case 2:
            mclsMainControl_EditDel
        Case 4
            mclsMainControl_EditInActive
        Case 5
            mclsMainControl_EditShowAll
        Case 7
            mclsMainControl_EditSearch
        Case 9
            mclsMainControl_EditFilter
        Case 10
            mclsMainControl_EditColumn
        Case 12:
            mclsMainControl_ToolRefresh
        Case 13:
            mclsMainControl_FilePrintReceipt
        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).Visible = True
        
        Load .mnuListEditMenu(6)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(6)
        .mnuListEditMenu(6).Visible = False
        
        Load .mnuListEditMenu(7)
        Utility.CloneMenu .mnuEditSearch, .mnuListEditMenu(7)
        .mnuListEditMenu(7).Visible = False
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(8)
        
        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(9)
        
        Load .mnuListEditMenu(10)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(10)
        
        Load .mnuListEditMenu(11)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(11)
        
        Load .mnuListEditMenu(12)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(12)
        
        Load .mnuListEditMenu(13)
        Utility.CloneMenu .mnuFilePrintReceipt, .mnuListEditMenu(13)
        
        Load .mnuListEditMenu(14)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(14)
    End With
End Sub
'
' 报表菜单
'
Private Sub MakeListReportMenu(Optional ByVal EditObject As String = "")
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
            Unload .mnuListReportMenu(intCnt)
        Next
        .mnuListReportMenu(0).Caption = "商品期初一览表"
        .mnuListReportMenu(0).Enabled = True
        .mnuListReportMenu(0).Visible = True
    End With
End Sub

Private Sub ToolRefresh(intTab As Integer)
    Dim i As Integer
    Dim strOldText As String
    Dim strOldSort As String
    
    strOldSort = cboFindKind.Text
    strOldText = mclsList(intTab).FlexGrid.TextMatrix(mclsList(intTab).FlexGrid.Row, mclsList(intTab).SortCol)
    mclsList(intTab).SaveListColWidth
    mclsList(intTab).FlexGrid.Redraw = False
    
    '刷新列表记录
    mclsList(intTab).FlexGrid.FixedCols = 0
    Set datItemInit(intTab).Resultset = GetList(intTab)
    If Not datItemInit(intTab).Resultset.EOF Then datItemInit(intTab).Resultset.MoveLast
    datItemInit(intTab).Resultset.Close
    '设置FlexGrid列表
    mclsList(intTab).SetFlexGrid
'    FormatGridMe
    '恢复以前排序列
    cboFindKind.Text = strOldSort
    cboFindKind.Text = strOldSort
    mclsList(intTab).FlexGrid.Redraw = False
    If mclsList(intTab).FlexGrid.Rows > 1 Then
        txtfind.Text = strOldText
    End If
    If chkShowAll.Value = 0 Then mclsList(intTab).DoShowAll False
    '更新菜单状态
    UpdateMenuStatus
    mclsList(intTab).FlexGrid.Redraw = True
End Sub

Private Sub txtFind_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim intSelLen As Integer
    
    If KeyCode = 8 Then
        intSelLen = txtfind.SelLength
        If txtfind.SelStart > 0 Then txtfind.SelStart = txtfind.SelStart - 1
        txtfind.SelLength = intSelLen + 1
    End If
End Sub


Private Function GetCol(ByVal strColName As String) As Integer
    Dim i As Integer
    
    With mclsList(sstItemInit.Tab).FlexGrid
         For i = 1 To .Cols - 1
             If .TextMatrix(0, i) = strColName Then
                GetCol = i
                Exit For
             End If
         Next
    End With
End Function
       

Public Function BindingResultSet()
    Me.Hide
    If sstItemInit.Tab = 0 Then
        sstIteminit_Click 0
    Else
        sstItemInit.Tab = 0
    End If
    Me.Show
    Me.ZOrder 0
End Function