8 respuestas en este tema

[escafandra]

A raíz de una pregunta en el foro amigo CD, a la cual he contestado tarde por estar últimamente un poco ausente de los foros, me ha parecido buena idea publicar aquí el truco de mi respuesta.

El problema es crear una ventana child semitransparente de otra que no lo es. Este problema aparentemente simple se complica pues Windows no lo admite:

Windows 8: The WS_EX_LAYERED style is supported for top-level windows and child windows. Previous Windows versions support WS_EX_LAYERED only for top-level windows.

El truco usado va a ser simular que la ventana "hija" es child cuando en realidad es una con estilo top-level y para ello basta con gestionar el mensaje WM_MOVING en la ventana padre y en la hija. En la ventana padre conseguiremos que al mover ésta lo hagan, también y simultáneamente, las hijas. En la ventana hija conseguiremos que su movimiento no traspase los límites de la ventana padre. De esta forma simulamos el efecto child y nuestra ventana hija podrá ser semitransparente.

El código es el siguiente:

delphi

procedure WMMoving(var Message: TWMMOVING); message WM_MOVING;

Para la ventana Padre:

delphi

procedure TForm1.WMMoving(var Message: TWMMOVING);
var
  i: integer;
begin
  inherited;
  for i:= 0 to ComponentCount-1 do
  begin
    if Components[i].ClassName <> 'TForm2' then continue;
    with Components[i] as TForm do
      SetWindowPos(Handle, HWND_TOPMOST, Message.DragRect.Left + Left - self.Left, Message.DragRect.Top + Top - self.Top, 0, 0, SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOZORDER); 
  end;
end;

Para la ventana hija:

delphi

procedure TForm2.WMMoving(var Message: TWMMOVING);
var
  Right, Bottom: integer;
begin
  inherited;
  with Application.MainForm do
  begin
    Right:=  Left + Width;
    Bottom:= Top + Height;
    if Message.DragRect.Left < Left then
    begin
      Message.DragRect.Left:= Left;
      Message.DragRect.Right:= Left + self.Width;
    end;
    if Message.DragRect.Top < Top then
    begin
      Message.DragRect.Top:= Top;
      Message.DragRect.Bottom:= Top + self.Height;
    end;
    if Message.DragRect.Left > Right - self.Width then
    begin
      Message.DragRect.Left:= Right - self.Width;
      Message.DragRect.Right:= Right - self.Width + self.Width;
    end;
    if Message.DragRect.Bottom > Bottom then
    begin
      Message.DragRect.Top:= Bottom - self.Height;
      Message.DragRect.Bottom:= Bottom - self.Height + self.Height;
    end;
  end;
end;

Y con esto basta para conseguir el efecto.

Coloco el código completo de un sencillo ejemplo (por si se corrompen los archivos adjuntos...) y subo el proyecto completo:

Ventana Padre:

delphi

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    procedure WMMoving(var Message: TWMMOVING); message WM_MOVING;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses Unit2;
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  with TForm2.Create(self) do
  begin
    AlphaBlend:= true;
    AlphaBlendValue:= 80;
    Show;
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE);
  end;
end;
 
procedure TForm1.WMMoving(var Message: TWMMOVING);
var
  i: integer;
begin
  inherited;
  for i:= 0 to ComponentCount-1 do
  begin
    if Components[i].ClassName <> 'TForm2' then continue;
    with Components[i] as TForm do
      SetWindowPos(Handle, HWND_TOPMOST, Message.DragRect.Left + Left - self.Left, Message.DragRect.Top + Top - self.Top, 0, 0, SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOZORDER); 
  end;
end;
 
end.

Ventana Hija:

delphi

unit Unit2;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
 
type
  TForm2 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    procedure WMMoving(var Message: TWMMOVING); message WM_MOVING;
  public
    { Public declarations }
  end;
 
var
  Form2: TForm2;
 
implementation
 
{$R *.dfm}
 
procedure TForm2.WMMoving(var Message: TWMMOVING);
var
  Right, Bottom: integer;
begin
  inherited;
  with Application.MainForm do
  begin
    Right:=  Left + Width;
    Bottom:= Top + Height;
    if Message.DragRect.Left < Left then
    begin
      Message.DragRect.Left:= Left;
      Message.DragRect.Right:= Left + self.Width;
    end;
    if Message.DragRect.Top < Top then
    begin
      Message.DragRect.Top:= Top;
      Message.DragRect.Bottom:= Top + self.Height;
    end;
    if Message.DragRect.Left > Right - self.Width then
    begin
      Message.DragRect.Left:= Right - self.Width;
      Message.DragRect.Right:= Right - self.Width + self.Width;
    end;
    if Message.DragRect.Bottom > Bottom then
    begin
      Message.DragRect.Top:= Bottom - self.Height;
      Message.DragRect.Bottom:= Bottom - self.Height + self.Height;
    end;
  end;
end;
 
procedure TForm2.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    ReleaseCapture;
    Perform(WM_SYSCOMMAND, $F012, 0);
  end;
end;
 
end.

Espero que sirva de ayuda o inspiración.


Saludos.

[enecumene]

Ya hacían falta tus trucos

[escafandra]

Bueno, es cierto que llevo un tiempo un poco "parado". Si me apetecía escribir algún truquillo...


Saludos.

[poliburro]

Vaya¡¡¡ Si no es por el Blog de Nuestro amigo ene no me entero del truco¡¡¡ Gracias amigo resulta muy interesante.  Se me ocurre a bote pronto que puede usarse para realzar pantallas, es decir hacer transparentes aquellas que no están en uso y opaca la que si está en uso. ya veremos que se puede hacer con este excelente truco.

Un abrazo amigo y gracias por compartirlo.

[egostar]

.......El problema es crear una ventana child semitransparente de otra que no lo es. Este problema aparentemente simple se complica pues Windows no lo admite:.....

Que Windows no admite queeeeeee ????

Para Delphi y asumo que C++ no hay impedimentos, bueno siempre y cuando el código venga de compañeros como escafandra

Saludos

[poliburro]

.......El problema es crear una ventana child semitransparente de otra que no lo es. Este problema aparentemente simple se complica pues Windows no lo admite:.....

Que Windows no admite queeeeeee ????

Para Delphi y asumo que C++ no hay impedimentos, bueno siempre y cuando el código venga de compañeros como escafandra

Saludos

Amen

[escafandra]

Gracias, amigos. Pero como decía hasta Win8 no se admiten ventanas child semitransparentes. Yo solo hice, una vez mas,  "trampas" 

Saludos.

[egostar]

Gracias, amigos. Pero como decía hasta Win8 no se admiten ventanas child semitransparentes. Yo solo hice, una vez mas,  "trampas" 

Saludos.

Eso lo sabemos mi estimado amigo, pero esas "trampas" no cualquiera se las ingenia

Lo dicho, Que windows no admite queeeee ?????

Saludos

[escafandra]

He visto un molesto efecto cuando las ventanas hijas tienen borde y Caption, son mas de una y movemos la ventana padre. Se trata de un cambio rápido se foco de una a otra. La solución es sencilla y basta con añadir SWP_NOACTIVATE y SWP_NOZORDER en SetWindowPos en el procedimiento TForm1.WMMoving:

delphi

SetWindowPos(Handle, HWND_TOPMOST, Message.DragRect.Left + Left - self.Left, Message.DragRect.Top + Top - self.Top, 0, 0, SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOZORDER);

Saludos.