1 | /*
|
---|
2 | レイヤードウィンドウを使用しているのでWindows 2000以上が必要。
|
---|
3 | チェックボックスの状態により透明度が変わるという例。
|
---|
4 | */
|
---|
5 |
|
---|
6 | #require <Classes/ActiveBasic/Windows/UI/Form.ab>
|
---|
7 | #require <Classes/ActiveBasic/Windows/UI/Application.ab>
|
---|
8 | #require <Classes/ActiveBasic/Windows/UI/CheckBox.ab>
|
---|
9 |
|
---|
10 | #resource "UI_Sample.rc"
|
---|
11 |
|
---|
12 | Imports ActiveBasic.Windows.UI
|
---|
13 |
|
---|
14 | Const LWA_ALPHA = 2
|
---|
15 | Const WS_EX_LAYERED = &h00080000
|
---|
16 | Declare Function SetLayeredWindowAttributes Lib "user32" (hwnd As HWND, crKey As COLORREF, bAlpha As Byte, dwFlags As DWord) As BOOL
|
---|
17 |
|
---|
18 | Class MyForm
|
---|
19 | Inherits Form
|
---|
20 | Public
|
---|
21 | Sub MyForm()
|
---|
22 | CreateForm()
|
---|
23 |
|
---|
24 | Dim wpFont = GetStockObject(DEFAULT_GUI_FONT) As WPARAM
|
---|
25 |
|
---|
26 | checkBox = New CheckBox
|
---|
27 | With checkBox
|
---|
28 | .Create(This, 0, 0, 0)
|
---|
29 | .Move(20, 20, 200, 20)
|
---|
30 | .Text = "半透明化"
|
---|
31 | .ThreeState = True
|
---|
32 | .SendMessage(WM_SETFONT, wpFont, 0)
|
---|
33 | .AddClick(AddressOf(OnClick))
|
---|
34 | End With
|
---|
35 | OnClick(This, Args.Empty)
|
---|
36 | Show(SW_SHOWDEFAULT)
|
---|
37 | End Sub
|
---|
38 | Protected
|
---|
39 | Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
|
---|
40 | Super.GetCreateStruct(cs)
|
---|
41 | With cs
|
---|
42 | .style = WS_CAPTION Or WS_BORDER Or WS_SYSMENU Or WS_DLGFRAME Or WS_MINIMIZEBOX
|
---|
43 | .dwExStyle = WS_EX_LAYERED
|
---|
44 | .cx = 320
|
---|
45 | .cy = 240
|
---|
46 | End With
|
---|
47 | End Sub
|
---|
48 |
|
---|
49 | Private
|
---|
50 | Sub OnClick(sender As Object, e As Args)
|
---|
51 | Dim alpha As Byte
|
---|
52 | Dim state = checkBox.State
|
---|
53 | Select Case state
|
---|
54 | Case CheckState.Unchecked
|
---|
55 | alpha = 255
|
---|
56 | Case CheckState.Checked
|
---|
57 | alpha = 200
|
---|
58 | Case CheckState.Indeterminate
|
---|
59 | alpha = 100
|
---|
60 | End Select
|
---|
61 | SetLayeredWindowAttributes(This, 0, alpha, LWA_ALPHA)
|
---|
62 | End Sub
|
---|
63 |
|
---|
64 | checkBox As CheckBox
|
---|
65 | End Class
|
---|
66 |
|
---|
67 | Control.Initialize(GetModuleHandle(0))
|
---|
68 |
|
---|
69 | Dim f = New MyForm
|
---|
70 | Application.Run(f)
|
---|