求助vb程序

来源:互联网 发布:药品质量监测网络平台 编辑:程序博客网 时间:2024/05/16 09:09

这是一个rle编码程序,目的是这样,将qqqqq压缩成q*5,但是程序有点错误,请强人帮忙改改,偶新学vb不懂.还麻烦各位将编码和译码一块详细解释一下,谢谢了

Function RLEDecode(InputString As String) As String

    Dim RLEString As String
    Dim TextString As String
    Dim x As Integer
   
    For x = 1 To Len(InputString) 'len ³¤¶È²â¶¨
    ThisChar = Mid$(InputString, x, 1) '´Ó×Ö·û´®Öзµ»ØÖ¸¶¨ÊýÄ¿µÄ×Ö·û¡£x±íʾ¿ªÊ¼×Ö·û£¬1×Ö·ûÊý
        If ThisChar = "*" Then
            TextString = TextString & String$(Asc(Mid$(InputString, x + 1, 1)), PrevChar)
            x = x + 1
        Else
            TextString = TextString & ThisChar
        End If
       
        PrevChar = ThisChar
    Next x
   
    RLEDecode = TextString

End Function

Function RLEEncode(InputString As String) As String

    Dim LastChar As String
    Dim ThisChar As String
    Dim RLEString As String
    Dim DupeChar As String
    Dim x As Integer
    Dim RepeatCount As Integer
   
    RepeatCount = 0
    For x = 1 To Len(InputString)
        ThisChar = Mid$(InputString, x, 1)
        If LastChar = ThisChar Then
           
            'If there is only 1 repeating (like the e in Cheese)
            'then don't encode
            'because it will take 1 extra byte <>²»µÈÓÚ
            If Mid$(InputString$, x + 1, 1) <> ThisChar And _
                RepeatCount = 0 Then
                RLEString = RLEString & ThisChar
                LastChar = ThisChar
            Else
                RepeatCount = RepeatCount + 1
       
                'We can only encode up to 254 repeats after that
                'we have to start the new sequence again
                If RepeatCount = 254 Then
                    RLEString = RLEString & "*" & Chr$(RepeatCount)
                    'chr $·µ»Ø String£¬ÆäÖаüº¬ÓÐÓëÖ¸¶¨µÄ×Ö·û´úÂëÏà¹ØµÄ×Ö·û ¡£

                    'Óï·¨

                    'Chr (charcode)

                    '±ØÒªµÄ charcode ²ÎÊýÊÇÒ»¸öÓÃÀ´Ê¶±ðij×Ö·ûµÄ Long¡£


                    RepeatCount = 0
                    LastChar = ""
                End If
            End If
        Else
            If RepeatCount > 0 Then
                RLEString = RLEString & "*" & Chr$(RepeatCount)
                RepeatCount = 0
            End If
   
            RLEString = RLEString & ThisChar
            LastChar = ThisChar
        End If
    Next x
   
    'If the last chars in string are repeats
    If RepeatCount > 0 Then
        RLEString = RLEString & "*" & Chr$(RepeatCount)
        RepeatCount = 0
    End If
   
    RLEEncode = RLEString

End Function

Private Sub Command1_Click()

Dim RLEEncodedString As String
    Dim temp As String
   
    temp = Text1.Text
   
    RLEEncodedString = RLEEncode(temp)
   
    Text2.Text = RLEEncodedString
   
    MsgBox "Encoded Length = " & Str$(Len(RLEEncodedString))

End Sub

Private Sub Command2_Click()

Dim temp As String
    Dim DecodedString As String
   
    temp = Text2.Text
   
    DecodedString = RLEDecode(temp)
   
    Text3.Text = DecodedString
    MsgBox "Decoded length = " & Str$(Len(DecodedString))

End Sub


Private Sub Form_Load()

Me.Caption = "Run Length Encode Example"
Command1.Caption = "RLE ±àÂë"
    Command2.Caption = "RLE ÒëÂë"
   
    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
End Sub


 

原创粉丝点击