FreeBASIC マニュアルのトップに戻る

FreeBASIC Wstr

目次→言語リファレンス→変数とデータ型→データ型を変換→WSTR←オリジナル・サイト
目次→実行時ライブラリー参考→文字列関数→WSTR←オリジナル・サイト

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

←リンク元に戻る　プログラム開発関連に戻る
数かASCII文字列の、ワイド・キャラクター文字列表現を返します。

構文:
declare function Wstr ( byval n as byte ) as wstring
declare function Wstr ( byval n as ubyte ) as wstring
declare function Wstr ( byval n as short ) as wstring
declare function Wstr ( byval n as ushort ) as wstring
declare function Wstr ( byval n as long ) as wstring
declare function Wstr ( byval n as ulong ) as wstring
declare function Wstr ( byval n as longint ) as wstring
declare function Wstr ( byval n as ulongint ) as wstring
declare function Wstr ( byval n as single ) as wstring
declare function Wstr ( byval n as double ) as wstring
declare function Wstr ( byref str as const string ) as wstring
declare function Wstr ( byval str as const wstring ptr ) as wstring

用法:
result = Wstr ( number )
or
result = Wstr ( string )

パラメタ:
number
ワイド・キャラクター文字列に変換する対象の、数値表現。
string
ワイド・キャラクター文字列に変換する対象の、文字列表現。

戻り値:
数値か文字列表現の、ワイド・キャラクター表現を返します。

記述:
Wstr は、数値変数を、そのワイド・キャラクター文字列表現に変換します。
それは、Str に相当する、ワイド・キャラクターです。

また、Wstr は、ASCII文字列を、ユニコード文字列に変換します。
もし、ワイド・キャラクター文字列を与えると、その文字列を変換しないで、そのまま返します。

今日は世界 例:このプログラムは、文字コード ShiftJIS で保存します。

# if defined ( __FB_WIN32__ )
# include "windows.bi"
# endif

Dim zs As ZString * 20
Dim ws As WString * 20

zs = "今日は　世界！"
ws = WStr (zs)

# if defined ( __FB_WIN32__ )

MessageBox (null, ws, WStr("Unicode '今日は　世界！'"), MB_OK Or MB_ICONINFORMATION)

# else

Print ws
Print WStr ("Unicode 'Hello World'")

# endif



　これは Str と WStr の使い分けの例です。
'Str&WStr.bas

'Unicode対応 文字コード表
'http://ash.jp/code/unitbl21.htm

Print "漢",                         Asc("漢")      & Asc("漢",2), Hex(Asc("漢"))      & Hex(Asc("漢",2))
Print "Str(""漢""): "  & Str("漢"), Asc(Str("漢")) & Asc("漢",2), Hex(Asc(Str("漢"))) & Hex(Asc(Str("漢"),2))
Print "WStr(""漢""): " & WStr("漢"), "u" & Asc(WStr("漢")), "u" & Hex(Asc(WStr("漢")))
Print "WStr(""字""): " & WStr("字"), "u" & Asc(WStr("字")), "u" & Hex(Asc(WStr("字")))


Dim ff As UByte

ff = FreeFile
Open "testASCII.txt" For Output As #ff
Print #ff, "漢"
Print #ff, "Str(""漢""): " & Str("漢")
Print #ff, "WStr(""漢""): " & WStr("漢")

Close #ff

ff = FreeFile
Open "testUTF16.txt" For Output Encoding "utf-16" As #ff
Print #ff, "漢"
Print #ff, "Str(""漢""): " & Str("漢")
Print #ff, "WStr(""漢""): " & WStr("漢")

Close #ff

Sleep


　下の例は、テキスト・ファイルの文字コードを ShiftJIS ⇔ UTF16 ⇔ UTF8(BOM付き) 変換する例です。
'ConvertCharacterEncoding1.bas

#Include "window9.bi"

Dim Shared Before As String
Dim Shared After As String
Dim Shared Expression As String

'文字列置換
'STRreplace
Declare Function STRreplace (ByVal StrEx As String, ByVal StrMask As String, ByVal StrRplce As String) As String
'https://www.freebasic-portal.de/code-beispiele/string-funktionen/strreplace-59.html
'Eternal_Pain	 '03.08.2007


Sub ConvertEncoding
   /'
      ★★★★★★★★★★★★
      テキスト・ファイルの文字コードを変換する例
   '/
   
   Dim FullPass As String  '対象ファイルのフルパス
   Dim FullPassAfter As String  '変換後のフルパス
   Dim Extension As String
   Dim LineCounter As Integer
   Dim StringVariable As String
   Dim WideStringVariable As WString *3000

   '調べたい文字列を含むファイルを入力する
   '********************* Window9 のファイルを開くダイアログを使う *********************
   Var ddd = OpenFileRequester("Specify English text file",ExePath,"Text File(*.txt;*.csv;*.htm*)"_
   +Chr(0)+"*.txt;*.csv;*.htm*"+Chr(0)+"All File(*.*)"+Chr(0)+"*.*"+Chr(0))
   
   FullPass = Str(ddd)
   
   If FullPass<>"" Then
   
      '' 入出ファイルを開きます。
      '' エラーが有れば、抜けます。
      Select Case Before
         Case "UTF8"
            If( Open( FullPass For Input Encoding "utf-8" As #1 ) ) Then
               Print "ERROR: 開こうとしたファイル名 " ; FullPass
               Sleep
               End -1
            End If

         Case "UTF16"
            If( Open( FullPass For Input Encoding "utf-16" As #1 ) ) Then
               Print "ERROR: 開こうとしたファイル名 " ; FullPass
               Sleep
               End -1
            End If

         Case Else
            If( Open( FullPass For Input As #1 ) ) Then
               Print "ERROR: 開こうとしたファイル名 " ; FullPass
               Sleep
               End -1
            End If
      End Select
      
      Extension = GetExtensionPart(FullPass)
      '' 出力ファイルを開きます。
      Select Case After
         Case "UTF8"
            FullPassAfter = STRreplace(FullPass , "." & Extension, "_UTF8." & Extension)
            Open FullPassAfter For Output Encoding "utf-8" As #2

         Case "UTF16"
            FullPassAfter = STRreplace(FullPass ,"." & Extension, "_UTF16." & Extension)
            Open FullPassAfter For Output Encoding "utf-16" As #2

         Case Else
            FullPassAfter = STRreplace(FullPass , "." & Extension, "_ShiftJIS." & Extension)
            Open FullPassAfter For Output As #2
      End Select
      
      ? FullPass
      ? Extension
      ? FullPassAfter
      'Sleep
            
      ' テキストファイルの内容を読み込む
      LineCounter = 0
   
      If Lof(1) > 0 Then 'ファイルが存在する場合
         Do Until EOF(1)
            '1行読み込み
   
            If Before <>"JIS" Then
               Line Input #1, WideStringVariable
               '? WideStringVariable
               'Sleep
            Else
               Line Input #1, StringVariable
               WideStringVariable = WStr(StringVariable)
               '? StringVariable
            EndIf
            
            LineCounter = LineCounter + 1
   
            If After = "JIS" Then
               StringVariable = WideStringVariable    '' ワイドから、日本語マルチバイトに変換
               Print #2, StringVariable               '' ... そして、ファイルに出力します。
            Else
               '? WideStringVariable
               Print #2, WideStringVariable           '' ファイルに出力します。
            EndIf
      
         Loop
      Else
         GoTo HandleErrors
      End If
      ?
      ? LineCounter & " 行目"
      ?
      'ファイル番号を通したファイルを閉じます。
      Close #1
      Close #2

   Else
      Print "メッセージ","ファイルが選択されませんでした！"
      Sleep
      End
   EndIf
   
   Print "変換が終了しました。何かキー入力してください。"
   Sleep
   End
   
   HandleErrors:
   Print "指定ファイルが有りません。"
   Sleep (1000)
   End

End Sub


'****************************************************
'変換文字コードを選択
'****************************************************
Dim As HWND hwnd
Dim As Integer event
Before = "JIS"
After = "UTF16"

hwnd = OpenWindow("変換方法を選択",300,10,400,240)
OptionGadget(1,10,10,190,30,"ShiftJIS→UTF-16")
SetGadgetState(1,1)
OptionGadget(2,10,40,190,30,"ShiftJIS→UTF-8(BOM)")
OptionGadget(3,10,70,190,30,"UTF-16 →ShiftJIS")
OptionGadget(4,10,100,190,30,"UTF-16 →UTF-8(BOM)")
OptionGadget(5,10,130,190,30,"UTF-8(BOM)→ShiftJIS")
OptionGadget(6,10,160,190,30,"UTF-8(BOM)→UTF-16")

TextGadget(13,200,20,190,30,"ShiftJIS→UTF-16")
ButtonGadget(11,270,70,100,30,"読込み開始")

Do
   event=WaitEvent()
   If event=EventClose Then End
   If event=eventgadget Then
      If eventNumber = 1 Then
         setgadgettext(13,"ShiftJIS→UTF-16")
         Before = "JIS"
         After = "UTF16"
      ElseIf eventNumber = 2 Then
         setgadgettext(13,"ShiftJIS→UTF-8(BOM)")
         Before = "JIS"
         After = "UTF8"
      ElseIf eventNumber = 3 Then
         setgadgettext(13,"UTF-16 →ShiftJIS")
         Before = "UTF16"
         After = "JIS"
      ElseIf eventNumber = 4 Then
         setgadgettext(13,"UTF-16 →UTF-8(BOM)")
         Before = "UTF16"
         After = "UTF8"
      ElseIf eventNumber = 5 Then
         setgadgettext(13,"UTF-8(BOM)→ShiftJIS")
         Before = "UTF8"
         After = "JIS"
      ElseIf eventNumber = 6 Then
         setgadgettext(13,"UTF-8(BOM)→UTF-16")
         Before = "UTF8"
         After = "UTF16"
      ElseIf eventNumber = 11 Then
         event=EventClose
         Close_Window(hwnd)
         Exit Do
      EndIf
   EndIf
Loop

ConvertEncoding

'-----------------------------------------------------------------------------'
Function StrReplace (ByVal StrEx As String, _
                     ByVal StrMask As String, _
                     ByVal StrRplce As String) As String

    If Len(StrEx)=0 Or Len(StrMask)>Len(StrEx) Then Return StrEx

    Dim Buffer As String=StrEx
    Dim MaskSearch As UInteger
    Dim MFound As Byte
    Dim lp As UInteger=1

    Do
        MaskSearch=InStr(lp,Buffer,StrMask)
        MFound=0

        If MaskSearch Then
            MFound=1:lp=MaskSearch+Len(StrRplce)
            ''
            Buffer=Left(Buffer,MaskSearch-1)+ _
            StrRplce+ _
            Right(Buffer,Len(Buffer)-(MaskSearch+(Len(StrMask)-1)))
            ''
        End If

    Loop While MFound=1

    Return Buffer
End Function


　下の例は、青空文庫のルビ表記を、html の「ルビタグ」に変換するものです。
　文字処理関数を使うため、途中で Wstr を使って UNICODE に変換して処理しています。
　Shift-JIS のままで処理するバージョンもあります。
　「UNICODE」にするために中間ファイルに書き出すバージョンもあります。
変換前のテキスト(Shift-JIS の html) は、ファイル名を、「mae.html」 として、C ドライブの test フォルダに登録します。
変換後のテキスト(Shift-JIS の html) は、同一フォルダに、「ato_RibyW.html」というファイル名で作られます。
　このプログラムは、ソース中の文字定数を「UNICODE」として扱いますが、コード(.bas ファイル)は、Shift-JIS で保存しても機能します。
サンプルのテキスト・ファイルと、ソースは、ここでダウンロードできます。→RubyTagForFB_WStr.zip

'RubyTagForFB_WStr4.bas
' ★このプログラム・コードは、Shift-JIS で保存しても、UNICODE で保存しても同じ出力を得られます。★

Dim InputFile As String
Dim OutputFile As String
Dim InputLine As String
Dim InputLineW As WString * 10000
Dim OutputLineW As WString * 10000
Dim OutputLine As String

Dim bodyFlag As Integer
Dim ProcessingLineCounter As Integer

Dim StartTime As Long
Dim EndTime As Long

Declare Sub HonbunSyori (OutputLineW As WString, InputLineW As WString)

InputFile="c:\test\mae.html"
OutputFile="c:\test\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  Encoding "ascii" As #1
Open OutputFile For Output As #2

'*************データの読み込み***********
While (EOF(1) = 0)
    ProcessingLineCounter = ProcessingLineCounter + 1
    Line Input #1, InputLine
'  'ASCII 文字列を、ユニコード文字列に変換
    InputLineW = WStr(InputLine)
    OutputLineW = InputLineW
    
    If InStr (InputLineW, "</body>") > 0 Then
        bodyFlag = 0
    End If
    
    If bodyFlag = 1 Then
'       本文処理  '★★★★★★★★★
'        Print InputLineW & Space(Len(InputLineW))
        HonbunSyori (OutputLineW , InputLineW )
    End If
      
    If InStr (InputLineW, "<body") > 0 Then
        bodyFlag = 1
    End If
    
'  'ワイドから、日本語マルチバイトに変換
    OutputLine = OutputLineW
'  'そして、出力します。
    Print #2, OutputLine
    
    OutputLine = ""
    InputLineW = ""
    OutputLineW = ""
    
    If (ProcessingLineCounter Mod 10) = 0 Then
	    Print ProcessingLineCounter , " 行目を読込み" & Space(Len(" 行目を読込み"))
    End If
       
Wend

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

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


'**************本文処理*********************
Sub HonbunSyori (OutputLineW As WString, InputLineW As WString)

	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
	
    OutputLineW = ""
    BackgroundNumber = 0
    KanjiNumber = 0
    RubyNumber = 0
    KanjiFlag = 0
    RubyFlag = 0
    BackgroundFlag = 1               '行末に > がない場合を考慮
    
    InputLineNumber = Len(InputLineW)
    
    For Figure = InputLineNumber To 1 Step -1        '文字列の後ろから、処理していく点が、ミソ
    	
        If Mid(InputLineW, 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 Mid(InputLineW, Figure, 1) = "》" Then  'ルビの開始 '★★2006年6月5日追加
        
			'#Ifdef __FB_WIN32__
			'	messagebox(NULL, InputLineW ,"",MB_OK)
			'#EndIf
        
            OutputLineW = "</rt><rp>)</rp></ruby><ruby><rb>" & Mid(InputLineW, Figure + 1, KanjiNumber - 1) & OutputLineW
            
            KanjiNumber = 0
            KanjiFlag = 0
            
            BackgroundNumber = 0
            RubyNumber = 0     '前回のRubyNumberをリセット
            BackgroundFlag = 0
            RubyFlag = 1
        
        ElseIf Mid (InputLineW, Figure, 1) = "》" Then               'ルビの開始
        	
			'#Ifdef __FB_WIN32__
			'	messagebox(NULL, InputLineW ,"",MB_OK)
			'#EndIf
        	
            OutputLineW = "</rt><rp>)</rp></ruby>" & Mid(InputLineW, Figure + 1, BackgroundNumber - 1) & OutputLineW
            BackgroundNumber = 0
            RubyNumber = 0     '前回のRubyNumberをリセット
            BackgroundFlag = 0
            RubyFlag = 1
            
        ElseIf Mid(InputLineW, Figure, 1) = "《" Then         'ルビの終了
            OutputLineW = "</rb><rp>(</rp><rt>" & Mid(InputLineW, Figure + 1, RubyNumber - 1) & OutputLineW
            KanjiNumber = 0     '前回のKanjiNumberをリセット
            RubyFlag = 0
            KanjiFlag = 1
            
        ElseIf KanjiFlag = 1 And (Mid(InputLineW, Figure, 1) = "｜" _
        Or Mid(InputLineW, Figure, 1) = "│") Then      '"｜"JIS 8162は記号の縦線。"│"JIS 84A0は罫線の縦線
            '★ガリバー対応★★★★2006年6月5日追加
            OutputLineW = "<ruby><rb>" & Mid(InputLineW, Figure + 1, KanjiNumber - 1) & OutputLineW
            KanjiNumber = 0
            KanjiFlag = 0
            BackgroundFlag = 1
            
        ElseIf KanjiFlag = 1 And (Mid(InputLineW, Figure, 1) = "（" _
        Or Mid(InputLineW, Figure, 1) = "）") Then       '（例）１円山応挙《まるやまおうきょ》
            '★夜明け前対応★★★★2006年6月6日追加
            OutputLineW = "<ruby><rb>" & Mid(InputLineW, Figure + 1, KanjiNumber - 1) & OutputLineW
            KanjiNumber = 0
            KanjiFlag = 0
            BackgroundFlag = 1
            BackgroundNumber = 1    'Backgroundのところまで侵食したため戻す
            
'        ElseIf Mid(InputLineW, Figure + 1, 1) >= "亜" And KanjiNumber > 1 _
'        And Mid(InputLineW, Figure, 1) < "亜" Then  '★つぐみ対応★★★★2006年6月5日追加
        
        ElseIf Mid(InputLineW, Figure + 1, 1) > "ヶ" And KanjiNumber > 1 _
        And Mid(InputLineW, Figure, 1) <= "ヶ" Then  '★大丈夫対応★★★★2006年6月5日追加
            OutputLineW = "<ruby><rb>" & Mid(InputLineW, Figure + 1, KanjiNumber - 1) & OutputLineW
            KanjiNumber = 0
            KanjiFlag = 0
            BackgroundFlag = 1
            BackgroundNumber = 1    'Backgroundのところまで侵食したため戻す
            
        ElseIf RubyNumber > 0 And KanjiNumber = RubyNumber Then
            OutputLineW = "<ruby><rb>" & Mid(InputLineW, Figure + 1, KanjiNumber - 1) & OutputLineW
            KanjiNumber = 0
            KanjiFlag = 0
            BackgroundFlag = 1
            BackgroundNumber = 1    'Backgroundのところまで侵食したため戻す

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

        End If
    
'       If ProcessingLineCounter = 71 Then Stop  '●●▲●●
    
    Next Figure
    
    If BackgroundFlag = 1 And BackgroundNumber > 0 Then
        OutputLineW = Mid(InputLineW, Figure + 1, BackgroundNumber) & OutputLineW
    End If
    
End Sub

プラットホーム差:
方言差:
QBからの違い:
参照:
データ型を変換　に戻る
文字列関数　に戻る
←リンク元に戻る　プログラム開発関連に戻る
ページ歴史:2016-03-13 11:59:51
日本語翻訳：WATANABE Makoto、原文著作者：VirusScanner

ホームページのトップに戻る

表示-非営利-継承