⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmedit.frm

📁 利用Visual Basic编写的小程序
💻 FRM
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmEdit 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "添加"
   ClientHeight    =   4950
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5400
   Icon            =   "frmEdit.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4950
   ScaleWidth      =   5400
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin MSComDlg.CommonDialog CD 
      Left            =   240
      Top             =   4320
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MSComCtl2.DTPicker DTPicker1 
      Height          =   255
      Left            =   1200
      TabIndex        =   30
      Top             =   840
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   450
      _Version        =   393216
      Format          =   20709377
      CurrentDate     =   38713
   End
   Begin VB.ComboBox comTitle 
      Height          =   300
      ItemData        =   "frmEdit.frx":0442
      Left            =   1185
      List            =   "frmEdit.frx":0444
      TabIndex        =   4
      Top             =   1560
      Width           =   1320
   End
   Begin VB.Frame Frame1 
      Caption         =   "照片"
      Height          =   2895
      Left            =   3000
      TabIndex        =   26
      Top             =   120
      Width           =   2055
      Begin VB.CommandButton cmdPhotoDel 
         Caption         =   "删除"
         Height          =   375
         Left            =   1200
         TabIndex        =   28
         Top             =   2400
         Width           =   735
      End
      Begin VB.CommandButton cmdPhoto 
         Caption         =   "指定..."
         Height          =   375
         Left            =   120
         TabIndex        =   27
         Top             =   2400
         Width           =   975
      End
      Begin VB.Image imgPhoto 
         Height          =   2055
         Left            =   120
         Stretch         =   -1  'True
         Top             =   240
         Width           =   1815
      End
      Begin VB.Label Label13 
         Caption         =   "无照片"
         Height          =   255
         Left            =   720
         TabIndex        =   29
         Top             =   1080
         Width           =   615
      End
   End
   Begin VB.TextBox txtMobile 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   1185
      MaxLength       =   12
      TabIndex        =   7
      Top             =   2529
      Width           =   1095
   End
   Begin VB.TextBox txtAddress 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   1185
      TabIndex        =   9
      Top             =   3183
      Width           =   4110
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "返回"
      Height          =   390
      Left            =   2760
      TabIndex        =   13
      Top             =   4440
      Width           =   960
   End
   Begin VB.CommandButton cmdEdit 
      Caption         =   "添加"
      Height          =   390
      Left            =   1560
      TabIndex        =   12
      Top             =   4440
      Width           =   960
   End
   Begin VB.OptionButton optFemale 
      Caption         =   "女"
      Height          =   300
      Left            =   1800
      TabIndex        =   2
      Top             =   507
      Width           =   540
   End
   Begin VB.OptionButton optMale 
      Caption         =   "男"
      Height          =   300
      Left            =   1185
      TabIndex        =   1
      Top             =   507
      Value           =   -1  'True
      Width           =   540
   End
   Begin VB.ComboBox comCity 
      Height          =   300
      Left            =   1185
      TabIndex        =   3
      Top             =   1191
      Width           =   1320
   End
   Begin VB.TextBox txtName 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   1185
      TabIndex        =   0
      Top             =   180
      Width           =   1095
   End
   Begin VB.TextBox txtCompany 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   1185
      TabIndex        =   10
      Top             =   3510
      Width           =   4110
   End
   Begin VB.TextBox txtTelOffice 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   1185
      MaxLength       =   8
      TabIndex        =   5
      Top             =   1875
      Width           =   1095
   End
   Begin VB.TextBox txtTelHome 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   1185
      MaxLength       =   8
      TabIndex        =   6
      Top             =   2202
      Width           =   1095
   End
   Begin VB.TextBox txtPostalCode 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   1185
      MaxLength       =   6
      TabIndex        =   8
      Top             =   2856
      Width           =   1095
   End
   Begin VB.TextBox txtEmail 
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   1185
      TabIndex        =   11
      Top             =   3840
      Width           =   4110
   End
   Begin VB.Label Label12 
      Caption         =   "手机号码"
      Height          =   255
      Left            =   360
      TabIndex        =   25
      Top             =   2549
      Width           =   870
   End
   Begin VB.Label Label2 
      Caption         =   "职务职称"
      Height          =   255
      Left            =   360
      TabIndex        =   24
      Top             =   1553
      Width           =   870
   End
   Begin VB.Label Label1 
      Caption         =   "地    址"
      Height          =   255
      Left            =   360
      TabIndex        =   23
      Top             =   3213
      Width           =   870
   End
   Begin VB.Label Label3 
      Caption         =   "姓    名"
      Height          =   255
      Left            =   360
      TabIndex        =   22
      Top             =   240
      Width           =   960
   End
   Begin VB.Label Label4 
      Caption         =   "性    别"
      Height          =   255
      Left            =   360
      TabIndex        =   21
      Top             =   557
      Width           =   855
   End
   Begin VB.Label Label5 
      Caption         =   "生    日"
      Height          =   255
      Left            =   360
      TabIndex        =   20
      Top             =   889
      Width           =   825
   End
   Begin VB.Label Label6 
      Caption         =   "所在城市"
      Height          =   255
      Left            =   360
      TabIndex        =   19
      Top             =   1221
      Width           =   870
   End
   Begin VB.Label Label7 
      Caption         =   "工作单位"
      Height          =   255
      Left            =   360
      TabIndex        =   18
      Top             =   3545
      Width           =   870
   End
   Begin VB.Label Label8 
      Caption         =   "办公电话"
      Height          =   255
      Left            =   360
      TabIndex        =   17
      Top             =   1885
      Width           =   870
   End
   Begin VB.Label Label9 
      Caption         =   "住宅电话"
      Height          =   255
      Left            =   360
      TabIndex        =   16
      Top             =   2217
      Width           =   870
   End
   Begin VB.Label Label10 
      Caption         =   "邮政编码"
      Height          =   255
      Left            =   360
      TabIndex        =   15
      Top             =   2881
      Width           =   870
   End
   Begin VB.Label Label11 
      Caption         =   "E-Mail"
      Height          =   255
      Left            =   360
      TabIndex        =   14
      Top             =   3885
      Width           =   735
   End
End
Attribute VB_Name = "frmEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public mode As Integer
Dim photo As Boolean

Private Sub cmdEdit_Click()
     Dim i As Integer
     '如果是新城市,则添加到列表中
     For i = 0 To comCity.ListCount - 1
        If Trim(comCity.List(i)) = Trim(comCity.Text) Then Exit For
     Next
     If i > comCity.ListCount - 1 Then
        comCity.AddItem comCity.Text
        frmMain.comCity.AddItem comCity.Text
        ReDim Preserve Cities(UBound(Cities) + 1)
        Cities(UBound(Cities)) = comCity.Text
     End If
     
     '如果是新职称,则添加到列表中
     For i = 0 To comTitle.ListCount - 1
        If Trim(comTitle.List(i)) = Trim(comTitle.Text) Then Exit For
     Next
     If i > comTitle.ListCount - 1 Then
        comTitle.AddItem comTitle.Text
        frmMain.comTitle.AddItem comTitle.Text
        ReDim Preserve Titles(UBound(Titles) + 1)
        Titles(UBound(Titles)) = comTitle.Text
     End If
     
     Select Case mode
         Case 1                     '添加
            RecNum = RecNum + 1
            ReDim Preserve Addrs(RecNum)
            With Addrs(RecNum)
               .Name = txtName
               .Sex = optMale
               .Birthday = DTPicker1.Value
               .City = comCity.Text
               .Company = txtCompany
               .Tel_Home = txtTelHome
               .Tel_Office = txtTelOffice
               .PostalCode = txtPostalCode
               .Email = txtEmail
               .Mobile = txtMobile
               .Address = txtAddress
               .Title = comTitle
               .photo = photo
            End With
            Addrs(i).Modified = True
    
            If Trim(comCity.Text) = Trim(frmMain.comCity) Or Trim(frmMain.comCity) = "全部" Then
               If frmMain.comSex.Text = "全部" Or Addrs(RecNum).Sex And frmMain.comSex.Text = "男" Or Not Addrs(RecNum).Sex And frmMain.comSex.Text = "女" Then
                   frmMain.lstName.AddItem txtName
                   frmMain.lstName.ItemData(frmMain.lstName.NewIndex) = RecNum
               End If
            End If
         Case 2
            i = frmMain.lstName.ItemData(frmMain.lstName.ListIndex)         '当前记录号
            With Addrs(i)
               .Name = txtName
               .Sex = optMale
               .Birthday = DTPicker1.Value
               .City = comCity.Text
               .Company = txtCompany
               .Tel_Home = txtTelHome
               .Tel_Office = txtTelOffice
               .PostalCode = txtPostalCode
               .Email = txtEmail
               .Mobile = txtMobile
               .Address = txtAddress
               .Title = comTitle
               .photo = photo
            End With
            frmMain.lstName.List(frmMain.lstName.ListIndex) = Addrs(i).Name
            Addrs(i).Modified = True
            Unload Me
     End Select
End Sub


Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdPhoto_Click()
    CD.DialogTitle = "指定照片文件"
    CD.FileName = ""
    CD.ShowOpen
    If CD.FileName = "" Then Exit Sub
    FileCopy CD.FileName, App.Path & "\photos\" & Trim(txtName) & ".jpg"
    imgPhoto.Picture = LoadPicture(App.Path & "\photos\" & Trim(txtName) & ".jpg")
    photo = True
    
End Sub

Private Sub cmdPhotoDel_Click()
    If Not photo Then Exit Sub
    photo = False
    imgPhoto.Picture = LoadPicture()
    Kill App.Path & "\photos\" & Trim(txtName) & ".jpg"
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Select Case mode
    Case 1          '添加
        Caption = "添加新记录"
        photo = False
    Case 2          '修改
        i = frmMain.lstName.ItemData(frmMain.lstName.ListIndex)
        txtName.Enabled = False
        With Addrs(i)
            txtName = .Name
            If .Sex Then optMale = True Else optFemale = True
            DTPicker1.Value = .Birthday
            comCity.Text = .City
            txtCompany = .Company
            txtTelHome = .Tel_Home
            txtTelOffice = .Tel_Office
            txtPostalCode = .PostalCode
            txtEmail = .Email
            txtMobile = .Mobile
            txtAddress = .Address
            comTitle = .Title
            photo = .photo
            If .photo = True Then
                imgPhoto.Picture = LoadPicture(App.Path & "\photos\" & Trim(Addrs(i).Name) & ".jpg")
            End If
        End With
        Caption = "修改当前记录"
        cmdEdit.Caption = "确定"
        cmdClose.Caption = "取消"
    End Select
    
    
    For i = 1 To UBound(Cities)
        comCity.AddItem Cities(i)
    Next
    For i = 1 To UBound(Titles)
        comTitle.AddItem Titles(i)
    Next
    
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -