社区
VB基础类
帖子详情
將圖像的像素由原來的1000*600縮小到500*300
Hideal
2004-08-27 02:33:13
將jpg圖像的像素由原來的1000*600縮小到500*300,然後另存一個文件.如果可以設置它的質量那就最好了.
本站我搜索了一下也沒有找到這樣的程序例子.用panitpicture方法只會將圖的一部份存起來,達不到目的.
難道這樣問題也算難嗎?
...全文
197
11
打赏
收藏
將圖像的像素由原來的1000*600縮小到500*300
將jpg圖像的像素由原來的1000*600縮小到500*300,然後另存一個文件.如果可以設置它的質量那就最好了. 本站我搜索了一下也沒有找到這樣的程序例子.用panitpicture方法只會將圖的一部份存起來,達不到目的. 難道這樣問題也算難嗎?
复制链接
扫一扫
分享
转发到动态
举报
写回复
配置赞助广告
用AI写文章
11 条
回复
切换为时间正序
请发表友善的回复…
发表回复
打赏红包
zyl910
2004-08-28
打赏
举报
回复
Option Explicit
Private 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 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_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 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
zyl910
2004-08-28
打赏
举报
回复
注意:
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=1
FrmMain.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
zyl910
2004-08-28
打赏
举报
回复
我并不是想人身攻击
我只是想让楼主见识一下现在技术的发展层次
别被教科书迷惑了
我原来也对这这些超过自身层次的东西很反感
但现在仔细看了一下数学与物理学的发展后
我感觉自己以及某些人真的很肤浅:
比如某些人说现在数学与物理学没有发展
这实际上是现在数学与物理学发展的太快,已经超过普通人认识的层次
这就像我们还在地球上,太阳的光芒(学校教育)把一切遮盖住了,不知道现在的研究已经到了河外星系
大学数学算什么
微积分只是现在数学的基础
而且大学教的还是初等微积分
Hideal
2004-08-28
打赏
举报
回复
承認你是高手,本人無地自容.
xxfeiyu
2004-08-28
打赏
举报
回复
用StretchBlt缩放
api申明里有
Hideal
2004-08-28
打赏
举报
回复
請勿進行人身功擊!!!!!!!!!!!!!!!!!!!!!!!
做人的最起碼的道理.
雖然你的回答是我所想要的.但你的回答讓人非常的不快.
zyl910:現在處於經歷社會的第一層次學階段中,請先學會怎樣做人.(高手和菜鳥之間的差距是菜鳥起步的階段高手同樣走過,請不要回關笑你的過去)
不過還是很謝謝你.
zyl910
2004-08-28
打赏
举报
回复
图像缩放程序的层次:
1:用PaintPicture缩放
2:用StretchBlt缩放
3:知道图像缩放原理,用SetPixelV逐点逐点算,速度非常慢
4:使用DIB图像处理技术加快图像处理速度,比3快70~100倍
5:考虑特殊CPU指令集优化算法,如MMX、3DNow!、SSE、SEE2等
楼主现在处于第一层次学习阶段
Hideal
2004-08-28
打赏
举报
回复
唉。。原来是这么的easy!!!
晕啊。。。跳楼好了。。。。
zyl910
2004-08-28
打赏
举报
回复
難道這樣問題也算難嗎?
-------------------
是因为你现在的编程功力不够
某些东西不敢跟你说
比如:
利用插值算法实现图像的平滑缩放
讨论:http://search.csdn.net/Expert/topic/1183/1183347.xml?temp=.5059931
下载:http://www.aivisoft.net/Zyl910/zScale.zip
zyl910
2004-08-28
打赏
举报
回复
本站我搜索了一下也沒有找到這樣的程序例子.用panitpicture方法只會將圖的一部份存起來,達不到目的.
=================================
别在同一个PictureBox中panitpicture!
将图像panitpicture到另一个PictureBox去
而且两者的AutoRedraw必须设为True(AutoRedraw=False时是在屏幕上画的,会被剪裁)
至于保存JPEG:
http://community.csdn.net/Expert/topic/3209/3209104.xml?temp=.9472772
★ 完整的JPEG保存程序 与 高速在网络上传输图像程序
Hideal
2004-08-28
打赏
举报
回复
up
MATLAB图像处理
介绍MATLAB提供的图像处理功能,包括图像基础知识、图像合成、空间变换、邻域和块处理、局部滤波、正交变换、数学形态学、图像分析、图像增强、图像恢复、图像分割、图像配准和图像三维重建等内容。 所在套餐:...
matlab将一幅图像缩小,基于matlab的图像缩小算法
一、基于matlab图像缩小算法缩小算法与放大算法不同...这种算法是通过对图像
像素
的均匀采样来保持所选择的
像素
仍旧保持
像素
的概貌特征。算法1通过matlab实现可得:function small=big2small(A,h,l)[m,n]=size(A);k1...
【数字图像处理】MATLAB实现图像缩小的两种算法
1)基于
像素
采样的图像缩小方法: % function [im] = resize(I,kr,kc) % I = imread('img\han.jpg'); % [im1] = dip(I,0.3,0.5); function [im] = dip(I,kr,kc) [m,n,d] = size(I); % 得到原始图像尺寸 m2 = r...
OpenCV2:等间隔采样和局部均值的图像缩小
图像的缩小从物理意义上来说,就是将图像的每个
像素
的大小缩小相应的倍数。但是,改变
像素
的物理尺寸显然不是那么容易的,从数字图像处理的角度来看,图像的缩小实际就是通过减少
像素
个数来实现的。显而易见的,减少...
(三)图像的放大和缩小
当一个图像的大小增加之后,组成图像的
像素
的可见度将会变得更高,从而使得图像表现得“软”。相反地,缩小一个图像将会增强它的平滑度和清晰度。 二、图像的放大和缩小的基本原理 图像的放大和缩小的基本原理就是...
VB基础类
7,763
社区成员
197,609
社区内容
发帖
与我相关
我的任务
VB基础类
VB 基础类
复制链接
扫一扫
分享
社区描述
VB 基础类
社区管理员
加入社区
获取链接或二维码
近7日
近30日
至今
加载中
查看更多榜单
社区公告
暂无公告
试试用AI创作助手写篇文章吧
+ 用AI写文章