XProfan

Deutsch

Julian
Schmidt

Hallo,

durch diesen Thread möchte ich den WinXP-Bug aus Screencapture[...]

beheben.

Es handelt sich dabei um einen Anzeige-Fehler welcher unter WinXP auftritt.
Unter Window 7 & Co sieht man einen schwarz eingefärbten Hintergrund und ein weißes Steuerkreuz welches den Cursor verfolgt. Unter WinXP ist Nichts zu sehen.

Kompilieren Markieren Separieren

Def SetLayeredWindowAttributes(4) !"USER32","SetLayeredWindowAttributes"
def SetWindowRgn(3) !"USER32","SetWindowRgn"
def RectRgn(4) !"GDI32","CreateRectRgn"
Declare fenster&[], x&, posx&, posy&
WindowStyle 240+1024
Window %MaxX,%MaxY,0,0

Whileloop 2

    fenster&[&loop]=Create("Window",%hwnd,"",%MaxX,%MaxY,0,0)'fenster&[1] - Schwarze Blende
    SetTransparent(fenster&[&loop],IF(&loop=1,55,20))'fenster&[2] - Durchsichtiger Klickschutz
    SetWindowPos fenster&[&loop]=0,0 - %MaxX, %MaxY;-1

EndWhile

ShowCursor 0

WhileNot iskey(27)

    Waitinput 10
    posx&=CursorPos("X1")
    posy&=CursorPos("Y1")
    StartPaint fenster&[1]
    CLS 0
    EndPaint
    CutRgnDLG(fenster&[1],RectRgn(0,posy&,posx&,posy&+1),RectRgn(posx&+1,posy&,%MaxX,posy&+1),RectRgn(posx&,0,posx&+1,posy&),RectRgn(posx&,posy&+1,posx&+1,%MaxY))
    CutRgnDLG(fenster&[2],RectRgn(0, 0, posx&, posy&),RectRgn(posx&+1, 0, %MaxX, posy&),RectRgn(0, posy&+1, posx&, %MaxY),RectRgn(posx&+1, posy&+1, %MaxX, %MaxY))

Endwhile

end

Proc SetTransparent

    Parameters Hwnd%, Perc%
    External("USER32","SetWindowLongA",Hwnd%, -20, External("USER32","GetWindowLongA",Hwnd%,-20) | $80000)
    SetLayeredWindowAttributes(Hwnd%, 0, (255 * Perc%) / 100, $2)

EndProc

Proc CutRgnDLG

    Parameters hdl&
    Declare region&,wRgn&
    wRgn&=RectRgn(0,0,width(hdl&)+100,height(hdl&)+100)

    whileloop 2,%PCount

        region&=@&(&loop)
        External("GDI32","CombineRgn",wRgn&,region&,wrgn&,3)
        DeleteObject region&

    EndWhile

    SetWindowRgn(hdl&, wRgn&, 1)
    Return wRgn&

EndProc

Proc WindowRect

    Parameters hdl&,Modus$
    Modus$=Lower$(Modus$)
    Declare x%, b#
    Dim b#,16
    External("USER32", "GetWindowRect",hdl&,b#)
    Case @&(3)<>0 : External("USER32","ScreenToClient",@&(3),b#) : External("USER32","ScreenToClient",@&(3),b#+8)
    Case Modus$="breite" : x%=Long(b#,8)-Long(b#,0)
    Case Modus$="höhe" : x%=Long(b#,12)-Long(b#,4)
    Case Modus$="x1" : x%=Long(b#,0)
    Case Modus$="y1" : x%=Long(b#,4)
    Case Modus$="x2" : x%=Long(b#,8)
    Case Modus$="y2" : x%=Long(b#,12)
    Dispose b#
    Return x%

EndProc

Proc CursorPos

    Parameters Modus$
    Modus$=Lower$(Modus$)
    Declare x%, mpos#
    Dim mpos#,8
    External("user32","GetCursorPos",mpos#)
    Case @&(2)<>0 : External("USER32","ScreenToClient",@&(2),mpos#)
    Case Modus$="x1" : x%=long(mpos#,0)
    Case Modus$="y1" : x%=long(mpos#,4)
    Case Modus$="x2" : x%=IF(@&(2)<>0,WindowRect(@&(2),"Breite"),%maxx)-long(mpos#,0)
    Case Modus$="y2" : x%=IF(@&(2)<>02,WindowRect(@&(2),"Höhe"),%maxy)-long(mpos#,4)
    Dispose mpos#
    Return x%

EndProc

LG

Julian

XProfan X2
Win7 Professional, SP1, AMD FX(tm)-8350 Eight-Core Processor
˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗
Webseite [...]

01.01.2013 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

- Seite 1 -

Julian
Schmidt

Will mir keiner helfen?

29.01.2013 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Daran liegts nicht,

die Frage ist nur zu allgemein gestellt bzw. der Code dazu zeigt zwar ein Problem
aber beschreibt kein konkretes Problem bzw. ist vlt. sogar zu umfangreich als das
erkenntlich ist das es um ein bestimmtes Problem geht.

Beispielsweise weiß ich nach Andreas Miethes Hinweisen garnicht mehr auf
welchem Stand der Text ist.

Mach doch mal einen Dreizeiler der das Problem aufzeigt und benenne das
konkrete Problem nochmals.

XProfan X2
WinXP, SP3, Core(TM) i7-3770 @ 3.40GHz

29.01.2013 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Julian
Schmidt

Nicht unbedingt ein 3. Zeiler sollte aber ok sein.
Ich möchte das keine Titelleiste und Rahmen eingeblendet werden.
Windowstyle scheint irgendwie nicht zu funktionieren.

Kompilieren Markieren Separieren

Def SetLayeredWindowAttributes(4) !"USER32","SetLayeredWindowAttributes"
def SetWindowRgn(3) !"USER32","SetWindowRgn"
def RectRgn(4) !"GDI32","CreateRectRgn"
cls
Var dlg&=Create("Window",%hwnd,"",0,0,%MaxX,%MaxY)
SetTransparent(dlg&,50)
Showwindow(dlg&,1)
CutRgnDLG(dlg&,RectRgn(0,0,0,0))

WhileNot iskey(27)

Endwhile

end

Proc SetTransparent

    Parameters Hwnd%, Perc%
    External("USER32","SetWindowLongA",Hwnd%, -20, External("USER32","GetWindowLongA",Hwnd%,-20) | $80000)
    SetLayeredWindowAttributes(Hwnd%, 0, (255 * Perc%) / 100, $2)

EndProc

Proc CutRgnDLG

    Parameters hdl&
    Declare region&,wRgn&
    wRgn&=RectRgn(0,0,width(hdl&)+100,height(hdl&)+100)

    whileloop 2,%PCount

        region&=@&(&loop)
        External("GDI32","CombineRgn",wRgn&,region&,wrgn&,3)
        DeleteObject region&

    EndWhile

    SetWindowRgn(hdl&, wRgn&, 1)
    Return wRgn&

EndProc

29.01.2013 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

- Seite 2 -

Ich schätze dass das was Du möchtest so nicht funktioniert da Du einerseits
einen Dialog benötigst (damit Transluzenz bei allen OS funktioniert) und andererseits
vom Aussehen her ein Static.

Maximal geht wohl nur:
Kompilieren Markieren Separieren

Def SetLayeredWindowAttributes(4) !"USER32","SetLayeredWindowAttributes"
def SetWindowRgn(3) !"USER32","SetWindowRgn"
def RectRgn(4) !"GDI32","CreateRectRgn"
cls
Var dlg&=Create("Dialog",%hwnd,"",100,100,300,300)
SetTransparent(dlg&,50)
setstyle dlg&,(getstyle(dlg&) | ws_caption) - ws_caption
'Showwindow(dlg&,1)
'CutRgnDLG(dlg&,RectRgn(0,0,0,0))
waitinput
end

Proc SetTransparent

    Parameters Hwnd%, Perc%
    External("USER32","SetWindowLongA",Hwnd%, -20, External("USER32","GetWindowLongA",Hwnd%,-20) | $80000)
    SetLayeredWindowAttributes(Hwnd%, 0, (255 * Perc%) / 100, $2)

EndProc

Proc CutRgnDLG

    Parameters hdl&
    Declare region&,wRgn&
    wRgn&=RectRgn(0,0,width(hdl&)+100,height(hdl&)+100)

    whileloop 2,%PCount

        region&=@&(&loop)
        External("GDI32","CombineRgn",wRgn&,region&,wrgn&,3)
        DeleteObject region&

    EndWhile

    SetWindowRgn(hdl&, wRgn&, 1)
    Return wRgn&

EndProc

mit minimalem Rahmen.

Den könntest aber ggf. sogar abschneiden mit Region.

XProfan X2
WinXP, SP3, Core(TM) i7-3770 @ 3.40GHz

29.01.2013 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

Wenn der Fensterstil auf $F0 gesetzt ist, dann sollte es funktionieren, wie oben schon geschrieben.

Allerdings fürchte ich Du bist da in einer Sackgasse. Es werden so nicht alle Elemente eingefangen bzw. angezeigt. ich habe z.B. ein paar "Minianwendungen" am laufen, die werden so nicht angezeigt.

Kompilieren Markieren Separieren

 $H windows.ph
Def SetLayeredWindowAttributes(4) !"USER32","SetLayeredWindowAttributes"
def SetWindowRgn(3) !"USER32","SetWindowRgn"
def RectRgn(4) !"GDI32","CreateRectRgn"
Declare fenster&[], x&, posx&, posy&
WindowStyle $F0
Window %MaxX,%MaxY,0,0

Whileloop 2

    fenster&[&loop]=Create("Dialog",%hwnd,"",%MaxX,%MaxY,0,0)'fenster&[1] - Schwarze Blende
    SetStyle fenster&[&loop],GetStyle(%hwnd)
    SetTransparent(fenster&[&loop],IF(&loop=1,55,20))'fenster&[2] - Durchsichtiger Klickschutz
    SetWindowPos fenster&[&loop]=0,0 - %MaxX, %MaxY;-1

EndWhile

ShowCursor 0

WhileNot iskey(27)

    Waitinput 10
    posx&=CursorPos("X1")
    posy&=CursorPos("Y1")
    StartPaint fenster&[1]
    CLS 0
    EndPaint
    CutRgnDLG(fenster&[1],RectRgn(0,posy&,posx&,posy&+1),RectRgn(posx&+1,posy&,%MaxX,posy&+1),RectRgn(posx&,0,posx&+1,posy&),RectRgn(posx&,posy&+1,posx&+1,%MaxY))
    CutRgnDLG(fenster&[2],RectRgn(0, 0, posx&, posy&),RectRgn(posx&+1, 0, %MaxX, posy&),RectRgn(0, posy&+1, posx&, %MaxY),RectRgn(posx&+1, posy&+1, %MaxX, %MaxY))

Endwhile

end

Proc SetTransparent

    Parameters Hwnd%, Perc%
    External("USER32","SetWindowLongA",Hwnd%, -20, External("USER32","GetWindowLongA",Hwnd%,-20) | $80000)
    SetLayeredWindowAttributes(Hwnd%, 0, (255 * Perc%) / 100, $2)

EndProc

Proc CutRgnDLG

    Parameters hdl&
    Declare region&,wRgn&
    wRgn&=RectRgn(0,0,width(hdl&)+100,height(hdl&)+100)

    whileloop 2,%PCount

        region&=@&(&loop)
        External("GDI32","CombineRgn",wRgn&,region&,wrgn&,3)
        DeleteObject region&

    EndWhile

    SetWindowRgn(hdl&, wRgn&, 1)
    Return wRgn&

EndProc

Proc WindowRect

    Parameters hdl&,Modus$
    Modus$=Lower$(Modus$)
    Declare x%, b#
    Dim b#,16
    External("USER32", "GetWindowRect",hdl&,b#)
    Case @&(3)<>0 : External("USER32","ScreenToClient",@&(3),b#) : External("USER32","ScreenToClient",@&(3),b#+8)
    Case Modus$="breite" : x%=Long(b#,8)-Long(b#,0)
    Case Modus$="höhe" : x%=Long(b#,12)-Long(b#,4)
    Case Modus$="x1" : x%=Long(b#,0)
    Case Modus$="y1" : x%=Long(b#,4)
    Case Modus$="x2" : x%=Long(b#,8)
    Case Modus$="y2" : x%=Long(b#,12)
    Dispose b#
    Return x%

EndProc

Proc CursorPos

    Parameters Modus$
    Modus$=Lower$(Modus$)
    Declare x%, mpos#
    Dim mpos#,8
    External("user32","GetCursorPos",mpos#)
    Case @&(2)<>0 : External("USER32","ScreenToClient",@&(2),mpos#)
    Case Modus$="x1" : x%=long(mpos#,0)
    Case Modus$="y1" : x%=long(mpos#,4)
    Case Modus$="x2" : x%=IF(@&(2)<>0,WindowRect(@&(2),"Breite"),%maxx)-long(mpos#,0)
    Case Modus$="y2" : x%=IF(@&(2)<>02,WindowRect(@&(2),"Höhe"),%maxy)-long(mpos#,4)
    Dispose mpos#
    Return x%

EndProc

20130129-211643.png	56 kB

Hochgeladen:	29.01.2013

Ladeanzahl:
		Herunterladen

XProfan X2
Gruss
Andreas
________ ________ ________ ________ _
Profan 3.3 - XProfanX2
Win 95,98,ME,2000,XP,Vista - Win 7 32 / 64 Bit
ASUS X93S - Intel Core I7-NVIDIA GForce 540M 8GB Arbeitsspeicher
Homepage : [...]

29.01.2013 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Julian
Schmidt

iF (29.01.13)

Ich schätze dass das was Du möchtest so nicht funktioniert da Du einerseits
einen Dialog benötigst (damit Transluzenz bei allen OS funktioniert) und andererseits
vom Aussehen her ein Static.

Stimmt, ich muss Dialog nehmen. Hat ja auch Andreas hier geschrieben.[...]

Funktioniert soweit mit dem Wegschneiden der Titelleiste.

iF (29.01.13)

Den könntest aber ggf. sogar abschneiden mit Region.

Dann müsste ich aber alles so umprogrammieren, das die Rahmen ausßerhalb des Bildschirms liegen, das man kein Loch entsteht. Oder geht das irgendwie anders?

Andreas Miethe (29.01.13)

Wenn der Fensterstil auf $F0 gesetzt ist, dann sollte es funktionieren, wie oben schon geschrieben.

Hab ich damals schon getestet und hat mit meinen ganz oben geposteten Quelltext mit den Fenstern als Dialog nicht funktioniert!

Andreas Miethe (29.01.13)

Allerdings fürchte ich Du bist da in einer Sackgasse. Es werden so nicht alle Elemente eingefangen bzw. angezeigt. ich habe z.B. ein paar "Minianwendungen" am laufen, die werden so nicht angezeigt.

Meinst du damit das mein Fenster nicht immer den Fokus bekommt, und deine Minianwendungen dieses überlappen oder wie?
Kompilieren Markieren Separieren

Def SetLayeredWindowAttributes(4) !"USER32","SetLayeredWindowAttributes"
def SetWindowRgn(3) !"USER32","SetWindowRgn"
def RectRgn(4) !"GDI32","CreateRectRgn"
Declare fenster&[], x&, posx&, posy&
WindowStyle $F0
Window %MaxX,%MaxY,0,0

Whileloop 2

    fenster&[&loop]=Create("Dialog",%hwnd,"",%MaxX,%MaxY,0,0)'fenster&[1] - Schwarze Blende
    SetTransparent(fenster&[&loop],IF(&loop=1,55,20))'fenster&[2] - Durchsichtiger Klickschutz
    SetWindowPos fenster&[&loop]=0,0 - %MaxX, %MaxY;-1
    setstyle fenster&[&loop],(getstyle(fenster&[&loop]) | 12582912) - 12582912

EndWhile

ShowCursor 0

WhileNot iskey(27)

    Waitinput 10
    posx&=CursorPos("X1")
    posy&=CursorPos("Y1")
    StartPaint fenster&[1]
    CLS 0
    EndPaint
    CutRgnDLG(fenster&[1],RectRgn(0,posy&,posx&,posy&+1),RectRgn(posx&+1,posy&,%MaxX,posy&+1),RectRgn(posx&,0,posx&+1,posy&),RectRgn(posx&,posy&+1,posx&+1,%MaxY))
    CutRgnDLG(fenster&[2],RectRgn(0, 0, posx&, posy&),RectRgn(posx&+1, 0, %MaxX, posy&),RectRgn(0, posy&+1, posx&, %MaxY),RectRgn(posx&+1, posy&+1, %MaxX, %MaxY))

Endwhile

end

Proc SetTransparent

    Parameters Hwnd%, Perc%
    External("USER32","SetWindowLongA",Hwnd%, -20, External("USER32","GetWindowLongA",Hwnd%,-20) | $80000)
    SetLayeredWindowAttributes(Hwnd%, 0, (255 * Perc%) / 100, $2)

EndProc

Proc CutRgnDLG

    Parameters hdl&
    Declare region&,wRgn&
    wRgn&=RectRgn(0,0,width(hdl&)+100,height(hdl&)+100)

    whileloop 2,%PCount

        region&=@&(&loop)
        External("GDI32","CombineRgn",wRgn&,region&,wrgn&,3)
        DeleteObject region&

    EndWhile

    SetWindowRgn(hdl&, wRgn&, 1)
    Return wRgn&

EndProc

Proc WindowRect

    Parameters hdl&,Modus$
    Modus$=Lower$(Modus$)
    Declare x%, b#
    Dim b#,16
    External("USER32", "GetWindowRect",hdl&,b#)
    Case @&(3)<>0 : External("USER32","ScreenToClient",@&(3),b#) : External("USER32","ScreenToClient",@&(3),b#+8)
    Case Modus$="breite" : x%=Long(b#,8)-Long(b#,0)
    Case Modus$="höhe" : x%=Long(b#,12)-Long(b#,4)
    Case Modus$="x1" : x%=Long(b#,0)
    Case Modus$="y1" : x%=Long(b#,4)
    Case Modus$="x2" : x%=Long(b#,8)
    Case Modus$="y2" : x%=Long(b#,12)
    Dispose b#
    Return x%

EndProc

Proc CursorPos

    Parameters Modus$
    Modus$=Lower$(Modus$)
    Declare x%, mpos#
    Dim mpos#,8
    External("user32","GetCursorPos",mpos#)
    Case @&(2)<>0 : External("USER32","ScreenToClient",@&(2),mpos#)
    Case Modus$="x1" : x%=long(mpos#,0)
    Case Modus$="y1" : x%=long(mpos#,4)
    Case Modus$="x2" : x%=IF(@&(2)<>0,WindowRect(@&(2),"Breite"),%maxx)-long(mpos#,0)
    Case Modus$="y2" : x%=IF(@&(2)<>02,WindowRect(@&(2),"Höhe"),%maxy)-long(mpos#,4)
    Dispose mpos#
    Return x%

EndProc

Kompilieren Markieren Separieren

Def SetLayeredWindowAttributes(4) !"USER32","SetLayeredWindowAttributes"
def SetWindowRgn(3) !"USER32","SetWindowRgn"
def RectRgn(4) !"GDI32","CreateRectRgn"
Windowstyle $F0
cls
Var dlg&=Create("Dialog",%hwnd,"",0,0,%MaxX,%MaxY)
setstyle dlg&,(getstyle(dlg&) | 12582912) - 12582912
SetTransparent(dlg&,50)
Showwindow(dlg&,1)
CutRgnDLG(dlg&,RectRgn(0,0,0,0))

WhileNot iskey(27)

Endwhile

end

Proc SetTransparent

    Parameters Hwnd%, Perc%
    External("USER32","SetWindowLongA",Hwnd%, -20, External("USER32","GetWindowLongA",Hwnd%,-20) | $80000)
    SetLayeredWindowAttributes(Hwnd%, 0, (255 * Perc%) / 100, $2)

EndProc

Proc CutRgnDLG

    Parameters hdl&
    Declare region&,wRgn&
    wRgn&=RectRgn(0,0,width(hdl&)+100,height(hdl&)+100)

    whileloop 2,%PCount

        region&=@&(&loop)
        External("GDI32","CombineRgn",wRgn&,region&,wrgn&,3)
        DeleteObject region&

    EndWhile

    SetWindowRgn(hdl&, wRgn&, 1)
    Return wRgn&

EndProc

29.01.2013 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

Julian Schmidt (29.01.13)

Meinst du damit das mein Fenster nicht immer den Fokus bekommt, und deine Minianwendungen dieses überlappen oder wie?

Das hat mit dem Focus nichts zu tun. Die Minianwendungen werden einfach nicht angezeigt und können so auch nicht per Screenshot eingefangen werden.

Hier mal 2 Bilder

original

Dein overlay

20130130-164427.png Vorschau

95 kB

Hochgeladen:

30.01.2013

Ladeanzahl:

Herunterladen

20130130-164455.png Vorschau

59 kB

Hochgeladen:

30.01.2013

Ladeanzahl:

Herunterladen

30.01.2013 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Julian
Schmidt

hmmmm....ok
Beim mir wurden sie erkannt. War aber erst ganz blöd im Vordergrund, weil ich den Dialog nicht auf Alway-On-Top gesetzt habe.
Was hast du da für ein OS. Werd ich mir in ner VM mal anschauen.

Julian Schmidt (29.01.13)

iF (29.01.13)

Den könntest aber ggf. sogar abschneiden mit Region.

Dann müsste ich aber alles so umprogrammieren, das die Rahmen ausßerhalb des Bildschirms liegen, das kein Loch entsteht. Oder geht das irgendwie anders?

[OFFTOPIC]Letzter Aktueller Quelltext siehe [...]

[/OFFTOPIC]

30.01.2013 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

Julian Schmidt (30.01.13)

hmmmm....ok
Was hast du da für ein OS. Werd ich mir in ner VM mal anschauen.

Windows 7

30.01.2013 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Julian
Schmidt

Benutz ich auch, was für eine Version Home Premium, Ultimate? Liegt evtl. daran das du kein Areo aktiviert hast. Geh in Systemsteuerung\Darstellung und Anpassung\Anpassung. Was für ein (Basis-)Design hast du eingestellt?

30.01.2013 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

Win7 32 / 64 Bit Home Premium.

Kein Aero
Für optimale Leistung angepasst.

Das werde ich auch nicht ändern !

Da muss sich schon Dein Programm anpassen

30.01.2013 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

Julian
Schmidt

Andreas Miethe (30.01.13)

Die Minianwendungen werden einfach nicht angezeigt und können so auch nicht per Screenshot eingefangen werden.

Habs mir gerade nochmal das Problem angeschaut. Mein Quellcode [...]

scheint die Minianwendungen wirklich nicht zu erfassen. Zumindest solange das Areo ausgeschaltet ist.

Mir fehlt gerade die zünde Idee um dieses Problem aus der Welt zu schaffen. Die einzige Möglichkeit die mir einfällt, ist auf eine andere Technik zu setzten.
iF hatte dazu ja auch irgendwo was vorgestellt....

23.02.2013 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

◄