ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2017年11月21日(火) 20:40

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 3 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2005年9月25日(日) 22:43 
オフライン

登録日時: 2005年8月23日(火) 00:15
記事: 161
住所: 沖縄県
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[i] = 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


通報する
ページトップ
 記事の件名:
投稿記事Posted: 2007年3月10日(土) 21:28 
オフライン

登録日時: 2007年2月11日(日) 01:52
記事: 36
住所: HYOGO pref.
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$()にも同様のバグがありました。


通報する
ページトップ
 記事の件名: 訂正
投稿記事Posted: 2007年3月10日(土) 22:45 
オフライン

登録日時: 2007年2月11日(日) 01:52
記事: 36
住所: HYOGO pref.
URight$()にもバグがあると言ったのは間違いでした。
今さっき試してみたらちゃんと動作しました。すみません。


通報する
ページトップ
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 3 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[1人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke