Option Strict Off
Option Explicit On
Imports System.Windows.Forms
Imports VB = Microsoft.VisualBasic
'------------------------------------ 2024/03/23 ------------------------------------
Public Class clsJisho
#Region "宣言"
    Event JishoListClick(ByVal ListItemText As String, ByVal ListItemIndex As Integer)    'ListItemText の文字が辞書リストから出力されました。
    '------------------------------------------------------------------------------------------------------
    'Private mMake_ing As Boolean = True
    'Private mJiListKWD_Click As Boolean
#End Region

#Region "基本"
    Friend Function Make() As Boolean
        Try
            Call Jisho_Initialize()
            Return True
        Catch ex As Exception
            MsgBox("ERROR in 五clsPacopaco.Make()" & vbCrLf & ex.ToString)
            Return False
        End Try
    End Function
    'Friend Function 辞書ListBox() As ListBox
    '    Return Me.mJiList
    'End Function
    Friend Function フォントデーターをください(ByRef rwJiList As ListBox, ByRef wFontName As String, ByRef wFontSize As Integer, ByRef wFontBold As Boolean) As Boolean
        With rwJiList.Font
            wFontName = .Name
            wFontSize = CInt(.Size)
            wFontBold = .Bold
        End With
        Return True
    End Function
    Friend Function フォントを設定してください(ByRef rwJiList As ListBox, ByVal rFontName As String, ByVal rFontSize As Integer, ByVal rFontBold As Boolean, ByVal DoReDraw As Boolean) As Boolean
        Try
            Dim fsty As FontStyle = IIf(rFontBold, FontStyle.Bold, FontStyle.Regular)
            With rwJiList
                .Font = New Font(rFontName, rFontSize, fsty)
                '.Font = .Font
            End With
            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function
#End Region


#Region "コピー from Old CofJisho ********************************"

#Region "宣言"
    Private Const gcAdd As Short = 100
    Private Const gcDel As Short = 101
    Private Const gcRep As Short = 102
    Private Const gcReset As Short = 110
    Private Const cHedBackFile As String = "z-"
    'in 五basCOM.vb -----------------------------------------------------
    'Public Const gggDayTimeFormat_yyyyMMdd_HHmmss As String = "yyyyMMdd-HHmmss"
    'Public Const gggDayTimeFormat_yyyyMMddHHmmss As String = "yyyyMMddHHmmss"   '注意　 VB5  のコード  "yyyymmddhhmmss"  を使用すると　.NET_VB　ではエラーになる。
    'in 五basCOM.vb -----------------------------------------------------
    Private Const cBackFileAddFormat As String = "-" & gggDayTimeFormat_yyyyMMdd_HHmmss '"-yyyyMMdd-HHmmss"
    Private Const cEntryFileTimeFormat As String = gggDayTimeFormat_yyyyMMddHHmmss ' "yyyyMMddHHmmss"
    Private Const cStdJishoName As String = "標準"
    Private Const cJishoFileMaxLen As Integer = 500000
    Private Const c辞書フォルダ As String = "JishoTexts"
    Private Const Format最終更新 As String = "yyyy-MM-dd HH:mm:ss"

    Private Structure wdstring
        'UPGRADE_WARNING: 固定長文字列のサイズはバッファに合わせる必要があります。 詳細については、'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="3C1E4426-0B80-443E-B943-0627CD55D48B"' をクリックしてください。
        <VBFixedString(1), System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.ByValArray, SizeConst:=1)> Public hed() As Char
        Dim wd() As String
        Dim wDX As Integer
        Dim arymax As Integer
        Dim loaded As Boolean
        Dim change As Boolean
        Dim dosort As Boolean
        <VBFixedArray(99)> Dim Key() As Integer
        Dim keymax As Integer
        Public Sub Initialize() 'この構造体のインスタンスを初期化するには、"Initialize()" を呼び出さなければなりません。
            ReDim Key(99)
        End Sub
    End Structure
    'UPGRADE_WARNING: 配列 mJWD で各要素を初期化する必要があります。 詳細については、'ms-help://MS.VSCC.v80/dv_commoner/local/redirect.htm?keyword="B97B714D-9338-48AC-B03F-345B617E2B02"' をクリックしてください。
    Private mJWD(100) As wdstring
    Private mJWDmax As Integer
    Private mJReadWriteMode As Boolean 'true =input read  /  false=change write
    Private mHedKeyStr As String
    Private mHedKeyJpn As String
    Private mHedKeyJpnExt As String
    Private mHedKeyEng As String
    Private mUnDoStr As String
    Private mUnDoCur As Integer
    Private mUnDoJWDIndex As Integer
    Private mUnDoTipIndex As Integer
    Private mOldNullHedStr As String
    Private mJishoFileFolder As String
    Private c13 As String
    Private c32 As String
    Private c44 As String
    Private mJishoChgFiles() As String
#End Region

#Region "関数"
    Friend Function ColorChangeFromOutSide_Buttons(ByVal 辞書キーBK As Integer, ByVal 辞書キーFR As Integer) As Boolean
        Dim BK As Color = ⅩColor_from_INT(辞書キーBK)
        Dim FR As Color = ⅩColor_from_INT(辞書キーFR)
        Return True
    End Function
    Friend Function ColorChangeFromOutSide(ByRef rwJiKeyLbl As TextBox, ByRef rwJiList As ListBox, ByVal 辞書キーUB As Integer, ByVal 辞書キーUF As Integer, ByVal 辞書キーDB As Integer, ByVal 辞書キーDF As Integer) As Boolean
        Dim BK As Color = ⅩColor_from_INT(IIf(ReadMode, 辞書キーDB, 辞書キーUB))
        Dim FR As Color = ⅩColor_from_INT(IIf(ReadMode, 辞書キーDF, 辞書キーUF))
        rwJiKeyLbl.BackColor = BK : rwJiKeyLbl.ForeColor = FR
        rwJiList.BackColor = BK : rwJiList.ForeColor = FR
        Return True
    End Function
    Friend Function JiKeyLbl_TextChanged(ByRef rJiKeyLbl As Label, ByRef rwJiList As ListBox) As Integer
        Dim a, max, n As Integer : Dim h As String : Dim ary() As String = {""} : Dim strlen As Integer = 1
        Try
            '-----------------------------
            Call JishoKomokuNullDel()
            '-----------------------------
            ReadMode = True
            '-----------------------------
            rwJiList.Items.Clear()

            rwJiList.Items.Add("") '2024/04/13 new  use KeyWord label pos

            h = rJiKeyLbl.Text
            If h <> "" Then
                If KeyWordCheck(h) = False Then
                    rJiKeyLbl.Text = ""
                Else
                    If JishoWordAryGet(h, ary, max) Then
                        For a = 2 To max
                            rwJiList.Items.Add(ary(a))
                            n = Len(ary(a))
                            If strlen < n Then strlen = n
                        Next
                    End If
                End If
            End If
            Return strlen
        Catch ex As Exception
            MsgBox("ERROR in JiKeyLbl_TextChanged()" & vbCrLf & ex.ToString)
            Return 1
        End Try
    End Function
    Friend Function JishoModeCange(ByRef mode As Boolean, ByRef OnStart As Boolean) As Boolean
        '2024/03/09 change ****************************************
        ReadMode = True '　辞書読み出しモードになりました。
        Return True
        '2024/03/09 change ****************************************
    End Function
    Private Function EntryFileHedsByMainHed(ByRef hed As String, ByRef Key() As String) As Boolean
        Key(1) = hed
        Key(2) = ""
        Key(3) = ""
        Select Case hed
            Case "か" : Key(2) = "が"
            Case "き" : Key(2) = "ぎ"
            Case "く" : Key(2) = "ぐ"
            Case "け" : Key(2) = "げ"
            Case "こ" : Key(2) = "ご"
            Case "さ" : Key(2) = "ざ"
            Case "し" : Key(2) = "じ"
            Case "す" : Key(2) = "ず"
            Case "せ" : Key(2) = "ぜ"
            Case "そ" : Key(2) = "ぞ"
            Case "た" : Key(2) = "だ"
            Case "ち" : Key(2) = "ぢ"
            Case "つ" : Key(2) = "づ"
            Case "て" : Key(2) = "で"
            Case "と" : Key(2) = "ど"
            Case "は" : Key(2) = "ば" : Key(3) = "ぱ"
            Case "ひ" : Key(2) = "び" : Key(3) = "ぴ"
            Case "ふ" : Key(2) = "ぶ" : Key(3) = "ぷ"
            Case "へ" : Key(2) = "べ" : Key(3) = "ぺ"
            Case "ほ" : Key(2) = "ぼ" : Key(3) = "ぽ"
        End Select
    End Function
    Private Function EntryFileStrs(ByRef hed As String, ByRef wText As String, ByRef OldOpenTime As String) As Boolean
        Dim Key(3) As String
        Dim a As Short
        Dim w, s, f As String
        Dim flag As Boolean
        EntryFileStrs = False
        Call EntryFileHedsByMainHed(hed, Key)
        flag = False
        For a = 1 To 3
            s = Key(a)
            If s <> "" Then
                f = zJishoFileName(zJishoIndex(s))
                If Ⅹファイルは存在(f) Then
                    Key(a) = f
                    s = Format(FileDateTime(f), cEntryFileTimeFormat)
                    If StrComp(s, OldOpenTime) > 0 Then
                        flag = True
                    ElseIf Ⅹ文を配列から探す(mJishoChgFiles, f) > 0 Then
                        flag = True
                    End If
                End If
            End If
        Next
        If Not flag Then Exit Function 'all no changed
        w = ""
        For a = 1 To 3
            s = ⅩFileTextOpen(Key(a))
            If s <> "" Then w = w & s
        Next
        If w <> "" Then
            wText = w
            OldOpenTime = Format(Now, cEntryFileTimeFormat)
            EntryFileStrs = True
        End If
    End Function
    Private Function JishoFilesChangedClear() As Boolean
        ReDim mJishoChgFiles(0)
    End Function
    Friend Function SaveAllChangedFile() As Boolean
        gggbol = JishoKomokuNullDel()
        Call AllSave()
    End Function
    Friend Property JishoFileFolder() As String
        Get
            JishoFileFolder = mJishoFileFolder
        End Get
        Set(ByVal Value As String)
            If Ⅹフォルダは存在(Value) Then
                mJishoFileFolder = Value
            Else
                MsgBox("辞書フォルダーが見つかりません。" & vbCrLf & vbCrLf & Value)
                mJishoFileFolder = ""
            End If
        End Set
    End Property
    Friend Property ReadMode() As Boolean
        Get
            ReadMode = mJReadWriteMode
        End Get
        Set(ByVal Value As Boolean)
            mJReadWriteMode = Value
        End Set
    End Property
    Private ReadOnly Property Changed() As Boolean
        Get
            Dim a As Integer
            Changed = False
            For a = 1 To mJWDmax
                If mJWD(a).change = True Then
                    Changed = True
                    Exit Property
                End If
            Next
        End Get
    End Property
    Private Function AllSave() As Boolean
        Try
            Dim a As Integer : Dim f As String : Dim Box As New ListBox : Box.Sorted = True
            For a = 1 To mJWDmax
                If mJWD(a).change = True Then
                    f = zJishoSave(a, Box)
                    If f <> "" Then
                        If Ⅹ文を配列から探す(mJishoChgFiles, f) = 0 Then Call Ⅹ文配列に一つの文要素を追加(mJishoChgFiles, 0, f)
                    End If
                End If
            Next
            Box.Dispose()
            Return True
        Catch ex As Exception
            MsgBox("ERROR in AllSave()" & vbCrLf & ex.ToString)
        End Try
    End Function
    Friend Function JishoWordAryGetOnEditMode(ByRef hed As String, ByRef ary() As String, ByRef max As Integer) As Boolean
        Dim h As String : Dim ID, a, b, stt As Integer : Dim s() As String = {""}
        Dim RET As Boolean = False
        max = 0
        ReDim ary(max)
        h = hed
        ID = zJishoCheckAndLoad(VB.Left(h, 1))
        If ID > 0 Then
            'must be keword = h + c44
            stt = zJishoKeyIndexGet("read", ID, h & c44)
            If stt <= mJWD(ID).wDX Then
                h = h & c44
                b = Len(h)
                For a = stt To mJWD(ID).wDX
                    If VB.Left(mJWD(ID).wd(a), b) = h Then
                        max = Ⅹ文をカットして配列にする(mJWD(ID).wd(a), c44, ary)
                        If max > 0 Then RET = True
                        Exit For
                    End If
                Next
            End If
        End If
        Return RET
    End Function
    Private Function JishoWordAryGet(ByRef hed As String, ByRef ary() As String, ByRef max As Integer) As Boolean
        Dim h As String : Dim ID, c, a, b, stt, x As Integer : Dim s() As String = {""} : Dim nexth As String
        Dim RET As Boolean = False
        max = 0
        ReDim ary(max)
        h = hed
        ID = zJishoCheckAndLoad(VB.Left(h, 1))
        If ID > 0 Then
            'must be keword = h + c44
            stt = zJishoKeyIndexGet("read", ID, h & c44)
            If stt <= mJWD(ID).wDX Then
                If mJReadWriteMode = False Then 'add mode
                    h = h & c44
                    b = Len(h)
                    For a = stt To mJWD(ID).wDX
                        If VB.Left(mJWD(ID).wd(a), b) = h Then
                            max = Ⅹ文をカットして配列にする(mJWD(ID).wd(a), c44, ary)
                            If max > 0 Then RET = True
                            Exit For
                        End If
                    Next
                Else 'input mode
                    nexth = zKyeWordNext(h)
                    max = 1
                    ReDim ary(max)
                    ary(max) = h
                    If Len(h) = 1 Then h = h & c44
                    b = Len(h)
                    For a = stt To mJWD(ID).wDX
                        If Len(mJWD(ID).wd(a)) >= b Then
                            If VB.Left(mJWD(ID).wd(a), b) = h Then
                                x = Ⅹ文をカットして配列にする(mJWD(ID).wd(a), c44, s)
                                If x > 0 Then
                                    RET = True
                                    For c = 2 To x
                                        max = max + 1
                                        ReDim Preserve ary(max)
                                        ary(max) = s(c)
                                    Next
                                End If
                            ElseIf h > nexth Then
                                Exit For
                            End If
                        End If
                    Next
                End If
            End If
        End If
        Return RET
    End Function
    '2024/03/09 new  *****************************************************************************
    Friend Function aaJishoChange(ByVal mJiKeyLbl_Text As String, ByVal mJiList As ListBox) As Boolean
        Dim h As String = Trim(mJiKeyLbl_Text)
        Dim w As String = h & c44
        Dim s As String = ""
        For a As Integer = 0 To mJiList.Items.Count - 1
            s = Trim(aaggリストボックスのテキスト(mJiList, a))
            If s <> "*" Then w = w & aaggリストボックスのテキスト(mJiList, a) & c44
        Next
        If JishoKomokuChange(h, w) = False Then Return False
        Return JishokomokuNullOldSet(h, mJiList)
    End Function
    Private Function JishoKomokuChange(ByRef h As String, ByRef w As String) As Boolean
        Dim op, n, ID As Integer
        ID = zJishoIndex(h)
        If ID > 0 And h <> "" And w <> "" Then
            h = h & c44
            n = zJishKomokuIndexforWrite(ID, h, Len(h))
            If n > 0 Then
                op = gcRep
            Else
                op = gcAdd
                If n = 0 Then n = mJWD(ID).wDX + 1 Else n = System.Math.Abs(n)
            End If
            If zJishoKomokuAddRepDel(op, ID, n, w) = False Then Return False
        End If
        Return True
    End Function
    Private Function JishokomokuNullOldSet(ByRef h As String, ByRef lt As System.Windows.Forms.ListBox) As Boolean
        mOldNullHedStr = ""
        If lt.Items.Count = 1 Then
            If Trim(lt.GetItemText(lt.Items(0)) = "*") Then
                mOldNullHedStr = Trim(h)
            End If
        End If
        Return True
    End Function
    Private Function JishoKomokuNullDel() As Boolean
        Dim ID, n As Integer
        Dim RET As Boolean = False
        If mOldNullHedStr <> "" Then
            ID = zJishoIndex(mOldNullHedStr)
            If ID > 0 Then
                If VB.Right(mOldNullHedStr, 1) <> c44 Then mOldNullHedStr = mOldNullHedStr & c44
                n = zJishKomokuIndexforWrite(ID, mOldNullHedStr, Len(mOldNullHedStr))
                If n > 0 Then RET = zJishoKomokuAddRepDel(gcDel, ID, n, "")
            End If
        End If
        mOldNullHedStr = ""
        Return RET
    End Function
    Private Function KeyWordCheck(ByRef h As String) As Boolean
        Dim a, l As Integer
        Dim s, w, c As String
        l = Len(h)
        If l = 0 Then
            Return False
        ElseIf mJReadWriteMode = True And l > 20 Or mJReadWriteMode = False And l > 50 Then
            Return False
        ElseIf InStr(1, mHedKeyStr, VB.Left(h, 1)) = 0 Then
            Return False
        Else
            w = mHedKeyStr & mHedKeyJpnExt
            s = JpnEngCheck(VB.Left(h, 1))
            For a = 2 To l
                c = Mid(h, a, 1)
                If InStr(1, w, c) = 0 Then Return False
                If JpnEngCheck(c) <> s Then Return False
            Next
        End If
        Return True
    End Function
    Private Function JpnEngCheck(ByRef h As String) As String
        'if h = "" then instr() > 0 ......96-5-14
        If InStr(1, mHedKeyJpn & mHedKeyJpnExt, h) > 0 Then
            Return "J"
        Else
            Return "E"
        End If
    End Function
    Private Function zJishoIndex(ByRef hed As String) As Integer
        Dim a, ID As Integer
        Dim h As String
        ID = 0
        If hed <> "" Then
            h = VB.Left(hed, 1)
            For a = 1 To mJWDmax
                If mJWD(a).hed = h Then
                    ID = a
                    Exit For
                End If
            Next
        End If
        Return ID
    End Function
    Private Function zJishokeyIndexSet(ByRef ID As Integer) As Boolean
        Dim b, a, m As Integer
        Dim k As String
        If ID > 0 Then
            If mJWD(ID).loaded = False Then Return False
            m = Len(mHedKeyStr)
            For a = 1 To m
                k = mJWD(ID).hed & Mid(mHedKeyStr, a, 1)
                mJWD(ID).Key(a) = mJWD(ID).wDX + 1
                For b = 1 To mJWD(ID).wDX
                    If VB.Left(mJWD(ID).wd(b), 2) = k Then
                        mJWD(ID).Key(a) = b
                        Return True
                    End If
                Next
            Next
        End If
        Return False
    End Function
    Private Function zJishoKeyIndexGet(ByRef mode As String, ByRef ID As Integer, ByRef keyword As String) As Integer
        Dim k As String
        Dim stt, p As Integer
        'must be keword = h + c44
        stt = 1
        If Len(keyword) > 2 Then
            k = Mid(keyword, 2, 1)
            p = InStr(1, mHedKeyStr, k)
            If p > 0 Then stt = mJWD(ID).Key(p)
            If stt > mJWD(ID).wDX Then
                If mode = "write" Then stt = 0
            End If
        End If
        Return stt
    End Function
    Private Function zJishKomokuIndexforWrite(ByRef ID As Integer, ByRef keyword As String, ByRef keylen As Integer) As Integer
        Dim a, stt As Integer
        'must be keword = h + c44
        stt = zJishoKeyIndexGet("write", ID, keyword)
        For a = stt To mJWD(ID).wDX
            If VB.Left(mJWD(ID).wd(a), keylen) = keyword Then
                Return a
            End If
        Next
        For a = stt To mJWD(ID).wDX
            If VB.Left(mJWD(ID).wd(a), keylen) > keyword Then
                Return -a
            End If
        Next
        Return 0
    End Function
    Private Function zJishoKomokuAryAddDel(ByRef op As Integer, ByRef ID As Integer) As Boolean
        'Public Const gcReset
        'Public Const gcAdd
        'Public Const gcDel
        Select Case op
            Case gcReset
                With mJWD(ID)
                    .wDX = 0
                    .arymax = 0
                    ReDim .wd(0)
                    .hed = Trim(Mid(mHedKeyStr, ID, 1))
                    .loaded = False
                    .change = False
                    .dosort = False
                    .keymax = 0
                    .Initialize()
                End With
            Case gcAdd
                If mJWD(ID).wDX > mJWD(ID).arymax Then
                    mJWD(ID).arymax = mJWD(ID).arymax + 50
                    ReDim Preserve mJWD(ID).wd(mJWD(ID).arymax)
                End If
            Case gcDel
                If mJWD(ID).wDX <= mJWD(ID).arymax - 50 Then
                    mJWD(ID).arymax = mJWD(ID).arymax - 50
                    ReDim Preserve mJWD(ID).wd(mJWD(ID).arymax)
                End If
        End Select
        Return True
    End Function
    Private Function zJishoKomokuAddRepDel(ByRef op As Integer, ByRef ID As Integer, ByRef n As Integer, ByRef w As String) As Boolean
        'Public Const gcAdd
        'Public Const gcDel
        'Public Const gcRep
        On Error GoTo errop
        Dim a As Integer
        If n < 1 Or n > mJWD(ID).wDX + 1 Then Return False
        mUnDoStr = ""
        mUnDoCur = 0
        mUnDoJWDIndex = 0
        mUnDoTipIndex = 0
        Select Case op
            Case gcAdd
                mJWD(ID).wDX = mJWD(ID).wDX + 1
                Call zJishoKomokuAryAddDel(gcAdd, ID)
                For a = mJWD(ID).wDX - 1 To n Step -1
                    mJWD(ID).wd(a + 1) = mJWD(ID).wd(a)
                Next
                mJWD(ID).wd(n) = w
                mJWD(ID).dosort = True
            Case gcRep
                mUnDoStr = mJWD(ID).wd(n)
                mUnDoJWDIndex = ID
                mUnDoTipIndex = n
                mJWD(ID).wd(n) = w
            Case gcDel
                For a = n To mJWD(ID).wDX - 1
                    mJWD(ID).wd(a) = mJWD(ID).wd(a + 1)
                Next
                mJWD(ID).wDX = mJWD(ID).wDX - 1
                Call zJishoKomokuAryAddDel(gcDel, ID)
        End Select
        If op <> gcRep Then Call zJishokeyIndexSet(ID)
        mJWD(ID).change = True
        Return True
errop:
        Return False
    End Function
    Private Function zJishoFileName(ByRef ID As Integer) As String
        If ID > 0 Then
            Return Ⅹパスセパレータ付加(JishoFileFolder) & cStdJishoName & "-" & mJWD(ID).hed & ".txt"
        End If
        Return ""
    End Function
    Private Function zJishoCheckAndLoad(ByRef hed As String) As Integer
        On Error GoTo errop
        'Dim a As Integer
        Dim ID As Integer
        ID = zJishoIndex(hed)
        If ID = 0 Then Return 0
        If mJWD(ID).loaded = False Then
            Dim f As String = zJishoFileName(ID)
            If f <> "" Then
                If Len(Dir(f, 0)) > 2 Then
                    Cursor.Current = Cursors.WaitCursor
                    mJWD(ID).wDX = 0
                    ReDim mJWD(ID).wd(0)
                    Dim rwAry() As String = {""}
                    Dim m As Integer = ⅩFileTextOpenSave(1, 1, f, rwAry)
                    Dim w As String
                    For a As Integer = 1 To m
                        w = rwAry(a)
                        If VB.Left(w, 1) = hed Then
                            mJWD(ID).wDX = mJWD(ID).wDX + 1
                            If mJWD(ID).wDX > mJWD(ID).arymax Then
                                Call zJishoKomokuAryAddDel(gcAdd, ID)
                            End If
                            mJWD(ID).wd(mJWD(ID).wDX) = w
                        End If
                    Next
                    mJWD(ID).loaded = True
                    Call zJishokeyIndexSet(ID)
                    Cursor.Current = Cursors.Default
                End If
            End If
        End If
        Return ID
errop:
        Reset()
        Cursor.Current = Cursors.Default
        MsgBox(ErrorToString())
        Return 0
    End Function
    Private Function zJishoSave(ByRef ID As Integer, ByRef lst As System.Windows.Forms.ListBox) As String
        On Error GoTo errop
        Dim p, a, l As Integer : Dim h, fb, w As String : Dim bf As String
        Dim f As String = ""
        Dim RET As String = ""
        If ID < 1 Then Return ""
        If mJWD(ID).change = True Then 'DO SAVE
            If mJWD(ID).dosort = True Then
                If mJWD(ID).wDX > 0 Then
                    'qqqqq(mJWD(ID).wd(1))
                    lst.Items.Clear()
                    For a = 1 To mJWD(ID).wDX
                        lst.Items.Add(mJWD(ID).wd(a))
                    Next
                    lst.Refresh()
                    For a = 0 To lst.Items.Count - 1
                        mJWD(ID).wd(a + 1) = aaggリストボックスのテキスト(lst, a) ' lst.GetItemText(lst.Items(a).text) '  VB6.GetItemString(lst, a) 
                    Next
                    lst.Items.Clear()
                End If
                mJWD(ID).dosort = False
            End If
            '---------------------------------------------
            bf = New String(c32, cJishoFileMaxLen + 2000)
            p = 1
            h = "■分類項目 ＝ " & mJWD(ID).hed & c13
            h = h & "■項目数 ＝ " & Format(mJWD(ID).wDX, "00000") & c13
            h = h & "■バイト数 ＝ " & Format(0, "00000") & c13
            h = h & "■最終更新 ＝ " & Format(Now, Format最終更新) & c13
            l = Len(h)
            Mid(bf, p, l) = h
            p = p + l
            '-----------------------------------
            For a = 1 To mJWD(ID).wDX
                w = mJWD(ID).wd(a) & vbCrLf
                l = Len(w)
                Mid(bf, p, l) = w
                p = p + l
                If p > cJishoFileMaxLen Then GoTo Sizeover
            Next
            bf = Trim(bf)
            w = Format(Len(bf), "00000")
            p = InStr(1, bf, "■バイト数 ＝ ")
            If p > 0 And p < 200 Then Mid(bf, p + 8, 5) = w
            '-----------------------------------
            f = zJishoFileName(ID)
            If f <> "" Then
                If Len(Dir(f, 0)) > 3 Then
                    fb = Ⅹパスセパレータ付加(JishoFileFolder) & cHedBackFile & Ⅹフルパス名からファイル名あるいは最後のフォルダ名を得る(f, True)
                    fb = fb & Format(Now, cBackFileAddFormat) & Ⅹファイル拡張子(f, True)
                    FileCopy(f, fb)
                End If
                If ⅩFileTextSave(f, bf) = True Then
                    mJWD(ID).change = False
                    RET = f
                End If
            End If
            bf = ""
        End If
        Return RET
Sizeover:
        w = "辞書ファイルのサイズが" & c13 & Format(cJishoFileMaxLen \ 1000) & "Ｋ文字を超えています" & c13
        w = w & f & c13 & "は保存できません"
        a = MsgBox(w, 48, "辞書ファイルサイズオーバー")
        Return ""
errop:
        Reset()
        MsgBox(ErrorToString())
        Return ""
    End Function
    Private Function zKyeWordNext(ByRef keyword As String) As String
        Dim a As Integer : Dim w, s, kw, ww As String
        s = JpnEngCheck(VB.Left(keyword, 1))
        If Len(keyword) < 2 Then
            Select Case s
                Case "J"
                    w = "ぁ"
                Case Else
                    w = "Ａ"
            End Select
            Return keyword & w
        Else
            kw = VB.Right(keyword, 1)
            Select Case s
                Case "J"
                    w = "ー"
                    a = InStr(1, "あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよらりるれろわをん", kw)
                    If a = 0 Then
                        a = InStr(1, "ぁぃぅぇぉがぎぐげござじずぜぞだぢづでど□□□□□ばびぶべぼ□□□□□ゃゅょ", kw)
                        If a = 0 Then
                            a = InStr(1, "□□□□□□□□□□□□□□□□□っ□□□□□□□ぱぴぷぺぽ", kw)
                        End If
                    End If
                    If a > 0 Then
                        w = Mid("ぃぅぇぉかきくけこさしすせそたちってとなにぬねのはひふへほまみむめもゃゅょらりるれろわをんん", a, 1)
                    End If
                Case Else
                    w = "z"
            End Select
            ww = keyword
            Mid(ww, Len(ww), 1) = w
            Return ww
        End If
    End Function
    Private Sub Jisho_Initialize()
        '-----------------------------
        JishoFileFolder = 絶対パス_PacoCOM辞書_Folder()
        '-----------------------------
        Call JishoFilesChangedClear()
        c13 = vbCrLf
        c32 = " "
        c44 = ","
        '-----------------------------
        Dim s As String
        s = ""
        s = s & "あいうえおかきくけこ"
        s = s & "がぎぐげごさしすせそ"
        s = s & "ざじずぜぞたちつてと"
        s = s & "だぢづでどなにぬねの"
        s = s & "はひふへほばびぶべぼ"
        s = s & "ぱぴぷぺぽまみむめも"
        s = s & "やゆよらりるれろわん"
        mHedKeyJpn = s
        mHedKeyJpnExt = "ーをぁぃぅぇぉゃゅょっ"
        s = ""
        s = s & "ＡＢＣＤＥＦＧＨＩＪ"
        s = s & "ＫＬＭＮＯＰＱＲＳＴ"
        s = s & "ＵＶＷＸＹＺ"
        mHedKeyEng = s
        mHedKeyStr = mHedKeyJpn & mHedKeyEng
        mJWDmax = Len(mHedKeyStr)
        Dim a As Integer
        For a = 1 To mJWDmax
            Call zJishoKomokuAryAddDel(gcReset, a)
        Next
        'Debug.Print "CofJisho--Form_Initialize"
    End Sub
#End Region

#End Region


#Region "それぞれのユーザーアプリのグローバルモジュールで設定が必要"
    '    Friend Function 絶対パス_AppPathCurSubFolder(ByVal rSubFolderName As String) As String
    '        Dim sAppPathyy As String = Ⅹパスセパレータ付加(ⅩAppフォルダ名())
    '        '2023/11/15  アプリの開発環境での設定により、デバッグモードの実行ファイルの位置が変わりうるので、相対パスの設定に注意が必要。
    '        '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    '        '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    '#If DEBUG Then
    '        Return sAppPathyy & "..\..\" & rSubFolderName
    '#Else
    '            Return sAppPathyy & rSubFolderName
    '#End If
    '        '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    '        '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
    '        '2023/11/15  アプリの開発環境での設定により、デバッグモードの実行ファイルの位置が変わりうるので、相対パスの設定に注意が必要。
    '        ''-----------------------------
    '        'Return sAppPathyy & rSubFolderName
    '        ''-----------------------------
    '    End Function
#End Region


End Class


