XProfan

Hi,

Yo como ni Variante: Das Ventana taucht de el Nichts en y verschwindet genauso elegant otra vez. Basierend en uno Presentación de Sven Schmidts.
Kompilieren Marca Separación

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

End

Viel Spaß beim Experimentieren
Christian

XProfan 8/9.1, Win XP, AMD 64/3200

Noch ne Variante:
Kompilieren Marca Separación

 {$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

Salve, IF

Hi, IF!
Seufz - como sieht uno sólo el Profi al Werk!

Na warte - mein Auto ha auch ya gemeint: Wenn Yo una vez groß bin, voluntad Yo una Ferrari! :+D)--

Saludo, Christian

XProfan 8/9.1, Win XP, AMD 64/3200

Also el ha doch nun wirklich nix con Profi hin oder her a tun - el es doch wirklich nurn normaler quelly.

Salve, IF

War en efecto nurn :+D)--

Aber me gefällt el irrsinnig bien, como simplemente manche Dinge con su genialen XPSE (y XProfan 9) a verwirklichen son. Deshalb -->

Apropos XPSE: En mi derzeitigen Projekt steigt XPSE de. Im Log kommt él sólo a Loading, mehr passiert no. Todos los demás Progs, el Yo así getestet habe, trabajo aber. Desde que aber siempre todavía etliche kleinere Fehler en mi Code auszubügeln habe, ha lo para mich momentan no viel Sinn, el auch todavía con el XPSE a testen. Yo verspreche Usted aber, si el Prog fertig es (el voluntad entonces así schätzomativ 15000 Zeilen voluntad) y Profano2cpp auch no Fehler mehr meldet, Su XPSE como ran que se - Usted wolltest sí, daß veces una correcto großer Code getestet se.

Saludo, Christian

XProfan 8/9.1, Win XP, AMD 64/3200

Yo sería mich wirklich freuen a wissen por qué xpse aussteigt. Tal vez simplemente veces Passagen kicken para determinar woran lo liegt.

Grade para Entwickeln größerer Projekte - y en Flüchtigkeitsfehler a verringern - es xpse geeignet - porque solch Fehler findet xpse.

Salve, IF