frminsertelement.frm

非常有用得编辑器软件源码

               Width           =   2415
            End
            Begin VB.CommandButton cmdBrowseLowRes 
               Caption         =   "&Browse..."
               Height          =   285
               Left            =   1560
               TabIndex        =   10
               Top             =   480
               Width           =   1095
            End
            Begin VB.TextBox txtLowRes 
               Height          =   285
               Left            =   120
               TabIndex        =   9
               Top             =   480
               Width           =   1455
            End
            Begin VB.Image picPreview 
               BorderStyle     =   1  'Fixed Single
               Height          =   2655
               Left            =   2760
               Stretch         =   -1  'True
               Top             =   240
               Width           =   2895
            End
            Begin VB.Label Label3 
               BackStyle       =   0  'Transparent
               Caption         =   "Alternative Text:"
               Height          =   255
               Left            =   120
               TabIndex        =   12
               Top             =   960
               Width           =   1455
            End
            Begin VB.Label Label2 
               BackStyle       =   0  'Transparent
               Caption         =   "Low Resolution:"
               Height          =   375
               Left            =   120
               TabIndex        =   11
               Top             =   240
               Width           =   1695
            End
         End
         Begin VB.Frame Frame1 
            Caption         =   "General"
            Height          =   1095
            Left            =   120
            TabIndex        =   4
            Top             =   120
            Width           =   5775
            Begin VB.CommandButton cmdBrowseIMG 
               Caption         =   "&Browse..."
               Height          =   285
               Left            =   4560
               TabIndex        =   7
               Top             =   480
               Width           =   1095
            End
            Begin VB.TextBox txtImgSource 
               Height          =   285
               Left            =   120
               TabIndex        =   5
               Top             =   480
               Width           =   4455
            End
            Begin VB.Label Label1 
               BackStyle       =   0  'Transparent
               Caption         =   "Image Source:"
               Height          =   375
               Index           =   0
               Left            =   120
               TabIndex        =   6
               Top             =   240
               Width           =   3735
            End
         End
      End
   End
End
Attribute VB_Name = "frmInsertElement"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Job As String

'The object
Public TheDOM As IHTMLDocument2
Public TheCode As CodeMax

Public inImage As IHTMLImgElement
Public inHyperlink As IHTMLAnchorElement
Public inTarget As IHTMLAnchorElement
Public inVideo As IHTMLImgElement

'Function Controllers
Public InsertMode As String
Public ElementMode As String
Public SavedMode As String
Public FilePath As String
Public IsCreator As Boolean
Dim p As IPictureDisp

Dim imgHeight As Long, imgWidth As Long

Public Function GenerateCode(InsertWhat As InsertModeConstant) As String
    
Select Case InsertWhat

    Case 1 'Image
        
        If Me.txtImgSource.Text = "" Then Exit Function
        
        Dim inImage As IHTMLImgElement
        Set inImage = CreateElement("IMG")
        
        With inImage
            On Error Resume Next
            .src = Me.txtImgSource.Text
            .alt = Me.txtAlt.Text
            .lowsrc = Me.txtLowRes.Text
            
            If Me.cobIMGAlign.Text <> "Default" Then .Align = Me.cobIMGAlign.Text
            .border = Me.txtIMGBorder.Text
            .hspace = CLng(Me.txtIMGHSpac.Text)
            .vspace = CLng(Me.txtIMGVspac.Text)
                        
            If Me.chkIMGSize.Value = 1 Then
                .Height = CLng(Me.txtIMGHeight.Text)
                .Width = CLng(Me.txtIMGWidth.Text)
            Else
                .Height = imgHeight \ Screen.TwipsPerPixelY \ 2
                .Width = imgWidth \ Screen.TwipsPerPixelX \ 2
            End If
            
            GenerateCode = inImage.outerHTML
            
        End With
        
    Case 4 'Video
        
        Set inVideo = CreateElement("IMG")
        
        
    Case 2 'Anchor(Hyperlink)
        
        Set inHyperlink = CreateElement("A")
        
        
    Case 3 'Bookmark
        
        Set inTarget = CreateElement("A")
        
        
End Select
    
End Function

Private Sub chkForever_Click()
Dim B As Integer
B = chkForever.Value
B = 1 - B
Me.txtVidLoop.Enabled = B
End Sub

Private Sub chkIMGSize_Click()
On Error Resume Next
 Me.txtIMGHeight.Enabled = chkIMGSize.Value
 Me.txtIMGWidth.Enabled = chkIMGSize.Value
End Sub

Private Sub chkVIDSize_Click()
On Error Resume Next
Me.txtVIDHeight.Enabled = chkVIDSize.Value
Me.txtVIDWidth.Enabled = chkVIDSize.Value
End Sub

Private Sub cmdABrowse_Click()
Dim Filename As String
On Error GoTo 1
Filename = ShowOpenBox("All Files *.*|*.*", Cd1)

Select Case Me.SavedMode
    
    Case "true"
        Me.txtHref.Text = ComparePath(Me.FilePath, Filename)
    Case "false"
        Me.txtHref.Text = "file:///" & Replace$(Filename, "\", "/")
        
End Select
1
End Sub

Private Sub cmdAEmail_Click()
Dim Email As String
 Email = InputBox("Please enter the E-mail Address.", "Link to a E-mail Address", "[e-mail]")
 
 If Email = vbNullString Then Exit Sub
 
 Me.txtHref.Text = "mailto:" & Email
 
End Sub

Private Sub cmdBrowseIMG_Click()

Dim Filename As String
On Error GoTo 1
Filename = ShowOpenBox("All Image Files (*.jpg, *.gif, *.bmp, *.png, *.tif, *.wmf, *.tga)|*.jpg;*.jpeg;*.gif;*.bmp;*.png;*.tif;*.tiff;*.wmf;*.tga;*.ras;*.pcd;*.pcx;*.eps", Cd1)

Set p = LoadPicture(Filename)
imgHeight = p.Height
imgWidth = p.Width

On Error Resume Next

picPreview.Picture = p

Select Case Me.SavedMode
    
    Case "true"
        Me.txtImgSource.Text = ComparePath(Me.FilePath, Filename)
    Case "false"
        Me.txtImgSource.Text = "file:///" & Replace$(Filename, "\", "/")
        
End Select
1
End Sub

Private Sub cmdCancel_Click()
Me.Hide
End Sub

Private Sub cmdOK_Click()

If Me.InsertMode = "true" Then

    Select Case Me.ElementMode
        Case "image"
        Dim a As String
        a = GenerateCode(1)
            If Me.IsCreator = True Then
                InsertHTML True, a, TheDOM
            Else
                InsertHTML False, a, , TheCode
            End If
        Case "video"
        
        Case "hyperlink"
        
        Case "target"
    
    End Select
    
Else

    Select Case Me.ElementMode
        Case "image"
        
        Case "video"
        
        Case "hyperlink"
        
        Case "target"
    
    End Select
    
End If

Me.Hide

End Sub

Private Sub Form_Load()
FlattenSpc Me, "commandbutton"
FlattenSpc Me, "textbox"
FlattenSpc Me, "listbox"
FlatControls Me
End Sub

Private Sub txtAlt_GotFocus()
SelectBox txtAlt
End Sub

Private Sub txtBookmarkName_GotFocus()
SelectBox txtBookmarkName
End Sub

Private Sub txtHref_GotFocus()
SelectBox txtHref
End Sub

Private Sub txtIMGBorder_GotFocus()
SelectBox txtIMGBorder
End Sub

Private Sub txtIMGBorder_LostFocus()
If IsNumeric(txtIMGBorder.Text) = False Then txtIMGBorder.Text = 0
End Sub

Private Sub txtIMGHeight_GotFocus()
SelectBox txtIMGHeight
End Sub

Private Sub txtIMGHeight_LostFocus()
If IsNumeric(txtIMGHeight.Text) = False Then txtIMGHeight.Text = 32
End Sub

Private Sub txtIMGHSpac_GotFocus()
SelectBox txtIMGHSpac
End Sub

Private Sub txtIMGHSpac_LostFocus()
If IsNumeric(txtIMGHSpac.Text) = False Then txtIMGHSpac.Text = 0
End Sub

Private Sub txtIMGVspac_GotFocus()
SelectBox txtIMGVspac
End Sub

Private Sub txtIMGVspac_LostFocus()
If IsNumeric(txtIMGVspac.Text) = False Then txtIMGVspac.Text = 0
End Sub

Private Sub txtIMGWidth_GotFocus()
SelectBox txtIMGWidth
End Sub

Private Sub txtIMGWidth_LostFocus()
If IsNumeric(txtIMGWidth.Text) = False Then txtIMGWidth.Text = 32
End Sub

Private Sub txtLowRes_GotFocus()
SelectBox txtLowRes
End Sub

Private Sub txtImgSource_GotFocus()
SelectBox txtImgSource
End Sub

Private Sub txtVIDBorder_GotFocus()
SelectBox txtVIDBorder
End Sub

Private Sub txtVIDHeight_GotFocus()
SelectBox txtVIDHeight
End Sub

Private Sub txtVIDHeight_LostFocus()
If IsNumeric(txtVIDHeight) = False Then txtVIDHeight.Text = 32
End Sub

Private Sub txtVIDHSpac_GotFocus()
SelectBox txtVIDHSpac
End Sub

Private Sub txtVidLoop_GotFocus()
SelectBox txtVidLoop
End Sub

Private Sub txtVidLoopDelay_GotFocus()
SelectBox txtVidLoopDelay
End Sub

Private Sub txtVidSource_GotFocus()
SelectBox txtVidSource
End Sub

Private Sub txtVIDVspac_GotFocus()
SelectBox txtVIDVspac
End Sub

Private Sub txtVIDWidth_GotFocus()
SelectBox txtVIDWidth
End Sub

Private Sub txtVIDWidth_LostFocus()
If IsNumeric(txtVIDWidth.Text) = False Then txtVIDWidth.Text = 32
End Sub