浏览器

开发平台：
Visual Basic

cScaleWebImage.cls：源码内容
							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cScaleWebImage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private WithEvents mWin As MSHTML.HTMLWindow2
Attribute mWin.VB_VarHelpID = -1
Private mDoc As MSHTML.HTMLDocument
Private WithEvents mFrm As Form
Attribute mFrm.VB_VarHelpID = -1
Private WithEvents mCmd As CommandButton
Attribute mCmd.VB_VarHelpID = -1
Private mOverCommand As Boolean
Private mAutoSize As Boolean
Private oImgW&, oImgH&
Public Sub DefaultSub()
Attribute DefaultSub.VB_UserMemId = 0
Debug.Print mWin.event.Type
Select Case mWin.event.Type
    Case "mouseout"
        If Not mOverCommand Then mCmd.Visible = False
    Case "mouseover"
        If mAutoSize Then
            mOverCommand = False
            mCmd.Visible = True
        Else
            If mDoc.body.scrollHeight > mDoc.body.clientHeight Or _
                mDoc.body.scrollWidth > mDoc.body.clientWidth Then
                    mOverCommand = False
                    mCmd.Visible = True
            End If
        End If
End Select
End Sub
Public Sub IniMe(nDoc As MSHTML.HTMLDocument, nfrm As Form)
Set mDoc = nDoc
Set mWin = mDoc.parentWindow
Set mFrm = nfrm
Set mCmd = mFrm.cmdScale
mCmd.Picture = ScaleBtnImg2
mCmd.ToolTipText = "将图片尺寸调整到窗口大小"
oImgW = mDoc.images(0).Width
oImgH = mDoc.images(0).Height
End Sub
Private Sub Class_Initialize()
mOverCommand = False
mAutoSize = False
End Sub
Private Sub mCmd_Click()
Dim tImg As MSHTML.HTMLImg
mAutoSize = Not mAutoSize
If mAutoSize Then
    mCmd.Picture = ScaleBtnImg1
    mCmd.ToolTipText = "扩展为常规大小"
    Call SizeImage
   
Else
    mCmd.Picture = ScaleBtnImg2
    mCmd.ToolTipText = "将图片尺寸调整到窗口大小"
    Set tImg = mDoc.images(0)
    tImg.clearAttributes
End If
End Sub
Private Sub mcmd_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
mOverCommand = True
End Sub
Private Sub SizeImage()
On Error GoTo due
Dim tImgW&, tImgH&, tBdW&, tBdH&
Dim nImgW&, nImgH&
Dim tImg As MSHTML.HTMLImg, tBd As MSHTML.HTMLBody
Dim tRate As Single
If mAutoSize Then
    Set tBd = mDoc.body
    If Not tBd Is Nothing Then
        Set tImg = mDoc.images(0)
        If Not tImg Is Nothing Then
            tImgW = tImg.Width: tImgH = tImg.Height
            tBdW = tBd.clientWidth: tBdH = tBd.clientHeight
            
            tRate = tImgW / tImgH
            If tRate <= tBdW / tBdH Then
                nImgH = tBdH - tBd.topMargin - tBd.bottomMargin
                If nImgH > oImgH Then nImgH = oImgH
                tImg.Height = nImgH
                tImg.Width = tImg.Height * tRate
            Else
                nImgW = tBdW - tBd.leftMargin - tBd.rightMargin
                If nImgW > oImgW Then nImgW = oImgW
                tImg.Width = nImgW
                tImg.Height = tImg.Width / tRate
            End If
            
            
        End If
    End If
End If
Exit Sub
due:
    MsgBox Err.Description
End Sub
Private Sub mWin_onresize()
Call SizeImage
End Sub

						