浏览器

开发平台：
Visual Basic

frmSlide.frm：源码内容
							VERSION 5.00
Begin VB.Form frmSlide 
   BorderStyle     =   0  'None
   ClientHeight    =   2805
   ClientLeft      =   105
   ClientTop       =   105
   ClientWidth     =   4275
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   2805
   ScaleWidth      =   4275
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.Frame fraHoldAll 
      BorderStyle     =   0  'None
      Caption         =   "Frame1"
      Height          =   2535
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3495
      Begin VB.CommandButton cmdAtuoFill 
         Caption         =   "&Auto"
         Height          =   300
         Left            =   2760
         TabIndex        =   14
         Top             =   1680
         Width           =   495
      End
      Begin VB.CommandButton cmdUrl 
         Caption         =   "&URL"
         Height          =   300
         Left            =   2760
         TabIndex        =   13
         Top             =   1200
         Width           =   495
      End
      Begin VB.TextBox txtSlideUrl 
         Appearance      =   0  'Flat
         Height          =   285
         Left            =   60
         OLEDropMode     =   1  'Manual
         TabIndex        =   4
         Top             =   840
         Width           =   3255
      End
      Begin VB.TextBox txtPos 
         Height          =   300
         Left            =   960
         TabIndex        =   7
         Top             =   1680
         Width           =   615
      End
      Begin VB.TextBox txtGap 
         Height          =   300
         Left            =   600
         TabIndex        =   5
         Top             =   1200
         Width           =   615
      End
      Begin VB.TextBox txtLen 
         Height          =   300
         Left            =   1920
         TabIndex        =   6
         Top             =   1200
         Width           =   615
      End
      Begin VB.CommandButton cmdGo 
         Caption         =   "转到(&T)"
         Height          =   300
         Left            =   1680
         TabIndex        =   10
         Top             =   1680
         Width           =   855
      End
      Begin VB.CommandButton cmdHideSetup 
         Caption         =   "关上(&C)"
         Height          =   315
         Left            =   2520
         TabIndex        =   3
         Top             =   60
         Width           =   855
      End
      Begin VB.CommandButton cmdNext 
         Caption         =   ">>"
         Height          =   375
         Left            =   900
         Style           =   1  'Graphical
         TabIndex        =   2
         Top             =   0
         Width           =   495
      End
      Begin VB.CommandButton cmdPre 
         Caption         =   "<<"
         Height          =   375
         Left            =   0
         Style           =   1  'Graphical
         TabIndex        =   1
         Top             =   0
         Width           =   495
      End
      Begin VB.Label Label1 
         Caption         =   "当前位置"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   120
         TabIndex        =   12
         Top             =   1680
         Width           =   735
      End
      Begin VB.Label Label2 
         Caption         =   "间隔"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   120
         TabIndex        =   11
         Top             =   1200
         Width           =   375
      End
      Begin VB.Label Label3 
         Caption         =   "长度"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Left            =   1440
         TabIndex        =   9
         Top             =   1200
         Width           =   375
      End
      Begin VB.Label lblSample 
         Caption         =   "Label4"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   9
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   60
         TabIndex        =   8
         Top             =   510
         Width           =   3315
      End
   End
   Begin VB.Menu mnuPopMain 
      Caption         =   "pop"
      Visible         =   0   'False
      Begin VB.Menu mnuALPHA 
         Caption         =   "透明度"
         Begin VB.Menu mnuALPHA_ss 
            Caption         =   ""
            Index           =   0
         End
      End
      Begin VB.Menu mnuPopMainSetup 
         Caption         =   "设置(&S)"
      End
      Begin VB.Menu mnuPopMainNone 
         Caption         =   "-"
      End
      Begin VB.Menu mnuPopMainHide 
         Caption         =   "隐藏(&H)"
      End
   End
End
Attribute VB_Name = "frmSlide"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Const SmallWidth As Single = 1395
Private Const SmallHeight As Single = 375
Private Const BigWidth As Single = 3495
Private Const BigHeight As Single = 2100
Private pX As Long, pY As Long
Private vTxtGap  As cNumberTextBox
Private vTxtLen As cNumberTextBox
Private vTxtPos As cNumberTextBox
Private Sub cmdAtuoFill_Click()
Dim tstr$, tVal&
tstr = txtSlideUrl.SelText
If tstr <> "" Then
    tVal = Val(tstr)
    txtSlideUrl.SelText = "(*)"
    txtLen.Text = Len(tstr)
    txtPos.Text = tVal
End If
End Sub
Private Sub cmdGo_Click()
If loadedBrowserCount > 0 Then
    Call GotoUrl(webbState(gActiveWebIndex).webForm, 0)
End If
End Sub
Private Sub cmdHideSetup_Click()
Call ShowSetup(False)
End Sub
Private Sub cmdNext_Click()
If loadedBrowserCount > 0 Then
    Call GotoUrl(webbState(gActiveWebIndex).webForm, 1)
End If
End Sub
Private Sub cmdPre_Click()
If loadedBrowserCount > 0 Then
    Call GotoUrl(webbState(gActiveWebIndex).webForm, -1)
End If
End Sub
Private Sub cmdUrl_Click()
If loadedBrowserCount > 0 Then
    txtSlideUrl.Text = webbState(gActiveWebIndex).webForm.GetWebUrl
End If
End Sub
Private Sub Form_Load()
Dim i&
Call ShowSetup(False)
With fraHoldAll
'    .Width = SmallWidth
 '   .Height = SmallHeight
    .ToolTipText = "右键点击"
End With
'Me.Width = SmallWidth
'Me.Height = SmallHeight
lblSample.Caption = "例如:http://sample.net/sample(*).htm"
mnuALPHA.Enabled = IsWin2k
For i = 1 To 10
Load mnuALPHA_ss(i)
mnuALPHA_ss(i).Caption = LTrim(Str((11 - i) * 10)) & "%"
mnuALPHA_ss(i).Visible = True
Next i
mnuALPHA_ss(1).Checked = True
mnuALPHA_ss(0).Visible = False
Set vTxtGap = New cNumberTextBox
vTxtGap.NumberTextBox = txtGap
Set vTxtLen = New cNumberTextBox
vTxtLen.NumberTextBox = txtLen
Set vTxtPos = New cNumberTextBox
vTxtPos.NumberTextBox = txtPos
End Sub
Private Sub fraholdall_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
    pX = X
    pY = Y
End If
End Sub
Private Sub fraholdall_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
    Me.Move Me.Left + X - pX, Me.Top + Y - pY
End If
End Sub
Private Sub fraholdall_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
    Me.PopupMenu mnuPopMain
End If
End Sub
Private Sub mnuPopMainHide_Click()
Me.Hide
'gMainForm.mnuViewSlide.Checked = False
End Sub
Private Sub mnuPopMainSetup_Click()
Call ShowSetup(True)
End Sub
Private Sub mnuALPHA_ss_Click(index As Integer)
Dim i&, tAl&
For i = 1 To 10
mnuALPHA_ss(i).Checked = False
Next i
mnuALPHA_ss(index).Checked = True
tAl = CLng((11 - index) * 25.5)
SetWindowLong Me.hWnd, GWL_EXSTYLE, GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributes Me.hWnd, 0, tAl, LWA_ALPHA
End Sub
Private Sub GotoUrl(nfrm As frmBrowser, nGoPos As Long)
Dim tGap&, tLen&, tPos&, tGoPos&
Dim tZeros$, tReplace$, tUrl$
tGap = vTxtGap.TextVal
tLen = vTxtLen.TextVal
tPos = vTxtPos.TextVal
tZeros = String(tLen, "0")
tGoPos = tPos + tGap * nGoPos
tReplace = Format(tGoPos, tZeros)
Debug.Print tReplace
tUrl = Replace(txtSlideUrl.Text, "(*)", tReplace)
nfrm.Navigate tUrl, False
txtPos.Text = LTrim(Str(tGoPos))
End Sub
Private Sub ShowSetup(nShow As Boolean)
Dim tCtrl As Control
If nShow Then
    For Each tCtrl In Me.Controls
        If Not TypeOf tCtrl Is Menu Then
            tCtrl.Visible = True
        End If
    Next
    
    With fraHoldAll
        .Width = BigWidth
        .Height = BigHeight
    End With
    
    Me.Width = BigWidth
    Me.Height = BigHeight
    mnuPopMainSetup.Enabled = False
Else
    For Each tCtrl In Me.Controls
        If Not TypeOf tCtrl Is Menu Then
            tCtrl.Visible = False
        End If
    Next
    
    cmdPre.Visible = True
    cmdNext.Visible = True
    With fraHoldAll
        .Width = SmallWidth
        .Height = SmallHeight
        .Visible = True
    End With
    
    Me.Width = SmallWidth
    Me.Height = SmallHeight
    mnuPopMainSetup.Enabled = True
End If
End Sub
Private Sub txtSlideUrl_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Data.GetFormat(vbCFText) Then
    txtSlideUrl.Text = Data.GetData(vbCFText)
End If
End Sub

						