当前位置:我的异常网» VB » 怎么让放进的图片随框大小而变

怎么让放进的图片随框大小而变

www.myexceptions.net  网友分享于：2013-01-30  浏览：6次

如何让放进的图片随框大小而变

有一个图片,可以随进放进新图片,替换旧图图片,但问题是放进的新图片无法随原框的大小,而放不满一个框或比框大.

那位能将下面的代码改一下,要求不论原图多大,放进此框后,都要随此框大小相应放大或缩小:

原代码如下:

提示:在窗体上有二个按钮(放进图片和保存图片),另要引进一个CommonDialog控件.

Dim   OpenFileName   As   String

Private   Reg

Private   Sub   Command1_Click()

On   Error   Resume   Next

CommonDialog1.DialogTitle   =   "放进新图片 "

CommonDialog1.Filter   =   "所有支持的格式 "   +   _

"(*.bmp;*.jpg;*.gif;*.pcx;*.ico)| "   +   _

"*.bmp;*.jpg;*.gif;*.pcx;*.ico) "

CommonDialog1.ShowOpen

If   CommonDialog1.FileName   <>   " "   Then

If   Err   <>   32755   Then

OpenFileName   =   CommonDialog1.FileName

Picture1.Picture   =   LoadPicture(OpenFileName)

End   If

End   If

End   Sub

Private   Sub   Command2_Click()

Call   Reg.RegWrite( "HKLM\SOFTWARE\PIC\Lj ",   OpenFileName,   "REG_SZ ")   '保存新图片

End   Sub

Private   Sub   Form_Load()

On   Error   Resume   Next

Set   Reg   =   New   IWshShell_Class

If   Reg.RegRead( "HKLM\SOFTWARE\PIC\Lj ")   =   " "   Then

Exit   Sub

End   If

Picture1.Picture   =   LoadPicture(Reg.RegRead( "HKLM\SOFTWARE\PIC\Lj "))

CommonDialog1.CancelError   =   True

End   Sub

------解决方案--------------------

Option Explicit

Private Reg As Object, strPicPath$, blnDefaultDirty As Boolean

Private Sub Command1_Click()

On Error Resume Next

CommonDialog1.CancelError = True

CommonDialog1.DialogTitle = "放进新图片 "

CommonDialog1.Filter = "所有支持的格式 " + _

"(*.bmp;*.jpg;*.gif;*.pcx;*.ico)| " + _

"*.bmp;*.jpg;*.gif;*.pcx;*.ico) "

CommonDialog1.ShowOpen

If CommonDialog1.FileName <> " " Then

If Err <> 32755 Then

strPicPath = CommonDialog1.FileName

Image1.Picture = LoadPicture(strPicPath)

blnDefaultDirty = True '用于退出时提醒用户是否保存为默认

End If

End If

End Sub

Private Sub Command2_Click()

Reg.RegWrite "HKLM\SOFTWARE\PIC\Lj ", strPicPath, "REG_SZ " '保存新图片

If Err = 0 Then MsgBox "设置成功！ ", 64, "恭喜 " Else MsgBox "设置失败！ ", 48, "糟糕 "

If blnDefaultDirty Then blnDefaultDirty = False

End Sub

Private Sub Form_Load()

On Error Resume Next

文章评论