以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  图片处理  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=86769)

--  作者:HJG_HB950207
--  发布时间:2016/6/25 14:25:00
--  图片处理
职工一览表 有姓名,图片 列,图片列一次从d:\\fox照片目录下导入:代码如下:

If FileSys.DirectoryExists("d:\\照片FOX") Then \'如果目录C:\\MyFolder存在
 For Each f As String In FileSys.GetFiles("d:\\照片FOX")
    Dim ifo As new FileInfo(f)
    Dim name As String = ifo.name.Replace(ifo.Extension, "")
    Dim fdr As DataRow = DataTables("职工一览表").Find("姓名 = \'" & name & "\'")
    If fdr IsNot Nothing Then
        fdr("照片") ="D:\\照片FOX\\" &ifo.Name
        FileSys.CopyFile(f, "d:\\照片FOX" & ifo.Name,True)
     End If
Next
 \'FileSys.DeleteDirectory("d:\\rsgl",2,3) \'则删除之
\'DataTables("职工一览表").DataCols("照片").DefaultFolder = "d:\\照片fox"
Else
  MessageBox.Show("请将全部职工个人照片用对应姓名命名(格式.JPG,存放至D:\\照片FOX 目录中,然后点击一键录入")
End If

请问:如何修改代码,使批量导入的图片文件是经过压缩的(原图片文件太大)



--  作者:Hyphen
--  发布时间:2016/6/25 15:16:00
--  
参考http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=84351


If FileSys.DirectoryExists("d:\\照片FOX") Then \'如果目录C:\\MyFolder存在
    For Each f As String In FileSys.GetFiles("d:\\照片FOX")
        Dim ifo As new FileInfo(f)
        Dim name As String = ifo.name.Replace(ifo.Extension, "")
        Dim fdr As DataRow = DataTables("职工一览表").Find("姓名 = \'" & name & "\'")
        If fdr IsNot Nothing Then
            fdr("照片") ="D:\\照片FOX\\" &ifo.Name
            Dim bmp As new bitmap(getImage(f), 100, 100 * (img.height / img.width))
            bmp.save("d:\\照片FOX" & ifo.Name)
            bmp.Dispose
        End If
    Next
    \'FileSys.DeleteDirectory("d:\\rsgl",2,3) \'则删除之
    \'DataTables("职工一览表").DataCols("照片").DefaultFolder = "d:\\照片fox"
Else
    MessageBox.Show("请将全部职工个人照片用对应姓名命名(格式.JPG,存放至D:\\照片FOX 目录中,然后点击一键录入")
End If

--  作者:HJG_HB950207
--  发布时间:2016/6/25 17:38:00
--  
谢!!!