Option Strict Off
Option Explicit On
'------------------------------------ 2023/11/09 ------------------------------------
Public Class 五clsIconShowBox

#Region "宣言"
    Private Const MeIDS As String = "五clsIconShowBox"
    Private 目IconWnd As 五clsScrolRectWnd
    Private Structure ICONFILEDATA
        Dim f As String
        Dim I As Integer
    End Structure
    Private mIcoData() As ICONFILEDATA
    Private mCurfile As String
    Private mCurIconIndex As Integer
    Private mCurPath As String
    Private mShowingMax As Integer
    Private mCurListIndex As Integer
    Private mPct座標ズレX As Integer = 0, mPct座標ズレY As Integer = 0
    Private mpico_picoCur_Y_Offset As Integer = 0
#End Region

#Region "New ....Finalize"

    Public Sub New()
        MyBase.New()
        ReDim mIcoData(0)
        mShowingMax = 0
        Call IcoCurClear(Nothing)
        目IconWnd = New 五clsScrolRectWnd
        'Debug.Print "三cIconShowBox--Class_Initialize" 'OK/2004/07/15
    End Sub

    Protected Overrides Sub Finalize()
        目IconWnd = Nothing
        MyBase.Finalize()
    End Sub

#End Region

#Region "関数"

    Friend Function CurIconCopy(ByRef pctShow As PictureBox, ByRef uke As PictureBox, ByRef ukeX As Integer, ByRef ukeY As Integer) As Boolean
        If pctShow.Image Is Nothing Or uke.Image Is Nothing Then
            qqqqq("ERROR in CurIconCopy() pct.Image Nothing !!")
            Return False
        End If
        Dim rrr, lll, ttt, bbb, www, hhh As Integer
        CurIconCopy = False
        If CurListIndex > 0 Then
            If 目IconWnd.ItemRectSize(CurListIndex, lll, ttt, rrr, bbb) Then
                www = rrr - lll
                hhh = bbb - ttt
                Return ⅩImage_Image_Copy(uke.Image, pctShow.Image, ukeX, ukeY, www, hhh, lll, ttt, www, hhh)
            End If
        End If
        Return False
    End Function

    Friend Function CurColCount() As Integer
        CurColCount = 目IconWnd.CurColCount
    End Function

    Friend Function FileLabelGetSet(ByRef Get1_Set2 As Integer, ByRef rPathWithIndex As String, ByRef rwlblFile As Label) As String
        Try
            Select Case Get1_Set2
                Case 1 'get
                    If rwlblFile.Text <> "" Then FileLabelGetSet = rwlblFile.Tag Else FileLabelGetSet = ""
                Case 2 'set
                    If rPathWithIndex = "" Then
                        rwlblFile.Text = ""
                        rwlblFile.Tag = ""
                    Else
                        'パス文字列の長さを表示サイズに合わせてカットして　...　をつける。
                        Dim MaxWD As Single : Dim n As Integer : Dim PathStr As String
                        If rPathWithIndex = "*" Then
                            n = CurListIndex
                            If n < 1 Then Return ""
                            PathStr = ⅩIconFileNameIndexConv(1, mCurPath & mIcoData(n).f, mIcoData(n).I)
                        Else
                            PathStr = rPathWithIndex
                        End If
                        MaxWD = rwlblFile.Width * 0.98
                        Dim retstr As String = ⅩPathStrCutDispSize(rwlblFile, MaxWD, PathStr)
                        rwlblFile.Text = retstr
                        rwlblFile.Tag = PathStr
                        Return retstr
                    End If
                    'rwlblFile.ToolTipText = rwlblFile.Tag
                    'qqqqq "rwlblFile.Tag = " + rwlblFile.Tag
            End Select
        Catch ex As Exception
            MsgBox(ex.ToString)
        End Try
        Return ""
    End Function

    Friend Property CurListIndex(Optional ByVal rpico As PictureBox = Nothing, Optional ByVal rpicoCur As PictureBox = Nothing, Optional ByVal lblFile As Label = Nothing, Optional ByVal btnOK As Button = Nothing, Optional ByVal btnOKenAdd As Boolean = True) As Integer
        '選択されているアイコン／イメージのリストインデックス
        Get
            Return mCurListIndex
        End Get
        Set(ByVal Value As Integer)
            mCurListIndex = Value
            Call SetCurBox(rpico, rpicoCur)
            Dim wHeight, wTop, wleft, wWidth, c As Integer
            If 目IconWnd.GetPostAndSize(mCurListIndex, wleft, wTop, wWidth, wHeight, c) Then
                Dim g As Graphics = Graphics.FromImage(rpicoCur.Image)
                If Not g Is Nothing Then
                    g.Clear(rpicoCur.BackColor)
                    g.Dispose()
                End If
                Dim n As Integer = (rpicoCur.Width - wWidth) \ 2
                gggbol = ⅩImage_Image_Copy(rpicoCur.Image, rpico.Image, n + 1, n + 1, wWidth - 2, wHeight - 2, wleft + 1, wTop + 1, wWidth - 2, wHeight - 2)
            End If
        End Set
    End Property

    Friend ReadOnly Property ItemCount() As Integer
        Get
            Return mShowingMax
        End Get
    End Property

    Friend Function GetListIndex(Optional ByRef rIconLabelStr As String = "", Optional ByRef rFile As String = "", Optional ByRef rIconIndex As Integer = 0) As Integer
        Try
            Dim a As Integer
            Dim s1, s2 As String
            s1 = UCase(rIconLabelStr)
            s2 = UCase(rFile)
            For a = 1 To mShowingMax
                If s1 <> "" Then
                    If s1 = UCase(ⅩIconFileNameIndexConv(1, mCurPath & mIcoData(a).f, mIcoData(a).I)) Then
                        Return a
                    End If
                ElseIf s2 <> "" Then
                    If s2 = UCase(mCurPath & mIcoData(a).f) And rIconIndex = mIcoData(a).I Then
                        Return a
                    End If
                Else
                    Return 0
                End If
            Next
            Return 0
        Catch ex As Exception
            MsgBox(ex.ToString)
            Return 0
        End Try
    End Function
    '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
    Friend Function HitTest(ByRef X As Single, ByRef Y As Single) As Integer
        Return 目IconWnd.HitTest(X, Y)
    End Function
    '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
    Friend Function SetCurBox(ByRef rpico As PictureBox, ByRef rpicoCur As PictureBox) As Boolean
        gggbol = zzSetCurBox(rpico, rpicoCur, mCurListIndex)
    End Function
    '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
    Private Function zzSetCurBox(ByRef rpico As PictureBox, ByRef rpicoCur As PictureBox, ByRef rListIndex As Integer, Optional ByRef UserColumn As Integer = 0) As Boolean
        Dim wHeight, wTop, wleft, wWidth As Integer
        If rListIndex = 0 Then
            rpicoCur.Visible = False
        ElseIf 目IconWnd.GetPostAndSize(rListIndex, wleft, wTop, wWidth, wHeight, UserColumn) Then
            Dim sfxy As Integer = 3
            Dim wwhh As Integer = wWidth + 6
            rpicoCur.SetBounds(mPct座標ズレX + wleft - sfxy, mPct座標ズレY + wTop + rpico.Top - sfxy, wwhh, wwhh, BoundsSpecified.All)
            mpico_picoCur_Y_Offset = rpicoCur.Top - rpico.Top
            rpicoCur.Visible = True
        Else
            rpicoCur.Visible = False
        End If
        Return True
    End Function
    '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
    Friend Function StartSizeSeting(ByRef pctBack As Panel, ByRef pctShow As PictureBox, ByRef vsbScroBar As VScrollBar, Optional ByRef SizeX As Integer = 32, Optional ByRef SizeY As Integer = 32, Optional ByRef SpaceXY As Integer = 4, Optional ByRef rPct座標ズレX As Integer = 0, Optional ByRef rPct座標ズレY As Integer = 0) As Boolean
        mPct座標ズレX = rPct座標ズレX
        mPct座標ズレY = rPct座標ズレY
        Call 目IconWnd.StartSizeSeting(pctBack, pctShow, vsbScroBar, SizeX, SizeY, SpaceXY)
        ReDim mIcoData(0)
        mShowingMax = 0
        Call IcoCurClear(Nothing)
        Return True
    End Function
    '■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
    Friend Function IconsShow(ByRef Parent As Control, ByRef コピー元イメージ As Image, ByRef path As String, ByRef files() As String, _
                                ByRef pctBack As Panel, ByRef pctShow As PictureBox, ByRef vsbScroBar As VScrollBar, _
                                Optional ByRef lblFile As Label = Nothing, Optional ByRef btnOK As Button = Nothing, _
                                Optional ByRef Over1000Msg As String = "", Optional ByRef OverMsgTitle As String = "") As Integer
        Dim m, a, max, b, n As Integer : Dim IcoFile As String, IcoIndex As Integer
        Try
            m = UBound(files)
            If path <> "" And m > 0 Then
                Call zzIcoListAllClearReset(1, pctBack, pctShow, vsbScroBar, lblFile, btnOK)
                max = 0
                mCurPath = Ⅹパスセパレータ付加(path)
                For a = 1 To m
                    IcoFile = files(a)
                    If InStr(IcoFile, "\") > 0 Then 'If FullPath
                        IcoFile = Ⅹフルパス名からファイル名あるいは最後のフォルダ名を得る(files(a), False)
                    End If
                    If Right(IcoFile, 4) = ".ico" Then
                        IcoIndex = 0
                        gggbol = IconsShow_SUB_addiconfile(max, IcoFile, IcoIndex)
                    Else
                        n = zzggⅩIconCountInFile(mCurPath & IcoFile)
                        For b = 1 To n
                            IcoIndex = b - 1
                            gggbol = IconsShow_SUB_addiconfile(max, IcoFile, IcoIndex)
                        Next
                    End If
                Next
                If max > 1000 Then
                    If Over1000Msg <> "" Then MsgBox(Over1000Msg, 48, OverMsgTitle)
                End If
                max = Math.Min(1000, max)
                ReDim Preserve mIcoData(max)
                mShowingMax = zzFrameSizeSetIconDraw(Parent, コピー元イメージ, pctBack, pctShow, vsbScroBar)
            Else
                Call zzIcoListAllClearReset(0, pctBack, pctShow, vsbScroBar, lblFile, btnOK)
            End If
            pctShow.Refresh()
            Return mShowingMax
        Catch ex As Exception
            MsgBox(ex.ToString())
            Return mShowingMax
        End Try
    End Function
    Private Function IconsShow_SUB_addiconfile(ByRef max As Integer, ByVal IcoFile As String, ByVal IcoIndex As Integer) As Boolean
        max = max + 1
        If max > UBound(mIcoData) Then ReDim Preserve mIcoData(UBound(mIcoData) + 50)
        mIcoData(max).f = IcoFile
        mIcoData(max).I = IcoIndex
        Return True
    End Function

    Private Function zzFrameSizeSetIconDraw(ByRef Parent As Control, ByRef コピー元イメージ As Image, ByRef pctBack As Panel, ByRef pctShow As PictureBox, ByRef vsbScroBar As VScrollBar) As Integer
        Dim mmm As Integer = 0
        Try
            Dim max As Integer = UBound(mIcoData)
            If 目IconWnd.SetSize(pctBack, pctShow, vsbScroBar, max, True) Then
                Dim wd As Integer = pctShow.ClientRectangle.Width
                Dim ht As Integer = pctShow.ClientRectangle.Height
                If ⅩPictreBox_Image_再作成_OrderImage_指定(pctShow, wd, ht, コピー元イメージ) Then
                    Dim g As Graphics = Graphics.FromImage(pctShow.Image)
                    If Not g Is Nothing Then
                        g.Clear(Color.White)
                        Dim X, Y As Integer
                        For a As Integer = 1 To max
                            If 目IconWnd.GetPostXY(a, X, Y) Then
                                If IconPaint_32_16(g, mCurPath & mIcoData(a).f, mIcoData(a).I, True, X, Y) Then
                                    mmm = mmm + 1
                                Else
                                    mIcoData(a).f = "" : mIcoData(a).I = -1
                                End If
                            End If
                        Next
                        g.Dispose()
                    Else
                        'error
                    End If
                End If
            Else
                'error
            End If
            'qqqqq "zzFrameSizeSetIconDraw()"
        Catch ex As Exception
            MsgBox("ERROR in zzFrameSizeSetIconDraw() " & vbCrLf & ex.ToString)
        End Try
        Return mmm
    End Function

    Private Function zzIcoListAllClearReset(ByRef op As Integer, ByRef pctBack As Panel, ByRef pctShow As PictureBox, ByRef vsbScroBar As VScrollBar, ByRef lblFile As Label, ByRef btnOK As Button) As Boolean
        If UBound(mIcoData) = 0 Then Return False
        ReDim mIcoData(0)
        mShowingMax = 0
        mCurfile = ""
        mCurIconIndex = 0
        mCurPath = ""
        mShowingMax = 0
        mCurListIndex = 0
        gggbol = ⅩPictureBox_Cls(pctShow)
        Call IcoCurClear(lblFile, btnOK)
        If op = 0 Then
            Call 目IconWnd.StartSizeSeting(pctBack, pctShow, vsbScroBar, -1, -1)
            Call 目IconWnd.VscbarSet(pctBack, vsbScroBar, True)
            'qqqqq "zzIcoListAllClearReset"
        End If
        Return True
    End Function

    Friend Function aa_mpico_picoCur_Y_Offset() As Integer
        Return mpico_picoCur_Y_Offset
    End Function

    Friend Function Event_VscbarChange(ByRef rpico As PictureBox, ByRef rpicoCur As PictureBox, ByRef vsbScroBar As VScrollBar) As Boolean
        Return 目IconWnd.Event_VscbarChange(rpico, vsbScroBar)
    End Function

    Friend Function VscbarSet(ByRef pctBack As Panel, ByRef vsbScroBar As VScrollBar, ByRef BarReset As Boolean) As Boolean
        Return 目IconWnd.VscbarSet(pctBack, vsbScroBar, BarReset)
    End Function

    Friend Function IcoCurClear(Optional ByRef lblFile As Label = Nothing, Optional ByRef btnOK As Button = Nothing) As Boolean
        mCurListIndex = 0
        mCurfile = ""
        mCurIconIndex = -1
        If Not lblFile Is Nothing Then
            Call FileLabelGetSet(2, "", lblFile)
        End If
        If Not btnOK Is Nothing Then btnOK.Enabled = False
        Return True
    End Function

    Friend Function CurIconData(ByRef wIconFileFullName As String, ByRef wIconFilePath As String, ByRef wIconFileTitle As String, ByRef wIconFileIndex As Integer) As Boolean
        If mCurfile = "" Or mCurIconIndex < 0 Then Return False
        wIconFileFullName = mCurPath & mCurfile
        wIconFilePath = Ⅹパスセパレータ削除(mCurPath)
        wIconFileTitle = mCurfile
        wIconFileIndex = mCurIconIndex
        Return True
    End Function

    Function zzggⅩIconCountInFile(ByRef rIconFile As String) As Integer
        If Ⅹファイルは存在(rIconFile) = False Then Return 0
        Try
            Dim Bigs(0) As Integer : Dim Smls(0) As Integer
            Return ExtractIconEx(rIconFile, -1, Bigs, Smls, 1)
        Catch ex As Exception
            Return 0
        End Try
    End Function

#End Region

End Class

'Dim g As Graphics = Graphics.FromImage(pct00000000.Image)
'If Not g Is Nothing Then
'    g.Clear(pct00000000.BackColor)
'    Dim hdc As Integer = g.GetHdc
'    If hdc <> 0 Then
'        For nnnnnn as integer = 1 To nnnnnnMax

'           描画コード ******************

'        Next
'        g.ReleaseHdc(hdc)
'    End If
'    g.Dispose()
'End If