Option Explicit

Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

'連携プレーさせる
'フロッピードライブエラー処理はしていません
Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
    Dir1.ListIndex = 0
End Sub
Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub
Private Sub File1_Click()
    Dim strPath As String
    
    'ドライブの所にあるファイルには、\を付ける
    strPath = File1.Path & _
            IIf(Right(File1.Path, 1) = "\", "", "\") & File1.List(File1.ListIndex)
    
    'マウスポインタを砂時計を表示します
    Me.MousePointer = vbHourglass
    
    'テキストファイルを読み込みます
    LoadAutoSizePicture Picture1, Picture2, strPath
    
    'マウスポインタを元に戻します
    Me.MousePointer = vbDefault
End Sub

'ファイル表示パターンを変えます
Private Sub Text2_Change()
    On Error Resume Next

    File1.Pattern = Text2.Text
End Sub

'自動的に縦と横の長さを整えます
Sub LoadAutoSizePicture(DstObject As Object, SrcObject As Object, ByVal strPath As String)
    Dim picSrcWid As Single, picSrcHei As Single
    Dim picDstWid As Single, picDstHei As Single
    Dim picDstLeft As Long, picDstTop As Long
    Dim picSize As Single
    
    On Error Resume Next
    
    '表示をクリアにします
    DstObject.Cls
    
    '隠れPictureに画像を読み込みます
    SrcObject.Picture = LoadPicture(strPath)
    
    '画像のサイズを代入します
    picSrcWid = SrcObject.ScaleWidth
    picSrcHei = SrcObject.ScaleHeight
    
    '横のサイズに合わせて画像が転送されます
    picSize = DstObject.ScaleWidth
    
    '縦と横の長さを計算します
    If picSrcWid > picSrcHei Then
        picDstWid = picSize
        '縦の長さの比率から計算します
        picDstHei = Int((picSrcHei / picSrcWid) * picSize)
        picDstLeft = 0
        '縦の位置を計算します
        picDstTop = (picSize - picDstHei) \ 2
    Else
        '横の長さの比率から計算してます
        picDstWid = Int((picSrcWid / picSrcHei) * picSize)
        picDstHei = picSize
        '横の位置を計算します
        picDstLeft = (picSize - picDstWid) \ 2
        picDstTop = 0
    End If
    
    '画像を縮小して表示します
    StretchBlt DstObject.hdc, picDstLeft, picDstTop _
            , picDstWid, picDstHei, SrcObject.hdc _
            , 0, 0, picSrcWid, picSrcHei, vbSrcCopy
    DstObject.Refresh
    
    '画像を解放します
    SrcObject.Picture = LoadPicture
    
End Sub