frmiteminitlist.frm

金算盘软件代码

End Property
Public Property Get IsShowCard() As Boolean
   IsShowCard = mIsShowCard
End Property

' 业务ID
Public Property Get ListID(ByVal intTab As Integer) As Long
    With mclsList(intTab).FlexGrid
        If .TextArray(.Row * .Cols) <> "" And .Row > 0 And .RowHeight(.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 Function IsshowAll() As Boolean
    Dim i As Integer
    
    IsshowAll = False
    With mclsList(sstItemInit.Tab).FlexGrid
        If .Rows = 1 Then Exit Function
        For i = 1 To .Rows - 1
            If .TextMatrix(i, 1) = "√" Then
               IsshowAll = True
               Exit For
            End If
        Next
    End With
End Function

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

'重画Form
Private Sub RedrawForm()
    
    With sstItemInit
        .Left = ListFormLeft
        .width = Me.ScaleWidth - ListFormLeft - ListFormRight
        .Height = Me.ScaleHeight - ssTabUpAreaHeight - ListDownAreaHeight
    End With
    
    '重画MS FlexGrid 控件
    With mclsList(sstItemInit.Tab).FlexGrid
        .Left = ListGridLeft
        .width = sstItemInit.width - ListGridLeft - ListGridRight
        .Height = sstItemInit.Height - sstItemInit.TabHeight - ListGridTop - ListGridBottom
    End With
    
    '重画其余控件
    txtfind.width = Me.ScaleWidth - txtfind.Left - ListFormBottom - cmdAgain.width - 15
    cmdAgain.Left = txtfind.Left + txtfind.width
    cmdEAR(0).top = Me.ScaleHeight - cmdEAR(0).Height - ListFormBottom
    cmdEAR(1).top = cmdEAR(0).top
   
    chkShowAll.top = cmdEAR(0).top
    chkShowAll.Left = Me.ScaleWidth - chkShowAll.width - ListFormBottom
End Sub

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


Private Sub Form_Deactivate()
    frmMain.SetEditUnEnabled
    frmMain.mnuFilePrintReceipt.Enabled = False
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

'
'窗体 Form 控件
'
Private Sub Form_Load()
    Dim intCount As Integer
    Dim i As Integer
    Dim intSortCol As Integer
    Dim intResponse As Integer
    
'    Me.Hide
'    Me.Left = -30000
    On Error GoTo ErrHandle
    MsgForm.PleaseWait
    Screen.MousePointer = vbHourglass
    
    #If conVersionType = 1 Then
        '金算盘财务及企业管理软件（标准版）
       sstItemInit.TabVisible(5) = True
    #Else
        #If conVersionType = 2 Then
            '金算盘财务及企业管理软件（行政事业版）
           sstItemInit.TabVisible(5) = True
        #Else
            #If conVersionTyp = 4 Then
                '金算盘商务管理软件（实达专用版）
                sstItemInit.TabVisible(3) = False
                sstItemInit.TabVisible(5) = False
                sstItemInit.TabVisible(6) = False
            #ElseIf conVersionTyp = 8 Then
                '金算盘商务管理软件（标准版）:conVersionType=8
                sstItemInit.TabVisible(5) = False
            #Else
                sstItemInit.TabVisible(5) = True
            #End If
        #End If
    #End If
    
    Me.HelpContextID = 30022
    intViewID(0) = 529     '库存商品期初
    intViewID(1) = 530     '受托商品期初
    intViewID(2) = 532     '委托代销商品期初
    intViewID(3) = 533     '分期商品期初
    intViewID(4) = 535     '直运商品期初
    intViewID(5) = 531     '加工商品期初
    intViewID(6) = 534     '采购商品期初
    
    For i = 0 To 6
        Set mclsList(i) = New list
        Set mclsList(i).FindKind = cboFindKind
        Set mclsList(i).Find = txtfind
    Next
    
    Set mclsItemInit = New clsStartDel         '删除增加类
    mclsItemInit.SethWnd Me.hwnd
    Set theEditForm = frmStartPeriod
    
    Set mclsList(0).FlexGrid = msgItemInit0
    Set mclsList(1).FlexGrid = msgItemInit1
    Set mclsList(2).FlexGrid = msgItemInit2
    Set mclsList(3).FlexGrid = msgItemInit3
    Set mclsList(4).FlexGrid = msgItemInit4
    Set mclsList(5).FlexGrid = msgItemInit5
    Set mclsList(6).FlexGrid = msgItemInit6
    
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    
    '设置钩子对象
    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
    
'    If sstItemInit.Tab = 0 Then
'        sstIteminit_Click 0
'    Else
'        sstItemInit.Tab = 0
'    End If
    Unload MsgForm
    Screen.MousePointer = vbDefault
    
    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
    UpdateMenuStatus
End Sub

Private Sub Form_Paint()
    DrawInSertLine Me.hwnd, ListFormLeft, 500, Me.width - 2 * (ListFormLeft + ListFormRight), 500
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'    If UnloadMode = vbFormControlMenu And mIsShowCard Then
'        ShowMsg Me.hwnd, "请先关闭商品期初卡片！", vbExclamation, Me.Caption
'        Cancel = True
'        If frmStartPeriod.WindowState = 1 Then frmStartPeriod.WindowState = 0
'        frmStartPeriod.Show
'        ZOrder 0
'    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim intCount As Integer
    Dim lngViewFieldDateID As Long
    
    On Error Resume Next
    For intCount = 0 To sstItemInit.Tabs - 1
        If blnIsLoad(intCount) Then
            If mclsList(intCount).ListSet.ListID < 1 Then
               mclsList(intCount).SaveListSet
            Else
              mclsList(intCount).SaveListSet
            End If
        End If
        blnIsLoad(intCount) = False
        Set datItemInit(intCount).Resultset = Nothing
        Set mclsList(intCount) = Nothing
    Next
    
    Unload frmStartPeriod
    Set mclsSubClassform = Nothing
    Set mclsSubClass = Nothing
    Set theEditForm = Nothing
    Set mclsItemInit = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

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

Private Sub Form_Activate()
    
    On Error Resume Next
    SetHelpID 30022
    If (Me.Left + Me.width) < 0 Or Me.Left > Screen.width Then
        Me.Left = 300
    End If
    mclsMainControl_ChildActive
    gclsSys.CurrFormName = Me.hwnd
    If mclsList(sstItemInit.Tab).FlexGrid.Enabled Then mclsList(sstItemInit.Tab).FlexGrid.SetFocus
    mclsList(sstItemInit.Tab).FlexGrid.Redraw = True
    UpdateMenuStatus
End Sub

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

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


Private Sub mclsMainControl_ChildActive()
     Dim vntMessage As Variant
     
     SetHelpID Me.HelpContextID
     gclsSys.CurrFormName = Me.hwnd
    '响应消息
    For Each vntMessage In mclsMainControl.Messages