StrConv関数の大半の機能を使用可能

オープンソース形式でコードを共有するフォーラムです。お役立ちコード、あなたも投稿してみませんか?
返信する
メッセージ
作成者
マティ
記事: 161
登録日時: 2005年8月23日(火) 00:15
お住まい: 沖縄県
連絡する:

StrConv関数の大半の機能を使用可能

#1 投稿記事 by マティ »

SJISでのみ、各種変換を行えます。
UNICODEを変換する場合は、以下のように処理してください。

コード: 全て選択


変換後 = StrConv(StrConv(StrConv(変換前,vbFromUnicode),vbKatakana+vbNarrow),Unicode)
各種制限
Unicode,vbFromUnicodeは単独で使用して下さい。
vbLowerCaseとvbUpperCase、vbHiraganaとvbKatakana、vbNarrowとvbWideの同時指定は出来ません。

コード: 全て選択


Declare Function WideCharToMultiByte Lib "kernel32" ( _
                 CodePage       As Long, _
                 dwFlags        As Long, _
                 lpWideByteStr  As VoidPtr,_
                 cchWideByte    As Long, _
                 lpMultiCharStr As String, _
                 cchMultiChar   As Long, _
                 pDefaultChar   As Long, _
                 pUsedDefaultChar As Long) As Long

Declare Function GetUserDefaultLCID Lib "kernel32" () As Long

Declare Function LCMapStringA Lib "kernel32" ( _
                 Locale      As Long, _
                 dwMapFlags  As Long, _
                 lpSrcStr    As String, _
                 cchSrc      As Long, _
                 lpDestStr   As String, _
                 cchDest     As Long) As Integer
Const LCMAP_LOWERCASE = &h00000100    '小文字にします
Const LCMAP_UPPERCASE = &h00000200    '大文字にします
Const LCMAP_HIRAGANA  = &h00100000    'ひらがなにします
Const LCMAP_KATAKANA  = &h00200000    'カタカナにします
Const LCMAP_HALFWIDTH = &h00400000    '半角文字にします(適用される場合)
Const LCMAP_FULLWIDTH = &h00800000    '全角文字にします(適用される場合)
'---------------------------------------------------
' StrConv が使用する定数郡
'---------------------------------------------------
Const vbLowerCase    = LCMAP_LOWERCASE   '小文字をにします
Const vbUpperCase    = LCMAP_UPPERCASE   '大文字をにします
Const vbHiragana     = LCMAP_HIRAGANA    'ひらがなにします
Const vbKatakana     = LCMAP_KATAKANA    'カタカナにします
Const vbNarrow       = LCMAP_HALFWIDTH   '半角文字にします
Const vbWide         = LCMAP_FULLWIDTH   '全角文字にします

Const vbUnicode      = 1                 'Unicodeへ変換
Const vbFromUnicode  = 2                 'SJIS   へ変換
'***************************************************
' StrConv
'---------------------------------------------------
' 引数 : 変換する文字列,変換処理
' 戻値 : 変換された文字列
'***************************************************
Function StrConv(sInp As String,eCnv As Long) As String
    'eCnv に対して処理を振り分け
    Dim iLen As Long, oLen As Long, lCnv As Long, LcId As Long
    '
    Select Case(eCnv And 3)

        Case vbFromUnicode
            iLen = Len(sInp) >> 1
            oLen=WideCharToMultiByte(CP_ACP, 0, sInp, iLen, 0, 0, 0, 0)
            StrConv=ZeroString(oLen)                            '作業領域作成
            WideCharToMultiByte(CP_ACP, 0, sInp, iLen, StrPtr(StrConv), oLen, 0, 0)

        Case vbUnicode
            iLen = Len(sInp)
            oLen = MultiByteToWideChar(CP_ACP,0,sInp,iLen,0,0)  '文字数取得
            StrConv=ZeroString(oLen << 1)                       '作業領域作成
            MultiByteToWideChar( CP_ACP,0,sInp,-1,StrPtr(StrConv),oLen)
        
        Case Else
            lCnv = (eCnv And &h00F00300)    '対象確認
            If(lCnv)Then
                LcId = GetUserDefaultLCID()
                iLen = Len(sInp)
                oLen = LCMapStringA(LcId, lCnv, sInp, iLen, 0, 0)
                StrConv=ZeroString(oLen)                            '作業領域作成
                oLen = LCMapStringA(LcId, lCnv, sInp, iLen, StrPtr(StrConv), oLen)
            Else
                StrConv=sInp: debug
            End If
    End Select
End Function
返信する