「データー圧縮」の編集履歴（バックアップ）一覧はこちら

「データー圧縮」(2010/12/01 (水) 22:46:11) の最新版変更点

追加された行は緑色になります。

削除された行は赤色になります。

#asciiart(blockquote){
'データー圧縮
'
Function Encode(src As *Byte, srclen As DWord, dst As *Byte) As DWord
	Dim i As DWord, j As DWord, k As DWord
	While i < srclen
		dst[j] = src[i]
		k = 0 
		While src[i] = dst[j]
			If k = 255 Or i > srclen Then Exit While
			k=k+1
			i=i+1
		Wend
		j=j+1
		dst[j] = k
		j=j+1
	Wend
	Encode = j
End Function


Function Decode(src As *Byte, srclen As DWord, dst As *Byte) As DWord
	Dim i As DWord, j As DWord, k As DWord
	While i < srclen
		dst[j] = src[i]
		For k=0 To src[i+1]-1
			dst[j+k]=src[i]
		Next
		i=i+2
		j=j+k
	Wend
	Decode = j
End Function

Function RleStr(src As *Byte, srclen As DWord) As String
	Dim s As String
	Dim i As DWord
	For i=0 To srclen-1 Step 2
		s = s + Chr$(src[i]) + "[" + Str$(src[i+1]) + "]"
	Next
	RleStr = s
End Function


#N88BASIC
Dim isrc[100] As *Byte
Dim idst[200] As *Byte
Dim idst2[100] As *Byte

Dim isrclen As DWord
Dim idstlen As DWord
Dim idst2len As DWord

lstrcpy(isrc, "AAAAAAAADDDDDDEEEECBBBBBBBBBCCCC")
isrclen = lstrlen(isrc)


idstlen = Encode(isrc, isrclen, idst)
Print "変換前=";MakeStr(isrc)
Print "変換後=";RleStr(idst, idstlen)

Print lstrlen(isrc);"→";idstlen;"(";idstlen/isrclen*100;"%)"

ZeroMemory(isrc, 100)
idst2len = Decode(idst, idstlen, idst2)

Print "復　元=";MakeStr(idst2)
Print idstlen;"→";idst2len;"(";idst2len/idstlen*100;"%)"

 'データー圧縮
 '
 Function Encode(src As *Byte, srclen As DWord, dst As *Byte) As DWord 
 	Dim i As DWord, j As DWord, k As DWord
 	While i < srclen
 		dst[j] = src[i]
 		k = 0 
 		While src[i] = dst[j]
 			If k = 255 Or i > srclen Then Exit While
 			k=k+1
 			i=i+1
 		Wend
 		j=j+1
 		dst[j] = k
 		j=j+1
 	Wend
 	Encode = j
 End Function
 
 
 Function Decode(src As *Byte, srclen As DWord, dst As *Byte) As DWord
 	Dim i As DWord, j As DWord, k As DWord
 	While i < srclen
 		dst[j] = src[i]
 		For k=0 To src[i+1]-1
 			dst[j+k]=src[i]
 		Next
 		i=i+2
 		j=j+k
 	Wend
 	Decode = j
 End Function
 
 Function RleStr(src As *Byte, srclen As DWord) As String
 	Dim s As String
 	Dim i As DWord
 	For i=0 To srclen-1 Step 2
 		s = s + Chr$(src[i]) + "[" + Str$(src[i+1]) + "]"
 	Next
 	RleStr = s
 End Function
 
 
 #N88BASIC
 Dim isrc[100] As *Byte
 Dim idst[200] As *Byte
 Dim idst2[100] As *Byte
 
 Dim isrclen As DWord
 Dim idstlen As DWord
 Dim idst2len As DWord
 
 lstrcpy(isrc, "AAAAAAAADDDDDDEEEECBBBBBBBBBCCCC")
 isrclen = lstrlen(isrc)
 
 
 idstlen = Encode(isrc, isrclen, idst)
 Print "変換前=";MakeStr(isrc)
 Print "変換後=";RleStr(idst, idstlen)
 
 Print lstrlen(isrc);"→";idstlen;"(";idstlen/isrclen*100;"%)"
 
 ZeroMemory(isrc, 100)
 idst2len = Decode(idst, idstlen, idst2)
 
 Print "復　元=";MakeStr(idst2)
 Print idstlen;"→";idst2len;"(";idst2len/idstlen*100;"%)"