XProfan

Gemerkt/Separiert von http://xprofan.com/thread.core?t=7077
Autor: Andreas Miethe
 $H Windows.ph
 $H messages.ph
 $H commctrl.ph
def %LWA_ALPHA $2
def %GWL_EXSTYLE -20
def %WS_EX_LAYERED $80000
def %WS_EX_TRANSPARENT $20
def SetWindowLong(3) !"USER32","SetWindowLongA"
def GetWindowLong(2) !"USER32","GetWindowLongA"
def SetLayeredWindowAttributes(4) !"USER32","SetLayeredWindowAttributes"

Proc SetTransparent

    Declare Old&
    Parameters Hwnd%, Perc%
    Old& = GetWindowLong(Hwnd%,%GWL_EXSTYLE)
    SetWindowLong(Hwnd%, %GWL_EXSTYLE, (Old& | %WS_EX_LAYERED));
    SetLayeredWindowAttributes(Hwnd%, RGB(31,31,31), (255 * Perc%) / 100,$2)

EndProc

DEF ExtractIcon(3) ! "SHELL32","ExtractIconA"
Def Setwindowposition(7) !"USER32","SetWindowPos"
Def ReleaseCapture(0) !"USER32","ReleaseCapture"

PROC CreateIconButton

    Parameters hndl&,icoInd&,Res$,x%,y%,x1%,y1%
    Declare ico#,icohndl&,Bhndl&
    Dim ico#,(Len(Res$)+1)
    String ico#,0 = Res$
    icohndl& = ExtractIcon(%Hinstance,ico#,icoInd&)
    Bhndl&=Control("BUTTON","",$50000340,x%,y%,x1%,y1%,hndl&,0,%hinstance,$020)
    Sendmessage(Bhndl&,$00F7,1,icohndl&)
    Dispose ico#
    Return Bhndl&

ENDPROC

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
SetTrueColor 1
Windowstyle 93
Windowtitle ""
Window 0,0 - %maxx,40
var Hwnd&=%Hwnd
cls @RGB(31,31,31)
@Setwindowposition(Hwnd&,-1,0,0,%maxx,40,42)
SetTransparent %Hwnd, 30
Var p& = Control("#32770","",$90000000,%winright-54,%wintop+4,32,32,%hwnd,0,%hInstance,0)
Var Icon20& = CreateICONBUTTON(p&,27,"SHELL32.DLL",0,0,0,0)
@Create("Tooltip",%hwnd,ICON20&,"Beendet das Programm")
SetWindowPos icon20&=0,0-32,32;0
SetFocus(%hwnd)
Usermessages ~WM_MOVE
Var ende& = 0

whilenot ende&

    waitinput
    GetMessage

    If GetFocus(icon20&)

        ende& = 1

    ElseIf (%message=$201) & GetFocus(Hwnd&)

        UseCursor 5
        ~SetParent(p&,%hwnd)
        ~Movewindow(p&,width(%hwnd)-52,1,32,32)
        SendMessage(%hwnd,$112,$F012,0)
        ReleaseCapture()
        ~SetParent(p&,0)
        ~Movewindow(p&,%winright-54,%wintop+4,32,32)
        UseCursor 0
        SetFocus(%hwnd)

    EndIf

FIN