txttohtml.frm

一个用于将.C文件转换为HTML文件

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form TxtToHtml 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "TxtToHtml-高纯"
   ClientHeight    =   7125
   ClientLeft      =   3600
   ClientTop       =   2055
   ClientWidth     =   7875
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7125
   ScaleWidth      =   7875
   Begin VB.CommandButton Command2 
      Caption         =   "转换"
      Height          =   375
      Left            =   2640
      TabIndex        =   3
      Top             =   6700
      Width           =   2535
   End
   Begin RichTextLib.RichTextBox RichTextBox1 
      Height          =   6615
      Left            =   30
      TabIndex        =   2
      Top             =   30
      Width           =   7815
      _ExtentX        =   13785
      _ExtentY        =   11668
      _Version        =   393217
      ScrollBars      =   2
      TextRTF         =   $"TxtToHtml.frx":0000
   End
   Begin VB.CommandButton Command3 
      Caption         =   "保存"
      Height          =   375
      Left            =   5280
      TabIndex        =   1
      Top             =   6720
      Width           =   2535
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   120
      Top             =   5880
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打开"
      Height          =   375
      Left            =   30
      TabIndex        =   0
      Top             =   6720
      Width           =   2535
   End
End
Attribute VB_Name = "TxtToHtml"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Pos As Integer
Public SearchStr As String
Dim keywords(1 To 7) As String

Sub replace(str As String, str2 As String, i As Integer)            '替换程序,i为跳过字符数目
    Pos = InStr(Pos + 1, RichTextBox1.Text, str, vbTextCompare)
    If Pos = 0 Then
        Exit Sub
    End If
    RichTextBox1.SelStart = Pos - 1
    RichTextBox1.SelLength = Len(str)
    RichTextBox1.SelRTF = str2
    Do
        Pos = InStr(Pos + i, RichTextBox1.Text, str, vbTextCompare)
        If Pos <> 0 Then
            RichTextBox1.SelStart = Pos - 1
            RichTextBox1.SelLength = Len(str)
            RichTextBox1.SelRTF = str2
        Else
            Exit Sub
        End If
    Loop
End Sub

Sub replace2(str As String, str2 As String)            '替换以str,以<br>结尾的字符串颜色
Do
    Pos = InStr(Pos + 1, RichTextBox1.Text, str, vbTextCompare)
    If Pos = 0 Then
        Exit Sub
    End If
    RichTextBox1.SelStart = Pos - 1
    RichTextBox1.SelLength = Len("//")
    RichTextBox1.SelRTF = "<font color=" & str2 & ">" & str
    Pos = InStr(Pos + 21, RichTextBox1.Text, "<br>", vbTextCompare)
    If Pos <> 0 Then
        RichTextBox1.SelStart = Pos - 1
        RichTextBox1.SelLength = Len("<br>")
        RichTextBox1.SelRTF = "<br></font>"
    Else
        RichTextBox1.SelStart = Len(RichTextBox1.Text)
        RichTextBox1.SelRTF = "<br></font>"
        Exit Sub
    End If
Loop
End Sub

Sub changecolor(str As String, str2 As String)                       'str为字 str2为颜色
    Dim tstr As String
    tstr = "<font color=" & str2 & ">" & str & "</font>"
    replace str, tstr, 22
End Sub

Private Sub Form_Load()                                              '窗体载入
    Pos = 0
    RichTextBox1.Text = ""
    keywords(1) = "int"
    keywords(2) = "void"
    keywords(3) = "struct"
    keywords(4) = "float"
    keywords(5) = "char"
    keywords(6) = "typedef"
    keywords(7) = "3333FF"
End Sub

Private Sub Command1_Click()                                          '打开文件
RichTextBox1.Text = ""
    CommonDialog1.Filter = "C文件 (*.c)|*.c"
    CommonDialog1.ShowOpen
    Open CommonDialog1.FileName For Input Access Read Lock Write As #1
    FileStr = ""
    Do Until EOF(1)
        Line Input #1, tempstr
        FileStr = FileStr & tempstr & Chr$(13) & Chr$(10)
        RichTextBox1.Text = FileStr
    Loop
    Close #1
End Sub

Private Sub Command2_Click()                                         '开始转换
    replace Chr$(13) & Chr$(10), "<br>" & Chr$(13) & Chr$(10), 5
    replace2 "#", "990000"
    replace2 "//", "#009900"
    replace Chr$(9), "&nbsp&nbsp&nbsp&nbsp", 5
        replace "/*", "<font color=#009900>/*", 21
    replace "*/", "*/</font>", 1
    For i = 1 To 6
        changecolor keywords(i) & " ", keywords(7)
    Next i
    RichTextBox1.Text = "<html>" & Chr$(13) & Chr$(10) & "<head><title>测试</title></head>" & Chr$(13) & Chr$(10) & "<body>" & "<strong>" & Chr$(13) & Chr$(10) & RichTextBox1.Text & Chr$(13) & Chr$(10) & "</strong>" & "</body>" & Chr$(13) & Chr$(10) & "</html>"
End Sub

Private Sub Command3_Click()                                          '保存文件
    Dim ofn As String
    CommonDialog1.Filter = "HTML文件 (*.html)|*.html"
    CommonDialog1.Flags = cdlOFNOverwritePrompt
    CommonDialog1.FileName = ""
    CommonDialog1.ShowSave
    ofn = CommonDialog1.FileName
    Open ofn For Output Access Write As #2
    Print #2, RichTextBox1.Text
    Close #2
End Sub