frmdefine.frm

通用样品管理系统是一个商业程序,功能界面都还不错!

VERSION 5.00
Begin VB.Form frmDefine 
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "产品属性定义"
   ClientHeight    =   4125
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6480
   Icon            =   "frmDefine.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4125
   ScaleWidth      =   6480
   ShowInTaskbar   =   0   'False
   Visible         =   0   'False
   Begin VB.CommandButton S_Button 
      Caption         =   "保存(&S)"
      Enabled         =   0   'False
      Height          =   375
      Left            =   4380
      TabIndex        =   3
      Top             =   1455
      Width           =   975
   End
   Begin VB.TextBox ModiTxt 
      Height          =   285
      Left            =   2280
      TabIndex        =   0
      Top             =   1875
      Width           =   1635
   End
   Begin VB.CommandButton E_Button 
      Cancel          =   -1  'True
      Caption         =   "退出(&X)"
      Height          =   375
      Left            =   5370
      TabIndex        =   4
      Top             =   1455
      Width           =   975
   End
   Begin VB.ListBox ItemList 
      Height          =   2400
      Left            =   270
      TabIndex        =   1
      Top             =   1515
      Width           =   1680
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00808000&
      Height          =   990
      Left            =   90
      ScaleHeight     =   930
      ScaleWidth      =   6210
      TabIndex        =   5
      Top             =   60
      Width           =   6270
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "操作说明"
         ForeColor       =   &H0000FFFF&
         Height          =   765
         Left            =   135
         TabIndex        =   6
         Top             =   105
         Width           =   255
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   $"frmDefine.frx":000C
         ForeColor       =   &H00FFFFFF&
         Height          =   825
         Left            =   120
         TabIndex        =   2
         Top             =   210
         Width           =   5940
      End
      Begin VB.Label Label3 
         BackColor       =   &H00000000&
         Height          =   960
         Left            =   -30
         TabIndex        =   7
         Top             =   -15
         Width           =   525
      End
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00FFFFFF&
      X1              =   2250
      X2              =   6405
      Y1              =   2415
      Y2              =   2415
   End
   Begin VB.Line Line1 
      X1              =   2265
      X2              =   6390
      Y1              =   2400
      Y2              =   2400
   End
   Begin VB.Label Label4 
      Caption         =   "2.修改完毕，按回车   键结束此项修改。"
      ForeColor       =   &H00004080&
      Height          =   360
      Index           =   1
      Left            =   2265
      TabIndex        =   11
      Top             =   3330
      Width           =   1620
   End
   Begin VB.Label Label4 
      Caption         =   "1.双击选定项目，即   可进行修改。"
      ForeColor       =   &H00004080&
      Height          =   360
      Index           =   2
      Left            =   2280
      TabIndex        =   10
      Top             =   2745
      Width           =   1620
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "输入新的名称在下面"
      Height          =   180
      Left            =   2295
      TabIndex        =   9
      Top             =   1560
      Width           =   1620
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "原始项目名称"
      Height          =   180
      Index           =   0
      Left            =   285
      TabIndex        =   8
      Top             =   1245
      Width           =   1080
   End
End
Attribute VB_Name = "frmDefine"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim TempX As Integer, ChangeT As Boolean

Private Sub E_Button_Click()
 Unload Me
End Sub

Private Sub Form_Load()
frmDefine.Left = (MDIForm1.Width - frmDefine.Width) / 2
frmDefine.Top = (MDIForm1.Height - frmDefine.Height) / 2 - 1500
frmDefine.HelpContextID = 1005
'读出字段名
On Error GoTo FileErr
  Dim LongX As Integer
  Dim TempS As String, TempC As String
      LongX = FreeFile
  TempS = Browser + "SAMPLE.DAT"
  Open TempS For Input As #LongX
    Do While Not EOF(LongX)
       Line Input #LongX, TempC
       ItemList.AddItem TempC
    Loop
  Close #LongX
  ChangeT = False
  
  Exit Sub
FileErr:
  If Err.Number = 53 Then
       MsgBox "文件没有找到，不能正常装载项目。", vbOKOnly + vbExclamation, "数据文件破坏"
     Else
       MsgBox "文件遭破坏，不能正常装载项目。", vbOKOnly + vbExclamation, "数据文件错误"
  End If
       E_Button.TabIndex = 0
       S_Button.Enabled = False
       M_Button.Enabled = False
  Exit Sub
  
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   If ChangeT = True Then
      Dim X As Integer
      X = MsgBox("数据库的属性已经改动，保存按(Y)或按(N)放弃！", vbYesNo + vbQuestion, "不能白辛苦了！")
      If X = 7 Then
         Exit Sub
      Else
         Call S_Button_Click
      End If
   End If
End Sub

Private Sub ItemList_Click()
 If ModiTxt.Text <> "" Then
    ModiTxt.Text = ""
 End If
End Sub

Private Sub ItemList_DblClick()
 If ItemList.ListIndex = -1 Then Exit Sub
    TempX = ItemList.ListIndex
    ModiTxt.Text = ItemList.Text
    ModiTxt.SetFocus
End Sub

Private Sub ItemList_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
       Call ItemList_DblClick
    End If
End Sub

Private Sub ModiTxt_GotFocus()
  ModiTxt.SelStart = 0
  ModiTxt.SelLength = Len(ModiTxt.Text)
End Sub

Private Sub ModiTxt_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 And Trim(ModiTxt.Text) <> "" And ItemList.ListIndex <> -1 Then
     ChangeT = True
     If S_Button.Enabled = False Then
        S_Button.Enabled = True
     End If
     ItemList.List(TempX) = Trim(ModiTxt.Text)
     ItemList.SetFocus
    ElseIf ItemList.ListIndex = -1 And KeyAscii = 13 Then
     MsgBox "您必须在左边的框中双击要修改的项目!", vbOKOnly + vbExclamation, "没有选项"
     ModiTxt.Text = ""
  End If
End Sub

Private Sub S_Button_Click()
  ChangeT = False
  S_Button.Enabled = False
  Dim LongX As Integer
  Dim TempS As String, TempC As String
      LongX = FreeFile
'On Error GoTo NOV
  TempS = Browser + "SAMPLE.DAT"
  Dim X As Integer
      X = 0
  Open TempS For Output As #LongX
    For X = 0 To ItemList.ListCount
        TempC = ItemList.List(X)
        Print #LongX, TempC
    Next
  Close #LongX
  
  Exit Sub
NOV:
   MsgBox "数据文件丢失，请与供应商联系！", vbOKOnly + vbCritical, "无能为力"
   S_Button = False
   Exit Sub
End Sub