www.pudn.com > 847t.rar > RLE.FRM

VERSION 4.00 
Begin VB.Form Form1  
   Caption         =   "Form1" 
   ClientHeight    =   1815 
   ClientLeft      =   2925 
   ClientTop       =   2775 
   ClientWidth     =   3855 
   Height          =   2220 
   Left            =   2865 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   1815 
   ScaleWidth      =   3855 
   Top             =   2430 
   Width           =   3975 
   Begin VB.CommandButton Command2  
      Caption         =   "Command2" 
      Height          =   495 
      Left            =   2520 
      TabIndex        =   4 
      Top             =   1200 
      Width           =   1215 
   End 
   Begin VB.CommandButton Command1  
      Caption         =   "Command1" 
      Height          =   495 
      Left            =   120 
      TabIndex        =   3 
      Top             =   1200 
      Width           =   1215 
   End 
   Begin VB.TextBox Text3  
      Height          =   285 
      Left            =   120 
      TabIndex        =   2 
      Text            =   "Text3" 
      Top             =   840 
      Width           =   3615 
   End 
   Begin VB.TextBox Text2  
      Height          =   285 
      Left            =   120 
      TabIndex        =   1 
      Text            =   "Text2" 
      Top             =   480 
      Width           =   3615 
   End 
   Begin VB.TextBox Text1  
      Height          =   285 
      Left            =   120 
      TabIndex        =   0 
      Text            =   "Text1" 
      Top             =   120 
      Width           =   3615 
   End 
End 
Attribute VB_Name = "Form1" 
Attribute VB_Creatable = False 
Attribute VB_Exposed = False 
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) 
        ThisChar = Mid$(InputString, 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) 
                    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 Encode" 
    Command2.Caption = "RLE Decode" 
     
    Text1.Text = "AAAAAAAAAABBBBBBBBBBCCCCC" 
    Text2.Text = "" 
    Text3.Text = "" 
End Sub