Form padre, hijos y alphablendvalue

[cesarsoftware]

Hola compañeros.

Siguiendo el consejo de casimiro, abro este nuevo hilo.

Necesito que el formulario principal (o la imagen que contiene alineada al client, un plano topografico, por ejemplo) no sea trasparente pero los formularios hijo si.
Sobre ese plano dibujo una casitas que muestran la actividad remota, ahora esas casitas (formularios creados en tiempo de ejecucion) no son trasparentes y tapan el plano, si son muchas, el plano del fondo ni se ve y ademas la casita se puede agrandar (tiene 2 tamaños en funcion de la cantidad de informacion a mostar).
Si creo el form hijo y le asigno el parent del formulario padre, las casitas se mueven con el plano pero cojen la propiedad alphablendvalue del padre, osea o todos trasparentes o todos opacos.
Si creo el form hijo y no le asigno el parent del formulario padre, las casitas se quedan en la posicion de la pantalla (que es el parent) donde estan y el plano se va solo, eso si, las casitas son trasparentes.

ejemplo del codigo

// inicializa objetos
Forma := TForm.Create(FormularioPadre);
Forma.Parent := FormularioPadre;//se mueve con el padre pero no es trasparente
// si no asigno y el formulario padre es la pantalla, son trasparentes pero no se mueven dentro del padre
Forma.Position := poDesigned;
Forma.Left := Left;
Forma.Top := Top;
if Icono = False then
begin
Forma.Width := 206;
Forma.Height := 256;
end
else
begin
Forma.Width := 26;
Forma.Height := 26;
end;
Forma.Color := clHotLight;
Forma.Visible := Visible;
Forma.BorderStyle := bsNone;
Forma.AlphaBlend := True;
Forma.AlphaBlendValue := 115;
Forma.ShowHint := True;
Forma.Hint := 'Left-Click y arrastre para mover';
Forma.OnMouseDown := LedOnMouseDown;
Forma.OnMouseMove := LedOnMouseMove;
Forma.OnMouseUp := LedOnMouseUp;
CBmodelo := TComboBox.Create(Forma);
CBmodelo.Parent := Forma;
CBmodelo.Top := 10;
...
LedOn := TShape.Create(Forma);
LedOn.Parent := Forma;
LedOn.Shape := stCircle;
...


¿Alguna sugerencia (de escafandra, por ejemplo;)?

Gracias aunque sea por leer.

[ricardopl65]

he estado haciendo unas pruebas y he sacado algo como esto.
Subo un proyecto hecho en XE2 , para otras versiones igual tienes que cambiar algun uses.

Lo he subido al FTP carpeta delphi/ejemplos/varios/mditrans.zip
porque no me deja subirlo de ningua otra manera

[Casimiro Notevi]

Crea el .zip sin el ejecutable, deja sólo el código fuente y súbelo con la opción "archivos adjuntos", así no ocupará casi nada.

[ricardopl65]

Ya lo he intentado pero me dice exceso de cuota.
Y cuando intento ver mis adjuntos me dice:

Tú has sido excluido por las siguientes razones:
No reason was specified.
Fecha en que será levantada tu exclusión: Nunca

Lo he subido con ejecutable por si tenia problemas para compilarlo debido a las versiones de delphi

[Casimiro Notevi]

Por eso te comento, que lo intentes sin el ejecutable, a ver si así puedes subirlo, no recuerdo cuánto es lo que puedes subir.

[ecfisa]

he estado haciendo unas pruebas y he sacado algo como esto.
Subo un proyecto hecho en XE2 , para otras versiones igual tienes que cambiar algun uses.

Lo he subido al FTP carpeta delphi/ejemplos/varios/mditrans.zip
porque no me deja subirlo de ningua otra manera
Hola Ricardo.

Busque el archivo "mditrans.zip" en la carpeta Delphi (y subcarpetas) del FTP y no pude encontrarlo, ¿ Tampoco te permitió subirlo allí ?

Quita el ejecutable, avisanos si continuas teniendo inconvenientes y vemos como solucionarlo.

Saludos.

[ricardopl65]

edito, subido sin ejecutable y tambien he quitado la propiedad picture del timage, que era lo que hacia grande el .dfm
por lo tanto deberas asignar un bitmap pequeño al timage

[ricardopl65]

Hola Ricardo.

Busque el archivo "mditrans.zip" en la carpeta Delphi (y subcarpetas) del FTP y no pude encontrarlo, ¿ Tampoco te permitió subirlo allí ?

Quita el ejecutable, avisanos si continuas teniendo inconvenientes y vemos como solucionarlo.

Saludos.
Lo subí pero desapareció , lo he vuelto a subir sin ejecutable, pero ya lo podeis quitar puesto que lo he podido poner como adjunto

[cesarsoftware]

Gracias por tu aporte ricardo,
A ver si a lo largo de la mañana le hecho un vistazo y os cuento.

[cesarsoftware]

Ya lo he probado y esta muy bien la jugada ricardo, gracias, pero esta solucion tiene 2 incovenientes, uno es que es totalmente trasparente y no "semitrasparente" como con alphabledvalue y el efecto visual cambia mucho ya que la "casita" original tiene un tono azulado.
La otra es semisolucionable, ya que al ser la forma trasparente no puedo moverla arrastando con el raton y tendria que asignar eventos a cada control de la forma pero no podria moverla pichando "en los huecos" de la forma que es lo que el usuario va a hacer.

¿Que?, ¿Se puede hacer un alphablend sin eredar la propiedad del padre?

Thanks.

[ricardopl65]

la forma es transparente excepto el imagedit que contiene la casita, yo no le he puesto imagen por no engordar el zip.
aqui pongo una grabacion bastante mala en mp4 de como me funciona a mi.
http://www.ricardoplaza.com/download/recorder.mp4
O igual es que no entiendo bien tu pregunta:D
http://www.ricardoplaza.com/download/casitas.jpg

[cesarsoftware]

Jopelines ricardo ^\||/, los has hecho muy bien entendiendo los formularios como casitas, (que asi lo he explicado yo), ahi podrias poner sobre o alrededor de las casitas la informacion relevante, conectada, desconectada, etc.

Yo no se hacer mp4 (¿podrias decirme como?) pero esta tarde cuando vuelva a las 17:00, preparo una fotos de la aplicacion real y las publico para poder explicarme mejor, por cierto, no hay casitas:D, son máquinas, jejeje.

Muchas gracias por tu colaboracion, a ver si entre todos damos con la solucion.

[ricardopl65]

he grabado la imagen con ScreenRecorder y pasado a mp4 con Any Video Converter.
Es que me lo tomo como un reto personal.
Mira aun mas facil usando parte del codigo del ejemplo 29 de Seoane (http://www.clubdelphi.com/foros/attachment.php?attachmentid=481&d=1160924094).
Solo el formulario padre de tipo fsNormal;

haciuendo doble clic sobre cada imagen se borra;
http://www.ricardoplaza.com/download/prado.jpg

[cesarsoftware]

Buenas, ya estoy aqui, e instalado el camrecorder (gracias) y en puesto en youtube el video que muestra los efectos
http://www.youtube.com/watch?v=LTPEjZiRtXE&feature=youtu.be
Como verás entre una imagen preciosa de un paisaje o un plano topografico o de planta el efecto visual cambia mucho, la aplicación funciona bien, pero si los formularios que contienen los objetos de datos fueran semitrasparentes pues como que mucho mejor;)

Habia pensado en dejarlos fuera del formulario padre y detectar el evento de movimiento de ventana (que no lo he buscado, supongo que existe) o el de raton onmousemove como ya hago y mover las ventanas hijas a la vez que se mueve el padre.
Pero estaba seguro de que me saldrias con que se puede crear una clase derivada de TForm y hacer que pudieran tener valores de alphablend distintos, aunque como veo que teneis controlado el tema de la imagen, a lo peor no se puede hacer lo que me gustaria (yo de derivar clases y eso, como que controlo poco).

Seguire investigando, pero me gustaria saber como sale de esta ricardo, jejeje:D

[ricardopl65]

No se si te servirá pero esto es de momento lo que mas se acerca.
Son ventanas MDI por lo tanto se mueven con el padre.

http://www.ricardoplaza.com/download/mditrans.jpg

[Chris]

Una ventana que esté dentro de otra no puede tener el estilo "WS_EX_LAYERED", que es lo que necesitas. Entonces lo que necesitas hacer es crear para cada "casita" dos ventanas, o una sola dependiendo del estilo que buscas. Un ejemplo que codifiqué hace un tiempo:
https://dl.dropbox.com/u/11734896/screenshots/layered_window.png

En realidad allí utilizo dos ventanas. La grafica de Ballon en realidad es una sola ventana. Esta es una ventana de capa (WS_EX_LAYERED Window (http://msdn.microsoft.com/en-us/library/ms997507.aspx)). El problema con la ventana de capas, es que no soportan interacción gráfica. Fueron inventadas con el próposito de hacer los viejos splash screen y cosas similares. Entonces utilizo una segunda ventana para albergar la interfaz (controles y labels) del formulario. Para mover conjuntamente los dos formularios manejo el evento WM_WINDOWPOSCHANGING en uno de ellos.

La otra posibilidad es hacer algo más o menos parecido a lo que tienes. En este caso creo que sólo tendrás que manejar el evento WM_WINDOWPOSCHANGING en el formulario padre y conforme mover a los hijos. Pero para conseguir el efecto de transparencia es importante que el formulario hijo NO SEA MDI-Child.

Saludos!

[cesarsoftware]

Gracias cris, voy a ver si me sale.

Thanks

[ricardopl65]

el problema de los MDI es que no soportan alphablend. O son transparentes (como en ultimo ejemplo que te puse ) o no lo son.
Una pregunta que se me ocurre ¿ es imprescindible que sean formularios?

[cesarsoftware]

Hola ricardo,

Pues no, no es imprescindible que sean formularios, de hecho inicialmente eran paneles y como vi que me tapaban el plano, pense en el alphablend del formulario.

¿Que se te ha ocurrido?

[ricardopl65]

estoy en ello de momento mirate este video a ver si se acerca a lo que quieres
http://www.ricardoplaza.com/download/ventanatrans.mp4

[ricardopl65]

perdona es esta la direccion
http://www.ricardoplaza.com/download/ventanatrans.avi

[cesarsoftware]

¡Si!^\||/ Eso es lo que busco.

Me das un poquito de info....porfa, anda... te invito a unas birras:D

[ricardopl65]

me tendras que dar una habitación porque mi mujer me va a echar de casa :D
adjunto el proyecto tal como yo lo llevo hasta ahora.

[cesarsoftware]

Me parece que vamos a tener que alquilar un apartamento entre los dos:D y tomarnos las birras en el bar del barrio, mi mujer tambien me quiere echar de casa:mad:, menos mal que nos quedan las niñas...y el portatil.

Bueno, visto, lo que has hecho es mover las ventanas hijas cuando mueves el padre con

procedure TFPrincipal.WMWindowPosChanging(var Message: TWMWindowPosChanging);
begin
MoveFW();
inherited;
end;
procedure TFPrincipal.MoveFW;
var
X: Integer;
begin
if Length(f2) > 0 then

for X := 0 to Length(f2) - 1 do
begin
if (TForm2(f2[X]).Visible) then
begin

TForm2(f2[X]).moviendo := true;
TForm2(f2[X]).Top := Self.Top + TForm2(f2[X]).difY;
TForm2(f2[X]).Left := Self.Left + TForm2(f2[X]).difx;
TForm2(f2[X]).moviendo := False;
end;
end;
end;


y en el hijo para apuntar la posicion actual

procedure tform2.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
if moviendo=false then
begin
difx:=left-fprincipal.Left;
difY:=top-fprincipal.Top;
end;
inherited;
end;

para controlar los limites

procedure TForm2.WMMove(var Message: TWMMove);
begin
// Aqui habría que descontar la anchura de los bordes y el caption del form padre para mejorar el efecto.
if left<fprincipal.Left then left:=FPrincipal.Left;
if (left+ width)>(fprincipal.Left+fprincipal.Width) then
left:=(fprincipal.Left+fprincipal.Width)-width;
if (top + Height)>(fprincipal.top+fprincipal.Height) then
top:=(fprincipal.top+fprincipal.Height)-Height;

if top<fprincipal.top then top:=FPrincipal.Top;
end;


lo que me resulta curioso es el uso de esta funcion, le engañas a la cola de mensajes, quizas es que yo lo hubiera hecho con onmousemove,down y up, vamos la costumbre de cada uno, supongo:rolleyes:
(editado: supongo que con un mensaje del sistema te ahorras asignar los eventos move,down,up a cada control, so burro)

procedure TForm2.WMNCHitTest(var Msg: TWMNCHitTest) ;
begin
inherited;
if Msg.Result = htClient then // Esta parte hace referencia a la parte donde se ha hecho click
Msg.Result := htCaption; // Aquí hace creer que donde se hizo click es el Caption Bar
end;


Desde luego el efecto es justo el deseado, me voy a poner a trabajar en esta tecnica que creo que va a ser la buena.

Cuando quieras las birras (o cafe)^\||/

PD: ¿porque se usa inherited, y cuando o porque se pone al principio o final de funciones? Thanks.

[ricardopl65]

Tengo que aclar que parte del código ya estaba en esta web.

[ricardopl65]

se pone inherited para invocar al metodo del ancestro del objeto en cuestión.
Por ejemplo en un metodo destroy primero liberas los objetos que hayas creado o cierras archivos etc y despues llamas a inherited para que continue con el proceso previsto. Si lo hicieses al reves cuando quisieras liberar tus objetos etc. ya se habria destruido el objeto.
En un Constructor create suele llamarse primero al inherited para que el objeto se cree normalmente y luego se añade la funcionalidad deseada. Si lo hicieses al reves, el metodo heredado sobreescribiria esa funcionalidad.
Es Importante el momento en el que se llama.

[cesarsoftware]

Gracias por responder ricardo, suponia que ese era el efecto de inherited, pero confrmado queda claro.:)

Al final con el movimiento conjunto de ventanas el tema esta solucionado y un poco mas afinado
en este video se ve una muestra del efecto con topes incluidos
http://www.youtube.com/watch?v=yHiEyPjZ890&feature=youtu.be

Hago un resumen de lo necesario, o lo que es lo mismo, la receta para cocinarlo:D

Formulario Padre o principal:

1 manejador de mensaje del movimiento de la pantalla principal

private
// Mover objetos DCx
procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;

3 variables publicas

public
// Posiciones relativas a la pantalla principal de los objetos DCx
PxArriba: word;
PxAbajo: word;
PxDcha: word;

En el OnCreate (por ejemplo) calcular los margenes
en mi caso tengo abajo una TStatusBar

PxArriba := GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CYFRAME) - 1;
PxAbajo := StatusBar.Height + GetSystemMetrics(SM_CYFRAME);
PxDcha := GetSystemMetrics(SM_CXFRAME);


Al crear las ventanas hijas darle informacion sobre los limites para que no se pasen

// Posiciones relativas a la pantalla principal
DCx[i].PxArriba := FormRemoto.PxArriba;
DCx[i].PxAbajo := FormRemoto.PxAbajo;
DCx[i].PxDcha := FormRemoto.PxDcha;
// posciones relativas respecto al padre (se guardan en una tabla)
DCx[i].Left := StrToIntDef(SGmaquinas.Cells[4, i + 1], 1);
DCx[i].Top := StrToIntDef(SGmaquinas.Cells[5, i + 1], 1);


El manejador que mueve las ventanas hijas cuando se mueve el padre

procedure TFormRemoto.WMWindowPosChanging(var Message: TWMWindowPosChanging);
var
i, t: integer;
begin
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 es la nueva posicion de la ventana hija
// DCx[i].Top es la posicion relativa de la ventana hija respento al padre, partiendo de 0,0
DCx[i].Forma.Top := Self.Top + PxArriba + DCx[i].Top;
DCx[i].Forma.Left := Self.Left + PxDcha + DCx[i].Left;
end;
inherited;
end;


Formulario hijo (semitrasparente con alphablendvalue)
unas variables publicas y los procedimientos de movimiento de raton
al final he deshechado los mensaje windows porque sale un movimiento "mas fino" de esta forma

public // Variables de entrada publicas
Forma: TForm; // Formulario contenedor
FormularioPadre: TWinControl; // Parent
PxArriba: word; // SM_CYCAPTION + SM_CYMENU + SM_CYFRAME;
PxAbajo: word; // 19(StatuBar.Height) + SM_CYFRAME;
PxDcha: word; // GetSystemMetrics(SM_CXFRAME);
Left, Top: word; // Posicion
procedure LedOnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); // 1ª posicion
procedure LedOnMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer); // mover panel
procedure LedOnMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer); // nueva posicion


Crear los formularios hijos en tiempo de ejecucion

Forma := TForm.CreateNew(FormularioPadre, 0); // CreateNew si no queremos usar un archivo .DFM
Forma.Position := poDesigned;
Forma.BorderStyle := bsNone;
Forma.Left := FormularioPadre.Left + PxDcha + Left; // posicion relativa al inicio
Forma.Top := FormularioPadre.Top + PxArriba + Top;
if Icono = False then
begin
Forma.Width := 206;
Forma.Height := 256;
end
else
begin
Forma.Width := 26;
Forma.Height := 26;
end;
Forma.Color := clHotLight;
Forma.Visible := Visible;
Forma.AlphaBlend := True;
Forma.AlphaBlendValue := 210;
Forma.ShowHint := True;
Forma.Hint := 'Left-Click y arrastre para mover';
Forma.OnMouseDown := LedOnMouseDown;
Forma.OnMouseMove := LedOnMouseMove;
Forma.OnMouseUp := LedOnMouseUp;
...
crear los componentes vcl y asigarno a la forma y los evento si es necesario
Lnumero := TLabel.Create(Forma);
Lnumero.Parent := Forma;
Lnumero.Top := LedOn.Top + 5;
Lnumero.Left := LedOn.Left + 6;
Lnumero.Height := 13;
Lnumero.Width := 12;
Lnumero.Transparent := True;
Lnumero.Caption := IntToStr(Numero);
Lnumero.ShowHint := True;
Lnumero.Hint := LedOn.Hint;
Lnumero.Visible := Icono;
Lnumero.OnMouseDown := LedOnMouseDown;
Lnumero.OnMouseMove := LedOnMouseMove;
Lnumero.OnMouseUp := LedOnMouseUp;
...


y los manejadores de eventos

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: integer;
begin
if ssLeft in Shift = False then
Exit;
// Controlar los limites
// Izquierda
if Forma.Left < (FormularioPadre.Left + PxDcha) then
begin
Forma.Left := FormularioPadre.Left + PxDcha;
SetCursorPos(Forma.Left + X, Forma.Top + Y);
end;
// Derecha
if (Forma.Left + Forma.Width) > (FormularioPadre.Left + FormularioPadre.Width - PxDcha) then
begin
Forma.Left := (FormularioPadre.Left + FormularioPadre.Width) - Forma.Width - PxDcha;
SetCursorPos(Forma.Left + X, Forma.Top + Y);
end;
// Arriba
if Forma.Top < (FormularioPadre.Top + PxArriba) then
begin
Forma.Top := FormularioPadre.Top + PxArriba;
SetCursorPos(Forma.Left + X, Forma.Top + Y);
end;
// Abajo
if (Forma.Top + Forma.Height) > (FormularioPadre.Top + FormularioPadre.Height - PxAbajo) then
begin
Forma.Top := (FormularioPadre.Top + FormularioPadre.Height) - Forma.Height - PxAbajo;
SetCursorPos(Forma.Left + X, Forma.Top + Y);
end;
// Mover el objeto
if X < oldLeft then
begin
nX := oldLeft - X;
Forma.Left := Forma.Left - nX;
end
else
begin
nX := X - oldLeft;
Forma.Left := Forma.Left + nX;
end;
if Y < oldTop then
begin
nY := oldTop - Y;
Forma.Top := Forma.Top - nY;
end
else
begin
nY := Y - oldTop;
Forma.Top := Forma.Top + nY;
end;
end;

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

procedure TcapturadorDCx.Movido(Sender: TObject);
begin
// Sincronizar si tiene tarea asignada
if Assigned(FOnMovido) then
FOnMovido(Self);
end;


Ala, un pasito mas, gracias a todos.^\||/

[ricardopl65]

Aunque tengo una duda, ¿que tarea realiza este programa?

[cesarsoftware]

Hola ricardo.

DatcomG2 es la segunda generacion es un sistema autonomo de captura de datos en planta, es decir, supervisa los estados de las máquinas en una fabrica (robots, prensas, centros de mecanizado, estrusoras, etc) o en campo abierto como una cantera por ejemplo.

En la página web (si, lo se, ahi que actualizarla) tengo una descripcion de la version previa
http://www.cesarsoftware.com/DatCom.aspx
Unas fotos
http://www.cesarsoftware.com/DatComFotos.aspx

Asi que basicamente recoge las señales (máquina en marcha, maquina trabajando, máquina en averia, fin de pieza, golpe ejecutado, clable soltado, etc) y la cuenta y suma los tiempos, dando estadistica de productividad de cada máquina y de cada turno. Por ejemplo, en una fabrica de estampacion de puertas de coche, indica si las máquinas estan golpeando (trabajando) y cuantas piezas van realizando; se pueden activar señales digitales (sirenas, luces, etc) cuando por ejemplo cada 4000 piezas o cada 10 horas de trabajo, etc. Toda la información es trasmitida por WiFi y la aplicacion usa sockets a bajo nivel (nada de indy) para comunicarse con los dispositivos, antes tambien por puerto serie, pero cada vez uso mas ethernet.
Como es un producto autonomo y dirigido a Jefes de produccion y gerentes, ha de ser muy vistoso (les encantan los colorines y las graficas) y siempre quieren ver el estado de la fabrica en tiempo real sentados comodamente en sus despachos, asi que DatComG2 dispone de un soft remoto de visualizacion de la planta en tiempo real. Ha, por supuesto usa Firebird para almacenar tal ingente cantidad de informacion.

Vaya rollo te he metido, parezco un comercial, jejeje:D
PD: se aceptan distribuidores. ¿Vosotros en que sector trabajais, grafico?

[fjcg02]

Conoces a IDS de Bergara ?

Saludos

[ricardopl65]

yo en realidad no me dedico a esto, para mi es solo un hobby. Un hobby desde hace mas de 20 años. Yo empecé con un sony de 64k y grabadora de cinta y luego con ms-dos 3.0 y el gwbasic que llevaba en rom. De ahi a clipper, turbo pascal, pascal para güindous, y toda la saga de delphi.
He hecho alguna cosilla en php y en java un par de aplicaciones para movil, básicamente para enviarnos mensajes de voz entre mi mujer y yo:D.
Y ahora ando investigando algo de phyton ¡¡ si es que uno ya tiene sus añitos !!

[cesarsoftware]

Conoces a IDS de Bergara ?

Saludos

Si, y ellos a nosotros tambien, somo "vecinos" y colaboradores^\||/,
¿Y Tú, de que les conoces? ¿No seras un espie, heinn;)

[cesarsoftware]

yo en realidad no me dedico a esto, para mi es solo un hobby. Un hobby desde hace mas de 20 años. Yo empecé con un sony de 64k y grabadora de cinta y luego con ms-dos 3.0 y el gwbasic que llevaba en rom. De ahi a clipper, turbo pascal, pascal para güindous, y toda la saga de delphi.
He hecho alguna cosilla en php y en java un par de aplicaciones para movil, básicamente para enviarnos mensajes de voz entre mi mujer y yo:D.
Y ahora ando investigando algo de phyton ¡¡ si es que uno ya tiene sus añitos !!

¡OLE!, esto es un hobby y no las motos^\||/, Yo tambien soy de tu epoca, pero como he conseguido convertir mi hobby en mi profesion, pues puedo dedicarle tiempo sin que mi mujer me ponga demasiados morros para cenar:o, ahora solo me embronca por la moto, "que ha ella si la llevas a pasear, le compras cositas, la cuidas, la mimas mas que ha mi:D..."
Tambien he recorrido los mismos compiladores que Tu y alguno mas, y te puedo decir que has acertado en el lenguaje de tu hobby, Delphi(pascal) y Enbarcadero(Borland) lo ha hecho bien.
Aunque te aconsejo que tires p'al movil que es el futuro, supongo que yo me quedaria en la "sucia, pesada" y decaida industria, ¡que daño estan haciendo algunos, eniff:(!

Es genial crear cosas y que los demas le saquen partido (y ya si te pagan, ni te cuento;))
Solo me queda darte animo y gracias por la ayuda y conversacion, un placer.

[fjcg02]

Si, y ellos a nosotros tambien, somo "vecinos" y colaboradores^\||/,
¿Y Tú, de que les conoces? ¿No seras un espie, heinn;)

Negativo, tuve mis escarceos comerciales y entablamos relación. La pena es que no salió nada.

Saludos

[cesarsoftware]

Negativo, tuve mis escarceos comerciales y entablamos relación. La pena es que no salió nada.

Saludos
Hola, ayer te envie un MP, pero no me figura en enviados ¿lo recibiste?

[fjcg02]

Hola, ayer te envie un MP, pero no me figura en enviados ¿lo recibiste?

Negativo, no lo veo en la bandeja de entrada.

Yo te envié otro privado. Lo has leido ? . Se abrán cruzado por el camino y han chocado desintegrándose ?

Saludos

[cesarsoftware]

Negativo, no lo veo en la bandeja de entrada.

Yo te envié otro privado. Lo has leido ? . Se abrán cruzado por el camino y han chocado desintegrándose ?

Saludos
jejeje:D, va a ser eso, si, si que lo lei y ya que estoy te contesto, porque basicamente (aunque algo mas extendido) te decia que idem de lo mismo, tuvimos algun proyecto comun pero que no cuajo, aunque se que les gusta nuestras soluciones industriales.

Y lo de la birra, (mi madre me dijo una vez "hijo, si te quieren invitar, no seas tonto y dejate"), ningun incoveniente, pero que huelan y sepan bien, nada de birras vituales.;)
Se agradece la ayuda.

[fjcg02]

...aunque algo mas extendido ...

No creo que sea eso, porque si el tuyo era más grande tendría que haber desintegrado al mío y ha sido al revés.

Un saludo
PD: si en Semana Santa te acercas por aquí no desaproveches la oferta que te he hecho, ya que seguramente estaré por aquí. Una birra es una birra.

[cesarsoftware]

Despues de varios dias trabajando, he notado que todavia quedaba "algo pendiente" a la hora de controlar los limites de las formas "hijas" lo pongo entre comillas para indicar que no son mdichild.

Resulta que al mover la forma se podian producir efectos no deseados como que se fuera la forma a 0,0, o a valores inferiores a los limites para luego volver a su sitio y esto era poque movia la forma dinamicamente y luego controlaba si se habia pasado, para solucionarlo nada mas facil (pero ahi que decirlo) que hacer todos los calculos y despues, solo despues de ajustar los limites, presentarla.

Por tanto el evento onmousemove queda asi y parece que mas sencillo y definitivo (por si alguien seguia este codigo, mas que nada, jejeje:D)
PD: he cambiado el nombre de PxDcha por PxBorde que es mas adecuado, y vale tanto para los 4 bordes de la forma.


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;


¿No tendre nada mejor que hacer un domingo a la tarde:eek:?

Saludos.

[fjcg02]

Negativo, no lo veo en la bandeja de entrada.

Yo te envié otro privado. Lo has leido ? . Se abrán cruzado por el camino y han chocado desintegrándose ?

Saludos

Algo pasa, porque después de escribir esto, ni han explotado los ordenadores ni nadie me dice nada... La cosa está mal, muy mal!

Saludos

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

[escafandra]

He estado ausente un tiempo. Me he encontrado este hilo y la referencia en este (http://clubdelphi.com/foros/showthread.php?t=75859) 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/library/windows/desktop/ms633540%28v=vs.85%29.aspx
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:
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:

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:

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:

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 :confused: no mueve las hijas por que no detecta bien el nombre de la clase en

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":confused:

¿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:
if Components[i].ClassName <> 'TForm2' then continue;
Tal como el código que expongo aquí (http://clubdelphi.com/foros/showpost.php?p=458097&postcount=44).


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):D

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.


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 (http://msdn.microsoft.com/en-us/library/windows/desktop/ms646360%28v=vs.85%29.aspx) 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).

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.

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

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.

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

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]

Lo que no he sabido hacer es como implementar
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 (http://msdn.microsoft.com/es-es/library/windows/desktop/ms633540%28v=vs.85%29.aspx) 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


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

Forma.Left := FormularioPadre.Left + PxBorde + Left;
Forma.Top := FormularioPadre.Top + PxArriba + Top;


y al controlar los limites en onmousemove

// 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=yHiEyPjZ890&feature=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:

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:

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