Mastering Visual Basic 6/mastvb6.iso/ch_code/ch21/htmledit/htmledit.frm

Visual Basic Form | 1996-05-18 | 9.3 KB | 285 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.1#0"; "RICHTX32.OCX"
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "SHDOCVW.DLL"
Begin VB.Form HTMLEdit
   Caption         =   "HTML Editor"
   ClientHeight    =   6285
   ClientLeft      =   390
   ClientTop       =   1590
   ClientWidth     =   10245
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6285
   ScaleWidth      =   10245
   Begin SHDocVwCtl.WebBrowser WebBrowser1
      Height          =   3180
      Left            =   90
      TabIndex        =   0
      Top             =   2955
      Width           =   9960
      ExtentX         =   17568
      ExtentY         =   5609
      ViewMode        =   1
      Offline         =   0
      Silent          =   0
      RegisterAsBrowser=   0
      RegisterAsDropTarget=   0
      AutoArrange     =   -1  'True
      NoClientEdge    =   -1  'True
      AlignLeft       =   0   'False
      ViewID          =   "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
      Location        =   ""
   End
   Begin RichTextLib.RichTextBox RichTextBox1
      Height          =   2775
      Left            =   60
      TabIndex        =   1
      Top             =   30
      Width           =   10020
      _ExtentX        =   17674
      _ExtentY        =   4895
      _Version        =   393217
      Enabled         =   -1  'True
      HideSelection   =   0   'False
      ScrollBars      =   3
      TextRTF         =   $"HTMLEdit.frx":0000
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "Times New Roman"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   7005
      Top             =   -135
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      FontSize        =   1.17485e-38
   End
   Begin VB.Menu FileMenu
      Caption         =   "File"
      Begin VB.Menu FileNew
         Caption         =   "New Document"
      End
      Begin VB.Menu FileOpen
         Caption         =   "Open Document"
      End
      Begin VB.Menu FileSave
         Caption         =   "Save Document"
      End
      Begin VB.Menu FileSaveAs
         Caption         =   "Save As ..."
      End
      Begin VB.Menu NavigateTo
         Caption         =   "Open URL"
      End
      Begin VB.Menu FileExit
         Caption         =   "Exit"
      End
   End
   Begin VB.Menu EditMenu
      Caption         =   "Edit"
      Begin VB.Menu EditCopy
         Caption         =   "Copy"
         Shortcut        =   ^C
      End
      Begin VB.Menu EditCut
         Caption         =   "Cut"
         Shortcut        =   ^X
      End
      Begin VB.Menu EditPaste
         Caption         =   "Paste"
         Shortcut        =   +{INSERT}
      End
      Begin VB.Menu EditClear
         Caption         =   "Clear"
      End
      Begin VB.Menu EditAll
         Caption         =   "Select All"
         Shortcut        =   ^A
      End
      Begin VB.Menu ShorcutSeparator1
         Caption         =   "-"
      End
      Begin VB.Menu EditRender
         Caption         =   "Render Document"
         Shortcut        =   ^R
      End
   End
   Begin VB.Menu shortcutMenu
      Caption         =   "Edit"
      Enabled         =   0   'False
      Visible         =   0   'False
      Begin VB.Menu ShortcutCopy
         Caption         =   "Copy"
      End
      Begin VB.Menu ShortcutCut
         Caption         =   "Cut"
      End
      Begin VB.Menu ShortcutPaste
         Caption         =   "Paste"
      End
      Begin VB.Menu ShortcutClear
         Caption         =   "Clear"
      End
      Begin VB.Menu ShortcutAll
         Caption         =   "Select All"
      End
      Begin VB.Menu ShortcutSeparator2
         Caption         =   "-"
      End
      Begin VB.Menu ShortcutRender
         Caption         =   "Render Document"
      End
   End
Attribute VB_Name = "HTMLEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RestoreText
Dim OpenFileName
Dim ResizeWindows As Boolean
Dim DragStartY As Integer
Dim HTMLHeight As Integer, WebHeight As Integer
Private Sub EditAll_Click()
    HTMLPad.RichTextBox1.SelStart = 0
    HTMLPad.RichTextBox1.SelLength = Len(HTMLPad.RichTextBox1.Text)
End Sub
Private Sub EditClear_Click()
    HTMLPad.RichTextBox1.Text = ""
End Sub
Private Sub EditCopy_Click()
    Clipboard.Clear
    Clipboard.SetText RichTextBox1.SelText
End Sub
Private Sub EditCut_Click()
    Clipboard.Clear
    Clipboard.SetText RichTextBox1.SelText
    RichTextBox1.SelText = ""
End Sub
Private Sub EditPaste_Click()
    Temp = Clipboard.GetText(vbCFText)
    SelTextStart = RichTextBox1.SelStart
    SelTextEnd = Len(Temp)
    RichTextBox1.SelText = Temp
    RichTextBox1.SelFontName = RichTextBox1.Font
    RichTextBox1.SelBold = False
    RichTextBox1.SelItalic = False
    RichTextBox1.SelUnderline = False
    RichTextBox1.SelColor = vbBlack
End Sub
Private Sub EditRender_Click()
    RenderDocument
End Sub
Private Sub EditUndo_Click()
    RichTextBox1.Text = RestoreText
End Sub
Private Sub EditSelect_Click()
    RichTextBox1.SelStart = 0
    RichTextBox1.SelLength = Len(RichTextBox1.Text)
End Sub
Private Sub FileNew_Click()
    RichTextBox1.Text = ""
    OpenFileName = ""
End Sub
Private Sub FileOpen_Click()
On Error Resume Next
    CommonDialog1.Filter = "HML Documents|*.htm;*.html|ActiveX Documents|*.vbd|All Files|*.*"
    CommonDialog1.ShowOpen
    If Trim(CommonDialog1.FileName) = "" Then Exit Sub
    dPos = InStr(CommonDialog1.FileName, ".")
    If dPos > 0 Then ext = Mid$(CommonDialog1.FileName, dPos + 1)
    If UCase$(ext) = "HTM" Or UCase$(ext) = "HTML" Or UCase$(ext) = "TXT" Then
        RichTextBox1.LoadFile CommonDialog1.FileName, 1
        WebBrowser1.Navigate CommonDialog1.FileName
        OpenFileName = CommonDialog1.FileName
    End If
' The following lines handle non-HTML file types
' like sounds and images
    WebBrowser1.Navigate CommonDialog1.FileName
End Sub
Private Sub FileSave_Click()
    If OpenFileName <> "" Then
        RichTextBox1.SaveFile OpenFileName, 1
    Else
        FileSaveAs_Click
    End If
End Sub
Private Sub FileSaveAs_Click()
    CommonDialog1.DefaultExt = "htm"
    CommonDialog1.Filter = "HTML Documents|*.htm|All Files|*.*"
    CommonDialog1.ShowSave
    If CommonDialog1.FileName = "" Then Exit Sub
    RichTextBox1.SaveFile CommonDialog1.FileName, 1
    OpenFile = CommonDialog1.FileName
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 And (Y > RichTextBox1.Top + RichTextBox1.Height) And (Y < WebBrowser1.Top) Then
        Screen.MousePointer = vbSizeNS
        ResizeWindows = True
        DragStartY = Y
        WebHeight = WebBrowser1.Height
        HTMLHeight = RichTextBox1.Height
    End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
    If ResizeWindows Then
        RichTextBox1.Height = HTMLHeight + (Y - DragStartY)
        WebBrowser1.Move WebBrowser1.Left, RichTextBox1.Top + RichTextBox1.Height + 120, WebBrowser1.Width, WebHeight - (Y - DragStartY)
        HTMLEdit.Refresh
    End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ResizeWindows = False
    Screen.MousePointer = vbDefault
End Sub
Private Sub Form_Resize()
    RichTextBox1.Width = HTMLEdit.Width - RichTextBox1.Left - 200
    WebBrowser1.Width = RichTextBox1.Width
    RichTextBox1.Height = 0.3 * HTMLEdit.Height
    WebBrowser1.Move WebBrowser1.Left, RichTextBox1.Top _
    + RichTextBox1.Height + 120, WebBrowser1.Width, HTMLEdit.Height _
    - RichTextBox1.Top - RichTextBox1.Height - 940
    WebBrowser1.Navigate App.Path & "\empty.htm"
End Sub
Private Sub NavigateTo_Click()
    URL = InputBox("Enter URL to navigate to")
    If URL <> "" Then
        WebBrowser1.Navigate URL
    End If
End Sub
Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        PopupMenu shortcutMenu
    End If
End Sub
Private Sub ShortcutAll_Click()
    Call EditAll_Click
End Sub
Private Sub ShortCutClear_Click()
    HTMLEdit.RichTextBox1.Text = ""
End Sub
Private Sub ShortcutCopy_Click()
    Call EditCopy_Click
End Sub
Private Sub ShortcutCut_Click()
    Call EditCut_Click
End Sub
Private Sub ShortcutPaste_Click()
    Call EditPaste_Click
End Sub
Private Sub ShortcutRender_Click()
    RenderDocument
End Sub
Private Sub WebBrowser1_Validate(Cancel As Boolean)
Debug.Print "Error"
End Sub