frmacount.frm

本程序源码是由vb编写的

 
End Sub


Private Sub Grid2_DblClick()

  If Trim(Grid2.TextMatrix(Grid2.Row, 8)) = "" Then Exit Sub
     Dim sTMp As String
       sTMp = Grid2.TextMatrix(Grid2.Row, 2)
     If sTMp = "收款单" Or sTMp = "退款单" Then
        ShowOrder Grid2.TextMatrix(Grid2.Row, 8)
      Else
         
     End If
 MovePic picCash, False, frmAcount, Grid1, Grid2

End Sub

Private Sub Grid4_DblClick()

  If Trim(Grid4.Text) = "" Then Exit Sub
     ShowOrder Grid4.Text
     MovePic picBrowser, False, frmAcount, Grid1, Grid4

End Sub

Private Sub mnuBN_Click()

  chtReport.chartType = 14
  
End Sub

Private Sub mnuCM_Click()
chtReport.chartType = 8
End Sub

Private Sub mnuCopy_Click()
chtReport.EditCopy
End Sub

Private Sub mnuH_Click()
chtReport.chartType = 2
End Sub

Private Sub mnuLine_Click()
chtReport.chartType = 3
End Sub

Private Sub mnuSD_Click()
chtReport.chartType = 16
End Sub

Private Sub mnuT_Click()
chtReport.chartType = 0
End Sub

Private Sub mnuZH_Click()
chtReport.chartType = 9
End Sub

Private Sub picBrowser_Resize()
 
  On Error Resume Next
  Grid4.left = 0
  Grid4.tOp = 0
  Grid4.Width = picBrowser.ScaleWidth
  Grid4.Height = picBrowser.ScaleHeight - picTool1.Height - 100
  picTool1.left = 0
  picTool1.tOp = Grid4.Height + 50
  picTool1.Width = Grid4.Width

End Sub

Private Sub picCash_Resize()

  On Error Resume Next
  Grid2.left = 0
  Grid2.tOp = 0
  Grid2.Width = picCash.ScaleWidth
  Grid2.Height = picCash.ScaleHeight - Picture3.Height - 100
  Picture3.left = 0
  Picture3.tOp = Grid2.Height + 50
  Picture3.Width = Grid2.Width

End Sub

Private Sub picOperator_Resize()

   On Error Resume Next
   Grid1.left = 120
   Grid1.tOp = 1800
   Grid1.Width = picOperator.Width - 300
   Grid1.Height = picOperator.Height - 2400
   Frame1.tOp = picOperator.Height - 650
   Frame1.left = 120
   Frame1.Width = Grid1.Width

End Sub


Private Sub picSelectP_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
 If Button = 2 Then
   '右键时
    PopupMenu mnuChart
 End If
End Sub

Private Sub picSelectP_Resize()
  
  On Error Resume Next
  Grid3.left = 0
  Grid3.tOp = 0
  Grid3.Width = picSelectP.ScaleWidth
  Grid3.Height = picSelectP.ScaleHeight - Picture1.Height - 100
  Picture1.left = 0
  Picture1.tOp = Grid3.Height + 50
  Picture1.Width = Grid3.Width
    
    Dim sngButtonTop As Single
    Dim sngScaleWidth As Single
    Dim sngScaleHeight As Single
    On Error GoTo Form_Resize_Error
    chtReport.Width = Grid3.Width
    chtReport.Height = Grid3.Height
    
    Exit Sub
Form_Resize_Error:
    '如果用户使窗体过小，以至于出现负值高度或宽度，则会出错。
    Resume Next
  
End Sub

Private Sub picTool1_Resize()

   On Error Resume Next
   cmdReturn.left = picTool1.Width - cmdReturn.Width - 200

End Sub

Private Sub Picture1_Resize()

   On Error Resume Next
   Command3.left = Picture1.Width - Command3.Width - 200

End Sub

Private Sub Picture3_Resize()

   On Error Resume Next
   cmdCashReturn.left = Picture3.Width - cmdCashReturn.Width - 200

End Sub

Private Sub tbOrder_ButtonClick(ByVal Button As MSComctlLib.Button)

 Select Case Button.Key
 
   Case "selldetail"
     '销售明细单
      FormID = "Count300"
      tbOrder.Buttons(1).Enabled = False
      tbOrder.Buttons(2).Enabled = False
      tbOrder.Buttons(4).Enabled = False
      MovePic picBrowser, True, frmAcount, Grid1, Grid4
   Case "sellcount"
      FormID = "Count200"
     '销售汇总
      tbOrder.Buttons(1).Enabled = False
      tbOrder.Buttons(2).Enabled = False
      tbOrder.Buttons(4).Enabled = False
      MovePic picSelectP, True, frmAcount, Grid1, Grid3
     '现金日记
   Case "cashday"
      FormID = "Count400"
      tbOrder.Buttons(1).Enabled = False
      tbOrder.Buttons(2).Enabled = False
      tbOrder.Buttons(4).Enabled = False
      MovePic picCash, True, frmAcount, Grid1, Grid2
   Case "print"

   Case "return"
     If picBrowser.left >= 0 Then
        tbOrder.Buttons(1).Enabled = True
        tbOrder.Buttons(2).Enabled = True
        tbOrder.Buttons(4).Enabled = True
        MovePic picBrowser, False, frmAcount, Grid1, Grid4
        FormID = "Count100"
        Exit Sub
     End If
     If picSelectP.left >= 0 Then
        tbOrder.Buttons(1).Enabled = True
        tbOrder.Buttons(2).Enabled = True
        tbOrder.Buttons(4).Enabled = True
        MovePic picSelectP, False, frmAcount, Grid1, Grid3
        FormID = "Count100"
        Exit Sub
     End If
     If picCash.left >= 0 Then
        tbOrder.Buttons(1).Enabled = True
        tbOrder.Buttons(2).Enabled = True
        tbOrder.Buttons(4).Enabled = True
        MovePic picCash, False, frmAcount, Grid1, Grid2
        FormID = "Count100"
        Exit Sub
     End If

     Unload Me
     
 End Select

End Sub

Private Sub tbOrder_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)

          '打印时给表头三部分+表名+行高++++++++++++++++++++++++++++++++++++++++++++++++++
             'On Error GoTo Print_Err
        Select Case FormID
          Case "Count100"
                Start_print.N_TiTle = "销售单"
                Start_print.N_Head10 = "单位：零售"
                Start_print.N_Head11 = "制单人：" & sUserName
                Start_print.N_Head2 = "时间：" & dpDate.Value
                Set Start_print.N_Grid = Grid1
          Case "Count200"
                Start_print.N_TiTle = "销售汇总表"
                Start_print.N_Head10 = "制单人：" & sUserName
                Start_print.N_Head11 = ""
                Start_print.N_Head2 = "汇总时间：" & dpAStart.Value & "到" & dpAEnd.Value
                Set Start_print.N_Grid = Grid3
          Case "Count300"
                Start_print.N_TiTle = "销售明细表"
                Start_print.N_Head10 = "制单人：" & sUserName
                Start_print.N_Head11 = ""
                Start_print.N_Head2 = "时间范围：" & dtStartDate.Value & "到" & dtEndDate.Value
                Set Start_print.N_Grid = Grid4
          Case "Count400"
                Start_print.N_TiTle = "现金表"
                Start_print.N_Head10 = "制单人：" & sUserName
                Start_print.N_Head11 = ""
                Start_print.N_Head2 = "时间范围：" & dpCStart.Value & "到" & dpCEnd.Value
                Set Start_print.N_Grid = Grid2
        End Select
         Select Case ButtonMenu.Key
           Case "set"
                  '如果值改变，将保存新的记录
                  SavePrintSet Start_print, "Get", FormID '给出该ID配置
                  frmPrintSet.Show 1
                   If PrintSetChange = True Then
                      SavePrintSet Start_print, "Save", FormID
                   End If
           Case "print"
                 Start_print.PrintPage
         End Select
         
           '释放内存
          '打印结束++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
          Exit Sub
Print_Err:
          MsgBox "对不起，打印设置或打印错误，请与供应商联系！    " & vbCrLf & vbCrLf & " 电话：[phone] 8269007 [e-mail]   ", vbInformation
          Exit Sub
End Sub

Private Sub TimeDate_Timer()

   lbDate.Caption = Format(Time, "hh:mm:ss AM/PM")
   
End Sub

Private Sub ConfigData()

  On Error GoTo Err_S
  '配置网格
   Grid1.Clear
   Grid1.Visible = False
   Grid1.Rows = 23
   Dim sFormat As String
   Dim x As Integer
   For x = 1 To CodeQua
       sFormat = sFormat & "|<" & CodeName(x)
   Next
   Grid1.FormatString = "^ |<产品编号|<产品名称|<单位" & sFormat & "|<单价 |<总额   "
   Grid1.ColWidth(0) = 200
   Grid1.ColWidth(1) = 2100
   Grid1.ColWidth(2) = 2200
   Grid1.ColWidth(3) = 1000
   'Code Qua starting ...
   For x = 1 To CodeQua
       Grid1.ColWidth(x + 3) = 800
   Next
   Grid1.ColWidth(4 + CodeQua) = 1200
   Grid1.ColWidth(5 + CodeQua) = 1750

    Grid1.Col = 0
    Grid1.Row = 1
    Grid1.Col = 1
    Grid1.ColSel = 1
    Grid1.Visible = True
    txtEdit = ""
    txtEdit.left = (Grid1.left + Grid1.CellLeft) - 10
    txtEdit.tOp = Grid1.tOp + Grid1.CellTop - 10
    txtEdit.Width = Grid1.CellWidth + 20
    cmdSelect.tOp = Grid1.tOp + Grid1.CellTop + 8
    cmdSelect.left = txtEdit.left + (txtEdit.Width - cmdSelect.Width) - 30

        
   Exit Sub
Err_S:
  MsgBox "很抱歉，不能正常配置网格：请到WWW.VB-CODE.NET网站咨询   " & vbCrLf & vbCrLf & Err.Description, vbInformation, "Error for form load."
  Exit Sub

End Sub

Private Sub StartLoad()

   On Error Resume Next
   bDelSelect = 0
   lbOperator = sUserName
   dpDate.Value = Date
   txtUnitID.Text = sShopName
  '装载动画光标
   New_AniCur1.AniFileName = App.Path + "\sys\9.ani"
   New_AniCur1.SetAniCursor Grid4.hwnd
   ConfigOrder "Select * From SellSheet Where Date=#" & Date & "#  Order By ID"
   ConfigAcount "Select * From Account Where Date=#" & Date & "#  Order By ID"
   dtEndDate.Value = Date
   dtStartDate.Value = DateAdd("d", -7, dtEndDate.Value)
   dpAEnd.Value = Date
   dpAStart.Value = DateAdd("d", -7, dpAEnd.Value)
   dpCEnd.Value = Date
   dpCStart.Value = DateAdd("d", -7, dpCEnd.Value)
   MarkCount "INSERT into SellCount SELECT GoodsID, GoodsName, Sum(Qua1) AS Q1, Sum(Qua2) AS Q2, Sum(Qua3) AS Q3, Sum(Qua4) AS Q4, Sum(Qua5) AS Q5, Sum(Qua6) AS Q6, Sum(Qua7) AS Q7, Sum(Qua8) AS Q8, Sum(Qua9) AS Q9, Sum(SumQua) AS SumQua1, Sum(Amo) AS Amo1 From SellDetail Where SellDetail.Date =#" & Date & "# GROUP BY GoodsID,GoodsName", Date
   ConfigProduct "Select * From SellCount order by SumQua1 desc"
   MarkChart

End Sub

Private Sub ConfigOrder(sSQL As String)

  On Error GoTo Err_S
  Dim Con As Database
  Dim rRecord As Recordset
  Set Con = OpenDatabase(ConData, 0, 0, ConStr)
  Set rRecord = Con.OpenRecordset(sSQL, dbOpenDynaset)
  '配置网格
   Grid4.Visible = False
   Grid4.Clear
   Grid4.Cols = 7
   Grid4.FormatString = "^..|^ 销售单编号 |^ 单位名称 |^ 总数量 |^ 总金额 |^ 状态|^日期"
   Grid4.ColWidth(0) = 200
   Grid4.ColWidth(1) = 2400
   Grid4.ColWidth(2) = 3500
   Grid4.ColWidth(3) = 1000
   Grid4.ColWidth(4) = 1100
   Grid4.ColWidth(5) = 2100
   Grid4.ColWidth(6) = 1380
   If rRecord.BOF Or rRecord.EOF Then
      rRecord.Close
      Con.Close
      Set rRecord = Nothing
      Set Con = Nothing
   Else
      Dim GridNO As Long
      Do While Not rRecord.EOF
         GridNO = GridNO + 1
         rRecord.Mo