フェードイン・フェードアウト          <TOP>


AlphaBlend 透過ピクセルと半透過ピクセルを持つビットマップを表示
GetDC デバイスコンテキストのハンドルを取得
ReleaseDC デバイスコンテキストを解放
 

ホームページトップの写真切替はこのコードを利用しています。

 

'================================================================
'= フェードイン・フェードアウト
'=    (Fading2.bas)
'================================================================
#include "Windows.bi"

' 透過ピクセルと半透過ピクセルを持つビットマップを表示
Declare Function Api_AlphaBlend& Lib "msimg32" Alias "AlphaBlend" (ByVal hdcDest&, ByVal nXDest&, ByVal nYDest&, ByVal nWidthDest&, ByVal nHeightDest&, ByVal hdcSrc&, ByVal nXSrc&, ByVal nYSrc&, ByVal nWidthSrc&, ByVal nHeightSrc&, ByVal nBlEndFunc&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

#define SRCAND &H8800C6                 '転送先の画像とAND演算して転送
#define SRCCOPY &HCC0020                'そのまま転送

Var Shared Picture1 As Object
Var Shared Picture2 As Object
Var Shared Radio1 As Object
Var Shared Radio2 As Object
Var Shared Button1 As Object
Var Shared Bitmap As Object

Picture1.Attach GetDlgItem("Picture1")
Picture2.Attach GetDlgItem("Picture2")
Radio1.Attach GetDlgItem("Radio1") : Radio1.SetFontSize 12
Radio2.Attach GetDlgItem("Radio2") : Radio2.SetFontSize 12
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
BitmapObject Bitmap

'================================================================
'=
'================================================================
Declare Function Index bdecl () As Integer
Function Index()
    Index = Val(Mid$(GetDlgRadioSelect("Radio1"), 6)) - 1
End Function

'================================================================
'=
'================================================================
Declare Sub Radio1_on edecl ()
Sub Radio1_on()
    Bitmap.LoadFile "FadeIn.bmp"
    Picture1.StretchBitmap Bitmap, 0, 0 , Picture1.GetWidth, Picture1.GetHeight
    Bitmap.DeleteObject
End Sub

'================================================================
'=
'================================================================
Declare Sub Radio2_on edecl ()
Sub Radio2_on()
    Bitmap.LoadFile "FadeOut.bmp"
    Picture1.StretchBitmap Bitmap, 0, 0 , Picture1.GetWidth, Picture1.GetHeight
    Bitmap.DeleteObject
End Sub

'================================================================
'=
'================================================================
Declare Sub Pic2DrawBitmap()
Sub Pic2DrawBitmap()
    Bitmap.LoadFile "flower.bmp"
    Picture2.StretchBitmap Bitmap, 0, 0 , Picture2.GetWidth, Picture2.GetHeight
    Bitmap.DeleteObject
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub mainForm_Start()
    Pic2DrawBitmap
    Radio1_on
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var hDC1 As Long
    Var hDC2 As Long
    Var i As Long
    Var Ret As Long
    
    hDC1 = Api_GetDC(Picture1.GethWnd)
    hDC2 = Api_GetDC(Picture2.GethWnd)

    Button1.EnableWindow 0
    
    For i = 0 To 100
        If Index = 0 Then
            Ret = Api_AlphaBlend(hDC1, 0, 0, Picture1.GetWidth, Picture1.GetHeight, hDC2, 0, 0, Picture2.GetWidth, Picture2.GetHeight, i * &H8000)
        Else
            Ret = Api_AlphaBlend(hDC2, 0, 0, Picture2.GetWidth, Picture2.GetHeight, hDC1, 0, 0, Picture1.GetWidth, Picture1.GetHeight, i * &H8000)
        End If
   
        Wait 3
    Next
    
    Button1.EnableWindow -1

    Ret = Api_ReleaseDC(Picture1.GethWnd, hDC1)
    Ret = Api_ReleaseDC(Picture2.GethWnd, hDC2)

    Pic2DrawBitmap
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End