halbtransparente Fenster

[Lubus]

Hallo,
wie wird in Lazarus ein halbtransparente Fenster programmiert? In Delphi gibt es "AlphaBlend"

[Teekeks]

Das geht nur IMHO mit der Jeweiligen API des Wingetsets.
Bei GTK2 (genauer: X) geht das so:

Code: Alles auswählen

unit alphaform; 
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils,xatom, X, xlib, gtk2, gdk2x, GTKProc, GtkDef, ctypes;
 
  procedure af_setForm_transparency(const f: THandle; const tp: integer);
 
implementation
 
procedure af_setForm_transparency(const f: THandle; const tp: integer);
var
  transparency: double;
  opacity: integer;
  atom_window_opacity: TAtom;
  dpy: PDisplay;
  win: TWindow;
begin
  dpy := XOpenDisplay(nil);
  win := GDK_WINDOW_XWINDOW(PGtkWidget(PtrUInt(f))^.window);
  transparency := tp / 1000 * 10;
  opacity      := trunc($FFFFFFFF * transparency);
  atom_window_opacity := XInternAtom(dpy, '_NET_WM_WINDOW_OPACITY', False);
  XChangeProperty(dpy, win, atom_window_opacity, XA_CARDINAL,
    32, PropModeReplace, @PcuChar(opacity), 1);
  XCloseDisplay(dpy);
end;
 
end.
//Aufruf z.B. so:
//(Angabe in %)
af_setForm_transparency(Form1.Handle,50);

Weiteres findest du hier.
Da wird auch eine Windows-Version beschrieben, die aber wohl nicht so Funktioniert...

Vl. Hat da jemand anderes schon was raus gefunden.

[_X_]

Hey, es verwendet ja doch jemand meinen Code ^^

mfg _X_

Sorry, aber das musste ich sagen

edit:// was ich jetzt so gesehen habe, stimmt da der Uses Bereich nicht:

Code: Alles auswählen

uses
  Classes, SysUtils,xatom, X, xlib, gtk2, gdk2x, GTK2Proc, Gtk2Def, ctypes;

sollte eher gehen

edit2://
mit win := QWidget_winId(TQtWidget(PtrUInt(aHandle)).Widget);
und in den uses statt dem gtk2-zeug "qt4" und "qtwidgets" gehts auch mit qt4

[felix96]

Der Code von TeeKeks funktioniert unter Windows nicht (Die units werden nicht gefunden), du könntest aber auch wie hier Beschrieben deine Form unsichtbar machen, einen Screenshot machen, und von diesem das Stückchen, was du brachst auf deiner Form ausgeben.
Und sie natürlich wieder sichtbar machen.

[martin_frb]

Lazarus snapshot verwenden. Da gibt es auch Alphablend.

[_X_]

@martin_frb, Wusste ich noch gar nicht.
Der Code von mir ist noch aus der Zeit, als Lazarus das nicht konnte.

mfg _X_

[Lubus]

Erst mal vielen Dank für die Hilfe. Bei mir kommt in der Zeile

32, PropModeReplace, @PcuChar(opacity), 1);

der Fehler:

Error: Typecast has different size (4->8) in assignment

Es wird das "@"-Zeichen angemeckert.

[Teekeks]

Hast du ein 64-Bit-Lazarus? wenn ja: versuche es mal mit einem int64 für die Variable opaticy

[Lubus]

Ja ich habe die 64-Bit Version und ja es geht weiter.
Er compiliert jetzt auch durch, allerdings mit folgenden Nachrichten:

unit2.pas(23,29) Hint: Conversion between ordinals and pointers is not portable
unit2.pas(28,27) Hint: Conversion between ordinals and pointers is not portable
Projekt "project1" erfolgreich gebaut.

und der Fehlermeldung bei der Ausführung

Project project1 raised exeption class 'External: SIGSEGV'

[Teekeks]

Ich habe zwar kein 64 Bit, aber probiere mal das hier aus:
Ersetze die Zeilen

Code: Alles auswählen

XChangeProperty(dpy, win, atom_window_opacity, XA_CARDINAL,
    32, PropModeReplace, @PcuChar(opacity), 1);

durch diese hier:

Code: Alles auswählen

XChangeProperty(dpy, win, atom_window_opacity, XA_CARDINAL,
    64, PropModeReplace, @PcuChar(opacity), 1);

Vl. liegt es daran. Ich kann dir aber keine Versicherung geben (das wäre aber Logisch wenn es daran liegen würde...)

[Lubus]

Ich habe das ausprobiert, aber der Fehler ist immer noch da. Nachdem ich die Fehlermeldung quittiert habe öffnet Lazarus die Unit "wincontrol.inc" und spring in Zeile 6638

HandleAllocated := (FHandle <> 0)

und die zwei Zeilen in der Nachricht beziehen sich auf

win := GDK_WINDOW_XWINDOW(PGtkWidget(PtrUInt(f))^.window);

und

64, PropModeReplace, @PcuChar(opacity), 1);

[Lubus]

Ich habe das Programm ein wenig umgebaut. Jetzt habe ich ein Button ins Fenster eingefügt und unter OnClick den Aufruf eingefügt:

procedure TForm1.Button1Click(Sender: TObject);
begin
af_setForm_transparency(Form1.Handle, 50); //Angaben in%
end;

Interessant ist, dass bei
"32, PropModeReplace, @PcuChar(opacity), 1); "
das Programm nicht beendet wird, aber wenn ich statt 32 die 64 eingebe, wird das Programm beendet.
Eine Transparenz ist trotzdem nicht möglich.

[Teekeks]

Ich habe mich eben mal belesen:
scheinbar ist da nur 8, 16 oder 32 als Angabe möglich.

Vl, wenn du das Opaticy auf Integer castest
Etwa so:

Code: Alles auswählen

XChangeProperty(dpy, win, atom_window_opacity, XA_CARDINAL,
    32, PropModeReplace, @PcuChar(Integer(opacity)), 1);

(und JA, ich weiß das man solche direkten Casts nicht macht...

[Lubus]

Da kommt dann der Fehler

unit2.pas(23,29) Hint: Conversion between ordinals and pointers is not portable
unit2.pas(29,27) Warning: Conversion between ordinals and pointers is not portable
unit2.pas(29,27) Error: Typecast has different size (4 -> 8 ) in assignment
unit2.pas(35) Fatal: There were 1 errors compiling module, stopping

[_X_]

Frage: Lazarus hat doch Alphablending, warum verwendest du nicht das?

Code: Alles auswählen

TForm.Alphablend := True;
TForm.AlphaBlendValue := 200; //0 Unsichtbar, 255 Sichtbar

mfg _X_