| 以文本方式查看主题 - Foxtable(狐表) (http://foxtable.net/bbs/index.asp) -- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2) ---- 改变图片文件类型 (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=125090) |
| -- 作者：刘林 -- 发布时间：2018/9/19 18:35:00 -- 改变图片文件类型 If wjm>"" Dim ifo As new FileInfo(t1) Dim img As image = getimage(t1) Dim bmp As new bitmap(img.width, img.height) Dim g = graphics.fromimage(bmp) g.DrawImage(img, 0, 0, img.Width, img.Height) Dim jpgEncoder As ImageCodecInfo Dim codecs() As ImageCodecInfo = ImageCodecInfo.GetImageDecoders For Each codec As ImageCodecInfo In codecs If (codec.FormatID = ImageFormat.Jpeg.Guid) Then jpgEncoder = codec Exit For End If Next Dim myEncoder As System.Drawing.Imaging.Encoder = System.Drawing.Imaging.Encoder.Quality Dim myEncoderParameters As EncoderParameters = New EncoderParameters(1) Dim myEncoderParameter As EncoderParameter = New EncoderParameter(myEncoder, 100) \' 质量级别 0 对应于最大压缩,而质量级别 100 对应于最小压缩 myEncoderParameters.Param(0) = myEncoderParameter Dim slt As String = ifo.path & wjm & ifo.Extension bmp.Save(slt,jpgEncoder, myEncoderParameters) bmp.dispose g.dispose Dim img1 As image = getImage(slt) Dim bmp1 As bitmap If img1.width > 200 Then If 200 * (img1.height / img1.width) > 150 Then bmp1 = new bitmap(img1, 200*(150/(200*(img1.height/img1.width))), 150) Else bmp1 = new bitmap(img1, 150, 150 * (img1.height / img1.width)) End If bmp1.save(slt) bmp1.Dispose End If If ftp1.Upload(slt,"\\xp\\" & FileSys.GetName(wjm & Ifo.extension),True) = True Then r("相片")="\\xp\\" & FileSys.GetName(wjm & Ifo.extension) r.save Else Messagebox.show("上传失败,请重新上传该文件!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information) End If Else End If Else 请问老师，当图片t1为非jpg文件类型时,我想在保存时统一保存为jpg类型，直接改扩展明应该不行吧,这个在哪里更改？ 顺便加一个问题用命令如何让当前行的图片字段的图片刷新呢？
[此贴子已经被作者于2018/9/19 19:05:52编辑过]
|
| -- 作者：有点甜 -- 发布时间：2018/9/19 20:43:00 -- 1、压缩代码要改一下
http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=124985&replyID=840268&skin=1
2、保存的时候修改
|
| -- 作者：刘林 -- 发布时间：2018/9/19 21:04:00 -- Dim ftp1 As New FtpClient ftp1.Host= ftp1.Account = ftp1.Password = Dim r As Row = Tables("相片处理_table1").Current Dim t1 As String = e.Form.Controls("textbox1").text Dim wjm As String="" If t1>"" If ValidPIN(r("身份证件号"))= True wjm = r("身份证件号") ElseIf r("学籍号")>"" wjm=r("学籍号") Else messagebox.show("该学生的身份证号和学籍号中至少有一个要正确完整") Return End If If wjm>"" Dim ifo As new FileInfo(t1) If Ifo.Length>40960 \'大于40k才压缩 Dim img As image = getimage(t1) Dim bmp As new bitmap(img.width, img.height) Dim g = graphics.fromimage(bmp) g.DrawImage(img, 0, 0, img.Width, img.Height) Dim jpgEncoder As ImageCodecInfo Dim codecs() As ImageCodecInfo = ImageCodecInfo.GetImageDecoders For Each codec As ImageCodecInfo In codecs If (codec.FormatID = ImageFormat.Jpeg.Guid) Then jpgEncoder = codec Exit For End If Next Dim myEncoder As System.Drawing.Imaging.Encoder = System.Drawing.Imaging.Encoder.Quality Dim myEncoderParameters As EncoderParameters = New EncoderParameters(1) Dim myEncoderParameter As EncoderParameter = New EncoderParameter(myEncoder, 100) \' 质量级别 0 对应于最大压缩,而质量级别 100 对应于最小压缩 myEncoderParameters.Param(0) = myEncoderParameter Dim slt As String = ifo.path & wjm & ifo.Extension bmp.Save(slt,jpgEncoder, myEncoderParameters) bmp.dispose g.dispose Dim img1 As image = getImage(slt) Dim bmp1 As bitmap If img1.width > 200 Then If 200 * (img1.height / img1.width) > 150 Then bmp1 = new bitmap(img1, 200*(150/(200*(img1.height/img1.width))), 150) Else bmp1 = new bitmap(img1, 150, 150 * (img1.height / img1.width)) End If bmp1.save(slt, ImageFormat.Jpeg) bmp1.Dispose End If If ftp1.Upload(slt,"\\xp\\" & FileSys.GetName(wjm & Ifo.extension),True) = True Then r("相片")="\\xp\\" & FileSys.GetName(wjm & Ifo.extension) r.save Else Messagebox.show("上传失败,请重新上传该文件!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information) End If Else If ftp1.Upload(t1,"\\xp\\" & FileSys.GetName(wjm & Ifo.extension),True) = True Then r("相片")="\\xp\\" & FileSys.GetName(wjm & Ifo.extension) r.save Else Messagebox.show("上传失败,请重新上传该文件!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information) End If End If End If Else messagebox.show("你没打开相片") End If 我测试了一下选择个png文件传上去后文件还是png呢哪里没有对？ |
| -- 作者：有点甜 -- 发布时间：2018/9/19 21:46:00 -- Dim slt As String = ifo.path & wjm & ifo.Extension
改成
Dim slt As String = ifo.path & wjm & ".jpg" |