將圖像的像素由原來的1000*600縮小到500*300

本站我搜索了一下也沒有找到這樣的程序例子.用panitpicture方法只會將圖的一部份存起來,達不到目的.
=================================别在同一个PictureBox中panitpicture！
将图像panitpicture到另一个PictureBox去
而且两者的AutoRedraw必须设为True（AutoRedraw=False时是在屏幕上画的，会被剪裁）
至于保存JPEG：
http://community.csdn.net/Expert/topic/3209/3209104.xml?temp=.9472772
★　完整的JPEG保存程序与高速在网络上传输图像程序

難道這樣問題也算難嗎?
-------------------
是因为你现在的编程功力不够
某些东西不敢跟你说比如：利用插值算法实现图像的平滑缩放
讨论：http://search.csdn.net/Expert/topic/1183/1183347.xml?temp=.5059931
下载：http://www.aivisoft.net/Zyl910/zScale.zip

图像缩放程序的层次：1：用PaintPicture缩放
2：用StretchBlt缩放
3：知道图像缩放原理，用SetPixelV逐点逐点算，速度非常慢
4：使用DIB图像处理技术加快图像处理速度，比3快70~100倍
5：考虑特殊CPU指令集优化算法，如MMX、3DNow!、SSE、SEE2等
楼主现在处于第一层次学习阶段

請勿進行人身功擊!!!!!!!!!!!!!!!!!!!!!!!做人的最起碼的道理.雖然你的回答是我所想要的.但你的回答讓人非常的不快.zyl910:現在處於經歷社會的第一層次學階段中,請先學會怎樣做人.(高手和菜鳥之間的差距是菜鳥起步的階段高手同樣走過,請不要回關笑你的過去)不過還是很謝謝你.

用StretchBlt缩放
api申明里有

注意：
PicClipD的ScaleMode=vbPixels
源图像是ImgSrc
目的图像是PicDest，注意它的属性
最关键的实现过程在CmdMake_Click
将下列内容复制到记事本，并保存为相应的文件
PicScale.vbp
--------------------
Type=Exe
Form=FrmMain.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\SYSTEM\STDOLE2.TLB#OLE Automation
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX
Startup="FrmMain"
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=1FrmMain.frm
----------------------------------
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmMain
   Caption         =   "简单图像文件缩放"
   ClientHeight    =   3195
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4680
   HasDC           =   0   'False
   LinkTopic       =   "Form1"
   ScaleHeight     =   213
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   312
   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      =   308
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   0
      Width           =   4680
      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 ExplicitPrivate Const CtlSpace = 4 '控件之间的距离Private Sub CmdMake_Click()
    Dim nWidth As Long
    Dim nHeight As Long

    '得到数值
    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 "错误的数值！", vbCritical
    Exit SubErrSetSize:
    MsgBox "无法创建这么大的图片！", vbCritical
    Exit SubEnd SubPrivate 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 SubPrivate Sub Form_Load()
    '-- 初始化坐标定位
    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应有高度
        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.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

    '--设置数值
    Call CmdReset_Click

    With CDlgFile
        .CancelError = True
        .Flags = cdlOFNOverwritePrompt Or cdlOFNHideReadOnly
        .Filter = "Windows位图(*.bmp)|*.bmp|所有文件(*.*)|*.*"
    End With

End SubPrivate 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 SubPrivate Sub mnuExit_Click()
    Unload Me
End SubPrivate 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 SubPrivate 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

唉。。原来是这么的easy!!!晕啊跳楼好了。

调试易

將圖像的像素由原來的1000600縮小到500300

解决方案 »