FreeBASIC KLEN KMID

目次→実行時ライブラリー参考→文字列関数→KLEN と KMID

KLEN と KMID　左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい

KLEN

全角・半角も1文字扱いとして、変数の長さを返します。２バイト系文字１文字を１つの文字として考える事ができます。
渡辺注：Shift_JIS のソース・コード(.bas ファイル)で、Shift_JIS の全角半角を、扱うことができる、KLen を追加しています。

構文:

declare function KLen ( byref variable as String(文字列) ) as Integer

用法:

result = KLen ( variable )

パラメタ:

variable

変数の形式は、String(文字列) を使います。

戻り値:

変数のサイズか、文字数で戻されます。

記述:

KLen は、変数の長さを、文字数で返します。

例 1:ソース・コード(.bas ファイル)は、Shift_JIS で保存

Dim Japanese As WString * 20

Declare Function KLen (mojiretsu As String) As Integer

Japanese = "今日は、世界！"

Print Len("hello world"), KLen("hello world") '戻り値 "11" と "11"
Print Len(Integer) '戻り値 " 4"
Print Len("今日は、世界！"), KLen("今日は、世界！") '戻り値 "14" と "7"
Print Len("今日は、world"), KLen("今日は、world") '戻り値 "13" と "9"
Print Len(Japanese), KLen(Japanese) '戻り値 "7" と "7"

Print "何かキーを押して下さい。"
Sleep

Function KLen (mojiretsu As String) As Integer
Dim i As Integer
Dim cCode As Integer
Dim Result As Integer

Result = 0

For i = 1 To Len(mojiretsu)
cCode = Asc(Mid(mojiretsu, i, 1))
If (cCode >= &h81 And cCode <= &h9F) Or (cCode >= &hE0 And cCode <= &hFF) Then 'コードが2バイト文字の範囲なら
i = i + 1
End If
Result = Result + 1
Next i
KLen = Result
End Function

KMID

全角・半角も1文字扱いとして、文字列の中の、一部分の文字列を返します。２バイト系文字１文字を１つの文字として考える事ができます。
渡辺注：
　Shift_JIS のソース・コード(.bas ファイル)で、Shift_JIS の全角半角を、扱うことができる、KMid を追加しています。

構文:

declare function KMid ( byref str as CONST String(文字列) , byval start as integer, byval n as integer ) as String(文字列)

用法:

result = KMid ( str, start , n )

パラメタ:

str

元になる文字列

start

抽出元の文字列 str の中での、抽出する文字列の開始位置。

n

抽出する文字列の文字数。

記述:

str で指定した文字列の、start 以下の文字列を返します。
str が空ならば、ヌル文字 ("") を返します。
start <= 0 ならば、ヌル文字 ("") を返します。
抽出する文字数を指定しても、 n < 0 か n >= len(str) なら、残っている文字のすべてを返します。

例 2:

英数字と2バイトの日本語が混在する場合の処理例です。
　　参考：ASCII 文字コード表

KLen KMid を使わない方法
ソース・コード(.bas ファイル)は、Shift_JIS で保存

' KLen KMid を使わない方法

Dim As String mojiretsu 
Dim As Integer mojisu
Dim As Integer i
Dim As Integer cCode

Width 60, 30 '横幅を60桁に狭めます
mojiretsu= "、-黑2009年10月04日(曜日Sun.)"
mojisu= Len(mojiretsu)
Print mojiretsu
Print "文字数= ";mojisu
For i=1 to mojisu
   cCode = Asc(Mid(mojiretsu, i, 1))
   If cCode >= 129 And cCode <= 255 Then  'コードが2バイト文字の範囲なら
      Print i,Mid(mojiretsu,i,2),Asc(Mid(mojiretsu,i,1)),"2バイト"
      i = i + 1
   Else
      Print i,Mid(mojiretsu,i,1),Asc(Mid(mojiretsu,i,1)),"1バイト"
   End If
Next i
Print "何かキーを押して下さい。"
Sleep

KLen KMid を使う方法(メインの部分がシンプルでしょう？)
ソース・コード(.bas ファイル)は、Shift_JIS で保存

#include "vbcompat.bi"

Dim As String mojiretsu 
Dim As Integer mojisu
Dim As Integer i

Declare Function KLen (mojiretsu As String) As Integer
Declare Function KMid (mojiretsu As String, start As Integer, mojisu As Integer) As String

Width 60, 30 '横幅を60桁に狭めます
mojiretsu= "、-黑2009年10月04日(曜日Sun.)"
mojisu= KLen(mojiretsu)
Print mojiretsu
Print "文字数= "; mojisu

For i=1 to mojisu
   Print i,KMid(mojiretsu,i,1), Asc(KMid(mojiretsu,i,1)),
   If Len(KMid(mojiretsu,i,1)) =1 Then 
      Print "1バイト"
   Else
      Print "2バイト"
   End If
Next i

Print "何かキーを押して下さい。"
Print
Sleep

' おまけ：今日の日付を使って表示し直します。
Dim Date_Serial As Double = Now ()

Print "今日の日付シリアル値：" ; Date_Serial

mojiretsu= Format (Date_Serial, "yyyy年mm月dd日") & "(" & WeekdayName(Weekday(Date_Serial)) & ")"
Print mojiretsu
mojisu= KLen(mojiretsu)
Print "文字数= "; mojisu
For i=1 to mojisu
   Print i, KMid(mojiretsu,i,1), Asc(KMid(mojiretsu,i,1)),
   If Len(KMid(mojiretsu,i,1)) =1 Then 
      Print "1バイト"
   Else
      Print "2バイト"
   End If
Next i

Print "何かキーを押して下さい。"
Sleep


Function KMid (mojiretsu As String, start As Integer, mojisu As Integer) As String
   Dim inS As Integer
   Dim inN As Integer
   Dim cCode As Integer
   Dim Counter As Integer
   Dim Modori As Integer
   
   Counter = 0
   inS = 0
   While Counter < start
      Modori = 1
      inS = inS + 1
      cCode = Asc(Mid(mojiretsu, inS, 1))
      If (cCode >= &h81 And cCode <= &h9F) Or (cCode >= &hE0 And cCode <= &hFF)  Then  'コードがSJIS2バイト文字の範囲なら
         inS = inS + 1
         Modori = 2
      End If
      Counter = Counter + 1
   Wend
   
   Counter = 0
   inN = 0
   While Counter < mojisu
      inN = inN + 1
      cCode = Asc(Mid(mojiretsu, inS - Modori + inN, 1))
      If (cCode >= &h81 And cCode <= &h9F) Or (cCode >= &hE0 And cCode <= &hFF)  Then  'コードがSJIS2バイト文字の範囲なら
         inN = inN + 1
      End If
      Counter = Counter + 1
   Wend
   
   KMid = Mid (mojiretsu,inS - Modori + 1 ,inN)
End Function

Function KLen (mojiretsu As String) As Integer
   Dim i As Integer
   Dim cCode As Integer
   Dim Result As Integer
   
   Result = 0
   
   For i = 1 To Len(mojiretsu)
      cCode = Asc(Mid(mojiretsu, i, 1))
      If (cCode >= &h81 And cCode <= &h9F) Or (cCode >= &hE0 And cCode <= &hFF)  Then  'コードがSJIS2バイト文字の範囲なら
         i = i + 1
      End If
      Result = Result + 1
   Next i
   KLen = Result
End Function

例 3:
' 目的：青空文庫のルビ表記を、html の「ルビタグ」に変換します。
' 変換前のテキスト(Shift-JIS の html) は、ファイル名を、「mae.html」として、C ドライブの temp フォルダに登録します。
' 変換後のテキスト(Shift-JIS の html) は、同一フォルダに、「ato_Riby.html」というファイル名で作られます。

ソース・コード(.bas ファイル)は、Shift_JIS で保存
サンプルのテキスト・ファイルと、ソースは、ここでダウンロードできます。→RubyTagForFB.zip

　FreeBASIC の本来の関数だけを使った、UNICODE 版も、お試し下さい。さすが、UNICODE 版は、圧倒的な速さで、5秒で処理が終わります。(^^ゞ


Dim InputFile As String
Dim OutputFile As String
Dim InputLine As String
Dim OutputLine As String

Dim bodyFlag As Integer
Dim ProcessingLineCounter As Integer

Dim StartTime As Long
Dim EndTime As Long

Declare Sub HonbunSyori (OutputLine As String, InputLine As String)
Declare Function KLen (mojiretsu As String) As Integer
Declare Function KMid (mojiretsu As String, start As Integer, mojisu As Integer) As String


' 目的：青空文庫のルビ表記を、html の「ルビタグ」に変換します。
' 変換前のテキスト(Shift-JIS の html) は、ファイル名を、「mae.html」 として、C ドライブの temp フォルダに登録します。
' 変換後のテキスト(Shift-JIS の html) は、同一フォルダに、「ato_Riby.html」というファイル名で作られます。

InputFile="c:\temp\mae.html"
OutputFile="c:\temp\ato_Ruby.html"

    
Print Time
StartTime=Val(Left(Time,2))*3600+Val(Mid(Time,4,2))*60+Val(Right(Time,2))


'********************************
'ファイルのオープン。
bodyFlag = 0
ProcessingLineCounter = 0

Open InputFile For Input As #1
Open OutputFile For Output As #2
'*************データの読み込み***********
While (Eof(1) = 0)
    ProcessingLineCounter = ProcessingLineCounter + 1
    Line Input #1, InputLine
    OutputLine = InputLine
    
'        If Trim(InputLine) = "</body>" Then
    If InputLine = "</body>" Then
        bodyFlag = 0
    End If
    
    If bodyFlag = 1 Then
'       本文処理  '★★★★★★★★★
        HonbunSyori (OutputLine , InputLine )
    End If
      
    If Left(InputLine, 5) = "<body" Then
        bodyFlag = 1
    End If
    
    Print #2, OutputLine
    If (ProcessingLineCounter Mod 10) = 0 Then
       Print ProcessingLineCounter , " 行目を読込み"
    End If
       
Wend

'**************終了処理*********************
Print ProcessingLineCounter , " 最終行まで読込み完了"
Close #1: Close #2

   Print Time
EndTime = Val(Left(Time,2))*3600+Val(Mid(Time,4,2))*60+Val(Right(Time,2))
Print "処理が終了しました。"
Print Using"処理時間は、###秒でした。";EndTime-StartTime
Print "処理が終了しました。何かキーを押して下さい。"
Sleep




Sub HonbunSyori (OutputLine As String, InputLine As String)
   

   Dim InputLineNumber As Integer
   Dim Figure As Integer
   Dim BackgroundFlag As Integer
   Dim RubyNumber As Integer
   Dim KanjiFlag As Integer
   Dim RubyFlag As Integer
   Dim BackgroundNumber As Integer
   Dim KanjiNumber As Integer
   
    OutputLine = ""
    BackgroundNumber = 0
    KanjiNumber = 0
    RubyNumber = 0
    KanjiFlag = 0
    RubyFlag = 0
    BackgroundFlag = 1               '行末に > がない場合を考慮

    
    InputLineNumber = KLen(InputLine)
    
    For Figure = InputLineNumber To 1 Step -1        '文字列の後ろから、処理していく点が、ミソ
       
        If KMid(InputLine, Figure, 1) = ">" Then      'タグ内
            BackgroundFlag = 1
        End If
    
        If RubyFlag = 1 Then
            RubyNumber = RubyNumber + 1              'ルビの文字数を数えている
        ElseIf KanjiFlag = 1 Then
            KanjiNumber = KanjiNumber + 1            '漢字の文字数を数えている
        ElseIf BackgroundFlag = 1 Then
            BackgroundNumber = BackgroundNumber + 1  'タグの文字数を数えている
        End If
        
        
        If KanjiFlag = 1 And KMid(InputLine, Figure, 1) = "》" Then   '★★6月5日追加
        
         '#Ifdef __FB_WIN32__
         '   messagebox(NULL, InputLine ,"",MB_OK)
         '#EndIf
        
            OutputLine = "</rt><rp>)</rp></ruby><ruby><rb>" & KMid(InputLine, Figure + 1, KanjiNumber - 1) & OutputLine
            
            KanjiNumber = 0
            KanjiFlag = 0
            
            BackgroundNumber = 0
            RubyNumber = 0     '前回のRubyNumberをリセット
            BackgroundFlag = 0
            RubyFlag = 1
        
        ElseIf KMid (InputLine, Figure, 1) = "》" Then
           
         '#Ifdef __FB_WIN32__
         '   messagebox(NULL, InputLine ,"",MB_OK)
         '#EndIf
           
            OutputLine = "</rt><rp>)</rp></ruby>" & KMid(InputLine, Figure + 1, BackgroundNumber - 1) & OutputLine
            BackgroundNumber = 0
            RubyNumber = 0     '前回のRubyNumberをリセット
            BackgroundFlag = 0
            RubyFlag = 1
            
        ElseIf KMid(InputLine, Figure, 1) = "《" Then
            OutputLine = "</rb><rp>(</rp><rt>" & KMid(InputLine, Figure + 1, RubyNumber - 1) & OutputLine
            KanjiNumber = 0     '前回のKanjiNumberをリセット
            RubyFlag = 0
            KanjiFlag = 1
            
        ElseIf KanjiFlag = 1 And (KMid(InputLine, Figure, 1) = "｜" _
        Or KMid(InputLine, Figure, 1) = "│") Then      '"｜"JIS 8162は記号の縦線。"│"JIS 84A0は罫線の縦線
            '★ガリバー対応★★★★6月5日追加
            OutputLine = "<ruby><rb>" & KMid(InputLine, Figure + 1, KanjiNumber - 1) & OutputLine
            KanjiNumber = 0
            KanjiFlag = 0
            BackgroundFlag = 1
            
        ElseIf KanjiFlag = 1 And (KMid(InputLine, Figure, 1) = "（" _
        Or KMid(InputLine, Figure, 1) = "）") Then       '（例）１円山応挙《まるやまおうきょ》
            '★夜明け前対応★★★★6月6日追加
            OutputLine = "<ruby><rb>" & KMid(InputLine, Figure + 1, KanjiNumber - 1) & OutputLine
            KanjiNumber = 0
            KanjiFlag = 0
            BackgroundFlag = 1
            BackgroundNumber = 1    'Backgroundのところまで侵食したため戻す
            
'        ElseIf KMid(InputLine, Figure + 1, 1) >= "亜" And KanjiNumber > 1 _
'        And KMid(InputLine, Figure, 1) < "亜" Then  '★つぐみ対応★★★★6月5日追加
        
        ElseIf KMid(InputLine, Figure + 1, 1) > "ヶ" And KanjiNumber > 1 _
        And KMid(InputLine, Figure, 1) <= "ヶ" Then  '★大丈夫対応★★★★6月5日追加
            OutputLine = "<ruby><rb>" & KMid(InputLine, Figure + 1, KanjiNumber - 1) & OutputLine
            KanjiNumber = 0
            KanjiFlag = 0
            BackgroundFlag = 1
            BackgroundNumber = 1    'Backgroundのところまで侵食したため戻す
            
        ElseIf RubyNumber > 0 And KanjiNumber = RubyNumber Then
            OutputLine = "<ruby><rb>" & KMid(InputLine, Figure + 1, KanjiNumber - 1) & OutputLine
            KanjiNumber = 0
            KanjiFlag = 0
            BackgroundFlag = 1
            BackgroundNumber = 1    'Backgroundのところまで侵食したため戻す

        ElseIf KanjiFlag = 1 And Figure = 1 Then    '行頭のKanji
            '★夜明け前対応★★★★6月8日追加
            OutputLine = "<ruby><rb>" & KMid(InputLine, Figure, KanjiNumber) & OutputLine
            KanjiNumber = 0
            KanjiFlag = 0

        End If
    
'       If ProcessingLineCounter = 71 Then Stop  '●●▲●●
    
    Next Figure
    
    If BackgroundFlag = 1 And BackgroundNumber > 0 Then
        OutputLine = KMid(InputLine, Figure + 1, BackgroundNumber) & OutputLine
    End If

End Sub

Function KMid (mojiretsu As String, start As Integer, mojisu As Integer) As String
   Dim inS As Integer
   Dim inN As Integer
   Dim cCode As Integer
   Dim Counter As Integer
   Dim Modori As Integer
   
   Counter = 0
   inS = 0
   While Counter < start
      Modori = 1
      inS = inS + 1
      cCode = Asc(Mid(mojiretsu, inS, 1))
      If (cCode >= &h81 And cCode <= &h9F) Or (cCode >= &hE0 And cCode <= &hFF)  Then  'コードがSJIS2バイト文字の範囲なら
         inS = inS + 1
         Modori = 2
      End If
      Counter = Counter + 1
   Wend
   
   Counter = 0
   inN = 0
   While Counter < mojisu
      inN = inN + 1
      cCode = Asc(Mid(mojiretsu, inS - Modori + inN, 1))
      If (cCode >= &h81 And cCode <= &h9F) Or (cCode >= &hE0 And cCode <= &hFF)  Then  'コードがSJIS2バイト文字の範囲なら
         inN = inN + 1
      End If
      Counter = Counter + 1
   Wend
   
   KMid = Mid (mojiretsu,inS - Modori + 1 ,inN)
End Function

Function KLen (mojiretsu As String) As Integer
   Dim i As Integer
   Dim cCode As Integer
   Dim Result As Integer
   
   Result = 0
   
   For i = 1 To Len(mojiretsu)
      cCode = Asc(Mid(mojiretsu, i, 1))
      If (cCode >= &h81 And cCode <= &h9F) Or (cCode >= &hE0 And cCode <= &hFF)  Then  'コードがSJIS2バイト文字の範囲なら
         i = i + 1
      End If
      Result = Result + 1
   Next i
   KLen = Result
End Function

参照:

文字コード判定のサンプル(VB6)
http://nonsoft.la.coocan.jp/SoftSample/SampleModJUDG.html
文字コードを判別する
http://dobon.net/vb/dotnet/string/detectcode.html
文字列関数
http://afsoft.jp/program/p07n.html

文字列関数に戻ります。

←リンク元に戻る　プログラム開発関連に戻る

ページ歴史:2016-09-16
作成:2011-12-16
日本語著作者：WATANABE Makoto

FreeBASIC KLEN KMID

KLEN と KMID 左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい

KLEN

KMID

KLEN と KMID　左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい