ab.com コミュニティ https://www.activebasic.com/forum/ |
|
[AB4]UNICODE対応文字列処理 https://www.activebasic.com/forum/viewtopic.php?t=352 |
ページ 1 / 1 |
作成者: | マティ [ 2005年9月25日(日) 22:43 ] |
記事の件名: | [AB4]UNICODE対応文字列処理 |
SJIS専用の文字列処理関数群が不人気だったので、Unicode用の専用関数郡を作成しました。 [AB4]で動作確認しました、関数郡はUから始まります。 ULen, ULeft$, URight$, UMid$, UInStrを乗せました。ホームページに、URim,ULRim,URRim等の関数もあります。 この関数郡を使用するには、元データがユニコードである必要があります。 関連関数として、StrConv関数をホームページで準備していますが、"UTF8→Shift-JISへの変換"を応用しても作成可能です。 しかし、データはString型で作成する必要があります。 コード: '----------------------------------------------------------- ' 文字数を調べる '----------------------------------------------------------- Function ULen( Text As String ) As Long ULen = Len( Text ) >> 1 '文字数を返す(バイトの半分) End Function '----------------------------------------------------------- ' 左側から取り出す '----------------------------------------------------------- Function ULeft$( Text As String, nChar As Long ) As String If(nChar <= 0)Then Exit Function '処理不能 ULeft$ = UStrCopy$( Text, 0, nChar ) '文字列を返す End Function '----------------------------------------------------------- ' 右側から取り出す '----------------------------------------------------------- Function URight$( Text As String, nChar As Long ) As String Dim s As Long s = ULen(Text) - nChar If(nChar <= 0)Then Exit Function '処理不能 If(s < 0)Then Exit Function '処理不能 URight$ = UStrCopy$( Text, s, nChar ) '文字列を返す End Function '----------------------------------------------------------- ' 指定位置から指定分の文字を取り出す!!! '----------------------------------------------------------- Function UMid$( Text As String, Start As Long )( nChar As Long ) As String Dim n As Long If(Start <= 0)Then Exit Function '処理不能 If(nChar < 0)Then Exit Function '処理不能 n = ULen( Text ) - Start If(nChar > n)Or(nChar = 0)Then nChar = n '最後まで処理する UMid$ = UStrCopy$( Text, Start-1, nChar ) '文字列を返す End Function '----------------------------------------------------------- ' 文字列中から一致する文字を検索します。 '----------------------------------------------------------- Function UInStr( Start As Long, Text As String, KeyWord As String ) As Long Dim i As Long, j As Long, n As Long, c As Byte Dim n1 As Long, n2 As Long Dim b1 As Long, b2 As Long '前処理 n1=ULen( Text ) n2=ULen( KeyWord ) If((n1 - Start + 1) < n2 )Then Exit Function '処理不能 If(n2 = 0)Then Exit Function '処理不能 If(Start <= 0)Then Exit Function '処理不能 If(Start > n1)Then Exit Function '処理不能 '比較本処理 UInStr=UTextFind( Start-1, Text, n1-1, KeyWord, n2-1 ) End Function コード: '************************************************************************************ ' 内部関数です!仕様の変更が多々ありますので、あまり外部から呼び出さないで下さい。 '************************************************************************************ '----------------------------------------------------------- ' 返却用の文字列を作成する '----------------------------------------------------------- Function UStrCopy$( Text As WordPtr, nStart As Long, nWord As Long ) As String Dim nByte As Long If(nWord > 0)Then nStart = nStart << 1 '開始位置 nByte = nWord << 1 '必要バイト数 UStrCopy$ = ZeroString( nByte ) '返却用領域作成 memcpy( StrPtr(UStrCopy$), Text+nStart, nByte ) '返却文字列コピー End If End Function '----------------------------------------------------------- ' 文字列検索 '----------------------------------------------------------- Function UTextFind( Start As Long, Text As WordPtr,n1 As Long, KeyWord As WordPtr, n2 As Long ) As Long Dim i As Long, j As Long, c As Word c = KeyWord[0] For i=Start to (n1-n2) If( Text = c )Then For j=1 To n2 If( Text[i+j] <> KeyWord[j] ) Then Exit For Next if(j > n2)Then UTextFind=i+1: Exit Function End If Next End Function |
作成者: | THEREMIN [ 2007年3月10日(土) 21:28 ] |
記事の件名: | |
UMid$()にバグがあります。 n = ULen( Text ) - Start +1 とするべきです。でないと、最後の文字が取得されなくなってしまいます。 確認も兼ねてbasic\function.sbp のMid$()を参照しましたが、こちらではStartPos=StartPos-1としているようです。 なので、 コード: Function UMid$( Text As String, Start As Long )( nChar As Long ) As String Dim n As Long Start = Start-1 If(Start < 0)Then Exit Function '処理不能条件 If(nChar < 0)Then Exit Function '処理不能条件 n = ULen( Text ) - Start If(nChar > n)Or(nChar = 0)Then nChar = n '最後まで処理する UMid$ = UStrCopy$( Text, Start, nChar ) '文字列を返す End Functionこんな感じにすると良いと思います。 もしやと思って調べてみたら、URight$()にも同様のバグがありました。 |
作成者: | THEREMIN [ 2007年3月10日(土) 22:45 ] |
記事の件名: | 訂正 |
URight$()にもバグがあると言ったのは間違いでした。 今さっき試してみたらちゃんと動作しました。すみません。 |
ページ 1 / 1 | 全ての表示時間は UTC+09:00 です |
Powered by phpBB® Forum Software © phpBB Limited https://www.phpbb.com/ |