main.frm

来自「一套VB完整的灯具销售管理系统设计」· FRM 代码 · 共 736 行 · 第 1/2 页

FRM
736 行
字号
12
   Dim Tc As Integer
      Tc = MsgBox("退出要生成发票吗(Y/N)？" & Chr(13) & Chr(10) & "如果不生成发票，将不能保存此发票", 3 + 16, "不能白辛苦了！")
   '选择是时执行如下：
      If Tc = 6 Then
          If Scfp.Enabled = False Then
             MsgBox "没有发票号，不能生成新发票", vbOKOnly + 32, "暂停生成"
               '发票号栏获得焦点
             Fptxt.SetFocus
               '退出
                Exit Sub
                  Else
                Call Scfp_Click
                Unload Me
                Exit Sub
             End If
      End If
   '选择否时执行如下：
   If Tc = 7 Then
      Unload Me
      End If
      '选择取消时退出
      Exit Sub
End Sub


Private Sub DBGrid1_AfterDelete()
'统计金额
Dim db3 As Database, Tj As Recordset, RecStr As String
 Set db3 = OpenDatabase(appData)
 RecStr = "update tempk set 金额=数量*单价"
 db3.Execute RecStr
 Set Tj = db3.OpenRecordset("select sum(金额) as Tjfield from tempk", dbOpenDynaset)
 If IsNull(Tj.Fields(0)) Then
  Hjtxt.Caption = 0
  Else
   Hjtxt.Caption = Tj.Fields(0)
  End If
   db3.Close
'替代其它项目
    Set db3 = OpenDatabase(appData)
    Set Tj = db3.OpenRecordset("tempk", dbOpenDynaset)
    RecStr = "update tempk set 经手人='" & Trim(Jsrtxt.Text) & "',发票号='" & Trim(Fptxt.Text) & "',合计=val(" & Hjtxt.Caption & ")" & ",日期=#" & rqlab.Caption & "#"
    db3.Execute RecStr
Dim sfkNum As Currency, qkNum As Currency
    sfkNum = Val(SFktxt.Text)
    qkNum = Val(QkTXt.Text)
    RecStrx = "update tempk set 购货人='" & Trim(Ghrtxt.Text) & "',实付款=" & sfkNum & ",欠款=" & qkNum
    db3.Execute RecStrx
    db3.Close
    QkTXt.Text = Val(Hjtxt.Caption) - Val(SFktxt.Text)
 DBGrid1.Refresh

End Sub

Private Sub DBGrid1_AfterUpdate()
'统计金额
Dim db3 As Database, Tj As Recordset, RecStr As String
 Set db3 = OpenDatabase(appData)
 RecStr = "update tempk set 金额=数量*单价"
 db3.Execute RecStr
 Set Tj = db3.OpenRecordset("select sum(金额) as Tjfield from tempk", dbOpenDynaset)
 If IsNull(Tj.Fields(0)) Then
  Hjtxt.Caption = 0
  Else
   Hjtxt.Caption = Tj.Fields(0)
  End If
   db3.Close
'替代其它项目
    Set db3 = OpenDatabase(appData)
    Set Tj = db3.OpenRecordset("tempk", dbOpenDynaset)
    RecStr = "update tempk set 经手人='" & Trim(Jsrtxt.Text) & "',发票号='" & Trim(Fptxt.Text) & "',合计=val(" & Hjtxt.Caption & ")" & ",日期=#" & rqlab.Caption & "#"
    db3.Execute RecStr
Dim sfkNum As Currency, qkNum As Currency
    sfkNum = Val(SFktxt.Text)
    qkNum = Val(QkTXt.Text)
    RecStrx = "update tempk set 购货人='" & Trim(Ghrtxt.Text) & "',实付款=" & sfkNum & ",欠款=" & qkNum
    db3.Execute RecStrx
    db3.Close
    QkTXt.Text = Val(Hjtxt.Caption) - Val(SFktxt.Text)
 DBGrid1.Refresh

End Sub

Private Sub DBGrid1_Change()
updateF = True
SFktxt.Text = 0
QkTXt.Text = 0
End Sub

Private Sub DBGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

'在第一列，按鼠标右键和非编辑情况下，执行如下：
If Button = 2 And DBGrid1.Col = 0 And DBGrid1.EditActive = False Then
    main.MousePointer = 11
    Load cpselect
    main.MousePointer = 0
    cpselect.Show 1
  Call DBGrid1_OnAddNew
   End If
End Sub

Private Sub DBGrid1_OnAddNew()
'统计金额
Dim db3 As Database, Tj As Recordset, RecStr As String
 Set db3 = OpenDatabase(appData)
 RecStr = "update tempk set 金额=数量*单价"
 db3.Execute RecStr
 Set Tj = db3.OpenRecordset("select sum(金额) as Tjfield from tempk", dbOpenDynaset)
 If IsNull(Tj.Fields(0)) Then
  Hjtxt.Caption = 0
  Else
   Hjtxt.Caption = Tj.Fields(0)
  End If
   db3.Close
'替代其它项目
    Set db3 = OpenDatabase(appData)
    Set Tj = db3.OpenRecordset("tempk", dbOpenDynaset)
    RecStr = "update tempk set 经手人='" & Trim(Jsrtxt.Text) & "',发票号='" & Trim(Fptxt.Text) & "',合计=val(" & Hjtxt.Caption & ")" & ",日期=#" & rqlab.Caption & "#"
    db3.Execute RecStr
Dim sfkNum As Currency, qkNum As Currency
    sfkNum = Val(SFktxt.Text)
    qkNum = Val(QkTXt.Text)
    RecStrx = "update tempk set 购货人='" & Trim(Ghrtxt.Text) & "',实付款=" & sfkNum & ",欠款=" & qkNum
    db3.Execute RecStrx
    db3.Close
    QkTXt.Text = Val(Hjtxt.Caption) - Val(SFktxt.Text)
 DBGrid1.Refresh

End Sub

Private Sub Form_Load()
main.Left = (Screen.Width - main.Width) / 2 - 200
main.Top = (Screen.Height - main.Height) / 2 - 110
'设定发票及临时库的路径
Temp.DatabaseName = appData
Temp.RecordSource = "tempk"
fpData.DatabaseName = appData
fpData.RecordSource = "fpk"
fpData.Refresh
'发票号自动加 1
On Error GoTo xx
fpData.Recordset.MoveLast
If IsNull(fpData.Recordset.Fields(0)) Then
    Fptxt.Text = "1998001"
   Else
    Fptxt.Text = fpData.Recordset.Fields(0) + 1
End If
fpData.Refresh
GoTo yy
xx:
  Fptxt.Text = "1998001"
yy:
  
'清空临时库
Dim Db As Database
   Set Db = OpenDatabase(appData)
   RecStr = "delete * from tempk"
   Db.Execute RecStr
   Db.Close
'设定日期
rqlab.Caption = Date
'设定经手人，登录时用的
Jsrtxt.Text = Manager
'发票没有开时，不能生成发票
     '初始化生成发票逻辑性
     Scfp.Enabled = True
     scfpF = False
     updateF = False
     PrintFP.Enabled = False
End Sub


Private Sub Fptxt_Change()
updateF = True
End Sub

Private Sub Fptxt_Click()
Fptxt.SelStart = 0
Fptxt.SelLength = Len(Fptxt.Text)
End Sub
Private Sub Fptxt_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   Ghrtxt.SetFocus
   End If
End Sub

Private Sub Ghrtxt_Change()
updateF = True
End Sub

Private Sub Ghrtxt_DblClick()
    main.MousePointer = 11
    Load GhrSelect
    main.MousePointer = 0
    GhrSelect.Show 1
End Sub

Private Sub Ghrtxt_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   Jsrtxt.SetFocus
   End If
End Sub

Private Sub Hjtxt_Change()
updateF = True
Hj = Format(Hjtxt.Caption, "###,###,###,###,###.##")
End Sub


Private Sub Jsrtxt_Change()
updateF = True
End Sub

Private Sub Jsrtxt_Click()
Jsrtxt.SelStart = 0
Jsrtxt.SelLength = Len(Jsrtxt.Text)
End Sub


Private Sub Jsrtxt_DblClick()
main.MousePointer = 11
Load jsrselect
main.MousePointer = 0
jsrselect.Show 1
End Sub

Private Sub Jsrtxt_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   DBGrid1.SetFocus
   End If
End Sub

Private Sub printfp_Click()

'检测生成发票后，如果更新的话，通知并反应更新事件
If updateF = True Then
   MsgBox "因发票更改，现在重新生成发票!", vbOKOnly + 48, "发票更正"
       Call Scfp_Click
   End If
'打印发票内容
Report1.ReportFileName = Browser + "report\Fp.rpt"
'Report1.ReportFileName = "c:\dj\fp.rpt"
Report1.PrintReport
   
End Sub

Private Sub rqlab_Change()
updateF = True
End Sub

Private Sub rqlab_DblClick()
main.MousePointer = 11
Load rqform1
main.MousePointer = 0
rqform1.Show 1
End Sub

Private Sub Scfp_Click()
'统计金额
Dim db3 As Database, Tj As Recordset, RecStr As String
 Set db3 = OpenDatabase(appData)
 RecStr = "update tempk set 金额=数量*单价"
 db3.Execute RecStr
 Set Tj = db3.OpenRecordset("select sum(金额) as Tjfield from tempk", dbOpenDynaset)
 If IsNull(Tj.Fields(0)) Then
  Hjtxt.Caption = 0
  Else
   Hjtxt.Caption = Tj.Fields(0)
  End If
   db3.Close
'替代其它项目
    Set db3 = OpenDatabase(appData)
    Set Tj = db3.OpenRecordset("tempk", dbOpenDynaset)
    RecStr = "update tempk set 经手人='" & Trim(Jsrtxt.Text) & "',发票号='" & Trim(Fptxt.Text) & "',合计=val(" & Hjtxt.Caption & ")" & ",日期=#" & rqlab.Caption & "#"
    db3.Execute RecStr
Dim sfkNum As Currency, qkNum As Currency
    sfkNum = Val(SFktxt.Text)
    qkNum = Val(QkTXt.Text)
    RecStrx = "update tempk set 购货人='" & Trim(Ghrtxt.Text) & "',实付款=" & sfkNum & ",欠款=" & qkNum
    db3.Execute RecStrx
    db3.Close
    QkTXt.Text = Val(Hjtxt.Caption) - Val(SFktxt.Text)
 DBGrid1.Refresh

'生成发票
fpData.Refresh
Dim Db As Database, ef As Recordset, Emtry As Integer
   Set Db = OpenDatabase(appData)
    Set ef = Db.OpenRecordset("tempk", dbOpenTable)
        Emtry = ef.RecordCount
        If Emtry = 0 Then
           MsgBox "此发票没有购货物，不以生成。" & Chr(13) & Chr(10) & "如果要生成，请选购货物。", vbOKOnly + 32, "没购货物"
             Db.Close
              Exit Sub
              Else
             '检测发票号有没有重复，如果有，则提示！
                FindStr = Trim(Fptxt.Text)
                FindStr = "发票号='" & FindStr & "'"
                   fpData.Recordset.FindFirst FindStr
                   If fpData.Recordset.NoMatch Then
                       '插入到发票库中
                       RecStr = "insert into fpk select * from tempk"
                       Db.Execute RecStr
                       '插入到客户库中
                       RecStr = "insert into guestfindk (发票号,经手人,购货人,日期,欠款,实付款,合计) values('"
                       RecStr = RecStr & Trim(Fptxt.Text) & "','" & Trim(Jsrtxt.Text) & "','" & Trim(Ghrtxt.Text) & "',#" & rqlab.Caption & "#," & Val(QkTXt.Text) & "," & Val(SFktxt.Text) & "," & Val(Hjtxt.Caption) & ")"
                       Db.Execute RecStr
                       Db.Close
                            Else
                              selectnum = MsgBox("该发票已经存在，是否覆盖（Y/N）？", 4 + 48, "发票重复")
                                If selectnum = 6 Then
                                  '删除发票库
                                  RecStr = "delete * from fpk where 发票号='" & Trim(Fptxt.Text) & "'"
                                  Db.Execute RecStr
                                  '删除客户总额库
                                  RecStr = "delete * from guestfindk where 发票号='" & Trim(Fptxt.Text) & "'"
                                  Db.Execute RecStr
                                  '插入到发票库
                                  RecStr = "insert into fpk select * from tempk"
                                  Db.Execute RecStr
                                  '插入到客户库中
                                  RecStr = "insert into guestfindk (发票号,经手人,购货人,日期,欠款,实付款,合计) values('"
                                  RecStr = RecStr & Trim(Fptxt.Text) & "','" & Trim(Jsrtxt.Text) & "','" & Trim(Ghrtxt.Text) & "',#" & rqlab.Caption & "#," & Val(QkTXt.Text) & "," & Val(SFktxt.Text) & "," & Val(Hjtxt.Caption) & ")"
                                  Db.Execute RecStr
                                  Db.Close
                                 End If
                    End If
               
        End If
       
'生成表为真
scfpF = True
'更新为假
updateF = False
PrintFP.Enabled = True
End Sub

Private Sub Sfktxt_Change()
updateF = True
If Val(Hjtxt.Caption) < Val(SFktxt.Text) Then
   MsgBox "注意：应付 " & Hj.Caption & " 元" & Chr(13) & Chr(10) & "您付的钱太多了！", vbOKOnly + 48, "钱过多?"
   SFktxt.SelStart = 0
   SFktxt.SelLength = Len(SFktxt.Text)
   SFktxt.Text = Hjtxt.Caption
   QkTXt.Text = "0"
   Exit Sub
End If
QkTXt.Text = Val(Hjtxt.Caption) - Val(SFktxt.Text)
End Sub

Private Sub Sfktxt_DblClick()
SFktxt.Text = Hjtxt.Caption
End Sub

Private Sub Sfktxt_KeyPress(KeyAscii As Integer)
  If KeyAscii = 8 Then
   If Val(Trim(SFktxt.Text)) = 0 Then
        KeyAscii = 0
      Else
        SFktxt.Text = Left(SFktxt.Text, (Len(SFktxt.Text) - 1))
        SFktxt.SelStart = Len(SFktxt.Text)
      End If
      End If
If KeyAscii = 47 Or KeyAscii < 46 Or KeyAscii > 58 Then
      KeyAscii = 0
      End If
End Sub
12

main.frm - 源码说明

本页面展示了「一套VB完整的灯具销售管理系统设计」中的 main.frm 源码文件，采用 FRM 编程语言编写，共 736 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫开发者社区收录了大量与VB相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?