Option Strict Off
Option Explicit On
Imports System.Windows.Forms
'------------------------------------ 2023/11/09 ------------------------------------
Friend Class 五clsPctFileOpenWithBuff

#Region "宣言"
    '***********************************************************************
    '2022/09/22 アプリケーションで　一つだけ作ること。アプリ内のすべてのユーザーで　共用すること。
    Private Structure PctFileBuff
        Dim Fname As String
        Dim ImgObj As Image
        Dim FileBmpWD As Integer
        Dim FileBmpHT As Integer
    End Structure
    Private mBUFF(0) As PctFileBuff
    Private mAryMax As Integer 'mBUFF(1 to mARYMAXALL)
    '***********************************************************************
#End Region

#Region "New ....Finalize"
    '***********************************************************************
    Public Sub New()
        MyBase.New()
        gggint = aaStartSet(1)
        'qqqqq "五clsPctFileOpenWithBuff--Class_Initialize"
    End Sub
    '***********************************************************************
    Protected Overrides Sub Finalize()
        Dim a As Integer
        ''-------------------------------------------------------------------
        'qqqqq "五clsPctFileOpenWithBuff--Class_Terminate"
        ''-------------------------------------------------------------------
        For a = 0 To UBound(mBUFF) : gggint = zzAryItemClear(mBUFF(a)) : Next
        '-------------------------------------------------------------------
        MyBase.Finalize()
    End Sub
    '***********************************************************************
#End Region

#Region "関数"
    '***********************************************************************
    Friend Function aaStartSet(ByRef rAryMax As Integer) As Boolean
        'アプリスタート時に、ただ一度だけの初期化を実行する
        If rAryMax > 2000 Or rAryMax < 1 Then
            Call ⅩMsgBox_OK_注意("五clsPctFileOpenWithBuff で使用できるファイル数は、" & vbCrLf & "１枚　～　２０００枚　までです。")
            Return False
        End If
        mAryMax = rAryMax : ReDim mBUFF(mAryMax)
        Dim a As Integer
        For a = 1 To mAryMax
            mBUFF(a).ImgObj = Nothing : gggint = zzAryItemClear(mBUFF(a))
        Next
        Return True
    End Function
    '***********************************************************************
    Private Function zzAryItemClear(ByRef obj As PctFileBuff) As Boolean
        With obj
            If .ImgObj IsNot Nothing Then
                .ImgObj.Dispose()
                'qqqqq "五clsPctFileOpenWithBuff--zzAryItemClear() - DeleteObject(.ImgObj)"
            End If
            .Fname = "" : .FileBmpWD = 0 : .FileBmpHT = 0
        End With
        Return True
    End Function
    '***********************************************************************
    Friend Function aaアプリ専用ファイルはすべて読込まれている(ByRef rStrファイル群の名前() As String, ByRef rNewImgWD As Integer, ByRef rNewImgHT As Integer, ByRef wファイル群の数 As Integer, ByRef w読み込み済み数 As Integer) As Boolean
        '2023/06/012  同じファイルでも、BitMap としてのサイズ  rNewImgWD, rNewImgHT  が異なっていれば、読み込まれていないことにする。
        Dim a, b As Integer : Dim s As String
        wファイル群の数 = 0
        w読み込み済み数 = 0
        For a = 1 To UBound(rStrファイル群の名前)
            s = rStrファイル群の名前(a)
            If s <> "" Then
                wファイル群の数 = wファイル群の数 + 1
                For b = 1 To mAryMax
                    With mBUFF(b)
                        If .Fname = s And .ImgObj IsNot Nothing Then
                            If .ImgObj.Width = rNewImgWD And .ImgObj.Height = rNewImgHT Then
                                w読み込み済み数 = w読み込み済み数 + 1
                            End If
                            Exit For
                        End If
                    End With
                Next
            End If
        Next
        Return (wファイル群の数 = w読み込み済み数)
    End Function
    '************************************************************************
    Friend Function aa画像ファイルオープン_Ret_CopyImg(ByRef ファイル As String, ByRef wImg返す As Image, ByRef rBmpMaxWD As Integer, ByRef rBmpMaxHT As Integer, ByVal r規定の内蔵画像 As String, ByVal r規定のImg As Image, ByRef wPctCurBmp縦横比率 As Single) As String
        '-------------------------------------------------------------------------------------
        If r規定の内蔵画像 <> "" Then
            If r規定のImg Is Nothing Then Return ""
        ElseIf Not ⅩファイルはPictureBoxで読み込める画像(ファイル) Then
            'qqqqq("File name error ---> " & ファイル)
            Return ""
        End If
        '-------------------------------------------------------------------------------------
        Dim a As Integer
        '-------------------------------------------------------------------------------------
        'メモリ内に画像の　 r開くファイル   の ImgObj　があるか調べる。
        For a = 1 To mAryMax
            With mBUFF(a)
                If .Fname = ファイル And .ImgObj IsNot Nothing And .FileBmpWD > 0 And .FileBmpHT > 0 Then
                    wImg返す = .ImgObj.Clone
                    wPctCurBmp縦横比率 = wImg返す.Height / wImg返す.Width
                    Return ファイル
                End If
            End With
        Next
        '-------------------------------------------------------------------------------------
        Try
            Dim imgNEW As Image = Nothing
            Dim filename As String = ""
            If r規定の内蔵画像 <> "" Then
                imgNEW = r規定のImg.Clone
                filename = r規定の内蔵画像
            Else
                Dim imf As Image = Nothing
                Try
                    imf = System.Drawing.Image.FromFile(ファイル)   'ファイルオープンを実行
                Catch
                    qqqqq("ERROR --- Image.FromFile(ファイル)")
                End Try
                If imf IsNot Nothing Then
                    imgNEW = imf.Clone : imf.Dispose()
                End If
                filename = ファイル
            End If
            If imgNEW Is Nothing Then Return ""
            Dim fileWD As Integer = imgNEW.Width
            Dim fileHT As Integer = imgNEW.Height
            '---------------------------------------------------------------------------
            'qqqqq("FileImg Width  " + Format(imgNEW.Width, "0000") + ",  FileImg Height   " + Format(imgNEW.Height, "0000"))
            '---------------------------------------------------------------------------
            '縦横比率が、 ファイルオープン用最大縦横比率  以上のサイズの画像はトリミングする。
            With imgNEW
                Dim imgtmp As Image = Nothing
                Dim ファイルオープン用最大縦横比率 As Single = 2.0#
                Dim ww As Integer = .Height * ファイルオープン用最大縦横比率
                Dim xx As Integer = (.Width - ww) \ 2
                Dim hh As Integer = .Width * ファイルオープン用最大縦横比率
                Dim yy As Integer = (.Height - hh) \ 2
                If xx > 0 Then
                    If ⅩImage_新規作成_再作成(imgtmp, ww, .Height) Then gggbol = ⅩImage_Image_Copy(imgtmp, imgNEW, 0, 0, ww, .Height, xx, 0, ww, .Height)
                ElseIf yy > 0 Then
                    If ⅩImage_新規作成_再作成(imgtmp, .Width, hh) Then gggbol = ⅩImage_Image_Copy(imgtmp, imgNEW, 0, 0, .Width, hh, 0, yy, .Width, hh)
                Else
                    'no op OK
                End If
                If imgtmp IsNot Nothing Then
                    imgNEW.Dispose()
                    imgNEW = imgtmp.Clone
                    imgtmp.Dispose()
                End If
            End With
            '---------------------------------------------------------------------------
            'qqqqq("Ⅹ描画_縦横比が_r最大縦横比率_以上の画像をトリミング()   OKOK")
            '---------------------------------------------------------------------------
            '新しく imgNEW のイメージを保存する。  mBUFF(x).Fname / .ImgObj / .BWD / .BHT / .FileBmpWD / .FileBmpHT  も設定しておく。
            Dim nnn As Integer = 0
            For a = 1 To mAryMax
                With mBUFF(a)
                    If .Fname = "" And .ImgObj Is Nothing And .FileBmpWD = 0 And .FileBmpHT = 0 Then
                        nnn = a : Exit For
                    End If
                End With
            Next
            If nnn = 0 Then
                MsgBox("五clsPctFileOpenWithBuff で使用できるファイル数は満杯です。") : Return ""
            End If
            '---------------------------------------------------------------------------
            Dim IsOK As Boolean = False
            Dim imgWD As Integer = imgNEW.Width
            Dim imgHT As Integer = imgNEW.Height
            Dim WD比 As Single = imgWD / rBmpMaxWD
            Dim HT比 As Single = imgHT / rBmpMaxHT
            Dim MAX比 As Single = IIf(WD比 > HT比, WD比, HT比)
            With mBUFF(nnn)
                If MAX比 > 1 Then
                    Dim ww As Integer = imgWD / MAX比
                    Dim hh As Integer = imgHT / MAX比
                    If ⅩImage_新規作成_再作成(.ImgObj, ww, hh) Then IsOK = ⅩImage全域StrechCopy(.ImgObj, imgNEW)
                    'If IsOK Then qqqqq("MAX比=" + Format(MAX比, "#.####") + ",  WD比=" + Format(WD比, "#.####") + ",  HT比=" + Format(HT比, "#.####"))
                Else
                    If ⅩImage_新規作成_再作成(.ImgObj, imgWD, imgHT) Then IsOK = ⅩImage全域StrechCopy(.ImgObj, imgNEW)
                    'If IsOK Then qqqqq("MAX比=" + Format(MAX比, "#.####") + ",  WD比=" + Format(WD比, "#.####") + ",  HT比=" + Format(HT比, "#.####"))
                End If
                imgNEW.Dispose()
                If Not IsOK Then
                    If .ImgObj IsNot Nothing Then .ImgObj.Dispose()
                    Return ""
                End If
                .Fname = filename
                .FileBmpWD = fileWD
                .FileBmpHT = fileHT
                wImg返す = .ImgObj.Clone
            End With
            '---------------------------------------------------------------------------
            wPctCurBmp縦横比率 = wImg返す.Height / wImg返す.Width
            'If IsOK Then qqqqq("wImg返す.Width  " + Format(wImg返す.Width, "0000") + ",  wImg返す.Height  " + Format(wImg返す.Height, "0000") + vbCrLf)
            '---------------------------------------------------------------------------
            If IsOK Then Return ファイル Else Return ""
        Catch
            Debug.Print(ErrorToString())
            Return ""
        End Try
    End Function
    '***********************************************************************
#End Region

End Class


