📄 formhtml.frm
字号:
Caption = "浏览..."
Height = 330
Left = 4260
TabIndex = 0
Top = 750
Width = 855
End
Begin VB.CheckBox Check1
Caption = "生成文件信息注释"
ForeColor = &H00000000&
Height = 345
Left = 300
TabIndex = 4
Top = 1590
Value = 1 'Checked
Width = 1815
End
Begin VB.CheckBox Check2
Caption = "使用小写扩展名（.htm）"
ForeColor = &H00000000&
Height = 435
Left = 300
TabIndex = 3
Top = 1140
Width = 2505
End
Begin VB.ComboBox Combo1
CausesValidation= 0 'False
Height = 300
ItemData = "FormHTML.frx":0CCE
Left = 3240
List = "FormHTML.frx":0CDE
TabIndex = 2
Text = ".htm"
Top = 750
Width = 945
End
Begin VB.Label Label7
Caption = "标题："
ForeColor = &H00000000&
Height = 330
Left = 210
TabIndex = 8
Top = 315
Width = 540
End
Begin VB.Label Label8
Caption = "路径："
ForeColor = &H00000000&
Height = 225
Left = 210
TabIndex = 7
Top = 840
Width = 540
End
End
End
Attribute VB_Name = "FormHTML"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim HFH As FLASHHEADER
Dim HFN As FLASHNOTE
Private Sub Check2_Click()
If Check2.Value = 1 Then
Combo1.Enabled = False
Else
Combo1.Enabled = True
End If
End Sub
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdFileDialog_Click()
Dim htmlFileName As String
Dim tmp As String
htmlFileName = ShowSaveDialog(Me, "网页文件HTML", "*.htm;*.html", "选择文件...", "htm", TextPath.Text & Combo1.Text)
If htmlFileName <> "" Then
TextPath.Text = Left(htmlFileName, InStrRev(htmlFileName, ".") - 1)
Combo1.Text = Right(htmlFileName, Len(htmlFileName) - InStrRev(htmlFileName, ".") + 1)
End If
End Sub
Private Sub cmdOK_Click()
Call SaveHTML
Unload Me
End Sub
Private Sub Form_Load()
HFH = getFlashHeader(Play.ShockwaveFlash1.Movie)
HFN = getNote(Play.ShockwaveFlash1.Movie)
SizeH.Text = HFH.lMHeight
SizeW.Text = HFH.lMWidth
TextTitle.Text = HFN.strMovieName
TextPath.Text = Left(Play.ShockwaveFlash1.Movie, InStrRev(Play.ShockwaveFlash1.Movie, ".") - 1)
Text3(0).Text = HFH.bColorR
Text3(1).Text = HFH.bColorG
Text3(2).Text = HFH.bColorB
Label5(0).BackColor = RGB(CInt(Text3(0).Text), CInt(Text3(1).Text), CInt(Text3(2).Text))
End Sub
Private Sub SizeH_KeyPress(KeyAscii As Integer)
If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <> vbKeyBack Then
KeyAscii = 0
End If
End Sub
Private Sub Text3_Change(Index As Integer)
If Text3(Index).Text = "" Then Text3(Index).Text = "0"
If CInt(Text3(Index).Text) > 255 Then Text3(Index).Text = 255
Label5(0).BackColor = RGB(CInt(Text3(0).Text), CInt(Text3(1).Text), CInt(Text3(2).Text))
Label5(1).BackColor = RGB(CInt(Text3(3).Text), CInt(Text3(4).Text), CInt(Text3(5).Text))
End Sub
Private Sub Text3_KeyPress(Index As Integer, KeyAscii As Integer)
If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <> vbKeyBack Then
KeyAscii = 0
End If
End Sub
Private Sub TextPath_Change()
TextPath.ToolTipText = TextPath.Text & Combo1.Text
End Sub
Sub SaveHTML()
Dim oFSO As New FileSystemObject
Dim htmlFilaName As String
Dim HTMLText As String
Dim lFileNum As Long
Dim BGColor As String '背景色
Dim TexCcolor As String '文本颜色
Dim colorR As String
Dim colorG As String
Dim colorB As String
Dim strDate As String
Dim strMovieSize As String
Dim intMovieTotalFrames As Integer
Dim intRote As Integer
Dim MoviePath As String
'取文件大小，日期
strMovieSize = FormatNumber(FileLen(Play.ShockwaveFlash1.Movie), 0) & " Byte"
strDate = FormatDateTime(oFSO.GetFile(Play.ShockwaveFlash1.Movie).DateLastModified, vbLongDate) & FormatDateTime(oFSO.GetFile(Play.ShockwaveFlash1.Movie).DateLastModified, vbLongTime)
'取背景色
colorR = Hex(CInt(Text3(0).Text))
If Len(colorR) < 2 Then
colorR = "0" & colorR
End If
colorG = Hex(CInt(Text3(1).Text))
If Len(colorG) < 2 Then
colorG = "0" & colorG
End If
colorB = Hex(CInt(Text3(2).Text))
If Len(colorB) < 2 Then
colorB = "0" & colorB
End If
BGColor = colorR & colorG & colorB
'取前景色
colorR = Hex(CInt(Text3(3).Text))
If Len(colorR) < 2 Then
colorR = "0" & colorR
End If
colorG = Hex(CInt(Text3(4).Text))
If Len(colorG) < 2 Then
colorG = "0" & colorG
End If
colorB = Hex(CInt(Text3(5).Text))
If Len(colorB) < 2 Then
colorB = "0" & colorB
End If
Textcolor = colorR & colorG & colorB
'动画背景
HTMLText = "<html>" & vbCrLf
HTMLText = HTMLText & "<head>" & vbCrLf
HTMLText = HTMLText & "<meta http-equiv= 'Content-Type' content='text/html; charset=gb2312'>" & vbCrLf
HTMLText = HTMLText & "<meta http-equiv= 'Name' content='KeyWords; By OpenPlayer(Flash播放器...) 1.5 春节版 http://OpenPlayer.51.net Email:yztink@163.net 小鱼儿工作室'>" & vbCrLf
HTMLText = HTMLText & "<title>" & TextTitle.Text & "</title>" & vbCrLf
HTMLText = HTMLText & "</head>" & vbCrLf
HTMLText = HTMLText & "<!-- By OpenPlayer 1.5 春节版 http://OpenPlayer.51.net Email:yztink@163.net 小鱼儿工作室-->" & vbCrLf
HTMLText = HTMLText & vbCrLf
HTMLText = HTMLText & "<body bgcolor=#" & BGColor & " " & "text=#" & Textcolor & ">"
HTMLText = HTMLText & vbCrLf & "<table border=0 width=100%>"
HTMLText = HTMLText & vbCrLf & "<tr>"
HTMLText = HTMLText & vbCrLf & "<td width=100% >"
HTMLText = HTMLText & vbCrLf & "<center>"
HTMLText = HTMLText & vbCrLf & "<OBJECT classid= 'clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=5,0,0,0'"
HTMLText = HTMLText & vbCrLf & " WIDTH=" & SizeW.Text & " HEIGHT=" & SizeH.Text & ">"
MoviePath = Play.ShockwaveFlash1.Movie
If Check4.Value = 1 Then
MoviePath = Mid(MoviePath, InStrRev(MoviePath, "\") + 1)
End If
HTMLText = HTMLText & vbCrLf & vbTab & "<PARAM NAME=movie VALUE='" & MoviePath & "'>"
HTMLText = HTMLText & vbCrLf & vbTab & "<PARAM NAME=quality VALUE=high>"
'是否背景透明
If Check3.Value = 1 Then
HTMLText = HTMLText & vbCrLf & vbTab & "<PARAM NAME=wmode VALUE=transparent>"
Else
HTMLText = HTMLText & vbCrLf & vbTab & "<PARAM NAME=bgcolor VALUE=#" & BGColor & ">"
End If
HTMLText = HTMLText & vbCrLf & vbTab & "<EMBED src='" & MoviePath & "' quality=high "
HTMLText = HTMLText & "bgcolor=#" & BGColor & " width=" & SizeW.Text & " height=" & SizeH.Text
HTMLText = HTMLText & "TYPE='application/x-shockwave-flash' PLUGINSPAGE='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash'>"
HTMLText = HTMLText & vbCrLf & vbTab & "</EMBED>"
HTMLText = HTMLText & vbCrLf & "</OBJECT>"
HTMLText = HTMLText & vbCrLf & "</center>"
HTMLText = HTMLText & vbCrLf & "</tr>"
HTMLText = HTMLText & vbCrLf & "</td>"
HTMLText = HTMLText & vbCrLf & "</table>"
'如果生成文件注释
If Check1.Value = 1 Then
HTMLText = HTMLText & vbCrLf & "<table align='center' border='1' borderColor='#000000' borderColorDark='#eeeeee' borderColorLight='#666666' cellPadding='2' cellSpacing='0' width='425' bgcolor=" & BGColor & ">"
HTMLText = HTMLText & vbCrLf & vbTab & "<tr>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=right width='30%' >标题</td>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=left>" & TextTitle.Text & "</td>" '标题
HTMLText = HTMLText & vbCrLf & vbTab & "</tr>"
HTMLText = HTMLText & vbCrLf & vbTab & "<tr>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=right >作品名</td>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=left>" & HFN.strMovieName & "</td>"
HTMLText = HTMLText & vbCrLf & vbTab & "</tr>"
HTMLText = HTMLText & vbCrLf & vbTab & "<tr>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=right >作者</td>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=left>" & HFN.strAuthor & "</td>"
HTMLText = HTMLText & vbCrLf & vbTab & "</tr>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=right >发布公司</td>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=left>" & HFN.strCompany & "</td>"
HTMLText = HTMLText & vbCrLf & vbTab & "</tr>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=right >大小</td>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=left>" & strMovieSize & "字节</td>"
HTMLText = HTMLText & vbCrLf & vbTab & "</tr>"
HTMLText = HTMLText & vbCrLf & vbTab & "<tr>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=right >制作日期(参考)</td>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=left>" & strDate & "</td>"
HTMLText = HTMLText & vbCrLf & vbTab & "</tr>"
HTMLText = HTMLText & vbCrLf & vbTab & "<tr>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=right >帧数</td>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=left>" & HFH.intMTotalFrames & "帧</td>"
HTMLText = HTMLText & vbCrLf & vbTab & "</tr>"
HTMLText = HTMLText & vbCrLf & vbTab & "<tr>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=right >速度</td>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=left>" & HFH.intMRate & "帧/秒</td>"
HTMLText = HTMLText & vbCrLf & vbTab & "</tr>"
HTMLText = HTMLText & vbCrLf & vbTab & "<tr>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=right >估计时间</td>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=left>" & Round(HFH.intMTotalFrames / HFH.intMRate, 1) & "秒</td>"
HTMLText = HTMLText & vbCrLf & vbTab & "</tr>"
HTMLText = HTMLText & vbCrLf & vbTab & "<tr>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=right >高×宽</td>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=left>" & SizeH.Text & " × " & SizeW.Text & " Pix</td>"
HTMLText = HTMLText & vbCrLf & vbTab & "</tr>"
HTMLText = HTMLText & vbCrLf & vbTab & "<tr>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=right >说明</td>"
HTMLText = HTMLText & vbCrLf & vbTab & vbTab & "<td align=left> " & HFN.strNote & "</td>"
HTMLText = HTMLText & vbCrLf & vbTab & "</tr>"
HTMLText = HTMLText & vbCrLf & "</table>"
HTMLText = HTMLText & vbCrLf & "</tr>"
HTMLText = HTMLText & vbCrLf & "</td>"
End If '如果生成文件注释.........结束
HTMLText = HTMLText & vbCrLf & ""
HTMLText = HTMLText & vbCrLf & "</body>"
HTMLText = HTMLText & vbCrLf & "</html>"
'是否使用.htm扩展名
If Check2.Value = 1 Then
htmlFilaName = TextPath.Text & ".htm"
Else
htmlFilaName = TextPath.Text & Combo1.Text
End If
lFileNum = FreeFile
Open htmlFilaName For Output As lFileNum
Print #lFileNum, HTMLText
Close lFileNum
End Sub
Private Sub TextPath_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
KeyAscii = 0
Call SaveHTML
Unload Me
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -