文字コード　追加で教えて欲しいです

Public SCA1() As String

Public SCA2() As Long

Public SEL1() As String

Public SEL2() As Long



Sub MAIN()



Call IVDINI(A)



Cells(2, 2).VALUE = "通常"

Cells(3, 2).VALUE = "サロゲートペア"

Cells(4, 2).VALUE = "通常異体字"

Cells(5, 2).VALUE = "サロゲートペア異体字"

Cells(6, 2).VALUE = "結合文字"

Cells(7, 2).VALUE = "有るセレクタ"

Cells(8, 2).VALUE = "嘘のセレクタ"



Cells(2, 4).VALUE = "折"

Cells(3, 4).VALUE = uni2(55405, 57158)

Cells(4, 4).VALUE = uni3(33883, 56128, 56576)

Cells(5, 4).VALUE = uni4(55362, 57247, 56128, 56576)

Cells(6, 4).VALUE = uni5(9977, 65039, 8205, 9792, 65039)

Cells(7, 4).VALUE = uni4(55399, 56893, 56128, 56577)

Cells(8, 4).VALUE = uni4(55399, 56893, 56128, 56586)



For y = 2 To 8

Cells(y, 3).FormulaR1C1 = "=IsIVSHEXSCAL(RC[1])"

Next



End Sub



Function IsIVSHEXSCAL(ByVal VALUE)

'http://d.hatena.ne.jp/replication/20091016/1255704497 

  Dim bytes, intI, firstByte, secondByte

  Dim SEL As Long

  Dim SELU As String

  Dim IVSByte() As Long

  Dim c As Long

  bytes = LenB(VALUE) ' バイト数を取得する 

  ReDim IVSByte(Int(bytes / 2) + 1)

  ' バイト数だけ繰り返し 

  IsIVSHEXSCAL = ""

  For intI = 1 To bytes Step 2

    ' 2バイトずつ取り出し 

    IVSByte(Int(intI / 2)) = AscW(MidB(VALUE, intI, 2))

    ' 最後のバイトの場合は、secondByteに0を格納する 

    If intI + 2 < bytes Then

      IVSByte(Int(intI / 2) + 1) = AscW(MidB(VALUE, intI + 2, 2))

    Else

      IVSByte(Int(intI / 2) + 1) = 0

    End If

      IsIVSHEXSCAL = IsIVSHEXSCAL & "U+" & Application.Dec2Hex(ASCW2(IVSByte(Int(intI / 2))), 4) & ","

  Next

    c = Application.WorksheetFunction.unicode(VALUE)

   '異体字セレクタの確認 

   'http://mrxray.on.coocan.jp/Delphi/Others/SurrogatePair.htm 

   If UBound(IVSByte, 1) > 2 Then

     If IVSByte(UBound(IVSByte, 1) - 3) = -9408 Then

     '上位ワードは U + DB40 の固定値 

     

     SEL = Application.Hex2Dec("E0100") + IVSByte(UBound(IVSByte, 1) - 2) + 8960

     'U + E0100 ～ U + E01EF 

     

     SELU = ",U+" & Application.Dec2Hex(SEL) & IVD(c, (IVSByte(UBound(IVSByte, 1) - 2) + 8960))

    Else

     SELU = ""

    End If

   Else

   SELU = ""

   End If

       'https://www.moug.net/tech/exvba/0100035.html 

       IsIVSHEXSCAL = "(" & "U+" & Application.Dec2Hex(c, 6) & SELU & ")" & IsIVSHEXSCAL

End Function

Sub IVDINI(A)



'ファイルの指定行を読込 

    Dim I       As Long

    Dim Fso     As New FileSystemObject

    'Microsoft Scripting Runtime　に参照設定 

    Dim FsoTS   As TextStream

    

    Dim SCA As String

    Dim SEL As String

    Dim SCAM As Long

    Dim SELM As Long

    

    Dim TEXT1 As String

    Dim N As Long

    Dim M As Long

    Dim I2 As Long

    Dim e As Long

    

    TEXT1 = ""

    myLine = CLng(Text2)

    Set FsoTS = Fso.OpenTextFile("C:\Users\Y2\Desktop\IVD_Sequences.txt")

    

     N = 0

     M = 0

     e = 0

   While e <> 1

    If FsoTS.AtEndOfStream = False Then

        M = M + 1

        TEXT1 = FsoTS.ReadLine

      If Left(TEXT1, 1) <> "#" Then

         N = N + 1

         ReDim Preserve SCA1(N)

         ReDim Preserve SCA2(N)

         ReDim Preserve SEL1(N)

         ReDim Preserve SEL2(N)

        

         SCA = SPP(TEXT1, 0, " ")

         SEL = SPP(SPP(TEXT1, 0, ";"), 1, " ")

         

         SCAM = Application.Hex2Dec(SCA)

         SELM = Application.Hex2Dec(SEL) - 917760

         

         SCA1(N) = SCA

         SCA2(N) = SCAM

         SEL1(N) = SEL

         SEL2(N) = SELM

        

        Else

         End If

       Else

        e = 1

    End If

    Wend

    FsoTS.Close

    Set FsoTS = Nothing

End Sub

Function IVD(SCATEST As Long, SELTEST As Long) As String

    Dim N As Long

    Dim M As Long

    Dim I2 As Long

    Dim e As Long

    

    N = UBound(SCA1())

    

    For I = 1 To N

     If SCA2(I) = SCATEST Then

      For I2 = I To N

       If (SCA2(I2) = SCATEST) * (SEL2(I2) = SELTEST) Then

       IVD = "有"

       I2 = N

       I = N

         Exit For

       Else

        IVD = "偽"

        End If

      Next

     Else

      IVD = "偽"

     End If

    Next

End Function

Function SPP(w As String, N As Long, SEP As String)

'http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/function/vba_string2.html 

 Dim S As Variant

 Dim WW As String

 S = Split(w, SEP)

 WW = S(N)

 SPP = WW

End Function

Function I異体字4(A, b, c, d)

 I異体字4 = ChrW(A) & ChrW(b) & ChrW(c) & ChrW(&HDD00 + d) '異体字連結 

End Function

Function uni2(A, b)

 uni2 = ChrW(A) & ChrW(b)

End Function

Function uni3(A, b, c)

 uni3 = ChrW(A) & ChrW(b) & ChrW(c)

End Function

Function uni4(A, b, c, d)

 uni4 = ChrW(A) & ChrW(b) & ChrW(c) & ChrW(d)

End Function

Function uni5(A, b, c, d, e)

 uni5 = ChrW(A) & ChrW(b) &ChrW(c) & ChrW(d) & ChrW(e)

End Function

Function ASCW2(VALUE As Long) As Long

If VALUE < 0 Then

  ASCW2 = 65536 + VALUE

Else

  ASCW2 = VALUE

End If



End Function

'▼鯖の場合 

'https://www.unicode.org/cgi-bin/GetUnihanData.pl?codepoint=%E9%AF%96 



'鯖のコードポイントを を４つのバイトの配列で取得します。 

Dim b1 As Byte() = System.Text.Encoding.UTF32.GetBytes("鯖")



'鯖のコードポイントを １つの数値で取得します。 

Dim cp1 As Long = b1(0) + b1(1) * 256 + b1(2) * 256 * 256 + b1(3) * 256 * 256 * 256



'16進数での表現も取得しておきます。 

Dim cp1_16 As String = BitConverter.ToString(b1.Reverse.ToArray).Replace("-", "")



Debug.WriteLine("鯖のコードポイントは " & cp1 & " = " & cp1_16)



If cp1 <= 65535 Then

    Debug.WriteLine("鯖はUnicode第１面にあります。")

Else

    Debug.WriteLine("鯖はUnicode第２面以降にあります。")

End If



'▼𩸽の場合 

'https://www.unicode.org/cgi-bin/GetUnihanData.pl?codepoint=%F0%A9%B8%BD 



'𩸽のコードポイントを を４つのバイトの配列で取得します。 

Dim b2 As Byte() = System.Text.Encoding.UTF32.GetBytes("𩸽")



'𩸽のコードポイントを １つの数値で取得します。 

Dim cp2 As Long = b2(0) + b2(1) * 256 + b2(2) * 256 * 256 + b2(3) * 256 * 256 * 256



'16進数での表現も取得しておきます。 

Dim cp2_16 As String = BitConverter.ToString(b2.Reverse.ToArray).Replace("-", "")



Debug.WriteLine("鯖のコードポイントは " & cp2 & " = " & cp2_16)



If cp2 <= 65535 Then

    Debug.WriteLine("𩸽はUnicode第１面にあります。")

Else

    Debug.WriteLine("𩸽はUnicode第２面以降にあります。")

End If

using System;

using System.Collections.Generic;

using System.Linq;

using System.Text;

using System.Threading.Tasks;

using System.Windows;

using System.Windows.Controls;

using System.Windows.Data;

using System.Windows.Documents;

using System.Windows.Input;

using System.Windows.Media;

using System.Windows.Media.Imaging;

using System.Windows.Navigation;

using System.Windows.Shapes;

using System.Collections.ObjectModel;



namespace WpfApp1_CMAP_CS

{

    ///'https://anderson02.com/cs/wpf/wpf-21/ 

    /// <summary>

    /// MainWindow.xaml の相互作用ロジック

    /// </summary>

    public partial class MainWindow : Window

    {

        int ii = 0;

        public MainWindow()

        {

            InitializeComponent();

     

                GlyphItems = new List<object>();



            System.IO.StreamWriter sw = new System.IO.StreamWriter( @"C:\Users\Y2\Desktop\ipatest.txt", false);

            //TextBox1.Textの内容を1行ずつ書き込む

         

            var font = @"C:\Users\Y2\AppData\Local\Microsoft\Windows\Fonts\ipamjm.ttf";

            //var font = @"C:\Windows\Fonts\meiryo.ttc";



            for (int i = 0; i < new GlyphTypeface(new Uri(font)).GlyphCount; i++)

            //      for (int i = 0; i < 100; i++)

            {

                  GlyphItems.Add(new { FontUri = font, Indices = i.ToString() });

                ii = i;

                sw.WriteLine(new { FontUri = font, Indices = i.ToString() });



            }

            MessageBox.Show(Convert.ToString(ii));

            //https://www.sejuku.net/blog/57946

            DataContext = this;

            //閉じる

            sw.Close();

        }

        public List<object> GlyphItems { get; set; }

        }

    }

    <Window x:Class="WpfApp1_CMAP_CS.MainWindow"

        xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"

        xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"

        xmlns:d="http://schemas.microsoft.com/expression/blend/2008"

        xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006"

        xmlns:local="clr-namespace:WpfApp1_CMAP_CS"

        mc:Ignorable="d"

        Title="MainWindow" Height="300" Width="300">

    <ScrollViewer HorizontalScrollBarVisibility="Auto" VerticalScrollBarVisibility="Auto">

        <Grid>

        <StackPanel>

            <ListBox ItemsSource="{Binding GlyphItems}">

    <ListBox.ItemTemplate>

        <DataTemplate>

            <Grid>

                <Grid.ColumnDefinitions>

                    <ColumnDefinition Width="50"/>

                    <ColumnDefinition/>

                </Grid.ColumnDefinitions>

                <Glyphs FontUri="{Binding FontUri}" Indices="{Binding Indices}" 

         FontRenderingEmSize="36" OriginX="10" OriginY="36" 

         Fill="Black"/>

                <TextBlock Grid.Column="1" VerticalAlignment="Center" 

          Text="{Binding Indices, StringFormat=Index {0}}"/>

            </Grid>

        </DataTemplate>

    </ListBox.ItemTemplate>

</ListBox>

        </StackPanel>

    </Grid>

    </ScrollViewer>

</Window>

var gtf = new GlyphTypeface(new Uri(@"C:\temp\ipamjm.ttf"));

//var gtf = new GlyphTypeface(new Uri(@"C:\temp\verdana.ttf"));





var b = System.Text.Encoding.UTF32.GetBytes("𩸽");

var codePoint = b[0] + b[1] * 256 + b[2] * 256 * 256 + b[3] * 256 * 256 * 256;



ushort index;

if (gtf.CharacterToGlyphMap.TryGetValue(codePoint, out index))

{

    Console.WriteLine($"このフォントでは インデックス {index} にその文字があります。");

}

else

{

    Console.WriteLine("このフォントにはその文字は含まれていません。");

}

Function Uni(ParamArray charCode() As Variant) As String

    Uni = ""

    Dim v As Variant

    For Each v In charCode

        Uni = Uni & ChrW(v)

    Next

End Function

Cells(2, 4).Value = ChrW(&H6298)

Cells(3, 4).Value = ChrW(&HD86D) & ChrW(&HDF46)

Cells(4, 4).Value = ChrW(&H845B) & ChrW(&HDB40) & ChrW(&HDD00)

Cells(5, 4).Value = ChrW(&HD842) & ChrW(&HDF9F) & ChrW(&HDB40) & ChrW(&HDD00)

Cells(6, 4).Value = ChrW(&H26F9) & ChrW(&HFE0F) & ChrW(&H200D) & ChrW(&H2640) & ChrW(&HFE0F)

Cells(7, 4).Value = ChrW(&HD867) & ChrW(&HDE3D) & ChrW(&HDB40) & ChrW(&HDD01)

Cells(8, 4).Value = ChrW(&HD867) & ChrW(&HDE3D) & ChrW(&HDB40) & ChrW(&HDD0A)

Public Function ToUTF16(codePage As Integer) As UShort()

    If codePage < 0 OrElse &H10FFFF < codePage Then

        Throw New ArgumentOutOfRangeException(NameOf(codePage))

    End If

    If codePage <= &HFFFF Then

        'BMP の場合は無加工 

        Return New UShort() {CUShort(codePage)}

    Else

        '①元の値から 0x10000 を引くことで、U+010000～U+10FFFF を 00000～FFFFF にする 

        Dim u = CUShort(codePage - &H10000UI)

        '②それを 20ビットの2進数として表現 

        Dim b = Convert.ToString(u, 2).PadLeft(20, "0"c)

        '③上位サロゲートは、上位10ビットの前に"110110"を添えた値 

        Dim us = CUShort(Convert.ToInt32("110110" & b.Substring(0, 10), 2))

        '④下位サロゲートは、下位10ビットの前に"110111"を添えた値 

        Dim ls = CUShort(Convert.ToInt32("110111" & b.Substring(10, 10), 2))

        Return {us, ls}

    End If

End Function

Public Sub MAIN()

End Sub



Private Sub IVDINI()

End Sub

if (System.Text.Rune.TryGetRuneAt("𩸽", 0, out System.Text.Rune rune))

{

    // U+00029E3D

    Console.WriteLine($"U+{rune.Value:X8}");



    // D867,DE3D

    char[] utf16 = new char[2]; // 格納するために十分なバッファ

    int n = rune.EncodeToUtf16(utf16);

    Console.WriteLine(string.Join(',', utf16.Take(n).Select(c => $"{(int)c:X4}"))); 



    // f0 a9 b8 bd

    byte[] utf8 = new byte[4]; // 格納するために十分なバッファ

    int m = rune.EncodeToUtf8(utf8);

    Console.WriteLine(string.Join(' ', utf8.Take(m).Select(b => $"{b:x2}"))); 

}

Public Class Form1

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        ListBox1.BeginUpdate()

        ListBox1.Items.Clear()



        Dim fontFile As String

        'fontFile = "C:\Windows\Fonts\ipamjm.ttf" 

        'fontFile = "C:\Windows\Fonts\arial.ttf" 

        fontFile = "C:\Windows\Fonts\meiryo.ttc"





        For Each ttf In Gekka.Text.Font.TrueType.TTC.Read(fontFile)

            ListBox1.Items.Add("-----------")

            For Each nm In ttf.Names

                ListBox1.Items.Add($"Id={nm.ID:d}({nm.ID:G})")

                ListBox1.Items.Add($"LanguageID={nm.LanguageID}")

                ListBox1.Items.Add($"Language={nm.Language}")

                ListBox1.Items.Add($"Text={nm.Text}")

                ListBox1.Items.Add("")

            Next

        Next

        ListBox1.EndUpdate()

    End Sub

End Class

    Public Sub Read(ByVal stream As System.IO.Stream)

        stream.Seek(0, System.IO.SeekOrigin.Begin)

        ttcTag = New Byte(4 - 1) {}

        If stream.Read(ttcTag, 0, 4) <> 4 Then

            Throw New System.IO.InvalidDataException()

        End If



        If Not (IsTTC) Then

            offsetTables = New Offset32(1 - 1) {}

            offsetTables(0) = New Offset32()

        Else

            majorVersion = stream.ReadUInt16BE()

            minorVersion = stream.ReadUInt16BE()

            numFonts = stream.ReadUInt32BE()

            offsetTables = New Offset32(numFonts - 1) {}

            With Nothing

                Dim i As Integer = 0

                For _F_2 As Integer = 0 To 1 Step 0

                    If Not (i < numFonts) Then

                        Exit For

                    End If



                    offsetTables(i) = New Offset32()

                    offsetTables(i).offset = stream.ReadUInt32BE()

                    i += 1

                Next

            End With

            If majorVersion >= 2 Then

                dsigTag = stream.ReadUInt32BE()

                dsigLength = stream.ReadUInt32BE()

                dsigOffset = stream.ReadUInt32BE()

                If dsigTag <> &H44534947 Then

       ★             Throw New System.IO.InvalidDataException()

                End If

            End If

        End If

    End Sub

    Public Shared Function FindISVS(ByVal targetFontName As String, ByVal targetChar As UInteger) As List(Of UInteger)

        On Error GoTo ErrLabel

        Dim fontFile As System.IO.FileInfo = FindFont(targetFontName)

        If (fontFile IsNot Nothing) Then

            For Each ttf As TTF In TTC.Read(fontFile.FullName, TTFDataReadTypes.Names Or TTFDataReadTypes.IVS)

                Return ttf.IVSMap.Item(targetChar)

            Next

        End If

        Return Nothing

        'Return New System.IO.FileInfo("C:\Users\Y2\AppData\Local\Microsoft\Windows\Fonts\ipamjm.ttf") 

ErrLabel:

        'https://www.sejuku.net/blog/35484 

        Dim er As UInteger

        Dim list1a = New List(Of UInteger)

        'https://atmarkit.itmedia.co.jp/ait/articles/1703/01/news042.html 

        er = 999999

        list1a.Add(er)

        Return list1a

    End Function

    Public Shared Function FindISV(ByVal targetFontName As String, ByVal targetChar As Char) As List(Of UInteger)

        Dim fontFile As System.IO.FileInfo = FindFont(targetFontName)

        If (fontFile IsNot Nothing) Then

            For Each ttf As TTF In TTC.Read(fontFile.FullName, TTFDataReadTypes.Names Or TTFDataReadTypes.IVS)

                Return ttf.IVSMap.Item(AscW(targetChar))

            Next

        End If

        Return Nothing

    End Function