kjhtml.frm

一套经典的asp教程 本人受益颇多 特推荐之 直接解压无密码

VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "SHDOCVW.DLL"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "快速学会 HTML -- by 王国荣"
   ClientHeight    =   5925
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   8220
   LinkTopic       =   "Form1"
   ScaleHeight     =   5925
   ScaleWidth      =   8220
   StartUpPosition =   3  '系统预设值
   Begin VB.PictureBox Picture2 
      BorderStyle     =   0  '没有框线
      Height          =   90
      Left            =   0
      MousePointer    =   7  '北-南指向
      ScaleHeight     =   90
      ScaleWidth      =   8175
      TabIndex        =   3
      Top             =   3720
      Width           =   8175
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H80000005&
      Height          =   3705
      Left            =   0
      ScaleHeight     =   3645
      ScaleWidth      =   7875
      TabIndex        =   1
      Top             =   0
      Width           =   7935
      Begin MSComDlg.CommonDialog CommonDialog1 
         Left            =   5760
         Top             =   2760
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
         CancelError     =   -1  'True
      End
      Begin SHDocVwCtl.WebBrowser WebBrowser1 
         Height          =   3015
         Left            =   0
         TabIndex        =   2
         Top             =   0
         Width           =   5655
         ExtentX         =   9975
         ExtentY         =   5318
         ViewMode        =   1
         Offline         =   0
         Silent          =   0
         RegisterAsBrowser=   0
         RegisterAsDropTarget=   1
         AutoArrange     =   -1  'True
         NoClientEdge    =   0   'False
         AlignLeft       =   0   'False
         ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
         Location        =   ""
      End
   End
   Begin VB.TextBox Text1 
      BeginProperty Font 
         Name            =   "细明体"
         Size            =   12
         Charset         =   136
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1935
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   3  '两者皆有
      TabIndex        =   0
      Top             =   3840
      Width           =   7935
   End
   Begin VB.Menu mFile 
      Caption         =   "档案(&F)"
      Begin VB.Menu mNew 
         Caption         =   "开新档案(&N)"
         Shortcut        =   ^N
      End
      Begin VB.Menu mOpen 
         Caption         =   "开启旧档(&O)"
         Shortcut        =   ^O
      End
      Begin VB.Menu mSave 
         Caption         =   "储存档案(&S)"
         Shortcut        =   ^S
      End
      Begin VB.Menu mLine0 
         Caption         =   "-"
      End
      Begin VB.Menu mEnd 
         Caption         =   "结束(&X)"
      End
   End
   Begin VB.Menu mEdit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu mCut 
         Caption         =   "剪下(&T)"
         Shortcut        =   ^X
      End
      Begin VB.Menu mCopy 
         Caption         =   "复制(&C)"
         Shortcut        =   ^C
      End
      Begin VB.Menu mPaste 
         Caption         =   "贴上(&P)"
         Shortcut        =   ^V
      End
      Begin VB.Menu mLine 
         Caption         =   "-"
      End
      Begin VB.Menu mBrowse 
         Caption         =   "浏览(&B)"
         Shortcut        =   {F5}
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Dim Path As String
Dim mouseDown As Boolean, fs As New FileSystemObject
Dim Y0 As Single, Y1 As Single, dY As Single

Private Sub Form_Load()
    Text1.Text = "<HTML>" & vbCrLf & "<BODY>" & vbCrLf & vbCrLf & "</BODY>" & vbCrLf & "</HTML>"
    Path = GetSetting("kjhtml", "Path", "Path", "c:\")
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If mouseDown Then
      If Y < 800 Then Y = 800
      If Y > Me.ScaleHeight - 800 Then Y = Me.ScaleHeight - 800
      Picture2.Top = Picture2.Top + Y - Y1
      Y1 = Y
      dY = Y - Y0
   End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
   ReleaseCapture
   mouseDown = False
   
   With Picture2
      .BackColor = &H8000000F
      .ZOrder 1
      .BorderStyle = 0
      .Visible = True
   End With
   ControlsResize
End Sub

Private Sub Form_Resize()
    ControlsResize
End Sub

Private Sub Browse()
    Dim txtf As Object, FileName As String
    
    On Error Resume Next
    FileName = Path & "tmp0AX39.htm"
    Set txtf = fs.CreateTextFile(FileName, True)
    txtf.Write Text1.Text
    txtf.Close
    
    WebBrowser1.Navigate "file:" & FileName
End Sub

Private Sub OpenHTML(FileName As String)
    Dim txtf As Object
    
    Set txtf = fs.OpenTextFile(FileName)
    On Error Resume Next
    Text1.Text = txtf.ReadAll
    txtf.Close
End Sub

Private Sub SaveHTML(FileName As String)
    Dim txtf As Object
    
    Set txtf = fs.CreateTextFile(FileName, True)
    On Error Resume Next
    txtf.Write Text1.Text
    txtf.Close
End Sub

Sub ControlsResize()
    On Error Resume Next
    
    Picture2.Width = Me.ScaleWidth
    Picture1.Width = Me.ScaleWidth
    Text1.Width = Me.ScaleWidth
    
    Picture1.Height = Picture2.Top
    Text1.Height = Me.ScaleHeight - Picture1.Height - Picture2.Height
    
    Text1.Top = Picture1.Height + Picture2.Height
    
    WebBrowser1.Width = Picture1.ScaleWidth
    WebBrowser1.Height = Picture1.ScaleHeight
End Sub

Private Sub mBrowse_Click()
    Browse
End Sub

Private Sub mCopy_Click()
    Clipboard.SetText Text1.SelText
End Sub

Private Sub mCut_Click()
    mCopy_Click
    Text1.SelText = ""
End Sub

Private Sub mEdit_Click()
    mPaste.Enabled = Clipboard.GetFormat(vbCFText)
    mCopy.Enabled = Text1.SelLength > 0
    mCut.Enabled = Text1.SelLength > 0
End Sub

Private Sub mEnd_Click()
    Unload Me
End Sub

Private Sub mNew_Click()
    Text1.Text = "<HTML>" & vbCrLf & "<BODY>" & vbCrLf & vbCrLf & "</BODY>" & vbCrLf & "</HTML>"
    Text1.SetFocus
    SendKeys "{Down}{Down}"
    
    Browse
End Sub

Private Sub mOpen_Click()
    With CommonDialog1
        On Error Resume Next
        .DialogTitle = "开启 HTML 文件"
        .Filter = "*.htm;*.html|*.htm;*.html"
        .InitDir = Path
        .ShowOpen
        If Err.Number = 0 Then
            OpenHTML .FileName
            pos = 1: pos2 = 0
            While pos > 0
                pos2 = pos
                pos = InStr(pos + 1, .FileName, "\")
            Wend
            Path = Left(.FileName, pos2)
            SaveSetting "kjhtml", "Path", "Path", Path
        End If
    End With
    
    Browse
End Sub

Private Sub mPaste_Click()
    Text1.SelText = Clipboard.GetText(vbCFText)
End Sub

Private Sub mSave_Click()
    With CommonDialog1
        On Error Resume Next
        .DialogTitle = "储存 HTML 文件"
        .Filter = "*.htm;*.html|*.htm;*.html"
        .InitDir = Path
        .ShowSave
        If Err.Number = 0 Then
            SaveHTML .FileName
            pos = 1: pos2 = 0
            While pos > 0
                pos2 = pos
                pos = InStr(pos + 1, .FileName, "\")
            Wend
            Path = Left(.FileName, pos2)
            SaveSetting "kjhtml", "Path", "Path", Path
        End If
    End With
End Sub

Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Y0 = Y + Picture2.Top
   Y1 = Y0
   mouseDown = True
   With Picture2
      .BackColor = &H80000010
      .ZOrder 0
      .BorderStyle = 1
      .Visible = True
   End With
   SetCapture Form1.hwnd
End Sub