怎样用vb做一个图片放大器？
设计一个图片放大器，拖动图片放大器，可以将图片放大器经过的图片区域放大，例如1.5倍。
2．解决方案：
设计一个界面，添加三个按钮、两个PictureBox和一个CommonDialog。其中一个按钮name为cmdOpen用于打开图片，另一个name为cmdMagnification用于显示放大器，第三个name为cmdExit即退出按钮；两个PictureBox中尺寸大name为pic1的为加载的图片，尺寸小name为pic2的为放大器。程序的运行过程是先用cmdOpen打开一幅图片，点击cmdMagnification显示图片放大器，左键拖动图片放大器可实现放大功能。
四、主要技术问题的描述
在这里有三个关键的问题：
1、窗体的大小随着打开的图片的大小而改变，窗体上的控件的位置也要相应改变；
如Me.Height = pic1.Height + 800
2、CommonDialog的使用；
3、放大镜的实现，其实是将pic1的部分图片绘制到pic2,并改变其尺寸，所用的是PictureBox的PaintPicture 和 Move 方法。
追问：409886296，家乡情 太谢谢你了
答案：你给我qq吧 我给你发过去
代码比较多
我可以给你源程序
Option Explicit
Private Type FormPosition
Left As Long
Top As Long
Width As Long
Height As Long
Maxed As Boolean
End Type
'sDefInitFileName is setup as (AppPath\AppEXEName.Ini)
'and is used as the Default Initialization Filename
Private sDefInitFileName As String
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Sub AddRecentFile(ByVal sNewFileName As String, mnuRecent As Variant, Optional ByVal iMaxEntries As Integer = 8, Optional ByVal iMaxFileNameLen As Integer = 60)
Dim lRet As Long
Dim iArrayCnt As Integer
Dim iFileCnt As Integer
Dim sFilename As String
Dim saFiles() As String
ReDim saFiles(iMaxEntries)
'Add New File at First Position
saFiles(0) = sNewFileName
'Get all Files in Init File
iFileCnt = 1
sFilename = GetInitEntry("Recent Files", "File " & CStr(iFileCnt), "")
While Len(sFilename) > 0 And iArrayCnt < iMaxEntries
'Don't get New File Again
If LCase$(sFilename) <> LCase$(sNewFileName) Then
iArrayCnt = iArrayCnt + 1
saFiles(iArrayCnt) = sFilename
End If
iFileCnt = iFileCnt + 1
sFilename = GetInitEntry("Recent Files", "File " & CStr(iFileCnt), "")
Wend
'Release Excess Memory
ReDim Preserve saFiles(iArrayCnt)
'Clean up the Init File (Deletes the Entire "Recent Files" Section)
lRet = SetInitEntry("Recent Files")
'Put Files Back Into Init File in Their New Order
For iFileCnt = 0 To iArrayCnt
lRet = SetInitEntry("Recent Files", "File " & CStr(iFileCnt + 1), saFiles(iFileCnt))
Next iFileCnt
'Retrieve Ordered Files Back Into Menu
Call GetRecentFiles(mnuRecent, iMaxEntries, iMaxFileNameLen)
'Checkmark First Recent File
mnuRecent(0).Checked = (mnuRecent(0).Caption <> "(Empty)")
End Sub
Public Sub GetRecentFiles(mnuRecent As Variant, Optional ByVal iMaxEntries As Integer = 8, Optional ByVal iMaxFileNameLen As Integer = 60)
'mnuRecent Must Be a Menu Array. At Design Time, create
'the first mnuRecent(0) with the Caption set to "(Empty)"
'and Disable it.
Dim iIdx As Integer
Dim iFileCnt As Integer
Dim iFullCnt As Integer
Dim iMenuCnt As Integer
Dim sFilename As String
On Error GoTo LocalError
'Get the Menu Count
iMenuCnt = mnuRecent.UBound
'Unload all but first Menu
For iIdx = 1 To iMenuCnt
Unload mnuRecent(iIdx)
Next iIdx
mnuRecent(0).Checked = False
mnuRecent(0).Tag = ""
mnuRecent(0).Enabled = False
.Text) / 100)
'Update the scrollbar (only fires change event if value changes).
hsbZoom.Value = mfScale * 100
'Update the textbox in case the scrollbar change event didn't fire.
txtZoom.Text = Format$(mfScale, "####%")
End Sub其他：这个呢，复杂的话可能要设计图像放大插值的问题，不过相信MS已经有现成的函数供调用了，所以你只用解决的就是，
1 窗体的大小的重绘，打开图像的时候获得图像的尺寸，然后按比例重绘窗体和控件，2 对话框的使用直接在百度里搜索代码，改下即可，因为用法几乎都一样，3 放大镜的实现，用鼠标在pic1上计算一个矩形区域（一般以鼠标为矩形中心），将矩形内的图像保存到内存中，在内存中对其进行缩放后在pic2中进行显示， 首先：做准备工作：在FORM1上新建一个PICTURE1（并装载一幅你喜爱的图像）和两个COMMAND命令按钮在PICTURE1下面（即COMMAND1和COMMAND2），其他属性不变，然后输入以下代码：
Private Sub Form_Load()//初始化设置
Picture1.AutoSize = True
Command1.Caption = ″显示网格″
Command2.Caption = ″取消网格″
Form1.Caption = ″显示网格图像演示程序″
End Sub
－－－－－－－－－－－－－－－－
Private Sub Form_Activate()//设置网格颜色
Picture1.ForeColor = vbWhite
Picture1.Move 0, 0
End Sub
－－－－－－－－－－－－－－－－
Private Sub Command1_Click()//显示网格
Dim HLINESNUM As Integer
Dim WLINESNUM As Integer
Dim XX As Integer
Dim I As Integer
Dim J As Integer
Dim YY As Integer
HLINESNUM = 15 //设置网格为15＊15显示
WLINESNUM = 15
Picture1.Refresh
Picture1.AutoRedraw = False
XX = Int(Picture1.ScaleWidth / WLINESNUM)
YY = Int(Picture1.ScaleHeight / HLINESNUM)
For I = 1 To HLINESNUM ＋ 1
Picture1.Line (XX ＊ I, 0)－(XX ＊ I, Picture1.Height － 1)
Picture1.Line (0, YY ＊ I)－(Picture1.Width － 1, YY ＊ I)
Next
End Sub
－－－－－－－－－－－－
Private Sub Command2_Click()//取消网格
Picture1.AutoRedraw = False
Picture1.Refresh
End Sub
－－－－－－－－－－－－
Private Sub Form_Unload(Cancel As Integer)
Unload Me //结束程序
End
End Sub
上一个：vb2005中在textbox中回车怎么会“咚”的一声？
下一个：vb 时间录入 VB中怎样在text输入时间（如1991-1-1），使这个时间录入数据库 。谢谢
