form1.frm

把图片缩小压缩成jpg格式并保存到sql数据库

 
   Dim imgX As ListImage
     
     
    
'1    ?从数据库中显示所需要的图片

'　　第一步首先打开数据库，看有没有要查找的内容，有则继续执行，没有就退出
         Dim con As String
          con = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db_test.mdb;Persist Security Info=False"
          adoConnection.CursorLocation = adUseClient
          adoConnection.Mode = adModeReadWrite
          adoConnection.ConnectionString = con
          adoConnection.Open
          
          
          
    
          
          
          
          
          
        
Set rs = adoConnection.Execute("select * from 人员表")
' "';"RS.ActiveConnection = "UID=;PWD=;DSN=TestDB;"
If rs.EOF Then rs.Close: Exit Sub

      
      Label6.Caption = "共有" & CStr(rs.RecordCount) & "条记录"
      
        Dim clmX As ColumnHeader
   '添加 ColumnHeaders。列宽度等于控件的宽度
   '除以 ColumnHeader 对象的数目。
   ListView1.ColumnHeaders.Clear
  Set clmX = ListView1.ColumnHeaders. _
   Add(, , rs.Fields(0).Name, (ListView1.Width / 5) + 80)
 For i = 1 To 4
   Set clmX = ListView1.ColumnHeaders. _
   Add(, , rs.Fields(i).Name, ListView1.Width / 5)
Next
   ListView1.BorderStyle = ccFixedSingle '设置 BorderStyle 属性。
   ListView1.View = lvwReport '设置 View 属性为


'　　第二步，读出长二进制数据即图片数据，把它转换成图片文件，操作过程如下
     rs.MoveFirst
    If rs.RecordCount > 0 Then

        For i = 0 To Text1.UBound
            Text1(i).Text = rs.Fields(i)
        Next i
lngTotalSize = rs!照片.ActualSize
Chunks = lngTotalSize \ ChunkSize
Fragment = lngTotalSize Mod ChunkSize
ReDim Picbyte(lngTotalSize - 1)
ReDim Chunk(Fragment - 1)
Chunk() = rs!照片.GetChunk(Fragment)
CopyMemory Picbyte(0), Chunk(0), Fragment
For i = 1 To Chunks
ReDim Chunk(ChunkSize - 1)
Chunk() = rs!照片.GetChunk(ChunkSize)
CopyMemory Picbyte(Fragment + (i - 1) * ChunkSize), Chunk(0), ChunkSize
Next i
Picture1.Picture = GetPictureFromByteStream(Picbyte())

'　　第三步，关闭数据库，这样就可以显示所要的图片了。
   
   
   
   
   
   
       rs.MoveFirst
   
       ListView1.Icons = Nothing
       ListView1.SmallIcons = Nothing
      
        ImageList1.ListImages.Clear
        ImageList1.ImageHeight = 60
         ImageList1.ImageWidth = 60
        For i = 1 To rs.RecordCount
        
            lngTotalSize = rs!照片.ActualSize
            Chunks = lngTotalSize \ ChunkSize
            Fragment = lngTotalSize Mod ChunkSize
            ReDim Picbyte(lngTotalSize - 1)
            ReDim Chunk(Fragment - 1)
            Chunk() = rs!照片.GetChunk(Fragment)
            CopyMemory Picbyte(0), Chunk(0), Fragment
            For j = 1 To Chunks
                ReDim Chunk(ChunkSize - 1)
                Chunk() = rs!照片.GetChunk(ChunkSize)
                CopyMemory Picbyte(Fragment + (j - 1) * ChunkSize), Chunk(0), ChunkSize
            Next j
       
            Set imgX = ImageList1.ListImages. _
            Add(, , GetPictureFromByteStream(Picbyte()))
            rs.MoveNext
        Next i
   
   
   
   
   
   
          ListView1.Icons = ImageList1
          ListView1.SmallIcons = ImageList1
        ListView1.ListItems.Clear
         rs.MoveFirst
      For i = 1 To rs.RecordCount
         '  Set mItem = ListView1.ListItems.Add(, , rs.Fields("姓名"), Rnd * 2 + 1)
           
            Set mItem = ListView1.ListItems.Add(, , rs.Fields("姓名"))
            For j = 1 To 4
              mItem.SubItems(j) = rs.Fields(j) & CStr(i)
          
            Next
              ListView1.ListItems(i).SmallIcon = i 'Rnd * 2 + 1
           '  ListView1.ListItems(i).ListSubItems(1).ReportIcon = i 'Rnd * 2 + 1
            ' ListView1.ListItems(1).ListSubItems(3).ReportIcon=1
            rs.MoveNext
        Next i
   
   
   
'   HIMAGELIST   hImage   =   SHGetFileInfo("c:\\*.*",   0,   &sh,   sizeof(sh),   SHGFI_SYSICONINDEX   );
 ' ListView_SetImageList(hList,   hImage,   LVSIL_SMALL);
   
   rs.Close
 adoConnection.Close
Picture1.Picture = GetPictureFromByteStream(Picbyte())

 End If
 
 
  
    '设置控件状态
    Command1.Enabled = False
    Command3.Enabled = False

    For i = 0 To Text1.UBound

        Text1(i).Enabled = False

    Next i

    ListView1.LabelEdit = lvwManual '这个属性返回或设置一个值，它确定是否可以编辑在 ListView 或 TreeView 控件中的 ListItem 或 Node 对象的标签。

 
 
 
End Sub

Private Sub Command1_Click()  '添加图片
  Dim strFile As String
  Dim Picbyte() As Byte
  Dim xy As POINTAPI
  strFile = GetOpenFile(hwnd)
    If strFile <> vbNullString Then
        Picture2.Picture = LoadPicture(strFile)
       ' Picture1.PaintPicture Picture2.Picture, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, vbSrcCopy
        
        '用stretch之前SetStretchBltMode（dc，HALFTONE）；
        ' 先调一下SetStretchBltMode (COLORONCOLOR)

        Call SetStretchBltMode(Picture1.hdc, HALFTONE)
        Call SetBrushOrgEx(Picture1.hdc, 0, 0, xy)
        StretchBlt Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture2.hdc, 0, 0, Picture2.Width, Picture2.Height, vbSrcCopy
      '   Picture1.Picture = Picture2.Picture
        Picture1.Refresh
     '    SaveJPEG Picture1, Picbyte(), CByte(90)
      '  Picture1.Picture = GetPictureFromByteStream(Picbyte())
      ' Picture1.Refresh
        
        
     
        
    End If

End Sub

Private Sub Command2_Click()  '添加

    Dim i&
    添加修改 = True
    Command1.Enabled = True
    Command2.Enabled = False
    Command3.Enabled = True
    Command5.Enabled = True
    For i = 0 To Text1.UBound

        Text1(i).Enabled = True
        Text1(i).Text = ""

    Next i

    'Image1.Picture = LoadPicture(vbNullString)
    Picture1.Picture = LoadPicture(vbNullString)
    Picture2.Picture = LoadPicture(vbNullString)
    Text1(0).SetFocus

  
End Sub

Private Sub Command3_Click() '保存
    Dim Picbyte() As Byte
    Dim FileLen  As Long
    Dim Chunks  As Long
   
    Dim i&
    Save2DB 添加修改
     Command1.Enabled = False
    Command2.Enabled = True
    Command3.Enabled = False
     Command5.Enabled = False
End Sub

Private Sub Command4_Click()

    Unload Me

End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)  '显示人员信息

    Dim i&

   Call sub1
   Exit Sub
   

End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)

    If KeyAscii = vbKeyReturn Then

        If Index = Text1.UBound Then

            Command1.SetFocus

            Exit Sub

        End If

        Text1(Index + 1).SetFocus

    End If

End Sub

Public Sub SaveJPEG(Pic As PictureBox, Picbyte() As Byte, Optional ByVal Quality As Byte = 90)
    Dim JPEGclass As New ClsJPEG
    Dim m_Picture As IPictureDisp
    Dim m_DC As Long
    Dim m_Millimeter As Single
   ' m_Millimeter = ScaleX(100, vbPixels, vbMillimeters)
    Set m_Picture = Pic
    m_DC = Pic.hdc
    '检查文件名及图像
    If m_DC <> 0 Then
        JPEGclass.Quality = Quality
        '全颜色保存
        JPEGclass.SetSamplingFrequencies 1, 1, 1, 1, 1, 1
        '从hDC拷贝图像
       'If JPEGclass.SampleHDC(m_DC, CLng(Pic.Width / m_Millimeter), CLng(Pic.Height / m_Millimeter)) = 0 Then
        If JPEGclass.SampleHDC(m_DC, CLng(Pic.ScaleWidth), CLng(Pic.ScaleHeight)) = 0 Then
  
          
            '保存文件,成功返回True
           Call JPEGclass.Savetobyte(Picbyte())
        End If
    End If
    '释放空间
    Set JPEGclass = Nothing
End Sub

Sub sub1()
 Dim Picbyte() As Byte
 Dim FileLen  As Long
 Dim Chunks  As Long
 Dim i As Long
'1    ?从数据库中显示所需要的图片

'　　第一步首先打开数据库，看有没有要查找的内容，有则继续执行，没有就退出
         Dim con As String
          con = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db_test.mdb;Persist Security Info=False"
          adoConnection.CursorLocation = adUseClient
          adoConnection.Mode = adModeReadWrite
          adoConnection.ConnectionString = con
          adoConnection.Open
        
Set rs = adoConnection.Execute("select * from 人员表 where 姓名='" + ListView1.SelectedItem.Text + "'")
' "';"RS.ActiveConnection = "UID=;PWD=;DSN=TestDB;"
If rs.EOF Then rs.Close: Exit Sub

'　　第二步，读出长二进制数据即图片数据，把它转换成图片文件，操作过程如下


    If rs.RecordCount > 0 Then

        For i = 0 To Text1.UBound

            Text1(i).Text = rs.Fields(i)

        Next i

      
lngTotalSize = rs!照片.ActualSize
Chunks = lngTotalSize \ ChunkSize
Fragment = lngTotalSize Mod ChunkSize
ReDim Picbyte(lngTotalSize - 1)
ReDim Chunk(Fragment - 1)
Chunk() = rs!照片.GetChunk(Fragment)
CopyMemory Picbyte(0), Chunk(0), Fragment
For i = 1 To Chunks
ReDim Chunk(ChunkSize - 1)
Chunk() = rs!照片.GetChunk(ChunkSize)
CopyMemory Picbyte(Fragment + (i - 1) * ChunkSize), Chunk(0), ChunkSize
Next i
'　　第三步，关闭数据库，这样就可以显示所要的图片了。
   rs.Close
 adoConnection.Close
Picture1.Picture = GetPictureFromByteStream(Picbyte())

 End If
End Sub