Option Explicit

'透過転送を可能にするAPIです
Private Declare Function TransparentBlt Lib "msimg32.dll" _
          (ByVal hdcDest As Long _
         , ByVal nXOriginDest As Long _
         , ByVal nYOriginDest As Long _
         , ByVal nWidthDest As Long _
         , ByVal nHeightDest As Long _
         , ByVal hdcSrc As Long _
         , ByVal nXOriginSrc As Long _
         , ByVal nYOriginSrc As Long _
         , ByVal nWidthSrc As Long _
         , ByVal nHeightSrc As Long _
         , ByVal crTransparent As Long) As Long

'DLLをメモリデスクに配置します
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
'DLLをメモリデスクから破棄します
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long

'メモリリークが発生するため
'一度、読み込んで使用してから解放してます
'引数の配置に変更はありません
Function MyTransParentBlt( _
           ByVal hdcDest As Long _
         , ByVal nXOriginDest As Long _
         , ByVal nYOriginDest As Long _
         , ByVal nWidthDest As Long _
         , ByVal nHeightDest As Long _
         , ByVal hdcSrc As Long _
         , ByVal nXOriginSrc As Long _
         , ByVal nYOriginSrc As Long _
         , ByVal nWidthSrc As Long _
         , ByVal nHeightSrc As Long _
         , ByVal crTransparent As Long) As Long
    Dim hLib As Long
    
    'DLLを読み込みます
    hLib = LoadLibrary("msimg32.dll")
    
    '読み込みが失敗しなかったら
    '関数を使用します
    If Not (hLib = 0) Then
        TransparentBlt _
                hdcDest, nXOriginDest, nYOriginDest, nWidthDest, nHeightDest _
                , hdcSrc, nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc _
                , crTransparent
        'DLLを解放します
        FreeLibrary hLib
    End If
    
End Function

'約、1秒間待機します
Sub Wait()
    Dim iSecond As Integer
    
    '現在の秒数を保持します
    iSecond = Second(Time)
    Do
        DoEvents
        '保持した値と現在の秒数とを比較して
        '同じでなければループから出ます
    Loop While iSecond = Second(Time)
End Sub

Private Sub Form_Load()
    
    'プロパティの設定をします
    
    'Picture1(0)
    Picture1(0).ScaleMode = vbPixels
    Picture1(0).Picture = LoadPicture(App.Path & "\folder_close.bmp")
    
    'Picture1(1)
    Picture1(1).ScaleMode = vbPixels
    Picture1(1).Picture = LoadPicture(App.Path & "\folder_open.bmp")
    
    'Picture2
    Picture2.AutoRedraw = True
    Picture2.ScaleMode = vbPixels
    Picture2.Picture = LoadPicture(App.Path & "\Image1.bmp")
End Sub

'開始ボタンをクリックしました
Private Sub Command1_Click()
    Dim j           As Integer
    Dim iAni        As Integer
    Dim lngX        As Long
    Dim lngY        As Long
    Dim lngCenterX  As Long
    Dim lngCenterY  As Long
    
    '開始ボタンのイベントを無効にします
    Command1.Enabled = False
    
    '回転するときの中心位置とその半径を代入します
    lngCenterX = (Picture2.ScaleWidth - Picture1(0).ScaleWidth) ¥ 2
    lngCenterY = (Picture2.ScaleHeight - Picture1(0).ScaleHeight) ¥ 2
    '時計周りに回転します
    For j = 0 To 360 Step 20
        '描画するイメージをランダムで選択します
        iAni = CInt(Rnd * 1)
        '描画する位置を決定します
        lngX = lngCenterX + Cos(j * 3.14 / 180) * lngCenterX
        lngY = lngCenterY + Sin(j * 3.14 / 180) * lngCenterY
        '透過処理を容易に(マスクイメージなしという意味で)行います
        '透明色は、RGB(192,192,192)に設定しています
        MyTransParentBlt _
                Picture2.hDC, lngX, lngY _
                , Picture1(iAni).ScaleWidth, Picture1(iAni).ScaleHeight _
                , Picture1(iAni).hDC, 0, 0 _
                , Picture1(iAni).ScaleWidth, Picture1(iAni).ScaleHeight _
                , RGB(192, 192, 192)
        '描画を更新します
        Picture2.Refresh
        '約1秒間処理を待機します
        Wait
    Next
    
    '開始ボタンのイベントを有効にします
    Command1.Enabled = True
End Sub