XProfan

GrowingWindow
Autor: Christian Bernfeld
DEF GetSysColor(1)   ! "USER32","GetSysColor"
Declare G%,Neutral&,Text1$,Text2$
Neutral& = GetSysColor(15)
WindowStyle 538
WindowTitle "Hoppla - da geht jan Fenster auf ..."
Declare x%,y%,PosX%,PosY%,Xeff%,Yeff%,LX%,LY%
x% = 800
y% = 600
PosX% = (%maxx/2)-(x%/2)
PosY% = (%maxy/2)-(y%/2)
Window 0,0 - 0,0
Cls Neutral&
UseFont "MS Sans Serif",15,0,1,0,0
SetDialogFont 1
Text1$ = @Create("Text",%Hwnd,"Nur eine kleine optische Spielerei",40,40,300,13)
Text1$ = @Create("Text",%Hwnd,"Taste oder Maus zum Beenden...",520,500,240,13)

WhileLoop 1,100

    Sleep 5
    INC G%
    Xeff% = x%*G%/100
    Yeff% = y%*G%/100
    LX% = (%maxx/2)-(Xeff%/2)
    LY% = (%maxy/2)-(Yeff%/2)
    setwindowpos %Hwnd = LX%,LY% - Xeff%,Yeff%;0

EndWhile

WaitInput

WhileNot G% = 1

    Sleep 1
    DEC G%
    Xeff% = x%*G%/100
    Yeff% = y%*G%/100
    LX% = (%maxx/2)-(Xeff%/2)
    LY% = (%maxy/2)-(Yeff%/2)
    setwindowpos %Hwnd = LX%,LY% - Xeff%,Yeff%;0

EndWhile

End

GrowingDisappearingWindow
Autor: Christian Bernfeld
DEF GetSysColor(1)   ! "USER32","GetSysColor"
Declare G%,Neutral&,Text1$,Text2$
Neutral& = GetSysColor(15)
Die folgende Prozedur "SetTransparent" wurde von Sven Schmidts veröffentlicht,
ich habe sie nur für meine Zwecke etwas modifiziert
PROFAN²-NT-TEAM-Vorlage
Autor: Sven Schmidts, concept/design
Titel: Transparent Window @ Win2k
Beschreibung: Sorgt für diesen "netten" Effekt; Transparente Fenster unter Windows (>=) 2000
Copyright © 2000-2001 Sven Schmidts, schmidts@cdesign.de
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, @Or(Old&,%WS_EX_LAYERED));
    SetLayeredWindowAttributes(Hwnd%, 0, (255 * Perc%) / 100, %LWA_ALPHA);

EndProc

WindowStyle 538
WindowTitle "Hoppla - da geht jan Fenster auf ..."
Declare x%,y%,PosX%,PosY%,Xeff%,Yeff%,LX%,LY%
x% = 800
y% = 600
PosX% = (%maxx/2)-(x%/2)
PosY% = (%maxy/2)-(y%/2)
Window 0,0 - 0,0                      zuerst "neben" den Bildschirm
Cls Neutral&
UseFont "MS Sans Serif",15,0,1,0,0
SetDialogFont 1
Text1$ = @Create("Text",%Hwnd,"Noch so eine kleine optische Spielerei",40,40,300,13)
Text1$ = @Create("Text",%Hwnd,"Taste oder Maus zum Beenden...",520,500,240,13)
***** Variante 1: Abnehmende Transparenz ******
SetTransparent %Hwnd, 0
setwindowpos %Hwnd = PosX%,PosY% - x%,y%;0

WhileLoop 1,100

    Sleep 1
    SetTransparent %Hwnd, G%
    INC G%

EndWhile

***** Oder Variante 2 - beide Methoden kombiniert *****
Voraussetzung für Kombination beider Methoden:
Relativ leistungsstarker PC (v.a. Grafikkarte), sonst ruckelts zu stark

WhileLoop 1,100

    Sleep 1
    SetTransparent %Hwnd, G%
    INC G%
    Xeff% = x%*G%/100
    Yeff% = y%*G%/100
    LX% = (%maxx/2)-(Xeff%/2)
    LY% = (%maxy/2)-(Yeff%/2)
    setwindowpos %Hwnd = LX%,LY% - Xeff%,Yeff%;0

EndWhile

WaitInput

WhileNot G% = 1

    Sleep 1
    SetTransparent %Hwnd, G%
    DEC G%
    Xeff% = x%*G%/100
    Yeff% = y%*G%/100
    LX% = (%maxx/2)-(Xeff%/2)
    LY% = (%maxy/2)-(Yeff%/2)
    setwindowpos %Hwnd = LX%,LY% - Xeff%,Yeff%;0       auch hier können beide Methoden kombiniert werden

EndWhile

End

 {$cleq}
def SetWindowLong(3) !"USER32","SetWindowLongA" :
def GetWindowLong(2) !"USER32","GetWindowLongA"
def SetLayeredWindowAttributes(4) !"USER32","SetLayeredWindowAttributes"
declare i&
buildmainwin
for i&:=0 to 255 step 3 do alpha %hwnd,i&
print "Click" : waitinput
for i&:=255 downto 0 step 3 do alpha %hwnd,i&
end

Proc preparehdl4alpha

    Parameters hdl&
    SetWindowLong(hdl&, -20, @Or(GetWindowLong(hdl&,-20),$80000));

EndProc

Proc alpha

    Parameters hdl&,aval%
    SetLayeredWindowAttributes(hdl&, 0, aval%, $2);

EndProc

proc buildmainwin

    windowstyle 80 : window 0,0 - 0,0 : preparehdl4alpha %hwnd : alpha %hwnd,0
    setwindowpos %hwnd = 0,0 - %maxx,%maxy
    cls 0 : showcursor 0

endproc