如何让放进的图片随框大小而变
有一个图片,可以随进放进新图片,替换旧图图片,但问题是放进的新图片无法随原框的大小,而放不满一个框或比框大.
那位能将下面的代码改一下,要求不论原图多大,放进此框后,都要随此框大小相应放大或缩小:
原代码如下:
提示:在窗体上有二个按钮(放进图片和保存图片),另要引进一个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

Image1.Stretch = True
Command1.Caption = "换图片 "
Command2.Caption = "设为默认 "

Set Reg = CreateObject( "Wscript.Shell ")
strPicPath = Reg.RegRead( "HKLM\SOFTWARE\PIC\Lj ")

If Len(strPicPath) = 0 Then Exit Sub

Image1.Picture = LoadPicture(strPicPath)
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If blnDefaultDirty Then
If (MsgBox( "你需要将当前图片设置为默认背景吗？ ", 64 + vbYesNo, "提示 ")) = 6 Then
Command2_Click
End If
End If
Set Reg = Nothing
strPicPath = " "
End Sub

=============================================
以上代码 VB6+XP SP2测试通过