frmprojectcost.frm

金算盘软件代码

Private Sub inittext()
'初始化统计金额
Dim intCount As Integer, dx As Double, dz As Double
Dim wjje As Double, yjje As Double, l As Integer, n As Integer
    dx = 0
    dz = 0
    Set datItemData.Recordset = mlhls
    mlhls.MoveFirst
    For intCount = 1 To mlhls.RecordCount
          wjje = C2Dbl(IIf(IsNull(mlhls.Fields("未开单")), 0, mlhls.Fields("未开单")))
          yjje = C2Dbl(IIf(IsNull(mlhls.Fields("本次开单")), 0, mlhls.Fields("本次开单")))
          dx = dx + wjje
          dz = dz + yjje
          mlhls.MoveNext
     Next intCount
     l = intfixl
     n = l
     While (msgGrid.TextMatrix(0, l) <> "本次开单")
            l = l + 1
     Wend
     While (msgGrid.TextMatrix(0, n) <> "未开单")
            n = n + 1
     Wend
     hlb(n).Caption = CStr(dx)
     hlb(l).Caption = CStr(dz)
     hlb(l).Refresh
     hlb(n).Refresh
End Sub

Private Sub cmdItemData_Click(Index As Integer)
'响应窗体按钮动作
    Dim lngID As Long
    Select Case Index
    Case 7                                    '确定存盘
        blnIsCancel = True
        If msgGrid.Rows > 1 Then
           Call FinishGrid(True)
        Else
           Unload Me
        End If
    Case 1                                    '取消
        blnIsCancel = True
        Unload Me
    Case 2                                    '筛选
        Call Select_Some
    Case 3                                    '栏目设置
        If msgGrid.Rows > 1 Then
           If ShowMsg(Me.hwnd, "栏目设置后，你刚刚做的选择将取消，需要先存盘吗", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "工程材料及费用开单") = IDYES Then
               FinishGrid (False)
           End If
           mclsGrid1.GridToListSet
           mclsGrid1.ListSet.SaveList
        End If
        
        mclsGrid1.ListSet.ShowListSet (113)
        mclsGrid1.ListSet.ViewId = 113
        Call RefreshGrid(False)
        mintCloseCol = Balance.FindClosedCol(msgGrid)
    Case 4                                    '关联
            With msgGrid
                If .Rows > 1 Then
                    lngID = .TextMatrix(.Row, 0)
                    lngID = Balance.Get_MyItemActivityID(lngID)
                    If lngID > 0 Then
                        ToFormName.ShowAOldBill lngID
                    Else
                        ShowMsg Me.hwnd, "该商品资料对应的采购单不存在", vbInformation, Me.Caption
                    End If
                Else
                    ShowMsg Me.hwnd, "无商品资料可以关联", vbInformation, Me.Caption
                End If
            End With
    Case 5                                   '全部选择
        Call Select_All("√")
    Case 6
        Call Select_All("")                 '全部取消
    End Select
End Sub

Public Sub GivemeParameter(ToForm As Object)
       Set ToFormName = ToForm
       Me.Show 1
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyEscape Then Unload Me
End Sub

Private Sub SetColWidth()
    Dim i As Integer, strColWidth As String
    
    strColWidth = GetSetting(App.title, "frmProjectCost", "ColWidth", "")
    For i = 1 To msgGrid.Cols - 1
        msgGrid.ColWidth(i) = StringOut(strColWidth, ",")
    Next i
End Sub

Private Sub Form_Load()
    Dim recRecordset As Recordset
    Dim strSql As String
    SetHelpID Me.hwnd, 30001
    mlngCustomerID = ToFormName.lblHead(0).Tag
    mlngCurrencyID = ToFormName.GetFID(7)
    mlngID = ToFormName.getID
    blnIsCancel = False
    mlngCol = 0
    msgGrid.Cols = 18
    strSql = "SELECT strCurrencyName FROM Currencys WHERE lngCurrencyID=" & mlngCurrencyID
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    If Not recRecordset.EOF Then
        lblProjectCost(2).Caption = "币种：" & recRecordset!strCurrencyName
    End If
    strSql = "SELECT strCustomerName FROM Customer WHERE lngCustomerID=" & mlngCustomerID
    Set recRecordset = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    If Not recRecordset.EOF Then
        lblProjectCost(0).Caption = "单位：" & recRecordset!strCustomerName
    End If
    recRecordset.Close
    Set recRecordset = Nothing
    Set mclsGrid1 = New NewGrid
    Set mclsGrid1.Grid = msgGrid
    Set mclsGrid1.Form = Me
    mclsGrid1.ColOfs = 7
    mclsGrid1.ListSet.ViewId = 113
    Call RefreshGrid(False)
    Set mclsGrid1.EditText = txtEdit
    mclsGrid1.SetEditText "本次开单", "###,###,###.00"
    Set cmdItemData(7).Picture = Utility.GetFormResPicture(1001, 0)
    Set cmdItemData(1).Picture = Utility.GetFormResPicture(1002, 0)
    Set cmdItemData(4).Picture = Utility.GetFormResPicture(1010, 0)
    Set msgGrid.MouseIcon = Utility.GetFormResPicture(2001, 2)
    gspEdit.Max = 9999
    gspEdit.Min = -9999
    mintCloseCol = Balance.FindClosedCol(msgGrid)
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    SetColWidth
End Sub
Private Sub Form_Resize()
   Dim leftx As Integer
   If Me.WindowState = 1 Then
      Exit Sub
   End If
    If Me.width < 7368 Then
        Me.width = 7368
    End If
    msgGrid.width = Me.ScaleWidth - DlListFormLeft - DlListFormRight * 2 - DlFormButtonWidth
    If Me.Height < 4018 Then
        Me.Height = 4018
    End If
    msgGrid.Height = Me.ScaleHeight - DlListUpAreaHeight - DlListDownAreaHeight - DlListFormBottom
    leftx = Me.ScaleLeft + Me.ScaleWidth - DlFormButtonWidth - DlListFormRight + 18
    cmdItemData(4).Left = leftx
    cmdItemData(7).Left = leftx
    cmdItemData(1).Left = leftx
    cmdItemData(2).Left = leftx
    cmdItemData(3).Left = leftx
'    cmdItemData(4).Left = leftx
    cmdItemData(5).Left = leftx
    cmdItemData(6).Left = leftx
    lblProjectCost(0).width = Int(Me.ScaleWidth / 2.8)
    lblProjectCost(1).Left = lblProjectCost(0).Left + lblProjectCost(0).width + Int(Me.ScaleWidth / 25) - 118
    gspEdit.Left = lblProjectCost(1).Left + lblProjectCost(1).width
    lblProjectCost(3).Left = gspEdit.Left + gspEdit.width
    lblProjectCost(2).Left = msgGrid.width - lblProjectCost(2).width + 588
    mclsGrid1.TotalRowAdjust
    Me.Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
'响应退出窗体动作
    If blnIsCancel = False And msgGrid.Rows > 1 Then
       If Balance.IsChange(msgGrid, 6) Then
            If ShowMsg(Me.hwnd, "确定退出工程材料及费用开单吗", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "工程材料及费用开单") = IDNO Then
                Cancel = True
                Exit Sub
            End If
       End If
    End If
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (1010)
    Utility.RemoveFormResPicture 139
    Set mclsGrid1 = Nothing
    Set ToFormName = Nothing
    Set mlhls = Nothing
    SaveColWidth
End Sub

Private Sub SaveColWidth()
    Dim i As Integer, strColWidth As String
    
    strColWidth = msgGrid.ColWidth(1)
    For i = 2 To msgGrid.Cols - 1
        strColWidth = strColWidth & "," & msgGrid.ColWidth(i)
    Next i
    SaveSetting App.title, "frmProjectCost", "ColWidth", strColWidth
End Sub

'全选
Private Sub Select_All(ByVal strChoose As String)
'完全选择
Dim i As Integer, p As Integer
Dim XX As Double
    i = intfixl + 1
    p = i
    '本循环找出本次收款及本次折扣所在的列
    While (msgGrid.TextMatrix(0, i) <> "本次开单")
          i = i + 1
    Wend
    While (msgGrid.TextMatrix(0, p) <> "关闭")
          p = p + 1
    Wend
    ytextRow = 1
    With msgGrid
         If strChoose = "√" Then
            Do While ytextRow < .Rows
               If .TextMatrix(ytextRow, p) <> "√" Then
                   .TextMatrix(ytextRow, 6) = "√"
                    XX = getnumber(ytextRow, 2) - getnumber(ytextRow, i)
                    msgGrid.TextMatrix(ytextRow, i) = msgGrid.TextMatrix(ytextRow, 2)
                    hlb(i).Caption = CStr(CDbl(IIf(Len(hlb(i).Caption) = 0, "0", hlb(i).Caption)) + XX)
        '               'hLb(i).Caption = Format((CDbl(hLb(i).Caption) + xx), "###,###,##0.00")
                End If
                ytextRow = ytextRow + 1
            Loop
         Else
            Do While ytextRow < .Rows
               If .TextMatrix(ytextRow, p) <> "√" Then
                  .TextMatrix(ytextRow, 6) = ""
                   XX = 0 - getnumber(ytextRow, i)
                   msgGrid.TextMatrix(ytextRow, i) = ""
                    hlb(i).Caption = CStr(CDbl(IIf(Len(hlb(i).Caption) = 0, "0", hlb(i).Caption)) + XX)
        '               'hLb(i).Caption = Format((CDbl(hLb(i).Caption) + xx), "###,###,##0.00")
                End If
                ytextRow = ytextRow + 1
            Loop
         End If
    End With
End Sub
Private Function getnumber(getx As Integer, gety As Integer) As Double
'从Flexgrid中取出数字值
    If (Len(Trim(msgGrid.TextMatrix(getx, gety))) = 0) Or IsNull(msgGrid.TextMatrix(getx, gety)) Then
        getnumber = 0
    Else
        getnumber = CDbl(msgGrid.TextMatrix(getx, gety))
    End If
End Function

'筛选
Private Sub Select_Some()
    If msgGrid.Rows > 1 Then
       If ShowMsg(Me.hwnd, "筛选后，你刚刚做的选择将被取消，需要先存盘吗", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "工程材料及费用开单") = IDYES Then
          FinishGrid (False)
       End If
    End If
    If mclsGrid1.ListSet.ListID < 1 Then
       mclsGrid1.ListSet.SaveList
    End If
    Filter.ShowFilter mclsGrid1.ListSet.ListID, 1
    mclsGrid1.ListSet.SaveList
    mclsGrid1.ListSet.ViewId = 113
    Call RefreshGrid(True)
End Sub

Private Sub gspEdit_KeyPress(KeyAscii As Integer, bCancel As Long)
'在gspEdit框中有键按下时响应的事件
    If KeyAscii = vbKeyEscape Then Unload Me
    If KeyAscii > 47 And KeyAscii < 58 Or KeyAscii = vbKeyBack Or KeyAscii = 13 Or KeyAscii = 46 Then
        If KeyAscii = 13 Then
            If Val(gspEdit.Text) > 9999 Then
                gspEdit.Text = 9999
            End If
            gspEdit.Text = Val(gspEdit.Text)
        End If
    Else
        KeyAscii = 0
    End If
End Sub