frmnewform.frm

档案管理系统源码VB档案管理系统源码VB

      Y1              =   3840
      Y2              =   3840
   End
   Begin VB.Line Line3 
      BorderColor     =   &H00E0E0E0&
      Index           =   0
      X1              =   45
      X2              =   45
      Y1              =   15
      Y2              =   3840
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00808080&
      Index           =   1
      X1              =   7605
      X2              =   7605
      Y1              =   0
      Y2              =   3870
   End
   Begin VB.Line Line3 
      BorderColor     =   &H00E0E0E0&
      Index           =   1
      X1              =   7620
      X2              =   7620
      Y1              =   0
      Y2              =   3885
   End
End
Attribute VB_Name = "frmNewForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ChangeTrue As Boolean
Dim NoChange As Boolean, lShow As Boolean, lShowS As Boolean

Private Sub ExitB_Click()
 
Unload Me

End Sub

Private Sub Form_Load()

On Error Resume Next
Me.Left = Val(GetSetting(App.EXEName, "AddNew", "Left"))
Me.Top = Val(GetSetting(App.EXEName, "AddNew", "Top"))

txtFields(4).Text = strFileType
ChangeTrue = False
Me.Caption = "正在 [ " & strFileType & " ] 区，添加新文件"
NoChange = False: lShow = False: lShowS = False

End Sub

Private Sub Form_Unload(Cancel As Integer)

 SaveSetting App.EXEName, "AddNew", "Left", Me.Left
 SaveSetting App.EXEName, "AddNew", "Top", Me.Top
  
If ChangeTrue = True Then
   Dim OK As Integer
   OK = MsgBox("有添加记录，需要保存码？(Y/N)", vbYesNo + 32, "未保存")
   If OK = 7 Then
    If IT = True And NoChange = True Then
     Call frmManager.cmdLoad_Click
    End If
      Unload Me
      Exit Sub
   Else
   '保存记录代码
      Call SaveAdd_Click
       If IT = True And NoChange = True Then
          Call frmManager.cmdLoad_Click
       End If
      Exit Sub
   End If
Else
  If IT = True And NoChange = True Then
   Call frmManager.cmdLoad_Click
  End If
   Unload Me
End If

End Sub

Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 If lShow = True Then  '已经隐藏时退出
   lLeft.Visible = False
   lRight.Visible = False
   lTop.Visible = False
   lBottom.Visible = False
   lShow = False
 End If
 If lShowS = True Then  '已经隐藏时退出
   lLeft_1.Visible = False
   lRight_1.Visible = False
   lTop_1.Visible = False
   lBottom_1.Visible = False
   lShowS = False
 End If
 
End Sub

Private Sub Label1_Click()
  MsgBox "此项不能修改，请注意！", vbOKOnly + 64, "提示:"
End Sub

Private Sub picEditFile_Click()

 On Error Resume Next
 OpenDialog.CancelError = True
 OpenDialog.Flags = cdlOFNFileMustExist + cdlOFNHideReadOnly
 OpenDialog.Filter = "所有文件(*.*)|*.*|"
 OpenDialog.DialogTitle = "请选择文件"
 OpenDialog.FileName = GetSetting(App.EXEName, "Config", "Add")
 OpenDialog.ShowOpen
 
 If Err.Number = 32755 Then
    If Trim(txtFields(1).Text) <> "" Then
       txtFields(2).SetFocus
     Else
       txtFields(1).SetFocus
    End If
    Exit Sub
 End If
 
 txtFields(1).Text = OpenDialog.FileName
 '保存最后一次打开的文件
 SaveSetting App.EXEName, "Config", "Add", OpenDialog.FileName
 txtFields(2).SetFocus
 
End Sub

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

 lTop.BorderColor = &H808080
 lBottom.BorderColor = &HFFFFFF

End Sub

Private Sub picEditFile_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  
 If lShow = True Then Exit Sub  '已经显示时退出
 
 lLeft.Visible = True
 lRight.Visible = True
 lTop.Visible = True
 lBottom.Visible = True
 lShow = True
 
End Sub

Private Sub picEditFile_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 lTop.BorderColor = &HFFFFFF
 lBottom.BorderColor = &H808080
 
End Sub

Private Sub picScan_Click()

 ScanFileName = ""
 Me.MousePointer = 11
    frmScan.Show 1
 Me.MousePointer = 0
  
 If ScanFileName = "" Then
    If Trim(txtFields(1).Text) = "" Then
       txtFields(1).SetFocus
     Else
       txtFields(2).SetFocus
    End If
    Exit Sub
 Else
    txtFields(1).Text = ScanFileName
    txtFields(2).SetFocus
 End If
 
End Sub

Private Sub picScan_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 lTop_1.BorderColor = &H808080
 lBottom_1.BorderColor = &HFFFFFF

End Sub

Private Sub picScan_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  
 If lShowS = True Then Exit Sub  '已经显示时退出
 
 lLeft_1.Visible = True
 lRight_1.Visible = True
 lTop_1.Visible = True
 lBottom_1.Visible = True
 lShowS = True
 
End Sub

Private Sub picScan_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 lTop_1.BorderColor = &HFFFFFF
 lBottom_1.BorderColor = &H808080
 
End Sub

Private Sub SaveAdd_Click()

If Trim(txtFields(0).Text) = "" Then
   MsgBox "档案名不能空，且不能重复,不能保存!", vbOKOnly + 64, "档案名有错误"
   txtFields(0).SetFocus
   Exit Sub
End If
'Save Data
  '**************** 开始 *****************
   DBEngine.BeginTrans
   Dim DB As Database, EF As Recordset, X As Integer, tempStr As String
       X = 0
   For X = 0 To 4
       If X < 4 Then
          tempStr = tempStr + "'" + txtFields(X).Text + "',"
         Else
          tempStr = tempStr + "'" + txtFields(X).Text + "'"
      End If
   Next
    tempStr = " Values (" + tempStr + ")"
    tempStr = "Insert into Detail (档案号,文件名,文件说明,参考说明,Name)" + tempStr
  Set DB = OpenDatabase(ConData, False, False, ConStr)
      DB.Execute tempStr
      DB.Close
   DBEngine.CommitTrans
  'Recommand set null value
    For X = 0 To 4
      txtFields(X).Text = ""
    Next
  '指针调回编号
    txtFields(0).SetFocus
  '**************** 结束 *****************
txtFields(4).Text = strFileType
ChangeTrue = False
NoChange = True

End Sub

Private Sub txtFields_Change(Index As Integer)
ChangeTrue = True
End Sub

Private Sub txtFields_DblClick(Index As Integer)

 If Index = 1 Then
    Call picEditFile_Click
 End If
 
End Sub

Private Sub txtFields_GotFocus(Index As Integer)

txtFields(Index).BackColor = &HFF0000
txtFields(Index).ForeColor = &HFFFFFF
txtFields(Index).SelStart = 0
txtFields(Index).SelLength = Len(Trim(txtFields(Index).Text))

End Sub

Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)

If Index < 2 Then
If KeyCode = 38 Then
   If Index > 0 Then
      txtFields(Index - 1).SetFocus
   End If
End If
If KeyCode = 40 Then
   If Index < 4 Then
      txtFields(Index + 1).SetFocus
   End If
End If
End If

End Sub

Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)

If KeyAscii = 13 And Index = 0 Then
   SendKeys "{tab}"
   Exit Sub
End If
If KeyAscii = 13 And Index = 1 Then
   Call picEditFile_Click
End If

End Sub

Private Sub txtFields_LostFocus(Index As Integer)

txtFields(Index).BackColor = &HFFFFFF
txtFields(Index).ForeColor = &H0
If InStr(1, txtFields(Index).Text, "'", vbTextCompare) Then
   MsgBox "该项目之中有特殊字符" + "<'>,请删除。", vbOKOnly + 48, "提示："
   txtFields(Index).SetFocus
   Exit Sub
End If
'较对有无重复的编号
If Index = 0 Then
   Dim DB As Database, EF As Recordset, tempStr As String
   Set DB = OpenDatabase(ConData, False, False, ConStr)
   Set EF = DB.OpenRecordset("Detail", dbOpenDynaset)
       tempStr = "档案号='" & txtFields(0).Text & "'"
       EF.FindFirst tempStr
   If Not EF.NoMatch Then
        MsgBox "重复的档案号,请修改!", vbOKOnly + 48, "警告!"
        DB.Close
        txtFields(0).Text = ""
        txtFields(0).SetFocus
        Exit Sub
       Else
        DB.Close
   End If
End If
End Sub

Private Sub txtFields_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 If lShow = False Then Exit Sub '已经隐藏时退出
 lLeft.Visible = False
 lRight.Visible = False
 lTop.Visible = False
 lBottom.Visible = False
 lShow = False
 
End Sub