ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2024年3月28日(木) 21:36

全ての表示時間は UTC+09:00 です




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

登録日時: 2005年8月23日(火) 00:15
記事: 161
お住まい: 沖縄県
SJIS専用の文字列処理関数群を作成しました。
[AB4]で動作確認しました関数名からKを取ると標準の関数と互換になっていると思います。
KLen, KLeft$, KRight$, KMid$, KInStrを乗せました。ホームページに、KRim,KLRim,KRRim等の関数もあります

[AB4]はString型が非推奨になっていますので、AP側でバッファーを持つ形式の関数を準備するつもりですが、APIを決めかねています。皆さんの知恵をお貸し下さい。
コード:
Const MaxCharactors = &h10000000                   '最大文字数

'-----------------------------------------------------------
' 文字数を調べる
'-----------------------------------------------------------
Function KLen( Text As BytePtr ) As Long
    KLen = KNumChar( Text )                     '文字数を返す
End Function

'-----------------------------------------------------------
' 左側から取り出す
'-----------------------------------------------------------
Function KLeft$( Text As String, nChar As Long ) As String
    If(nChar <= 0)Then Exit Function        '処理不能
    KLeft$ = KStrCopy$( Text, 0, KNumByte(Text, nChar) )    '文字列を返す
End Function

'-----------------------------------------------------------
' 右側から取り出す
'-----------------------------------------------------------
Function KRight$( Text As String, nChar As Long ) As String
    Dim b As Long, s As Long
    If(nChar <= 0)Then Exit Function        '処理不能
    s = KNumByte( StrPtr(Text)  , KNumChar( Text ) - nChar )    '開始バイト
    b = Len( Text ) - s                         '転送バイト数
    KRight$ = KStrCopy$( Text, s, b )           '文字列を返す
End Function

'-----------------------------------------------------------
' 指定位置から指定分の文字を取り出す!!!
'-----------------------------------------------------------
Function KMid$( Text As String, Start As Long )( nChar As Long ) As String
    Dim b As Long, s As Long
    If(Start <= 0)Then Exit Function        '処理不能
    If(nChar <  0)Then Exit Function        '処理不能
    If(nChar  = 0)Then nChar = MaxCharactors    '最後まで処理する
    s = KNumByte( StrPtr(Text)  , Start-1 )         '開始バイト
    b = KNumByte( StrPtr(Text)+s, nChar   )         '転送バイト数
    KMid$ = KStrCopy$( Text, s, b )                 '文字列を返す
End Function

'-----------------------------------------------------------
' 文字列中から一致する文字を検索します。
'-----------------------------------------------------------
Function KInStr( 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
    '前処理
    KCheckEx( Text,    MaxCharactors, n1, b1 )
    KCheckEx( KeyWord, MaxCharactors, n2, b2 )
    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        '処理不能
    '比較本処理
    n = Start: i = KNumByte( StrPtr(Text), n-1 )
    Do
        c = Text
        If( KeyWord[0] = c )Then
            For j=1 To (b2 - 1)
                If( Text[i+j] <> KeyWord[j] ) Then Exit For
            Next
            if(j = b2)Then KInStr=n: Exit Function
        End If
        n  = n  + 1
        i = i + 1 - ((((c >> 1)Xor c)And &hA0) = &h80)    '2Byte?
    Loop
End Function
コード:
'************************************************************************************
' 内部関数です!仕様の変更が多々ありますので、あまり外部から呼び出さないで下さい。
'************************************************************************************
'-----------------------------------------------------------
' 指定した文字数までのバイト数を調べる(文字数指定あり)
'-----------------------------------------------------------
Function KNumByte( Text As BytePtr, nChar As Long) As Long
    Dim Dummy As Long                               'Dummyデータ
    KCheckEx( Text, nChar, Dummy, KNumByte )        'バイト数を返す
End Function

'-----------------------------------------------------------
' 文字列の文字数を調べる
'-----------------------------------------------------------
Function KNumChar( Text As BytePtr ) As Long
    Dim Dummy As Long                               'Dummyデータ
    KCheckEx( Text, MaxCharactors, KNumChar, Dummy )'文字数を返す
End Function

'-----------------------------------------------------------
' 文字列の文字数&バイト数を調べる(文字数指定あり)
'-----------------------------------------------------------
Sub KCheckEx( Text As BytePtr, nLen As Long, ByRef nChar As Long, ByRef nByte As Long)
    Dim n As Long, i As Long, c As Byte
    '
    If(nLen > 0)Then
        Do
            c = Text(i): if(c = 0)Then Exit Do
            i = i + 1 - ((((c >> 1)Xor c)And &hA0) = &h80)    '2Byte?
            n = n + 1
        Loop While ( n < nLen )
    End If
    nByte = i        'バイト数
    nChar = n        '文字数
End Sub

'-----------------------------------------------------------
' 返却用の文字列を作成する
'-----------------------------------------------------------
Function KStrCopy$( Text As String, nStart As Long, nByte As Long ) As String
    If(nByte > 0)Then
        KStrCopy$ = ZeroString( nByte )                            '返却用領域作成
        memcpy( StrPtr(KStrCopy$), StrPtr(Text)+nStart, nByte )    '返却文字列コピー
    End If
End Function


通報する
ページトップ
投稿記事Posted: 2006年6月17日(土) 03:22 
お世話になります。

AV2で作った下記のプログラムが、おかげさまでAV4でも動きました!
感謝です。
m(__)m

#N88BASIC

100 dim mojiretsu$ as string
110 dim mojisu as integer
120 dim i as integer
130 dim a$ as string

140 mojiretsu$ = "2006年06月18日(曜日Sun.)"
150 mojisu = KLen(mojiretsu$)
160 Print mojisu
170 for i=1 to mojisu
180 Print KMid$(mojiretsu$,i,1)
190 next i
200 Input a$
210 end


19
2
0
0
6

0
6

1
8

(


S
u
n
.
)

http://makotowatana.ld.infoseek.co.jp/


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

全ての表示時間は UTC+09:00 です


オンラインデータ

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


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

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