frm_Use.frm
上传用户:yexiandon
上传日期:2022-07-12
资源大小:895k
文件大小:17k
源码类别:

百货/超市行业

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
  3. Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
  4. Begin VB.Form frm_Use 
  5.    BorderStyle     =   3  'Fixed Dialog
  6.    Caption         =   "采购单"
  7.    ClientHeight    =   5610
  8.    ClientLeft      =   45
  9.    ClientTop       =   330
  10.    ClientWidth     =   9405
  11.    Icon            =   "frm_Use.frx":0000
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   5610
  16.    ScaleWidth      =   9405
  17.    ShowInTaskbar   =   0   'False
  18.    StartUpPosition =   1  '所有者中心
  19.    Begin VB.ComboBox cboCar 
  20.       Height          =   300
  21.       ItemData        =   "frm_Use.frx":000C
  22.       Left            =   6600
  23.       List            =   "frm_Use.frx":000E
  24.       Style           =   2  'Dropdown List
  25.       TabIndex        =   7
  26.       Top             =   120
  27.       Width           =   1335
  28.    End
  29.    Begin VB.CommandButton CancelButton 
  30.       Caption         =   "取消"
  31.       Height          =   300
  32.       Left            =   8160
  33.       TabIndex        =   11
  34.       Top             =   5160
  35.       Width           =   975
  36.    End
  37.    Begin VB.CommandButton OKButton 
  38.       Caption         =   "确定"
  39.       Height          =   300
  40.       Left            =   7080
  41.       TabIndex        =   10
  42.       Top             =   5160
  43.       Width           =   975
  44.    End
  45.    Begin VB.ComboBox cboClerk 
  46.       Height          =   300
  47.       ItemData        =   "frm_Use.frx":0010
  48.       Left            =   4560
  49.       List            =   "frm_Use.frx":0012
  50.       Style           =   2  'Dropdown List
  51.       TabIndex        =   5
  52.       Top             =   120
  53.       Width           =   1335
  54.    End
  55.    Begin VB.TextBox txtNum 
  56.       BackColor       =   &H8000000F&
  57.       BorderStyle     =   0  'None
  58.       Enabled         =   0   'False
  59.       Height          =   225
  60.       Left            =   1080
  61.       Locked          =   -1  'True
  62.       TabIndex        =   13
  63.       Text            =   "0"
  64.       Top             =   5160
  65.       Width           =   1215
  66.    End
  67.    Begin VB.TextBox txtM 
  68.       BackColor       =   &H8000000F&
  69.       BorderStyle     =   0  'None
  70.       Enabled         =   0   'False
  71.       Height          =   225
  72.       Left            =   3360
  73.       Locked          =   -1  'True
  74.       TabIndex        =   12
  75.       Text            =   "0"
  76.       Top             =   5160
  77.       Width           =   1215
  78.    End
  79.    Begin VB.TextBox txtDATA 
  80.       BorderStyle     =   0  'None
  81.       Height          =   270
  82.       Left            =   8640
  83.       TabIndex        =   8
  84.       Top             =   600
  85.       Visible         =   0   'False
  86.       Width           =   495
  87.    End
  88.    Begin MSComCtl2.DTPicker DTP 
  89.       Height          =   300
  90.       Index           =   0
  91.       Left            =   600
  92.       TabIndex        =   1
  93.       Top             =   135
  94.       Width           =   1335
  95.       _ExtentX        =   2355
  96.       _ExtentY        =   529
  97.       _Version        =   393216
  98.       CustomFormat    =   "yyyy-MM-dd"
  99.       Format          =   25559043
  100.       CurrentDate     =   38718
  101.    End
  102.    Begin MSFlexGridLib.MSFlexGrid GD1 
  103.       Height          =   4530
  104.       Left            =   120
  105.       TabIndex        =   9
  106.       Top             =   480
  107.       Width           =   9195
  108.       _ExtentX        =   16219
  109.       _ExtentY        =   7990
  110.       _Version        =   393216
  111.       Rows            =   16
  112.       Cols            =   9
  113.       RowHeightMin    =   275
  114.       AllowBigSelection=   0   'False
  115.       HighLight       =   0
  116.       AllowUserResizing=   1
  117.       FormatString    =   "序|配件名称|规格型号|ID|单位|数量|单价|金额|备注"
  118.    End
  119.    Begin MSComCtl2.DTPicker DTP 
  120.       Height          =   300
  121.       Index           =   1
  122.       Left            =   2520
  123.       TabIndex        =   3
  124.       Top             =   120
  125.       Width           =   1335
  126.       _ExtentX        =   2355
  127.       _ExtentY        =   529
  128.       _Version        =   393216
  129.       CustomFormat    =   "HH:mm:ss"
  130.       Format          =   25559042
  131.       CurrentDate     =   38718
  132.    End
  133.    Begin VB.Label lblxcd 
  134.       Caption         =   "维修车"
  135.       Height          =   195
  136.       Index           =   1
  137.       Left            =   6000
  138.       TabIndex        =   6
  139.       Top             =   195
  140.       Width           =   615
  141.    End
  142.    Begin VB.Label Label1 
  143.       Caption         =   "数量合计"
  144.       Height          =   195
  145.       Left            =   240
  146.       TabIndex        =   15
  147.       Top             =   5160
  148.       Width           =   735
  149.    End
  150.    Begin VB.Label Label2 
  151.       Caption         =   "金额合计"
  152.       Height          =   195
  153.       Left            =   2520
  154.       TabIndex        =   14
  155.       Top             =   5160
  156.       Width           =   735
  157.    End
  158.    Begin VB.Label lblxcd 
  159.       Caption         =   "时间"
  160.       Height          =   195
  161.       Index           =   5
  162.       Left            =   2040
  163.       TabIndex        =   2
  164.       Top             =   195
  165.       Visible         =   0   'False
  166.       Width           =   375
  167.    End
  168.    Begin VB.Label lblxcd 
  169.       Caption         =   "经手人"
  170.       Height          =   195
  171.       Index           =   2
  172.       Left            =   3960
  173.       TabIndex        =   4
  174.       Top             =   195
  175.       Width           =   615
  176.    End
  177.    Begin VB.Label lblxcd 
  178.       Caption         =   "日期"
  179.       Height          =   195
  180.       Index           =   0
  181.       Left            =   120
  182.       TabIndex        =   0
  183.       Top             =   195
  184.       Width           =   375
  185.    End
  186. End
  187. Attribute VB_Name = "frm_Use"
  188. Attribute VB_GlobalNameSpace = False
  189. Attribute VB_Creatable = False
  190. Attribute VB_PredeclaredId = True
  191. Attribute VB_Exposed = False
  192. '****************************************************************************
  193. '人人为我,我为人人
  194. '枕善居收藏整理
  195. '发布日期:2008/01/21
  196. '描    述:汽车维修管理系统SQL2000版
  197. '网    站:http://www.Mndsoft.com/  (VB6源码博客)
  198. '网    站:http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
  199. 'e-mail  :Mndsoft@163.com
  200. 'e-mail  :Mndsoft@126.com
  201. 'OICQ    :88382850
  202. '          如果您有新的好的代码别忘记给枕善居哦!
  203. '****************************************************************************
  204. Option Explicit
  205. Const Bpname = 1
  206. Const Bguige = 2
  207. Const Bppcd = 3
  208. Const Bdw = 4
  209. Const Bnum = 5
  210. Const Bprice = 6
  211. Const Bje = 7
  212. Const Bbak = 8
  213. Public mvarViewType As gxcViewType
  214. Public mvarID As String
  215. Public OK As Boolean
  216. Private Sub CancelButton_Click()
  217. OK = False
  218. Unload Me
  219. End Sub
  220. Public Sub AllClerksToCombo(ByRef cbo As ComboBox)
  221.   Dim i As Long
  222.   Dim objTypes As New Recordset
  223.   cbo.Clear '清除当前的列表内容
  224.   Set objTypes = g_Conn.Execute("Select clkID,clkName from Clerk")
  225.   For i = 1 To objTypes.RecordCount
  226.     Call cbo.AddItem(objTypes(1), i - 1)
  227.     cbo.ItemData(i - 1) = objTypes(0)
  228.     objTypes.MoveNext
  229.   Next i
  230. End Sub
  231. Public Sub AllCarsToCombo(ByRef cbo As ComboBox)
  232.   Dim i As Long
  233.   Dim objTypes As New Recordset
  234.   cbo.Clear '清除当前的列表内容
  235.   Set objTypes = g_Conn.Execute("Select ID,carNo from Client")
  236.   For i = 1 To objTypes.RecordCount
  237.     Call cbo.AddItem(objTypes(1), i - 1)
  238.     cbo.ItemData(i - 1) = objTypes(0)
  239.     objTypes.MoveNext
  240.   Next i
  241. End Sub
  242. Private Sub DTP_Change(Index As Integer)
  243. If Index = 0 Then DTP(1).Value = DTP(0).Value Else DTP(0).Value = DTP(1).Value
  244. End Sub
  245. Private Sub Form_Load()
  246.     With GD1
  247.         .ColWidth(0) = 300
  248.         .ColWidth(Bpname) = 1400
  249.         .ColWidth(Bguige) = 1400
  250.         .ColWidth(Bppcd) = 0
  251.         .ColWidth(Bdw) = 600
  252.         .ColWidth(Bnum) = 600
  253.         .ColWidth(Bprice) = 600
  254.         .ColWidth(Bje) = 800
  255.         .ColWidth(Bbak) = 2500
  256.     Dim i As Integer
  257.         .TextMatrix(0, 0) = "序"
  258.     For i = 1 To .Rows - 1
  259.         .TextMatrix(i, 0) = i
  260.         .Row = i
  261.         .Col = Bje
  262.         .CellBackColor = &HFFF800
  263.         .Col = Bguige
  264.         .CellBackColor = &HFFF800
  265.         .Col = Bppcd
  266.         .CellBackColor = &HFFF800
  267.         .Col = Bdw
  268.         .CellBackColor = &HFFF800
  269.     Next i
  270.         .Row = 1
  271.         .Col = 1
  272.     End With
  273. AllClerksToCombo cboClerk
  274. AllCarsToCombo cboCar
  275. Select Case mvarViewType
  276.     Case vtadd
  277.         DTP(0).Value = Now()
  278.         DTP(1).Value = Now()
  279.     Case vtModify
  280.         SetDefaultValue GetID(mvarID)
  281.     Case vtinfo
  282.         SetDefaultValue GetID(mvarID)
  283.         SetStatus
  284. End Select
  285. End Sub
  286. Function SetDefaultValue(IdnStr As String)
  287. Dim RSmain, RSsub As Recordset
  288. Dim i, ii As Integer
  289. Set RSmain = g_Conn.Execute("select * from Store where ID = " & IdnStr)
  290. DTP(0) = RSmain("Fdate")
  291. DTP(1) = RSmain("Fdate")
  292.   For i = 0 To cboClerk.ListCount - 1
  293.     If cboClerk.ItemData(i) = RSmain("cID") Then
  294.       cboClerk.ListIndex = i         '客户类型Id
  295.       Exit For
  296.     End If
  297.   Next i
  298.   For i = 0 To cboCar.ListCount - 1
  299.     If cboCar.ItemData(i) = RSmain("carID") Then
  300.       cboCar.ListIndex = i         '客户类型Id
  301.       Exit For
  302.     End If
  303.   Next i
  304. Set RSmain = Nothing
  305. Set RSsub = g_Conn.Execute("SELECT * FROM SubStore WHERE sID = " & IdnStr)
  306. With GD1
  307. For i = 1 To GD1.Rows - 1
  308.     For ii = 1 To GD1.Cols - 1
  309.     .TextMatrix(i, ii) = ""
  310.     Next
  311. Next
  312. ii = RSsub.RecordCount
  313. For i = 1 To ii
  314.     .TextMatrix(Val(RSsub("Line")), Bpname) = GetValueByID("PeiJian", "ID", RSsub("pID"), "pName")
  315.     .TextMatrix(Val(RSsub("Line")), Bguige) = GetValueByID("PeiJian", "ID", RSsub("pID"), "pType")
  316.     .TextMatrix(Val(RSsub("Line")), Bppcd) = IdnStr
  317.     .TextMatrix(Val(RSsub("Line")), Bdw) = GetValueByID("PeiJian", "ID", RSsub("pID"), "pUnit")
  318.     .TextMatrix(Val(RSsub("Line")), Bnum) = RSsub("pNum")
  319.     .TextMatrix(Val(RSsub("Line")), Bprice) = RSsub("pPrice")
  320.     .TextMatrix(Val(RSsub("Line")), Bbak) = RSsub("pDemo")
  321.     RSsub.MoveNext
  322. Next
  323. Set RSsub = Nothing
  324. End With
  325. GD1_RowColChange
  326. End Function
  327. Private Sub SetStatus()
  328.   Dim ctl As Control
  329.   Dim intBorderStyle As Integer
  330.   Dim lngbkColor As Long
  331.   Dim boolLocked As Boolean
  332.   
  333.     intBorderStyle = 0  '3D
  334.     lngbkColor = &H8000000F
  335.     boolLocked = True
  336.   
  337.   For Each ctl In Controls
  338.     If (TypeOf ctl Is TextBox) Then
  339.       ctl.BorderStyle = intBorderStyle
  340.       ctl.BackColor = lngbkColor
  341.       ctl.Locked = boolLocked
  342.     ElseIf (TypeOf ctl Is ComboBox) Or _
  343.             (TypeOf ctl Is DTPicker) Or _
  344.             (TypeOf ctl Is CheckBox) Or _
  345.             (TypeOf ctl Is MSFlexGrid) Then
  346.       ctl.Enabled = Not boolLocked
  347.     End If
  348.   Next
  349. End Sub
  350. Private Sub GD1_Click()
  351. Select Case GD1.Col
  352. Case Bje, Bguige, Bppcd, Bdw
  353. Case Else
  354.     txtDATA = GD1
  355.     Modi
  356. End Select
  357. End Sub
  358. Private Sub GD1_KeyPress(KeyAscii As Integer)
  359. Select Case GD1.Col
  360. Case Bje, Bguige, Bppcd, Bdw
  361. Case Else
  362.     Select Case KeyAscii
  363.         Case 0 To 32
  364.             KeyAscii = 0
  365.             txtDATA = GD1
  366.             txtDATA.Move GD1.CellLeft + GD1.Left + 20, GD1.CellTop + GD1.Top + 20, GD1.CellWidth - 8, GD1.CellHeight - 8
  367.             txtDATA.Visible = True
  368.             txtDATA.SetFocus
  369.             txtDATA.SelStart = Len(txtDATA.Text)
  370.         Case Else
  371.             txtDATA = Chr(KeyAscii)
  372.             txtDATA.Move GD1.CellLeft + GD1.Left + 20, GD1.CellTop + GD1.Top + 20, GD1.CellWidth - 8, GD1.CellHeight - 8
  373.             txtDATA.Visible = True
  374.             txtDATA.SetFocus
  375.             txtDATA.SelStart = Len(txtDATA.Text)
  376.     End Select
  377. End Select
  378. End Sub
  379. Private Sub GD1_LeaveCell()
  380. If txtDATA.Visible Then
  381. Select Case GD1.Col
  382.     Case Bnum, Bprice
  383.         If Val(txtDATA) <> 0 Then GD1 = Val(txtDATA) Else GD1 = ""
  384.         txtDATA = ""
  385.     Case Bbak
  386.         GD1 = txtDATA
  387.         txtDATA.Text = ""
  388.     Case Bpname
  389.         If txtDATA = "" Then
  390.             Dim i As Integer
  391.             For i = 1 To 100
  392.                 GD1.TextMatrix(GD1.Row, 1) = ""
  393.             Next
  394.         End If
  395.     Case Else
  396.     End Select
  397.     txtDATA.Visible = False
  398. End If
  399. End Sub
  400. Private Sub GD1_RowColChange()
  401.     Dim cs, cc As Double
  402.     Dim i As Integer
  403.     cs = 0
  404.     cc = 0
  405.     For i = 1 To GD1.Rows - 1
  406.         If Val(GD1.TextMatrix(i, Bnum)) <> 0 Or Val(GD1.TextMatrix(i, Bprice)) <> 0 Then
  407.             GD1.TextMatrix(i, Bje) = Val(GD1.TextMatrix(i, Bprice)) * Val(GD1.TextMatrix(i, Bnum))
  408.         End If
  409.         cs = cs + Val(GD1.TextMatrix(i, Bnum))
  410.         cc = cc + Val(GD1.TextMatrix(i, Bje))
  411.     Next i
  412.     txtNum = cs
  413.     txtM = cc
  414. End Sub
  415. Private Sub OKButton_Click()
  416. If GetValueByID("Client", "ID", cboCar.ItemData(cboCar.ListIndex), "isfns") Then MsgBox cboCar.Text & "已完工,不能再做改动!": Exit Sub
  417. Dim ErrMsg As String
  418. Dim i, newID As Integer
  419. On Error Resume Next
  420.   Select Case mvarViewType
  421.   Case vtadd    '添加客户
  422. If Not Chk Then Exit Sub
  423.     g_Conn.BeginTrans
  424.     newID = NextID("Store", "ID")
  425.         g_Conn.Execute ("insert into Store(ID,Type,Fdate,cID,carID) " & _
  426.                 "Values('" & newID & "','-1','" & DTP(1).Value & _
  427.                 "','" & cboClerk.ItemData(cboClerk.ListIndex) & "','" & cboCar.ItemData(cboCar.ListIndex) & "')")
  428.         For i = 1 To GD1.Rows - 1
  429.         If GD1.TextMatrix(i, 1) <> "" Then g_Conn.Execute ("insert into SubStore(sID,Line,pID,pNum,pPrice,pDemo) " & _
  430.                 "Values('" & newID & "','" & i & "','" & GD1.TextMatrix(i, Bppcd) & _
  431.                 "'," & Val(GD1.TextMatrix(i, Bnum)) & "," & Val(GD1.TextMatrix(i, Bprice)) & ",'" & GD1.TextMatrix(i, Bbak) & "')")
  432.         Next
  433.         If Err.Number = 0 Then g_Conn.CommitTrans Else g_Conn.RollbackTrans: MsgBox Err.Description
  434.   Case vtModify '修改客户信息
  435. If Not Chk Then Exit Sub
  436.     g_Conn.BeginTrans
  437.     newID = NextID("Store", "ID")
  438.         g_Conn.Execute ("Update Store set Fdate='" & DTP(1).Value & _
  439.                 "',cID='" & cboClerk.ItemData(cboClerk.ListIndex) & "',carID='" & cboCar.ItemData(cboCar.ListIndex) & "' Where ID='" & GetID(mvarID) & "'")
  440.         For i = 1 To GD1.Rows - 1
  441.         If GD1.TextMatrix(i, 1) <> "" Then g_Conn.Execute ("Update SubStore Set pID='" & GD1.TextMatrix(i, Bppcd) & _
  442.                 "',pNum=" & Val(GD1.TextMatrix(i, Bnum)) & ",pPrice=" & Val(GD1.TextMatrix(i, Bprice)) & ",pDemo='" & GD1.TextMatrix(i, Bbak) & _
  443.                 "' Where sID='" & GetID(mvarID) & "' and Line='" & i & "'")
  444.         Next
  445.         If Err.Number = 0 Then g_Conn.CommitTrans Else g_Conn.RollbackTrans: MsgBox Err.Description
  446.   Case Else
  447.   End Select
  448.   OK = True
  449.   Unload Me
  450. End Sub
  451. Private Sub txtDATA_DblClick()
  452. Dim obj As New CpName
  453. If frmFindUse.Rel("select pName,pType,ID,pUnit,pNum from PeiJian where pName like '%" & txtDATA.Text & "%'", obj) = True Then
  454. txtDATA.Text = obj.pName
  455. GD1.TextMatrix(GD1.Row, 1) = txtDATA.Text
  456. GD1.TextMatrix(GD1.Row, 2) = obj.pType
  457. GD1.TextMatrix(GD1.Row, 3) = obj.pid
  458. GD1.TextMatrix(GD1.Row, 4) = obj.pUnit
  459. GD1.TextMatrix(GD1.Row, 5) = obj.pNum
  460. txtDATA.Visible = False
  461. GD1.SetFocus
  462. GD1.Col = 5
  463. End If
  464. End Sub
  465. Private Sub txtdata_GotFocus()
  466. txtDATA.Visible = True
  467. End Sub
  468. Private Sub txtDATA_KeyDown(KeyCode As Integer, Shift As Integer)
  469. Select Case KeyCode
  470.     Case 38 'UP
  471.         If GD1.Row > 1 Then
  472.             GD1.Row = GD1.Row - 1
  473.             MovIn
  474.         End If
  475.     Case 40 'DOWN
  476.         If GD1.Row < GD1.Rows - 1 Then
  477.             GD1.Row = GD1.Row + 1
  478.             MovIn
  479.         End If
  480.     Case 37 'LEFT
  481.         If GD1.Col > 1 Then
  482.             If txtDATA.SelStart = 0 Then
  483.                 GD1.Col = GD1.Col - 1
  484.                 MovIn
  485.             End If
  486.         End If
  487.     Case 39 'RIGHT
  488.         If txtDATA.SelStart = Len(txtDATA.Text) Then
  489.             If GD1.Col < GD1.Cols - 1 Then
  490.                 GD1.Col = GD1.Col + 1
  491.                 MovIn
  492.             Else
  493.                 If GD1.Col = GD1.Cols - 1 And GD1.Row < GD1.Rows - 1 Then
  494.                     GD1.Row = GD1.Row + 1
  495.                     GD1.Col = 1
  496.                     MovIn
  497.                 End If
  498.             End If
  499.         End If
  500.     Case 13 'ENTER
  501.         txtDATA_DblClick
  502. End Select
  503. End Sub
  504. Private Sub MovIn()
  505. txtDATA.Visible = False
  506. GD1.SetFocus
  507. End Sub
  508. Private Sub Modi()
  509. txtDATA = GD1
  510. txtDATA.Move GD1.CellLeft + GD1.Left + 20, GD1.CellTop + GD1.Top + 20, GD1.CellWidth - 8, GD1.CellHeight - 8
  511. txtDATA.Visible = True
  512. txtDATA.SetFocus
  513. txtDATA.SelStart = Len(txtDATA.Text)
  514. End Sub
  515. Function Chk() As Boolean
  516. Dim i As Integer
  517. Dim ii As Integer
  518. ii = 0
  519. If cboClerk.Text = "" Then
  520.     MsgBox "错误,经手人不能为空!"
  521.     Chk = False
  522.     Exit Function
  523. End If
  524. With GD1
  525. For i = 1 To 15
  526.     If .TextMatrix(i, Bpname) <> "" Then
  527.     ii = ii + 1
  528.         If Val(.TextMatrix(i, Bnum)) = 0 Then
  529.             MsgBox "第" & i & "行错误,数量不能为零!"
  530.             .Row = i
  531.             Chk = False
  532.             Exit Function
  533.         ElseIf Val(.TextMatrix(i, Bprice)) = 0 Then
  534.             MsgBox "第" & i & "行错误,单价不能为零!"
  535.             .Row = i
  536.             Chk = False
  537.             Exit Function
  538.         ElseIf Len(.TextMatrix(i, Bbak)) > 25 Then
  539.             MsgBox "第" & i & "行错误,备注应小于25个字符!"
  540.             .Row = i
  541.             Chk = False
  542.             Exit Function
  543.         End If
  544.     End If
  545. Next i
  546. End With
  547. If ii > 0 Then
  548.     Chk = True
  549. Else
  550.     MsgBox "没有要保存的数据!"
  551.     Chk = False
  552. End If
  553. End Function