Form padre, hijos y alphablendvalue

[cesarsoftware]

¿?
No entiendo.

[[fjcg02]]

A ver, a ver, en que Habré estado pensando...

Sólo me queda el consuelo de que lo escribí "al vuelo" y se me pasó ese pequeño gran detalle. Será que como es muda, nadie se acuerda de ella.

Saludos

[cesarsoftware]

Vale, revisando los post, entiendo lo de habran, (abran) los mensajes.
Tendran algun problema en el servidor

[[escafandra]]

He estado ausente un tiempo. Me he encontrado este hilo y la referencia en este otro.
Veo que posiblemente a estas alturas el problema está solucionado, pero me gustaría aportar mi granito de arena al problema.

Hasta Windows 8 no es posible tener el estilo WS_EX_LAYERED en ventanas child por lo que el problema no tiene solución... O si, la solución es hacer "trampas" y simular que una ventana top-level es child.

http://msdn.microsoft.com/es-es/libr...=vs.85%29.aspx

Empezado por MSD

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.

Mi propuesta es simple. Se trata de escribir la función de tratamiento de mensajes para WM_MOVING en el formulario padre y en los hijos:

Código Delphi [-]
procedure WMMoving(var Message: TWMMOVING); message WM_MOVING;

Para el formulario Padre tratamos de que las ventanas hijas se desplacen con él para que parezcan childwindows:

Código 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);
  end;
end;

Y para el formulario hijo evitamos que pueda salir del entorno de la ventana padre, simulando ser child:

Código 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;

El resto del código que presento es adorno. Subo un ejemplo compilable en delphi7.
Espero haber servido de ayuda aunque sea un poco tarde.


Saludos.

[cesarsoftware]

Gracias escafandra por volver y estar ahi, al pie del cañon

Con el codigo usado hasta ahora va bastante bien, solo se ve un pequeño retardo al mover las ventanas "hijas", pero he detectado que no funciona (no mueve a las hijas) en windows server 2003.

Probare tu tecnica (que seguro que es la buena) y lo comento.

Tomate una

[[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:

Código 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.

[cesarsoftware]

Hola escafandra, he probado tu codigo (delphi 2010 y windows 7 64) y no mueve las hijas por que no detecta bien el nombre de la clase en

Código Delphi [-]
    if Application.Components[i].ClassName <> 'TForm2' then continue;

Solo ve las clases THintWindows y TForm1
Si lo comprueba con "if Application.Components[i].Unitname" solo ve Controls y Unit1.
Es como si para la aplicacion no tuviera los formularios creados en tiempo de ejecucion
En Application.ComponentCount siempre tiene le valor 2, aunque cree 10 ventanas "hijas"

¿Sera algo del compilador o se puede comprobar de otra manera?

Saludos.

[[escafandra]]

Debes eliminar Appliation, puesto que el owner de los formularios TForm2 es TForm1:

Código Delphi [-]
if Components[i].ClassName <> 'TForm2' then continue;

Tal como el código que expongo aquí.


El código es un boceto y puede irse mejorando según las necesidades.

Vuelvo a subir el código completo por si las moscas...


Saludos.

[cesarsoftware]

Ahora si

Probare tu codigo en mi aplicacion y te cuento si es mejor (que seguro que si)

Thanks.

PD: Esta funcion hace que cuando pulse el raton en la ventana (no en el caption) mande el mensaje de mover, veo que ReleaseCapture deja al cursor hacer lo que estaba haciendo, pero.. porque se manda Perform(VM_SYSCOMMAND, $F012, 0); y que valor es $F012.

Código Delphi [-]
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;

Un saludo

[[escafandra]]

Se trata de enviar un mensaje WM_SYSCOMMAND con el parámetro wParam SC_MOVE (F010h) or 2. Conseguimos el efecto de mover la ventana sin pinchar en la barra del caption.


Saludos.

[cesarsoftware]

Gracias por la aclaracion

[cesarsoftware]

Con tu codigo en el formulario principal, el movimiento de las ventanas hijas es mucho mas fino, sigue sin funcionar en server 2003, pero no me importa demasiado (ahora en vez de dejar las ventanas hijas donde estan las mueve arriba y a la izquerda a toda velocidad).

Código Delphi [-]
procedure WMMoving(var Message: TWMMOVING); message WM_MOVING;

procedure TFormMain.WMMoving(var Message: TWMMOVING);
var
  i: integer;
begin
  for i := 0 to ComponentCount - 1 do
  begin
    if Components[i].ClassName <> 'TForm' then
      continue; // Si los hijos de TFormMain no son TFORM
    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;

Con mi codigo se ve (al ojo) el desplazamiento de las ventanas hijas sobre el formulario principal.

Código Delphi [-]
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;

procedure TFormMain.WMWindowPosChanging(var Message: TWMWindowPosChanging);
var
  i, t: word;
begin
  // Mover objetos DCx junto con la ventana principal
  t := Length(DCx);
  if t = 0 then
    Exit;
  for i := 0 to t - 1 do
  begin
    if DCx[i] = nil then
      Continue;
    DCx[i].Forma.Top := Self.Top + PxArriba + DCx[i].Top;
    DCx[i].Forma.Left := Self.Left + PxBorde + DCx[i].Left;
  end;
  inherited;
end;

Lo que no he sabido hacer es como implementar

Código Delphi [-]
procedure WMMoving(var Message: TWMMOVING); message WM_MOVING;

en las ventanas hijas por que se crean "on the fly y sin forma", pero es que ademas como controlo las pulsaciones del raton entonces aprovecho para mover las ventanas hijas.

Código Delphi [-]
  Forma := TForm.CreateNew(FormularioPadre, 0);
  Forma.Position := poDesigned;
  Forma.BorderStyle := bsNone;
  Forma.Left := FormularioPadre.Left + PxBorde + Left;
  Forma.Top := FormularioPadre.Top + PxArriba + Top;
  Forma.Color := clHotLight;
  Forma.Visible := Visible;
  Forma.AlphaBlend := True;
  Forma.AlphaBlendValue := Opacidad;
  Forma.ShowHint := True;
  Forma.Hint := 'Left-Click y arrastre para mover';
  Forma.OnMouseDown := LedOnMouseDown;
  Forma.OnMouseMove := LedOnMouseMove;
  Forma.OnMouseUp := LedOnMouseUp;

asi que sigo usando las que me van bien

Código Delphi [-]
procedure TcapturadorDCx.LedOnMouseDown(Sender: TObject; Button: TMouseButton;
                                        Shift: TShiftState; X, Y: Integer);
begin
  // Capturar posicion inicial del ratón al comenzar a mover
  oldLeft := X;
  oldTop := Y;
  // Solo si es Shape LedOn
  if Sender is TForm then
    Exit;
  // Cambiar estado a icono o detalle
  if Button = mbRight then
  begin
    if Icono = True then
      SetIcono(False)
    else
      SetIcono(True);
    Exit;
  end;
  // comprobar si ha pulsado doble-click
  if ssDouble in Shift = False then
    Exit;
  // Encender o Apagar el capturador
  if DCx = nil then
    ActivaDCx // si no ha sido activado
  else
    if DCx.abierto = True then
      DesactivaDCx
    else
      if (DCx.conectando = False) and (Conectando = False) then
        ActivaDCx; // si las tarea DCx y el objeto TcapturadorDCx estan parados
end;

procedure TcapturadorDCx.LedOnMouseMove(Sender: TObject; Shift: TShiftState;
                                        X, Y: Integer);
var
  nX, nY, nLeft, nTop: integer;
begin
  if ssLeft in Shift = False then
    Exit;
  // Mover la posicion del objeto
  if X < oldLeft then
  begin
    nX := oldLeft - X;
    nLeft := Forma.Left - nX;
  end
  else
  begin
    nX := X - oldLeft;
    nLeft := Forma.Left + nX;
  end;
  if Y < oldTop then
  begin
    nY := oldTop - Y;
    nTop := Forma.Top - nY;
  end
  else
  begin
    nY := Y - oldTop;
    nTop := Forma.Top + nY;
  end;
  // Controlar los limites
  // Izquierda
  if nLeft < (FormularioPadre.Left + PxBorde) then
    nLeft := FormularioPadre.Left + PxBorde;
  // Derecha
  if (nLeft + Forma.Width) > (FormularioPadre.Left + FormularioPadre.Width - PxBorde) then
    nLeft := (FormularioPadre.Left + FormularioPadre.Width) - Forma.Width - PxBorde;
  // Arriba
  if nTop < (FormularioPadre.Top + PxArriba) then
    nTop := FormularioPadre.Top + PxArriba;
  // Abajo
  if (nTop + Forma.Height) > (FormularioPadre.Top + FormularioPadre.Height - PxAbajo) then
    nTop := (FormularioPadre.Top + FormularioPadre.Height) - Forma.Height - PxAbajo;
  // reposicionar objecto
  Forma.Left := nLeft;
  Forma.Top := nTop;
end;

procedure TcapturadorDCx.LedOnMouseUp(Sender: TObject; Button: TMouseButton;
                                      Shift: TShiftState; X, Y: Integer);
begin
  Left := Forma.Left - (FormularioPadre.Left + PxBorde);
  Top := Forma.Top - (FormularioPadre.Top + PxArriba);
  Movido(Sender);
end;

Por tanto, de momento, me quedo con el tuyo en el formulario padre y con el mio en el formulario hijo en tiempo de ejecucion.

[[escafandra]]

Empezado por cesarsoftware

Lo que no he sabido hacer es como implementar

Código Delphi [-]
procedure WMMoving(var Message: TWMMOVING); message WM_MOVING;

en las ventanas hijas por que se crean "on the fly y sin forma", pero es que ademas como controlo las pulsaciones del raton entonces aprovecho para mover las ventanas hijas.

.......

Por tanto, de momento, me quedo con el tuyo en el formulario padre y con el mio en el formulario hijo en tiempo de ejecucion.

Lo mas sencillo es que crees un formulario hijo en tiempo de diseño para implementar tus funciones. Luego lo dejas como "disponible" en el proyecto, para crearlo por código cuando te haga falta.


Saludos.

[cesarsoftware]

Si, ya me lo he planteado, de hecho el objeto que crea este formulario usa otros 2 formularios creados en tiempo de diseño, pero es que esta "forma" viene deribada de que antes era un panel y cuando me acorde del alphablend "lo converti" en forma, de ahi que se cree en tiempo de ejecucion.

Gracias por la ayuda.

[[escafandra]]

En realidad cualquier ventana no child (para winXP, Vista ó win7) puede ser transparente... Basta con dar el estilo WS_EX_LAYERED y usar la API SetLayeredWindowAttributes para establecer el porcentaje de opacidad.

En tu caso lo mas sencillo es usar el alphablend del TForm, que se basa en el mismo principio, y derivar de ésta clase tu ventana. Lo suyo sería hacerlo en tiempo de diseño para tener un fácil control.

Por cierto, el código que dejé permite moverse a las ventanas hijas por todo el área de la ventana padre. Para ser mas cercano a una ventana child, debería limitarse el recorrido exclusivamente al área cliente de la ventana padre.


Saludos.

[cesarsoftware]

Si, antes de comprobar onmousemove ya se han incluido las variables

Código Delphi [-]
  PxArriba := GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CYFRAME) - 1;
  PxAbajo := StatusBar.Height + GetSystemMetrics(SM_CYFRAME);
  PxBorde := GetSystemMetrics(SM_CXFRAME);

y al crear la forma se posiciona segun esos margenes

Código Delphi [-]
  Forma.Left := FormularioPadre.Left + PxBorde + Left;
  Forma.Top := FormularioPadre.Top + PxArriba + Top;

y al controlar los limites en onmousemove

Código Delphi [-]
  // Controlar los limites
  // Izquierda
  if nLeft < (FormularioPadre.Left + PxBorde) then
    nLeft := FormularioPadre.Left + PxBorde;
  // Derecha
  if (nLeft + Forma.Width) > (FormularioPadre.Left + FormularioPadre.Width - PxBorde) then
    nLeft := (FormularioPadre.Left + FormularioPadre.Width) - Forma.Width - PxBorde;
  // Arriba
  if nTop < (FormularioPadre.Top + PxArriba) then
    nTop := FormularioPadre.Top + PxArriba;
  // Abajo
  if (nTop + Forma.Height) > (FormularioPadre.Top + FormularioPadre.Height - PxAbajo) then
    nTop := (FormularioPadre.Top + FormularioPadre.Height) - Forma.Height - PxAbajo;
  // reposicionar objecto
  Forma.Left := nLeft;
  Forma.Top := nTop;

En este video se ve como no se pasa de limites con estas funciones
http://www.youtube.com/watch?v=yHiEy...ature=youtu.be

Saludos

[[escafandra]]

Bien. Pero fíjate que puedes calcular directamente el area cliente sin necesidad de calcular los anchos de borde y de la barra del caption:

Esta sería la modificación en el tratamiento de mensaje de WM_MOVING:

Código Delphi [-]
procedure TForm2.WMMoving(var Message: TWMMOVING);
var
  MainRect: TRect;
begin
  inherited;
  Windows.GetClientRect(Application.MainForm.Handle, MainRect);
  MapWindowPoints(Application.MainForm.Handle, 0, MainRect, 2);
  if Message.DragRect.Left < MainRect.Left then
  begin
    Message.DragRect.Left:= MainRect.Left;
    Message.DragRect.Right:= MainRect.Left + self.Width;
  end;
  if Message.DragRect.Top < MainRect.Top then
  begin
    Message.DragRect.Top:= MainRect.Top;
    Message.DragRect.Bottom:= MainRect.Top + self.Height;
  end;
  if Message.DragRect.Left > MainRect.Right - self.Width then
  begin
    Message.DragRect.Left:= MainRect.Right - self.Width;
    Message.DragRect.Right:= MainRect.Right;
  end;
  if Message.DragRect.Bottom > MainRect.Bottom then
  begin
    Message.DragRect.Top:= MainRect.Bottom - self.Height;
    Message.DragRect.Bottom:= MainRect.Bottom;
  end;
end;

Tratar el mensaje WM_MOVING es mejor que el OnMouseMove pues hace referencia al movimiento de la ventana, no del ratón, sea cual sea el mecanismo del movimiento (ratón o teclado) y se llama durante el movimiento continuo, no tras éste. Además es mas simple y rápido.


Saludos

[[escafandra]]

Voy a poner un ejemplo de como implementar cualquier función de tratamiento de mensajes en una ventana aún no siendo diseñada en tiempo de diseño. La técnica es hacer un Subclassing.

Vamos a cambiar la función de tratamiento de mensajes de la ventana a bajo nivel y vamos a guardar el puntero a la antigua función para poder llamarla a la salida de nuestra nueva función (como si fuera una especie de inherited) Con esto conseguimos cambiar el comportamiento de la ventana para los aspectos que nos interesen y respetar el resto.

Para guardar el puntero a la antigua función de tratamiento de mensajes utilizaré el Tag del TWinControl.

Este sería el código resultante para el tema de este hilo usando subclassing:

Código 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


{$R *.dfm}
// Nueva función de Tratamiento de mensajes
// solo nos interesa tratar WM_MOVING
function ChildWindowProc(hWnd: HWND; uMsg: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;
var
  ChWidth, ChHeight: integer;
  MainRect, ChRect: TRect;
  WinControl: TWinControl;
begin
  if uMsg = WM_MOVING then
  begin
    Windows.GetClientRect(Application.MainForm.Handle, MainRect);
    MapWindowPoints(Application.MainForm.Handle, 0, MainRect, 2);
    Windows.GetWindowRect(hWnd, ChRect);
    ChWidth:=  ChRect.Right - ChRect.Left;
    ChHeight:= ChRect.Bottom - ChRect.Top;
    if PRECT(lParam).Left < MainRect.Left then
    begin
      PRECT(lParam).Left:= MainRect.Left;
      PRECT(lParam).Right:= MainRect.Left + ChWidth;
    end;
    if PRECT(lParam).Top < MainRect.Top then
    begin
      PRECT(lParam).Top:= MainRect.Top;
      PRECT(lParam).Bottom:= MainRect.Top + ChHeight;
    end;
    if PRECT(lParam).Left > MainRect.Right - ChWidth then
    begin
      PRECT(lParam).Left:= MainRect.Right - ChWidth;
      PRECT(lParam).Right:= MainRect.Right;
    end;
    if PRECT(lParam).Bottom > MainRect.Bottom then
    begin
      PRECT(lParam).Top:= MainRect.Bottom - ChHeight;
      PRECT(lParam).Bottom:= MainRect.Bottom;
    end;
  end;

  // Llamamos a la función original de tratamiento de mensajes de la ventana
  Result:= 0;
  WinControl:= FindControl(hWnd);
  if (WinControl <> nil) and (WinControl.Tag <> 0) then
    Result:= CallWindowProc(Pointer(FindControl(hWnd).Tag), hWnd, uMsg, WParam, lParam);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with TForm.Create(self) do
  begin
    Left:= self.Left + (self.Width - Width) div 2;
    Top:=  self.Top  + (self.Height - Height) div 2;
    AlphaBlend:= true;
    AlphaBlendValue:= 80;
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or SWP_SHOWWINDOW);
    // Aquí se realiza el subclassing y se guarda la antigua función
    Tag:= SetWindowLong(Handle, GWL_WNDPROC, LongInt(@ChildWindowProc));
  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 <> 'TForm' then continue;
    with Components[i] as TForm do
      SetWindowPos(Handle, 0, 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.

Saludos.

[cesarsoftware]

Gracias escafandra.

Estos dias tengo que entregar otro trabajo y no he podido probar.
Intentare sacar un rato este finde semana y te cuento como ha ido.

unas