fixedtypelist.frm

金算盘软件代码

            If CLng(.Tag) > 0 Then
                BringWindowToTop .Tag
            Else
                Me.BindingResultSet
            End If
        Else
            Me.BindingResultSet
        End If
    End With
    Me.sstTypAct.Tab = intTab
    With mclsList(intTab).ListSet
        '得到排序字段
        For intCount = 1 To .Columns
            If .ColumnOrderType(intCount) <> 0 Then
                strSortField = .ColumnFieldName(intCount)
                strSortDec = .ColumnDesc(intCount)
                Exit For
            End If
        Next
        If intCount > .Columns Then
            ShowList = False
            Exit Function
        End If
        strofFrom = .FromOfSql
        strofWhere = .WhereOfSql
    End With
    '根据lngID得到排序字段值
    strSql = "Select " & strSortField & " As " & strSortDec
    Select Case intTab
        Case 0
            If strofWhere <> "" Then
                strofWhere = " where " & strofWhere & " and FixedType.lngFixedTypeID=" & lngID
            Else
                strofWhere = " where FixedType.lngFixedTypeID=" & lngID
            End If
        Case 1
            If strofWhere <> "" Then
                strofWhere = " where " & strofWhere & " and FixedMethod.lngFixedMethodID=" & lngID
            Else
                strofWhere = " where FixedMethod.lngFixedMethodID=" & lngID
            End If
    End Select
    strSql = strSql & strofFrom & strofWhere
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recTemp
        If .RowCount > 0 Then
            txtfind.Text = recTemp(strSortDec)   '查找
            With mclsList(intTab).FlexGrid
                If .TextMatrix(.Row, 0) = lngID Then      '是否找到
                    ShowList = True
                Else
                    ShowList = False
                End If
            End With
        Else
            ShowList = False
        End If
        .Close
    End With
End Function
'卡片
Public Property Let IsShowCard(ByVal Index As Integer, ByVal vNewValue As Boolean)
   mIsShowCard(Index) = vNewValue
End Property
Public Property Get IsShowCard(ByVal Index As Integer) As Boolean
   IsShowCard = mIsShowCard(Index)
End Property

'按照固定资产ID提取记录
Public Function GetbyListID(ByVal intTab As Integer, ByVal lngID As Long) As rdoResultset
    Dim recRecordset As rdoResultset
    Dim strSql As String
    
    Select Case intTab
        Case 0
            strSql = "Select * From FixedType Where lngFixedTypeID = " & lngID
        Case 1
            strSql = "Select * From FixedMethod Where lngFixedMethodID = " & lngID
    End Select
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Set GetbyListID = recRecordset
End Function

'按照固定资产ID更新停用标志
Private Function UpdateListInActive(ByVal intTab As Integer, ByVal lngID As Long, ByVal blnIsInActive As Boolean) As Boolean
    Dim strSql As String
    
    Select Case intTab
        Case 0
            strSql = "UPDATE FixedType SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngFixedTypeID = " & lngID
        Case 1
            strSql = "UPDATE FixedMethod SET blnIsInActive = " & IIf(blnIsInActive, 1, 0) & " WHERE lngFixedMethodID = " & lngID
    End Select
    UpdateListInActive = gclsBase.ExecSQL(strSql)
End Function

' 固定资产ID
Public Property Get ListID(ByVal intTab As Integer) As Long
    With mclsList(intTab).FlexGrid
    If .TextArray(.Row * .Cols) <> "" And .Row > 0 Then
        ListID = CLng(.TextArray(.Row * .Cols))
    Else
        ListID = 0
    End If
    End With
End Property

' 固定资产停用标志
Public Property Get ListIsInActive(ByVal intTab As Integer) As Boolean
    If chkShowAll.Value Then
        With mclsList(intTab).FlexGrid
            ListIsInActive = Not (.TextArray(.Row * .Cols + 1) = "")
        End With
    Else
        ListIsInActive = False
    End If
End Property

'根据列表中记录数，设置菜单可用属性
Private Sub UpdateMenuStatus()
    Dim blnIsnotEmpty As Boolean
    Dim blnFindNoChange As Boolean
    Dim IsHaveRight As Boolean
    Select Case sstTypAct.Tab
        Case 0
            IsHaveRight = IsCanDo(20, gclsBase.OperatorID)
        Case 1
            IsHaveRight = IsCanDo(21, gclsBase.OperatorID)
    End Select
    With mclsList(sstTypAct.Tab).FlexGrid
        If .Rows > 1 And .ColSel <> 0 And .RowHeight(.Row) > 0 Then
            blnIsnotEmpty = True
        Else
            blnIsnotEmpty = False
        End If
    End With
    With frmMain
        .mnuEditEdit.Caption = "修改(&E)"
        .mnuEditNew.Caption = "新增(&N)"
        .mnuEditDel.Caption = "删除(&D)"
        .mnuEditCopy.Enabled = blnIsnotEmpty
        .mnuEditEdit.Enabled = blnIsnotEmpty And IsHaveRight
        .mnuEditNew.Enabled = True And IsHaveRight
        .mnuEditDel.Enabled = blnIsnotEmpty And IsHaveRight
        .mnuEditInActive.Checked = False
        .mnuEditInActive.Visible = False
        .mnuEditInActive.Enabled = blnIsnotEmpty And IsHaveRight
        .mnuEditShowAll.Checked = chkShowAll.Value
        .mnuEditShowAll.Enabled = True
        .mnuEditUse.Enabled = blnIsnotEmpty
        .mnuEditSearch.Enabled = True
        .mnuEditColumn.Enabled = True
        .mnuEditFilter.Enabled = True
        .mnuFilePrint.Enabled = True
        .mnuFilePrintSetup.Enabled = True
        .mnuReportQuick.Enabled = blnIsnotEmpty
        .mnuToolRefresh.Enabled = True
    End With
    
    If mclsList(sstTypAct.Tab).FlexGrid.ColSel = 0 Then  '无当前选定行
        blnFindNoChange = mclsList(sstTypAct.Tab).FindNoChange
        mclsList(sstTypAct.Tab).FindNoChange = True
        txtfind.Text = ""
        mclsList(sstTypAct.Tab).FindNoChange = blnFindNoChange
        cmdAgain.Enabled = False
    End If
    frmMain.SetToolBar
End Sub

'重画Form
Private Sub RedrawForm()
    
    On Error Resume Next
    With sstTypAct
        .Left = ListFormLeft
        .width = Me.ScaleWidth - ListFormLeft - ListFormRight
        .Height = Me.ScaleHeight - ssTabUpAreaHeight - ListDownAreaHeight
    End With
    '重画MS FlexGrid 控件
    With mclsList(sstTypAct.Tab).FlexGrid
        .Left = ListGridLeft
        .width = sstTypAct.width - ListGridLeft - ListGridRight
        .Height = sstTypAct.Height - sstTypAct.TabHeight - ListGridTop - ListGridBottom
    End With

    '重画其余控件
    txtfind.width = Me.ScaleWidth - txtfind.Left - ListFormBottom - cmdAgain.width - 15
    cmdAgain.Left = txtfind.Left + txtfind.width
    cmdTypact(0).top = Me.ScaleHeight - cmdTypact(0).Height - ListFormBottom
    cmdTypact(1).top = cmdTypact(0).top
    cmdTypact(2).top = cmdTypact(0).top
    chkShowAll.top = cmdTypact(0).top
    chkShowAll.Left = Me.ScaleWidth - chkShowAll.width - ListFormBottom
End Sub


'命令控件数组
Private Sub cmdTypact_Click(Index As Integer)
    Dim PosX, PosY As Integer
    
    PosX = cmdTypact(Index).Left
    PosY = cmdTypact(Index).top + cmdTypact(Index).Height
    With frmMain
        Select Case Index
               Case 0
                    MakeListEditMenu
                    PopupMenu .mnuListEdit, , PosX, PosY
               
               Case 1
                    MakeListReportMenu
                    PopupMenu .mnuListReport, , PosX, PosY
               Case 2
                    frmFixedInit.Show
                    frmFixedInit.ZOrder 0
        End Select
    End With
End Sub

Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
End Sub

'
'窗体 Form 控件
'
Private Sub Form_Load()
    Dim i As Integer
    Dim intSortCol As Integer
    On Error GoTo ErrHandle
'    Me.Hide
'    Me.Left = -30000
    MsgForm.PleaseWait
    Me.HelpContextID = 30048
    '固定资产列表窗体初始化
    Debug.Print "Load Start: ", Timer
    intViewID(0) = 46
    intViewID(1) = 16
    For i = 0 To 1
        Set mclsList(i) = New list
        Set mclsList(i).FindKind = cboFindKind
        Set mclsList(i).Find = txtfind
    Next
    Set mclsList(0).FlexGrid = msgFixedType
    Set mclsList(1).FlexGrid = msgFixedMethod
     
    '设置钩子对象
    Set mclsSubClass = New SubClass32.SubClass

    mclsSubClass.Messages(WM_PAINT) = True
    mclsSubClass.Messages(WM_LBUTTONUP) = True
    mclsSubClass.Messages(WM_LBUTTONDOWN) = True
    mclsSubClass.Messages(WM_MOUSEMOVE) = True
    
    Set mclsSubClassform = New SubClass32.SubClass
    mclsSubClassform.hwnd = Me.hwnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
    Unload MsgForm
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    
'    If sstTypAct.Tab = 0 Then
'        sstTypAct_Click 0
'    Else
'        sstTypAct.Tab = 0
'    End If
     Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload MsgForm
         Unload Me
    End If
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton And frmMain.ActiveForm Is Me Then
        MakeListEditMenu
        PopupMenu frmMain.mnuListEdit
    End If
End Sub

Private Sub Form_Paint()
    DrawInSertLine Me.hwnd, ListFormLeft, 500, Me.width - 2 * (ListFormLeft + ListFormRight), 500
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    If KeyAscii = vbKeyEscape Then
        Unload Me
    ElseIf KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = vbFormControlMenu Then
        Select Case True
            Case mIsShowCard(0)
                MsgBox "请先关闭固资类型卡片！", vbExclamation
                Cancel = True
'                frmFixedTypeListCard.Show
'                frmFixedTypeListCard.ZOrder 0
            Case mIsShowCard(1)
                MsgBox "请先关闭变动方式卡片！", vbExclamation
                Cancel = True
'                frmFixedMethodListCard.Show
'                frmFixedMethodListCard.ZOrder 0
        End Select
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim intCount As Integer
    On Error Resume Next
'    If mIsShowCard(0) Then Unload frmFixedTypeListCard
'    If mIsShowCard(1) Then Unload frmFixedMethodListCard
    For intCount = 0 To sstTypAct.Tabs - 1
        If blnIsLoad(intCount) Then
            mclsList(intCount).SaveListSet
        End If
        blnIsLoad(intCount) = False
        Set mclsList(intCount) = Nothing
    Next
    Set mclsSubClass = Nothing
    Set mclsSubClassform = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

Private Sub Form_Resize()
     On Error Resume Next
     If Me.WindowState = 1 Then Exit Sub
     If Me.Left + Me.width < 0 Or Me.Left > Screen.width Then
       Me.Left = 300
    End If
    RedrawForm
End Sub

Private Sub Form_Activate()
    SetHelpID 30048
    mclsMainControl_ChildActive
    gclsSys.CurrFormName = Me.hwnd
    mclsList(sstTypAct.Tab).FlexGrid.Redraw = True
    UpdateMenuStatus
    If Me.WindowState = 1 Then Me.WindowState = 0
End Sub

'
'显示全部记录/未停用记录 CheckBox 控件
'
Private Sub chkShowAll_Click()
  
    With sstTypAct
        mclsList(.Tab).FlexGrid.Redraw = False
        mclsList(.Tab).DoShowAll chkShowAll.Value
        mclsList(.Tab).FlexGrid.Redraw = True
    End With
    UpdateMenuStatus
End Sub

'
'查找条件类型 ComboBox 控件
'
Private Sub cboFindKind_Click()
    Dim i As Integer
    Dim intWidth As Integer
    Dim strFind As String
    Dim intSortCol As Integer
    
    mclsList(sstTypAct.Tab).ReGetColCaption
    If mblnComboxNoClick Then Exit Sub
    With mclsList(sstTypAct.Tab).FlexGrid
        .Redraw = False
        For i = 1 To .Cols - 1
            If .TextMatrix(0, i) = cboFindKind.Text Then
                If .RowHeight(.Row) > 0 Then strFind = .TextMatrix(.Row, i)
                mclsList(sstTypAct.Tab).FixrowSortBold i
                Exit For
            End If
        Next
    End With
    
    If mclsList(sstTypAct.Tab).FlexGrid.Rows > 1 Then
       If txtfind.Text = strFind Then
          txtFind_Change
       Else
          txtfind.Text = strFind