frmcalccost.frm

金算盘软件代码

Private Sub MethodClick()
    Dim strMethod As String
    Dim lngCnt As Long
    
    strMethod = MethodCode(cboCost(1).Text)
    
    If mstrMethodCode <> strMethod And strMethod <> "" Then
        '关闭辅助窗口
        Close_ChildWindow
        
        On Error Resume Next
        
        Me.MousePointer = vbHourglass
        
        MsgForm.PleaseWait
        mblnRefresh = True
        '红字成本计算方法
        With cboCost(2)
            .Clear
            .AddItem "不计算成本"
            .AddItem "最近进价"
            .AddItem "最高进价"
            .AddItem "最低进价"
            .AddItem "平均进价"
            .AddItem "上月结存价"
            .ListIndex = 1
        End With
    
        mstrMethodCode = MethodCode(cboCost(1).Text)
        If mstrMethodCode = cmSingle Or mstrMethodCode = cmMonthAvg Then
            cboCost(2).ListIndex = 0
            cboCost(2).Enabled = False
        Else
            cboCost(2).ListIndex = 1
            cboCost(2).Enabled = True
        End If
        chkTax.Visible = False
        Select Case mstrMethodCode
        Case cmPlan
            mclsGrid.ListSet.ViewId = PlanViewID
            With cboCost(2)
                .Clear
                .AddItem "计划价"
                .ListIndex = 0
                .Enabled = False
            End With
        Case cmRealDiff
            chkTax.Visible = True
            mclsGrid.ListSet.ViewId = SaleViewID
            With cboCost(2)
                .Clear
                .AddItem "进销差价率"
                .ListIndex = 0
                .Enabled = False
            End With
        Case cmMonthAvg
            mclsGrid.ListSet.ViewId = RealViewID
            With cboCost(2)
                .AddItem "计划价"
                .AddItem "全月平均"
                .ListIndex = 0
                .Enabled = True
            End With
        Case cmLastPrice
            mclsGrid.ListSet.ViewId = RealViewID
            With cboCost(2)
                .Clear
                .AddItem "最后进价"
                .ListIndex = 0
                .Enabled = False
            End With
        Case Else
            cboCost(2).AddItem "计划价"
            mclsGrid.ListSet.ViewId = RealViewID
            If mstrMethodCode <> cmFIFO And mstrMethodCode <> cmLIFO And mstrMethodCode <> cmSingle Then
                With cboCost(2)
                    .AddItem "移动平均价"
                End With
            End If
        End Select
        
        If cboCost(2).Enabled Then
            strMethod = GetSet(1, "成本计算", "红字成本_" & cboCost(1).Text, cboCost(1).Text)
            For lngCnt = 0 To cboCost(2).ListCount - 1
                If strMethod = cboCost(2).list(lngCnt) Then
                    cboCost(2).ListIndex = lngCnt
                    Exit For
                End If
            Next lngCnt
        End If
        mblnRefresh = False
        RefreshGrid
        Unload MsgForm
        Me.MousePointer = vbDefault
    End If
End Sub


'查找特殊列
Private Sub FindSpecialCol()
    Dim lngCnt As Long
    Dim strTitle As String
    
    With mclsGrid.Grid
        For lngCnt = 1 To .Cols - 1
            If Not IsNull(mclsGrid.Grid.CellValue(0, lngCnt)) Then
                strTitle = mclsGrid.Grid.CellValue(0, lngCnt)
                strTitle = Replace(strTitle, "↑", "")
                strTitle = Replace(strTitle, "↓", "")
                Select Case strTitle
                Case "商品"
                    mlngColItemCode = lngCnt
                Case "差价率"
                    mlngColRealRate = lngCnt
                Case "差异率"
                    mlngColPlanRate = lngCnt
                End Select
            End If
        Next lngCnt
    End With
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'        Form 事件、方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
    Dim lngCnt As Long
    
    On Error Resume Next
    
    Set mclsSubClassform = New SubClass32.SubClass
    mclsSubClassform.hwnd = Me.hwnd
    mclsSubClassform.Messages(WM_GETMINMAXINFO) = True
    
    '主控对象
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    
    'Grid对象
    Set mclsGrid = New TableGrid
    mclsGrid.SetSortCol 4
    mclsGrid.SortType = 1

    mblnFind = True
    mblnSort = True
    mintYear = gclsBase.FYearOfDate(gclsBase.BaseDate)
    mstrMethodCode = ""
    
   
    Me.HelpContextID = HelpID
    
    prgLoad.Visible = False
    chkTax.Visible = False
    CalDate.Enabled = False
    With picGrid
        .Visible = True
        .Left = mlngLeft
        .top = mlngTop
    End With
End Sub

Private Sub Form_Activate()
    gclsSys.CurrFormName = hwnd
    mclsMainControl_ChildActive
    SetHelpID HelpContextID
    CalDate.Enabled = False
    Refresh
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    If (TypeOf Screen.ActiveControl Is ListText) Then
        If Not Screen.ActiveControl.ReferVisible Then
            If KeyCode = vbKeyReturn Then
               KeyCode = 0
               SendKeys "{Tab}", True
            End If
        End If
    ElseIf KeyCode = vbKeyReturn Then
        KeyCode = 0
        SendKeys "{Tab}", True
    ElseIf KeyCode = 27 Then
        Unload Me
    End If
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    If WindowState <> vbMinimized Then
        If (Left + width < 0 Or Left > Screen.width) And WindowState <> vbMaximized Then
            Left = (Screen.width - width) / 2
        End If
        If width < mlngFormMinWidth * Screen.TwipsPerPixelX Then
            width = mlngFormMinWidth * Screen.TwipsPerPixelX
        End If
        cboCost(2).Left = ScaleWidth - cboCost(2).width - mlngLeft
        lblNote(2).Left = cboCost(2).Left - lblNote(2).width - 15
        cboCost(1).Left = lblNote(2).Left - cboCost(1).width - 30
        lblNote(1).Left = cboCost(1).Left - lblNote(1).width - 15
        txtFind.width = ScaleWidth - txtFind.Left - mlngLeft - cmdAgain.width - 15
        cmdAgain.Left = txtFind.Left + txtFind.width
        
        cmdEdit.Left = ListFormLeft
        cmdEdit.top = Me.ScaleHeight - cmdEdit.Height - ListFormBottom
        cmdReport.top = cmdEdit.top
    
        With picGrid
            .width = ScaleWidth - 2 * mlngLeft
            .Height = ScaleHeight - mlngBottomHeight - mlngTop + 100
        End With
        chkTax.top = cmdEdit.top + 30
        chkTax.Left = picGrid.Left + picGrid.width - chkTax.width
        
        If Not mclsGrid Is Nothing And mlngColItemCode > 0 Then
'            mclsGrid.FormResize
        End If
    End If
End Sub

'关闭窗口前，确定是否有以下几个窗口未关闭：
'成本底稿窗口、成本结转窗口、成本批次窗口
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Close_ChildWindow
End Sub

Private Sub Close_ChildWindow()
    Dim intCount As Integer
    Dim strName  As String
    
    On Error Resume Next
    For intCount = gclsSys.MainControls.Count To 1 Step -1
        strName = gclsSys.MainControls(intCount).Form.Name
        If strName = "frmCalcScript" Then
            Unload frmCalcScript
        ElseIf strName = "frmCalcSingle" Then
            Unload frmCalcSingle
        ElseIf strName = "frmCloseCost" Then
            Unload frmCloseCost
        End If
    Next intCount
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Set frmCalcScript = Nothing
    Set frmCalcSingle = Nothing
    Set frmCalcSingleChoice = Nothing
    Set FrmCalcAmount = Nothing
    Set frmCloseCost = Nothing
    
    Set mclsGrid = Nothing
    Set mclsSubClassform = Nothing
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub

Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    mclsGrid.ClearSortColArrow
    Set myPrintclass = New PrintClass
    myPrintclass.PrintNewList gclsBase.BaseDB, mclsGrid.Resultset, mclsGrid.Grid.TableHandle, 72, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Set myPrintclass = Nothing
    mclsGrid.AddSortColArrow
End Sub

Private Sub mclsMainControl_FilePrintSetup()
    Dim clsPrintclass As PrintClass
    Set clsPrintclass = New PrintClass
    clsPrintclass.PrintNewSetUp gclsBase.BaseDB, mclsGrid.Grid.TableHandle, , , , 72, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    Set clsPrintclass = Nothing
End Sub

Private Sub mclsMainControl_ToolRefresh()
    If MethodCode(cboCost(1).Text) <> "" Then
        RefreshGrid
    End If
End Sub

'处理窗体最小尺寸
Private Sub mclsSubClassForm_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim MinMax As MINMAXINFO

    If Msg = WM_GETMINMAXINFO Then
        CopyMemory MinMax, ByVal lParam, Len(MinMax)
        
        MinMax.ptMinTrackSize.x = mlngFormMinWidth
        MinMax.ptMinTrackSize.y = mlngFormMinHeight
        
        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
    End If
End Sub



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'        主控对象（MainControl）方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' 编辑菜单
Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    On Error Resume Next
    
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        
        intCnt = 0
        .mnuListEditMenu(intCnt).Enabled = (Not mclsGrid.IsEmpty)
        .mnuListEditMenu(intCnt).Visible = True
        .mnuListEditMenu(intCnt).Caption = "全部计算(&A)"
        
        intCnt = intCnt + 1
        Load .mnuListEditMenu(intCnt)
        .mnuListEditMenu(intCnt).Enabled = (Not mclsGrid.IsEmpty)
        .mnuListEditMenu(intCnt).Visible = True
        .mnuListEditMenu(intCnt).Caption = "快速计算(&F)"
        
        intCnt = intCnt + 1
        Load .mnuListEditMenu(intCnt)
        .mnuListEditMenu(intCnt).Enabled = (Not mclsGrid.IsEmpty)
        .mnuListEditMenu(intCnt).Visible = True
        .mnuListEditMenu(intCnt).Caption = "自动调整成本(&Z)"
        .mnuListEditMenu(intCnt).Checked = (GetSet(1, "成本计算", "调整成本", 1) = 1)
        
        intCnt = intCnt + 1
        Load .mnuListEditMenu(intCnt)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(intCnt)
        
        intCnt = intCnt + 1
        Load .mnuListEditMenu(intCnt)
        If mstrMethodCode = cmSingle Or _
            mstrMethodCode = cmFIFO Or mstrMethodCode = cmLIFO Or mstrMethodCode = cmMoveAvg Then
            .mnuListEditMenu(intCnt).Enabled = (Not mclsGrid.IsEmpty)
        Else
            .mnuListEditMenu(intCnt).Enabled = False
        End If
        .mnuListEditMenu(intCnt).Visible = True
        .mnuListEditMenu(intCnt).Caption = "计算底稿(&S)"
            
        intCnt = intCnt + 1
        Load .mnuListEditMenu(intCnt)
        If MethodCode(cboCost(1).Text) = cmSingle Then
            If (Not mclsGrid.IsEmpty) Then