Option Strict Off
Option Explicit On
Imports System.Runtime.InteropServices
Imports System.Drawing.Drawing2D
Imports System.IO
Imports System.Windows.Forms.Form
Imports VB = Microsoft.VisualBasic
'------------------------------------ 2025/05/05 ------------------------------------
Module 五basCOMgame

#Region "WinAPI"
    Public Const MAX_PATH As Short = 260
    '**********************************************************************************************
    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
    '**********************************************************************************************
    Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Integer, ByVal hWndInsertAfter As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal CX As Integer, ByVal CY As Integer, ByVal wFlags As Integer) As Integer
    Public Const SWP_NOMOVE As Integer = &H2
    Public Const SWP_NOSIZE As Integer = &H1
    Public Const HWND_TOP As Integer = 0
    Public Const SW_SHOW As Integer = 5
    Declare Sub Sleep Lib "KERNEL32" (ByVal dwMilliseconds As Integer)
    '**********************************************************************************************
    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 GetDC Lib "user32" (ByVal hwnd As Integer) As Integer
    Declare Function CreateCompatibleDC Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hdc As Integer) As Integer
    Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer) As Integer
    Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Integer, ByVal hDC As Integer) As Integer
    Declare Function DeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hdc As Integer) As Integer
    Declare Function UpdateWindow Lib "user32" Alias "UpdateWindow" (ByVal hwnd As Integer) As Integer
    Declare Function InvertRect Lib "user32" Alias "InvertRect" (ByVal hdc As Integer, ByRef lpRect As RECT) As Integer
    Declare Function ValidateRect Lib "user32" Alias "ValidateRect" (ByVal hwnd As Integer, ByRef lpRect As RECT) As Integer
    Declare Function ClientToScreen 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 IntersectRect Lib "user32" (ByRef lpDestRect As RECT, ByRef lpSrc1Rect As RECT, ByRef lpSrc2Rect As RECT) As Integer
    Declare Function OffsetRect Lib "user32" (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 UnionRect Lib "user32" Alias "UnionRect" (ByRef lpDestRect As RECT, ByRef lpSrc1Rect As RECT, ByRef lpSrc2Rect As RECT) As Integer
    '**********************************************************************************************
    Public Const RGN_AND As Integer = 1
    Public Const RGN_OR As Integer = 2
    Public Const RGN_XOR As Integer = 3
    Public Const RGN_DIFF As Integer = 4
    Public Const RGN_COPY As Integer = 5
    Public Const NULLREGION As Integer = 1
    Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Integer, ByVal hSrcRgn1 As Integer, ByVal hSrcRgn2 As Integer, ByVal nCombineMode As Integer) As Integer
    Declare Function GetRgnBox Lib "gdi32" (ByVal hRgn As Integer, ByRef lpRect As RECT) As Integer
    Declare Function SelectClipRgn Lib "gdi32" (ByVal hDC As Integer, ByVal hRgn As Integer) As Integer
    Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Integer, ByVal X As Integer, ByVal Y As Integer) As Integer
    Declare Function OffsetRgn Lib "gdi32" (ByVal hRgn As Integer, ByVal X As Integer, ByVal Y As Integer) As Integer
    Declare Function CreateRectRgn Lib "gdi32" (ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer) As Integer
    Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer, ByVal x3 As Integer, ByVal y3 As Integer) As Integer
    Declare Function CreateRectRgnIndirect Lib "gdi32" (ByRef lpRect As RECT) As Integer
    Declare Function CreatePolygonRgn Lib "gdi32" (ByVal lpPoint() As POINTAPI, ByVal nCount As Integer, ByVal nPolyFillMode As Integer) As Integer
    Public Const WINDING As Integer = 2
    Declare Function CreateEllipticRgnIndirect Lib "gdi32" (ByRef lpRect As RECT) As Integer
    Declare Function CreateEllipticRgn Lib "gdi32" (ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer) As Integer
    Declare Function FillRgn Lib "gdi32" (ByVal hDC As Integer, ByVal hRgn As Integer, ByVal hBrush As Integer) As Integer
    Declare Function FrameRgn Lib "gdi32" (ByVal hDC As Integer, ByVal hRgn As Integer, ByVal hBrush As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer) As Integer
    Declare Function InvalidateRgn Lib "user32" (ByVal hwnd As Integer, ByVal hRgn As Integer, ByVal bErase As Integer) As Integer
    Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Integer, ByVal hRgn As Integer, ByVal bRedraw As Boolean) As Integer
    Declare Function InvertRgn Lib "gdi32" (ByVal hDC As Integer, ByVal hRgn As Integer) As Integer
    '**********************************************************************************************
    Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal dwRop As Integer) As Integer
    Declare Function StretchBlt Lib "gdi32" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal nSrcWidth As Integer, ByVal nSrcHeight As Integer, ByVal dwRop As Integer) As Integer
    Declare Function PatBlt Lib "gdi32" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal dwRop As Integer) As Integer
    Public Const SRCAND As Integer = &H8800C6 'SRCAND      論理AND演算子を使って､ 転送元と転送先の長方形の色を組み合わせます。
    Public Const SRCCOPY As Integer = &HCC0020 'SRCCOPY     転送元長方形を転送先長方形にそのままコピーします｡
    Public Const SRCPAINT As Integer = &HEE0086 'SRCPAINT    論理OR演算子を使って､ 転送元と転送先の長方形の色を組み合わせます。
    Declare Function SetStretchBltMode Lib "gdi32" (ByVal hDC As Integer, ByVal nStretchMode As Integer) As Integer
    Public Const COLORONCOLOR As Short = 3
    Public Const WHITENESS As Integer = &HFF0062 'WHITENESS   物理パレットのインデックス1に対応する色を使って転送先長方形を塗りつぶします (デフォルトの物理パレットでは､ この色は白です)。
    '**********************************************************************************************
    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
    Public Const BLACK_BRUSH As Short = 4
    Public Const WHITE_BRUSH As Short = 0
    Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Integer) As Integer
    Public Const PS_SOLID As Short = 0
    Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Integer, ByVal nWidth As Integer, ByVal crColor 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
    Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Integer, ByRef lpPoint As POINTAPI) As Integer
    Declare Function SetPixel Lib "gdi32" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Integer) As Integer
    Declare Function GetPixel Lib "gdi32" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Integer
    Declare Function MoveToEx Lib "gdi32" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByRef lpPoint As POINTAPI) As Integer
    Declare Function LineTo Lib "gdi32" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Integer
    Declare Function Ellipse Lib "gdi32" Alias "Ellipse" (ByVal hdc As Integer, ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Integer
    Declare Function Arc Lib "gdi32" Alias "Arc" (ByVal hdc As Integer, ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer, ByVal X3 As Integer, ByVal Y3 As Integer, ByVal X4 As Integer, ByVal Y4 As Integer) As Integer
    '    '********************************************************************************
    Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Integer, ByVal phiconLarge() As Integer, ByVal phiconSmall() As Integer, ByVal nIcons As Integer) As Integer
    'ExtractIconEx 関数が取得したすべてのアイコンのハンドルは、必要がなくなった段階で、DestroyIcon 関数を呼び出して破棄しなければなりません。
    '********************************************************************************
    Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Integer) As Integer
#End Region

#Region "グローバル変数と定数"
    '********************************************************************************
    Public gm使用中のディスプレイ台数 As Integer = 0 '2023/03/03 add
    '---------------------------------------------------------
    '2023/01/22  ghDC1 / ghDC2 で、選択した画像がモノクロになるのを防ぐため、imgfrom　のコピービットマップを選択させておく。
    Public ghDC1 As Integer = 0     '2022/09/27　　アプリ内で存在し続ける共用 HDC。
    Public ghDC2 As Integer = 0     '2022/09/27　　アプリ内で存在し続ける共用 HDC。
    Public ghBitMap1 As Integer = 0     '2023/01/22　　アプリ内で存在し続ける共用 BitMap。
    Public ghBitMap2 As Integer = 0     '2023/01/22　　アプリ内で存在し続ける共用 BitMap。
    Public ghOldbmp1 As Integer = 0     '2023/01/22　　アプリ内で存在し続ける共用 BitMap。
    Public ghOldbmp2 As Integer = 0     '2023/01/22　　アプリ内で存在し続ける共用 BitMap。
    '2023/01/22  ghDC1 / ghDC2 で、選択した画像がモノクロになるのを防ぐため、imgfrom　のコピービットマップを選択させておく。
    '---------------------------------------------------------
    Public gggCR2 As String = vbCrLf & vbCrLf
    Public gggbol As Boolean        '2022/03/07　　全コードで共有するテンポラリー戻り値。　Boolean型  で共用。
    Public gggint As Integer        '2022/03/07　　全コードで共有するテンポラリー戻り値。　Integer型  で共用。
    Public gggstr As String = ""    '2022/03/07　　全コードで共有するテンポラリー戻り値。　String 型  で共用。
    Public gggintary(0) As Integer
    Public gggstrary() As String = New String() {"", ""}    '2022/03/07　　全コードで共有するテンポラリー戻り値。　String() 型  で共用。
    Public Const gcoファイルはPictureBoxで読み込める画像の_FilePattern_20220509 As String = "*.bmp;*.jpg;*.jpeg;*.png;*.gif;*.ico;*.tif"
    Public Const gggYearDayFormat As String = "yyyy/MM/dd"
    '2023/07/24 -------------------------------------------------------------------------
    Public Const gco拡張子集_画像 As String = "*bmp*jpg*jpeg*png*gif*ico*tif*"
    '************************************************************************************
    'プロパティ操作の指示定数 ---------------------------------------------------
    Public Const gcoプロパ名 As Integer = 17200
    Public Const gcoプロパ初期化 As Integer = 17300    'Public Const gcoプロパDEF As Integer = 17300
    Public Const gcoプロパ規定値 As Integer = 17305    'Public Const gcoプロパDEFGET As Integer = 17305
    Public Const gcoプロパGet As Integer = 17310
    Public Const gcoプロパLet As Integer = 17320
    Public Const gcoプロパiniRD As Integer = 17330
    Public Const gcoプロパiniWR As Integer = 17340
    Public Const gcoプロパMenuClick As Integer = 17350
    Public Const gcoプロパ実効値 As Integer = 17370
    Public Const gcoプロパ実効値からインデックス As Integer = 17380
    Public Const gcoプロパGet現在の実効値を As Integer = 17500
    Public Const gcoプロパLet現在の実効値で As Integer = 17501
    Public Const gcoプロパListBoxSet As Integer = 17600
    'Ⅹ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
    '********************************************************************************
#End Region

#Region "基本"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩⅩⅩAppOwnHDC_make_del_in_AppMain_Form_Load_FormClose_もしエラーなら_End_する(ByVal Make_1_Del_2 As Integer) As Boolean
        If False = ⅩⅩAppOwnHDC_make_del(Make_1_Del_2) Then
            MsgBox("ⅩⅩAppOwnHDC_make_del()  でエラーが発生しました。" & vbCrLf & "強制終了します。")
            End
        End If
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩⅩAppOwnHDC_make_del(ByVal Make_1_Del_2 As Integer) As Boolean
        Dim g As Graphics : Dim hdc As Integer : Dim img As Image
        Select Case Make_1_Del_2
            Case 1
                img = New Bitmap(20, 20)
                If img IsNot Nothing Then
                    g = Graphics.FromImage(img)
                    If g IsNot Nothing Then
                        hdc = g.GetHdc
                        If hdc <> 0 Then
                            ghDC1 = CreateCompatibleDC(hdc) '2022/09/27　　アプリ内で存在し続ける共用 HDC。
                            If ghDC1 = 0 Then GoTo ErrEXIT
                            ghDC2 = CreateCompatibleDC(hdc) '2022/09/27　　アプリ内で存在し続ける共用 HDC。
                            If ghDC2 = 0 Then GoTo ErrEXIT
                            g.ReleaseHdc(hdc)
                            hdc = 0
                            '---------------------------------------------------------
                            '2023/01/22  ghDC1 / ghDC2 で、選択した画像がモノクロになるのを防ぐため、img copy　のコピービットマップを選択させておく。
                            Dim bm As Bitmap = img
                            ghBitMap1 = bm.GetHbitmap
                            ghBitMap2 = bm.GetHbitmap
                            ghOldbmp1 = SelectObject(ghDC1, ghBitMap1)
                            ghOldbmp2 = SelectObject(ghDC2, ghBitMap2)
                            'gggbol = ⅩClipboard_SetImage_From_GDIBmp_Or_Image(ghBitMap1, Nothing)
                            '2023/01/22  ghDC1 / ghDC2 で、選択した画像がモノクロになるのを防ぐため、img copy　のコピービットマップを選択させておく。
                            '---------------------------------------------------------
                        End If
                        g.Dispose()
                    End If
                    img.Dispose()
                End If
                Return True
            Case Else
                '---------------------------------------------------------
                '2023/01/22  ghDC1 / ghDC2 で、選択した画像がモノクロになるのを防ぐため、img copy　のコピービットマップを選択させておく。．．．の後始末。
                If ghOldbmp1 <> 0 Then SelectObject(ghDC1, ghOldbmp1)
                If ghOldbmp2 <> 0 Then SelectObject(ghDC2, ghOldbmp2)
                If ghBitMap1 <> 0 Then DeleteObject(ghBitMap1)
                If ghBitMap2 <> 0 Then DeleteObject(ghBitMap2)
                ghBitMap1 = 0
                ghBitMap2 = 0
                '2023/01/22  ghDC1 / ghDC2 で、選択した画像がモノクロになるのを防ぐため、img copy　のコピービットマップを選択させておく。．．．の後始末。
                '---------------------------------------------------------
                If ghDC1 <> 0 Then DeleteDC(ghDC1)
                If ghDC2 <> 0 Then DeleteDC(ghDC2)
                ghDC1 = 0
                ghDC2 = 0
                ghOldbmp1 = 0
                ghOldbmp2 = 0
                Return True
        End Select
        Return False
        '*****************************************************
ErrEXIT:
        If ghDC1 <> 0 Then DeleteDC(ghDC1)
        If hdc <> 0 Then g.ReleaseHdc(hdc)
        If g IsNot Nothing Then g.Dispose()
        If img IsNot Nothing Then img.Dispose()
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    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 ⅩクリップボードからpctImageへコピー(ByRef pct As PictureBox, ByVal 縦横比率minmax As Single, ByVal 指定縦横最大サイズpxel As Integer, ByVal 指定幅_StrechCopy_Use As Integer, ByVal 指定高_StrechCopy_Use As Integer) As Boolean
        '縦横比率minmax < 1.0 縦長     縦横比率minmax > 1.0 横長
        '指定幅_StrechCopy_Use > 0  and  指定高_StrechCopy_Use > 0 ならば ストレッチコピーを実行
        If pct Is Nothing Or (指定幅_StrechCopy_Use < 1 And (縦横比率minmax < 0.001! Or 縦横比率minmax > 1000.0! Or 指定縦横最大サイズpxel < 10 Or 指定縦横最大サイズpxel > 100000)) Then
            Call ⅩMsgBox_OK_情報("●ⅩクリップボードからpctImageへコピー() で引数の設定エラー発生●")
            Return False
        End If
        Try
            Dim img As Image
            img = Clipboard.GetImage
            If img Is Nothing Then
                Call ⅩMsgBox_OK_情報("クリップボードに画像イメージはありません")
            Else
                With pct
                    If .Image IsNot Nothing Then
                        .Image.Dispose()
                    End If
                    Dim WD, HT As Integer
                    If 指定幅_StrechCopy_Use > 0 And 指定高_StrechCopy_Use > 0 Then  'ストレッチコピーを実行
                        WD = 指定幅_StrechCopy_Use : HT = 指定高_StrechCopy_Use
                        .Image = New Bitmap(WD, HT)
                        gggbol = Ⅹ受けImage全域に_送Imageの選択領域を_Copy(.Image, img, 0, 0, img.Width, img.Height)
                    Else
                        If 縦横比率minmax > 1.0! Then
                            HT = 指定縦横最大サイズpxel : WD = 指定縦横最大サイズpxel / 縦横比率minmax
                        Else
                            WD = 指定縦横最大サイズpxel : HT = 指定縦横最大サイズpxel / 縦横比率minmax
                        End If
                        Dim wLeft, wTop, wWidth, wHeight As Integer
                        Dim 送り幅 As Integer = img.Width
                        Dim 送り高 As Integer = img.Height
                        gggbol = Ⅹサイズ計算_受けに合わせて_送りをトリミング(WD, HT, 送り幅, 送り高, wLeft, wTop, wWidth, wHeight)
                        .Image = New Bitmap(WD, HT)
                        gggbol = Ⅹ受けImage全域に_送Imageの選択領域を_Copy(.Image, img, wLeft, wTop, wWidth, wHeight)

                    End If
                    pct.SetBounds(0, 0, WD, HT, BoundsSpecified.Size)
                    Return True
                End With
            End If
        Catch ex As Exception
            Call ⅩMsgBox_OK_情報("●ⅩクリップボードからpctImageへコピー() でエラー発生●")
        End Try
        Return False
    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のフルパスファイル名() 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 ⅩAppTmpFileHTML() As String
        Return Ⅹパスセパレータ付加(ⅩAppフォルダ名()) & ⅩApp関連タイトル名(".HTM")
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹアプリメインウインドタイトル作成(ByRef アプリタイトル As String) As String
        Return アプリタイトル & "　Ver " & Ⅹアプリデーター文字列_バージョンとコンパイル日付()
    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 Ⅹカウントアップ(ByRef rw現在の値 As Integer, ByVal 一回のアップ数 As Integer, ByVal 最低数 As Integer, ByVal 最高数 As Integer) As Integer
        rw現在の値 = rw現在の値 + 一回のアップ数
        If rw現在の値 > 最高数 Then
            rw現在の値 = 最低数
        End If
        Return rw現在の値
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ数値計算時間稼ぎ(ByVal 繰り返し回数 As Integer) As Integer
        Dim a As Integer, nnn As Double = 10000
        For a = 1 To 繰り返し回数
            nnn = (nnn ^ 0.99999) ^ 0.99999
            If nnn < 10 Then nnn = 10000
        Next
        Return 繰り返し回数
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ数値の配列内のインデックス(ByRef nFind As Integer, ByRef IntAry() As Integer) As Integer
        '2013/12/12  指定した数値と同じ数値の配列のインデックスを得る 
        '1 to Ubound()    0 = 無し
        Dim a As Integer
        For a = 1 To UBound(IntAry)
            If nFind = IntAry(a) Then Return a
        Next
        Return 0
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩBitsAnd(ByRef rMainVal As Integer, ByRef rChkVal As Integer) As Boolean
        Return ((rMainVal And rChkVal) = rChkVal)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    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 Ⅹサイズ計算_受けに合わせて_送りをトリミング(ByVal 受け幅 As Integer, ByVal 受け高 As Integer, ByVal 送り幅 As Integer, ByVal 送り高 As Integer, _
                                                           ByRef wLeft As Integer, ByRef wTop As Integer, ByRef wWidth As Integer, ByRef wHeight As Integer) As Boolean
        wLeft = 0 : wTop = 0 : wWidth = 送り幅 : wHeight = 送り高
        If 受け幅 < 1 Or 受け高 < 1 Or 送り幅 < 1 Or 送り高 < 1 Then Return False
        Dim 受け縦横比率, 送り縦横比率 As Single
        受け縦横比率 = 受け高 / 受け幅
        送り縦横比率 = 送り高 / 送り幅
        If 受け縦横比率 < 送り縦横比率 Then
            wWidth = 送り幅 : wLeft = 0 : wHeight = Int(wWidth * 受け縦横比率) : wTop = (送り高 - wHeight) \ 2
        Else
            wHeight = 送り高 : wTop = 0 : wWidth = Int(wHeight / 受け縦横比率) : wLeft = (送り幅 - wWidth) \ 2
        End If
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ画面内での移動用配列の要素数の設定_平方根で(ByRef rx1 As Integer, ByRef ry1 As Integer, ByRef rx2 As Integer, ByRef ry2 As Integer, ByRef rスピード倍数_01_to_10 As Single, ByRef r要素min As Integer, ByRef r要素max As Integer) As Integer
        '2021/04/03 add '画面上の実体の距離に合わせて、カード描画数を増減する。
        Dim px, py As Integer : Dim 画面上の距離 As Double
        px = (rx2 - rx1)
        py = (ry2 - ry1)
        画面上の距離 = CDbl(System.Math.Sqrt((px * px) + (py * py)))
        Return Ⅹ数値範囲Int(r要素min, r要素max, CInt(System.Math.Sqrt(画面上の距離) * CDbl(rスピード倍数_01_to_10)))
        'qqqqq CStr(CInt(画面上の実体の距離))
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "フォント"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    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
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    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 Ⅹコントロールフォント変更_Bold(ByRef Cont As Control, ByVal bold As Boolean) As Boolean
        Try
            With Cont
                If bold <> (.Font.Bold) Then
                    If bold Then
                        .Font = New Font(.Font, FontStyle.Bold)
                    Else
                        .Font = New Font(.Font, FontStyle.Regular)
                    End If
                End If
                .Refresh()
            End With
            Return True
        Catch ex As Exception
            MsgBox("ERROR in Ⅹコントロールフォント変更_Bold()" & gggCR2 & ex.ToString)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹコントロールフォント変更(ByRef Cont As Control, ByVal フォント名 As String, ByVal フォントサイズ As Single) As Boolean
        Try
            Dim フォントFontStyle As FontStyle = Cont.Font.Bold Or Cont.Font.Italic Or Cont.Font.Underline
            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 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 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(sFonts(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
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹフォント描画_FromGDI(ByVal GDIHDC As Integer, ByVal GDIFont As Integer, ByRef rc As RECT, ByVal テキスト As String, ByVal テキストカラー As Integer) As Boolean
        Dim RET As Boolean = False
        Try
            Dim g As Graphics
            g = Graphics.FromHdc(GDIHDC)
            If g IsNot Nothing Then
                Dim fot As Font
                fot = Font.FromHfont(GDIFont)
                If fot IsNot Nothing Then
                    Dim br As New SolidBrush(ⅩColor構造体_from_色値(テキストカラー))
                    Dim rcagl As New Rectangle(rc.lll, rc.ttt, rc.rrr - rc.lll, rc.bbb - rc.ttt)
                    Dim sFormat As New StringFormat()
                    sFormat.Alignment = StringAlignment.Center
                    sFormat.LineAlignment = StringAlignment.Center
                    g.DrawString(テキスト, fot, br, rcagl, sFormat)
                    RET = True
                    fot.Dispose()
                End If
                g.Dispose()
            End If
        Catch ex As Exception
            qqqqq("" & ex.ToString())
        End Try
        Return RET
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "ウインドウ"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩForms_最大化_標準化_メニュー操作(ByVal FormLoad_0_MenuClick_1 As Integer, ByRef fom As Form, ByRef mmm As ToolStripMenuItem) As Boolean
        Const CapToMax As String = "＜ 最大化 ＞"        ' "＜ 最大化 ＞"   "<< 最大化 >>"
        Const CapToNormal As String = "＞ 標準化 ＜"     ' "＞ 標準化 ＜"   ">> 標準化 <<"
        Try
            If FormLoad_0_MenuClick_1 = 1 Then
                If InStr(mmm.Text, CapToMax) > 0 Then
                    Dim rcag As Rectangle = Ⅹスクリーンサイズ(True)
                    With rcag
                        fom.WindowState = FormWindowState.Normal
                        fom.SetBounds(.Left, .Top, .Width, .Height)
                    End With
                    mmm.Text = CapToNormal
                Else
                    Dim rcag As Rectangle = Ⅹファーストディスプレイサイズ(True)
                    With rcag
                        .Inflate(-.Width * 0.05, -.Height * 0.05)
                        fom.WindowState = FormWindowState.Normal
                        fom.SetBounds(.Left, .Top, .Width, .Height)
                    End With
                    mmm.Text = CapToMax
                End If
            Else 'Form Load
                mmm.ForeColor = Color.MediumBlue
                Dim rcag As Rectangle = Ⅹスクリーンサイズ(True)
                With rcag
                    If fom.WindowState = FormWindowState.Normal And fom.Width = .Width And fom.Height = .Height Then
                        mmm.Text = CapToNormal
                    Else
                        mmm.Text = CapToMax
                    End If
                End With
            End If
            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩForms_Controls_ドラッグドロップを可能にする(ByRef c0 As Control, ByRef c1 As Control, ByRef c2 As Control, ByRef c3 As Control, ByRef c4 As Control) As Boolean
        'gggbol = ⅩForms_Controls_ドラッグドロップを可能にする(Nothing, Nothing, Nothing, Nothing, Nothing)
        If c0 IsNot Nothing Then c0.AllowDrop = True 'ドラッグドロップを可能にする。
        If c1 IsNot Nothing Then c1.AllowDrop = True 'ドラッグドロップを可能にする。
        If c2 IsNot Nothing Then c2.AllowDrop = True 'ドラッグドロップを可能にする。
        If c3 IsNot Nothing Then c3.AllowDrop = True 'ドラッグドロップを可能にする。
        If c4 IsNot Nothing Then c4.AllowDrop = True 'ドラッグドロップを可能にする。
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩForm_最小化状態なら_標準サイズに戻す(ByRef wForm As Form, ByRef wFlagサイズ操作禁止 As Boolean) As Boolean
        If wForm Is Nothing Then Return False
        With wForm
            If .WindowState = FormWindowState.Minimized Then
                wFlagサイズ操作禁止 = True
                .WindowState = FormWindowState.Normal
                wFlagサイズ操作禁止 = False
            End If
        End With
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩForm_OwnerSet_IconSet_TextSet(ByVal rMe As Form, ByVal rMeText As String, ByVal rOwnerForm As Form) As Boolean
        If rMe Is Nothing Then Return False
        If rOwnerForm Is Nothing Then Return False
        Try
            rMe.Owner = rOwnerForm
            If rOwnerForm.Icon IsNot Nothing Then rMe.Icon = rOwnerForm.Icon
            If rMeText <> "" Then rMe.Text = rMeText
            Return True
        Catch ex As Exception
            MsgBox("ERROR in ⅩForm_OwnerSet_IconSet_TextSet() " & ex.ToString)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩFormSizeSetByControlSize(ByRef f As Form, ByRef c As Control, ByRef RightSpace As Integer, ByRef BottomSpace As Integer, Optional ByRef rサイズオーバーでも設定する As Boolean = False, Optional ByRef MsgBox_Show_WindowSizeOver As Boolean = False) As Integer
        'コントロール c のサイズ変更に連動して親フォーム f をリサイズする
        'RightSpace / BottomSpace コントロール c の左下の余白を指定する。
        '----------------------------------
        'return 0 =　スクリーンサイズオーバー、あるいは別のエラーで、リサイズできません。
        'return 1 =　現在のままのサイズでＯＫで、リサイズはしていません。
        'return 2 =　スクリーンサイズ内で、りサイズできました。
        'return 3 =　スクリーンサイズオーバーですが、リサイズしました。
        '----------------------------------
        Dim リタン As Integer = 0 : Static SizeSeting, ココから呼び出した As Boolean : Dim X, Y As Integer : Dim ScrnWD, ScrnHT As Integer, rc As RECT
        If SizeSeting Then Return リタン
        If RightSpace < 0 And BottomSpace < 0 Then Return リタン
        If ⅩFormMoveable(f) = False Then Return リタン
        Try
            With f
                If Not (f Is c.FindForm) Then Return 0
                If Not ⅩGetScreenSizeNET(rc, ScrnWD, ScrnHT, 0, 0, 0, 0) Then Return 0
                '----------------------------------
                X = .Width - .ClientRectangle.Width + c.Right + RightSpace
                Y = .Height - .ClientRectangle.Height + c.Bottom + BottomSpace
                '----------------------------------
                If X = .Width And Y = .Height Then
                    リタン = 1
                ElseIf X <= ScrnWD + 100 And Y <= ScrnHT + 100 Then
                    SizeSeting = True
                    .SetBounds(.Left, .Top, X, Y)
                    SizeSeting = False
                    リタン = 2
                    '----------------------------------
                    '2019/08/03  フォームリサイズで、メニューバーが、二列と一列との間で変化した場合の、設定エラーを補正する
                    If (BottomSpace <> (f.ClientRectangle.Height) - c.Bottom) Then
                        If Not ココから呼び出した Then
                            ココから呼び出した = True
                            リタン = ⅩFormSizeSetByControlSize(f, c, RightSpace, BottomSpace, rサイズオーバーでも設定する, MsgBox_Show_WindowSizeOver)
                            ココから呼び出した = False
                        End If
                        '                Debug.Print "ⅩFormSizeSetByControlSize() -ERR"
                    End If
                    '----------------------------------
                    'Debug.Print "ⅩFormSizeSetByControlSize()"
                Else
                    If rサイズオーバーでも設定する Then
                        SizeSeting = True : .SetBounds(.Left, .Top, X, Y) : SizeSeting = False
                        リタン = 3
                    Else
                        If MsgBox_Show_WindowSizeOver Then MsgBox("""" & f.Name & """  Window Size Over !!")
                    End If
                End If
            End With
            Return リタン
        Catch
            SizeSeting = False : MsgBox(ErrorToString())
            Return 0
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    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()
        'gggint = ⅩFormMove(gcoフォームのサイズと位置を設定, Me, rMoveCancel, rWndState, rPxlLeft, rPxlTop, rPxlWidth, rPxlHeight) '
        'gggint = ⅩFormMove(gcoフォームをスクリーン内に移動, Me) '
        'gggint = ⅩFormMove(gcoフォームをスクリーン中心に移動, Me) '
        'gggint = ⅩFormMove(gcoフォーム中心をマウス位置中心に移動, Me) '
        'gggint = ⅩFormMove(gcoフォーム左上をマウス位置中心に移動, Me) '
        'gggint = ⅩFormMove(gcoフォームを親フォームの中心に移動, Me, , , , , , , , rOwnerForm ) 
        '-------------------------------------
        'rMoveCancel = (rFormPost = Enum一般.フォームのサイズと位置の変更禁止)
        'gggint = ⅩFormMove(Enum一般.フォームのサイズと位置を設定, f, MoveCancel, WndState, xx, yy, ww, hh)
        '-------------------------------------
        Const cMinWidth As Integer = 100 : Const cMinHeight As Integer = 100
        Const cSpace As Short = 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 ⅩFormSizeChang最小サイズ以上に_フラグ設定付(ByRef ユーザーの_mCall_In_frmMain_ResizeEnd As Boolean, ByRef f As Form, ByVal メニューバーHT As Integer, ByVal 最小ClientWD As Integer, ByVal 最小ClientHT As Integer, ByRef rwFlgココから呼び出した As Boolean) As Boolean
        Dim RET As Boolean = False
        If f.WindowState = FormWindowState.Normal Then
            ユーザーの_mCall_In_frmMain_ResizeEnd = True
            RET = ⅩFormSizeChang最小サイズ以上に(f, メニューバーHT, 最小ClientWD, 最小ClientHT, rwFlgココから呼び出した)
            ユーザーの_mCall_In_frmMain_ResizeEnd = False
        End If
        Return RET
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩFormSizeChang最小サイズ以上に(ByRef f As Form, ByVal メニューバーHT As Integer, ByVal 最小ClientWD As Integer, ByVal 最小ClientHT As Integer, ByRef rwFlgココから呼び出した As Boolean) As Boolean
        If f.WindowState = FormWindowState.Normal Then
            Dim ww, hh As Integer
            ww = 最小ClientWD + (f.Width - f.ClientSize.Width)
            If f.Width >= ww Then ww = f.Width
            hh = 最小ClientHT + (f.Height - f.ClientSize.Height) + メニューバーHT
            If f.Height >= hh Then hh = f.Height
            If f.Width < ww Or f.Height < hh Then
                rwFlgココから呼び出した = True
                f.SetBounds(0, 0, ww, hh, BoundsSpecified.Size)
                '2023/03/11 一回の呼び出しでは、正しいサイズに設定されない場合がある。　**アプリ最大化で起動後の　最初の　最大化　から　ノーマルサイズ　への変更時に
                If f.Width < ww Or f.Height < hh Then
                    'qqqqq("ⅩFormSizeChang最小サイズ以上に() 内で2回実行")
                    f.SetBounds(0, 0, ww, hh, BoundsSpecified.Size)
                End If
                Application.DoEvents()
                rwFlgココから呼び出した = False
            End If
            gggint = ⅩFormMove(gcoフォームをスクリーン内に移動, f)
            Return True
        Else
            Return False '2023/08/17 ??????????????  
        End If
    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) 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
            Return rcagl
        Catch
            Return Nothing
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹファーストディスプレイサイズ(ByRef タスクバー除外 As Boolean) As Rectangle
        '2023/04/01
        Try
            Dim ScreenAry() As Screen = Screen.AllScreens  '0 to max
            Dim max As Integer = ScreenAry.GetUpperBound(0)
            If タスクバー除外 Then
                Return ScreenAry(0).WorkingArea
            Else
                Return ScreenAry(0).Bounds
            End If
        Catch
            Return Nothing
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩSetWindowRgnDo(ByVal hwnd As Long, ByVal RGNコピー元 As Long, ByVal OffsetX As Long, ByVal OffsetY As Long) As Boolean
        Dim rgn0 As Long
        rgn0 = CreateRectRgn(0, 0, 1, 1)
        If rgn0 <> 0 Then
            If 0 <> CombineRgn(rgn0, RGNコピー元, RGNコピー元, RGN_COPY) Then
                If 0 <> OffsetRgn(rgn0, OffsetX, OffsetY) Then
                    If 0 <> SetWindowRgn(hwnd, 0, 0) Then
                        If 0 <> SetWindowRgn(hwnd, rgn0, 0) Then
                            gggint = DeleteObject(rgn0)
                            Return True
                        End If
                    End If
                End If
            End If
        End If
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩSetFocusControl(ByRef c As Control) As Boolean
        Try        'Web Control には使用禁止
            If c IsNot Nothing Then
                If c.Visible Then
                    If c.Enabled Then 'Web Control には使用禁止
                        c.Select()
                        'qqqqq("ggⅩSetFocusControl " & c.Name)
                        Return True
                    End If
                End If
            End If
            Return True
        Catch ex As Exception
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ子contは親contの領域内にある(ByVal 親 As Control, ByVal 子 As Control, ByVal 縁正負 As Integer) As Boolean
        If 親 Is Nothing Or 子 Is Nothing Then Return False
        Return (子.Left >= 0 + 縁正負) And (子.Top >= 0 + 縁正負) And (子.Right <= 親.ClientRectangle.Width - 縁正負) And (子.Bottom <= 親.ClientRectangle.Height - 縁正負)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "TextBox"

#End Region

#Region "コントロール"

#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 Ⅹマウスイベント検査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ファイルイベント_Drag_Is_指定EXT_IN(ByVal e As DragEventArgs, ByVal 拡張子集 As String) As Boolean
        '2023/07/24 new
        '拡張子集 　= "*ext1*ext2*....*......*......*"  これらの　EXT　タイプなら　True　を返す  
        'e.Effect　　を設定して返す　
        If (e.Data.GetDataPresent(DataFormats.FileDrop)) Then
            Try
                Dim ddd As DataObject = e.Data
                If ddd.ContainsFileDropList Then
                    Dim fff As System.Collections.Specialized.StringCollection = ddd.GetFileDropList
                    '2022/05/09 ファイル名とフォルダ名が　混ざって入っている。
                    If fff IsNot Nothing Then
                        Dim f As String, ext As String
                        Dim CHK_UCASE As String = IIf(Len(拡張子集) > 0, "*" & UCase(拡張子集) & "*", "")
                        For a As Integer = 0 To fff.Count - 1
                            f = fff.Item(a)
                            If My.Computer.FileSystem.FileExists(f) Then
                                If Len(CHK_UCASE) = 0 Then
                                    e.Effect = DragDropEffects.Copy     ' Allow drop.
                                    Return True  '一般的なファイルです
                                Else
                                    ext = "*" & UCase(Ⅹファイル拡張子(f, False)) & "*"
                                    If (InStr(CHK_UCASE, ext) > 0) Then
                                        e.Effect = DragDropEffects.Copy     ' Allow drop.
                                        Return True  '拡張子集ファイルが混ざっています
                                    End If
                                End If
                            End If
                        Next
                    End If
                End If
            Catch
                'no op
            End Try
        End If
        e.Effect = DragDropEffects.None     ' Do not allow drop.
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩOLEDragDropファイルイベント(ByVal DragEnter1_Over2_Drop3 As Integer, ByVal UkeCont As Control, ByVal e As DragEventArgs, _
                    ByRef wFolders_0_Ubound() As String, ByRef wFiles_0_Ubound() As String, ByRef wDrpX_inControl As Integer, ByRef wDrpY_inControl As Integer) As Boolean
        '2022/06/15 　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.FileDrop)) Then
                    e.Effect = DragDropEffects.Copy     ' Allow drop.
                Else
                    e.Effect = DragDropEffects.None     ' Do not allow drop.
                End If
                Return True
            Case 3
                ReDim wFolders_0_Ubound(0) : wFolders_0_Ubound(0) = ""
                ReDim wFiles_0_Ubound(0) : wFiles_0_Ubound(0) = ""
                wDrpX_inControl = 0 : wDrpY_inControl = 0
                '---------------------------------------------------------------
                If (e.Data.GetDataPresent(DataFormats.FileDrop)) Then
                    e.Effect = DragDropEffects.Copy     ' Allow drop.
                    Try
                        Dim ddd As DataObject = e.Data
                        If ddd.ContainsFileDropList Then
                            Dim fff As System.Collections.Specialized.StringCollection = ddd.GetFileDropList
                            '2022/05/09 ファイル名とフォルダ名が　混ざって入っている。
                            If fff IsNot Nothing Then
                                Dim f As String : Dim m1 As Integer = -1, m2 As Integer = -1
                                For a As Integer = 0 To fff.Count - 1
                                    f = fff.Item(a)
                                    If My.Computer.FileSystem.DirectoryExists(f) Then
                                        m1 = m1 + 1 : ReDim Preserve wFolders_0_Ubound(m1) : wFolders_0_Ubound(m1) = f
                                    ElseIf My.Computer.FileSystem.FileExists(f) Then
                                        m2 = m2 + 1 : ReDim Preserve wFiles_0_Ubound(m2) : wFiles_0_Ubound(m2) = f
                                    End If
                                Next
                                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ファイルイベント() ")
                    End Try
                Else
                    e.Effect = DragDropEffects.None     ' Do not allow drop.
                End If
                Return (Not (wFolders_0_Ubound(0) = "" And wFiles_0_Ubound(0) = ""))
        End Select
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "いろいろ"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹリストボックスにリストをセット_Ret_Cstr_CurListIndex(ByRef lst As ListBox, ByVal r設定するリスト文字列() As String, ByVal r設定するCurIndex As Integer) As String
        'r設定するリスト文字列() = ItemsIndex (0  to  max) = { "aaa", "bbbbbb", "ccccc", ...... }
        With lst
            .Items.Clear()
            For a As Integer = 0 To UBound(r設定するリスト文字列)
                .Items.Add(r設定するリスト文字列(a))
            Next
            Dim n As Integer = Math.Max(-1, Math.Min(r設定するCurIndex, .Items.Count - 1))
            .SelectedIndex = n
            Return CStr(n)
        End With
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ全角文字に数値を変換(ByRef r数値 As Double) As String
        Return StrConv(CStr(r数値), VbStrConv.Wide)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ全角数字の値(ByRef r全角数字文字列 As String) As Double
        Return Val(StrConv(r全角数字文字列, VbStrConv.Narrow))
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹラベル文字列一致インデックス(ByRef ラベル() As Label, ByRef 文字列 As String) As Integer
        'ラベル() のインデックスは、 0 から ubound(ラベル()) - 1
        Try
            For a As Integer = 0 To UBound(ラベル)
                If ラベル(a) Is Nothing Then Exit For
                If ラベル(a).Text = 文字列 Then Return a
            Next
        Catch ex As Exception
        End Try
        Return -1
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹカーソルファイルロード(ByVal owner As Control, ByVal filecur As String, ByVal errmsgShow As Boolean) As Boolean
        Try
            owner.Cursor = New Cursor(filecur)
            Return True
            '2022/06/22 カスタムカーソルの組み込み方が ?????
            'pctメイン.Cursor = New Cursor(pctメイン.GetType(), "hand.CUR")  'ERROR
        Catch ex As Exception
            MsgBox("カーソルファイル　" & vbCrLf & vbCrLf & filecur & "　を、" & vbCrLf & vbCrLf & "このアプリと同じフォルダに入れてください。")
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹサウンドを鳴らす(ByVal サウンドファイル As String, ByVal 繰り返し数 As Integer, ByVal サウンド終了まで待つ As Boolean, ByVal ShowMsgBox As Boolean) As Boolean
        Try
            If Not Ⅹファイルは存在(サウンドファイル) Then
                If ShowMsgBox Then MsgBox(サウンドファイル & gggCR2 & "サウンドファイルがありません。" & gggCR2 & "サウンドファイルを再設定してください。")
                Return False
            End If
            For a As Integer = 1 To 繰り返し数
                If a > 100 Then Exit For
                My.Computer.Audio.Play(サウンドファイル, IIf(サウンド終了まで待つ, AudioPlayMode.WaitToComplete, AudioPlayMode.Background))
            Next
            Return True
        Catch ex As Exception
            MsgBox(サウンドファイル & gggCR2 & "サウンドファイルの実行で、エラーが発生しました。")
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "Ⅹゲーム枚数_経過時間_文字列設定"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹゲーム枚数_経過時間_表示処理(ByVal r開始_0_途中_1_終了_2_初期化_3 As Integer, ByVal rTimer As Timer, ByVal mスタートカード枚数 As Integer, ByVal m現在の残りカード枚数 As Integer, ByRef mn枚数と時間の表示 As ToolStripMenuItem, ByRef lblカード残り枚数 As Label, ByRef lbl経過時間 As Label) As Boolean
        If rTimer Is Nothing Then Return False
        Static DTStart As DateTime
        Try
            Dim DD As TimeSpan
            Dim カードデーター As String = CStr(m現在の残りカード枚数) & " / " & CStr(mスタートカード枚数) & " 枚"
            Select Case r開始_0_途中_1_終了_2_初期化_3
                Case 0, 3 '開始    '初期化  App Start
                    rTimer.Interval = 1000
                    rTimer.Enabled = (r開始_0_途中_1_終了_2_初期化_3 = 0)
                    DTStart = DateTime.Now
                    DD = DTStart - DTStart
                Case 1 '途中
                    DD = DateTime.Now - DTStart
                Case 2 '終了
                    DD = DateTime.Now - DTStart
                    rTimer.Enabled = False
            End Select
            If mn枚数と時間の表示 IsNot Nothing Then
                If r開始_0_途中_1_終了_2_初期化_3 = 2 Or r開始_0_途中_1_終了_2_初期化_3 = 3 Then
                    mn枚数と時間の表示.Text = "[ 枚数と時間 ]"
                Else
                    mn枚数と時間の表示.Text = カードデーター & "  " & Format(DD.Hours, "00") & ":" & Format(DD.Minutes, "00") & ":" & Format(DD.Seconds, "00")
                End If
            End If
            If lblカード残り枚数 IsNot Nothing Then
                lblカード残り枚数.Text = "カード枚数　　　" & カードデーター
            End If
            If lbl経過時間 IsNot Nothing Then
                lbl経過時間.Text = "ゲーム時間　　　" & Format(DD.Hours, "00") & " 時間 " & Format(DD.Minutes, "00") & " 分 " & Format(DD.Seconds, "00") & " 秒"
            End If
            Return True
        Catch ex As Exception
            MsgBox("ERROR  in  Ⅹゲーム枚数_経過時間_表示処理()" & vbCrLf & ex.ToString)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹゲーム枚数_経過時間_メニュー文字列設定(ByVal op_FormLoad0_MenuDrop1_StartReSet2_MenuHide3 As Integer, _
                ByRef mn枚数と時間の表示_Main As ToolStripMenuItem, ByRef m残り枚数 As ToolStripMenuItem, ByRef m経過時間 As ToolStripMenuItem, _
                ByVal m残りカード枚数 As String, ByVal フォーマット_hms_ms_s As String) As Boolean
        Static stcゲーム開始枚数 As Integer
        Dim ttt As String
        Select Case op_FormLoad0_MenuDrop1_StartReSet2_MenuHide3
            Case 0 'FormLoad0
                mn枚数と時間の表示_Main.Visible = False
                gggbol = zzⅩゲーム枚数_経過時間_文字列設定(0, m残り枚数, m経過時間, "000", "00:00", stcゲーム開始枚数)
            Case 1 'MenuDrop1
                ttt = Ⅹタイム経過チェック文字列_時間_分_秒(1, フォーマット_hms_ms_s)
                gggbol = zzⅩゲーム枚数_経過時間_文字列設定(0, m残り枚数, m経過時間, m残りカード枚数, ttt, stcゲーム開始枚数)
            Case 2 'StartReSet2
                mn枚数と時間の表示_Main.Visible = True
                ttt = Ⅹタイム経過チェック文字列_時間_分_秒(0, フォーマット_hms_ms_s)
                stcゲーム開始枚数 = m残りカード枚数
            Case 3 'MenuHide
                mn枚数と時間の表示_Main.Visible = False
            Case 4 'from GMCOM_ゲーム結果パネル表示_Show()
                ttt = Ⅹタイム経過チェック文字列_時間_分_秒(1, フォーマット_hms_ms_s)
                'gggbol = zzⅩゲーム枚数_経過時間_文字列設定(1, m残り枚数, m経過時間, stcゲーム開始枚数, ttt, stcゲーム開始枚数)
                gggbol = zzⅩゲーム枚数_経過時間_文字列設定(1, m残り枚数, m経過時間, m残りカード枚数, ttt, stcゲーム開始枚数)
        End Select
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function zzⅩゲーム枚数_経過時間_文字列設定(ByVal op As Integer, ByRef m残り枚数 As ToolStripMenuItem, ByRef m経過時間 As ToolStripMenuItem, ByVal m残りカード枚数 As String, ByVal mゲーム経過時間 As String, ByVal stcゲーム開始枚数 As Integer) As Boolean
        Select Case op
            Case 0
                m残り枚数.Text = "ゲーム　残り枚数　　" & m残りカード枚数 & " 枚　／　" & CStr(stcゲーム開始枚数) & " 枚"
                m経過時間.Text = "ゲーム　経過時間　　" & mゲーム経過時間
            Case 1
                If m残りカード枚数 = "0" Then
                    m残り枚数.Text = "ゲーム開始枚数　　" & stcゲーム開始枚数 & " 枚"
                    m経過時間.Text = "ゲーム使用時間　　" & mゲーム経過時間
                Else
                    m残り枚数.Text = "ゲーム残り枚数　　" & m残りカード枚数 & " 枚　／　" & CStr(stcゲーム開始枚数) & " 枚"
                    m経過時間.Text = "ゲーム使用時間　　" & mゲーム経過時間
                End If
        End Select
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "タイム経過チェック"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹタイム経過チェック文字列_時間_分_秒(ByVal rスタート_0_現在_1 As Integer, ByVal フォーマット_HMS_MS_S As String) As String
        Dim DTS As TimeSpan = Ⅹタイム経過チェック(rスタート_0_現在_1)
        Select Case フォーマット_HMS_MS_S
            Case "hms" : Return Format(DTS.Hours, "00") & " 時間 " & Format(DTS.Minutes, "00") & " 分 " & Format(DTS.Seconds, "00") & " 秒"
            Case "ms" : Return Format(DTS.Minutes, "00") & " 分 " & Format(DTS.Seconds, "00") & " 秒"
            Case "s" : Return Format(DTS.Seconds, "00") & " 秒"
            Case Else
                Return "ERROR in Ⅹタイム経過チェック文字列_時間_分_秒()"
        End Select
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹタイム経過チェック(ByVal rスタート_0_現在_1 As Integer) As TimeSpan
        Static DTM As DateTime
        If rスタート_0_現在_1 = 0 Then
            DTM = DateTime.Now
            Return DTM - DTM
        Else
            Dim d As DateTime = DateTime.Now
            Return d - DTM
        End If
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹタイム_経過時間_秒数(ByVal rスタート_0_現在_1 As Integer, ByRef DTM As DateTime) As Integer
        If rスタート_0_現在_1 = 0 Then
            DTM = DateTime.Now
            Return 0
        Else
            Dim DDD As TimeSpan = DateTime.Now - DTM
            Dim nnn As Integer = CInt(DDD.TotalSeconds)
            Return nnn
        End If
    End Function
#End Region

#Region "ファイル"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩファイルはPictureBoxで読み込める画像でファイルシステムに存在する(ByRef rPath As String) As Boolean
        If Ⅹファイルは存在(rPath) Then Return ⅩファイルはPictureBoxで読み込める画像(rPath)
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹフルパス名からファイル名あるいは最後のフォルダ名を得る(ByRef pf As String, Optional ByRef DelExt As Boolean = False) As String
        '2023/07/15 chg 
        'フルパス名から ファイル名 あるいは 最後のパス名 のみを得る
        Try
            Dim w As String = Path.GetFileName(pf)
            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 Short, 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 pf As String) As String
        '2023/07/15 chg 
        'フルパス名から パス名 のみを得る。あるいは親フォルダパス名を得る。
        Try
            Dim w As String = Path.GetDirectoryName(pf)
            If w Is Nothing Then Return ""
            Return w
        Catch
        End Try
        Return ""
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹパスセパレータ変換(ByRef rPathFile As String, ByRef rPathSepStr As String) As String
        'path sep "\" or "/"
        'rPathSepStr をチェックしてどちらかに一致させる。 "\" or "/"
        Dim a As Short : 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 Short : 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 Short : 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 ⅩFolderOrFileIsValid(ByRef p As String) As Integer
        '2008/06/19  path sep "\" or "/"
        'ret ----  0 = not find    '1 = folder    '2 = file
        If Ⅹフォルダは存在(p) Then
            Return 1
        ElseIf Ⅹファイルは存在(p) Then
            Return 2
        Else
            Return 0
        End If
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩファイルはPictureBoxで読み込める画像の_FilePattern() As String
        Return gcoファイルはPictureBoxで読み込める画像の_FilePattern_20220509
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩファイルはPictureBoxで読み込める画像(ByRef rPath As String) As Boolean
        Dim ext As String = LCase(Ⅹファイル拡張子(rPath, True))
        If ext = "" Then Return False
        Return (InStr(ⅩファイルはPictureBoxで読み込める画像の_FilePattern(), "*" & ext) > 0)
    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)
            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 ⅩVBStrLeft(ByVal rStr As String, ByVal rStrlen As Integer) As String
        Return Microsoft.VisualBasic.Left(rStr, rStrlen)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩFormatEx(ByRef rNum As Long, Optional ByRef RX As Integer = 1) As String
        'この関数は　２　ギガバイトまで　それ以上ではオーバーフロー
        'Get FormatStr "2,000,000,000"
        '64 BIT　では　８バイト　×　８　÷　２　
        Try
            If RX = 1 Then
                If rNum < 1 Then Return "0" Else Return Format(rNum, "###,##0")
            Else '1000 / 1000000 / 1000000000 / ...
                Dim n As Long
                n = CLng(rNum / RX)
                If n = 0 And rNum > 0 Then n = 1
                If n < 1 Then Return "0" Else Return Format(n, "###,##0")
            End If
        Catch
            MsgBox("ERROR in ⅩFormatEx()")
        End Try
        Return "0"
    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 ⅩIniデーター文_RW(ByVal gcoプロパiniRD_gcoプロパiniWR As Integer, ByVal 名前 As String, ByVal 値 As String) As String
        '2022/05/14　必ず一行の先頭に、名前があり、その次に　=　でつながっていることを前提とする。でなければ "" を返す。
        '名前=値
        Select Case gcoプロパiniRD_gcoプロパiniWR
            Case gcoプロパiniWR
                Return 名前 & "=" & 値
            Case gcoプロパiniRD
                If InStr(値, 名前) = 1 Then
                    Dim p As Long = InStr(値, "=")
                    If p > 0 Then Return Mid(値, p + 1)
                End If
        End Select
        Return ""
    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 ary() As String, ByRef DelWith_0_to_31_127 As Boolean, ByRef DoRedim As Boolean) As Integer
        'ary() 内の空の要素を削除してかえす space / crlf / tab
        'ary() = 1 to max
        Dim s() As String = {""} : Dim a, m As Integer : Dim w As String : Dim bol As Boolean
        ReDim s(UBound(ary))
        m = 0
        For a = 1 To UBound(ary)
            If DelWith_0_to_31_127 Then
                w = ary(a)
                bol = Ⅹ文内で_Chr_0_to_31_or_127_は空白にし_Trim_する(w)
                If w = "" Then ary(a) = ""
            End If
            If Len(ary(a)) > 0 Then
                m = m + 1
                s(m) = ary(a)
            End If
        Next
        If DoRedim Then
            ReDim ary(m)
        Else
            m = UBound(ary)
        End If
        For a = 1 To m
            ary(a) = s(a)
        Next
        Return m
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ文内で_Chr_0_to_31_or_127_は空白にし_Trim_する(ByRef wStr As String) As Boolean
        'Chr0 to Chr31 / Chr127 Replace Chr32 trim do
        Dim a, m As Integer
        If wStr <> "" Then
            For a = 1 To Len(wStr)
                m = Asc(Mid(wStr, a, 1))
                If (m >= 0 And m < 32) Or m = 127 Then Mid(wStr, a, 1) = " "
            Next
            wStr = Trim(wStr)
        End If
        Return True
    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 rwAry() As String) As Integer
        Try
            If UBound(rwAry) = 0 Then
                If rwAry(0) = "" Then Return 0 'データーがない場合は何もしない
            End If
            Dim max As Integer = UBound(rwAry) + 1
            ReDim Preserve rwAry(max)
            For a As Integer = max To 1 Step -1
                rwAry(a) = rwAry(a - 1)
            Next
            rwAry(0) = ""
            Return max
        Catch ex As Exception
            ReDim Preserve rwAry(0)
            Return 0
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ文配列のコピー_Not_ReDim_受け配列(ByRef 受け() As String, ByRef 送り() As String) As Boolean
        Try
            Dim a As Integer, m As Integer
            m = UBound(受け)
            For a = 0 To UBound(送り)
                If a <= m Then
                    受け(a) = 送り(a)
                Else
                    Exit For
                End If
            Next
            Return True
        Catch
        End Try
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ文配列のコピー(ByRef 受け() As String, ByRef 送り() As String, Optional ByVal 空白のデーター以後は削除してRedimする As Boolean = False) As Boolean
        Try
            Dim a As Integer
            ReDim 受け(UBound(送り))
            For a = 0 To UBound(送り)
                受け(a) = 送り(a)
            Next
            If 空白のデーター以後は削除してRedimする Then
                For a = 1 To UBound(受け)
                    If 受け(a) = "" Then
                        ReDim Preserve 受け(a - 1)
                        Exit For
                    End If
                Next
            End If
            Return True
        Catch
        End Try
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ文配列全体の比較(ByRef ary1() As String, ByRef ary2() As String, Optional ByRef CompNoCase As Boolean = True) As Boolean
        '2008/06/20
        Try
            Dim a, n As Integer
            n = UBound(ary1)
            If n <> UBound(ary2) Then Return False
            For a = 0 To n
                If CompNoCase Then
                    If UCase(ary1(a)) <> UCase(ary2(a)) Then Return False
                Else
                    If ary1(a) <> ary2(a) Then Return False
                End If
            Next
            Return True
        Catch
        End Try
        Return False
    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
        'gStrCut()
        '文字列  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 Ⅹカッコで囲む和文用(ByVal MainStr As String, ByVal AddSpace As String) As String
        Return "【" & AddSpace & MainStr & AddSpace & "】"
    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
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩPathStrCutDispSize(ByRef rCont As Control, ByRef MaxWD As Integer, ByRef ファイルフルパス As String, Optional ByRef CutEx As String = "") As String
        'パス文字列の長さを表示サイズに合わせてカットして　...　をつける。
        If rCont Is Nothing Or ファイルフルパス = "" Then Return ""
        Dim cut, w As String : Dim p, a, m As Integer : Dim ary() As String = {""}
        Try
            If Ⅹ文の幅pxl(rCont, ファイルフルパス) < MaxWD Then Return ファイルフルパス
            If CutEx = "" Then
                cut = IIf(InStr(ファイルフルパス, "\") > 0, "\", IIf(InStr(ファイルフルパス, "／") > 0, "／", "/"))
            Else
                cut = CutEx 'フォルダメモパスに使用する。
            End If
            ReDim ary(0)
            m = Ⅹ文をカットして配列にする(ファイルフルパス, cut, ary)
            If m > 2 Then
                p = 3
                Do
                    w = ary(1) & cut & "..." & cut
                    For a = p To m
                        w = w & ary(a) & IIf(a < m, cut, "")
                    Next
                    If Ⅹ文の幅pxl(rCont, w) < MaxWD Then Exit Do
                    p = p + 1
                    If p > m Then Exit Do
                Loop
                Return w
            Else
                Return ファイルフルパス
            End If
        Catch
        End Try
        Return ""
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "ListView"

#End Region

#Region "リストボックス"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    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 開始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
            If ListBoxをクリアする Then .Clear()
            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 lt As ListBox, ByRef ary() As String, Optional ByRef AddFore As String = "", Optional ByRef AddBack As String = "") As Integer
        'リストボックスのリストを文字列配列の ary( 1 to ubound ) に入れ ubound を返す
        'AddFore / AddBack 前と後ろに文字列を追加する場合に指定する
        Dim a, m As Integer
        With lt.Items
            m = .Count : ReDim ary(m)
            If AddFore = "" And AddBack = "" Then
                For a = 0 To m - 1
                    ary(a + 1) = .Item(a)
                Next
            Else
                For a = 0 To m - 1
                    ary(a + 1) = AddFore & .Item(a) & AddBack
                Next
            End If
            Return UBound(ary)
        End With
    End Function
#End Region

#Region "Image"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩImageClear(ByVal img As Image, ByVal ccc As Color) As Boolean
        Try
            If img IsNot Nothing Then
                Dim g As Graphics = Graphics.FromImage(img)
                If g IsNot Nothing Then
                    g.Clear(ccc)
                    g.Dispose()
                    Return True
                End If
            End If
        Catch ex As Exception
        End Try
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩImageFileOpen_Copy_Into_OtherImage(ByVal pf As String, ByRef wUserImg As Image) As Boolean
        Try
            Dim img As Image = System.Drawing.Image.FromFile(pf)
            If img IsNot Nothing Then
                If ⅩImage_新規作成_再作成(wUserImg, img.Width, img.Height) Then
                    gggbol = ⅩImage全域StrechCopy(wUserImg, img)
                    img.Dispose()
                    Return True
                End If
            End If
        Catch
            MsgBox("ERROR in aaウインドウ初期化作成()" & vbCrLf & ErrorToString())
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩImageDrawByGraphics_With_Set_GDIrgn(ByVal g受け As Graphics, ByVal img送り元 As Image, ByVal GDIrgn As Integer, ByRef 受け As RECT, ByRef 送り As RECT) As Boolean
        If g受け Is Nothing Then Return False
        If img送り元 Is Nothing Then Return False
        If GDIrgn = 0 Then Return False
        Dim rrggnn As Region
        rrggnn = Region.FromHrgn(GDIrgn)
        g受け.SetClip(rrggnn, CombineMode.Replace)
        Dim RET As Boolean = ⅩImageDrawByGraphics(g受け, img送り元, 受け, 送り)
        rrggnn.Dispose()
        Return RET
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩImageDrawByGraphics(ByVal g受け As Graphics, ByVal img送り元 As Image, ByRef 受け As RECT, ByRef 送り As RECT) As Boolean
        'gggbol = ⅩImageDrawByGraphics( g受けGraphics ,  img送り元 , 受け_RECT , 送り_RECT )
        'gggbol = ⅩImageDrawByGraphics( g受けGraphics ,  img送り元 , 受x , 受y , 受w , 受h , 送x , 送y, 送w, 送h )
        'gggbol = ⅩImageDrawByGraphics( g受けGraphics ,  img送り元 , 受x , 受y , 受w , 受h , 送り_RECT )
        'gggbol = ⅩImageDrawByGraphics( g受けGraphics ,  img送り元 , 受け_RECT , 送x , 送y, 送w, 送h )
        If g受け Is Nothing Then Return False
        If img送り元 Is Nothing Then Return False
        Dim 田 As Rectangle : 田.X = 受け.lll : 田.Y = 受け.ttt : 田.Width = 受け.rrr - 受け.lll : 田.Height = 受け.bbb - 受け.ttt
        g受け.DrawImage(img送り元, 田, 送り.lll, 送り.ttt, 送り.rrr - 送り.lll, 送り.bbb - 送り.ttt, GraphicsUnit.Pixel)
        Return True
    End Function
    Function ⅩImageDrawByGraphics(ByVal g受け As Graphics, ByVal 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
        'gggbol = ⅩImageDrawByGraphics( g受けGraphics ,  img送り元 , 受x , 受y , 受w , 受h , 送x , 送y, 送w, 送h )
        If g受け Is Nothing Then Return False
        If img送り元 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)
        Return True
    End Function
    Function ⅩImageDrawByGraphics(ByVal g受け As Graphics, ByVal img送り元 As Image, ByVal 受x As Integer, ByVal 受y As Integer, ByVal 受w As Integer, ByVal 受h As Integer, ByRef 送り As RECT) As Boolean
        'gggbol = ⅩImageDrawByGraphics( g受けGraphics ,  img送り元 , 受x , 受y , 受w , 受h , 送り_RECT )
        If g受け Is Nothing Then Return False
        If img送り元 Is Nothing Then Return False
        Dim 田 As Rectangle : 田.X = 受x : 田.Y = 受y : 田.Width = 受w : 田.Height = 受h
        g受け.DrawImage(img送り元, 田, 送り.lll, 送り.ttt, 送り.rrr - 送り.lll, 送り.bbb - 送り.ttt, GraphicsUnit.Pixel)
        Return True
    End Function
    Function ⅩImageDrawByGraphics(ByVal g受け As Graphics, ByVal img送り元 As Image, ByRef 受け As RECT, ByVal 送x As Integer, ByVal 送y As Integer, ByVal 送w As Integer, ByVal 送h As Integer) As Boolean
        'gggbol = ⅩImageDrawByGraphics( g受けGraphics ,  img送り元 , 受け_RECT , 送x , 送y, 送w, 送h )
        If g受け Is Nothing Then Return False
        If img送り元 Is Nothing Then Return False
        Dim 田 As Rectangle : 田.X = 受け.lll : 田.Y = 受け.ttt : 田.Width = 受け.rrr - 受け.lll : 田.Height = 受け.bbb - 受け.ttt
        g受け.DrawImage(img送り元, 田, 送x, 送y, 送w, 送h, GraphicsUnit.Pixel)
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩBitMapCopyDoDo(ByVal hDC受 As Integer, ByVal hDC送 As Integer, ByVal ux As Integer, ByVal uy As Integer, ByVal uw As Integer, ByVal uh As Integer, ByVal ox As Integer, ByVal oy As Integer, ByVal ow As Integer, ByVal oh As Integer) As Boolean
        'hDC受  へ　hDC送　からコピーする。　ow = 0　を指定すると　BitBlt()　を使用する。hDC受 == hDC送 でもよい。
        'StretchBlt　の場合は事前に　SetStretchBltMode()　を実行する
        If hDC受 <> 0 And hDC送 <> 0 Then
            If (ow < 1) Or (uw = ow And uh = oh) Then
                Return (0 <> BitBlt(hDC受, ux, uy, uw, uh, hDC送, ox, oy, SRCCOPY))
            Else
                If 0 <> SetStretchBltMode(hDC受, COLORONCOLOR) Then Return (0 <> StretchBlt(hDC受, ux, uy, uw, uh, hDC送, ox, oy, ow, oh, SRCCOPY))
            End If
        Else
            qqqqq("■ERROR in ⅩBitMapCopyDoDo() ---> NOT (hDC受 <> 0 And hDC送 <> 0)")
        End If
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩImageから_GDI用BMPを_作り選択_後で消す(ByVal 作り1_消す2 As Integer, ByRef img As Image, ByRef g As Graphics, ByRef GDIHDC As Integer, ByRef GDIbmp As Integer, ByRef oldbmp As Integer) As Boolean
        If 作り1_消す2 = 1 Then
            If img Is Nothing Then Return False
            Try
                g = Graphics.FromImage(img)
            Catch ex As Exception
                Return False
            End Try
            '2023/02/03 err if
            If g IsNot Nothing Then
                GDIHDC = g.GetHdc
                If GDIHDC <> 0 Then
                    Dim bmp As Bitmap = img
                    GDIbmp = bmp.GetHbitmap
                    If GDIbmp <> 0 Then
                        oldbmp = SelectObject(GDIHDC, GDIbmp)
                        If oldbmp <> 0 Then
                            Return True
                        End If
                        gggint = DeleteObject(GDIbmp)
                    End If
                    g.ReleaseHdc(GDIHDC)
                End If
                g.Dispose()
            End If
            Return False
        Else
            gggint = SelectObject(GDIHDC, oldbmp)
            gggint = DeleteObject(GDIbmp)
            g.ReleaseHdc(GDIHDC)
            g.Dispose()
            Return True
        End If
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩBmpMakeFromImage(ByVal Img As Image) As Integer
        Try
            Dim bmtmp As Bitmap = Img
            Dim bmp As Integer = bmtmp.GetHbitmap
            Return bmp
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩグレーImageMake(ByRef img元画 As Image, ByRef imgグレー As Image, ByRef imgグレーコピー先 As Image, ByVal DoNewCopy As Boolean, ByVal 明るく暗くする_2_to_1_to_0 As Single) As Boolean
        Dim RET As Boolean = False
        If img元画 Is Nothing Then Return False
        If imgグレー Is Nothing Then Return False
        If DoNewCopy Then
            If imgグレーコピー先 Is Nothing Then Return False
            If imgグレー IsNot Nothing Then
                imgグレー.Dispose()
            End If
            imgグレー = img元画.Clone
            If imgグレーコピー先 IsNot Nothing Then
                imgグレーコピー先.Dispose()
            End If
            imgグレーコピー先 = img元画.Clone
        End If
        'グレーにする()
        RET = ⅩBmpPctBox明るく暗くする_BitsByteAry(imgグレー, 明るく暗くする_2_to_1_to_0)
        If DoNewCopy Then
            RET = ⅩImage全域StrechCopy(imgグレーコピー先, imgグレー)
        End If
        'qqqqq("ⅩグレーImageMake() Done")
        Return RET
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩBmpPctBox明るく暗くする_BitsByteAry(ByVal rwBmp As Bitmap, ByRef 明るく暗くする_2_to_1_to_0 As Single) As Boolean
        If rwBmp Is Nothing Then Return False
        Try
            Dim rect As New Rectangle(0, 0, rwBmp.Width, rwBmp.Height)     'Lock the bitmap's bits. 
            Dim BmpData As System.Drawing.Imaging.BitmapData = rwBmp.LockBits(rect, Drawing.Imaging.ImageLockMode.ReadWrite, rwBmp.PixelFormat)
            Dim ptr As IntPtr = BmpData.Scan0    ' Get the address of the first line.
            Dim pich As Integer = 0
            Select Case rwBmp.PixelFormat
                Case Imaging.PixelFormat.Format24bppRgb
                    pich = 3
                Case Imaging.PixelFormat.Format32bppArgb, Imaging.PixelFormat.Format32bppPArgb, Imaging.PixelFormat.Format32bppRgb
                    pich = 4
            End Select
            'Format24bppRgb    1 ピクセルあたり 24 ビットの形式であることを指定します。つまり、赤、緑、および青のコンポーネントに、それぞれ 8 ビットを使用します。  
            'Format32bppArgb   1 ピクセルあたり 32 ビットの形式であることを指定します。つまり、アルファ、赤、緑、および青のコンポーネントに、それぞれ 8 ビットを使用します。 
            'Format32bppPArgb  1 ピクセルあたり 32 ビットの形式であることを指定します。つまり、アルファ、赤、緑、および青のコンポーネントに、それぞれ 8 ビットを使用します。アルファ コンポーネントに応じて、赤、緑、および青のコンポーネントが前乗算されます。  
            'Format32bppRgb    1 ピクセルあたり 32 ビットの形式であることを指定します。つまり、赤、緑、および青のコンポーネントに、それぞれ 8 ビットを使用します。残りの 8 ビットは使用されません。            
            If pich > 2 And ptr <> 0 Then
                'Declare an array to hold the bytes of the bitmap. 
                Dim bytes As Integer = rwBmp.Width * rwBmp.Height * pich
                Dim RGBs(bytes - 1) As Byte
                ' Copy the RGB values into the array.
                System.Runtime.InteropServices.Marshal.Copy(ptr, RGBs, 0, bytes)
                ' 
                Dim bai As Single : Dim baiINT As Integer
                Dim rr As Integer, gg As Integer, bb As Integer
                Dim 明るくする As Boolean = (明るく暗くする_2_to_1_to_0 >= 1)
                bai = 明るく暗くする_2_to_1_to_0
                bai = Ⅹ数値範囲Sng(0, 1, IIf(bai < 1, bai, bai - 1))
                baiINT = bai * 50
                'qqqqq("BitsByteAry Pich = " & CStr(pich))  'GIF などでは４バイト／１ピクセル
                Dim c As Integer, a As Integer
                For a = 0 To RGBs.Length - 1 Step pich
                    'If pich = 3 Then c = a Else c = a + 1　　不要３バイトでも、４バイトでも並びは同じ
                    c = a
                    If 明るくする Then
                        rr = RGBs(c) : rr = rr + ((255 - rr) * baiINT) \ 50
                        gg = RGBs(c + 1) : gg = gg + ((255 - gg) * baiINT) \ 50
                        bb = RGBs(c + 2) : bb = bb + ((255 - bb) * baiINT) \ 50
                    Else
                        rr = RGBs(c) * baiINT \ 50
                        gg = RGBs(c + 1) * baiINT \ 50
                        bb = RGBs(c + 2) * baiINT \ 50
                    End If
                    If rr < 0 Then rr = 0
                    If rr > 255 Then rr = 255
                    If gg < 0 Then gg = 0
                    If gg > 255 Then gg = 255
                    If bb < 0 Then bb = 0
                    If bb > 255 Then bb = 255
                    RGBs(c) = rr
                    RGBs(c + 1) = gg
                    RGBs(c + 2) = bb
                Next
                'Copy the RGB values back to the bitmap
                System.Runtime.InteropServices.Marshal.Copy(RGBs, 0, ptr, bytes)

                ReDim RGBs(0)

            End If
            'Unlock the bits.
            rwBmp.UnlockBits(BmpData)

            'qqqqq("******ⅩBmpPctBox明るく暗くする_BitsByteAry()")
            Return True
        Catch
            MsgBox(ErrorToString)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩImage_Copy_or_Clone(ByRef 受img As Image, ByRef 送img As Image) As Boolean
        If 送img Is Nothing Then Return False
        If 受img Is Nothing Then
            受img = 送img.Clone
            'qqqqq("ⅩPctBoxImage_Copy_or_Clone() -- Make New Clone")
        Else
            Dim RET As Boolean = False : Dim WD As Integer = 送img.Width : Dim HT As Integer = 送img.Height
            If WD = 受img.Width And HT = 受img.Height Then
                RET = ⅩImage全域StrechCopy(受img, 送img)
                'If RET Then qqqqq("ⅩPctBoxImage_Copy_or_Clone() -- Image Copy")
            End If
            If Not RET Then
                受img.Dispose()
                受img = 送img.Clone
                'qqqqq("ⅩPctBoxImage_Copy_or_Clone() -- Size Change ... Make Clone")
            End If
        End If
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩPictreBox_Image_再作成(ByRef wPict As PictureBox, ByRef rWD As Integer, ByRef rHT As Integer) As Boolean
        If wPict Is Nothing Then Return False
        If rWD < 1 Or rHT < 1 Then Return False
        Try
            If wPict.Image IsNot Nothing Then
                If rWD = wPict.Image.Width And rHT = wPict.Image.Height Then
                    'chknnn = chknnn + 1 : qqqqq(CStr(chknnn) & " ●●●サイズ変更なし　ⅩPictreBox_Image_再作成()")
                    Return True
                End If
                wPict.Image.Dispose()
                wPict.Image = Nothing
            End If

            '2023/03/26 change ************************************
            'wPict.Image = New Bitmap(rWD, rHT, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
            Dim g As Graphics = wPict.CreateGraphics
            If g Is Nothing Then Return False
            wPict.Image = New Bitmap(rWD, rHT, g)
            g.Dispose()

            Return True
        Catch ex As Exception
            MsgBox("ERROR in ⅩPictreBox_Image_再作成()" & vbCrLf & ex.Message)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩPictreBox_Image_再作成_OrderImage_指定(ByRef wPict As PictureBox, ByRef rWD As Integer, ByRef rHT As Integer, ByVal OrderImage As Image) As Boolean
        If wPict Is Nothing Then Return False
        If rWD < 1 Or rHT < 1 Then Return False
        Try
            If wPict.Image IsNot Nothing Then
                If rWD = wPict.Image.Width And rHT = wPict.Image.Height Then
                    'chknnn = chknnn + 1 : qqqqq(CStr(chknnn) & " ●●●サイズ変更なし　ⅩPictreBox_Image_再作成()")
                    Return True
                End If
                wPict.Image.Dispose()
                wPict.Image = Nothing
            End If
            '2023/03/26 change ************************************
            wPict.Image = New Bitmap(OrderImage, rWD, rHT)
            Return True
        Catch ex As Exception
            MsgBox("ERROR in ⅩPictreBox_Image_再作成()" & vbCrLf & ex.Message)
            Return False
        End Try
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩImage全域StrechCopy(ByRef uke As Image, ByRef oku As Image) As Boolean
        If uke Is Nothing Or oku Is Nothing Then Return False
        Dim g As Graphics = Graphics.FromImage(uke)
        If g Is Nothing Then Return False
        Dim 田 As Rectangle : 田.X = 0 : 田.Y = 0 : 田.Width = uke.Width : 田.Height = uke.Height
        g.DrawImage(oku, 田, 0, 0, oku.Width, oku.Height, GraphicsUnit.Pixel)
        g.Dispose()
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    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 RET As Boolean = False
            Dim brs As New SolidBrush(ⅩColor構造体_from_色値(Ⅹ色LONG値(ccc)))
            If brs Is Nothing Then
            Else
                g.FillRectangle(brs, left, top, WD, HT)
                brs.Dispose()
                RET = True
            End If
            g.Dispose()
            Return RET
        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) As Boolean
        If Img受 Is Nothing Then Return False
        'qqqqq("Ⅹ受けImage全域に_送Imageの選択領域を_Copy()")
        Return ⅩImage_Image_Copy(Img受, Img送, 0, 0, Img受.Width, Img受.Height, 送x, 送y, 送w, 送h)
    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
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩBmpMakeMaskBackColorSet(ByVal pctTmpHDC As Integer, ByVal rPxlWD As Integer, ByVal rPxlHT As Integer) As Integer
        'ウインドウに四角形ではない形の画像をコピーするため、 OR Copy + AND Copy　をするための画像を作成するビットマップを作る。
        '指定サイズの水平方向が二倍のビットマップを作り、水平方向に２分割して、黒字と白地の背景にして、ビットマップのハンドルを返す。
        '単独の画像のサイズ制限は１０ピクセル以上、４０００ピクセル以下。
        'pctTmpHDC は使用していないピクチャーボックスの　.hDC　を渡す。メモリー内にある　hDC　を渡すとインデックスカラーになる。
        Dim RetBMP As Integer = 0
        Dim NewMakeBMP, oldBmp As Integer
        Try
            If pctTmpHDC <> 0 Then
                If rPxlWD > 5 And rPxlWD <= 4000 And rPxlHT > 5 And rPxlHT <= 4000 Then
                    NewMakeBMP = CreateCompatibleBitmap(pctTmpHDC, rPxlWD * 2, rPxlHT)
                    If NewMakeBMP <> 0 Then
                        oldBmp = SelectObject(pctTmpHDC, NewMakeBMP)
                        If oldBmp <> 0 Then
                            Dim rc As RECT
                            If 0 <> SetRect(rc, 0, 0, rPxlWD, rPxlHT) Then
                                If ⅩRectDraw_White_Or_Black(pctTmpHDC, rc, 0) Then
                                    If 0 <> OffsetRect(rc, rPxlWD, 0) Then
                                        If ⅩRectDraw_White_Or_Black(pctTmpHDC, rc, 1) Then
                                            RetBMP = NewMakeBMP
                                        End If
                                    End If
                                End If
                            End If
                            gggint = SelectObject(pctTmpHDC, oldBmp) : oldBmp = 0
                        Else
                            gggint = DeleteObject(NewMakeBMP) : NewMakeBMP = 0
                        End If
                    Else
                        qqqqq("error in ⅩBmpMakeMaskBackColorSet()")
                    End If
                End If
            End If
        Catch
        End Try
        If RetBMP = 0 Then
            If oldBmp <> 0 And pctTmpHDC <> 0 Then gggint = SelectObject(pctTmpHDC, oldBmp)
            If NewMakeBMP <> 0 Then gggint = DeleteObject(NewMakeBMP)
            'Debug.Print "Error Not Made 移動描画用BMP in ⅩBmpMakeMaskBackColorSet()"
        End If
        Return RetBMP
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩBmpDrawMakeMask(ByRef hDC As Integer, ByRef bmp As Integer, ByRef rgn As Integer, ByRef Uxx As Integer, ByRef Uyy As Integer, ByRef op黒地に白抜き As Boolean) As Boolean
        If hDC = 0 Or bmp = 0 Or rgn = 0 Then Return False
        Dim oldBmp, RET As Integer
        RET = 0
        oldBmp = 0
        Try
            oldBmp = SelectObject(hDC, bmp)
            If oldBmp <> 0 Then
                If 0 <> SelectClipRgn(hDC, rgn) Then RET = FillRgn(hDC, rgn, GetStockObject(IIf(op黒地に白抜き, WHITE_BRUSH, BLACK_BRUSH)))
                gggint = SelectClipRgn(hDC, 0)
                gggint = SelectObject(hDC, oldBmp)
                oldBmp = 0
            End If
            Return (RET <> 0)
        Catch
            gggint = SelectClipRgn(hDC, 0)
            If oldBmp <> 0 Then gggint = SelectObject(hDC, oldBmp)
            MsgBox(ErrorToString())
        End Try
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩBmpDrawStretchBlt(ByRef HDC受け As Integer, ByRef bmp As Integer, ByRef Rgn画 As Integer, ByRef Rgn枠 As Integer, _
                ByRef 受x As Integer, ByRef 受y As Integer, ByRef 受WD As Integer, ByRef 受HT As Integer, _
                ByRef HDC送り As Integer, ByRef 送x As Integer, ByRef 送y As Integer, ByRef 送WD As Integer, ByRef 送HT As Integer, _
                Optional ByRef Brsh枠 As Integer = 0, Optional ByRef 枠幅実寸 As Integer = 0, Optional ByRef Brsh線 As Integer = 0, Optional ByRef 外枠幅実寸 As Integer = 0) As Boolean
        If HDC受け = 0 Or bmp = 0 Or Rgn画 = 0 Or 受WD = 0 Or 受HT = 0 Or HDC送り = 0 Or 送WD = 0 Or 送HT = 0 Then Return False
        Dim oldBmp, RET As Integer
        RET = 0
        oldBmp = 0
        Try
            oldBmp = SelectObject(HDC受け, bmp)
            If oldBmp <> 0 Then
                If 0 <> SelectClipRgn(HDC受け, Rgn画) Then
                    If 0 <> SetStretchBltMode(HDC受け, COLORONCOLOR) Then
                        RET = StretchBlt(HDC受け, 受x, 受y, 受WD, 受HT, HDC送り, 送x, 送y, 送WD, 送HT, SRCCOPY)
                        If RET <> 0 Then
                            If Brsh枠 <> 0 Then
                                If Rgn枠 <> 0 Then
                                    If 0 <> SelectClipRgn(HDC受け, Rgn枠) Then
                                        gggint = FillRgn(HDC受け, Rgn枠, Brsh枠)
                                        gggint = SelectClipRgn(HDC受け, Rgn画)
                                    End If
                                Else
                                    If 枠幅実寸 > 0 Then gggint = FrameRgn(HDC受け, Rgn画, Brsh枠, 枠幅実寸, 枠幅実寸)
                                End If
                            End If
                            If Brsh線 <> 0 And 外枠幅実寸 > 0 Then gggint = FrameRgn(HDC受け, Rgn画, Brsh線, 外枠幅実寸, 外枠幅実寸)
                        End If
                    End If
                    gggint = SelectClipRgn(HDC受け, 0)
                End If
                gggint = SelectObject(HDC受け, oldBmp)
                oldBmp = 0
            End If
            Return (RET <> 0)
        Catch
            gggint = SelectClipRgn(HDC受け, 0)
            If oldBmp <> 0 Then gggint = SelectObject(HDC受け, oldBmp)
            MsgBox(ErrorToString())
        End Try
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩBmpCopySelectRect(ByRef HDC受け As Integer, ByRef 受bmp As Integer, ByRef HDC送り As Integer, ByRef 送bmp As Integer, ByRef rc送り As RECT) As Boolean
        If HDC受け = 0 Or 受bmp = 0 Or HDC送り = 0 Or 送bmp = 0 Then Return False
        If 0 <> IsRectEmpty(rc送り) Then Return False
        Dim RET As Boolean = False
        Dim oldbmp受 As Integer = SelectObject(HDC受け, 受bmp)
        If oldbmp受 <> 0 Then
            Dim oldbmp送 As Integer = SelectObject(HDC送り, 送bmp)
            If oldbmp送 <> 0 Then
                With rc送り
                    RET = BitBlt(HDC受け, .lll, .ttt, .rrr - .lll, .bbb - .ttt, HDC送り, .lll, .ttt, SRCCOPY)
                End With
                gggint = SelectObject(HDC送り, oldbmp送)
            End If
            gggint = SelectObject(HDC受け, oldbmp受)
        End If
        Return RET
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩImage_描画長方形枠_線幅指定_ペン指定(ByRef img As Image, ByRef rc As RECT, ByRef ペン As Pen) As Boolean
        If img Is Nothing Then Return False
        If ペン Is Nothing Then Return False
        Dim g As Graphics = Graphics.FromImage(img)
        If g Is Nothing Then Return False
        g.DrawRectangle(ペン, rc.lll, rc.ttt, rc.rrr - rc.lll, rc.bbb - rc.ttt)
        g.Dispose()
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩImage_Draw_Lines_POINTAPI(ByVal g As Graphics, ByVal pts_0_max() As POINTAPI, ByVal ラインの色 As Color, ByVal ラインの幅 As Integer) As Boolean
        If g Is Nothing Then Return False
        Dim p As New Pen(ラインの色, ラインの幅)
        If p Is Nothing Then Return False
        Dim a, b As Integer
        For a = 0 To UBound(pts_0_max) - 1
            b = a + 1
            g.DrawLine(p, pts_0_max(a).X, pts_0_max(a).Y, pts_0_max(b).X, pts_0_max(b).Y)
        Next
        p.Dispose()
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ描画長方形枠_線幅指定(ByRef hDC As Integer, ByRef rc As RECT, Optional ByRef LineWidth As Integer = 1, Optional ByRef RightBottomDel As Integer = 0) As Boolean
        Dim a As Integer
        Dim pt As POINTAPI
        Dim rrc As RECT
        If hDC = 0 Then Return False
        If 0 <> CopyRect(rrc, rc) Then
            With rrc
                .rrr = .rrr - RightBottomDel '2014/01/10 add
                .bbb = .bbb - RightBottomDel '2014/01/10 add
                For a = 0 To LineWidth - 1
                    gggint = MoveToEx(hDC, .lll + a, .ttt + a, pt)
                    gggint = LineTo(hDC, .rrr - a, .ttt + a)
                    gggint = LineTo(hDC, .rrr - a, .bbb - a)
                    gggint = LineTo(hDC, .lll + a, .bbb - a)
                    gggint = LineTo(hDC, .lll + a, .ttt + a)
                Next
            End With
            Return True
        End If
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ描画長方形枠_線幅指定_ペン指定(ByRef hDC As Integer, ByRef rc As RECT, ByRef ペン As Integer, Optional ByRef LineWidth As Integer = 1, Optional ByRef RightBottomDel As Integer = 0) As Boolean
        Dim old As Integer, RET As Boolean
        If hDC = 0 Or ペン = 0 Then Return False
        old = SelectObject(hDC, ペン)
        If old <> 0 Then
            RET = Ⅹ描画長方形枠_線幅指定(hDC, rc, LineWidth, RightBottomDel)
            gggint = SelectObject(hDC, old)
            Return RET
        End If
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "描画"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ領域内をグラデーションカラーで描画(ByVal hDC As Integer, ByVal 描画RGN As Integer, ByVal 内領域分割数 As Integer, ByVal グラデ段階数 As Integer, ByVal 色 As Integer, ByVal 明るい色倍数_050_to_099 As Single, ByVal 内明るい外暗い As Boolean) As Boolean
        'グラデーションのメインカラーの明るさは、呼び出しもとで調整すること。
        'グラデーションのメインカラーの明るさは、呼び出しもとで調整すること。
        Dim a As Integer, b As Integer, n As Integer
        Dim Xライン幅 As Single, Yライン幅 As Single, 色配列(0) As Integer, 色配列TMP(0) As Integer, 明るい色 As Integer, ブラシ As Integer
        明るい色 = ⅩHalfColor明るくする(色, 明るい色倍数_050_to_099)
        If Ⅹ色グラデーション制作(色, 明るい色, グラデ段階数, 色配列) Then
            If 内明るい外暗い Then
                n = UBound(色配列) : ReDim 色配列TMP(n)
                For a = 1 To n : 色配列TMP(a) = 色配列(a) : Next
                For a = 1 To n : 色配列(a) = 色配列TMP(n - a + 1) : Next
            End If
            '------------------------------------------------------------------------
            Dim xx, yy, wd, ht As Integer
            gggbol = Ⅹリージョンの位置とサイズ(描画RGN, xx, yy, wd, ht, 0, 0)
            Xライン幅 = wd / 内領域分割数 / グラデ段階数
            Yライン幅 = ht / 内領域分割数 / グラデ段階数
            '------------------------------------------------------------------------
            ブラシ = CreateSolidBrush(色配列(1))
            If ブラシ <> 0 Then
                gggint = FillRgn(hDC, 描画RGN, ブラシ)
                gggint = DeleteObject(ブラシ)
            End If
            For n = 1 To グラデ段階数
                ブラシ = CreateSolidBrush(色配列(n))
                If ブラシ <> 0 Then
                    a = グラデ段階数 - n + 1
                    If n > 1 Then b = n - 1 Else b = n
                    gggint = FrameRgn(hDC, 描画RGN, ブラシ, Xライン幅 * a, Yライン幅 * a)
                    gggint = DeleteObject(ブラシ)
                End If
            Next
        End If
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩInvertRect_WndHandle(ByRef hWnd As IntPtr, ByRef rc As RECT, ByRef DoCall_API32_Validate_UpdateWindow As Boolean) As Integer
        Dim RET As Integer = 0
        If hWnd <> 0 Then
            Dim hDC As Integer = GetDC(hWnd)
            If hDC <> 0 Then
                RET = InvertRect(hDC, rc)
                ReleaseDC(hWnd, hDC)
                If DoCall_API32_Validate_UpdateWindow Then
                    gggint = ValidateRect(hWnd, rc)
                    gggint = UpdateWindow(hWnd)
                End If
            End If
        End If
        Return RET
    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()
                Return True
            End If
        Catch ex As Exception
            MsgBox("ERR in ⅩPictureBox_Cls()" & vbCrLf & ex.ToString)
        End Try
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "アイコン"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function IconPaint_32_16(ByVal g As Graphics, ByRef rIconFile As String, ByRef rIconIndex As Integer, ByRef Size_32_True_16_False As Boolean, ByRef x As Integer, ByRef y As Integer) As Boolean
        '2023/08/12 new 取得アイコンは必ず削除すること
        If g Is Nothing Then Return False
        Dim Bigs(0) As Integer : Dim Smls(0) As Integer
        Dim h As Integer = ExtractIconEx(rIconFile, rIconIndex, Bigs, Smls, 1)
        If Bigs(0) <> 0 And Smls(0) <> 0 Then
            Dim hicon As Integer = 0
            If Size_32_True_16_False = True Then
                If Smls(0) <> 0 Then Call DestroyIcon(Smls(0))
                hicon = Bigs(0)
            Else
                If Bigs(0) <> 0 Then Call DestroyIcon(Bigs(0))
                hicon = Smls(0)
            End If
            If hicon <> 0 Then
                Dim ic As Icon = System.Drawing.Icon.FromHandle(hicon)
                g.DrawIcon(ic, x, y)
                ic.Dispose()
                gggint = DestroyIcon(hicon)
                Return True
            End If
        End If
        Return False
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩIconFileNameIndexConv(ByRef rOp_1_ファイル名から文_2_文からファイル名 As Integer, ByRef rwIconFile As String, ByRef rwIconIndex As Integer) As String
        Dim a As Integer
        Select Case rOp_1_ファイル名から文_2_文からファイル名
            Case 1
                Return rwIconFile & " (" & CStr(rwIconIndex) & ")"
            Case Else
                a = InStr(rwIconFile, " (")
                If a = 0 Then Return ""
                rwIconIndex = Val(Mid(rwIconFile, a + 2)) 'アイコンファイル内での　インデックス
                Return VB.Left(rwIconFile, a - 1)  'アイコンファイル名
        End Select
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "色の操作"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩColorGradationAryByColor(ByVal OpCodeRGB As String, ByVal r中心色 As Integer, ByVal Div As Integer, ByRef wグラデーション色配列() As Integer, ByVal wグラデーション色配列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グラデーション色配列(wグラデーション色配列IDX_1_to_max)
        If Not Ⅹ色RGB値(r中心色, rr, gg, bb) Then Return False
        ReDim wグラデーション色配列(wグラデーション色配列IDX_1_to_max)
        n = wグラデーション色配列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 wグラデーション色配列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 Ⅹ色GradationColors5(ByRef FaceColor As Integer, ByRef c1c5() As Integer, ByRef div3456 As Integer) As Boolean
        '-----------------------------------------------------------------------------
        'Private Sub GradTest_Click()
        ''Ⅹ色GradationColors5 関数のテスト 2011/11/28   lblGradTest(0-5) のラベルが必要
        '    Static div3456 As Integer: Dim FaceColor As Integer, a As Integer, c1c5(5) As Integer
        '    FaceColor = vbWhite * Rnd
        '    div3456 = div3456 + 1
        '    If div3456 > 6 Or div3456 < 3 Then div3456 = 3
        '    GGGint = Ⅹ色GradationColors5(FaceColor, c1c5(), div3456)
        '    For a = 1 To 5: lblGradTest(a).BackColor = c1c5(a): Next
        '    lblGradTest(0).BackColor = FaceColor
        '    lblGradTest(1).ForeColor = vbWhite
        '    lblGradTest(1).Caption = "div3456 = " & CStr(div3456)
        'End Sub
        '-----------------------------------------------------------------------------
        'FaceColor  を中心にしてグラデーションの色をつくり　c1c5 ( 1 to 5 )　に入れる
        'c1c5()  ではインデックスが小さいほど暗く、インデックスが大きければ明るい。c1c5(3) = FaceColor return
        'div3456  では値が小さいほど全体のコントラストが強くなる。
        '-----------------------------------------------------------------------------
        Dim c, a, Div As Integer : Dim e As Boolean : Dim g1, b, r, g, r1, b1 As Integer
        gggint = Ⅹ色RGB値(FaceColor, r, g, b)
        Div = Ⅹ数値範囲Int(3, 6, div3456)
        Dim ddivv As Single
        For a = 1 To 5
            e = (a <= 3)
            c = IIf(e, 3 - a, a - 3)
            ddivv = c / Div
            r1 = Ⅹ数値範囲Int(0, 255, IIf(e, r - (r * ddivv), r + ((255 - r) * ddivv)))
            g1 = Ⅹ数値範囲Int(0, 255, IIf(e, g - (g * ddivv), g + ((255 - g) * ddivv)))
            b1 = Ⅹ数値範囲Int(0, 255, IIf(e, b - (b * ddivv), b + ((255 - b) * ddivv)))
            c1c5(a) = RGB(r1, g1, b1)
        Next
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩColor_to_INT(ByVal Color構造体 As Color) As Integer
        Return System.Drawing.ColorTranslator.ToWin32(Color構造体)
    End Function
    Function ⅩColor_from_INT(ByVal 色 As Integer) As Color
        Return System.Drawing.ColorTranslator.FromWin32(色)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩColor構造体_to_色値(ByVal Color構造体 As Color) As Integer
        Return System.Drawing.ColorTranslator.ToWin32(Color構造体)
    End Function
    Function ⅩColor構造体_from_色値(ByVal 色 As Integer) As Color
        Return System.Drawing.ColorTranslator.FromWin32(色)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩHalfColor明るくする(ByRef ccc As Integer, ByRef 倍数_02_to_09 As Single) As Integer
        Dim 赤, 緑, 青 As Integer
        gggint = Ⅹ色RGB値(ccc, 赤, 緑, 青)
        Dim bai As Single = Ⅹ数値範囲Sng(0.2!, 0.9!, 倍数_02_to_09)
        Dim baiii As Single = 1.0! - bai
        Dim sft As Integer = 255 * bai
        Dim 赤赤 As Integer = Math.Min(255, sft + 赤 * baiii)
        Dim 緑緑 As Integer = Math.Min(255, sft + 緑 * baiii)
        Dim 青青 As Integer = Math.Min(255, sft + 青 * baiii)
        'If 赤赤 < 128 Or 緑緑 < 128 Or 青青 < 128 Then
        '    qqqqq("ⅩHalfColor明るくする()  < 128")
        'End If
        Return RGB(赤赤, 緑緑, 青青)
    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 c As Integer, ByRef 倍数_050_to_099 As Single) As Integer
        Dim g, r, b As Integer
        gggint = Ⅹ色RGB値(c, r, g, b)
        Return RGB(r + (255 - r) * 倍数_050_to_099, g + (255 - g) * 倍数_050_to_099, b + (255 - b) * 倍数_050_to_099)
    End Function
    Function Ⅹ色RndColor(Optional ByVal 暗くする_0_to_1 As Single = 1.0) As Integer
        Dim g, r, b As Integer
        Randomize()
        r = Ⅹ数値範囲Int(0, 255, Rnd() * 255)
        g = Ⅹ数値範囲Int(0, 255, Rnd() * 255)
        b = Ⅹ数値範囲Int(0, 255, Rnd() * 255)
        If 暗くする_0_to_1 < 1.0 Then
            Dim n As Single = Math.Max(0.01, Math.Min(0.99, 暗くする_0_to_1))
            r = CInt(CSng(r) * n)
            g = CInt(CSng(g) * n)
            b = CInt(CSng(b) * n)
        End If
        Return RGB(r, g, b)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ色RndColor_BrushMake() As Integer
        Dim ccc As Integer = Ⅹ色RndColor()
        Dim brs As Integer = CreateSolidBrush(ccc)
        Return brs
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ色の値の検査修正値(ByVal ColorValOrIndex As Integer) As Integer
        'ColorValOrIndex = カラー実効値あるいはシステムカラーインデックス
        If ColorValOrIndex < 0 Then
            If ColorValOrIndex > &H80000018 Then
                Return &H80000018
            ElseIf ColorValOrIndex < &H80000000 Then
                Return &H80000000
            Else
                Return ColorValOrIndex
            End If
        Else
            If ColorValOrIndex > &HFFFFFF Then Return &HFFFFFF Else Return ColorValOrIndex
        End If
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ色グラデーション制作(ByVal r色1 As Integer, ByVal r色2 As Integer, ByVal r段階数 As Integer, ByRef w色配列() As Integer) As Boolean
        '2021/03/21 chg   '2018/09/14  new
        'r段階数 = 3 to 50
        Dim g2, b1, r1, g, a, r, b, g1, r2, b2 As Integer
        Dim Div, bai As Single
        Dim gg基底, bb差, rr差, gg差, rr基底, bb基底 As Integer
        If r段階数 < 3 Or r段階数 > 50 Then Return False
        gggint = Ⅹ色RGB値(r色1, r1, g1, b1)
        gggint = Ⅹ色RGB値(r色2, r2, g2, b2)
        Div = Ⅹ数値範囲Int(2, 49, r段階数 - 1)
        ReDim w色配列(r段階数)
        rr差 = r2 - r1 : rr基底 = r1
        gg差 = g2 - g1 : gg基底 = g1
        bb差 = b2 - b1 : bb基底 = b1
        w色配列(1) = RGB(r1, g1, b1)
        For a = 1 To Div
            bai = (a / Div)
            r = Ⅹ数値範囲Int(0, 255, rr基底 + rr差 * bai)
            g = Ⅹ数値範囲Int(0, 255, gg基底 + gg差 * bai)
            b = Ⅹ数値範囲Int(0, 255, bb基底 + bb差 * bai)
            w色配列(a + 1) = RGB(r, g, b)
        Next
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹ色をぼかすOnEnabledOff(ByVal rEnabled As Boolean, ByVal ColorObj As Color) As Color
        Dim gg, rr, bb As Integer
        If rEnabled Then
            Return ColorObj
        Else
            Dim ccc As Integer = ⅩColor_to_INT(ColorObj)
            gggint = Ⅹ色RGB値(ccc, rr, gg, bb)
            ccc = RGB(rr + (255 - rr) \ 2, gg + (255 - gg) \ 2, bb + (255 - bb) \ 2)
            Return ⅩColor_from_INT(ccc)
        End If
    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 ⅩControlCenterXY(ByVal cont As Control, ByRef wCX As Integer, ByRef wCY As Integer) As Boolean
        If cont Is Nothing Then Return False
        With cont
            wCX = .Left + (.Width \ 2)
            wCY = .Top + (.Height \ 2)
        End With
        Return True
    End Function
#End Region

#Region "RECT操作"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩRect_RectAngle_交換_配列(ByVal RECT_から_RectAngle_へコピーは_0 As Integer, ByRef rc() As RECT, ByRef rang() As Rectangle) As Boolean
        Dim max As Integer
        If RECT_から_RectAngle_へコピーは_0 = 0 Then
            max = UBound(rc)
            If max < 0 Then Return False
            ReDim rang(max)
        Else
            max = UBound(rang)
            If max < 0 Then Return False
            ReDim rc(max)
        End If
        For a As Integer = 0 To max
            gggbol = ⅩRect_RectAngle_交換(RECT_から_RectAngle_へコピーは_0, rc(a), rang(a))
        Next
        Return True
    End Function
    Function ⅩRect_RectAngle_交換(ByVal RECT_から_RectAngle_へコピーは_0 As Integer, ByRef rc As RECT, ByRef rang As Rectangle) As Boolean
        If RECT_から_RectAngle_へコピーは_0 = 0 Then
            With rc
                rang.X = .lll : rang.Y = .ttt : rang.Width = .rrr - .lll : rang.Height = .bbb - .ttt
            End With
        Else
            With rang
                rc.lll = .Left : rc.ttt = .Top : rc.rrr = .Right : rc.bbb = .Bottom
            End With
        End If
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    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
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩRectDraw_White_Or_Black(ByRef hDC As Long, ByRef rc As RECT, ByVal White1_Black0 As Integer) As Integer
        Dim hbr As Long
        If hDC <> 0 Then
            hbr = GetStockObject(IIf(White1_Black0 = 1, WHITE_BRUSH, BLACK_BRUSH))
            If hbr <> 0 Then
                Return FillRect(hDC, rc, hbr)
            End If
        End If
        Return 0
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩRectIntoBigRect(ByRef rc As RECT, ByRef rcbig As RECT) As Boolean
        ⅩRectIntoBigRect = False
        If ⅩRect幅(rc) > ⅩRect幅(rcbig) Or ⅩRect高(rc) > ⅩRect高(rcbig) Then Return False
        If rc.lll < rcbig.lll Then
            gggint = OffsetRect(rc, rcbig.lll - rc.lll, 0)
        ElseIf rc.rrr > rcbig.rrr Then
            gggint = OffsetRect(rc, rcbig.rrr - rc.rrr, 0)
        End If
        If rc.ttt < rcbig.ttt Then
            gggint = OffsetRect(rc, 0, rcbig.ttt - rc.ttt)
        ElseIf rc.bbb > rcbig.bbb Then
            gggint = OffsetRect(rc, 0, rcbig.bbb - rc.bbb)
        End If
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "リージョン操作"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹリージョンの位置とサイズ(ByVal hRgn As Integer, ByRef w左 As Integer, ByRef w上 As Integer, ByRef w幅 As Integer, ByRef w高 As Integer, ByVal r加減_幅 As Integer, ByVal r加減_高 As Integer) As Boolean
        w左 = 0
        w上 = 0
        w幅 = 0
        w高 = 0
        If hRgn = 0 Then Return False
        Dim rc As RECT
        gggint = GetRgnBox(hRgn, rc)
        If gggint = NULLREGION Then Return False
        w左 = rc.lll
        w上 = rc.ttt
        w幅 = ⅩRect幅(rc) + r加減_幅
        w高 = ⅩRect高(rc) + r加減_高
        Return True
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹリージョンcopy(ByVal hRgn As Integer, ByVal Do_OffSet_LeftTop_to_0 As Boolean) As Integer
        If hRgn = 0 Then Return 0
        Dim hNew As Integer = CreateRectRgn(0, 0, 1, 1)
        If hNew = 0 Then Return 0
        Dim aaa As Integer = CombineRgn(hNew, hRgn, hRgn, RGN_COPY)
        If aaa > NULLREGION Then
            If Do_OffSet_LeftTop_to_0 Then
                Dim rc As RECT
                gggint = GetRgnBox(hRgn, rc)
                gggint = OffsetRgn(hNew, -rc.lll, -rc.ttt)
            End If
            Return hNew
        ElseIf aaa = NULLREGION Then  '1 NULLREGION  新しく作成されたリージョンは､ 空のリージョンです。
            If hNew <> 0 Then DeleteObject(hNew)
            Return 0
        Else            '0 ERROR  リージョンは新しく作成されませんでした。
            If hNew <> 0 Then DeleteObject(hNew)
            Return 0
        End If
        '' '' 1 NULLREGION	    新しく作成されたリージョンは､ 空のリージョンです。
        '' '' 2 SIMPLEREGION	新しく作成されたリージョンは､ 境界が重なっていません。
        '' '' 3 COMPLEXREGION	新しく作成されたリージョンは､ 1つ以上の長方形です。
        '' '' 0 ERROR	        リージョンは新しく作成されませんでした。
    End Function
    '    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "メニュー"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function Ⅹメニュー配列作成_1_20(ByRef wMenuAry() As ToolStripMenuItem, ByRef m01 As ToolStripMenuItem, _
            Optional ByRef m02 As ToolStripMenuItem = Nothing, Optional ByRef m03 As ToolStripMenuItem = Nothing, Optional ByRef m04 As ToolStripMenuItem = Nothing, Optional ByRef m05 As ToolStripMenuItem = Nothing, _
            Optional ByRef m06 As ToolStripMenuItem = Nothing, Optional ByRef m07 As ToolStripMenuItem = Nothing, Optional ByRef m08 As ToolStripMenuItem = Nothing, Optional ByRef m09 As ToolStripMenuItem = Nothing, Optional ByRef m10 As ToolStripMenuItem = Nothing, _
            Optional ByRef m11 As ToolStripMenuItem = Nothing, Optional ByRef m12 As ToolStripMenuItem = Nothing, Optional ByRef m13 As ToolStripMenuItem = Nothing, Optional ByRef m14 As ToolStripMenuItem = Nothing, Optional ByRef m15 As ToolStripMenuItem = Nothing, _
            Optional ByRef m16 As ToolStripMenuItem = Nothing, Optional ByRef m17 As ToolStripMenuItem = Nothing, Optional ByRef m18 As ToolStripMenuItem = Nothing, Optional ByRef m19 As ToolStripMenuItem = Nothing, Optional ByRef m20 As ToolStripMenuItem = Nothing) As Integer
        'メニュー配列を作る　　wMenuAry(1～20)  1　から　20まで　最大インデックスを返す。
        ReDim wMenuAry(0)
        wMenuAry(0) = Nothing
        If m01 Is Nothing Then Return 0
        ReDim wMenuAry(20) : Dim cur As Integer = 0 : Dim max As Integer = 0
        max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m01)
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m02) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m03) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m04) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m05) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m06) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m07) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m08) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m09) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m10) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m11) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m12) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m13) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m14) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m15) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m16) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m17) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m18) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m19) Else Return cur
        If max = -1 Then max = Ⅹメニュー配列作成_1_20_SUB(wMenuAry, cur, m20) Else Return cur
        Return cur
    End Function
    Function Ⅹメニュー配列作成_1_20_SUB(ByRef wMenuAry() As ToolStripMenuItem, ByRef rwCur As Integer, ByRef rmnu As ToolStripMenuItem) As Integer
        If rmnu IsNot Nothing Then
            rwCur = rwCur + 1 : wMenuAry(rwCur) = rmnu : Return -1
        Else
            ReDim Preserve wMenuAry(rwCur) : Return rwCur
        End If
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

#Region "MsgBox"
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩMsgBox_Yes_TRUE_No_FALSE(ByVal title As String, ByVal msg As String) As Boolean
        Return (MsgBox(msg, MsgBoxStyle.OkCancel, title) = MsgBoxResult.Ok)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Sub ⅩMsgBox_OK_情報(ByVal msgstr As String)
        MsgBox(msgstr, MsgBoxStyle.OkOnly Or MsgBoxStyle.Information)
    End Sub
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Sub ⅩMsgBox_OK_注意(ByVal msgstr As String)
        MsgBox(msgstr, MsgBoxStyle.OkOnly Or MsgBoxStyle.Exclamation)
    End Sub
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
    Function ⅩMsgBox_アプリ終了しますか() As Boolean
        Dim s As String = ⅩAppタイトル名()
        Return (MsgBox(s & gggCR2 & "このアプリを終了しますか", MsgBoxStyle.OkCancel, s) = MsgBoxResult.Ok)
    End Function
    Function ⅩMsgBox_アプリ終了しますか(ByVal Appタイトル As String) As Boolean
        Return (MsgBox(Appタイトル & "    ( " & ⅩAppEXEのフルパスファイル名() & " )" & gggCR2 & "このアプリを終了しますか ？", MsgBoxStyle.OkCancel, Appタイトル) = MsgBoxResult.Ok)
    End Function
    '●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●●
#End Region

End Module
