以文本方式查看主题 - 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 -- 谢!!! |