透明・透過のテスト(Ⅰ)             <TOP>

SetWindowLong ウィンドウに関するデータをセット

GetWindowLong ウィンドウに関するデータを取得

SetLayeredWindowAttributes 透明なウィンドウを作成 (Windows95/98には対応していません！)

　

通常フォーム表示


透過度（アルファ値175）

    フォーム全体が透けている 

フォーム（背景色：灰色）を透明に

    デスクトップアイコン等が見えている

ピクチャボックス背景色（白で）を指定し透明に

    TEXTBOX、PICTUREBOX、LISTBOXが透けている

BUTTON1をSCROOL1に変え、ALPHA値を連続可変にしてみました。

　

'================================================================
'=　透明・透過のテスト(Ⅰ)
'=  ※256色以下では透明なWindowは作成されない
'=  SetLayeredWindowAttributesはWindows95/98では不可
'=    (SetLayeredWinAttri.bas)
'================================================================
#include "Windows.bi"

' 指定されたウィンドウの属性を変更。また、拡張ウィンドウメモリの指定されたオフセットの32ビット値を書き換えることができる
Declare Function Api_SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)

' 指定されたウィンドウに関しての情報を取得。また、拡張ウィンドウメモリから、指定されたオフセットにある32ビット値を取得することもできる
Declare Function Api_GetWindowLong& Lib "user32" Alias "GetWindowLongA" (ByVal hWnd&, ByVal nIndex&)

' レイヤード ウィンドウの不透明および透明のカラーキーを設定
Declare Function Api_SetLayeredWindowAttributes& Lib "user32" Alias "SetLayeredWindowAttributes" (ByVal hWnd&, ByVal crKey&, ByVal bAlpha&, ByVal dwFlags&)

#define GWL_EXSTYLE (-20)            '拡張ウィンドウスタイル(nIndexの定数)
#define LWA_COLORKEY 1               'crKeyを透明色として使う(dwFlagsの定数)
#define LWA_ALPHA 2                  'bAlphaをアルファー値として使う
#define WS_EX_LAYERED &H80000        '透明なウィンドウ属性(Windows2000以上)

Var shared Text(2) As Object
Var Shared Button(2) As Object
Var shared List1 As Object
Var shared Picture1 As Object
Var shared HScroll1 As Object

Picture1.Attach GetDlgItem("Picture1")
List1.Attach GetDlgItem("List1") : List1.SetFontSize 14
HScroll1.Attach GetDlgItem("HScroll1")
For i = 0 To 2
    Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1)))
    Text(i).SetFontSize 14
    Button(i).Attach GetDlgItem("Button" & Trim$(Str$(i + 1)))
    Button(i).SetFontSize 14
Next

Var shared hWnd As Long
Var shared Alpha As Byte
Var shared CrLf$ As String

'================================================================
'=　
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    CrLf$ = Chr$(13, 10)
    Text(0).SetWindowtext ""
    Picture1.Symbol(0, 0), "Picture", 1, 1
    hWnd = GethWnd
    For i = 1 To 20
        List1.AddString String$(40, Chr$(&H40 + i))
    Next
    HScroll1.SetScrollRange 25, 255
    HScroll1.SetScrollStep 5, 1
    HScroll1.SetScrollPos 255
End Sub

'================================================================
'=　ウィンドウ全体を半透明にする(クリック毎に透過度を可変)
'================================================================
Declare Sub HScroll1_Change edecl ()
Sub HScroll1_Change()
    Var dwStyle As Long
    Var Ret As Long

    Alpha = HScroll1.GetScrollPos

    '拡張ウィンドウスタイルにWS_EX_LAYEREDを追加する
    dwStyle = Api_GetWindowLong(hWnd, GWL_EXSTYLE)
    dwStyle = dwStyle Or WS_EX_LAYERED

    Ret = Api_SetWindowLong(hWnd, GWL_EXSTYLE, dwStyle)
    Ret = Api_SetLayeredWindowAttributes(hWnd, 0, Alpha, LWA_ALPHA)

    Text(0).SetWindowtext "Alpha値：" & Trim$(Str$(Alpha))
End Sub

'================================================================
'=　MainForm背景色を透明にする
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var dwStyle As Long
    Var Ret As Long
    
    '拡張ウィンドウスタイルにWS_EX_LAYEREDを追加する
    dwStyle = Api_GetWindowLong(hWnd, GWL_EXSTYLE)
    dwStyle = dwStyle Or WS_EX_LAYERED

    Ret = Api_SetWindowLong(hWnd, GWL_EXSTYLE, dwStyle)
    '透明色を指定して透明にする
    Ret = Api_SetLayeredWindowAttributes(hWnd, GetBackColor, 0, LWA_COLORKEY)
    Text(0).SetWindowtext "メインフォームの背景色を取得(GetBackColor)し、その色を指定して透明に・・"
End Sub

'================================================================
'=　Picture1の背景色を透明にする
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var dwStyle As Long
    Var Ret As Long

    '拡張ウィンドウスタイルにWS_EX_LAYEREDを追加する
    dwStyle = Api_GetWindowLong(hWnd, GWL_EXSTYLE)
    dwStyle = dwStyle Or WS_EX_LAYERED
    Ret = Api_SetWindowLong(hWnd, GWL_EXSTYLE, dwStyle)

    'Picture1の背景色を取得し、その色を透明にする            ↓
    Ret = Api_SetLayeredWindowAttributes(hWnd, Picture1.GetBackColor, 0, LWA_COLORKEY)
    Text(0).SetWindowtext "ピクチャボックスの背景色を取得(GetBackColor)し、その色を指定して透明に・・"
End Sub

'================================================================
'=　ウィンドウ全体を通常に戻す
'================================================================
Declare Sub Button3_on edecl ()
Sub Button3_on()
    Var dwStyle As Long
    Var Ret As Long
    
    '拡張ウィンドウスタイルにWS_EX_LAYEREDを追加する
    dwStyle = API_GETWINDOWLONG&( hWnd, GWL_EXSTYLE)
    dwStyle = dwStyle Or WS_EX_LAYERED
    Ret = Api_SetWindowLong(hWnd, GWL_EXSTYLE, dwStyle)

    'ウィンドウ全体を通常に戻す                   ↓透明度(255：通常)
    Ret = Api_SetLayeredWindowAttributes(hWnd, 0, 255, LWA_ALPHA)
    Text(0).SetWindowtext "Alpha値：" & Trim$(Str$(255))
End Sub

'================================================================
'=　イベント
'================================================================
While 1
    WaitEvent
Wend
Stop
End