'================================================================
'= ウインドウの透明度変更
'=    (SetLayeredWindowAttributes.bas)
'================================================================
#include "Windows.bi"

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

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

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

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

Var Shared Text1 As Object
Var Shared HScroll1 As Object

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
HScroll1.Attach GetDlgItem("HScroll1")

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var Ret As Long

    HScroll1.SetScrollRange 25,255
    HScroll1.SetScrollStep 5, 10
    HScroll1.SetScrollPos 255

    Text1.SetWindowtext format$(255, "Alpha:###")

    Ret = Api_GetWindowLong(GethWnd, GWL_EXSTYLE)
    Ret = Ret Or WS_EX_LAYERED
    Ret = Api_SetWindowLong(GethWnd, GWL_EXSTYLE, Ret)
End Sub

'================================================================
'=
'================================================================
Declare Sub HScroll1_Change edecl ()
Sub HScroll1_Change()
    Var Alpha As Byte
    Var Ret As Long

    '半透明化(25 〜 255)
    Alpha = HScroll1.GetScrollPos
    Text1.SetWindowtext format$(Alpha, "Alpha:###")

    Ret = Api_SetLayeredWindowAttributes(GethWnd, 0, Alpha, LWA_ALPHA)
End Sub

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