- Foxtable(狐表) (http://foxtable.net/bbs/index.asp)
-- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2)
---- 各位老师给我帮好吗 (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=143694)
-- 发布时间：2019/12/2 9:59:00
-- 各位老师给我帮好吗
此主题相关图片如下：lalpdgq9rr7wtkjnabjnaro_698_440.png
Dim t As Table = Tables("基本信息") Dim dlg As new OpenFileDialog dlg.Filter="图形文件|*.bmp;*.jpg;*.gif;*.png" \'设置筛选器 If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮 Dim file As String = dlg.FileName Dim img As image = getImage(file) \'Dim bmp As bitmap 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 If img.width > 1280 Then If 1280 * (img.height / img.width) > 720 Then bmp = new bitmap(img, 1280*(720/(1280*(img.height/img.width))), 720) Else bmp = new bitmap(img, 1280, 1280 * (img.height / img.width)) End If End If 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, 60) \' 质量级别 0 对应于最大压缩,而质量级别 100 对应于最小压缩 myEncoderParameters.Param(0) = myEncoderParameter bmp.Save("c:\\压缩图.jpg", jpgEncoder, myEncoderParameters) bmp.dispose g.dispose Dim FT As NEW FTPClient FT.Host ="" FT.Account = "" FT.Password = "" Dim sz As Date Dim st As String = dlg.FileName.SubString(dlg.FileName.LastIndexOf("\\")+1) \'获取无路径的文件名 Dim ftype As String = st.SubString(st.LastIndexOf(".")) If ft.MakeDir("/中小学证明") Then Messagebox.Show("中小学证明目录创建成功!") ElseIf ft.MakeDir("/中小学证明\\" & t.Current("乡镇")) Then Messagebox.Show(t.Current("乡镇") & "目录创建成功!") ElseIf ft.MakeDir("/中小学证明\\" & t.Current("乡镇") & "/" & t.Current("行政村")) Then Messagebox.Show(t.Current("乡镇") & t.Current("行政村") & "目录创建成功!") Else If t.Current.IsNull("入学时间") And t.Current("数据赛选")<> "空挂" And t.Current("健康状况")<> "失能" Or t.Current.IsNull("入学时间") And t.Current("数据赛选")<> "出国" And t.Current("健康状况")<> "失能" Then MessageBox.Show("入学时间不能为空!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information) e.Cancel = True ElseIf t.Current.IsNull("年级") And t.Current("数据赛选")<> "空挂" And t.Current("健康状况")<> "失能" Or t.Current.IsNull("年级") And t.Current("数据赛选")<> "出国" And t.Current("健康状况")<> "失能" Then MessageBox.Show("年级不能为空!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information) e.Cancel = True ElseIf t.Current.IsNull("就读学校") And t.Current("数据赛选")<> "空挂" And t.Current("健康状况")<> "失能" Or t.Current.IsNull("就读学校") And t.Current("数据赛选")<> "出国" And t.Current("健康状况")<> "失能" Then MessageBox.Show("就读学校不能为空!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information) e.Cancel = True ElseIf t.Current.IsNull("残疾证号") And t.Current("健康状况")= "失能" Then MessageBox.Show("请填写残疾证号","提示",MessageBoxButtons.OK,MessageBoxIcon.Information) e.Cancel = True Else Dim Val1 As Integer = Rand.Next(100,300) ft.Upload("c:\\压缩图.jpg","//中小学证明/" & t.Current("乡镇") & "/" & t.Current("行政村") & "/" & t.Current("姓名") & Val1 & ftype) ft.Close T.Current("证明") = "//中小学证明/" & t.Current("乡镇") & "/" & t.Current("行政村") & "/" & t.Current("姓名") & Val1 & ftype sz = FT.GetFileTime(T.Current("证明")) T.Current("证明修改时间") = sz End If End If End If 此主题相关图片如下：2019112911565852178.png |
-- 发布时间：2019/12/2 10:04:00
--
请上传几张您测试有问题的图片上来测试
-- 发布时间：2019/12/2 11:21:00
--
老师 有的电脑可以但是大部分电脑都不行
-- 发布时间：2019/12/2 11:22:00
--
去年是没有问题今年处了这种情况
-- 发布时间：2019/12/2 11:48:00
--
试试压缩图片直接就这样用有没有问题
Dim file As String = "d:\\test.jpg"
Dim img As image = getImage(file)
Dim bmp As bitmap
If img.width > 800 Then
If 800 * (img.height / img.width) > 600 Then
bmp = new bitmap(img, 800*(600/(800*(img.height/img.width))), 600)
Else
bmp = new bitmap(img, 800, 800 * (img.height / img.width))
End If
End If
bmp.save("d:\\缩略图.jpg",img.RawFormat)
bmp.Dispose