frm_jy_dj.frm

mnnnml , ,l, ,mk mmkkmlklmkkkkkkkkkkkkkm,mkl

      Left            =   2190
      TabIndex        =   19
      Top             =   4230
      Width           =   840
   End
   Begin VB.Image imgTitleMinimize 
      Height          =   210
      Left            =   1620
      Picture         =   "Frm_jy_dj.frx":2FDA
      Stretch         =   -1  'True
      Top             =   4050
      Width           =   210
   End
   Begin VB.Image imgTitleClose 
      Height          =   210
      Left            =   1665
      Picture         =   "Frm_jy_dj.frx":3224
      Stretch         =   -1  'True
      Top             =   4410
      Width           =   210
   End
   Begin VB.Image imgTitleHelp 
      Height          =   210
      Left            =   1620
      Picture         =   "Frm_jy_dj.frx":346E
      Stretch         =   -1  'True
      Top             =   4770
      Width           =   210
   End
   Begin VB.Image imgWindowBottomRight 
      Height          =   450
      Left            =   1260
      Picture         =   "Frm_jy_dj.frx":36B8
      Top             =   4050
      Width           =   285
   End
   Begin VB.Image imgWindowBottomLeft 
      Height          =   450
      Left            =   900
      Picture         =   "Frm_jy_dj.frx":3E02
      Top             =   4050
      Width           =   285
   End
   Begin VB.Image Imageicon 
      Height          =   315
      Left            =   2295
      Picture         =   "Frm_jy_dj.frx":454C
      Stretch         =   -1  'True
      Top             =   4590
      Width           =   315
   End
   Begin VB.Image imgTitleMain 
      Height          =   450
      Left            =   180
      Picture         =   "Frm_jy_dj.frx":7B9E
      Stretch         =   -1  'True
      Top             =   4500
      Width           =   285
   End
   Begin VB.Image imgWindowRight 
      Height          =   450
      Left            =   1260
      Picture         =   "Frm_jy_dj.frx":82E8
      Stretch         =   -1  'True
      Top             =   4530
      Width           =   285
   End
   Begin VB.Image imgWindowLeft 
      Height          =   450
      Left            =   900
      Picture         =   "Frm_jy_dj.frx":8A32
      Stretch         =   -1  'True
      Top             =   4530
      Width           =   285
   End
   Begin VB.Image imgWindowBottom 
      Height          =   450
      Left            =   540
      Picture         =   "Frm_jy_dj.frx":917C
      Stretch         =   -1  'True
      Top             =   4530
      Width           =   285
   End
   Begin VB.Image imgTitleRight 
      Height          =   450
      Left            =   540
      Picture         =   "Frm_jy_dj.frx":98C6
      Top             =   4050
      Width           =   285
   End
   Begin VB.Image imgTitleLeft 
      Height          =   450
      Left            =   180
      Picture         =   "Frm_jy_dj.frx":A010
      Top             =   4050
      Width           =   285
   End
End
Attribute VB_Name = "Frm_jy_dj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public shuliang As Integer
Dim xxxX1 As String

Private Sub combo1_Click(Index As Integer)
If Index = 1 Then
  combo1(0).Clear
  Dim db1 As Connection
  Dim adoPrimaryRS As Recordset
  Set db1 = New Connection
  db1.CursorLocation = adUseClient
  db1.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fullpath("mdb\ziliao.lbl")
  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "select  姓名 from jygr_v where 单位='" & combo1(1).Text & "'", db1, adOpenStatic, adLockOptimistic
 
  With adoPrimaryRS
  For i = 0 To .RecordCount - 1
  combo1(0).AddItem adoPrimaryRS("姓名"), i
  .MoveNext
  Next i
 
    End With
adoPrimaryRS.Close
   If combo1(0).ListCount > 0 Then
    combo1(0).ListIndex = 0
  End If
 Exit Sub
   
End If
End Sub

Private Sub Command1_Click()


If Len(Text1(0).Text & "-" & Text1(1).Text) <> 9 Or Text1(1).Text = "0000" Then
   
MsgBox "输入的编号不符合规则,重新确认", vbExclamation, "提示"
Exit Sub
Else
 
    For i = 2 To 5
    If Text1(i) = "" Or combo1(1).Text = "" Then
    MsgBox "输入信息不完整,重新输入！", vbCritical
    Exit Sub
    End If
    Next i
If Val(Text1(3).Text) > shuliang Then
    MsgBox "借阅数大于库存！重新输入", vbCritical
    Text1(3).SetFocus
    Exit Sub
End If

If Val(Text1(3).Text) = 0 Then
    MsgBox "借阅数不能为零！重新输入", vbCritical
    Text1(3).SetFocus
    Exit Sub
End If


yy = MsgBox("确认借阅数为:" & Text1(3).Text, vbYesNo + vbQuestion)
If yy = vbYes Then
  With Frm_jy_gl.RS
  .AddNew
  
  .Fields("借阅编号").Value = Text1(0).Text & "-" & Text1(1).Text
  .Fields("资料编号").Value = Text1(6).Text
  .Fields("名称").Value = Text1(2).Text
 .Fields("分类").Value = Text1(7).Text
 .Fields("数量").Value = Val(Text1(3).Text)
 .Fields("单位").Value = combo1(1).Text
 .Fields("借阅人").Value = combo1(0).Text
  .Fields("经办人").Value = Text1(4).Text
  .Fields("借阅时间").Value = Text1(5).Text
 .Fields("备注").Value = "借阅"
  .Update
  End With
  aa = Frm_jy_gl.rs1("已借")
  Frm_jy_gl.rs1.Fields("已借").Value = aa + Val(Text1(3).Text)
  Frm_jy_gl.rs1.Update
  Unload Me
  Else
  Exit Sub
End If
End If
End Sub

Private Sub Command2_Click()
Unload Me
End Sub



Private Sub DTPicker1_Change()
aaa = DTPicker1.Value
Text1(5).Text = Year(aaa) & "年" & Month(aaa) & "月" & Day(aaa) & "日"
End Sub


Private Sub Form_Load()
MakeWindow Me

Dim db As ADODB.Connection
Dim adoPrimaryRS As Recordset
Dim xx As String
xxxX1 = ""

  Set db = New ADODB.Connection
  db.CursorLocation = adUseClient
  db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fullpath("mdb\ziliao.lbl")

  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "select top 1 借阅编号 from jy_jl order by 借阅编号 desc", db, adOpenStatic, adLockOptimistic
  If adoPrimaryRS.RecordCount = 0 Then
  X1 = "当前下发记录为空！"
  Text1(0).Text = Year(Date)
  Text1(1).Text = "0001"
 
  Else
   xxxX1 = adoPrimaryRS("借阅编号")
  X1 = "上一次编号为:" & adoPrimaryRS("借阅编号")
  Text1(0).Text = Left(adoPrimaryRS("借阅编号"), 4)
  xx = Format$("0000", Val(Right(X1, 4)) + 1)
  x11 = Len(xx)
  temp = ""
  For i = 1 To 4 - x11
  temp = temp & "0"
  Next i
  temp = temp & xx
  Text1(1).Text = temp
  End If
  Label4.Caption = X1
  format_txt1
  Text1(4).Text = gz_user
  Text1(2).Text = "肖卫东"
  'Text1(3).Text = "领取人"
  DTPicker1.Value = Date
  aaa = Date
  Text1(5).Text = Year(aaa) & "年" & Month(aaa) & "月" & Day(aaa) & "日"
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 0 Or Index = 1 Or Index = 3 Then
strValid = "0123456789"
If KeyAscii > 26 Then
            If InStr(strValid, Chr(KeyAscii)) = 0 Then
                KeyAscii = 0
            End If
End If
End If
End Sub
Private Sub format_txt1()
On Error GoTo err_67:
  Dim db1 As Connection
  Dim adoPrimaryRS As Recordset
  Set db1 = New Connection
  db1.CursorLocation = adUseClient
  db1.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fullpath("mdb\ziliao.lbl")
  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "select distinct 单位 from jygr_v order by 单位", db1, adOpenStatic, adLockOptimistic
 
  With adoPrimaryRS
  For i = 0 To .RecordCount - 1
  combo1(1).AddItem adoPrimaryRS("单位"), i
  .MoveNext
  Next i
 
    End With
adoPrimaryRS.Close
   If combo1(1).ListCount > 0 Then
    combo1(1).ListIndex = 0
  End If
 Exit Sub

err_67:
MsgBox Err.Description, vbExclamation
End Sub

Private Sub imgTitleClose_Click()
Unload Me
End Sub

Private Sub imgTitleLeft_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub imgTitleMain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub imgTitleMinimize_Click()
    Me.WindowState = 1
End Sub

Private Sub imgTitleRight_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub

Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    DoDrag Me
End Sub