frminfo.frm

家谱管理软件,树形控件操作,可保存文本和图片,查找快捷

      Caption         =   "职业"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   120
      TabIndex        =   13
      Top             =   3090
      Width           =   420
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      Caption         =   "学历"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   120
      TabIndex        =   11
      Top             =   2610
      Width           =   420
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "籍贯"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   120
      TabIndex        =   9
      Top             =   2130
      Width           =   420
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "生日"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   120
      TabIndex        =   7
      Top             =   1650
      Width           =   420
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "民族"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   120
      TabIndex        =   5
      Top             =   1170
      Width           =   420
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "性别"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   120
      TabIndex        =   3
      Top             =   690
      Width           =   420
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "姓名"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   120
      TabIndex        =   1
      Top             =   210
      Width           =   420
   End
End
Attribute VB_Name = "FrmInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Dim sINIFile As String
Dim sJLFile As String
Dim sJPGFile As String


'首先定义一个用于输入的函数WriteOneString：
Private Function WriteOneString(ByVal Section As String, ByVal Key As String, ByVal value As String) As Boolean
    Dim X As Long, buff As String * 128, I As Integer
    buff = value + Chr(0)
    X = WritePrivateProfileString(Section, Key, buff, sINIFile)
    WriteOneString = X
End Function



'然后定义一个用于输出的函数 ReadOneString:
Private Function ReadOneString(ByVal Section As String, ByVal Key As String) As String
    Dim X As Long, buff As String * 128, I As Integer
    X = GetPrivateProfileString(Section, Key, "", buff, 128, sINIFile)
    I = InStr(buff, Chr(0))
    ReadOneString = Trim(Left(buff, I - 1))
End Function



Private Sub Cmd信息保存_Click()
    Text1 = WriteOneString("Option", "姓名", Text1)
    Text2 = WriteOneString("Option", "性别", Text2)
    Text3 = WriteOneString("Option", "民族", Text3)
    Text4 = WriteOneString("Option", "生日", Text4)
    Text5 = WriteOneString("Option", "籍贯", Text5)
    Text6 = WriteOneString("Option", "学历", Text6)
    Text7 = WriteOneString("Option", "职业", Text7)
    Text8 = WriteOneString("Option", "爱好", Text8)
    Text9 = WriteOneString("Option", "配偶", Text9)
    Text10 = WriteOneString("Option", "民族P", Text10)
    Text11 = WriteOneString("Option", "生日P", Text11)
    Text12 = WriteOneString("Option", "籍贯P", Text12)

    Call ReadString


    '另外的文件
    If Text13.Text = "" Then Exit Sub
    '有无Res文件夹
    If Dir(App.Path & "\Res", vbDirectory) = "" Then MkDir App.Path & "\Res"
    
    '保存简历
    If Dir(sJLFile, 32) <> "" Then Kill sJLFile
    Open sJLFile For Output As #1
        Print #1, Text13.Text
    Close #1
    Cmd信息保存.Enabled = False
End Sub



Private Sub Command2_Click()
    Unload Me
End Sub



Private Sub Command3_Click()
    FrmPhoto.Show 1
End Sub





Private Sub Form_Load()
    Me.Move FrmMain.Left, FrmMain.Top, FrmMain.Width, FrmMain.Height
    
    Me.Caption = "信息 - [" & FrmMain.TreeView1.SelectedItem.Text & "]"
    
    If Dir(App.Path & "\Rec", vbDirectory) = "" Then MkDir App.Path & "\Rec"
    sINIFile = App.Path & "\Rec\" & FrmMain.TreeView1.SelectedItem.Key & ".ini"
    
    If Dir(App.Path & "\Res", vbDirectory) = "" Then MkDir App.Path & "\Res"
    sJLFile = App.Path & "\Res\" & FrmMain.TreeView1.SelectedItem.Key & ".txt"
    
    '有无Img文件夹
    If Dir(App.Path & "\Img", vbDirectory) = "" Then MkDir App.Path & "\Img"
    sJPGFile = App.Path & "\Img\" & FrmMain.TreeView1.SelectedItem.Key & ".jpg"
    
    If Dir(sINIFile, 31) <> "" Then
        Call ReadString
    End If
    
    Text1 = FrmMain.TreeView1.SelectedItem.Text
    
    '另外的文件
    Text13.Text = ""
    '读出文本文件数据
    '应该注意长文件
    
    If Dir(sJLFile, 32) <> "" Then
        Open sJLFile For Input As #1
        Text13.Text = StrConv(InputB$(LOF(1), 1), vbUnicode)
        Close #1
    End If
    Cmd信息保存.Enabled = False

    If FrmMain.Tag = 0 Then
    Cmd信息保存.Enabled = False
    Text2.Locked = True
    Text3.Locked = True
    Text4.Locked = True
    Text5.Locked = True
    Text6.Locked = True
    Text7.Locked = True
    Text8.Locked = True
    Text9.Locked = True
    Text10.Locked = True
    Text11.Locked = True
    Text12.Locked = True
    Text13.Locked = True
    End If
    
    '显示缩略图片文件
    '显示图片文件
    If Dir(sJPGFile, 32) <> "" Then
        Me.Image2.Picture = LoadPicture(sJPGFile)
        
        Me.Image1.Width = Image2.Width / Image2.Height * 1335
        Me.Image1.Left = (Me.Picture3.Width - Me.Image1.Width) / 2
        Me.Image1.Picture = LoadPicture(sJPGFile)
        Me.Picture3.Visible = True
    Else
        Me.Image1.Picture = LoadPicture()
        Me.Picture3.Visible = False
    End If

End Sub



Private Sub Form_Resize()
    If Me.WindowState = 1 Then Exit Sub
    If Me.Width < 2900 Or Me.Height < 600 Then Exit Sub
    Me.Picture1.Move 2400, 120, Me.ScaleWidth - 2520, Me.ScaleHeight - 500
    Me.Text13.Move 240, 0, Me.Picture1.Width - 270, Me.Picture1.Height - 20
    Me.Picture3.Top = Me.ScaleHeight - 1715
End Sub



Sub ReadString()
    Text1 = ReadOneString("Option", "姓名")
    Text2 = ReadOneString("Option", "性别")
    Text3 = ReadOneString("Option", "民族")
    Text4 = ReadOneString("Option", "生日")
    Text5 = ReadOneString("Option", "籍贯")
    Text6 = ReadOneString("Option", "学历")
    Text7 = ReadOneString("Option", "职业")
    Text8 = ReadOneString("Option", "爱好")
    Text9 = ReadOneString("Option", "配偶")
    Text10 = ReadOneString("Option", "民族P")
    Text11 = ReadOneString("Option", "生日P")
    Text12 = ReadOneString("Option", "籍贯P")
    Cmd信息保存.Enabled = False
End Sub


Private Sub Label10_DblClick()
    Text10.Text = "汉族"
End Sub

Private Sub Label2_DblClick()
    If Text2.Text = "" Or Text2.Text = "女" Then
        Text2.Text = "男"
    Else
        Text2.Text = "女"
    End If
End Sub

Private Sub Label3_DblClick()
    Text3.Text = "汉族"
End Sub

Private Sub Text2_Change()
    If FrmMain.Tag = 1 Then Cmd信息保存.Enabled = True
End Sub
Private Sub Text3_Change()
    If FrmMain.Tag = 1 Then Cmd信息保存.Enabled = True
End Sub
Private Sub Text4_Change()
    If FrmMain.Tag = 1 Then Cmd信息保存.Enabled = True
End Sub
Private Sub Text5_Change()
    If FrmMain.Tag = 1 Then Cmd信息保存.Enabled = True
End Sub
Private Sub Text6_Change()
    If FrmMain.Tag = 1 Then Cmd信息保存.Enabled = True
End Sub
Private Sub Text7_Change()
    If FrmMain.Tag = 1 Then Cmd信息保存.Enabled = True
End Sub
Private Sub Text8_Change()
    If FrmMain.Tag = 1 Then Cmd信息保存.Enabled = True
End Sub
Private Sub Text9_Change()
    If FrmMain.Tag = 1 Then Cmd信息保存.Enabled = True
End Sub
Private Sub Text10_Change()
    If FrmMain.Tag = 1 Then Cmd信息保存.Enabled = True
End Sub
Private Sub Text11_Change()
    If FrmMain.Tag = 1 Then Cmd信息保存.Enabled = True
End Sub
Private Sub Text12_Change()
    If FrmMain.Tag = 1 Then Cmd信息保存.Enabled = True
End Sub
Private Sub Text13_Change()
    If FrmMain.Tag = 1 Then Cmd信息保存.Enabled = True
End Sub



'输入限制确认
'在某些应用程序中，我们需要限制在文本框或其它一些控件中只能输入数字
'或一些特定的字符，现在我们可以通过下面的一个函数来实现此功能：
Function ValiText(KeyIn As Integer, ValidateString As String, Editable As Boolean) As Integer
    Dim ValidateList As String
    Dim KeyOut As Integer
    
    If Editable = True Then
        ValidateList = UCase(ValidateString) & Chr(8)
    Else
        ValidateList = UCase(ValidateString)
    End If
    
    If InStr(1, ValidateList, UCase(Chr(KeyIn)), 1) > 0 Then
        KeyOut = KeyIn
    Else
        KeyOut = 0
        Beep
    End If
    
    ValiText = KeyOut
End Function



'在工程中加入此函数后，你就可以使用它了。
'方法：在需要限制输入的控件的 KeyPress 加入以下代码：
'现在你就可以过虑掉你不希望的字符了。
'在此例中，我们只接受第二个参数提供的字符，即："0123456789/-"
'而此函数的第三个参数就决定了能否使用 [Backspace] 键。

'最后值得一提的是此函数对大小写是不敏感的?

Private Sub Text4_KeyPress(KeyAscii As Integer)
    KeyAscii = ValiText(KeyAscii, "0123456789-", True)
End Sub

Private Sub Text11_KeyPress(KeyAscii As Integer)
    KeyAscii = ValiText(KeyAscii, "0123456789-", True)
End Sub