Option Strict Off
Option Explicit On
#Region "Imports"
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.IO
Imports System.Windows.Forms
Imports VB = Microsoft.VisualBasic
#End Region

Module 五basCOM
    Private Const MeName As String = "五basCOM"

#Region "WinAPI"
    '**********************************************************************************************
    Declare Function GetWindowsDirectory Lib "KERNEL32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
    Declare Function GetSystemDirectory Lib "KERNEL32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
    '**********************************************************************************************
    Public Const SW_SHOW As Integer = 5
    '**********************************************************************************************
    Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Integer
    ''lpszFile    文書ファイルか実行可能ファイルの名前
    ''lpszDir     デフォルトディレクトリのドライブ文字とパス
    ''lpszResult  実行可能ファイルの名前が返されます
    ''関数が正常に終了した場合は、32より大きい値を返します
    ''32以下の戻り値は、エラー値を示します。
    Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Integer, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Integer) As Integer
    '**********************************************************************************************
    Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Integer, ByRef lpPoint As POINTAPI) As Integer
    '**********************************************************************************************
    <StructLayout(LayoutKind.Sequential)> Structure RECT
        Public lll As Integer
        Public ttt As Integer
        Public rrr As Integer
        Public bbb As Integer
    End Structure
    <StructLayout(LayoutKind.Explicit)> Structure POINTAPI
        <FieldOffset(0)> Dim X As Integer
        <FieldOffset(4)> Dim Y As Integer
    End Structure
    '**********************************************************************************************
    Declare Function SetRect Lib "user32" (ByRef lpRect As RECT, ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer) As Integer
    Declare Function CopyRect Lib "user32" Alias "CopyRect" (ByRef lpDestRect As RECT, ByRef lpSourceRect As RECT) As Integer
    Declare Function InflateRect Lib "user32" Alias "InflateRect" (ByRef lpRect As RECT, ByVal x As Integer, ByVal y As Integer) As Integer
    Declare Function IsRectEmpty Lib "user32" Alias "IsRectEmpty" (ByRef lpRect As RECT) As Integer
    Declare Function SetRectEmpty Lib "user32" Alias "SetRectEmpty" (ByRef lpRect As RECT) As Integer
    Declare Function FillRect Lib "user32" (ByVal hDC As Integer, ByRef lpRect As RECT, ByVal hBrush As Integer) As Integer
    Declare Function FrameRect Lib "user32" (ByVal hDC As Integer, ByRef lpRect As RECT, ByVal hBrush As Integer) As Integer
    '**********************************************************************************************
    Declare Function SelectObject Lib "gdi32" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer
    Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Integer) As Integer
    Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Integer) As Integer
    Declare Function GetSysColor Lib "user32" (ByVal nIndex As Integer) As Integer
    Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Integer
    '********************************************************************************
#End Region

#Region "変数と定数とEnum"
    Public gm使用中のディスプレイ台数 As Integer = 0 '2023/03/03 add
    '---------------------------------------------------------
    Public gggCR2 As String = vbCrLf & vbCrLf
    Public gggbol As Boolean        '2022/03/07　　全コードで共有するテンポラリー戻り値。　Boolean型  で共用。
    Public gggint As Integer        '2022/03/07　　全コードで共有するテンポラリー戻り値。　Integer型  で共用。
    Public gggsng As Single
    Public gggstr As String = ""    '2022/03/07　　全コードで共有するテンポラリー戻り値。　String 型  で共用。
    Public Const gggYearDayFormat As String = "yyyy/MM/dd"
    Public Const gggDayTimeFormat_yyyyMMdd_HHmmss As String = "yyyyMMdd-HHmmss"
    Public Const gggDayTimeFormat_yyyyMMddHHmmss As String = "yyyyMMddHHmmss"   '注意　 VB5  のコード  "yyyymmddhhmmss"  を使用すると　.NET_VB　ではエラーになる。
    'ⅩFormMove() ----------------------------------------------------------------
    Public Const gcoフォームのサイズと位置を設定 As Integer = 1200
    Public Const gcoフォームをスクリーン内に移動 As Integer = 1210
    Public Const gcoフォームをスクリーン中心に移動 As Integer = 1220
    Public Const gcoフォーム中心をマウス位置中心に移動 As Integer = 1230
    Public Const gcoフォーム左上をマウス位置中心に移動 As Integer = 1240
    Public Const gcoフォームのサイズと位置の変更禁止 As Integer = 1250
    Public Const gcoフォームを親フォームの中心に移動 As Integer = 1260
    Public Const gcoプロパGetARY As Integer = 17430
    Public Const gcoプロパLetARY As Integer = 17440
    Public Const gcoプロパconvARYtoSTR As Integer = 17450
    Public Const gcoプロパconvSTRtoARY As Integer = 17460
    'Mouse Events ----------------------------------------------------------------
    Public Const gcoMsDown As Integer = 1300
    Public Const gcoMsMove As Integer = 1310
    Public Const gcoMsUp As Integer = 1320
    '-----------------------------------------------
    Public Const ggcChr58 As String = ":" '2025/01/19 Add
#End Region

#Region "基本"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩSysFolderWindows() As String
        Dim s As String = New String(Chr(0), 256)
        gggint = GetWindowsDirectory(s, Len(s)) : Return VB.Left(s, InStr(s, vbNullChar) - 1)
    End Function
    Function ⅩSysFolderSystem() As String
        Dim s As String = New String(Chr(0), 256)
        gggint = GetSystemDirectory(s, Len(s)) : Return VB.Left(s, InStr(s, vbNullChar) - 1)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function qqqqq(ByVal s As String) As Boolean
        'Debug.Print 専用の関数　2012/05/05 new
        Debug.Print(s) : Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩControlNameStr(ByRef c As Control) As String
        If c Is Nothing Then Return "" Else Return c.Name
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩAppフォルダ名() As String
        Return My.Application.Info.DirectoryPath
    End Function
    Function ⅩAppタイトル名() As String
        Return ⅩApp関連タイトル名("")
    End Function
    Function ⅩApp関連タイトル名(ByRef rドット付拡張子 As String) As String
        Return My.Application.Info.AssemblyName & rドット付拡張子
    End Function
    Function ⅩAppEXEタイトル名_EXE_付() As String
        Return ⅩApp関連タイトル名(".EXE")
    End Function
    Function ⅩAppEXEのフルパスファイル名_EXEなし() As String
        Return Ⅹパスセパレータ付加(ⅩAppフォルダ名()) & ⅩAppタイトル名()
    End Function
    Function ⅩAppEXEのフルパスファイル名() As String
        Return Ⅹパスセパレータ付加(ⅩAppフォルダ名()) & ⅩAppEXEタイトル名_EXE_付()
    End Function
    Function Ⅹワードパッドのフルパスファイル名_In_WinXP() As String
        Return "c:\Program Files\Windows NT\Accessories\wordpad.exe"
    End Function
    Function ⅩExplorerのフルパスファイル名() As String
        Return Ⅹパスセパレータ付加(ⅩSysFolderWindows) & "Explorer.exe"
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹアプリデーター文字列_バージョンとコンパイル日付() As String
        Const TF As String = gggYearDayFormat : Dim t, f As String
        f = ⅩAppEXEのフルパスファイル名()
        If Ⅹファイルは存在(f) Then t = Format(FileDateTime(f), TF) Else t = Format(Now, TF)
        Return Format(My.Application.Info.Version.Major) & "." & Format(My.Application.Info.Version.Minor) & "." & Format(My.Application.Info.Version.Revision) & "　(" & t & ")"
    End Function
#End Region

#Region "数値計算"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ数値範囲Int(ByVal dmin As Integer, ByVal dmax As Integer, ByVal dcheck As Integer) As Integer
        Dim a, a0 As Integer : Dim a1 As Integer
        If dmin < dmax Then
            a0 = dmin : a1 = dmax
        Else
            a0 = dmax : a1 = dmin
        End If
        a = dcheck
        If a > a1 Then a = a1
        If a < a0 Then a = a0
        Return a
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ数値範囲Sng(ByRef dmin As Single, ByRef dmax As Single, ByRef dcheck As Single) As Single
        Dim a, a0, a1 As Single
        If dmin < dmax Then
            a0 = dmin : a1 = dmax
        Else
            a0 = dmax : a1 = dmin
        End If
        a = dcheck
        If a > a1 Then a = a1
        If a < a0 Then a = a0
        Return a
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩBitsAnd(ByRef rMainVal As Integer, ByRef rChkVal As Integer) As Boolean
        Return ((rMainVal And rChkVal) = rChkVal)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "フォント"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function aaggFontStrChange(ByVal ToFont_0_ToString_1 As Integer, ByRef rwCont As Control, ByRef rwDataStr As String, ByVal rSizeMin As Integer, ByVal rSizeMax As Integer) As Boolean
        If rwCont Is Nothing Then Return False
        Try
            Dim rw名前 As String = "メイリオ", rwサイズ As Integer, rw太字 As Boolean, rw斜体 As Boolean, rw下線 As Boolean, rw取消線 As Boolean
            Dim Style As FontStyle = FontStyle.Regular
            If ToFont_0_ToString_1 = 0 Then
                If Not aaggFontDataStrIO(ToFont_0_ToString_1, rwDataStr, rw名前, rwサイズ, rw太字, rw斜体, rw下線, rw取消線, rSizeMin, rSizeMax) Then Return False
                gggbol = aaggFontStyle_FontProp_ExChange(1, Style, rw太字, rw斜体, rw下線, rw取消線)
                Return Ⅹコントロールフォント変更(rwCont, rw名前, rwサイズ, Style)
            Else
                rw名前 = rwCont.Font.Name
                rwサイズ = rwCont.Font.Size
                Style = rwCont.Font.Style
                gggbol = aaggFontStyle_FontProp_ExChange(0, Style, rw太字, rw斜体, rw下線, rw取消線)
                Return aaggFontDataStrIO(ToFont_0_ToString_1, rwDataStr, rw名前, rwサイズ, rw太字, rw斜体, rw下線, rw取消線, rSizeMin, rSizeMax)
            End If
        Catch ex As Exception
        End Try
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function aaggFontDataStrIO(ByVal ToDataVal_0_ToString_1 As Integer, ByRef rwDataStr As String, _
                               ByRef rw名前 As String, ByRef rwサイズ As Integer, ByRef rw太字 As Boolean, ByRef rw斜体 As Boolean, ByRef rw下線 As Boolean, ByRef rw取消線 As Boolean, _
                               ByVal rSizeMin As Integer, ByVal rSizeMax As Integer) As Boolean
        Dim c As String = ggcChr58  'Public Const ggcChr58 As String = ":"
        If ToDataVal_0_ToString_1 = 0 Then
            rw名前 = "メイリオ" : rwサイズ = 9 : rw太字 = False : rw斜体 = False : rw下線 = False : rw取消線 = False
            Dim ary() As String = {""}
            If 6 = Ⅹ文をカットして配列にする(rwDataStr, c, ary) Then
                rw名前 = ary(1) : rwサイズ = Ⅹ数値範囲Int(rSizeMin, rSizeMax, Val(ary(2))) : rw太字 = aaggBoolFromStr(ary(3)) : rw斜体 = aaggBoolFromStr(ary(4)) : rw下線 = aaggBoolFromStr(ary(5)) : rw取消線 = aaggBoolFromStr(ary(6))
            End If
            Return True
        Else
            Dim sss As String = IIf(rw名前 = "", "メイリオ", rw名前)
            Dim nnn As Integer = Ⅹ数値範囲Int(rSizeMin, rSizeMax, rwサイズ)
            rwDataStr = sss & c & CStr(nnn) & c & aaggBoolToStr(rw太字) & c & aaggBoolToStr(rw斜体) & c & aaggBoolToStr(rw下線) & c & aaggBoolToStr(rw取消線)
            Return True
        End If
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function aaggFontStyle_FontProp_ExChange(ByVal opStyle_Get_0_Set_1 As Integer, ByRef rwStyle As FontStyle, ByRef rwBold As Boolean, ByRef rwItalic As Boolean, ByRef rwUnderline As Boolean, ByRef rwStrikeout As Boolean) As Boolean
        If opStyle_Get_0_Set_1 = 0 Then
            rwBold = ((rwStyle And FontStyle.Bold) = FontStyle.Bold)
            rwItalic = ((rwStyle And FontStyle.Italic) = FontStyle.Italic)
            rwUnderline = ((rwStyle And FontStyle.Underline) = FontStyle.Underline)
            rwStrikeout = ((rwStyle And FontStyle.Strikeout) = FontStyle.Strikeout)
        Else
            If rwBold Then rwStyle = (rwStyle Or FontStyle.Bold) Else rwStyle = (IIf(rwItalic, FontStyle.Italic, 0) Or IIf(rwUnderline, FontStyle.Underline, 0) Or IIf(rwStrikeout, FontStyle.Strikeout, 0))
            If rwItalic Then rwStyle = (rwStyle Or FontStyle.Italic) Else rwStyle = (IIf(rwBold, FontStyle.Bold, 0) Or IIf(rwUnderline, FontStyle.Underline, 0) Or IIf(rwStrikeout, FontStyle.Strikeout, 0))
            If rwUnderline Then rwStyle = (rwStyle Or FontStyle.Underline) Else rwStyle = (IIf(rwBold, FontStyle.Bold, 0) Or IIf(rwItalic, FontStyle.Italic, 0) Or IIf(rwStrikeout, FontStyle.Strikeout, 0))
            If rwStrikeout Then rwStyle = (rwStyle Or FontStyle.Strikeout) Else rwStyle = (IIf(rwBold, FontStyle.Bold, 0) Or IIf(rwItalic, FontStyle.Italic, 0) Or IIf(rwUnderline, FontStyle.Underline, 0))
        End If
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹコントロールフォント変更(ByRef Cont As Control, ByVal フォント名 As String, ByVal フォントサイズ As Single, ByVal rBold As Boolean, ByVal rItalic As Boolean, ByVal rUnderline As Boolean, ByVal rStrikeout As Boolean) As Boolean
        Try
            Dim Style As FontStyle = FontStyle.Regular
            gggbol = aaggFontStyle_FontProp_ExChange(1, Style, rBold, rItalic, rUnderline, rStrikeout)
            gggbol = Ⅹコントロールフォント変更(Cont, フォント名, フォントサイズ, Style)
            Return True
        Catch ex As Exception
            MsgBox("ERROR in " & MeName & ".Ⅹコントロールフォント変更()" & vbCrLf & ex.ToString)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩObjColorFontCopy(ByVal 送 As Control, ByVal 受1 As Control, Optional ByVal 受2 As Control = Nothing, Optional ByVal 受3 As Control = Nothing, Optional ByVal 受4 As Control = Nothing, Optional ByVal 受5 As Control = Nothing, Optional ByVal 受6 As Control = Nothing, Optional ByVal 受7 As Control = Nothing, Optional ByVal 受8 As Control = Nothing, Optional ByVal 受9 As Control = Nothing, Optional ByVal 受10 As Control = Nothing) As Boolean
        '2023/09/15 new
        If Not ⅩObjColorFontCopy_sub(送, 受1) Then Return False
        If Not ⅩObjColorFontCopy_sub(送, 受2) Then Return True
        If Not ⅩObjColorFontCopy_sub(送, 受3) Then Return True
        If Not ⅩObjColorFontCopy_sub(送, 受4) Then Return True
        If Not ⅩObjColorFontCopy_sub(送, 受5) Then Return True
        If Not ⅩObjColorFontCopy_sub(送, 受6) Then Return True
        If Not ⅩObjColorFontCopy_sub(送, 受7) Then Return True
        If Not ⅩObjColorFontCopy_sub(送, 受8) Then Return True
        If Not ⅩObjColorFontCopy_sub(送, 受9) Then Return True
        If Not ⅩObjColorFontCopy_sub(送, 受10) Then Return True
        Return True
    End Function
    Function ⅩObjColorFontCopy_sub(ByVal 送 As Control, ByVal 受 As Control) As Boolean
        If 受 Is Nothing Then Return False
        Try
            With 受
                .Font = 送.Font
                .ForeColor = 送.ForeColor
                .BackColor = 送.BackColor
            End With
            Return True
        Catch ex As Exception
            MsgBox("ERROR in ⅩObjColorFontCopy_sub()" & gggCR2 & ex.ToString)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Public Sub ⅩFontSize_Set_SizeVal_Or_MenuItem(ByVal mnu As ToolStripMenuItem, ByVal fsz As Single, Optional ByVal cont0 As Control = Nothing, Optional ByVal cont1 As Control = Nothing, Optional ByVal cont2 As Control = Nothing, Optional ByVal cont3 As Control = Nothing, Optional ByVal cont4 As Control = Nothing, Optional ByVal cont5 As Control = Nothing, Optional ByVal cont6 As Control = Nothing, Optional ByVal cont7 As Control = Nothing)
        Dim n As Single
        If mnu IsNot Nothing Then
            n = Val(mnu.Text)
        Else
            n = fsz
        End If
        n = Ⅹ数値範囲Sng(7, 72, n)
        gggsng = ⅩFontSizeChange(cont0, n) : gggsng = ⅩFontSizeChange(cont1, n) : gggsng = ⅩFontSizeChange(cont2, n) : gggsng = ⅩFontSizeChange(cont3, n)
        gggsng = ⅩFontSizeChange(cont4, n) : gggsng = ⅩFontSizeChange(cont5, n) : gggsng = ⅩFontSizeChange(cont6, n) : gggsng = ⅩFontSizeChange(cont7, n)
    End Sub
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩFontSizeChange(ByVal cont As Control, ByVal rNewSize As Single, Optional ByVal rSizeMin As Single = 8, Optional ByVal rSizeMax As Single = 72) As Single
        If cont Is Nothing Then Return 0
        Try
            Dim fsz As Single = Ⅹ数値範囲Sng(rSizeMin, rSizeMax, rNewSize)
            With cont
                .Font = New Font(.Font.Name, rNewSize, .Font.Style, .Font.Unit)
            End With
            Return fsz
        Catch ex As Exception
            qqqqq("ERROR in ⅩFontSizeChange()" & gggCR2 & ex.ToString)
            Return 0
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹコントロールフォント変更(ByRef Cont As Control, ByVal フォント名 As String, ByVal フォントサイズ As Single) As Boolean
        Try
            Dim フォントFontStyle As FontStyle = Cont.Font.Style
            Dim ft As New Font(フォント名, フォントサイズ, フォントFontStyle)
            Cont.Font = ft
            Cont.Refresh()
            Return True
        Catch ex As Exception
            MsgBox("ERROR!!!  Ⅹコントロールフォント変更()" & gggCR2 & ex.ToString)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹコントロールフォント変更_NameSizeBold(ByRef Cont As Control, ByVal フォント名 As String, ByVal フォントサイズ As Single, ByVal フォントボールド As Boolean) As Boolean
        Try
            Dim NewStyle As New FontStyle
            With Cont
                If フォントボールド Then
                    NewStyle = FontStyle.Bold Or .Font.Italic Or .Font.Underline Or .Font.Strikeout
                Else
                    NewStyle = FontStyle.Regular Or .Font.Italic Or .Font.Underline Or .Font.Strikeout
                End If
            End With
            Dim ft As New Font(フォント名, フォントサイズ, NewStyle)
            Cont.Font = ft
            Cont.Refresh()
            Return True
        Catch ex As Exception
            MsgBox("ERROR!!!  Ⅹコントロールフォント変更()" & gggCR2 & ex.ToString)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹコントロールフォント変更(ByRef Cont As Control, ByVal フォント名 As String, ByVal フォントサイズ As Single, ByVal フォントFontStyle As FontStyle) As Boolean
        Try
            Dim ft As New Font(フォント名, フォントサイズ, フォントFontStyle)
            Cont.Font = ft
            Cont.Refresh()
            Return True
        Catch ex As Exception
            MsgBox("ERROR!!!  Ⅹコントロールフォント変更()" & gggCR2 & ex.ToString)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹフォントサイズリスト作成(ByRef wCboFontSize As ComboBox, Optional ByRef Maxsize As Integer = 257, Optional ByRef r選択フォントSize As Integer = 0) As Boolean
        '2023/08/08 Maxsize　以下のサイズコンボ  wCboFontSize  を作る
        Const cFontsSizeCount As Integer = 29
        Static mFontsSize(cFontsSizeCount) As Integer
        Dim a As Integer
        Try
            If mFontsSize(29) <> 256 Then
                mFontsSize(1) = 8 : mFontsSize(2) = 9 : mFontsSize(3) = 10 : mFontsSize(4) = 11 : mFontsSize(5) = 12 : mFontsSize(6) = 14
                mFontsSize(7) = 16 : mFontsSize(8) = 18 : mFontsSize(9) = 20 : mFontsSize(10) = 22 : mFontsSize(11) = 24 : mFontsSize(12) = 26
                mFontsSize(13) = 28 : mFontsSize(14) = 32 : mFontsSize(15) = 36 : mFontsSize(16) = 42 : mFontsSize(17) = 48 : mFontsSize(18) = 56
                mFontsSize(19) = 64 : mFontsSize(20) = 72 : mFontsSize(21) = 84 : mFontsSize(22) = 96 : mFontsSize(23) = 112 : mFontsSize(24) = 128
                mFontsSize(25) = 144 : mFontsSize(26) = 168 : mFontsSize(27) = 192 : mFontsSize(28) = 224 : mFontsSize(29) = 256
            End If
            If Not wCboFontSize Is Nothing Then
                With wCboFontSize
                    .Items.Clear()
                    For a = 1 To cFontsSizeCount
                        If mFontsSize(a) <= Maxsize Then .Items.Add(VB.Format(mFontsSize(a))) Else Exit For
                    Next
                    If r選択フォントSize > 7 Then
                        For a = 0 To .Items.Count - 1
                            If Val(.GetItemText(.Items(a))) = r選択フォントSize Then
                                .SelectedIndex = a
                                Exit For
                            End If
                        Next
                    End If
                End With
            End If
            Return True
        Catch ex As Exception
            MsgBox(ErrorToString())
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹフォントコンボ簡易リスト作成(ByRef wFonts() As String, Optional ByRef wCommbo As ComboBox = Nothing, Optional ByRef r選択フォント名 As String = "", Optional ByRef r非表示フォント名追加リスト As String = "", Optional ByRef r配列からもフォント名を削除する As Boolean = False) As Integer
        '日本語では不要なフォントを取り除いた配列リスト　wFonts()　を作る。
        'wCommbo　が指定されていれば、それにリストアップする。
        'r選択フォント名　が指定されていれば、リストからそれを選択する。
        'wCommbo　で選択されているリストのインデックスを返す。なければ先頭のインデックスを選択して　0　を返す。
        '---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
        '削除できる　新しいフォントデーター　2023/03/07 変更
        Const ABCfonts As String = "::削除フォントリスト = ::::Modern::VisualUI::Roman::Script::Courier::MS Serif::MS Sans Serif::Marlett::Arial::Arabic Transparent::Arial Baltic" & _
        "::Arial CE::Arial CYR::Arial Greek::Arial TUR::Arial Black::Calibri::Calibri Light::Cambria::Cambria Math::Candara::Comic Sans MS::Consolas::Constantia" & _
        "::Corbel::Courier New::Courier New Baltic::Courier New CE::Courier New CYR::Courier New Greek::Courier New TUR::Ebrima::Franklin Gothic Medium::Gabriola" & _
        "::Gadugi::Georgia::Impact::Javanese Text::Leelawadee UI::Leelawadee UI Semilight::Lucida Console::Lucida Sans Unicode::Malgun Gothic::Malgun Gothic Semilight" & _
        "::Microsoft Himalaya::Microsoft JhengHei::Microsoft JhengHei UI::Microsoft JhengHei Light::Microsoft JhengHei UI Light::Microsoft New Tai Lue::Microsoft PhagsPa" & _
        "::Microsoft Sans Serif::Microsoft Tai Le::Microsoft YaHei::Microsoft YaHei UI::Microsoft YaHei Light::Microsoft YaHei UI Light::Microsoft Yi Baiti" & _
        "::MingLiU -ExtB::PMingLiU -ExtB::MingLiU_HKSCS -ExtB::Mongolian Baiti::MV Boli::Myanmar Text::Nirmala UI::Nirmala UI Semilight::Palatino Linotype::Segoe MDL2 Assets" & _
        "::Segoe Print::Segoe Script::Segoe UI::Segoe UI Black::Segoe UI Emoji::Segoe UI Historic::Segoe UI Light::Segoe UI Semibold::Segoe UI Semilight::Segoe UI Symbol" & _
        "::SimSun::NSimSun::SimSun -ExtB::Sitka Small::Sitka Text::Sitka Subheading::Sitka Heading::Sitka Display::Sitka Banner::Sylfaen::Symbol::Tahoma::Times New Roman" & _
        "::Times New Roman Baltic::Times New Roman CE::Times New Roman CYR::Times New Roman Greek::Times New Roman TUR::Trebuchet MS::Verdana::Webdings::Wingdings" & _
        "::Abadi MT Condensed::Wingdings 2::Wingdings 3::MingLiU-ExtB::PMingLiU-ExtB::MingLiU_HKSCS-ExtB::SimSun-ExtB" & "::Bahnschrift Light::Bahnschrift SemiLight::Bahnschrift::Bahnschrift SemiBold" & _
        "::Bahndensed" & "::Bahnschrift SemiBold SemiConden::Bahnschrift Light Condensed::Bahnschrift SemiLight Condensed" & _
        "::Nina" & "::Bahnschrift Light SemiCondensed::Bahnschrift SemiLight SemiConde::Bahnschrift SemiCondensed" & _
        "::Bahnschrift Condensed::Bahnschrift SemiBold Condensed::Candara Light::Corbel Light::Ink Free::HoloLens MDL2 Assets::::"
        '---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
        '使用可能な　新しいフォントデーター　2017/12/11 作成
        '游ゴシック    游ゴシック Light    游ゴシック Medium    メイリオ    MS ゴシック    MS Pゴシック    MS 明朝    MS P明朝    游明朝    游明朝 Demibold    游明朝 Light    MS UI Gothic
        'Terminal    System    FixedSys    Small Fonts    Yu Gothic UI    Yu Gothic UI Semibold    Yu Gothic UI Light    Yu Gothic UI Semilight    Meiryo UI
        '---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
        Dim sss As String = ABCfonts & r非表示フォント名追加リスト & "::"
        '---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
        Dim RET As Integer = 0
        If Ⅹフォントリストアップ(wFonts, wCommbo, sss, r配列からもフォント名を削除する) > 0 Then
            If Not wCommbo Is Nothing Then
                Dim a As Integer
                a = Ⅹコンボボックスで文を探し存在すればそれを選択(wCommbo, r選択フォント名, True)
                If a < 0 Then wCommbo.SelectedIndex = 0
                RET = wCommbo.SelectedIndex
            Else
                RET = -1
            End If
        Else
            RET = -1
        End If
        Return RET
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹフォントリストアップ(ByRef wFonts() As String, Optional ByRef wCommbo As ComboBox = Nothing, Optional ByRef r追加禁止フォント群文字列 As String = "", Optional ByRef r配列からもフォント名を削除する As Boolean = False) As Integer
        '2022/03/15 chg for NET
        '-------------------------------------------
        'wFonts()  あるいは  wCommbo に入れたくないフォントは "::" & FontNameStr & "::" を 　r追加禁止フォント群文字列 　内に指定する。'r追加禁止フォント群文字列 ="" の場合はすべて入る。
        '-------------------------------------------
        Static sFonts() As String = {""} : Dim nnn, a, b, mmm As Integer : Dim ary() As String = {""} : Dim s As String
        '-------------------------------------------
        ReDim wFonts(0)
        Try
            a = UBound(sFonts)
        Catch ex As Exception
            qqqqq("ERROR  a = UBound(sFonts) ---> " & ex.Message)
            a = 0 : ReDim sFonts(a)
        End Try
        '-------------------------------------------
        '2022/03/15 test code
        'ReDim sFonts(0)     'この関数を、繰り返して、テストする場合は  こちらを使用する。
        '2022/03/15 test code
        '-------------------------------------------
        If UBound(sFonts) = 0 Then
            '2022/03/13 new
            mmm = Ⅹフォントリスト_パソコン内_を_文の配列へ(ary)
            ReDim sFonts(mmm)
            '2022/03/13 new

            nnn = 0
            For a = 1 To mmm
                If ary(a) <> "" Then
                    If InStr(ary(a), "@") > 0 Then '縦書き用フォントを削除
                        ary(a) = ""
                    Else '全角文字　フォント名を先頭に移動
                        s = ary(a)
                        For b = 1 To Len(s)
                            If Asc(Mid(s, b, 1)) < 0 Then
                                nnn = nnn + 1 : sFonts(nnn) = s : ary(a) = "" : Exit For
                            End If
                        Next
                    End If
                End If
            Next
            For a = 1 To mmm '半角ローマ字　フォント名を追加
                If ary(a) <> "" Then
                    nnn = nnn + 1 : sFonts(nnn) = ary(a)
                End If
            Next
            ReDim Preserve sFonts(nnn)
        End If
        '--------------------------------------------------------------------------------------------------------
        nnn = UBound(sFonts) : ReDim wFonts(nnn) : For a = 1 To nnn : wFonts(a) = sFonts(a) : Next
        '--------------------------------------------------------------------------------------------------------
        'ユーザーへ返す　wFonts()　から　r追加禁止フォント群文字列　のフォントを削除する。
        If r配列からもフォント名を削除する Or (r追加禁止フォント群文字列 <> "") Then
            ReDim ary(nnn) : For a = 1 To nnn : ary(a) = wFonts(a) : Next
            nnn = 0
            For a = 1 To UBound(ary)
                If InStr(r追加禁止フォント群文字列, "::" & ary(a) & "::") = 0 Then
                    nnn = nnn + 1 : wFonts(nnn) = ary(a)
                End If
            Next
            ReDim Preserve wFonts(nnn)
        End If
        '--------------------------------------------------------------------------------------------------------
        If Not wCommbo Is Nothing Then
            With wCommbo
                .Items.Clear()
                For a = 1 To UBound(wFonts)
                    .Items.Add(wFonts(a))
                    'qqqqq("Ⅹフォントリストアップ() --- " & CStr(wFonts(a)))
                Next
                If .Items.Count > 0 Then .SelectedIndex = 0
            End With
        End If
        Return UBound(wFonts)
        '    '*******************************************************************************************
        '    'テストプログラム   2015/06/09
        '    'フォントリストのリストアップ。プログラムのインストールでフォントが追加されている場合がある。
        '    www = "フォントリスト = "
        '    For a = 1 To UBound(sFonts())
        '        www = www & "::" & sFonts(a) & "::"
        '    Next
        '    Clipboard.Clear
        '    Clipboard.SetText www
        '    'テストプログラム   2015/06/09
        '    '*******************************************************************************************
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹフォントリスト_パソコン内_を_文の配列へ(ByRef wFonts() As String) As Integer
        '2022/03/13 new
        Try
            Dim SysFonts As New System.Drawing.Text.InstalledFontCollection
            Dim fonts() As FontFamily = SysFonts.Families
            Dim mmm As Integer = fonts.Length
            ReDim wFonts(mmm)
            Dim a As Integer
            For a = 0 To mmm - 1
                wFonts(a + 1) = fonts(a).Name
            Next
            Return mmm
        Catch
        End Try
        ReDim wFonts(0)
        Return 0
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹコンボボックスで文を探し存在すればそれを選択(ByRef cb As ComboBox, ByRef s As String, ByRef NoCase As Boolean) As Integer
        If cb Is Nothing Then Return -1
        Dim a As Integer = Ⅹコンボボックスで文を探し存在すればそのインデックスを返す(cb, s, NoCase)
        If a >= 0 Then cb.SelectedIndex = a
        Return a
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹコンボボックスで文を探し存在すればそのインデックスを返す(ByRef cb As ComboBox, ByRef s As String, ByRef NoCase As Boolean) As Integer
        '2022/03/16 chg ComboBox から s と同じ文字列を探す インデックスを返す (-1 = no find)
        'NoCase = true なら大小区別せず探す
        If (s <> "") And (Not cb Is Nothing) Then
            Dim w As String : Dim a As Integer
            If NoCase Then
                w = UCase(s)
                For a = 0 To cb.Items.Count - 1
                    'qqqqq(w & "  " & UCase(cb.Items.Item(a)))
                    If w = UCase(cb.Items.Item(a)) Then Return a
                Next
            Else
                w = s
                For a = 0 To cb.Items.Count - 1
                    If w = cb.Items.Item(a) Then Return a
                Next
            End If
        End If
        Return -1
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "ウインドウ"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩFormMove(ByRef gco指示 As Integer, ByRef f As Form, Optional ByRef rMoveCancel As Boolean = False, _
                            Optional ByRef rWndState As Integer = vbNormal, _
                            Optional ByRef rPxlLeft As Integer = 0, Optional ByRef rPxlTop As Integer = 0, _
                            Optional ByRef rPxlWidth As Integer = 0, Optional ByRef rPxlHeight As Integer = 0, _
                            Optional ByRef rOldSizeUseOK As Boolean = False, Optional ByRef rOwnerForm As Form = Nothing) As Boolean
        'ⅩFormMove()
        'gggbol = ⅩFormMove(gcoフォームのサイズと位置を設定, Me, rMoveCancel, rWndState, rPxlLeft, rPxlTop, rPxlWidth, rPxlHeight) '
        'gggbol = ⅩFormMove(gcoフォームをスクリーン内に移動, Me) '
        'gggbol = ⅩFormMove(gcoフォームをスクリーン中心に移動, Me) '
        'gggbol = ⅩFormMove(gcoフォーム中心をマウス位置中心に移動, Me) '
        'gggbol = ⅩFormMove(gcoフォーム左上をマウス位置中心に移動, Me) '
        'gggbol = ⅩFormMove(gcoフォームを親フォームの中心に移動, Me, , , , , , , , rOwnerForm ) 
        '-------------------------------------
        'rMoveCancel = (rFormPost = Enum一般.フォームのサイズと位置の変更禁止)
        'gggbol = ⅩFormMove(Enum一般.フォームのサイズと位置を設定, f, MoveCancel, WndState, xx, yy, ww, hh)
        '-------------------------------------
        Const cMinWidth As Integer = 100 : Const cMinHeight As Integer = 100
        Const cSpace As Integer = 0 '余剰スペースはなしにする 2011/11/01
        '-------------------------------------
        If rMoveCancel Or f Is Nothing Then Return False
        If ⅩFormMoveable(f) = False Then Return False
        Try
            Dim wd, xx, yy, ht As Integer : Dim ScrnWD, ScrnHT, a As Integer : Dim p As POINTAPI : Dim wPxlRECT As RECT
            Dim ScrnRight, ScrnLeft, ScrnTop, ScrnBottom As Integer
            '-------------------------------------
            gggint = ⅩGetScreenSizeNET(wPxlRECT, ScrnWD, ScrnHT, ScrnLeft, ScrnTop, ScrnRight, ScrnBottom)
            '-------------------------------------
            '2016/01/28 add
            'マルチディスプレイで　フォームサイズがウインドウサイズより大きい場合もあるので、その対策のコードを追加した。
            ScrnWD = Math.Max(ScrnWD, f.Width) : ScrnHT = Math.Max(ScrnHT, f.Height)
            '-------------------------------------
            'if ini file data > screen.width / height
            ScrnWD = Math.Max(ScrnWD, rPxlWidth) : ScrnHT = Math.Max(ScrnHT, rPxlHeight)
            '-------------------------------------
            ScrnWD = Math.Min(ScrnWD, Screen.PrimaryScreen.Bounds.Width * 3) 'if error ini data
            ScrnHT = Math.Min(ScrnHT, Screen.PrimaryScreen.Bounds.Height * 3) 'if error ini data
            '2016/01/28 add
            '-------------------------------------
            Select Case gco指示
                Case gcoフォームのサイズと位置を設定
                    'rOldSizeUseOK が指定された場合は、前回のウインドウの位置とサイズが、正しい値であると保障されている。rWndState <> vbNormal　でも正しいデーターが入っている
                    If (Not rOldSizeUseOK) And (rPxlWidth < 1 Or rPxlHeight < 1 Or rWndState <> FormWindowState.Normal) Then
                        wd = Math.Min(f.Width, ScrnWD - cSpace) : ht = Math.Min(f.Height, ScrnHT - cSpace)
                    Else
                        wd = Ⅹ数値範囲Int(cMinWidth, ScrnWD - cSpace, rPxlWidth) : ht = Ⅹ数値範囲Int(cMinHeight, ScrnHT - cSpace, rPxlHeight)
                    End If
                    If rPxlLeft < 0 Then rPxlLeft = 0 ' = ScrnLeft + (ScrnWD - wd) / 2: @@@@@@@@@@@ 2023/06/27 ERROR 修正
                    If rPxlTop < 0 Then rPxlTop = 0 ' = ScrnTop + (ScrnHT - ht) / 2: @@@@@@@@@@@ 2023/06/27 ERROR 修正
                    xx = Ⅹ数値範囲Int(ScrnLeft, ScrnRight - wd, rPxlLeft) : yy = Ⅹ数値範囲Int(ScrnTop, ScrnBottom - ht, rPxlTop)
                    If f.FormBorderStyle = FormBorderStyle.Sizable Or f.FormBorderStyle = FormBorderStyle.SizableToolWindow Then
                        f.SetBounds(xx, yy, wd, ht)
                    Else
                        f.SetBounds(xx, yy, f.Width, f.Height)
                    End If
                    a = f.FormBorderStyle
                    If a = FormBorderStyle.FixedSingle Or a = FormBorderStyle.Sizable Then
                        f.WindowState = IIf(rWndState = FormWindowState.Maximized, FormWindowState.Maximized, IIf(rWndState = FormWindowState.Normal, FormWindowState.Normal, FormWindowState.Minimized))
                    End If
                Case gcoフォームをスクリーン内に移動, gcoフォームをスクリーン中心に移動, gcoフォーム左上をマウス位置中心に移動, gcoフォーム中心をマウス位置中心に移動, gcoフォームを親フォームの中心に移動
                    If (f.Width) > ScrnWD Then Return False
                    If (f.Height) > ScrnHT Then Return False
                    Select Case gco指示
                        Case gcoフォームをスクリーン内に移動
                            xx = (f.Left) : yy = (f.Top)
                        Case gcoフォームをスクリーン中心に移動
                            xx = ScrnLeft + (ScrnWD - (f.Width)) / 2 : yy = ScrnTop + (ScrnHT - (f.Height)) / 2
                        Case gcoフォームを親フォームの中心に移動
                            If rOwnerForm Is Nothing Then Return False
                            With rOwnerForm
                                xx = (.Left) + ((.Width) - (f.Width)) / 2 : yy = (.Top) + ((.Height) - (f.Height)) / 2
                            End With
                        Case Else
                            If 0 <> GetCursorPos(p) Then
                                xx = p.X : yy = p.Y
                                If gco指示 = gcoフォーム中心をマウス位置中心に移動 Then
                                    xx = xx - (f.Width / 2) : yy = yy - (f.Height / 2)
                                End If
                            End If
                    End Select
                    xx = Ⅹ数値範囲Int(ScrnLeft, ScrnRight - f.Width, xx) : yy = Ⅹ数値範囲Int(ScrnTop, ScrnBottom - f.Height, yy)
                    If xx <> f.Left Or yy <> f.Top Then f.SetBounds(xx, yy, 0, 0, Windows.Forms.BoundsSpecified.X Or Windows.Forms.BoundsSpecified.Y)
            End Select
            Return True
        Catch
        End Try
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩFormMoveable(ByRef f As Form) As Boolean
        If f Is Nothing Then Return False
        Dim NotMoveable As Boolean = (f.FormBorderStyle = FormBorderStyle.None And f.ControlBox = False)
        If (Not (f.MdiParent Is Nothing = True)) Or (f.WindowState <> FormWindowState.Normal) Or (NotMoveable) Then Return False
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩGetScreenSizeNET(ByRef wRECT As RECT, ByRef wWidth As Integer, ByRef wHight As Integer, ByRef wLeft As Integer, ByRef wTop As Integer, ByRef wRight As Integer, ByRef wBottom As Integer) As Boolean
        Dim rcagl As Rectangle = Ⅹスクリーンサイズ(True)
        If rcagl = Nothing Then Return False
        gggint = SetRect(wRECT, rcagl.Left, rcagl.Top, rcagl.Right, rcagl.Bottom)
        wWidth = rcagl.Width : wHight = rcagl.Height : wLeft = wRECT.lll : wTop = wRECT.ttt : wRight = wRECT.rrr : wBottom = wRECT.bbb
        'qqqqqrc "ⅩGetScreenSizeNET() ret wPxlRECT = ", wPxlRECT 'チェック用のデバッグコード
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹスクリーンサイズ(ByRef タスクバー除外 As Boolean, Optional ByRef wLeft As Integer = 0, Optional ByRef wTop As Integer = 0, Optional ByRef wRight As Integer = 0, Optional ByRef wBottom As Integer = 0) As Rectangle
        '2022/03/15 new add
        Try
            Dim ScreenAry() As Screen = Screen.AllScreens  '0 to max
            Dim max As Integer = ScreenAry.GetUpperBound(0)
            Dim rcagl As Rectangle : Dim a As Integer
            gm使用中のディスプレイ台数 = max + 1 '0 to max
            'qqqqq("gm使用中のディスプレイ台数　" & CStr(gm使用中のディスプレイ台数) & "　台")
            If タスクバー除外 Then
                rcagl = ScreenAry(0).WorkingArea
                For a = 0 To max
                    rcagl = System.Drawing.Rectangle.Union(rcagl, ScreenAry(a).WorkingArea)
                Next
                'qqqqq(vbCrLf & "Ⅹスクリーンサイズ() タスクバー除外 = " & rcagj.ToString)
            Else
                rcagl = ScreenAry(0).Bounds
                For a = 0 To max
                    rcagl = System.Drawing.Rectangle.Union(rcagl, ScreenAry(a).Bounds)
                Next
                'qqqqq(vbCrLf & "Ⅹスクリーンサイズ() すべて = " & rcagj.ToString)
            End If
            With rcagl
                wLeft = .Left : wTop = .Top : wRight = .Right : wBottom = .Bottom
            End With
            Return rcagl
        Catch
            Return Nothing
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "TextBox"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function aaggTextBoxAddStr(ByRef wTextBox As TextBox, ByVal rAddStr As String, ByVal rSelectAllText As Boolean) As Integer
        If wTextBox Is Nothing Then Return 0
        If rAddStr = "" Then Return 0
        With wTextBox
            .SelectionStart = Len(.Text) : .SelectedText = rAddStr
            If rSelectAllText Then
                .SelectionStart = 0 : .SelectionLength = Len(.Text)
            End If
            Return Len(.Text)
        End With
    End Function
#End Region

#Region "マウス"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ現在のマウスポイント(ByRef コントロール As Control, ByRef wPPP As POINTAPI, ByRef wPOS As Point) As Boolean
        Try
            If 0 = GetCursorPos(wPPP) Then Return False
            wPOS.X = wPPP.X : wPOS.Y = wPPP.Y
            If Not コントロール Is Nothing Then
                If 0 = ScreenToClient(コントロール.Handle, wPPP) Then Return False
                wPOS.X = wPPP.X : wPOS.Y = wPPP.Y
            End If
            Return True
        Catch
        End Try
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹマウスイベント検査2023(ByRef gcoMsDown_gcoMsUp As Integer, ByVal e As MouseEventArgs) As Boolean
        Dim btn As Integer = e.Button : Dim X As Integer = e.X : Dim Y As Integer = e.Y : Dim movechk As Integer = 3 : Dim upchk As Integer = 3 : Dim wIsMoveDownToUp As Boolean = False
        If gcoMsDown_gcoMsUp = gcoMsDown Then
            Return Ⅹマウスイベント検査2022(gcoMsDown, btn, X, Y, movechk, movechk, upchk, upchk, wIsMoveDownToUp)
        Else
            Return Ⅹマウスイベント検査2022(gcoMsUp, btn, X, Y, movechk, movechk, upchk, upchk, wIsMoveDownToUp)
        End If
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹマウスイベント検査2022(ByRef gcoMsDown_gcoMsMove_gcoMsUp As Integer, ByRef MouseButtonsButton As Integer, ByRef X As Integer, ByRef Y As Integer, _
                                 ByRef MoveShiftX As Integer, ByRef MoveShiftY As Integer, ByRef UpShiftX As Integer, ByRef UpShiftY As Integer, Optional ByRef wIsMoveDownToUp As Boolean = False) As Boolean
        '-----------------------------------------------------------------------------------------------------------------------------
        '2023/10/28
        '使用できるコード
        'Dim btn As Integer = e.Button : Dim X As Integer = e.X : Dim Y As Integer = e.Y : Dim movechk As Integer = 3 : Dim upchk As Integer = 3 : Dim wIsMoveDownToUp As Boolean = False
        'gggbol = Ⅹマウスイベント検査2022(gcoMsDown_gcoMsMove_gcoMsUp, btn, X, Y, movechk, movechk, upchk, upchk, wIsMoveDownToUp)
        '-----------------------------------------------------------------------------------------------------------------------------
        'Boolean = Ⅹマウスイベント検査2022(gcoMsDown_gcoMsMove_gcoMsUp, Button, X, Y, @MoveShiftX, @MoveShiftY, @UpShiftX, @UpShiftY, wIsMoveDownToUp)
        '-----------------------------------------------------------------------------------------------------------------------------
        'マウスムーブの時点では、マウスドラッグが実行され、X か Y が前回より　MoveShiftX / MoveShiftY　以上動いていれば、True　を返す。
        '-----------------------------------------------------------------------------------------------------------------------------
        'マウスアップの時点では、X と Y が マウスダウン時より　UpShiftX / UpShiftY　の範囲以内にある場合にのみ　True　を返す。
        '-----------------------------------------------------------------------------------------------------------------------------
        'wIsMoveDownToUp　マウスダウン時と比較して、X か Y が　UpShiftX / UpShiftY　の範囲内を越えて移動すれば　True　を返す。
        '-----------------------------------------------------------------------------------------------------------------------------
        Dim リタン As Boolean = False
        Static MsDown As Boolean : Static DnX As Integer : Static DnY As Integer : Static DnBtn As Integer : Static MvX As Integer : Static MvY As Integer
        wIsMoveDownToUp = False
        If (gcoMsDown = gcoMsDown_gcoMsMove_gcoMsUp) And (MsDown = False) Then
            MsDown = True : DnBtn = MouseButtonsButton : DnX = X : DnY = Y : MvX = X : MvY = Y
            リタン = (X >= 0 And Y >= 0)
        ElseIf (MsDown = True) And (DnBtn = MouseButtonsButton) Then
            If gcoMsMove = gcoMsDown_gcoMsMove_gcoMsUp Then
                リタン = (Math.Abs(MvX - X) >= MoveShiftX Or Math.Abs(MvY - Y) >= MoveShiftY)
                MvX = X : MvY = Y
                'If リタン Then qqqqq("Ⅹマウスイベント検査2018 " & CStr(MvX))
            ElseIf gcoMsUp = gcoMsDown_gcoMsMove_gcoMsUp Then
                wIsMoveDownToUp = Not (Math.Abs(DnX - X) <= UpShiftX And Math.Abs(DnY - Y) <= UpShiftY)
                リタン = Not wIsMoveDownToUp
                GoTo DataClearExit
            Else
                GoTo DataClearExit
            End If
        Else
            GoTo DataClearExit
        End If
        Return リタン
        '----------------------------------------------------
DataClearExit:
        MsDown = False : DnBtn = -1 : DnX = -100000 : DnY = -100000 : MvX = -100000 : MvY = -100000
        Return リタン
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "OLE ドラッグドロップ"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩOLEDragDropテキストイベントANSI(ByVal DragEnter1_Over2_Drop3 As Integer, ByVal UkeCont As Control, ByVal e As DragEventArgs, _
                    ByRef wTextANSI As String, ByRef wDrpX_inControl As Integer, ByRef wDrpY_inControl As Integer) As Boolean
        '---------------------------------------------------------------
        '2023/09/17 　D & D を使用できない場合には　UkeCont　に　Nothing　を設定する。
        If UkeCont Is Nothing Then
            e.Effect = DragDropEffects.None     ' Do not allow drop.
            Return False
        End If
        Select Case DragEnter1_Over2_Drop3
            Case 1, 2
                If (e.Data.GetDataPresent(DataFormats.Text)) Then
                    e.Effect = DragDropEffects.Copy     ' Allow drop.
                Else
                    e.Effect = DragDropEffects.None     ' Do not allow drop.
                End If
                Return True
            Case 3
                wTextANSI = "" : wDrpX_inControl = 0 : wDrpY_inControl = 0
                If (e.Data.GetDataPresent(DataFormats.Text)) Then
                    e.Effect = DragDropEffects.Copy     ' Allow drop.
                    Try
                        Dim ddd As DataObject = e.Data
                        If ddd.ContainsText Then
                            Dim sss As String = ddd.GetText
                            If sss <> "" Then
                                wTextANSI = sss
                                Dim p As Point : p.X = e.X : p.Y = e.Y
                                Dim pp As Point = UkeCont.PointToClient(p)
                                wDrpX_inControl = pp.X
                                wDrpY_inControl = pp.Y
                            End If
                        End If
                    Catch
                        qqqqq("ERROR in ⅩOLEDragDropテキストイベントANSI() ")
                    End Try
                Else
                    e.Effect = DragDropEffects.None     ' Do not allow drop.
                End If
                Return (wTextANSI <> "")
        End Select
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "いろいろ"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function aaggBoolToStr(ByRef b As Boolean) As String
        If b Then Return "1" Else Return "0"
    End Function
    Function aaggBoolFromStr(ByRef s As String) As Boolean
        Return (Val(s) <> 0)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "ファイル"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩFileTextOpen(ByVal rPathFile As String) As String
        Try
            Dim s As String = My.Computer.FileSystem.ReadAllText(rPathFile, System.Text.Encoding.Default)
            Return s
        Catch ex As Exception
            Return ""
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩFileTextSave(ByVal rPathFile As String, ByVal rwStr As String) As Boolean
        Try
            My.Computer.FileSystem.WriteAllText(rPathFile, rwStr, False, System.Text.Encoding.Default)
            Return True
        Catch ex As Exception
            MsgBox("ERROR in Ⅹ_FileTextSave() " & gggCR2 & ex.ToString)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹフルパス名からファイル名あるいは最後のフォルダ名を得る(ByRef pf As String, Optional ByRef DelExt As Boolean = False) As String
        '2027/07/06 chg 
        'フルパス名から ファイル名 あるいは 最後のパス名 のみを得る
        Try
            Dim s As String = pf
            If Right(s, 1) = "\" Or Right(s, 1) = "/" Then s = Mid(s, 1, Len(s) - 1)
            Dim w As String = Path.GetFileName(s)
            If w Is Nothing Then Return ""
            If DelExt Then w = Path.GetFileNameWithoutExtension(w) ' Ⅹファイル拡張子を削除(w)
            Return w
        Catch
        End Try
        Return ""
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩAppFindExeFile(ByRef rFile As String) As String
        Dim e, w, d As String
        Dim a As Integer
        Try
            w = New String(Chr(0), 255)
            d = Ⅹフルパス名からファイル名あるいは最後のフォルダ名を得る(rFile)
            a = FindExecutable(rFile, d, w)
            If a > 32 Then
                w = LCase(Ⅹ文最後の_Chr0_でカットする(w))
                e = VB.Right(w, 4)
                If e = ".bat" Or e = ".com" Or e = ".dll" Then Return ""
            Else
                w = ""
            End If
            Return w
        Catch
        End Try
        Return ""
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩFileRunOrFolderShow(ByRef hwnd As Integer, ByRef opIndex As Integer, ByRef DocFile As String, Optional ByRef UserEditer As String = "", Optional ByRef NoFindMsgTitleStr As String = "", Optional ByRef NoFindMsgDispStr As String = "") As Boolean
        'OpIndex    '0 = ｱﾌﾟﾘｹｰｼｮﾝ / '1 = カスタム / '2 = ﾜｰﾄﾞﾊﾟｯﾄﾞ / '3 = メモ帳 / '4 = 移動 / '5 = ペイントで開く
        Dim リタン As Boolean = False : Dim f, d As String
        Try
            d = DocFile
            If (opIndex = 4) And (Ⅹファイルは存在(d)) Then ' 移動
                If (ShellExecute(hwnd, "open", ⅩExplorerのフルパスファイル名, "/e, /select, " & d, "", SW_SHOW) <= 32) Then Return False Else Return True
            ElseIf Ⅹフォルダは存在(d) Then
                If (ShellExecute(hwnd, "open", ⅩExplorerのフルパスファイル名, "/e, " & d, "", SW_SHOW) <= 32) Then Return False Else Return True
            ElseIf Ⅹファイルは存在(d) Then
                Select Case opIndex
                    Case 0 'Native ｱﾌﾟﾘｹｰｼｮﾝ
                        '**********************************************************************************
                        '2018/02/01  Change Add
                        If "exe" = LCase(Ⅹファイル拡張子(d)) Then
                            If (ShellExecute(hwnd, "open", d, "", "", SW_SHOW) <= 32) Then Return False Else Return True
                        Else
                            If (ShellExecute(hwnd, "open", d, "", "", SW_SHOW) <= 32) Then '2018/02/01  VB 等では Shell が使用できない場合がある
                                f = ⅩAppFindExeFile(d)
                                Return ⅩFileRunOrFolderShowSUB_RunBy_VB_Shell(f, d, NoFindMsgTitleStr, NoFindMsgDispStr)
                            Else
                                Return True
                            End If
                        End If
                        '**********************************************************************************
                    Case 1, 2, 3, 5
                        f = ""
                        Select Case opIndex
                            Case 1 : f = UserEditer 'By UserEditer カスタム
                            Case 2 : f = Ⅹワードパッドのフルパスファイル名_In_WinXP() '                'By WordPad    ﾜｰﾄﾞﾊﾟｯﾄﾞ
                            Case 3 : f = Ⅹパスセパレータ付加(ⅩSysFolderWindows) & "notepad.exe" 'By NotePad    メモ帳
                            Case 5 : f = "c:\WINDOWS\system32\mspaint.exe" 'ペイントで開く
                        End Select
                        If f = "" Then Return False Else Return (ⅩFileRunOrFolderShowSUB_RunBy_VB_Shell(f, d, NoFindMsgTitleStr, NoFindMsgDispStr))
                    Case Else
                        Return False
                End Select
            ElseIf ⅩIsStrURLPath(d) Then  'URL
                If (ShellExecute(hwnd, "open", d, "", "", SW_SHOW) <= 32) Then Return False Else Return True
            ElseIf InStr(LCase(d), "file:///") = 1 Then  'URL in disk
                If (ShellExecute(hwnd, "open", d, "", "", SW_SHOW) <= 32) Then Return False Else Return True
            Else
                f = d
                Return ⅩFileRunOrFolderShowSUB_NoFileMsgShow_ReturnFalse(f, NoFindMsgTitleStr, NoFindMsgDispStr)
            End If
            Return False
        Catch ex As Exception
            MsgBox("ERROR in ⅩFileRunOrFolderShow()" & gggCR2 & ErrorToString())
        End Try
        Return False
    End Function
    Function ⅩFileRunOrFolderShowSUB_RunBy_VB_Shell(ByRef f As String, ByRef d As String, Optional ByRef NoFindMsgTitleStr As String = "", Optional ByRef NoFindMsgDispStr As String = "") As Boolean
        Dim sss As String
        If f = "" Then Return ⅩFileRunOrFolderShowSUB_NoFileMsgShow_ReturnFalse(f, NoFindMsgTitleStr, NoFindMsgDispStr)
        If (Not Ⅹファイルは存在(f)) Then Return ⅩFileRunOrFolderShowSUB_NoFileMsgShow_ReturnFalse(f, NoFindMsgTitleStr, NoFindMsgDispStr)
        If InStr(d, " ") > 0 And InStr(d, """") = 0 Then d = ⅩDBQA(d)
        sss = CStr(Shell(f & " " & d, AppWinStyle.NormalFocus))
        Return (sss <> "")
    End Function
    Function ⅩFileRunOrFolderShowSUB_NoFileMsgShow_ReturnFalse(ByRef f As String, Optional ByRef NoFindMsgTitleStr As String = "", Optional ByRef NoFindMsgDispStr As String = "") As Boolean
        If NoFindMsgTitleStr = "" Then NoFindMsgTitleStr = "ファイルあるいはフォルダが見つかりません"
        If NoFindMsgDispStr = "" Then NoFindMsgDispStr = "ファイルあるいはフォルダが見つかりません" & vbCrLf & vbCrLf & "あるいはこのファイルは、隠しファイルかシステムファイルです。"
        MsgBox(IIf(f = "", "関連付け実行ファイルがありません。", ⅩDBQA(f) & vbCrLf & vbCrLf & NoFindMsgDispStr), 64, NoFindMsgTitleStr)
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹパスセパレータ変換(ByRef rPathFile As String, ByRef rPathSepStr As String) As String
        'path sep "\" or "/"
        'rPathSepStr をチェックしてどちらかに一致させる。 "\" or "/"
        Dim a As Integer : Dim chk, w As String
        w = rPathFile
        If rPathSepStr = "\" Then chk = "/" Else chk = "\"
        For a = 1 To Len(w)
            If Mid(w, a, 1) = chk Then Mid(w, a, 1) = rPathSepStr
        Next
        Return w
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹパスセパレータ付加(ByRef rPath As String, Optional ByRef rPathSep As String = "\") As String
        'path sep "\" or "/"
        'ディレクトリー名に "\" or "/" を追加する
        Dim w, sep As String
        w = rPath
        If w <> "" Then
            sep = IIf(rPathSep = "\", "\", "/")
            w = Ⅹパスセパレータ変換(w, sep)
            If VB.Right(w, 1) <> sep Then w = w & sep
        End If
        Return w
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹパスセパレータ削除(ByRef pt As String) As String
        'path sep "\" or "/"
        'ディレクトリー名の最後の "\" or "/" を削除する
        Dim w As String
        w = pt
        If InStr(w, "\") > 0 And InStr(w, "/") > 0 Then w = Ⅹパスセパレータ変換(w, "\")
        If InStr(w, "\") > 0 Then
            If VB.Right(w, 1) = "\" And VB.Right(w, 2) <> ":\" Then w = VB.Left(w, Len(w) - 1)
        Else
            If VB.Right(w, 1) = "/" And VB.Right(w, 2) <> ":/" Then w = VB.Left(w, Len(w) - 1)
        End If
        Return w
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹファイル拡張子(ByRef fl As String, Optional ByRef WithDot As Boolean = False) As String
        '2022/07/18 ファイル名，フルパスファイル名から拡張子を得る  WithConma = True なら"."を含む
        '複数の . が入っている場合は、もっとも後ろの . 以降の文字列を返す。　例 >>> PITAPETA.四FRMDLGABOUT.RESOURCES ---> return RESOURCES
        Try
            Dim f As String
            f = fl
            If InStr(f, Path.DirectorySeparatorChar) = 0 Then 'フルパスでなくファイル名だけの場合の対策
                f = Path.DirectorySeparatorChar & f
            End If
            Dim s As String = Path.GetExtension(f)
            If s Is Nothing Then
                s = ""
            End If
            If WithDot = False Then
                If Len(s) > 1 Then
                    If VB.Left(s, 1) = "." Then
                        s = Mid(s, 2, 100)
                    End If
                    'qqqqq(s & " -----  " & fl)
                End If
            End If
            Return s
        Catch ex As Exception
            Return ""
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩIsStrHedURLPathHed(ByRef rStr As String) As Boolean
        Return (UCase(VB.Left(rStr, 8)) = "HTTPS://") Or (UCase(VB.Left(rStr, 7)) = "HTTP://")
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩIsStrEndURLPathEnd(ByRef rStr As String) As Boolean
        Return ((VB.Right(rStr, 1) = "/") Or (UCase(VB.Right(rStr, 4)) = ".HTM") Or (UCase(VB.Right(rStr, 5)) = ".HTML"))
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩIsStrURLPath(ByRef rStr As String) As Boolean
        Return (ⅩIsStrHedURLPathHed(rStr) And ⅩIsStrEndURLPathEnd(rStr))
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩFilePathOrTitleCheck(ByRef rPathFile As String) As String
        'rPathFile ファイル名あるいはフルパス名が正当な文字列か調べる。'パスのフォルダが実際に存在しているかはチェックしない。
        'Trim$() にして返す / エラーであれば "" を返す。
        'path sep "\" or "/"
        Const chk As String = "*?""<>|"
        Dim a As Integer : Dim w, s, c As String
        s = Trim(rPathFile) : w = Ⅹパスセパレータ変換(s, "\") 'フルパス名 s の PathSep を "\" に統一する｡
        If Len(w) < 1 Or Len(w) > 255 Then Return ""
        If VB.Left(w, 1) = "." Or VB.Right(w, 1) = "." Then Return ""
        For a = 1 To Len(w)
            c = Mid(w, a, 1)
            If System.Math.Abs(Asc(c)) < 32 Then Return ""
            If InStr(chk, c) > 0 Then Return "" 'ファイル名にエラー文字   *?""<>|  が入っていればエラー
        Next
        'フルパス名であればチェックする  :\/  が入っている
        If InStr(w, ":") > 0 Then
            If InStr(w, ":\") <> 2 Then Return ""
            If InStr(3, w, ":") > 0 Then Return ""
        End If
        If InStr(w, "\") > 0 Then
            If InStr(w, ":\") <> 2 Then Return ""
            If InStr(w, "\\") > 0 Then Return ""
        End If
        Return s
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩFileNameCheck(ByRef s As String, Optional ByRef OKErrChrs As String = "") As Boolean
        'ファイル名にエラー文字が入っていれば False を返す
        '両端にスペースが入っていれば　Trim$()　する。
        Const errs As String = "\/:*?""<>|"
        Dim a, m As Integer : Dim c, t As String
        '結果がいずれであっても、引数の文字列は Trim$() して返す。
        s = Trim(s)
        t = s
        m = Len(t)
        If m < 1 Then Return False
        'ファイル名にエラー文字が入っていても、OKErrChr に含まれる文字であればよしとする。
        'そのために検査用文字列内のエラー文字を "0" に置換する。
        For a = 1 To m
            c = Mid(t, a, 1)
            If InStr(OKErrChrs, c) > 0 Then Mid(t, a, 1) = "0"
        Next
        '置換した検査用文字列でエラーチェックする。
        If VB.Left(t, 1) = "." Then Return False
        If VB.Right(t, 1) = "." Then Return False
        For a = 1 To m
            c = Mid(t, a, 1)
            If InStr(errs, c) > 0 Then Return False
            If System.Math.Abs(Asc(c)) < 32 Then Return False
        Next
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹファイルは存在(ByRef rPathFile As String) As Boolean
        Return My.Computer.FileSystem.FileExists(rPathFile)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹフォルダは存在(ByRef rPath As String) As Boolean
        Try
            'Dim w As String = rPath
            'Dim s As String = VB.Right(rPath, 1)
            'If s = "\" Or s = "/" Then w = VB.Left(w, Len(w) - 1)
            '*****************************************************************************************************************
            '2024/02/04  原因不明のエラーが　1か所のフォルダで発生する
            '同じ名前のファイルまたはディレクトリが既に存在するため、"w:\000MyApp\00000\00VB\VBTools\TextWndShow" を作成できません。
            '数百のフォルダ名チェックの中で、このフォルダだけ エラーが発生する。フォルダが存在するのに、存在しないと判定する。ナゾ
            '*****************************************************************************************************************
            Dim w As String = rPath
            Dim lenW As Integer = Len(w)
            If lenW < 1 Then Return False
            Dim s As String = Mid(rPath, lenW, 1)
            If s = "\" Or s = "/" Then w = Mid(w, 1, lenW - 1)
            Return My.Computer.FileSystem.DirectoryExists(w)
        Catch ex As Exception
            MsgBox("ERROR in aaa" & gggCR2 & ex.ToString)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹファイルの絶対パス(ByVal rPath As String) As String
        Try
            Dim getInfo As System.IO.FileInfo
            getInfo = My.Computer.FileSystem.GetFileInfo(rPath)
            'qqqqq(rPath)
            'qqqqq(getInfo.FullName)
            Return getInfo.FullName
        Catch ex As Exception
            MsgBox("" & gggCR2 & ex.ToString)
            Return ""
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩFileTextOpenSave(ByRef rOpen_1_Save_2 As Integer, ByRef rData_配列_1_文字列_2 As Integer, ByRef rPathFile As String, ByRef rwAry() As String, Optional ByRef rwStr As String = "") As Integer
        'Public Const gcoファイルを開く As Integer = 1
        'Public Const gco文字配列使用 As Integer = 1
        'Public Const gcoファイルを保存 As Integer = 2
        'Public Const gco文字変数使用 As Integer = 2
        '-------------------------------------------------------------------
        'Dim rPathFile As String, rwAry() As String, rwStr As String
        'Integer = ⅩFileTextOpenSave( 1 =ファイルを開く | 2 = ファイルを保存 ,  1 = 文字配列使用 | 2 = 文字変数使用 , rPathFile, rwAry(), rwStr) ' , Optional rAddGrowSize = 200, Optional rMaxLineCount = 1000000)
        '最大２０メガバイトまでのテキストファイル
        '-------------------------------------------------------------------
        'rOpen1_Save2           = 1 = ファイルを開く
        'rData_配列_1_文字列_2   = 1 = テキストファイルを文字列型配列 rwAry(1 - n) に読み込む
        'rData_配列_1_文字列_2   = 2 = テキストファイルを文字列変数に入れる
        'rAddGrowSize = １回当たりの配列の追加要素の数
        'rMaxLineCount  になれば読み込みを中止する
        'ファイル最後から前方にある　空白ライン　や　改行のみのライン　は削除する
        '-------------------------------------------------------------------
        '正しく終了すれば　行数を返す    'エラーであれば　0　を返す  ******************************************
        '-------------------------------------------------------------------
        'rOpen1_Save2           = 2 = ファイルを保存
        'rData_配列_1_文字列_2   = 1 = rwAry(1 to Ubound)　を保存
        'rData_配列_1_文字列_2   = 2 = rwStr　を保存
        '-------------------------------------------------------------------
        '正しく終了すれば　-1　を返す    'エラーであれば　0　を返す  ******************************************
        '-------------------------------------------------------------------
        Try
            Dim max As Integer
            '--------------------------------------------------------------
            Select Case rOpen_1_Save_2
                Case 1  '正しく終了すれば　行数を返す
                    ReDim rwAry(0)
                    If Not Ⅹファイルは存在(rPathFile) Then Return 0
                    If FileLen(rPathFile) < 2 Or FileLen(rPathFile) > 20000000 Then Return 0 '最大２０メガバイトまでのテキストファイル
                    '--------------------------------------------------------------
                    rwStr = My.Computer.FileSystem.ReadAllText(rPathFile, System.Text.Encoding.Default)
                    max = Ⅹ文をカットして配列にする(rwStr, vbCrLf, rwAry, False)
                    Do While Trim(rwAry(max)) = "" And max > 0 : max = max - 1 : Loop
                    Do While rwAry(max) = vbCrLf And max > 0 : max = max - 1 : Loop
                    ReDim Preserve rwAry(max)
                    '--------------------------------------------------------------
                    If rData_配列_1_文字列_2 = 2 Then rwStr = Ⅹ文を配列から作成(rwAry)
                    Return max

                Case 2 '正しく終了すれば　-1　を返す
                    If rData_配列_1_文字列_2 = 1 Then rwStr = Ⅹ文を配列から作成(rwAry)
                    '--------------------------------------------------------------
                    If ⅩFilePathOrTitleCheck(rPathFile) = "" Then Return 0
                    My.Computer.FileSystem.WriteAllText(rPathFile, rwStr, False, System.Text.Encoding.Default)
                    Return -1  'True
            End Select
            Return -1
        Catch
            Reset()
            If rOpen_1_Save_2 = 1 Then ReDim rwAry(0)
            Return 0
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "文"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩStrChgOldStrNewStrEqualLen(ByRef wStr As String, ByRef oldstr As String, ByRef newStr As String, Optional ByRef NoCase As Boolean = False) As Boolean
        '2023/08/10 chg 
        '文字列内の OldStr を等しい長さの NewStr に置換
        'NoCase=True 大文字と小文字の区別をしない
        Dim RET As Boolean = False : Dim n As Integer = Len(oldstr) : Dim m As Integer = Len(newStr)
        If n <> m Or n < 1 Or Len(wStr) < 1 Or n > Len(wStr) Then Return RET
        Dim p As Integer : Dim UcaseOldStr, h As String
        If NoCase Then
            UcaseOldStr = UCase(oldstr)
            h = VB.Left(UcaseOldStr, 1)
            For p = 1 To Len(wStr) - n + 1
                If Mid(wStr, p, 1) = h Then
                    If UCase(Mid(wStr, p, n)) = UcaseOldStr Then
                        Mid(wStr, p, n) = newStr : RET = True
                    End If
                End If
            Next
        Else
            h = VB.Left(oldstr, 1)
            For p = 1 To Len(wStr) - n + 1
                If Mid(wStr, p, 1) = h Then
                    If Mid(wStr, p, n) = oldstr Then
                        Mid(wStr, p, n) = newStr : RET = True
                    End If
                End If
            Next
        End If
        Return RET
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩStrChgOldStrNewStr(ByRef s As String, ByRef oldstr As String, ByRef newStr As String) As String
        '文字列内の OldStr を NewStr に置換 NewStr = "" OK
        '文字列を返す。
        Dim w As String = s
        gggbol = ⅩStrChgOldStrNewStr_ChgSelf(w, oldstr, newStr)
        Return w
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩStrChgOldStrNewStr_ChgSelf(ByRef s As String, ByRef oldstr As String, ByRef newStr As String) As Boolean
        '文字列内の OldStr を NewStr に置換 NewStr = "" OK
        '引数の文字列を変更する。変更できれば　あるいは　なければ　True　を返す。
        Dim m As Integer = Len(oldstr)
        Dim n As Integer = Len(newStr)
        If m < 1 Then Return False
        If Len(s) >= m Then
            Dim p As Integer = 1
            Do
                p = InStr(p, s, oldstr)
                If p = 0 Then
                    Return True
                Else
                    s = VB.Left(s, p - 1) & newStr & Mid(s, p + m)
                    p = p + n
                End If
            Loop
        End If
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩVBStrLeft(ByVal rStr As String, ByVal rStrlen As Integer) As String
        Return Microsoft.VisualBasic.Left(rStr, rStrlen)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩVBStrRight(ByVal rStr As String, ByVal rStrlen As Integer) As String
        Return Microsoft.VisualBasic.Right(rStr, rStrlen)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩStrHedCharDel(ByRef wStr As String, ByRef rDelChars As String) As Boolean
        'wStr　の先頭から　 rDelChars 内のいずれか１文字があり続けるうちは、それらを削除し続ける。　削除する文字がなければ　False　を返す。
        Dim a As Integer : Dim s As String : Dim bol As Boolean
        bol = False
        If Len(rDelChars) < 1 Or Len(wStr) < 1 Then Return False
        For a = 1 To Len(wStr)
            s = Mid(wStr, a, 1)
            If InStr(rDelChars, s) > 0 Then
                Mid(wStr, a, 1) = " "
                bol = True
            Else
                Exit For
            End If
        Next
        wStr = LTrim(wStr)
        Return bol
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ文を先頭に持つ文を配列から探す(ByRef ary() As String, ByRef r先頭文 As String, Optional ByRef NoCase As Boolean = True) As Integer
        '指定した文字列と同じ文字列を先頭に持つ文字列の配列のインデックスを得る  1 to MAX  /  0 = 無し
        Dim a As Integer : Dim w As String
        If r先頭文 <> "" Then
            w = UCase(r先頭文)
            For a = 1 To UBound(ary)
                If NoCase Then
                    If InStr(UCase(ary(a)), w) = 1 Then Return a
                Else
                    If InStr(ary(a), r先頭文) = 1 Then Return a
                End If
            Next
        End If
        Return 0
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ文配列に一つの文要素を追加(ByRef wAry() As String, ByRef rwCurIndex As Integer, ByRef rAddStr As String, Optional ByRef rAddCount As Integer = 50) As Integer
        '2023/08/11 chg
        'wAry()         文字列を順次追加して入れる配列
        'rwCurIndex     文字列を追加した最後のインデックス       2020/12/23 もし rwCurIndex = 0 であれば、この関数内で　rwCurIndex = UBound(wAry())　に設定する
        'rAddStr        追加する文字列
        'rAddCount　　　wAry() 配列の追加サイズ  /  0 以下を指定すれば ReDim wAry(0), rwCurIndex = 0
        If rAddCount <= 0 Then 'reset wAry(0)
            rwCurIndex = 0
            ReDim wAry(0)
        Else
            If rwCurIndex = 0 Then rwCurIndex = UBound(wAry) '2020/12/23 add this line
            rwCurIndex = rwCurIndex + 1
            If UBound(wAry) < rwCurIndex Then ReDim Preserve wAry(rwCurIndex + rAddCount)
            wAry(rwCurIndex) = rAddStr
        End If
        Return rwCurIndex
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ文配列を壱ベースからゼロベースにする(ByRef rwAry() As String) As Integer
        Try
            'rwAry(0) = "" | rwAry(1 ....... max) = "data" -----------> rwAry(0) = rwAry(1) | rwAry(1 ... max - 1 ) = rwAry(1 + 1 ....... max) 
            Dim max As Integer = UBound(rwAry)
            If max = 0 Then
                Return -1 'rwAry(0) = ""  データーがない場合は何もしない
            End If
            For a As Integer = 0 To max - 1
                rwAry(a) = rwAry(a + 1)
            Next
            max = max - 1
            ReDim Preserve rwAry(max)
            Return max
        Catch ex As Exception
            ReDim Preserve rwAry(0)
            Return -1
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ文配列から文を探す(ByRef ary() As String, ByRef rStr As String, Optional ByRef NoCase As Boolean = True, Optional ByRef max As Integer = 0) As Integer
        '指定した文字列と同じ文字列の配列のインデックスを得る  ary(1) ～ ary(max) の範囲で
        '見つからなければ　0　を返す。
        Dim a As Integer : Dim w As String
        If rStr <> "" Then
            w = UCase(rStr)
            If max = 0 Then max = UBound(ary)
            For a = 1 To max
                If NoCase Then
                    If UCase(ary(a)) = w Then Return a
                Else
                    If ary(a) = rStr Then Return a
                End If
            Next
        End If
        Return 0
    End Function
    Function Ⅹ文を配列から探す(ByRef ary() As String, ByRef rStr As String, Optional ByRef NoCase As Boolean = True, Optional ByRef max As Integer = 0) As Integer
        '指定した文字列と同じ文字列の配列のインデックスを得る  ary(1) ～ ary(max) の範囲で
        '見つからなければ　0　を返す。
        Dim a As Integer : Dim w As String
        If rStr <> "" Then
            w = UCase(rStr)
            If max = 0 Then max = UBound(ary)
            For a = 1 To max
                If NoCase Then
                    If UCase(ary(a)) = w Then Return a
                Else
                    If ary(a) = rStr Then Return a
                End If
            Next
        End If
        Return 0
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ文を配列から作成(ByRef rary() As String, Optional ByRef rCut As String = vbCrLf, Optional ByRef rStt As Integer = 1, Optional ByRef rStp As Integer = -1, Optional ByRef rBuffAddSize As Integer = 10000) As String
        'w = Ⅹ文を配列から作成(rAry(), rCut = vbCrLf, rStt = 1, rStp = -1, rBuffAddSize = 10000)
        '文字列配列を rStt から rStp まで rCut で連結して文字列を返す
        'rStt を指定しなければ rStt = 1
        'rStp を指定しなければ rStp = UBound(ary)
        Try
            Dim s As String : Dim p, a, n As Integer
            If rStt < LBound(rary) Then rStt = LBound(rary)
            If rStp < rStt Or rStp > UBound(rary) Then rStp = UBound(rary)
            p = 1 : s = Space(rBuffAddSize)
            For a = rStt To rStp
                n = Len(rary(a)) + Len(rCut) : Do While p + n > Len(s) : s = s & Space(rBuffAddSize) : Loop
                Mid(s, p, n) = rary(a) & rCut : p = p + n
            Next
            Return VB.Left(s, p - 1)
        Catch
            MsgBox("ERROR in Ⅹ文を配列から作成()")
        End Try
        Return ""
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ文をカットして配列にする_ChgTo_BaseO(ByRef rStr As String, ByRef rCut As String, ByRef wAry() As String, Optional ByRef rTrimDo As Boolean = False) As Integer
        Dim m As Integer = Ⅹ文をカットして配列にする(rStr, rCut, wAry, rTrimDo)
        Return Ⅹ文配列を壱ベースからゼロベースにする(wAry)
    End Function
    Function Ⅹ文をカットして配列にする(ByRef rStr As String, ByRef rCut As String, ByRef wAry() As String, Optional ByRef rTrimDo As Boolean = False) As Integer
        'Ⅹ文をカットして配列にする()
        '文字列  rStr  から  rCut  でカットして文字列を　可変長 配列  wAry()  に入れ   wAry ( 1 to max )  の max 個数を返す
        ReDim wAry(0)
        Dim LenStr As Integer = Len(rStr)
        Dim LenCut As Integer = Len(rCut)
        If LenStr < 1 Or LenCut < 1 Then Return 0
        If LenStr <= LenCut Then
            If InStr(rStr, rCut) > 0 Then Return 0
        End If
        Try
            Dim tmpmax As Integer = UBound(wAry) : Dim arymax As Integer = 0 : Dim p As Integer = 1
            Dim pp As Integer
            Do While p <= LenStr
                arymax = arymax + 1
                If arymax > tmpmax Then
                    ReDim Preserve wAry(tmpmax + 50) : tmpmax = UBound(wAry)
                End If
                pp = InStr(p, rStr, rCut)
                If pp >= p Then
                    If rTrimDo Then wAry(arymax) = Trim(Mid(rStr, p, pp - p)) Else wAry(arymax) = Mid(rStr, p, pp - p)
                    p = pp + LenCut
                ElseIf pp = 0 Then
                    If rTrimDo Then wAry(arymax) = Trim(Mid(rStr, p, (LenStr + 1) - p)) Else wAry(arymax) = Mid(rStr, p, (LenStr + 1) - p)
                    Exit Do
                End If
            Loop
            ReDim Preserve wAry(arymax)
            Return arymax
        Catch
        End Try
        Return 0
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ文最後の_Chr0_でカットする(ByRef w As String) As String
        Dim p As Integer
        p = InStr(1, w, Chr(0))
        If p > 0 Then Return VB.Left(w, p - 1) Else Return w
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩDBQA(ByRef s As String) As String
        Return """" & s & """"
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ文の高さと幅を返すpxl(ByRef rCont As Control, ByRef r文 As String, ByRef w幅pxl As Integer, ByRef w高pxl As Integer) As Boolean
        w幅pxl = 0 : w高pxl = 0
        If rCont Is Nothing Or r文 = "" Then Return False
        If Len(r文) > 0 Then
            Try
                Dim g As Graphics = rCont.CreateGraphics
                g.PageUnit = GraphicsUnit.Pixel
                Dim szf As SizeF = g.MeasureString(r文, rCont.Font)
                w幅pxl = szf.Width
                w高pxl = szf.Height
                g.Dispose()
                Return True
            Catch
            End Try
        End If
        Return False
    End Function
    Function Ⅹ文の高さpxl(ByRef rCont As Control, ByRef r文 As String) As Integer
        Dim w幅pxl, w高pxl As Integer
        If Ⅹ文の高さと幅を返すpxl(rCont, r文, w幅pxl, w高pxl) Then Return w高pxl Else Return 0
    End Function
    Function Ⅹ文の幅pxl(ByRef rCont As Control, ByRef r文 As String) As Integer
        Dim w幅pxl, w高pxl As Integer
        If Ⅹ文の高さと幅を返すpxl(rCont, r文, w幅pxl, w高pxl) Then Return w幅pxl Else Return 0
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "リストボックス　コンボボックス"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function aaggリストボックス_マウスクリックアイテム_文字列(ByVal lst As ListBox, ByVal e As MouseEventArgs) As String
        '2024/03/25 new 
        Dim n As Integer = lst.SelectedIndex
        If n >= 0 Then
            Dim rcgl As Rectangle = lst.GetItemRectangle(n)
            If rcgl.Contains(e.X, e.Y) Then
                Return lst.Items(n).ToString
            End If
        End If
        Return ""
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function aaggリストボックス選択アイテム位置内にマウスがある(ByVal lst As ListBox) As Integer
        '2024/04/05 new
        Dim n As Integer = lst.SelectedIndex
        If n >= 0 Then
            Dim pt As Point = Cursor.Position
            Dim pppt As Point = lst.PointToClient(pt)
            Dim rcgl As Rectangle = lst.GetItemRectangle(n)
            If rcgl.Contains(pppt.X, pppt.Y) Then Return n
        End If
        Return -1
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function aaggリストボックスのテキスト(ByRef lt As ListBox, ByVal ListIndex As Integer) As String
        '2023/10/28 new
        If ListIndex >= 0 And ListIndex < lt.Items.Count Then Return lt.GetItemText(lt.Items(ListIndex)) Else Return ""
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹリストボックスから_文のリストを探して_インデックスを返す(ByRef lt As ListBox, ByRef 文 As String, ByRef NoCase As Boolean, Optional ByVal StartIndex As Integer = 0) As Integer
        'リストボックスから s と同じリストを探す インデックスを返す (-1 = no find)
        'NoCase = true なら大小区別せず探す
        Dim a As Integer : Dim w, ss As String
        If NoCase Then ss = UCase(文) Else ss = 文
        With lt.Items
            For a = 0 To .Count - 1
                w = .Item(a)
                If NoCase Then
                    If UCase(w) = ss Then Exit For
                Else
                    If w = ss Then Exit For
                End If
            Next
            Return IIf(a < .Count, a, -1)
        End With
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹリストボックスに_文配列からリストを入れる(ByRef lt As ListBox, ByRef ary() As String, ByRef ListBoxをクリアする As Boolean, Optional ByRef 開始IDX As Integer = -1, Optional ByRef 停止IDX As Integer = -1) As Integer
        'Return   リストボックス.Count
        'If Error Return  0
        '文字列配列の ary( 1 - ubound )を リストボックスのリストに入れ List.Items.Count を返す
        Dim max As Integer = UBound(ary)
        Dim stp, stt As Integer
        If ListBoxをクリアする Then lt.Items.Clear()
        If 開始IDX <> -1 And (開始IDX < 1 Or 開始IDX > max) Then Return 0
        If 開始IDX = -1 Then stt = 1 Else stt = Ⅹ数値範囲Int(1, max, 開始IDX)
        If 停止IDX = -1 Then stp = UBound(ary) Else stp = Ⅹ数値範囲Int(1, max, 停止IDX)
        With lt.Items
            Dim sort As Boolean = lt.Sorted
            Dim c As Integer = 0
            For a As Integer = stt To stp
                If sort Then
                    .Add(ary(a))
                Else
                    .Insert(c, ary(a)) : c = c + 1
                End If
            Next
            Return .Count
        End With
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹリストボックスの全リストを_別のリストボックスにコピー(ByRef 受け As ListBox, ByRef 送り As ListBox) As Integer
        '2023/07/17 add new
        Dim a, n As Integer
        受け.Items.Clear()
        n = 送り.Items.Count
        For a = 0 To n - 1
            受け.Items.Add(送り.Items(a))
        Next
        Return n
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹリストボックスの全リストの比較(ByRef LB1 As ListBox, ByRef LB2 As ListBox, ByVal NoCase As Boolean, Optional ByVal LB2_の最後のアイテムは無視する As Boolean = False) As Boolean
        '2024/03/08 add new    '相互の内容がそっくり同じであれば　True　を返す。
        Dim a As Integer
        If LB1.Items.Count = 0 And LB2.Items.Count = 0 Then Return True
        If LB1.Items.Count <> LB2.Items.Count Then
            If (LB2.Items.Count - LB1.Items.Count) <> 1 Then
                Return False
            ElseIf LB2_の最後のアイテムは無視する = False Then
                Return False
            End If
        End If
        If NoCase Then
            For a = 0 To LB1.Items.Count - 1
                If UCase(LB1.Items(a).ToString) <> UCase(LB2.Items(a).ToString) Then Return False
            Next
        Else
            For a = 0 To LB1.Items.Count - 1
                If LB1.Items(a).ToString <> LB2.Items(a).ToString Then Return False
            Next
        End If
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "Image"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩImage_サイズチェック_異なれば再作成_色で色りつぶす(ByRef img As Image, ByRef rWD As Integer, ByRef rHT As Integer, ByVal colorINT As Integer) As Boolean
        If rWD < 1 Or rHT < 1 Then Return False
        If img Is Nothing Then Return False
        If img.Width <> rWD Or img.Height <> rHT Then
            If Not ⅩImage_新規作成_再作成(img, rWD, rHT) Then Return False
            'qqqqq("ⅩImage_サイズチェック_異なれば再作成_色で色りつぶす")
            Return ⅩImageFillRect(img, colorINT, 0, 0, rWD, rHT, False)
        End If
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩImageFillRect(ByRef Img受 As Image, ByVal colorINT As Integer, ByVal left As Integer, ByVal top As Integer, ByVal WD As Integer, ByVal HT As Integer, ByVal 色をぼかす_Enabled_Off As Boolean) As Boolean
        If Img受 Is Nothing Then Return False
        If left < 0 Or top < 0 Or WD < 1 Or HT < 1 Then Return False
        Try
            Dim g As Graphics = Graphics.FromImage(Img受)
            If g Is Nothing Then Return False
            Dim ccc As Integer
            If 色をぼかす_Enabled_Off Then ccc = Ⅹ色をぼかすOnEnabledOff(False, colorINT) Else ccc = colorINT
            Dim brs As New SolidBrush(ⅩColor構造体_from_色値(Ⅹ色LONG値(ccc)))
            If brs Is Nothing Then Return False
            g.FillRectangle(brs, left, top, WD, HT)
            brs.Dispose()
            g.Dispose()
            Return True
        Catch ex As Exception
            MsgBox("ERROR in ⅩImageFillRect()  " & vbCrLf & ex.ToString)
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩImage_新規作成_再作成(ByRef wImage As Image, ByRef rWD As Integer, ByRef rHT As Integer) As Boolean
        If rWD < 1 Or rHT < 1 Then Return False
        If rWD > 1000000 Or rHT > 1000000 Then Return False
        Try
            If wImage IsNot Nothing Then
                If rWD = wImage.Width And rHT = wImage.Height Then
                    'chknnn = chknnn + 1 : qqqqq(CStr(10000 + chknnn) & " ●●サイズ変更なし　ⅩImage_新規作成_再作成()")
                    Return True
                End If
                wImage.Dispose()
                wImage = Nothing
            End If
            wImage = New Bitmap(rWD, rHT)
            Return (wImage IsNot Nothing)
        Catch ex As Exception
            MsgBox("ERROR in ⅩImage_再作成()" & vbCrLf & ex.Message)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩImage_Image_Copy(ByRef Img受 As Image, ByRef Img送 As Image, ByVal 受x As Integer, ByVal 受y As Integer, ByVal 受w As Integer, ByVal 受h As Integer, ByVal 送x As Integer, ByVal 送y As Integer, ByVal 送w As Integer, ByVal 送h As Integer) As Boolean
        'Img受  へ　Img送　からコピーする。　
        'mg受   =   Img送 でもよい。
        'gggbol = ⅩImage_Image_Copy(Img受, Img送, 受x, 受y, 受w, 受h, -1,  -1,  -1,  -1)
        'gggbol = ⅩImage_Image_Copy(Img受, Img送, 受x, 受y, 受w, 受h, 送x, 送y, 送w, 送h)
        If Img受 Is Nothing Then Return False
        If Img受 IsNot Img送 Then
            If Img送 Is Nothing Then Return False
        End If
        If 受x < 0 Or 受y < 0 Or 受w < 1 Or 受h < 1 Then Return False
        If 送x < 0 Then 送x = 受x
        If 送y < 0 Then 送y = 受y
        If 送w < 0 Then 送w = 受w
        If 送h < 0 Then 送h = 受h
        If 送x < 0 Or 送y < 0 Or 送w < 1 Or 送h < 1 Then Return False
        Try
            Dim g As Graphics = Graphics.FromImage(Img受)
            If g Is Nothing Then Return False
            Dim 田 As Rectangle : 田.X = 受x : 田.Y = 受y : 田.Width = 受w : 田.Height = 受h
            g.DrawImage(Img送, 田, 送x, 送y, 送w, 送h, GraphicsUnit.Pixel)
            g.Dispose()
            Return True
        Catch ex As Exception
            MsgBox("ERROR in ⅩImage_Image_Copy()" & vbCrLf & ex.Message)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "描画"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩPictureBox_Cls(ByRef pct As PictureBox, ByVal rBackColor As Color) As Boolean
        If rBackColor <> Color.Empty Then pct.BackColor = rBackColor
        Return ⅩPictureBox_Cls(pct)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩPictureBox_Cls(ByRef pct As PictureBox) As Boolean
        Try
            Dim g As Graphics
            If pct.Image Is Nothing Then
                g = pct.CreateGraphics
            Else
                g = Graphics.FromImage(pct.Image)
            End If
            If Not g Is Nothing Then
                g.Clear(pct.BackColor)
                g.Dispose()
                pct.Refresh()
                Return True
            End If
        Catch ex As Exception
            MsgBox("ERR in ⅩPictureBox_Cls()" & vbCrLf & ex.ToString)
        End Try
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩPictureBox_Cls(ByRef pct As PictureBox, ByVal Left As Single, ByVal Top As Single, ByVal Width As Single, ByVal Height As Single, ByVal rBackColor As Color) As Boolean
        Dim g As Graphics = Nothing : Dim brs As SolidBrush = Nothing
        Try
            If pct.Image Is Nothing Then
                g = pct.CreateGraphics
            Else
                g = Graphics.FromImage(pct.Image)
            End If
            If g IsNot Nothing Then
                brs = New SolidBrush(rBackColor)
                If brs IsNot Nothing Then
                    g.FillRectangle(brs, Left, Top, Width, Height)
                    brs.Dispose()
                    brs = Nothing
                End If
                g.Dispose()
                g = Nothing
                pct.Refresh()
                Return True
            End If
        Catch ex As Exception
            If g IsNot Nothing Then g.Dispose()
            If brs IsNot Nothing Then brs.Dispose()
            MsgBox("ERR in ⅩPictureBox_Cls()" & vbCrLf & ex.ToString)
        End Try
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "色の操作"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩColor_to_INT(ByVal Color構造体 As Color) As Integer
        Return Ⅹ数値範囲Int(0, &HFFFFFF&, System.Drawing.ColorTranslator.ToWin32(Color構造体))
    End Function
    Function ⅩColor_from_INT(ByVal 色 As Integer) As Color
        Return System.Drawing.ColorTranslator.FromWin32(Ⅹ数値範囲Int(0, &HFFFFFF&, 色))
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩColor構造体_to_色値(ByVal Color構造体 As Color) As Integer
        Return Ⅹ数値範囲Int(0, &HFFFFFF&, System.Drawing.ColorTranslator.ToWin32(Color構造体))
    End Function
    Function ⅩColor構造体_from_色値(ByVal 色 As Integer) As Color
        Return System.Drawing.ColorTranslator.FromWin32(Ⅹ数値範囲Int(0, &HFFFFFF&, 色))
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩColorGradationAryByColor(ByVal OpCodeRGB As String, ByVal r中心色 As Integer, ByVal Div As Integer, ByRef wグラデーション色配列() As Integer, ByVal rグラデーション色配列IDX_1_to_max As Integer) As Boolean
        '2021/03/21 chg   2014/12/14 new code
        'OpCodeRGB に　"R"  "G"  "B"　が入っていれば、ソレゾレの要素だけをグラデーションする。通常は　"RGB"　を指定する。
        'r中心色 からグラデーションセルのデーターを設定して配列  wグラデーション色配列(1 - wグラデーション色配列IDX_1_to_max)  に入れる。有効なインデックスは  1 To wグラデーション色配列IDX_1_to_max
        'Div でグラデーションのコントラストを指定する。
        Dim gg, rr, bb As Integer
        Dim CGG, n, a, c, CRR, CBB As Integer, ddivv As Single, ddivv11 As Single
        Dim e As Boolean
        Dim DoGG, DoRR, DoBB As Boolean
        ReDim wグラデーション色配列(rグラデーション色配列IDX_1_to_max)
        If Not Ⅹ色RGB値(r中心色, rr, gg, bb) Then Return False
        ReDim wグラデーション色配列(rグラデーション色配列IDX_1_to_max)
        n = rグラデーション色配列IDX_1_to_max \ 2
        DoRR = (InStr(OpCodeRGB, "R") > 0)
        DoGG = (InStr(OpCodeRGB, "G") > 0)
        DoBB = (InStr(OpCodeRGB, "B") > 0)
        '2022/11/20
        For a = 1 To rグラデーション色配列IDX_1_to_max
            e = (a <= n)
            c = IIf(e, n - a, a - n)
            ddivv = c / Div
            ddivv11 = (1 - ddivv)
            If DoRR Then CRR = Ⅹ数値範囲Int(0, 255, IIf(e, rr * ddivv11, rr + ((255 - rr) * ddivv))) Else CRR = rr
            If DoGG Then CGG = Ⅹ数値範囲Int(0, 255, IIf(e, gg * ddivv11, gg + ((255 - gg) * ddivv))) Else CGG = gg
            If DoBB Then CBB = Ⅹ数値範囲Int(0, 255, IIf(e, bb * ddivv11, bb + ((255 - bb) * ddivv))) Else CBB = bb
            wグラデーション色配列(a) = RGB(CRR, CGG, CBB)
        Next
        'qqqqq("zzColorGradationAryByColor out")
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ色システム色をLong値に変換(ByVal SysColorIndex As Integer) As Integer
        Return GetSysColor(Ⅹ数値範囲Int(0, &H18, System.Math.Abs(&H80000000 - SysColorIndex)))
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩColorXOR(ByVal rColor As Integer) As Integer
        Dim ccc As Integer = Ⅹ色LONG値(rColor)
        Return Ⅹ数値範囲Int(0, &HFFFFFF&, &HFFFFFF& Xor ccc)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ色LONG値(ByVal ColorValOrIndex As Integer) As Integer
        'ColorValOrIndex = カラー実効値あるいはシステムカラーインデックス
        Dim c As Integer
        c = Ⅹ色の値の検査修正値(ColorValOrIndex)
        If c >= 0 And c <= &HFFFFFF Then Return c Else Return Ⅹ色システム色をLong値に変換(c)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ色RGB値(ByVal ColorValOrIndex As Integer, ByRef wRR As Integer, ByRef wGG As Integer, ByRef wBB As Integer) As Boolean
        'ColorValOrIndex = カラー実効値あるいはシステムカラーインデックス
        Dim c As Integer = Ⅹ色LONG値(ColorValOrIndex)
        wBB = (c And &HFF0000) \ &H10000
        wGG = (c And &HFF00) \ &H100S
        wRR = (c And &HFF)
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ色HalfColor(ByRef cor As Color, ByVal 明るい_True_暗い_False As Boolean) As Color
        Dim c As Integer = ⅩColor_to_INT(cor)
        Dim g, r, b As Integer
        gggint = Ⅹ色RGB値(c, r, g, b)
        If 明るい_True_暗い_False Then
            c = RGB(r + (255 - r) \ 2, g + (255 - g) \ 2, b + (255 - b) \ 2)
        Else
            c = RGB(r \ 2, g \ 2, b \ 2)
        End If
        Return ⅩColor_from_INT(c)
    End Function
    Function Ⅹ色HalfColor(ByRef c As Integer, ByVal 明るい_True_暗い_False As Boolean) As Integer
        Dim g, r, b As Integer
        gggint = Ⅹ色RGB値(c, r, g, b)
        If 明るい_True_暗い_False Then
            Return RGB(r + (255 - r) \ 2, g + (255 - g) \ 2, b + (255 - b) \ 2)
        Else
            Return RGB(r \ 2, g \ 2, b \ 2)
        End If
    End Function
    Function Ⅹ色HalfColor(ByRef c As Integer) As Integer
        Dim g, r, b As Integer
        gggint = Ⅹ色RGB値(c, r, g, b)
        Return RGB(r + (255 - r) \ 2, g + (255 - g) \ 2, b + (255 - b) \ 2)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function aagg色値の検査修正値(ByVal IntColor As Integer) As Integer
        If IntColor < 0 Then Return 0
        If IntColor > &HFFFFFF Then Return &HFFFFFF
        Return IntColor
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ色の値の検査修正値(ByVal IntColor As Integer) As Integer
        Return aagg色値の検査修正値(IntColor)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ色をぼかすOnEnabledOff(ByVal rEnabled As Boolean, ByVal ColorValOrIndex As Integer) As Integer
        Dim gg, rr, bb As Integer
        If rEnabled Then
            Return Ⅹ色LONG値(ColorValOrIndex)
        Else
            gggint = Ⅹ色RGB値(ColorValOrIndex, rr, gg, bb)
            Return RGB(rr + (255 - rr) \ 2, gg + (255 - gg) \ 2, bb + (255 - bb) \ 2)
        End If
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "RectAngle操作"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩMainControl_SubControl_Shift_XY(ByVal MainControl As Control, ByVal SubControl As Control, ByRef wSiftX As Integer, ByRef wSiftY As Integer) As Boolean
        '2023/10/23
        If MainControl Is Nothing Then Return False
        If SubControl Is Nothing Then Return False
        Dim ptpar As Point = New Point(0, 0)
        Dim ptchd As Point = New Point(0, 0)
        Dim ptpar1 As Point = MainControl.PointToScreen(ptpar)
        Dim ptchd1 As Point = SubControl.PointToScreen(ptchd)
        wSiftX = ptchd1.X - ptpar1.X
        wSiftY = ptchd1.Y - ptpar1.Y
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "RECT操作"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩFrameDraw(ByVal hDC As Integer, ByRef rc As RECT, ByVal color As Integer, ByVal LineWD As Integer, ByVal left As Integer, ByVal Top As Integer, ByVal wd As Integer, ByVal ht As Integer, ByVal 色をぼかす_Enabled_Off As Boolean) As Boolean
        If hDC = 0 Then Return False
        If LineWD < 1 Then Return False
        Dim RET As Boolean = False, old As Integer = 0, brs As Integer = 0, ccc As Integer = 0, wRect As RECT
        Try
            If False = ⅩRectCopyOrMake(wRect, rc, left, Top, wd, ht) Then Return False
            If 色をぼかす_Enabled_Off Then ccc = Ⅹ色をぼかすOnEnabledOff(False, color) Else ccc = color
            brs = CreateSolidBrush(Ⅹ色LONG値(color))
            If brs <> 0 Then
                old = SelectObject(hDC, brs)
                If old <> 0 Then
                    Dim n, a, www, hhh As Integer
                    With wRect : www = .rrr - .lll : hhh = .bbb - .ttt : End With
                    n = Math.Min((Math.Min(www, hhh) \ 2), LineWD)
                    For a = 0 To n - 1
                        RET = (0 <> FrameRect(hDC, wRect, brs))
                        gggint = InflateRect(wRect, -1, -1)
                    Next
                    gggint = SelectObject(hDC, old) : old = 0
                End If
                gggint = DeleteObject(brs) : brs = 0
            End If
        Catch
            If old <> 0 Then gggint = SelectObject(hDC, old)
            If brs <> 0 Then gggint = DeleteObject(brs)
        End Try
        Return RET
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩRect幅(ByRef rc As RECT) As Integer
        Return rc.rrr - rc.lll
    End Function
    Function ⅩRect高(ByRef rc As RECT) As Integer
        Return rc.bbb - rc.ttt
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩRect内にXY座標がある(ByVal X As Integer, ByVal Y As Integer, ByRef rc As RECT) As Boolean
        Return (X >= rc.lll And X < rc.rrr And Y >= rc.ttt And Y < rc.bbb)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩRectCopyOrMake(ByRef wRect As RECT, ByRef rc As RECT, ByVal left As Integer, ByVal Top As Integer, ByVal wd As Integer, ByVal ht As Integer) As Boolean
        'wRect に　left, Top, wd, ht が有効であれば、それらを設定する。　でなければ　wRect に　rc　を　コピーする。
        gggint = SetRectEmpty(wRect)
        If left >= 0 And Top >= 0 And wd > 0 And ht > 0 Then
            Dim x2 As Integer = left + wd
            Dim y2 As Integer = Top + ht
            If x2 > left And y2 > Top Then gggint = SetRect(wRect, left, Top, x2, y2)
        Else
            gggint = CopyRect(wRect, rc)
        End If
        Return (IsRectEmpty(wRect) = 0)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩRectDraw(ByVal hDC As Integer, ByRef rc As RECT, ByVal color As Integer, ByVal left As Integer, ByVal top As Integer, ByVal wd As Integer, ByVal ht As Integer, ByVal 色をぼかす_Enabled_Off As Boolean) As Boolean
        If hDC = 0 Then Return False
        Dim RET As Boolean = False, hbr As Integer = 0, ccc As Integer, wRect As RECT
        Try
            If False = ⅩRectCopyOrMake(wRect, rc, left, top, wd, ht) Then Return False
            If 色をぼかす_Enabled_Off Then ccc = Ⅹ色をぼかすOnEnabledOff(False, color) Else ccc = color
            hbr = CreateSolidBrush(Ⅹ色LONG値(ccc))
            If hbr <> 0 Then
                RET = (0 <> FillRect(hDC, wRect, hbr))
                gggint = DeleteObject(hbr)
            End If
            hbr = 0
        Catch
            If hbr <> 0 Then gggint = DeleteObject(hbr)
            qqqqq("ERROR  in  ⅩRectDraw()")
        End Try
        Return RET
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "MsgBox"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Sub ⅩMsgBox_OK_情報(ByVal msgstr As String)
        MsgBox(msgstr, MsgBoxStyle.OkOnly Or MsgBoxStyle.Information)
    End Sub
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

End Module

