详细资料.frm

zui hao yong de VBxitong

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form3 
   Caption         =   "详细资料"
   ClientHeight    =   5280
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4740
   LinkTopic       =   "Form3"
   ScaleHeight     =   5280
   ScaleWidth      =   4740
   StartUpPosition =   2  '屏幕中心
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   3720
      Top             =   2280
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   330
      Left            =   3600
      TabIndex        =   15
      Top             =   4800
      Width           =   975
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "确定"
      Height          =   330
      Left            =   3600
      TabIndex        =   14
      Top             =   4320
      Width           =   975
   End
   Begin VB.CommandButton cmdView 
      Caption         =   "浏览..."
      Height          =   330
      Left            =   3480
      TabIndex        =   13
      Top             =   2760
      Width           =   1095
   End
   Begin VB.PictureBox Picture1 
      Height          =   1935
      Left            =   840
      ScaleHeight     =   1875
      ScaleWidth      =   2475
      TabIndex        =   12
      Top             =   3240
      Width           =   2535
   End
   Begin VB.TextBox txtPhoto 
      Height          =   270
      Left            =   840
      Locked          =   -1  'True
      TabIndex        =   11
      Top             =   2760
      Width           =   2535
   End
   Begin VB.TextBox txtAddress 
      Height          =   270
      Left            =   840
      TabIndex        =   10
      Top             =   2280
      Width           =   2535
   End
   Begin VB.TextBox txtPhone 
      Height          =   270
      Left            =   840
      TabIndex        =   9
      Top             =   1800
      Width           =   2535
   End
   Begin VB.TextBox txtAge 
      Height          =   270
      Left            =   840
      TabIndex        =   8
      Top             =   1320
      Width           =   2535
   End
   Begin VB.TextBox txtSex 
      Height          =   270
      Left            =   840
      TabIndex        =   7
      Top             =   840
      Width           =   2535
   End
   Begin VB.TextBox txtName 
      Height          =   270
      Left            =   840
      TabIndex        =   6
      Top             =   360
      Width           =   2535
   End
   Begin VB.Label Label6 
      Caption         =   "照片:"
      Height          =   375
      Left            =   240
      TabIndex        =   5
      Top             =   2880
      Width           =   1095
   End
   Begin VB.Label Label5 
      Caption         =   "地址:"
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   2400
      Width           =   1095
   End
   Begin VB.Label Label4 
      Caption         =   "电话:"
      Height          =   375
      Left            =   240
      TabIndex        =   3
      Top             =   1920
      Width           =   1335
   End
   Begin VB.Label Label3 
      Caption         =   "年龄:"
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   1440
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "性别:"
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   960
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "姓名:"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   480
      Width           =   975
   End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const BLOCKSIZE = 4096 '每次读写块的大小
Public bh As String

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdSave_Click()
Dim rst As New ADODB.Recordset
Dim sql As String
    If bh <> "" Then
        sql = "select * from 通讯录 where 编号=" & bh
    Else
        sql = "select * from 通讯录 where 1=2"
    End If
    rst.Open sql, conn, adOpenStatic, adLockOptimistic
    If rst.RecordCount = 0 Then
        rst.AddNew
    End If
    rst.Fields("姓名") = txtname.Text
    rst.Fields("性别") = txtSex.Text
    rst.Fields("年龄") = txtAge.Text
    rst.Fields("电话") = txtPhone.Text
    rst.Fields("地址") = txtAddress.Text
    If txtPhoto.Text <> "" Then Call SaveToDB(rst.Fields("照片"), txtPhoto.Text)
    rst.Update
    rst.Close
    Set rst = Nothing
    Unload Me
End Sub

Private Sub cmdView_Click()
On Error GoTo errout
    CommonDialog1.fileName = ""
    CommonDialog1.Filter = "图片（*.bmp;*.jpg）|*.bmp;*.jpg"
    CommonDialog1.ShowOpen
    If CommonDialog1.fileName <> "" Then
        txtPhoto.Text = CommonDialog1.fileName
        Picture1.Picture = LoadPicture(CommonDialog1.fileName)
    End If
errout:
End Sub

Private Sub SaveToDB(ByRef Fld As ADODB.Field, DiskFile As String)
    Dim byteData() As Byte '定义数据块数组
    Dim NumBlocks As Long '定义数据块个数
    Dim FileLength As Long '标识文件长度
    Dim LeftOver As Long '定义剩余字节长度
    Dim SourceFile As Long '定义自由文件号
    Dim i As Long '定义循环变量
    SourceFile = FreeFile '提供一个尚未使用的文件号
    Open DiskFile For Binary Access Read As SourceFile '打开文件
    FileLength = LOF(SourceFile) '得到文件长度
    If FileLength = 0 Then '判断文件是否存在
        Close SourceFile
        MsgBox DiskFile & " 无 内 容 或 不 存 在 !"
    Else
        NumBlocks = FileLength \ BLOCKSIZE '得到数据块的个数
        LeftOver = FileLength Mod BLOCKSIZE '得到剩余字节数
        Fld.Value = Null
        ReDim byteData(BLOCKSIZE) '重新定义数据块的大小
        For i = 1 To NumBlocks
            Get SourceFile, , byteData() ' 读到内存块中
            Fld.AppendChunk byteData() '写入FLD
        Next i
        ReDim byteData(LeftOver) '重新定义数据块的大小
        Get SourceFile, , byteData() '读到内存块中
        Fld.AppendChunk byteData() '写入FLD
        Close SourceFile '关闭源文件
    End If
End Sub


Private Sub ShowPhoto(rf As ADODB.Field)
Dim Chunk() As Byte
Const ChunkSize As Integer = 2384
Dim DataFile As Integer, Chunks, Fragment As Integer
Dim MediaTemp As String
Dim lngOffset, lngTotalSize As Long
Dim i As Integer
    MediaTemp = App.Path & "\picturetemp.tmp"
    DataFile = 1
    Open MediaTemp For Binary Access Write As DataFile
    lngTotalSize = rf.ActualSize
    Chunks = lngTotalSize \ ChunkSize
    Fragment = lngTotalSize Mod ChunkSize
    ReDim Chunk(Fragment)
    Chunk() = rf.GetChunk(Fragment)
    Put DataFile, , Chunk()
    For i = 1 To Chunks
        ReDim Chunk(ChunkSize)
        Chunk() = rf.GetChunk(ChunkSize)
        Put DataFile, , Chunk()
    Next i
    Close DataFile
    Picture1.Picture = LoadPicture(MediaTemp)
    Kill MediaTemp
End Sub

Private Sub LoadData()
Dim rst As New ADODB.Recordset
Dim sql As String
    sql = "select * from 通讯录 where 编号=" & bh
    rst.Open sql, conn, adOpenKeyset, adLockOptimistic
    If rst.RecordCount <> 0 Then
        txtname.Text = rst.Fields("姓名")
        txtSex.Text = rst.Fields("性别")
        txtAge.Text = rst.Fields("年龄")
        txtPhone.Text = rst.Fields("电话")
        txtAddress.Text = rst.Fields("地址")
        If Not IsNull(rst.Fields("照片")) Then
            ShowPhoto rst.Fields("照片")
        Else
            Picture1.Picture = LoadPicture("")
        End If
    End If
    rst.Close
    Set rst = Nothing
End Sub

Private Sub Form_Load()
    If bh <> "" Then
        LoadData
    End If
End Sub