HSPでAeroGlassに描画してみる

A2dの32bitビットマップデータをHSPの実ウインドウに直接描くことで黒い文字も透けないオシャンティなデザインが可能。
Vistaのころから何回も挑戦してついに理想の動作を手に入れたというのにWin8でグラスウインドウが廃止されてしまったKANASHIMI

waiei
2013/9/14 19:40

タグ：
hsp
aero

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
#include "a2d.hsp"
#module
#uselib "user32"
#func GetDC "GetDC" int
#func ReleaseDC "ReleaseDC" int,int
#deffunc alSetAeroGlass
    alReleaseAeroGlass
    wid=ginfo_sel
    GetDC hwnd
    dc=stat
    return dc
#deffunc alReleaseAeroGlass onexit
    old_wid=ginfo_sel
    if dc:gsel wid:ReleaseDC hwnd,dc:gsel old_wid
    return 0
#deffunc _alCopyImageToAeroGlass int p1, int x, int y, int w, int h
    if imgValidArr@a2d(p1) {
        ; 実スクリーンの Graphics 作成
        gsel wid
        GdipCreateFromHDC@a2d dc, varptr(tmpGraphics)
        if tmpGraphics {
            GdipSetCompositingMode@a2d tmpGraphics, 1
            GdipDrawImageRectRectI@a2d tmpGraphics, imgImageArr@a2d(p1), x, y, w,h, x, y, w,h, UnitPixel@a2d, pImageAttr@a2d, 0, 0
            GdipDeleteGraphics@a2d tmpGraphics  ; tmpGraphics を削除
            tmpGraphics = 0
            return 0
        }
    }
    return -1
#global
#define alCopyImageToAeroGlass(%1,%2=ginfo_cx,%3=ginfo_cy,%4=ginfo_winx,%5=ginfo_winy) _alCopyImageToAeroGlass %1,%2,%3,%4,%5
#uselib "dwmapi"
#func DwmIsCompositionEnabled "DwmIsCompositionEnabled" int
#func DwmExtendFrameIntoClientArea "DwmExtendFrameIntoClientArea" int,int
    aerorect=-1,0,0,0
    wx=640 : wy=480
    screen 0,wx,wy,2
    cls 4 : gsel 0,1
    gosub *lAeroChk
    oncmd gosub *lAeroChk,0x031E    ;Aeroの状態が変わった時
    oncmd gosub *lWRedraw,0x3       ;画面外に行った時に消えるので描画しなおす（高負荷なので工夫して）
    alSetAeroGlass
    alCreateImage 0,wx,wy
    repeat 10
    _y=cnt
    repeat 10
    _x=cnt
    alHsvColor ((_y*10+_x)*2)\192,255,100+_y*15,200-_x*15
    alFillRect _x*(wx/10)+1,_y*(wy/10)+1,(wx/10)-1,(wy/10)-1
    loop
    loop
    alFont "meiryo",60 : alColor 0,0,0,255
    alDrawText "そしてこの\n黒文字である\n透けていないでしょ？",0,0,wx,wy,1,1
    repeat
    gosub *lWRedraw
    wait 5  ;最小化からの復帰時の再描画がうまくいかないのでとりあえずループ監視
    loop
    stop
*lWRedraw
    // 再描画(Aero環境の場合、画面外にウインドウが行くと再描画が必要)
    if aero{
        alCopyImageToAeroGlass 0
    }else{
        alCopyImageToScreen 0,0
        redraw
    }
    return
*lAeroChk
    DwmIsCompositionEnabled varptr(aero)
    if aero!0{
        color 0,0,0 : boxf
        DwmExtendFrameIntoClientArea hwnd,varptr(aerorect)
        wait 1  ;何故かgselでウインドウ表示後ウエイトを入れないと中身が表示されない
                ;（生成時のアニメーション中だとだめ？最小化から復帰アニメーション中もだめっぽい）
    }else{
        color 0,0,0 : boxf
    }
    gosub *lWRedraw
    return
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

このコードをツイートする