Transparente Fenster in Xbase

[thomas]

Hallo.

Wie kann ich ein GUI-Fenster in Xbase transparent anzeigen.
(z.B. oDlg:SetTransparent := 85%)

Gruß

Thomas

[Tom]

Hallo, Thomas.

Ich weiß nicht genau, was Du erreichen willst. Jedenfalls: Folgender Code "zeigt" ein unsichtbares (transparentes) Fenster, das eine Grafik enthält, von der auch nur der Teil zu sehen ist, der nicht die Farbe RGB 255,255,0 hat.

Code: Alles auswählen

   oDlg := XbpDialog():new( AppDesktop(),,,{936,514} )
   oDlg:taskList := .F.
   oDlg:visible  := .F.
   oDlg:title    := "Test"
   oDlg:border   := XBPDLG_NO_BORDER // kein Rand
   oDlg:close    := {|mp1,mp2,obj| obj:destroy() }
   oDlg:titlebar := .F.
   oDlg:create()

   oPS := XbpPresSpace():new():create( oDlg:drawingArea:winDevice() )

   oImage   := XbpBitmap():new():create( oPS )
   oImage:load(,BITMAP_LOGO) // als Ressource einbinden
   oImage:transparentClr := GraMakeRGBColor({255,255,0})
   lBGClr := XBPSYSCLR_TRANSPARENT

   oDlg:drawingarea:paint := {|x,y,obj| x:=obj:currentSize(), ;
                               oImage:draw( oPS, {0, 0, x[1], x[2]}, ;
                               {0, 0, oImage:xSize, oImage:ySize},,;
                               GRA_BLT_BBO_IGNORE), Sleep(0.1) }

   oDlg:drawingArea:SetColorBG( lBGClr )

   aPos:= CenterPos( oDlg:currentSize(), AppDesktop():currentSize() )
   aPos[2] := aPos[2]
   oDlg:setPos( aPos )
   oDlg:show()
   oImage:draw( oPS )
   SetAppFocus( oDlg )

[thomas]

Hallo Tom.

Ich habe da etwas auf der MSDN gefunden. Ist ja leider nur für VB, aber
vieleicht könnte man dieses Beispiel nach Xbase portieren ?

http://www.microsoft.com/germany/msdn/l ... s2000.mspx

Gruß

Thomas

[Tom]

Hallo, Thomas.

Verstehe. Es gibt zwei API-Funktionen unter 2K/XP, mit denen man die Stilbits abfragen und setzen kann. Das sollte sich in Xbase auch umsetzen lassen. Ich schaue mal, ob ich das nachher hinkriege. Bin gespannt auf den Effekt.

[Tom]

Hallo, Thomas.

Here we go:

Code: Alles auswählen

#define GWL_EXSTYLE -20
#define WS_EX_LAYERED 0x80000
#define LWA_ALPHA 0x2

DLLFUNCTION GetWindowLongA( hWnd, nIndex ) ;
         USING STDCALL ;
          FROM USER32.DLL
DLLFUNCTION SetWindowLongA( hWnd, nIndex, dwNewLong ) ;
         USING STDCALL ;
          FROM USER32.DLL
DLLFUNCTION SetLayeredWindowAttributes( hWnd, crKey, bAlpha, dwFlags ) ;
         USING STDCALL ;
          FROM USER32.DLL

function SetWindowTransparency(hWnd,nPercent,lActive)
lExStyle := GetWindowLongA(hWnd, GWL_EXSTYLE)
If lActive
 lExStyle = lExStyle + WS_EX_LAYERED
 Else
 lExStyle = lExStyle - WS_EX_LAYERED
EndIf
SetWindowLongA(hWnd, GWL_EXSTYLE, lExStyle)
nTransparentValue = (1 - nPercent / 100) * 255
SetLayeredWindowAttributes(hWnd, 0, nTransparentValue, LWA_ALPHA)
return nil

Du rufst auf, indem Du das Handle des Fensters ermittelst

Code: Alles auswählen

nHwnd := SetAppWindow():GetHwnd()

und dann die Transparenz aktivierst:

Code: Alles auswählen

SetWindowTransparency(nHwnd,50,.T.)

Damit erzeugst Du eine 50%-ige Transparenz des Fensters. Der Code ist noch nicht ganz sauber, weil nach dem "IF lActive" eigentlich eine bitweise Veroderung und nach dem Else ein bitweises NICHT UND erfolgen sollte. Schnopelt trotzdem. Kühner Effekt.

[thomas]

Hallo Tom,

Das ist ja Super, werde gleich mal Deinen Porgrammcode testen.

Gruß

Thomas

[Tom]

Funktioniert gut. Siehe Anhang.

[thomas]

Hallo Tom,

Dein Programm funktioniert sehr gut. Ich habe ein paar kleine
Änderungen vorgenommen, so daß mann ein Fenster langsam oder schnell von 0% bis 100% Transparenz oder umgekehrt ein-/abblenden
kann.

Code: Alles auswählen

#define GWL_EXSTYLE -20
#define WS_EX_LAYERED 0x80000
#define LWA_ALPHA 0x2

#xtranslate SetDefault(<var>, <def>)        => iif(<var>==NIL, <var>:=<def>, <var>)

DLLFUNCTION GetWindowLongA( hWnd, nIndex ) USING STDCALL FROM USER32.DLL
DLLFUNCTION SetWindowLongA( hWnd, nIndex, dwNewLong ) USING STDCALL FROM USER32.DLL
DLLFUNCTION SetLayeredWindowAttributes( hWnd, crKey, bAlpha, dwFlags ) USING STDCALL FROM USER32.DLL

FUNCTION SetWindowLayered(hWnd,lActive)
LOCAL lExStyle := GetWindowLongA(hWnd, GWL_EXSTYLE)
SetDefault(lActive,.T.)
IF lActive
    IF !(lExStyle $ WS_EX_LAYERED)
        lExStyle := lExStyle + WS_EX_LAYERED
        SetWindowLongA(hWnd, GWL_EXSTYLE, lExStyle)
    ENDIF
ELSE
    IF (lExStyle $ WS_EX_LAYERED)
        lExStyle := lExStyle - WS_EX_LAYERED
        SetWindowLongA(hWnd, GWL_EXSTYLE, lExStyle)
    ENDIF
ENDIF
RETURN(NIL)

FUNCTION SetWindowTransparency(hWnd,nPercent,nToPercent,nSpeed)
LOCAL nTransparentValue
LOCAL nIx,nStep
SetDefault(nPercent,50)
SetDefault(nToPercent,nPercent)
SetDefault(nSpeed,1)
IIF(nToPercent < nPercent, nStep := -1*nSpeed, nStep := 1*nSpeed )
FOR nIx = nPercent TO nToPercent STEP nStep
    nTransparentValue := (1 - nIx / 100) * 255
    SetLayeredWindowAttributes(hWnd, 0, nTransparentValue, LWA_ALPHA)
NEXT nIx
nTransparentValue := (1 - nToPercent / 100) * 255
SetLayeredWindowAttributes(hWnd, 0, nTransparentValue, LWA_ALPHA)
RETURN(NIL)

Gruß

Thomas

[Tom]

Hallo, Thomas.

Irgendwas ist da vermurkst. Wo ist der Aufruf von SetWindowLayered()? Wie sind die Aufrufkonventionen?

[thomas]

Hi Tom.

Schau genau hin, ich habe aus Deiner Funktion den Aufruf für SetWindowLayered() in eine separate Funktion gepackt. Es hat den
Vorteil, das man ein Fenster transparent ausblenden kann ohne das es flickert. Leider verursacht ( zumindest bei mir) der Aufruf von SetWindowLayered(nHwnd,.T.) ein kurzes flickern des Fensters, wenn es bereits sichtbar ist.

Code: Alles auswählen

SetWindowLayered(hWnd,.T.)          // Stil setzen
SetWindowTransparency(hWnd,100) // unsichtbar machen
oDlg:Show()                                   // Fenster anzeigen
SetWindowTransparency(hWnd,100,0) // sichtbar machen

Gruß

Thomas

[Tom]

Verstehe. Ich schaue mal, ob ich das mit dem Flackern irgendwie hinkriege.

[boddy]

Hallo Tom & Tom !!!

Super geuler Effekt, gefällt mir sehr.
Leider habe ich das mit dem Flackern nicht hinbekommen.
Vielleicht sind es nur die Einstellungen von Bildschirm bzw. Grafikkarte.

Gruß
Armin

[Bernd Reinhardt]

Hallo.
Ich habt das ja ganz gut beschrieben, ich krieg auch ein transparentes Fenster hin, leider aber ohne Inhalt.
Soblad das Fenster in Transparentmodus geschaltet ist, kann ich nichts mehr ausgeben, und die bereits ausgegebenen Daten sind weg.
Was mach ich denn nur falsch. Hab schon vieles vesucht, geht aber nicht.
Gruß
Bernd

Code: Alles auswählen

******************************************************************************
* Application's Main() Procedure
******************************************************************************

PROCEDURE Main() 

   LOCAL nEvent, mp1, mp2, oXbp 
   Local nHwnd, oPS, oFont
   
   oDlg2 := XbpDialog():new( )
	oDlg2:minButton := .t.
   oDlg2:title    := "Meldung über Netzwerk "
   oDlg2:create( AppDesktop(), , {100,100}, {500,300})
   oDraw2 := oDlg2:drawingarea   
   oPs := oDraw2:lockPS()
   oFont := XbpFont(oPS):new():create("32.Helvetica")
   oFont := XbpFont(oPS):new():create("32.Helvetica") 
   GraSetFont( oPS ,oFont )
   GraStringAt( oPs, { 10, 80 }, "Bernd Reinhardt" )     
   oDlg2:show()
	setappwindow(oDlg2)
	setappfocus(oDlg2)
   DO WHILE nEvent <> xbeP_Close 
      nEvent := AppEvent( @mp1, @mp2, @oXbp ) 
      oXbp:HandleEvent( nEvent, mp1, mp2 ) 
   ENDDO   
   nEvent := 0
   nHwnd := oDlg2:GetHwnd() 

   SetWindowTransparency(nhWnd,6, .t.) 
   GraStringAt( oPs, { 10, 80 }, "Bernd Reinhardt" )     
   DO WHILE nEvent <> xbeP_Close 
      nEvent := AppEvent( @mp1, @mp2, @oXbp ) 
      oXbp:HandleEvent( nEvent, mp1, mp2 ) 
   ENDDO 
   oPs := oDraw2:unlockPS()      
   oDlg2:destroy()
   quit
return
      DLLFUNCTION MessageBeep(nMsgType) USING STDCALL FROM "USER32.DLL"
      DLLFUNCTION GetWindowLongA( hWnd, nIndex ) USING STDCALL FROM "USER32.DLL" 
      DLLFUNCTION SetWindowLongA( hWnd, nIndex, dwNewLong ) USING STDCALL FROM "USER32.DLL" 
      DLLFUNCTION SetLayeredWindowAttributes( hWnd, crKey, bAlpha, dwFlags ) USING STDCALL FROM "USER32.DLL"   
      
********************************************************************************************
Function SetWindowTransparency(hWnd,nPercent,lActive) 
   lExStyle := GetWindowLongA(hWnd, GWL_EXSTYLE) 
   If lActive 
      lExStyle = lExStyle + WS_EX_LAYERED 
   Else 
      lExStyle = lExStyle - WS_EX_LAYERED 
   EndIf 
   SetWindowLongA(hWnd, GWL_EXSTYLE, lExStyle) 
   nTransparentValue = (1 - nPercent / 100) * 255 
   SetLayeredWindowAttributes(hWnd, 0, nTransparentValue, LWA_ALPHA) 
return nil 

***************************************************************************************

[Martin Altmann]

Hallo Bernd,
Joe Carrick hat Dir ja in der Alaska-Newsgroup geantwortet - hast Du seinen Vorschlag mal ausprobiert und klappt es damit nicht?
Hier noch mal für die Anderen das Posting von Joe:

Hallo Bernd,

packe die GraFunktionen in eine eigene function (MyGraFunction(oSelf)). Du solltest :microPS() anstelle von XbpPresSpace() benutzen. Dann überschreibe den oDraw2:paint() callback um diese Funktion aufzurufen. z.B.:

Code: Alles auswählen

oDraw2:paint := {| aRect, uNIL, self | MyGraFunction(self) }

Stelle sicher, dass Du den Presentation Space am Ende der MyGraFunction() zerstörst.

Beispiel:

Code: Alles auswählen

MyGrafunction( oSelf )

     Local oPS := oSelf:lockPS()

     oFont := XbpFont(oPS):new():create("32.Helvetica")
     GraSetFont( oPS ,oFont )
     GraStringAt( oPs, { 10, 80 }, "Bernd Reinhardt" )

     oSelf:unLockPS(oPS)

RETURN

Das bewirkt, dass die GraFunktionen immer wieder neu ausgeführt werden, wenn die :drawingArea des Dialoges neu gemalt wird.

-Joe

Viele Grüße,
Martin

[Bernd Reinhardt]

Hallo Martin.
Danke für die Info, ich habe die Änderung von Joe eingebaut. Es ist jetzt so, dass ich eine Ausgabe erhalte. Allerdings ist dieser Text nicht transparent, sondern nur das Fenster.
Das Bild, welches Tom am 30.11.2005 hier ins Forum gestellt hat, ist aber komplett (also einschl. aller z. B. grastring) transparent.
Allerdings arbeite ich hier mit WIN2K, müsste aber hier auch gehen.

Bernd

[brandelh]

Hallo,

darf ich mal aus Neugierde fragen warum man transparente Fenster haben will ?
Der Nutzen will mir nicht einleuchten ... eventuell für die Augenärzte und Optiker

[Bernd Reinhardt]

Hallo.
Mit dem CRT Fenster kann man keinen Vollbildmodus machen.
Nur halt fast Vollbild.
Teilweise habe ich noch GET-Eingabefelder und SAY als Ausgabe.
Sieht halt in den Augen mancher Kunden noch nach DOS aus.
Wenn dann halt Windowseffekte möglich sind, und auch ohne großen Aufwand möglich, dann baue ich schon mal solche Effekte ein.
Über den Sinn kann man streiten, aber bei einigen Kunden ist es wie beim essen. Das Auge ißt mit, und je mehr Windowslike desto besser.
Zudem habe ich ein Fenster welches ON TOP läuft und Daten anzeigt. Wenn der Kunde das darunter liegende Fenster anklieckt, so möchte ich das ONTOP-Fenster transparenter machen. Die Daten sind dann noch sichtbar, aber transparent.
Macht mein Editor mit dem Suchfenster (Textpad) auch. Ist manchmal ganz nett.
Bernd

[AUGE_OHR]

hi,

habe es schon in den :resize Thread geschrieben das man mit
SetWindowLayered(hWnd,.T.) bei :resize des Titlebar "nach oben"
dann den Effect erhält das die :drawingArea "nach unten" rutscht

man muss also vor dem :resize SetWindowLayered(hWnd,.F.) setzten
was wohl auch der "Flacker Effekt" war/ist.

[AUGE_OHR]

hi,

ich habe unter
http://www.xbaseforum.de/viewtopic.php?p=26513#26513
einen neuen Thread hierzu eröffnet.

[AUGE_OHR]

hi,

weil hier hier die beiden DLL FUnction SetWindowLongA() / GetWindowLongA() vorkommen

Code: Alles auswählen

#define GWL_EXSTYLE -20
#define WS_EX_LAYERED 0x80000
#define LWA_ALPHA 0x2

DLLFUNCTION GetWindowLongA( hWnd, nIndex ) ;
         USING STDCALL ;
          FROM USER32.DLL
DLLFUNCTION SetWindowLongA( hWnd, nIndex, dwNewLong ) ;
         USING STDCALL ;
          FROM USER32.DLL
DLLFUNCTION SetLayeredWindowAttributes( hWnd, crKey, bAlpha, dwFlags ) ;
         USING STDCALL ;
          FROM USER32.DLL

SetWindowLongA(hWnd, GWL_EXSTYLE, lExStyle)

Frage dazu weil etwas ähnliches :

Code: Alles auswählen

hwndPB := oProgress:hWnd
SetWindowLongA(hwndPB, GWL_STYLE, PBS_MARQUEE )
SendMessageA(hwndPB, PBS_MARQUEE    , 1, 200)

was leider nicht funktioniert sobald ich SetWindowLongA() aufrufe "verschwindet"
mein Progressbar
jemand einen Tip was da passieren könnte ?

[gf210957]

Hallo Tom,

nur zur Info: Leider kann ich Dein Bild nicht anzeigen. Liegt das an meinem Browser?

Gruß aus Albstadt

Günter Früholz

[Tom]

Hallo, Günter.

Das ist beim Forenumzug verschüttgegangen, weil ich die Bilddatei direkt ins Verzeichnis des alten Forums geladen hatte. Ist aktualisiert, müsste jetzt also wieder zu sehen sein.