我想用VB寫一個壓縮圖片的程序，應(yīng)該怎么寫

如果你是僅僅為了壓縮，而不是為了編程，你可以用ACDSee，他可以批量操作，方法是在ACDSee中選擇你需要壓縮的全部文件，點 工具 調(diào)整大小 選項很明顯，你試一試。

創(chuàng)新互聯(lián)是一家專業(yè)提供蒼溪企業(yè)網(wǎng)站建設(shè),專注與成都網(wǎng)站建設(shè)、網(wǎng)站制作、HTML5、小程序制作等業(yè)務(wù)。10年已為蒼溪眾多企業(yè)、政府機構(gòu)等服務(wù)。創(chuàng)新互聯(lián)專業(yè)網(wǎng)站建設(shè)公司優(yōu)惠進行中。

你非要用程序的話，看看一下參考

注意：

PicClipD的ScaleMode=vbPixels

源圖像是ImgSrc

目的圖像是PicDest，注意它的屬性

最關(guān)鍵的實現(xiàn)過程在CmdMake_Click

將下列內(nèi)容復(fù)制到記事本，并保存為相應(yīng)的文件

PicScale.vbp

--------------------

Type=Exe

Form=FrmMain.frm

Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\WINDOWS\system32\stdole2.tlb#OLE Automation

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 = "復(fù)位"

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 nWidth As Long

Dim nHeight As Long

'得到數(shù)值

On Error GoTo ErrNum

nWidth = CLng(TxtWidth.Text)

nHeight = CLng(TxtHeight.Text)

On Error GoTo 0

If nWidth 1 Or nHeight 1 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 "錯誤的數(shù)值！", vbCritical

Exit Sub

ErrSetSize:

MsgBox "無法創(chuàng)建這么大的圖片！", 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()

'-- 初始化坐標(biāo)定位

Dim SM_Me As Long

Dim SM_Tbr As Long

Dim nTemp As 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應(yīng)有高度

nTemp = nTemp + .ScaleY(TxtWidth.Height, SM_Tbr, vbPixels)

'設(shè)置高度

.Height = Me.ScaleY(nTemp, vbPixels, SM_Me)

End With

'定位PicToolBar內(nèi)的控件

nTemp = PicToolBar.ScaleHeight

LblWidth.Move CtlSpace, (nTemp - LblWidth.Height) / 2

TxtWidth.Move LblWidth.Left + LblWidth.Width, 0

LblHeight.Move TxtWidth.Left + TxtWidth.Width + CtlSpace, (nTemp - LblWidth.Height) / 2

TxtHeight.Move LblHeight.Left + LblHeight.Width, 0, TxtHeight.Width, TxtWidth.Height

CmdMake.Move TxtHeight.Left + TxtHeight.Width + CtlSpace, 0, CmdMake.Width, TxtWidth.Height

CmdReset.Move CmdMake.Left + CmdMake.Width + CtlSpace, 0, CmdReset.Width, TxtWidth.Height

ImgSrc.Move 0, 0

PicDest.Move 0, 0

'--設(shè)置數(shù)值

Call CmdReset_Click

With CDlgFile

.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 nTemp As 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 如何壓縮、解壓縮文件

1、你先搞懂 winrar.exe 的解壓參數(shù)格式，然后把winrar.exe和相關(guān)文件加入到資源文件中，然后調(diào)用 資源文件中的winrar.exe

2、弄明白rar/zip文件解壓/壓縮方法和格式，自己寫程序 (可能會比較麻煩)

求大神指點 vb.net 怎么把本地圖像壓縮 怎 后 在轉(zhuǎn)換到 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)

如何壓縮數(shù)碼照片？

用ACDsee

步驟很簡單

用這個軟件打開照片后 選擇文件→另存為→選項里面把品質(zhì)調(diào)低就好了 一般別調(diào)的太低就看不出有什么差別 但是打印出來就能看出差別來了

求軟件壓縮工具，本人是學(xué)VB.NET的，現(xiàn)在做了一個軟件想把它壓縮成.exe文件

那不是壓縮，是編譯，默認(rèn)是debug模式，編譯生成后會在bin里的debug里，如果選擇release模式，會生成到bin里的release里。

想要安裝文件，不需要其它工具，在VS里你就可以新建一個安裝項目，然后把編譯好的文件加入進來，會自動檢查依賴的文件，然后生成一下，就會在安裝項目文件夾里的bin/release或debug生成你要的安裝文件。

asp.net如何實現(xiàn) 圖片壓縮（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無標(biāo)題頁/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 height 0 Then

width = height * img.Width / img.Height

ElseIf height = 0 Then

height = width * img.Height / img.Width

End If

If width img.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

網(wǎng)站名稱：vb.net壓縮圖片 net 圖片壓縮
URL網(wǎng)址：http://jinyejixie.com/article48/hpcphp.html

成都網(wǎng)站建設(shè)公司_創(chuàng)新互聯(lián)，為您提供App開發(fā)、面包屑導(dǎo)航、企業(yè)建站、網(wǎng)站設(shè)計公司、品牌網(wǎng)站制作、外貿(mào)建站

廣告

聲明：本網(wǎng)站發(fā)布的內(nèi)容（圖片、視頻和文字）以用戶投稿、用戶轉(zhuǎn)載內(nèi)容為主，如果涉及侵權(quán)請盡快告知，我們將會在第一時間刪除。文章觀點不代表本網(wǎng)站立場，如需處理請聯(lián)系客服。電話：028-86922220；郵箱：631063699@qq.com。內(nèi)容未經(jīng)允許不得轉(zhuǎn)載，或轉(zhuǎn)載時需注明來源： 創(chuàng)新互聯(lián)