frm_zlxf_djbh.frm

代码名称：资料管理系统 一个资料管理系统的源程序

         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   240
      Left            =   3840
      TabIndex        =   20
      Top             =   3270
      Width           =   1260
   End
   Begin VB.Image imgTitleMinimize 
      Height          =   210
      Left            =   3270
      Picture         =   "Frm_zlxf_djbh.frx":2FD6
      Stretch         =   -1  'True
      Top             =   3090
      Width           =   210
   End
   Begin VB.Image imgTitleClose 
      Height          =   210
      Left            =   3315
      Picture         =   "Frm_zlxf_djbh.frx":3220
      Stretch         =   -1  'True
      Top             =   3450
      Width           =   210
   End
   Begin VB.Image imgTitleHelp 
      Height          =   210
      Left            =   3270
      Picture         =   "Frm_zlxf_djbh.frx":346A
      Stretch         =   -1  'True
      Top             =   3810
      Width           =   210
   End
   Begin VB.Image imgWindowBottomRight 
      Height          =   450
      Left            =   2910
      Picture         =   "Frm_zlxf_djbh.frx":36B4
      Top             =   3090
      Width           =   285
   End
   Begin VB.Image imgWindowBottomLeft 
      Height          =   450
      Left            =   2550
      Picture         =   "Frm_zlxf_djbh.frx":3DFE
      Top             =   3090
      Width           =   285
   End
   Begin VB.Image Imageicon 
      Height          =   315
      Left            =   3945
      Picture         =   "Frm_zlxf_djbh.frx":4548
      Stretch         =   -1  'True
      Top             =   3630
      Width           =   315
   End
   Begin VB.Image imgTitleMain 
      Height          =   450
      Left            =   1830
      Picture         =   "Frm_zlxf_djbh.frx":7B9A
      Stretch         =   -1  'True
      Top             =   3540
      Width           =   285
   End
   Begin VB.Image imgWindowRight 
      Height          =   450
      Left            =   2910
      Picture         =   "Frm_zlxf_djbh.frx":82E4
      Stretch         =   -1  'True
      Top             =   3570
      Width           =   285
   End
   Begin VB.Image imgWindowLeft 
      Height          =   450
      Left            =   2550
      Picture         =   "Frm_zlxf_djbh.frx":8A2E
      Stretch         =   -1  'True
      Top             =   3570
      Width           =   285
   End
   Begin VB.Image imgWindowBottom 
      Height          =   450
      Left            =   2190
      Picture         =   "Frm_zlxf_djbh.frx":9178
      Stretch         =   -1  'True
      Top             =   3570
      Width           =   285
   End
   Begin VB.Image imgTitleRight 
      Height          =   450
      Left            =   2190
      Picture         =   "Frm_zlxf_djbh.frx":98C2
      Top             =   3090
      Width           =   285
   End
   Begin VB.Image imgTitleLeft 
      Height          =   450
      Left            =   1830
      Picture         =   "Frm_zlxf_djbh.frx":A00C
      Top             =   3090
      Width           =   285
   End
End
Attribute VB_Name = "Frm_zlxf_djbh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim xxxX1 As String
Private Sub Command1_Click()


If Len(Text1(0).Text & "-" & Text1(1).Text) <> 9 Or Text1(1).Text = "0000" Then
   
MsgBox "输入的编号不符合规则,重新确认", vbExclamation, "提示"
Exit Sub
Else
 'If xxxX1 = "" Or xxxX1 < Text1(0).Text & "-" & Text1(1).Text Then
    For i = 2 To 5
    If Text1(i) = "" Or combo1(3).Text = "" Then
    MsgBox "输入信息不完整,重新输入！", vbCritical
    Exit Sub
    End If
    Next i
    Frm_zlxf_ff.pzr = Text1(2).Text
    Frm_zlxf_ff.jbr = Text1(4).Text
    Frm_zlxf_ff.ltr = Text1(3).Text
    Frm_zlxf_ff.ltdw = combo1(3).Text
    Frm_zlxf_ff.ltsj = Text1(5).Text
'End If
 Frm_zlxf_ff.djbh = Text1(0).Text & "-" & Text1(1).Text
Unload Me
Frm_zlxf_ff.Show vbModal
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 xfzl_xf_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 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 单位 from xfzl_lqdw order by  单位", db1, adOpenStatic, adLockOptimistic
 
  With adoPrimaryRS
  For i = 0 To .RecordCount - 1
  combo1(3).AddItem adoPrimaryRS("单位"), i
  .MoveNext
  Next i
 
    End With
   
  adoPrimaryRS.Close
   If combo1(3).ListCount > 0 Then
    combo1(3).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