imagemanageform.frm

即时通讯

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form ImageManageForm 
   Caption         =   "图片管理"
   ClientHeight    =   4050
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   6180
   LinkTopic       =   "Form1"
   ScaleHeight     =   4050
   ScaleWidth      =   6180
   StartUpPosition =   3  '窗口缺省
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   2280
      Top             =   3240
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Filter          =   "*.bmp|*.bmp"
   End
   Begin VB.CommandButton Command2 
      Caption         =   "保存"
      Height          =   375
      Left            =   4320
      TabIndex        =   2
      Top             =   3360
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打开"
      Height          =   375
      Left            =   3240
      TabIndex        =   1
      Top             =   3360
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.Frame Frame1 
      Height          =   3975
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   6135
      Begin VB.Image Image1 
         Height          =   3615
         Left            =   80
         Top             =   200
         Width           =   5895
      End
   End
   Begin VB.Menu m_openImage 
      Caption         =   "打开"
   End
   Begin VB.Menu m_saveImage 
      Caption         =   "保存"
   End
End
Attribute VB_Name = "ImageManageForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**************************************
'*    模 块 名 称 :应用程序图片管理窗体
'*    功 能 描 述 :管理系统中的图片
'*                 新增或修改完成后把图片的ID 存放在查询ID中
'*                 mainform.g_application.m_queryResultId
'*    程序员姓名  : 陈齐国
'*    最后修改人  : 陈齐国
'*    最后修改时间:2005/10/14
'**************************************
Option Explicit

Public m_imageId As String          ' 图片对象的ID 当为空时为新增图片，
                                    '              不空为修改一个图片

Private imageDataArr() As Byte      ' 图像文件读入后保存的字节数组
Private imageName As String         ' 图像文件名

Private m_dao As ImageDAO
Private m_recordset As ADODB.Recordset ' 数据操作数据集对象
'**************************************
'*    功 能 描 述 :加载一个图片
'*    输 入 参 数 :无
'*    输 出 能 数 :无
'**************************************
Private Sub Command1_Click()
    Dim filename1 As String            ' 用户选择的文件的路径及文件名字符串
    Dim fileLen As Long                ' 文件长度
    Dim file_num As Long               ' 文件数据
    Dim bufferfile As Long
    Dim current As String


    
    CommonDialog1.FileName = ""
    CommonDialog1.ShowOpen                      '显示打开文件对话框
    filename1 = CommonDialog1.FileName          '获取所选择的文件名

    On Error GoTo EXITSUB
        file_num = FreeFile()
        Open filename1 For Binary Access Read As #file_num
        
        fileLen = LOF(file_num) '求文件长度
        ReDim imageDataArr(fileLen) '根据文件长度定义动态数组大小
        Get #file_num, , imageDataArr '将一个已打开的磁盘文件读入数组变量之中
        
        bufferfile = FreeFile()
        Open "tempfile.bmp" For Binary Access Read Write As #bufferfile '打开一个临时文件
        Put bufferfile, , imageDataArr '将动态数组FileArr中的数据写入临时文件tempfile中
        current = CurDir & "\tempfile.bmp" '获取临时文件的全路径
    '    WebBrowser1.Navigate current '在WebBrowser控件中显示文件内容
        Image1.Picture = LoadPicture(current)

EXITSUB:
End Sub
'**************************************
'*    功 能 描 述 :保存按钮的处理函数
'*    输 入 参 数 :无
'*    输 出 能 数 :无
'**************************************
Private Sub Command2_Click()
    Dim imageId As String
    Dim ret As Boolean
    
    If m_imageId = "" Then     ' 新增一条记录
        imageId = m_dao.NewImage("a.bmp", imageDataArr)
        m_imageId = imageId
    Else                       ' 修改一条记录
        ret = m_dao.ModifyImage("a.bmp", imageDataArr, m_imageId)
    End If
    
    MainForm.g_application.m_queryResultId = m_imageId   ' 返回图片ID
    
    Unload Me
End Sub

'**************************************
'*    功 能 描 述 :窗体初始化操作
'*    输 入 参 数 :无
'*    输 出 能 数 :无
'**************************************
Private Sub Form_Load()
    Set m_recordset = New ADODB.Recordset
    Set m_dao = New ImageDAO
    
    SetToCenter Me
    
    MainForm.g_application.m_queryResultId = ""     ' 把查询结果清空，在退出时再写入值

    CommonDialog1.Filter = "*.jpg|*.jpg|*.bmp|*.bmp|*.gif|*.gif|*.jpeg|*.jpeg"
    
    LoadImage m_imageId
End Sub
'**************************************
'*    功 能 描 述 :载入一个图记录的图片数据
'*    输 入 参 数 :imageId  - 图片ID
'*    输 出 能 数 :无
'**************************************
Private Function LoadImage(imageId As String)
    Dim ret As Boolean
    Dim fileLen As Long      ' 图片的长度
    Dim bufferfile As Long
    Dim current As String
    
    
    ret = m_dao.FindImageById(m_recordset, m_imageId)
    
    If ret Then
        fileLen = m_recordset.Fields("imageDate").ActualSize          '得到office字段中的文件数据的大小
        ReDim imageDataArr(fileLen)
        imageDataArr() = m_recordset.Fields("imageDate").GetChunk(fileLen) '将字段中数据写入动态数组中
        
        bufferfile = FreeFile()
        Open "tempfile.bmp" For Binary Access Read Write As #bufferfile '打开一个临时文件
        Put bufferfile, , imageDataArr '将动态数组FileArr中的数据写入临时文件tempfile中
        current = CurDir & "\tempfile.bmp" '获取临时文件的全路径
    '    WebBrowser1.Navigate current '在WebBrowser控件中显示文件内容
        Image1.Picture = LoadPicture(current)
    End If
    
    m_recordset.Close
End Function
'**************************************
'*    功 能 描 述 :窗体改变大小处理函数
'*    输 入 参 数 :无
'*    输 出 能 数 :无
'**************************************
Private Sub Form_Resize()
    Frame1.Height = Me.Height - 800
    Frame1.Width = Me.Width - 150
    
    Image1.Stretch = False
    
    If (Image1.Height > Frame1.Height - 300) Or _
        (Image1.Width > Frame1.Width - 200) Then
        Image1.Height = Frame1.Height - 300
        Image1.Width = Frame1.Width - 200
        
        Image1.Stretch = True
    End If
End Sub

Private Sub m_openImage_Click()
    Command1_Click
End Sub

Private Sub m_saveImage_Click()
    Command2_Click
End Sub