首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

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

2012-01-29 
如何让放进的图片随框大小而变有一个图片,可以随进放进新图片,替换旧图图片,但问题是放进的新图片无法随原

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

热点排行