XProfan

Hi,

I have there another Variante: the Window diving from the nothing on and disappears just as elegant again. based on of/ one Presentation of Sven Schmidts.
Compile Mark Separation

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

plenty Fun at experiment
Christian

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

yet ne Variante:
Compile Mark Separation

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

salvo, iF

Hi, iF!
Seufz - there sees one hold whom Profi on the Werk!

well were - my car has already meant: If I once big be, I will one Ferrari! :+D)--

Greeting, Christian

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

means the has still now really nothing with Profi there or since To do - this is still really nurn normal quelly.

salvo, iF

was indeed nurn :+D)--

but me gefällt the irrsinnig well, How simply some items with your genialen XPSE (and XProfan 9) To verwirklichen are. therefore -->

Apropos XPSE: with my derzeitigen proposition soar XPSE from. in the log comes it only To Loading, More happens not. All other Progs, The I so tested have, functions but. Since I but still etliche smaller ones Error in my code auszubügeln have, has it for me momentarily not plenty sense, whom too yet with the XPSE To testing. I verspreche you but, if the Prog is done (the then so schätzomativ 15000 Lines go) and Profan2cpp too no Error More reports, your XPSE there ran To let - You wanted Yes, that time one correctly. great code tested becomes.

Greeting, Christian

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

i'd me really forward to know Why xpse aussteigt. Perhaps simply time Passagen kicken to determine Why it's located.

Grade to that develop larger projects - and circa Flüchtigkeitsfehler To to diminish - is xpse suitable - because such Error finds xpse.

salvo, iF