Foxtable(狐表)用户栏目专家坐堂 → 各位老师给我帮好吗


  共有2176人关注过本帖树形打印复制链接

主题:各位老师给我帮好吗

帅哥哟,离线,有人找我吗?
telek
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:403 积分:3430 威望:0 精华:0 注册:2014/3/10 11:02:00
各位老师给我帮好吗  发帖心情 Post By: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
按此在新窗口浏览图片

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:106884 积分:543633 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2019/12/2 10:04:00 [只看该作者]

请上传几张您测试有问题的图片上来测试

 回到顶部
帅哥哟,离线,有人找我吗?
telek
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:403 积分:3430 威望:0 精华:0 注册:2014/3/10 11:02:00
  发帖心情 Post By:2019/12/2 11:21:00 [只看该作者]

老师 有的电脑可以但是大部分电脑都不行

 回到顶部
帅哥哟,离线,有人找我吗?
telek
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:403 积分:3430 威望:0 精华:0 注册:2014/3/10 11:02:00
  发帖心情 Post By:2019/12/2 11:22:00 [只看该作者]

去年是没有问题今年处了这种情况

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:106884 积分:543633 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By: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

 回到顶部