Transparentes Multiedit

[Ralph Theobald]

Hier mal einen Code für ein transparentes Fenster.
Eigentlich nichts Spektakuläres, wenn nicht das Multiedithintergrund auch
transparent wäre. Funtkioniert bei anderen Controls nicht.


$P+
SetErrorLevel 0


' Position von WFFORMS7.INC nicht verändern!
$I C:\PRFellow\LIB\WFFORMS7.INC
def SetWindowLong(3) !"USER32","SetWindowLongA"
def GetWindowLong(2) !"USER32","GetWindowLongA"
def SetLayeredWindowAttributes(4) !"USER32","SetLayeredWindowAttributes"

def &GWL_EXstyle -20
def &WS_EX_LAYERED $80000

Proc TransParent
Parameters element&,transcolor&,Janein&
declare Ret&
Ret&=Getwindowlong(element&,-20)
Ret&=Ret& | $80000
Setwindowlong(element&,&GWL_EXstyle,Ret&)
If janein&
SetLayeredWindowAttributes(element&,0,TransColor&,$1)
else
SetLayeredWindowAttributes(element&,0,255,$1)
endif
endproc
Proc preparehdl4alpha
Parameters hdl&
SetWindowLong(hdl&, -20, @xOr(GetWindowLong(hdl&,-20),$80000));
EndProc

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




Proc alpha2
Parameters hdl&,aval%
SetWindowLong(hdl&, -20, @Or(GetWindowLong(hdl&,-20),$80000));
SetLayeredWindowAttributes(hdl&, 0, aval%, $2);
EndProc

declare i%
' *** GlobalStatements der Form


' *** GlobalStatements der Form-Controls

Proc OnApplicationExit

EndProc

Proc OnApplicationInit

EndProc
OnApplicationInit

Declare appexit%
Declare MultiEdit1&



SetTrueColor 1
WindowStyle $003F
WindowTitle ""
Window Add(%maxX,5),114 - 498,408
Cls GetSysColor(15)
UseFont "MS Sans Serif",13,0,0,0,0
SetDialogFont 1
SetFormIcon "",0
Let MultiEdit1&=CreateMultiEdit(%hwnd,"",40,50,202,249)
ClearList
AddString "'Gallia est omnis divisa in partes tres, quarum unam incolunt '"
AddString "Belgae, aliam Aquitani, tertiam, qui ipsorum lingua Celtae, '"
AddString "nostra Galli appellantur. Hi omnes lingua, institutis, '"
AddString "legibus inter se differunt. Gallos ab Aquitanis Garunna '"
AddString "flumen, a Belgis Matrona et Sequana divit.\nHorum omnium '"
AddString "foritissimi sunt Belgae, propterea quod a cultu atque '"
AddString "humanitate provinciae longissime absunt minimeque ad eos '"
AddString "mercatores saepe commeant atque ea, quae ad effeminandos '"
AddString "animos pertinent, important proximique sunt Germanis, qui '"
AddString "trans Thenum incolunt, quibuscum continenter bellum '"
AddString "gerunt.\n\nApud Helvetios longe noblilissimus fuit et '"
AddString "ditissimus Orgetorix. Is M. Messala M. Pisone consulibus '"
AddString "regni cupiditate inductus coniurationem nobilitatis fecit '"
AddString "et civitati persuasit, ut de finibus suis cum omnibus '"
AddString "copiis exirent: perfacile esse, cum virtute omnibus '"
AddString "praestarent, totius Galliae imperio potiri.\nId hoc '"
AddString "gacilius iis persuasit, quod undique loci natura Helvetii '"
AddString "continentur: una ex parte flumine Rheno latissimo atque '"
AddString "altissimo, qui agrum Helvetium a Germanis dividit, altera '"
AddString "ex parte monte Iura altissimo, qui est inter Sequanos '"
AddString "et Helvetios, tertia lacu Lemanno et flumine Thodano, '"
AddString "qui provinciam nostram ab Helvetiis dividit.\n'"
AddString "\nG. J. Caesar';"
MoveListToEdit(MultiEdit1&)
ClearList
preparehdl4alpha %hwnd
SetWindowPos %hwnd = 207,114 - 498,408;0

WhileNot appexit%


alpha %hwnd,190

'TransParent %hwnd,100,0
If Equ(%key,2)
Let appexit%=1
ElseIf GetFocus(MultiEdit1&)

ElseIf Equ(%key,4)
' Fenstergröße
ElseIf Equ(%key,5)
' Hilfe
EndIf
WaitInput
Wend
OnApplicationExit

[Ralph Theobald]

Hier ist der richtige Code


$P+
SetErrorLevel 0


' Position von WFFORMS7.INC nicht verändern!
$I C:\PRFellow\LIB\WFFORMS7.INC
def SetWindowLong(3) !"USER32","SetWindowLongA"
def GetWindowLong(2) !"USER32","GetWindowLongA"
def SetLayeredWindowAttributes(4) !"USER32","SetLayeredWindowAttributes"

def &GWL_EXstyle -20
def &WS_EX_LAYERED $80000

Proc TransParent
Parameters element&,transcolor&,Janein&
declare Ret&
Ret&=Getwindowlong(element&,-20)
Ret&=Ret& | $80000
Setwindowlong(element&,&GWL_EXstyle,Ret&)
If janein&
SetLayeredWindowAttributes(element&,0,TransColor&,$1)
else
SetLayeredWindowAttributes(element&,0,255,$1)
endif
endproc

declare i%
' *** GlobalStatements der Form


' *** GlobalStatements der Form-Controls

Proc OnApplicationExit

EndProc

Proc OnApplicationInit

EndProc
OnApplicationInit

Declare appexit%
Declare MultiEdit1&



SetTrueColor 1
WindowStyle $003F
WindowTitle ""
Window Add(%maxX,5),114 - 498,408
Cls GetSysColor(15)
UseFont "MS Sans Serif",13,0,0,0,0
SetDialogFont 1
SetFormIcon "",0
Let MultiEdit1&=CreateMultiEdit(%hwnd,"",40,50,402,249)
ClearList
AddString "'Gallia est omnis divisa in partes tres, quarum unam incolunt '"
AddString "Belgae, aliam Aquitani, tertiam, qui ipsorum lingua Celtae, '"
AddString "nostra Galli appellantur. Hi omnes lingua, institutis, '"
AddString "legibus inter se differunt. Gallos ab Aquitanis Garunna '"
AddString "flumen, a Belgis Matrona et Sequana divit.\nHorum omnium '"
AddString "foritissimi sunt Belgae, propterea quod a cultu atque '"
AddString "humanitate provinciae longissime absunt minimeque ad eos '"
AddString "mercatores saepe commeant atque ea, quae ad effeminandos '"
AddString "animos pertinent, important proximique sunt Germanis, qui '"
AddString "trans Thenum incolunt, quibuscum continenter bellum '"
AddString "gerunt.\n\nApud Helvetios longe noblilissimus fuit et '"
AddString "ditissimus Orgetorix. Is M. Messala M. Pisone consulibus '"
AddString "regni cupiditate inductus coniurationem nobilitatis fecit '"
AddString "et civitati persuasit, ut de finibus suis cum omnibus '"
AddString "copiis exirent: perfacile esse, cum virtute omnibus '"
AddString "praestarent, totius Galliae imperio potiri.\nId hoc '"
AddString "gacilius iis persuasit, quod undique loci natura Helvetii '"
AddString "continentur: una ex parte flumine Rheno latissimo atque '"
AddString "altissimo, qui agrum Helvetium a Germanis dividit, altera '"
AddString "ex parte monte Iura altissimo, qui est inter Sequanos '"
AddString "et Helvetios, tertia lacu Lemanno et flumine Thodano, '"
AddString "qui provinciam nostram ab Helvetiis dividit.\n'"
AddString "\nG. J. Caesar';"
MoveListToEdit(MultiEdit1&)
ClearList

SetWindowPos %hwnd = 207,114 - 498,408;0

WhileNot appexit%
TransParent %hwnd,255,1
If Equ(%key,2)
Let appexit%=1
ElseIf GetFocus(MultiEdit1&)

ElseIf Equ(%key,4)
' Fenstergröße
ElseIf Equ(%key,5)
' Hilfe
EndIf
WaitInput
Wend
OnApplicationExit

[Frabbing]

Versuch mal an die Codetags zu denken, Ralph. Ist sonst immer schwer lesbar der Code, und unstrukturiert.