锐客网

  1. 首页 > 睿知 > it技术 > >

vb.net压缩图片 vba压缩图片

heightIT技术

我想用VB写一个压缩图片的程序，应该怎么写如果你是仅仅为了压缩，而不是为了编程，你可以用ACDSee，他可以批量操作，方法是在ACDSee中选择你需要压缩的全部文件，点 工具 调整大小 选项很明显，你试一试 。
你非要用程序的话，看看一下参考
注意：
PicClipD的ScaleMode=vbPixels
源图像是ImgSrc
目的图像是PicDest，注意它的属性
最关键的实现过程在CmdMake_Click
将下列内容复制到记事本，并保存为相应的文件
PicScale.vbp
--------------------
Type=Exe
Form=FrmMain.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\WINDOWS\system32\stdole2.tlb#OLEAutomation
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX
IconForm="FrmMain"
Startup="FrmMain"
HelpFile=""
ExeName32="PicScale.exe""
Command32="""
Name="PicScale"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1
FrmMain.frm
----------------------------------
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmMain
Caption="简单图像文件缩放"
ClientHeight=3810
ClientLeft=165
ClientTop=855
ClientWidth=5505
HasDC=0'False
LinkTopic="Form1"
ScaleHeight=254
ScaleMode=3'Pixel
ScaleWidth=367
StartUpPosition =3'窗口缺省
Begin MSComDlg.CommonDialog CDlgFile
Left=2160
Top=1320
_ExtentX=847
_ExtentY=847
_Version=393216
End
Begin VB.PictureBox PicClipD
BackColor=H8000000C
HasDC=0'False
Height=1695
Left=2520
ScaleHeight=109
ScaleMode=3'Pixel
ScaleWidth=117
TabIndex=8
TabStop=0'False
Top=840
Width=1815
Begin VB.PictureBox PicDest
AutoRedraw=-1'True
BackColor=H00FFFFFF
BorderStyle=0'None
Height=495
Left=240
ScaleHeight=33
ScaleMode=3'Pixel
ScaleWidth=65
TabIndex=9
TabStop=0'False
Top=360
Width=975
End
End
Begin VB.PictureBox PicClipS
BackColor=H8000000C
HasDC=0'False
Height=1575
Left=360
ScaleHeight=101
ScaleMode=3'Pixel
ScaleWidth=101
TabIndex=7
TabStop=0'False
Top=840
Width=1575
Begin VB.Image ImgSrc
Height=855
Left=240
Top=240
Width=855
End
End
Begin VB.PictureBox PicToolBar
Align=1'Align Top
HasDC=0'False
Height=495
Left=0
ScaleHeight=29
ScaleMode=3'Pixel
ScaleWidth=363
TabIndex=0
TabStop=0'False
Top=0
Width=5505
Begin VB.CommandButton CmdReset
Caption="复位"
Height=255
Left=3960
TabIndex=6
Top=120
Width=780
End
Begin VB.CommandButton CmdMake
Caption="生成"
Height=255
Left=3120
TabIndex=5
Top=120
Width=780
End
Begin VB.TextBox TxtHeight
Height=270
Left=2280
TabIndex=4
Text="Text1"
Top=120
Width=750
End
Begin VB.TextBox TxtWidth
Height=270
Left=720
TabIndex=2
Text="Text1"
Top=120
Width=750
End
Begin VB.Label LblHeight
AutoSize=-1'True
Caption="Height:"
Height=180
Left=1680
TabIndex=3
Top=120
Width=630
End
Begin VB.Label LblWidth
AutoSize=-1'True
Caption="Width:"
Height=180
Left=120
TabIndex=1
Top=120
Width=540
End
End
Begin VB.Menu mnuFile
Caption="文件(F)"
Begin VB.Menu mnuOpen
Caption="打开(O)..."
End
Begin VB.Menu mnuSave
Caption="保存(S)..."
End
Begin VB.Menu mnuSep0_0
Caption="-"
End
Begin VB.Menu mnuExit
Caption="退出(X)"
End
End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const CtlSpace = 4'控件之间的距离
Private Sub CmdMake_Click()
Dim nWidthAs Long
Dim nHeightAs Long
'得到数值
On Error GoTo ErrNum
nWidth = CLng(TxtWidth.Text)
nHeight = CLng(TxtHeight.Text)
On Error GoTo 0
If nWidth1 Or nHeight1 Then GoTo ErrNum
'改变大小
On Error GoTo ErrSetSize
PicDest.Move 0, 0, nWidth, nHeight
On Error GoTo 0
'取消PictureBox的缓存
Set PicDest.Picture = Nothing
'绘制图像
PicDest.PaintPicture ImgSrc, 0, 0, PicDest.ScaleWidth, PicDest.ScaleHeight
Exit Sub
ErrNum:
MsgBox "错误的数值！", vbCritical
Exit Sub
ErrSetSize:
MsgBox "无法创建这么大的图片！", vbCritical
Exit Sub
End Sub
Private Sub CmdReset_Click()
If ImgSrc.Picture.Type = vbPicTypeNone Then'无图片
TxtWidth.Text = CStr(1)
TxtHeight.Text = CStr(1)
CmdMake.Enabled = False
Else
TxtWidth.Text = CStr(ImgSrc.Width)
TxtHeight.Text = CStr(ImgSrc.Height)
CmdMake.Enabled = True
Call CmdMake_Click
End If
End Sub
Private Sub Form_Load()
'--初始化坐标定位
Dim SM_MeAs Long
Dim SM_TbrAs Long
Dim nTempAs Long
SM_Me = Me.ScaleMode
SM_Tbr = PicToolBar.ScaleMode
'定位PicToolBar的高度
With PicToolBar
'计算边框大小
nTemp = Me.ScaleY(.Height, SM_Me, vbPixels) - .ScaleY(.ScaleHeight, SM_Tbr, vbPixels)
'计算PicToolBar应有高度
nTemp = nTemp.ScaleY(TxtWidth.Height, SM_Tbr, vbPixels)
'设置高度
.Height = Me.ScaleY(nTemp, vbPixels, SM_Me)
End With
'定位PicToolBar内的控件
nTemp = PicToolBar.ScaleHeight
LblWidth.Move CtlSpace, (nTemp - LblWidth.Height) / 2
TxtWidth.Move LblWidth.LeftLblWidth.Width, 0
LblHeight.Move TxtWidth.LeftTxtWidth.WidthCtlSpace, (nTemp - LblWidth.Height) / 2
TxtHeight.Move LblHeight.LeftLblHeight.Width, 0, TxtHeight.Width, TxtWidth.Height
CmdMake.Move TxtHeight.LeftTxtHeight.WidthCtlSpace, 0, CmdMake.Width, TxtWidth.Height
CmdReset.Move CmdMake.LeftCmdMake.WidthCtlSpace, 0, CmdReset.Width, TxtWidth.Height
ImgSrc.Move 0, 0
PicDest.Move 0, 0
'--设置数值
Call CmdReset_Click
With CDlgFile
【vb.net压缩图片 vba压缩图片】.CancelError = True
.Flags = cdlOFNOverwritePrompt Or cdlOFNHideReadOnly
.Filter = "Windows位图(*.bmp)|*.bmp|所有文件(*.*)|*.*"
End With
End Sub
Private Sub Form_Resize()
If Me.WindowState = 1 Then Exit Sub
On Error Resume Next
Dim nTempAs Long
nTemp = PicToolBar.Height
PicClipS.Move 0, nTemp, Me.ScaleWidth / 2, Me.ScaleHeight - nTemp
PicClipD.Move PicClipS.Width, nTemp, Me.ScaleWidth - PicClipS.Width, PicClipS.Height
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuOpen_Click()
On Error Resume Next
CDlgFile.ShowOpen
If Err.Number Then Exit Sub'点了取消
'打开
Set ImgSrc.Picture = LoadPicture(CDlgFile.FileName)
If Err.Number Then
MsgBox "无法打开文件！", vbCritical
Exit Sub
End If
On Error GoTo 0
Call CmdReset_Click
End Sub
Private Sub mnuSave_Click()
On Error Resume Next
CDlgFile.ShowSave
If Err.Number Then Exit Sub'点了取消
'保存
SavePicture PicDest.Image, CDlgFile.FileName
If Err.Number Then
MsgBox "无法保存图片！", vbCritical
Exit Sub
End If
On Error GoTo 0
End Sub
求大神指点 vb.net 怎么把本地图像压缩 怎 后 在转换到 MemoryStream里面呢?Dim s As New MemoryStream()
Dim pic As New Bitmap("c:\AeroSnap截图1.bmp")
Dim SngPer As Single = 2 / 10
Dim PicOld As Image = pic
Dim PicNew As New System.Drawing.Bitmap(PicOld, PicOld.Width * SngPer, PicOld.Height * SngPer)
PicNew.Save(s, Drawing.Imaging.ImageFormat.Jpeg)
s.Seek(0,SeekOrigin.Begin)
VB.net 读取GZ压缩文件只能先解压再读取吗?手机敲很累的！一定要给分?。「袷绞牵簍ar
选项
文件.选项有
-c:产生打包文件
-v:显示详细信息
-f:指定压缩后的文件名
-z:打包同时压缩！举个例子吧！将目录my打包并压缩成my.tar.gz就这样tar
-zcvf
my.tar.gz
my
asp.net如何实现 图片压缩（vb.net）'''''''''''''''tosmallimg.aspx''
%@ Page Language="VB" AutoEventWireup="false" CodeFile="tosmallpic.aspx.vb" Inherits="tosmallpic" %
%@ OutputCache Duration="86400" VaryByParam="*" %
!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" ""
html xmlns=""
head runat="server"
title无标题页/title
/head
body
form id="form1" runat="server"
div
/div
/form
/body
/html
'''''''''''''''tosmallimg.aspx.vb''
Imports System.Drawing, System.Drawing.Imaging, System.Drawing.Drawing2D
Partial Class tosmallpic
Inherits System.Web.UI.Page
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim width As Int16 = CInt(My.Request.QueryString("width"))
Dim height As Int16 = CInt(My.Request.QueryString("height"))
Dim url As String = My.Request.QueryString("url")
If Not System.IO.File.Exists(Server.MapPath(url)) Then
Response.Redirect("img/default.jpg")
Response.End()
End If
Dim img As Image = Image.FromFile(Server.MapPath(url))
If width = 0 And height0 Then
width = height * img.Width / img.Height
ElseIf height = 0 Then
height = width * img.Height / img.Width
End If
If widthimg.Width Then Response.Redirect(url)
Dim bmp As New Bitmap(width, height)
Dim gr As Graphics = Graphics.FromImage(bmp)
gr.Clear(Color.Transparent)
'gr.SmoothingMode = SmoothingMode.AntiAlias
Dim rct As New Rectangle(0, 0, width, height)
gr.DrawImage(img, New Rectangle(0, 0, width, height), New Rectangle(0, 0, img.Width, img.Height), GraphicsUnit.Pixel)
Response.Clear()
Response.ContentType = "image/jpeg"
bmp.Save(Response.OutputStream, ImageFormat.Jpeg)
End Sub
End Class
介绍下我的blog
vb.net压缩图片的介绍就聊到这里吧 ， 感谢你花时间阅读本站内容，更多关于vba压缩图片、vb.net压缩图片的信息别忘了在本站进行查找喔 。

    推荐阅读


    上一篇：gis效果图层，arcgis 图层

    下一篇：如何启动dcom服务器？ dcom服务器怎么开启