frmmakeorder.frm

金算盘软件代码

Private Sub dtmInput_Validate(Cancel As Boolean)
    If dtmInput.Text = "" Then
        cMsgBox "制单日不能为空！"
        dtmInput.Text = Format(gclsBase.BaseDate, "yyyy-mm-dd")
        Cancel = True
    Else
        If dtmInput.Text < gclsBase.BeginDate Then
            cMsgBox "制单日不能小于帐套启用日期！"
            dtmInput.Text = gclsBase.BeginDate
            Cancel = True
        End If
    End If
    If Cancel = False Then
        mintYear = gclsBase.FYearOfDate(C2Date(dtmInput.Text))
        mbytPeriod = gclsBase.PeriodOfDate(C2Date(dtmInput.Text))
    End If
End Sub

Private Sub Form_Activate()
    If Me.HelpContextID <> 0 Then
        SetHelpID Me.HelpContextID
    End If
    If mblnFirstIN = True Then
        mblnFirstIN = False
        ReCalc
    End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        If Me.ActiveControl Is GrdCol Then
        Else
            BKKEY Me.ActiveControl.hWnd, vbKeyTab
        End If
    End If
End Sub

Private Sub Form_Load()
    Dim i As Long
    Dim j As Long
    Dim lngTmp As Long

    Screen.MousePointer = vbHourglass
    Utility.LoadFormResPicture Me
  
    strCurrDec = FormatString(gclsBase.NaturalCurDec)
    strPriceDec = FormatString(gclsBase.PriceDec)
    dtmInput.Text = Format(gclsBase.BaseDate, "yyyy-mm-dd")
    CboInput.Clear
    CboInput.AddItem "年"
    CboInput.AddItem "季"
    CboInput.AddItem "月"
    CboInput.AddItem "周"
    CboInput.AddItem "天"
    CboInput.ListIndex = 3
    SpinInput.Text = "12"
    
    GrdCol.Redraw = False
    Set mclsGrid = New Grid
    Set mclsGrid.Grid = GrdCol
    mclsGrid.ListSet.ViewId = 999999999 '虚拟视图
    mclsGrid.ColOfs = 1
    GrdCol.Cols = 15
    mclsGrid.ListSet.Columns = GrdCol.Cols - 1
    
    GrdCol.TextMatrix(0, 1) = "选择"
    GrdCol.TextMatrix(0, 2) = "商品"
    GrdCol.TextMatrix(0, 3) = "规格型号"
    GrdCol.TextMatrix(0, 4) = "计量单位"
    GrdCol.TextMatrix(0, 5) = "供应商"
    GrdCol.TextMatrix(0, 6) = "最小库存量"
    GrdCol.TextMatrix(0, 7) = "周平均销售量"
    GrdCol.TextMatrix(0, 8) = "当前现有库存量"
    GrdCol.TextMatrix(0, 9) = "预计本周到货量"
    GrdCol.TextMatrix(0, 10) = "建议本周采购量"
    GrdCol.TextMatrix(0, 11) = "建议本次采购量"
    GrdCol.TextMatrix(0, 12) = "本币含税单价"
    GrdCol.TextMatrix(0, 13) = "本币含税金额"
    GrdCol.TextMatrix(0, 14) = "约定到货日期"
    
    ReDim strColName(GrdCol.Cols - 1)
    ReDim xlngColNo(GrdCol.Cols - 1)
     
    For i = 0 To 5
        GrdCol.ColAlignment(i) = flexAlignLeftCenter
        strColName(i) = GrdCol.TextMatrix(0, i)
        xlngColNo(i) = i
    Next
    For i = 6 To GrdCol.Cols - 1
        GrdCol.ColAlignment(i) = flexAlignRightCenter
        strColName(i) = GrdCol.TextMatrix(0, i)
        xlngColNo(i) = i
    Next
    mclsGrid.ColOfs = 2
'    mclsGrid.ListSetToGrid
    mclsGrid.SetupStyle
    
'    Set mclsGrid.EditText = curInput
    mclsGrid.SetEditText "建议本次采购量", "", "选择", "√", curInput
    mclsGrid.SetEditText "本币含税单价", "", "选择", "√", curInput
    mclsGrid.SetEditText "本币含税金额", "", "选择", "√", curInput
    mclsGrid.SetEditText "约定到货日期", "", "选择", "√", dtmPromise
    
    Set GrdCol.MouseIcon = Utility.GetFormResPicture(2001, 2)
    GrdCol.MousePointer = flexDefault
    LoadGrdColWidth
    If GrdCol.ColWidth(0) <> 0 Then
        GrdCol.ColWidth(0) = 0
    End If
    mblnFirstIN = True
    GrdCol.Redraw = True
    Screen.MousePointer = vbDefault
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Me.MousePointer = vbHourglass Then
        Cancel = 1
        Exit Sub
    End If
    If Not Data1.Resultset Is Nothing Then
        Data1.Resultset.Close
    End If
    SaveGrdColWidth
    Utility.UnLoadFormResPicture Me
    Utility.RemoveFormResPicture 2001
    Erase strColName
    Erase xlngColNo
    Erase RowDatas
    Set mclsGrid = Nothing
End Sub

Private Sub GrdCol_KeyPress(KeyAscii As Integer)
    With GrdCol
        If KeyAscii = vbKeySpace Then
            If .Row >= .FixedRows Then
                Select Case .TextMatrix(0, .col)
                Case "建议本次采购量", "本币含税单价", "本币含税金额", "约定到货日期"
                Case Else
                    If .TextMatrix(.Row, 1) = "" Then
                        SetSelectRow .Row, True
                    Else
                        SetSelectRow .Row, False
                    End If
                End Select
            End If
        End If
    End With
End Sub

Private Sub grdCol_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Long
    
    With GrdCol
        If y > .RowHeight(0) Then
            If x < .ColWidth(1) Then
                If y > .RowPos(.Rows - 1) + .RowHeight(.Rows - 1) Then
                    .MousePointer = flexDefault
                Else
                    .MousePointer = 99
                End If
            Else
                .MousePointer = flexDefault
            End If
        Else
            .MousePointer = flexDefault
        End If
    End With
End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim i As Integer
    Dim j As Long
    Dim lngRowBak As Long
    
    If Button = vbRightButton Then
        Exit Sub
    End If
    If y < GrdCol.RowHeight(0) Then
        GrdCol.Redraw = False
        For i = 0 To GrdCol.Cols - 1
            If x > GrdCol.ColPos(i) And x < GrdCol.ColPos(i) + GrdCol.ColWidth(i) Then
                lngRowBak = GrdCol.RowData(GrdCol.MouseRow)
                GrdCol.Row = 0
                GrdCol.col = i
                If GrdCol.ColAlignment(i) = flexAlignRightCenter Then
                    If InStr(GrdCol.TextMatrix(0, i), "金额") <> 0 Or InStr(GrdCol.TextMatrix(0, i), "单价") <> 0 Then
                        For j = 1 To GrdCol.Rows - 1
                            GrdCol.TextMatrix(j, i) = C2Dbl(GrdCol.TextMatrix(j, i))
                        Next
                    End If
                    If InStr(GrdCol.TextMatrix(0, i), "↑") <> 0 Then
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↓"
                        
                        GrdCol.Sort = flexSortNumericDescending
                    Else
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↑"
                        
                        GrdCol.Sort = flexSortNumericAscending
                    End If
                    If InStr(GrdCol.TextMatrix(0, i), "金额") <> 0 Then
                        For j = 1 To GrdCol.Rows - 1
                            GrdCol.TextMatrix(j, i) = Format(C2Dbl(GrdCol.TextMatrix(j, i)), strCurrDec)
                        Next
                    ElseIf InStr(GrdCol.TextMatrix(0, i), "单价") <> 0 Then
                        For j = 1 To GrdCol.Rows - 1
                            GrdCol.TextMatrix(j, i) = Format(C2Dbl(GrdCol.TextMatrix(j, i)), strPriceDec)
                        Next
                    End If
                Else
                    If InStr(GrdCol.TextMatrix(0, i), "↑") <> 0 Then
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↓"
                        
                        GrdCol.Sort = flexSortStringNoCaseDescending
                    Else
                        GrdCol.TextMatrix(0, i) = ColName(i) & "↑"
                        
                        GrdCol.Sort = 5
                    End If
                End If
                For j = 1 To GrdCol.Rows - 1
                    If GrdCol.RowData(j) = lngRowBak Then
                        GrdCol.Row = j
                        If Not GrdCol.RowIsVisible(j) Then
                            GrdCol.TopRow = j
                        End If
                        Exit For
                    End If
                Next
            Else
                GrdCol.TextMatrix(0, i) = ColName(i)
            End If
        Next
        GrdCol.Redraw = True
    Else
        If y <= GrdCol.RowPos(GrdCol.Rows - 1) + GrdCol.RowHeight(GrdCol.Rows - 1) Then
            If GrdCol.MouseRow >= GrdCol.FixedRows Then
                Select Case GrdCol.TextMatrix(0, GrdCol.col)
                Case Else
                    If GrdCol.MouseCol = 1 Then
                        GetLngColNO
                        If GrdCol.TextMatrix(GrdCol.MouseRow, 1) = "" Then
                            SetSelectRow GrdCol.MouseRow, True
                        Else
                            SetSelectRow GrdCol.MouseRow, False
                        End If
                    End If
                End Select
            End If
        End If
    End If
End Sub

Private Sub LoadGrdColWidth()
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim i As Integer
    
    strSql = "SELECT strKey,strSetting FROM Setting WHERE lngModuleID=0 AND strSection='" & Me.Name & "列宽'"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTmp.BOF And recTmp.EOF Then
        FirstGrdColWidth
    Else
        Do While Not recTmp.EOF
            GrdCol.ColWidth(C2lng(recTmp!strKey)) = C2lng(recTmp!strSetting)
            recTmp.MoveNext
        Loop
    End If
    recTmp.Close
    Set recTmp = Nothing
End Sub
Private Sub FirstGrdColWidth()
    Dim i As Integer
    
    For i = 1 To GrdCol.Cols - 1
        GrdCol.ColWidth(i) = IIf(InStr(GrdCol.TextMatrix(0, i), "日期") <> 0, 11, StrLen(GrdCol.TextMatrix(0, i)) + 1) * Me.TextWidth("A")
    Next
End Sub
Private Sub SaveGrdColWidth()
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim i As Integer
    
    On Error GoTo ErrHandle
    GetLngColNO
    
    gclsBase.BaseWorkSpace.BeginTrans
    
    strSql = " FROM Setting WHERE lngModuleID=0 AND strSection='" & Me.Name & "列宽'"
    gclsBase.BaseDB.Execute "DELETE " & strSql
        
    strSql = "SELECT *" & strSql
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    With recTmp
        For i = 1 To GrdCol.Cols - 1
            .AddNew
            !lngModuleID = 0
            !strSection = Me.Name & "列宽"
            !strKey = i
            !strSetting = CStr(IIf(GrdCol.ColWidth(xlngColNo(i)) < 400, 400, GrdCol.ColWidth(xlngColNo(i))))
            !strTypeName = "Long"
            .Update
        Next
    End With
    recTmp.Close
    Set recTmp = Nothing
    gclsBase.BaseWorkSpace.CommitTrans
    Exit Sub
ErrHandle:
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    gclsBase.BaseWorkSpace.RollBacktrans
End Sub

Private Sub cmdokcancel_Click(Index As Integer)
    If Me.MousePointer = vbHourglass Then
        Exit Sub
    End If
    Dim i As Long