サンプル投稿用掲示板 VB2005 〜 用トップページ VB6.0 用 トップページ
- 日時： 2009/05/16 19:58
- 名前： 魔界の仮面弁士
- ***********************************************************************************
* カテゴリー：[文字列処理][基本コード][] *
* キーワード：StrConv,文字コード,変換,半角,全角,Unicode *
***********************************************************************************
Left/Mid/Right 関数を、「バイト単位で処理」するための文字列処理関数群です。
1999 年当時に作っていた物。今更不要かと思いましたが、
掲示板の質問に挙がって来たので発掘してみました。
# Mid ステートメントのために、Property Let 実装したバージョンも
# どこかにあるはずなのだけれども、コード喪失…。
Public Function LenA(ByVal Source As String) As Long
'********1*********2*********3*********4*********5*********6*********7*********8
'*: Name : LenA (Function)
'*:
'*: Descripition: 文字列のANSIバイト数を返します。
'*:
'*: Arguments : Source (i) 対象文字列式。
'*:
'*: Return : SourceのANSI 換算時のバイト数を返します。
'*:
'********1*********2*********3*********4*********5*********6*********7*********8
LenA = LenB(StrConv(Source, vbFromUnicode))
End Function
Public Function LeftA(ByVal Source As String, _
ByVal Length As Long, _
Optional ByVal NoCheck As Boolean = False _
) As String
'********1*********2*********3*********4*********5*********6*********7*********8
'*: Name : LeftA (Function)
'*:
'*: Descripition: 文字列の左端から指定したANSIバイト数分の文字列を返します。
'*: 16bit版VBのLeftB関数と、ほぼ同じ動作です。
'*:
'*: Arguments : Source (i) この文字列式の左端から文字列が取り出されます。
'*: Length (i) 取り出す文字列のバイト数を表す数式を指定します。
'*: NoCheck [i] 2バイト文字の分断を無視するかどうかを指定します。
'*: True : 2バイト文字分断チェックを行わない
'*: False : 2バイト文字分断チェックを行う(規定値)
'*:
'*: Return : Sourceを左からLengthバイト取り出した文字列を返します。
'*:
'*: Notes : 2バイト文字が分断される場合は、以下のように処理されます。
'*: NoCheck = True の場合：末尾にDBCSの先導バイトが混入します。
'*: NoCheck = Falseの場合：分断される文字は切り捨てられます。
'*:
'********1*********2*********3*********4*********5*********6*********7*********8
Dim B() As Byte, W() As Byte
Dim L As Long
If Length <= 0 Then
LeftA = ""
Exit Function
End If
If NoCheck Then
B = LeftB$(StrConv(Source, vbFromUnicode), Length)
Else
For L = 1 To Length
W = StrConv(Left$(Source, L), vbFromUnicode)
If UBound(W) > Length - 1 Then
Exit For
Else
B = W
End If
Next L
End If
LeftA = StrConv(CStr(B), vbUnicode)
End Function
Public Function RightA(ByVal Source As String, _
ByVal Length As Long, _
Optional ByVal NoCheck As Boolean = False _
) As String
'********1*********2*********3*********4*********5*********6*********7*********8
'*: Name : RightA (Function)
'*:
'*: Descripition: 文字列の右端から指定したANSIバイト数分の文字列を返します。
'*: 16bit版VBのRightB関数と、ほぼ同じ動作です。
'*:
'*: Arguments : Source (i) この文字列式の右端から文字列を取り出します。
'*: Length (i) 取り出す文字列のバイト数を表す数式を指定します。
'*: NoCheck [i] 2バイト文字の分断を無視するかどうかを指定します。
'*: True : 2バイト文字分断チェックを行わない
'*: False : 2バイト文字分断チェックを行う(規定値)
'*:
'*: Return : Sourceを右からLengthバイト取り出した文字列を返します。
'*:
'*: Notes : 2バイト文字が分断される場合は、以下のように処理されます。
'*: NoCheck = True の場合：先頭にあるDBCS文字をそのまま分断します。
'*: NoCheck = Falseの場合：分断される文字は切り捨てられます。
'*:
'********1*********2*********3*********4*********5*********6*********7*********8
Dim B() As Byte, W() As Byte
Dim L As Long
If Length <= 0 Then
RightA = ""
Exit Function
End If
If NoCheck Then
B = RightB$(StrConv(Source, vbFromUnicode), Length)
Else
For L = 1 To Length
W = StrConv(RightB$(Source, L), vbFromUnicode)
If UBound(W) > Length - 1 Then
Exit For
Else
B = W
End If
Next L
End If
RightA = StrConv(CStr(B), vbUnicode)
End Function
Public Function MidA(ByVal Source As String, _
ByVal Start As Long, _
Optional ByVal Length As Variant, _
Optional ByVal NoCheck As Boolean = False _
) As String
'********1*********2*********3*********4*********5*********6*********7*********8
'*: Name : MidA (Function)
'*:
'*: Descripition: 文字列から指定したANSIバイト数分の文字列を返します。
'*: 16bit版VBのMidB関数と、ほぼ同じ動作です。
'*:
'*: Arguments : Source (i) 文字列を取り出す、元の文字列式を指定します。
'*: Start (i) Sourceの先頭の位置を1として、どの位置から文字列を
'*: 取り出すかを、先頭からのバイト数で指定します。
'*: Length [i] 取り出す文字列のバイト数を表す数式を指定します。
'*: NoCheck [i] 2バイト文字の分断を無視するかどうかを指定します。
'*: True : 2バイト文字分断チェックを行わない
'*: False : 2バイト文字分断チェックを行う(規定値)
'*:
'*: Return : Sourceを右からLengthバイト取り出した文字列を返します。
'*:
'*: Notes : 2バイト文字が分断される場合は、以下のように処理されます。
'*: NoCheck = True の場合：先頭にあるDBCS文字をそのまま分断します。
'*: NoCheck = Falseの場合：分断される文字は切り捨てられます。
'*:
'********1*********2*********3*********4*********5*********6*********7*********8
Dim B() As Byte, W() As Byte
Dim L As Long
Dim lngStart As Long, lngLength As Long
If IsMissing(Length) Then
lngLength = LenB(MidB(StrConv(Source, vbFromUnicode), Start))
Else
lngLength = Length
End If
If lngLength = 0 Then
MidA = ""
Exit Function
End If
If NoCheck Then
B = MidB$(StrConv(Source, vbFromUnicode), Start, lngLength)
Else
B = ""
lngStart = Start
For L = 1 To Start - 1
If LenA(Left(Source, L)) >= Start - 1 Then
lngStart = L + 1
Exit For
End If
Next L
For L = 1 To lngLength
W = StrConv(Mid$(Source, lngStart, L), vbFromUnicode)
If UBound(W) > lngLength - 1 Then
Exit For
Else
B = W
End If
Next L
End If
MidA = StrConv(CStr(B), vbUnicode)
End Function
'------------
なお MidA の NoCheck 引数は、全角文字を分断するような指定がなされた場合、
その取扱いを変更するためのものです。
Source = "≠＝!=-"
A0 = MidA(Source, 1, 4) '『≠＝』
B0 = MidA(Source, 1, 4, True) '『≠＝』
A1 = MidA(Source, 2, 3) '『＝!』 開始位置を 2 から 3 にずらして取得
B1 = MidA(Source, 2, 3, True) '『ａ』 開始位置が全角文字を分断するため、正しい文字列にならない
A2 = MidA(Source, 2, 4) '『＝!=』開始位置を 2 から 3 にずらして取得
A2 = MidA(Source, 2, 4, True) '『ａ・』開始位置と終了位置の両方が全角文字を分断して、正しい文字列にならない
A3 = MidA(Source, 3, 3) '『＝!』
B3 = MidA(Source, 3, 3, True) '『＝!』
A4 = MidA(Source, 4, 3) '『!=-』 開始位置を 4 から 5 にずらして取得
B4 = MidA(Source, 4, 3, True) '『・=』 開始位置が全角文字を分断するため、正しい文字列にならない
A5 = MidA(Source, 5, 3) '『!=-』
B5 = MidA(Source, 5, 3, True) '『!=-』
 |
