waiei -blog-

その日の出来事を簡単に紹介する日記

スポンサーサイト

--------------:--
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

HSPでAeroのグラスウインドウに描画

2013-09-14-Sat-23:30
5年越しの悲願
日記マンガ

黒文字も透けません!
全画面グラス
一部グラス




こんにちは、A.Cです。
今回はHSPの記事です。超マニアックです。

かなり長いんで続きの方に書きました。右のRead moreから⇒
 
五年前にこんな日記を書きました。
ダメだ俺…早く何とかしないと…!
この時にすでにグラスウインドウに描画できてるじゃーんと
なっているわけですが、あれ実は画面更新するときにものすごく点滅して
実用性が皆無だったので他にもいろんな方法を試していました。

・その1:反転コピーでアルファ値も反転
HSPTV!の掲示板にあった方法。
DWMのガラス効果で、ボタンの黒文字を透過させない方法

#uselib "dwmapi"
#cfunc DwmIsCompositionEnabled "DwmIsCompositionEnabled" int
#func DwmExtendFrameIntoClientArea "DwmExtendFrameIntoClientArea" int,int
#func DwmEnableBlurBehindWindow "DwmEnableBlurBehindWindow" int,int
#uselib "UxTheme"
#func OpenThemeData "OpenThemeData" int, wstr
#func DrawThemeBackground "DrawThemeBackground" int, int, int, int, int, int
#func CloseThemeData "CloseThemeData" int
#include "gdi32.as"
#include "user32.as"

#define BP_PUSHBUTTON 0
#define PBS_NORMAL 1 ; 通常状態
#define PBS_HOT 2 ; マウスカーソルが上にある状態
#define PBS_PRESSED 3 ; 押された状態
#define DT_BOTTOM   0x8
#define DT_CALCRECT 0x400
#define DT_CENTER   0x1
#define DT_EDITCONTROL  0x2000
#define DT_END_DLLIPISIS    0x8000
#define DT_EXPANDTABS   0x40
#define DT_EXTERNALLEADING  0x200
#define DT_LEFT 0x0
#define DT_MODIFYSTRING 0x10000
#define DT_NOCLIP   0x100
#define DT_PATH_ELLIPSIS    0x4000
#define DT_NOPREFIX 0x800
#define DT_RIGHT    0x2
#define DT_RTLREADING   0x20000
#define DT_SINGLELINE   0x20
#define DT_TABSTOP  0x80
#define DT_TOP  0x0
#define DT_VCENTER  0x4
#define DT_WORDBREAK    0x10
#define DT_WORD_ELLIPSIS    0x40000

#define BM_SETSTYLE 0x00F4
#define BS_OWNERDRAW 0x0000000B
#define WM_DRAWITEM 0x002B
#define ODT_BUTTON 4

;DRAWITEMSTRUCT(抜粋)
#define DIS_CtlType 0; UINT CtlType;
#define DIS_hDC 6; HDC hDC;
#define WM_SETCURSOR 0x20

    objX=160 : objY=30
    bgscr 2,objX,objY*5,2
    syscolor 15:boxf 0,objY,ginfo_winx,ginfo_winy
    hdc_obj=hdc
    OpenThemeData hwnd"button"
    hTheme=stat
    font "meiryo",12
    text="ボタンテキスト"
    repeat 4,1
    r=0,objY*cnt,objX,objY*cnt+objY
    DrawThemeBackground hTheme,hdc,1,cnt,varptr(r)
    if cnt=4:syscolor 17:else:syscolor 18
    DrawText hdc,text,-1,varptr(r),DT_SINGLELINE | DT_CENTER | DT_VCENTER | DT_NOPREFIX
    loop
    redraw

    screen 0,320,240
    arect=0,0,0,objY+20     //一番最初の値を-1にすると全部透明
    DwmExtendFrameIntoClientArea hwnd,varptr(arect)
    cls 4:color 0,0,0:boxf 0,0,ginfo_winx,ginfo_winy-(objY+20)-1

    onclick gosub *lClick

    objsize objX,objY
    pos ginfo_winx-(objX+10),ginfo_winy-(objY+10)
    button gosub "",*lClick : hObj=objinfo(stat,2)
    sendmsg hObj, BM_SETSTYLEBS_OWNERDRAW, 0
    oncmd gosub *lDRAWITEMWM_DRAWITEM
    oncmd gosub *lWM_SETCURSORWM_SETCURSOR
    GetDC hObj
    dcObj=stat
    overObj=0
    ena=1
    stop

*lClick
    if mousey>ginfo_winy-(objY+20):return
    ena=1-ena
    objenable 0,ena
    return

*lDRAWITEM
    wp=wparam
    lp=lparam
    dupptr DIS, lp, 48
    if DIS.DIS_CtlType!ODT_BUTTON:return
    BitBlt DIS.DIS_hDC, 0, 0, objX,objY, hdc_obj, 0, 0, 0x330008
    if DIS.4 & $4{
        BitBlt dcObj, 0, 0, objX, objY, hdc_obj, 0, objY*4, 0xEE0086
    }else:if DIS.4 & $1{
        BitBlt dcObj, 0, 0, objX, objY, hdc_obj, 0, objY*3, 0xEE0086
    }else{
        BitBlt dcObj, 0, 0, objX, objY, hdc_obj, 0, objY, 0xEE0086
    }
    return
*lWM_SETCURSOR
    if wparam!hObj{
        if overObj=1{
            BitBlt dcObj, 0, 0, objX,objY, hdc_obj, 0, 0, 0x330008
            BitBlt dcObj, 0, 0, objX, objY, hdc_obj, 0, objY, 0xEE0086
        }
        overObj=0
        return
    }
    BitBlt dcObj, 0, 0, objX,objY, hdc_obj, 0, 0, 0x330008
    BitBlt dcObj, 0, 0, objX, objY, hdc_obj, 0, objY*2, 0xEE0086
    overObj=1
    return

*lEnd
    ReleaseDC hObj,dcObj
    CloseThemeData hTheme
    wait 1
    end


メリット
オーナードローなので本物のオブジェクト
デメリット
完全な透明か、完全な不透明しかないため、見た目あまりきれいじゃない
アルファ反転コピー

・その2:OpenHSPを改造して内部的にスクリーンバッファを32bit処理にする
HSPはオープンソースなので内部に持つカラー情報を24bitから32bitに改造
OpenHSPコンパイル
メリット
ぶっちゃけほとんどない
デメリット
HSPの通常命令が使えなくなる
HSPのバージョンが上がるたびに改造する必要がある
不透明にするのめんどい

・その3:32bitビットマップをLoadImageで読み込む
今思えば一番正解に近い方法
32bitビットマップ
メリット
本来の方法に近いので挙動がおかしくない
デメリット
使いたい画像を32bitビットマップで用意する手間がある
画面更新時にちらつく

・その4:上にレイヤードウインドウを重ねる
見た目はかなり綺麗

;----
;   考え方
;   ・メインウインドウ(ID 0)の上にレイヤードウインドウ(ID 2)を描画
;   ・レイヤードウインドウの拡張ウインドウスタイルに0x80を追加して
;    タスクバーに表示されないようにする
;   ・WS_EX_TRANSPARENTメッセージも追加してクリックしても反応しないようにする
;   ・gsel ID,2によって、レイヤードウインドウを最前面にする
;   ・ただし、メインウインドウが非アクティブ時はSetWindowPos命令で解除する
;   ・メインウインドウが移動したらWM_MOVEメッセージ(0x3)をキャッチして
;    MoveWindow命令でレイヤードウインドウも移動
;    widthだとマイナス値が返らない
;    また、-1=65535なので32768以上の場合65536を引くようにする
;   ・WM_MOUSEMOVEメッセージでマウスの位置を監視し、ボタンのマウスオーバー判定をする
;   ・ただし、ウインドウ外に出たらメッセージが送られなくなるので
;    WM_MOUSELEAVEメッセージ+TrackMouseEvent命令でメッセージが来るよう設定する
;   ・マウスクリック/解放時にメッセージを飛ばしてクリック判定をする
;   ・エンジョイAeroライフ!

;   レイヤードウインドウの生成にAsさんのレイヤードウィンドウモジュールを
;   少し改造して使わせていただいています


#include "user32.as"
#define WS_EX_TRANSPARENT   0x00000020
#define WS_EX_LAYERED   0x00080000
#define WM_SETCURSOR 0x20
#define WM_MOUSEMOVE 0x200
#define WM_NCHITTEST 0x84
#define WM_MOUSELEAVE 0x02A3
#define WM_ACTIVATE 0x6
#uselib "dwmapi"
#cfunc DwmIsCompositionEnabled "DwmIsCompositionEnabled" int
#func DwmExtendFrameIntoClientArea "DwmExtendFrameIntoClientArea" int,int
#func DwmEnableBlurBehindWindow "DwmEnableBlurBehindWindow" int,int
#include "mod_lbgscr.hsp"
    screen 0,320,240
    _pos=0,0
    ClienttoScreen hwnd,varptr(_pos)
    oncmd gosub *wm,0x03
    arect=0,0,0,30  //一番最初の値を-1にすると全部透明
    DwmExtendFrameIntoClientArea hwnd,varptr(arect)
    cls 4
    oncmd gosub *lCL_MOUSECLICK, 0x201
    oncmd gosub *lCL_MOUSECLICK, 0x202
    oncmd gosub *lWM_MOUSEMOVEWM_MOUSEMOVE
    ;-- メッセージ登録だけではこないので TrackMouseEvent を使う
    oncmd gosub *lWM_MOUSELEAVEWM_MOUSELEAVE
    buffer 1:picload "bga2avi.bmp"
    pictX=ginfo_winx/2
    pictY=ginfo_winy/3
    ;-- 0,0からのズレ
    zureX=320-pictX+10
    zureY=240-pictY*10/13
    lbgscr 2,pictX,pictY,2,_pos(0)+zureX,_pos(1)+zureY,1,0,0,0
    GetWindowLong hwnd,-20
    SetWindowLong hwnd,-20,stat|WS_EX_TRANSPARENT|WS_EX_LAYERED | $80
    h2=hwnd
;   color 0,0,0:pos 0,30:mes "ウインドウを重ねて、片方は操作を受け付けないごり押し方法です。"
    gsel 2,1:SetWindowPos h2,-1,0,0,0,0,0x3:gsel 0,1
    ;-- マウスがウインドウ外に行ったときにメッセーを出すよう設定
    TRACKMOUSEEVENTstr = 16,2,hwnd,0
    TrackMouseEvent varptr(TRACKMOUSEEVENTstr)
    nowAct=1    ;アクティブ/非アクティブ切り替え時の一時変数
    nowMouse=0  ;クリック/解放時の一時変数
    onexit *lEnd
    color 224,238,255:font "meiryo",14
    pos 10,20
    mes "・AeroGlassWindowの透明部分に描画"
    mes "・非クライアント領域まではみ出してる描画"
    mes "・マウスオーバー等に反応"
    mes "・一部ウインドウの外にまで描画"
    mes ""
    mes "・非クライアント領域のクリック判定が微妙\nなので今はクリック判定なし"
    mes "・実はこれ、レイヤードウインドウなんです↓"
    stop

;-- レイヤードウインドウを一緒に動かす
*wm
    _x=(lparam)&0xFFFF
    _y=(lparam>>16)&0xFFFF
    if _x>32768:_x-=65536
    if _y>32768:_y-=65536
    ;-- widthだと0未満にならない
    gsel 2:MoveWindow h2,_x+zureX,_y+zureY,pictX,pictY,0:gsel 0
    return

*lCL_MOUSECLICK
    cl=0
    if overW2=1{
        if (wparam&1)=1:cl=1:else:cl=0
    }
    gosub *lWM_MOUSEMOVE
    return
*lNCL_MOUSECLICK
    cl=0
    if overW2=1{
        if wparam=2 | wparam=18:cl=1:else:cl=0
    }
    gosub *lWM_MOUSEMOVE
    return
;-- マウス移動時の処理
*lWM_MOUSEMOVE
    sendmsg h2,WM_NCHITTEST,0,ginfo(1)<<16 | ginfo(0)
    overW2=stat
    if ginfo(2)=-1{
        if nowAct=1{
            ;-- 最前面ウインドウの登録解除
            SetWindowPos h2,1,0,0,0,0,0x3|0x10
            SetWindowPos h2,0,0,0,0,0,0x3|0x10
            nowAct=0
        }
    }else{
        ;-- マウスオーバー
        if nowMouse!stat+cl{
            nowMouse=stat+cl
            lbgscr_Update 2, pictX, pictY, 1, 0, nowMouse*pictY, 0
            gsel 0
        }
        ;-- 非アクティブからアクティブになった
        if nowAct=0{
            gsel 2,2
            gsel 0,1
            nowAct=1
        }
    }
    return
;-- マウスが画面外に行ったときのメッセージ
*lWM_MOUSELEAVE
    gosub *lWM_MOUSEMOVE
    wait 1
    TRACKMOUSEEVENTstr = 16,2,hwnd,0
    TrackMouseEvent varptr(TRACKMOUSEEVENTstr)
    return
*lEnd
    end


※画像とモジュールが別途必要です

レイヤードウインドウ
メリット
ウインドウの外側まではみ出る位置に画像を配置できる
デメリット
下のウインドウが移動したときに一緒に移動させる必要がある
他のウインドウが重なった時にウインドウの重なり順を考慮する必要がある
レイヤードウインドウ側をクリックしても下のウインドウをアクティブにしておく必要がある
ぶっちゃけかなりめんどい

そして、昨日ふと32bitのメモリ上のビットマップを作っておいて
そのデータをHSPのバッファを通さずに直接画面に描画すればいいのではないかと思いやってみた。
32bitDIB


#include "user32.as"
#include "gdi32.as"
#uselib "dwmapi"
#func DwmIsCompositionEnabled "DwmIsCompositionEnabled" int
#func DwmExtendFrameIntoClientArea "DwmExtendFrameIntoClientArea" int,int
#uselib "ComCtl32"
#func DrawShadowText "DrawShadowText" int,int,int,int,int,int,int,int,int
#uselib "kernel32.dll"
#cfunc lstrlenW "lstrlenW" var

#module
#deffunc dwmRect var p,int _w,int _h,int a
    w=_w
    h=_h
    c=a<<24|ginfo_r<<16|ginfo_g<<8|ginfo_b
    _cx=ginfo_cx
    _cy=ginfo_cy
    if _cx<0{
        w+=_cx
        pos 0,ginfo_cy
    }
    if _cy<0{
        h+=_cy
        pos ginfo_cx,0
    }
    _cx=ginfo_cx
    _cy=ginfo_cy
    if _cx+w>=ginfo_winx{
        w=ginfo_winx-_cx
    }
    if _cy+h>=ginfo_winy{
        h=ginfo_winy-_cy
    }
    if w<0|h<0:return
    repeat h,_cy
    _y=cnt
    repeat w,_cx
    _x=cnt
    lpoke p,(_y*ginfo_winx+_x)*4,c
    loop
    loop
    return
#global

    wx=640
    wy=480
    screen 0,wx,wy,2
    dim bmi,40
    dim pImage,wx*wy*4
    bmi=40,wx,-wy,1|32<<16,0,wx*wy*4,0,0,0,0
    GetDC hwnd
    h_dc=stat
    CreateDIBSection h_dc,varptr(bmi),0,varptr(pImage),0,0
    hBitmap=stat
    CreateCompatibleDC h_dc
    hmdc=stat
    SelectObject hmdc,hBitmap
    hOhandle=stat
    ReleaseDC hwnd,h_dc

    onexit *lEnd
    gsel 0,1

    color 128,0,255
    pos 0,0
    dwmRect pImage,wx,wy,64
    
    repeat 3
    
    color 255,0,0
    pos 50+100*cnt,50
    dwmRect pImage,60,100,255-96*cnt
    
    color 0,0,255
    pos 50+100*cnt,240
    dwmRect pImage,60,100,255-96*cnt
    
    color 0,255,0
    pos 50+100*cnt,150
    dwmRect pImage,60,100,255-96*cnt
    
    loop
    oncmd gosub *lAeroChk,0x031E
    gosub *lAeroChk
    
    GetDC hwnd
    dc=stat
    repeat
    wait 1
    if aero{
        StretchDIBits dc,0,0,wx,wy,0,0,wx,wy,varptr(pImage),varptr(bmi),0,0xCC0020
    }else{
        StretchDIBits hdc,0,0,wx,wy,0,0,wx,wy,varptr(pImage),varptr(bmi),0,0xCC0020
        redraw
    }
    loop
    stop

*lAeroChk
    DwmIsCompositionEnabled varptr(aero)
    if aero!0{
        color 0,0,0 : boxf
        rect=0,0,40,250
        DwmExtendFrameIntoClientArea hwnd,varptr(rect)
    }else{
        syscolor 15 : boxf
    }
    return

*lEnd
    ReleaseDC hwnd,dc
    SelectObject hmdc,hOhandle
    DeleteDC(hmdc)
    DeleteObject(hBitmap)
    end


ついにうまくいった━━━━━━(゚∀゚)━━━━━━━!!!!!

と思ったのもつかの間、この方法、白になればなるほど透明度が無視されます。
白ェ・・・

もはやここまでか、と思ったがここでふと32bitDIBの代わりにGDI+使えば良いのではとなる。
その結果
ついに・・・!?
ついに念願の動作来たぞおお!




だがしかし




実ウインドウに直接転送してるため
画面外にウインドウを持っていくとこの通り一部が消えてしまいます。
アッー!
あぁんひどぅい・・・

消えたところを描きなおせばいい?
だがちょっと待ってほしい、本来オフスクリーンに描画→実スクリーンに転送することでチラツキをなくしているのに、一旦画面クリア→実スクリーンに直接描画を繰り返し行うと超点滅をおこしてしまいます。
結局は5年前と何も変わっていないという落ちでした。






と思いきや








原理はよくわかっていないのですが、本来すでにある画面の状態に重ねるように転送するものをアルファ値関係なくごっそり置き換えて転送することで、いったんクリアする必要なく再描画できているのかなと思います。
何はともあれこれでオシャンティなUIのツールが作れます!
#include "a2d.hsp"

#module
#uselib "user32"
#func GetDC "GetDC" int
#func ReleaseDC "ReleaseDC" int,int
#func DeleteObject "DeleteObject" int
#uselib "gdi32"
#func CreateDIBSection "CreateDIBSection" int,int,int,int,int,int

;------------------------------------------------------
;   alSetAeroGlass
;   現在選択中のウインドウをAeroGlass処理
;   対象ウインドウにする。
;   既に他のウインドウが対象の場合、
;   旧対象の解放処理が行われる。
;------------------------------------------------------
#deffunc alSetAeroGlass
    alReleaseAeroGlass
    wid=ginfo_sel
    GetDC hwnd
    dc=stat
    return dc
;------------------------------------------------------
;   alReleaseAeroGlass
;   AeroGlass処理対象ウインドウを解放する。
;   プログラムの終了時に自動的に呼び出される。
;------------------------------------------------------
#deffunc alReleaseAeroGlass onexit
    old_wid=ginfo_sel
    if dc:gsel wid:ReleaseDC hwnd,dc:gsel old_wid
    return 0
;------------------------------------------------------
;   alCopyImageToAeroGlass id,px,py,width,height
;   id = イメージID
;   px,py = 左上座標(省略可)
;   width,height = コピー縦横サイズ(省略可)
;   イメージIDの内容をAeroGlassウインドウに書き込む。
;   イメージIDの縦横サイズはAeroGlassウインドウと
;   同じサイズであること。
;   px,py,width,heightを省略した場合は
;   全画面コピーになる。
;------------------------------------------------------
#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=0,%3=0,%4=ginfo_winx,%5=ginfo_winy_alCopyImageToAeroGlass %1,%2,%3,%4,%5
#define alCopyHDCToImage(%1,%2,%3=0,%4=0,%5=ginfo_winx,%6=ginfo_winy_alCopyHDCToImage %1,%2,%3,%4,%5,%6

#uselib "dwmapi"
#func DwmIsCompositionEnabled "DwmIsCompositionEnabled" int
#func DwmExtendFrameIntoClientArea "DwmExtendFrameIntoClientArea" int,int

    wx=640
    wy=480
    screen 0,wx,wy,2

    alCreateImage 2,100,100
    alColor 128,255,0,128
    repeat 3
    alFillEllip (100-100/(cnt+1))/2,(100-100/(cnt+1))/2,100/(cnt+1),100/(cnt+1)
    loop
    alCreateImage 1,80,100
    repeat 2
    if cnt=0:alColor 0,0,0,255:else:alColor 255,255,255,255
    alFillEllip 0,cnt*25,7,7
    alFillEllip 73,cnt*25,7,7
    alFillEllip 0,18+cnt*25,7,7
    alFillEllip 73,18+cnt*25,7,7
    alFillRect 4,cnt*25,72,25
    alFillRect 0,4+cnt*25,80,17
    loop
    alCopyImageToImage 1,1,0,50,80,25,0,25
    alStretchImageToImage 1,1,0,0,80,25,1,51,78,23
    cmatrix(MAT_R) = 1.0, 0.0, 0.0, 0.0, 0.0
    cmatrix(MAT_G) = 0.0, 1.0, 0.0, 0.0, 0.0
    cmatrix(MAT_B) = 0.0, 0.0, 1.0, 0.0, 0.0
    cmatrix(MAT_A) = 0.0, 0.0, 0.0, 0.5, 0.0
    alCopyModeColorMatrix cmatrix
    alCopyImageToImage 1,1,0,50,80,14,0,25
    alResetCopyMode
    alCreateImage 0,wx,wy
    alErase
    
    alSysColor 15 : alFillRect 0,55,wx,wy-55-250
    
    alCopyImageToImage 2,0,5,5,100,100,0,0
    alCopyImageToImage 2,0,5,120,100,100,0,0
    cmatrix(MAT_R) = 1.0, 0.0, 0.0, 0.0, 0.0
    cmatrix(MAT_G) = 0.0, 1.0, 0.0, 0.0, 0.0
    cmatrix(MAT_B) = 0.0, 0.0, 1.0, 0.0, 0.0
    cmatrix(MAT_A) = 0.0, 0.0, 0.0, 0.5, 0.0
    alCopyModeColorMatrix cmatrix
    alCopyImageToImage 1,0,wx-285,15,80,25,0,50
    alCopyImageToImage 1,0,wx-185,15,80,25,0,0
    alCopyImageToImage 1,0,wx-85,15,80,25,0,25
    alResetCopyMode

    alFont "meiryo",14

    alColor 255,255,255,255
    alDrawText "ボタン風",wx-285,15,80,30,1,1

    alColor 255,255,255,255
    alDrawText "テスト ▽",wx-185,15,80,30,1,1

    alColor 0,0,0,255
    alDrawText "テスト ▽",wx-85,15,80,30,1,1
    
    alSysColor 7
    alDrawText "DWMとGDI+を使用したAeroGlassへの描画",0,65,wx,30,1,1
    
    alFont "meiryo",64
    alColor 0,128,255,255
    alDrawText "描画はGDI+で",10,60,wx,wy-60-250,1,1
    
    repeat 10
    alColor 255,255,255,(9-cnt)*25
    alFillRect cnt*64,wy-250,64,125
    alColor 0,0,0,(9-cnt)*25
    alFillRect cnt*64,wy-125,64,125
    loop
    alFont "meiryo",64
    alColor 0,0,0,255
    alDrawText "白地に黒文字デース",0,wy-250,wx,125,1,1
    alColor 255,255,255,255
    alDrawText "黒地に白文字デース",0,wy-125,wx,125,1,1

    onexit *lEnd
    gsel 0,1
    DwmIsCompositionEnabled varptr(aero)
    oncmd gosub *lAeroChk,0x031E
    oncmd gosub *lWRedraw,0x3   ;画面外に行った時に消えるので描画しなおす
    gosub *lAeroChk
    
    alSetAeroGlass
    d=stat
    gosub *lWRedraw
    //-- 一部だけ更新
    repeat
    alSysColor 15
    alFillRect 5,55,100,50
    alEraserBrush
    alFillRect 5,5,100,50
    alHsvColor cnt\192,255,255,128
    repeat 3
    alFillEllip (100-100/(cnt+1))/2+5,(100-100/(cnt+1))/2+5,100/(cnt+1),100/(cnt+1)
    loop
    if aero{
        alCopyImageToAeroGlass 0,5,5,100,100
    }else{
        redraw 0
        syscolor 15 : boxf 5,5,100+5-1,100+5-1
        alCopyImageToScreen 0,0,5,5,100,100,5,5
        redraw 1,5,5,100,100
    }
    await 10
    loop
    //---------------
    stop
*lWRedraw
    // 再描画(Aero環境の場合、画面外にウインドウが行くと再描画が必要)
    if aero{
        alCopyImageToAeroGlass 0
    }else{
        redraw 0
        syscolor 15 : boxf
        alCopyImageToScreen 0,0
        redraw
    }
    return

*lAeroChk
    DwmIsCompositionEnabled varptr(aero)
    if aero!0{
        color 0,0,0 : boxf
        rect=0,0,55,250
        DwmExtendFrameIntoClientArea hwnd,varptr(rect)
        await   ;何故かウエイトを入れないと表示されない(実ウインドウの生成がアニメーションのせいで間に合っていない?)
    }else{
        syscolor 15 : boxf
    }
    gosub *lWRedraw
    return

*lEnd
    end

※11/25:余計な定義部分を削除、各関数の説明追記

もうちょっと使いやすくしてからモジュールとして公開したいですね。
HOME
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。