Barra de título transparente en los formularios

[rgstuamigo]

Hola amigos.
Todos sabemos que en Windows 7 los formularios y/o ventanas por defecto aparecen con su barra de título transparente, lo cual me parece muy bonito y pues actualmente estoy desarrolando una aplicacion que va a funcionar tanto en Window XP como Windows 7 y lo que deseo es hacer que SOLO la barra de títulos de los formularios de mi aplicacion sea transparente cuando se ejecuten en cualquier Windows.
Sé que puedo utilizar las propiedades AlphaBlend y AlphaBlendValue del formulario pero no me sirve ya que tales propiedades hacen que todo el formulario se haga transparente :o, y yo solo quiero hacer transparente la barra de título.;)He estado buscando y no he encontrado casi nada al respecto.
Existira alguna API que me ayude para tal menester y que sirva tanto para Windows XP o superior?
Desde ya... se le agradece cualquier comentario o sugerencia...;)
Saludos...:)
POSDATA: Estoy trabajando con Delphi XE y Windows 7.:)

[ecfisa]

Hola mi amigo, como siempre, un gran gusto verte por aquí :)

He estado buscando y parece que es más fácil hacer transparente una chapa de zinc que una barra de título en XP... :D

Pero, encontré este artículo (en realidad un tutorial) que quizá ya hayas leido: Creating Forms with Custom Title Bars (http://www.mindspring.com/~cityzoo/ttlbar1.html), pero si no, tal vez te pueda dar una idea de como lograrlo.

Lo siento pero no encontré nada más específico sobre lo que buscas... :(


Un saludo. :)

[roman]

Y, digo yo, ¿no sería mejor dejar el estilo de la ventana acorde al sistema operativo?

// Saludos

[rgstuamigo]

Hola mi amigo, como siempre, un gran gusto verte por aquí :)

He estado buscando y parece que es más fácil hacer transparente una chapa de zinc que una barra de título en XP... :D

Pero, encontré este artículo (en realidad un tutorial) que quizá ya hayas leido: Creating Forms with Custom Title Bars (http://www.mindspring.com/~cityzoo/ttlbar1.html), pero si no, tal vez te pueda dar una idea de como lograrlo.

Lo siento pero no encontré nada más específico sobre lo que buscas... :(


Un saludo. :)
Igualmente un gran gusto verte Daniel...
Muchas gracias por el enlace le voy a hechar una buena leida y ver que se puede hacer.

Y, digo yo, ¿no sería mejor dejar el estilo de la ventana acorde al sistema operativo?

// Saludos
Un saludo Roman... gracias por las respuestas....
Pues en principio eso es lo que pensé pero aveces se le meten ciertas cosas cosas a uno y pues quiere a veces darle un toque diferente a sus aplicaciones;):D, vamos a ver que tan complicado es la cosa, y si se pone dura pues vamos a tener que dejarlo así no más, pero como bien dice el dicho:"Uno no pierde nada con intentarlo".:D
De todas formas si alguien puede sugerirme o guiarme le seré muy agradecido.
Saludos...:)

[rcarrillom]

"Uno no pierde nada con intentarlo"

Tiempo amigo mío (en caso de que no funcione el intento), que es lo más valioso :D

[escafandra]

Quizás este artículo (http://www.codeproject.com/KB/dialog/SemiTranDlgWithCtrls.aspx) te interese.

Saludos.

[rgstuamigo]

Tiempo amigo mío (en caso de que no funcione el intento), que es lo más valioso :D
Teneis razon por esa parte pero:o, si nunca lo intentas pues nunca aprendes nada nuevo.;)
Quizás este artículo (http://www.codeproject.com/KB/dialog/SemiTranDlgWithCtrls.aspx) te interese.


Pues claro que me interesa mi buen amigo escafandra ;):D.
Ya me extrañaba no tener una respuestas tuya ;), sé muy bien que dominas con gran maestría la programacion con las API, por eso siempre que posteas algo en cualquier foro, estoy muy atento atus respuestas, pues siempre estoy aprendiendo algo nuevo tuyo.;)Vamos a hecharle una muy buena leida a ese link y ver si puedo hechar andar esto:o; aunque para eso creo que voy estar haciendo algunas preguntas si me topo con algo que no entienda.;)
Saludos... y gracias....:)

[escafandra]

El artículo que propuse muestra formularios muy vistosos pero de bajo rendimiento gráfico. Usa ventanas estilo WS_EX_LAYERED para conseguir semitransparencias y la API SetLayeredWindowAttributes (http://msdn.microsoft.com/en-us/library/windows/desktop/ms633540%28v=vs.85%29.aspx) (lo mismo que delphi usando AlphaBlend). También realiza un ejemplo con la API UpdateLayeredWindow (http://msdn.microsoft.com/en-us/library/windows/desktop/ms633556%28v=vs.85%29.aspx), engorrosa de usar porque nos tenemos que hacer cargo de pintar todos los controles, pues los mensajes WM_PAINT dejan de gestionarse.

He preparado una "chapucilla" como ejemplo en delphi, sencillo y con mejor rendimiento gráfico (creo :p) que sólo pretende colocar la barra del Caption y el brode de la ventana semitransparentes.

El truco es poner el Form como semitransparente con la propiedad AlphaBlend y su valor. Luego Creamos un segundo Form en tiempo de ejecución sin borde, sin Caption y opaco, que colocamos enzima, ocupando todo el área cliente. Posteriormente cambiamos el Parent de todos los controles a este nuevo Form. Para que esto funcione debemos reescribir parte de la función de tratamiento de mensajes del Form original.

El efecto resultante es lo que deseaba realizar rgstuamigo. Conseguimos hacer transparente la barra del título y la chapa de zinc.


El código que realiza el efecto es el siguiente:

procedure TForm1.WndProc(var Message: TMessage);
begin
case Message.Msg of
WM_SYSCOMMAND:
case Message.WParam of
SC_MAXIMIZE, SC_MINIMIZE, SC_RESTORE:
SetWindowPos(FForm.Handle, 0, Left + GetSystemMetrics(SM_CXFRAME),
Top + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME),
Width - 2*GetSystemMetrics(SM_CXFRAME),
Height - GetSystemMetrics(SM_CYCAPTION) - 2*GetSystemMetrics(SM_CYFRAME), 0);
end;
WM_CLOSE:
FForm.Close;
WM_MOVING:
SetWindowPos(FForm.Handle, 0, PRECT(Message.lParam).left + GetSystemMetrics(SM_CXFRAME),
PRECT(Message.lParam).top + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME),
0, 0, SWP_NOSIZE);
WM_SIZING:
SetWindowPos(FForm.Handle, 0, PRECT(Message.lParam).left + GetSystemMetrics(SM_CXFRAME),
PRECT(Message.lParam).top + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME),
PRECT(Message.lParam).Right - PRECT(Message.lParam).Left - 2*GetSystemMetrics(SM_CXFRAME),
PRECT(Message.lParam).Bottom - PRECT(Message.lParam).Top - GetSystemMetrics(SM_CYCAPTION) -
2*GetSystemMetrics(SM_CYFRAME), 0);
WM_SIZE:
if FForm <> nil then
SetWindowPos(FForm.Handle, 0, Left + GetSystemMetrics(SM_CXFRAME),
Top + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME),
Width - 2*GetSystemMetrics(SM_CXFRAME),
Height - GetSystemMetrics(SM_CYCAPTION) - 2*GetSystemMetrics(SM_CYFRAME), 0);
WM_SETFOCUS:
PostMessage(FForm.Handle, WM_SETFOCUS, 0, 0);
end;
inherited WndProc(Message);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FForm:= TForm.Create(self);
FForm.Left:= Left + GetSystemMetrics(SM_CXFRAME);
FForm.Top:= Top + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME);
FForm.Width:= Width - 2 * GetSystemMetrics(SM_CXFRAME);
FForm.Height:= Height - GetSystemMetrics(SM_CYCAPTION) - 2*GetSystemMetrics(SM_CYFRAME);
FForm.BorderStyle:= bsNone;
FForm.Show;

while ControlCount > 0 do
Controls[0].Parent:= FForm;

end;


Aquí (http://terawiki.clubdelphi.com/Delphi/Ejemplos/Controles/?download=Caption_Transparente.zip) tenéis el ejemplo completo.


Saludos.

[roman]

He preparado una "chapucilla" como ejemplo en delphi, sencillo y con mejor rendimiento gráfico (creo :p) que sólo pretende colocar la barra del Caption y el brode de la ventana semitransparentes.

El truco es poner el Form como semitransparente con la propiedad AlphaBlend y su valor. Luego Creamos un segundo Form en tiempo de ejecución sin borde, sin Caption y opaco, que colocamos enzima, ocupando todo el área cliente.

¡Joder! (Lo digo amistosamente) Ésta sí que es buena :) Yo lo único que había intentado, pero no funciona, era insertar el segundo formulario dentro del principal; pero tú literalmente lo has puesto encima, o sea, que le has puesto una cortinita :D

Muy ingenioso.

// Saludos

[Chris]

Eres un genio Escafandra!

Iba a sugerir lo mismo porque hace un par de meses estuve intentando desarrollar algo similar. Pero nunca logré quitar un pequeño flick que aparecía al momento de abrir la ventana por primera vez. En mi caso me inspiré analizando el código de Chromiun. Pero ahora me inspiraré de tí, espero que no te molestes :)

Saludos,
Chris!

[Chris]

Y, digo yo, ¿no sería mejor dejar el estilo de la ventana acorde al sistema operativo?

Tienes razón Román, yo soy de los que piensa siempre en seguir el espíritud, look and feel, del sistema sobre el que está corriendo nuestra aplicación. Luce más integrada. Pero si he visto que Skype en Wxp hace lo que desea nuestro compañero.

Saludos,
Chris

[escafandra]

¡Joder! (Lo digo amistosamente) Ésta sí que es buena :) Yo lo único que había intentado, pero no funciona, era insertar el segundo formulario dentro del principal; pero tú literalmente lo has puesto encima, o sea, que le has puesto una cortinita :D

Muy ingenioso.

// Saludos

Bueno, no es mas que una chapucilla, una idea, una prueba de concepto. :D

Eres un genio Escafandra!

Iba a sugerir lo mismo porque hace un par de meses estuve intentando desarrollar algo similar. Pero nunca logré quitar un pequeño flick que aparecía al momento de abrir la ventana por primera vez. En mi caso me inspiré analizando el código de Chromiun. Pero ahora me inspiraré de tí, espero que no te molestes :)

Saludos,
Chris!

¿Genio?..., no es para tanto. Es un honor que te inspires en mi código. :D


Saludos.

[rgstuamigo]

...
He preparado una "chapucilla" como ejemplo en delphi, sencillo y con mejor rendimiento gráfico (creo :p) que sólo pretende colocar la barra del Caption y el brode de la ventana semitransparentes.

El truco es poner el Form como semitransparente con la propiedad AlphaBlend y su valor. Luego Creamos un segundo Form en tiempo de ejecución sin borde, sin Caption y opaco, que colocamos enzima, ocupando todo el área cliente. Posteriormente cambiamos el Parent de todos los controles a este nuevo Form. Para que esto funcione debemos reescribir parte de la función de tratamiento de mensajes del Form original.

El efecto resultante es lo que deseaba realizar rgstuamigo. Conseguimos hacer transparente la barra del título y la chapa de zinc.
...

Excelente código amigo... de verdad..;)
Pues al ver tu código me puesto a trabajar de inmediato para transformar tu código y hacerlo un componente, aunque me ha costado bastante por que no tengo mucha experiencia en creacion de componentes como ustedes:o, pues he conseguido hacer una version estable:
Aquí está el código de dicho componente:
unit AlphaTitleBar;

interface

uses
SysUtils, Classes, Forms, Messages, Windows;

type
TAlphaTitleBar = class(TComponent)
private
{ Private declarations }
FForm: TForm;
FHooksCreated: Boolean;
FActive: Boolean;
FTransparencyValue: Byte;
OldWndProc: TFarProc;
NewWndProc: Pointer;
procedure HookOwner;
procedure UnhookOwner;
procedure CreateFForm;
procedure DestroyFForm;
Procedure SetActive(value: Boolean);
Procedure SetTransparencyValue(value: Byte);
Procedure UpdateWndProcAndOnCreate;
protected
{ Protected declarations }
procedure CallDefault(var Msg: TMessage);
procedure HookWndProc(var Message: TMessage); virtual;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
Property Active: Boolean read FActive write SetActive default False;
Property TransparencyValue: Byte read FTransparencyValue
write SetTransparencyValue default 170;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('GenioEscafandra', [TAlphaTitleBar]); //<--En homenaje a Escafandra ;);)
end;

{ TAlphaTitleBar }

procedure TAlphaTitleBar.CallDefault(var Msg: TMessage);
begin
Msg.Result := CallWindowProc(OldWndProc, TForm(Owner).Handle, Msg.Msg,
Msg.wParam, Msg.lParam);
end;

constructor TAlphaTitleBar.Create(AOwner: TComponent);
Var
I: Integer;
begin
if not(AOwner is TForm) then
raise EInvalidCast.Create
('El componente TAlphaTitleBar solo puede ser colocado en un TForm o en sus descendientes.');
with AOwner do
for I := 0 to ComponentCount - 1 do
if (Components[I] is TAlphaTitleBar) and (Components[I] <> Self) then
raise EComponentError.Create
('Solo se permite un solo componente TAlphaTitleBar en un formulario.');
inherited Create(AOwner);
FActive := False;
FTransparencyValue := 170;
// HookOwner;
end;

procedure TAlphaTitleBar.CreateFForm;
begin
with (Owner as TForm) do
begin
FForm := TForm.Create(nil); // (Self.Owner); // ojo lo cambie
FForm.BorderStyle := bsNone;
FForm.Show;
FForm.Left := Left + GetSystemMetrics(SM_CXFRAME);
FForm.Top := Top + GetSystemMetrics(SM_CYCAPTION) +
GetSystemMetrics(SM_CYFRAME);
FForm.Width := Width - 2 * GetSystemMetrics(SM_CXFRAME);
FForm.Height := Height - GetSystemMetrics(SM_CYCAPTION) - 2 *
GetSystemMetrics(SM_CYFRAME);
while ControlCount > 0 do
Controls[0].Parent := FForm;
SendMessage(Handle, WM_NCACTIVATE, ShortInt(True), 0);
end;
end;

destructor TAlphaTitleBar.Destroy;
begin
UnhookOwner;
DestroyFForm;
inherited Destroy;
end;

procedure TAlphaTitleBar.DestroyFForm;
begin
if Assigned(FForm) then
begin
while FForm.ControlCount > 0 do
FForm.Controls[0].Parent := (Owner as TForm);
FreeAndNil(FForm);
end;
end;

procedure TAlphaTitleBar.HookOwner;
begin
if not Assigned(Owner) then
Exit;
OldWndProc := TFarProc(GetWindowLong(TForm(Owner).Handle, GWL_WndProc));
NewWndProc := MakeObjectInstance(HookWndProc);
SetWindowLong(TForm(Owner).Handle, GWL_WndProc, LongInt(NewWndProc))
end;

procedure TAlphaTitleBar.HookWndProc(var Message: TMessage);
begin
with (Owner as TForm) do
Begin
case Message.Msg of
WM_SYSCOMMAND:
case Message.wParam of
SC_MAXIMIZE, SC_MINIMIZE, SC_RESTORE:
SetWindowPos(FForm.Handle, 0, Left + GetSystemMetrics(SM_CXFRAME),
Top + GetSystemMetrics(SM_CYCAPTION) +
GetSystemMetrics(SM_CYFRAME),
Width - 2 * GetSystemMetrics(SM_CXFRAME),
Height - GetSystemMetrics(SM_CYCAPTION) - 2 *
GetSystemMetrics(SM_CYFRAME), 0);
end;
WM_CLOSE:
FForm.Close;
WM_MOVING:
SetWindowPos(FForm.Handle, 0, PRECT(Message.lParam).Left +
GetSystemMetrics(SM_CXFRAME), PRECT(Message.lParam).Top +
GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME), 0, 0,
SWP_NOSIZE);
WM_SIZING:
SetWindowPos(FForm.Handle, 0, PRECT(Message.lParam).Left +
GetSystemMetrics(SM_CXFRAME), PRECT(Message.lParam).Top +
GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME),
PRECT(Message.lParam).Right - PRECT(Message.lParam).Left - 2 *
GetSystemMetrics(SM_CXFRAME), PRECT(Message.lParam).Bottom -
PRECT(Message.lParam).Top - GetSystemMetrics(SM_CYCAPTION) - 2 *
GetSystemMetrics(SM_CYFRAME), 0);
WM_SIZE:
if FForm <> nil then
SetWindowPos(FForm.Handle, 0, Left + GetSystemMetrics(SM_CXFRAME),
Top + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME),
Width - 2 * GetSystemMetrics(SM_CXFRAME),
Height - GetSystemMetrics(SM_CYCAPTION) - 2 *
GetSystemMetrics(SM_CYFRAME), 0);
WM_SETFOCUS:
PostMessage(FForm.Handle, WM_SETFOCUS, 0, 0);
end;
CallDefault(Message);
End;
end;

procedure TAlphaTitleBar.SetActive(value: Boolean);
begin
if value <> FActive then
begin
FActive := value;
TForm(Owner).AlphaBlend := value;
UpdateWndProcAndOnCreate;
end;
end;

procedure TAlphaTitleBar.SetTransparencyValue(value: Byte);
begin
if value <> FTransparencyValue then
begin
FTransparencyValue := value;
TForm(Owner).AlphaBlendValue := value;
TForm(Owner).Invalidate;
end;

end;

procedure TAlphaTitleBar.UnhookOwner;
begin
if Assigned(Owner) and Assigned(OldWndProc) then
SetWindowLong(TForm(Owner).Handle, GWL_WndProc, LongInt(OldWndProc));
if Assigned(NewWndProc) then
FreeObjectInstance(NewWndProc);
NewWndProc := nil;
OldWndProc := nil
end;

procedure TAlphaTitleBar.UpdateWndProcAndOnCreate;
begin
if FActive then
begin
if not FHooksCreated then
begin
FHooksCreated := True;
if not(csDesigning in ComponentState) then
CreateFForm;
HookOwner;
end;
end
else
begin
FHooksCreated := False;
UnhookOwner;
DestroyFForm;
end;
TForm(Owner).Invalidate;
end;

end.
Desde luego se lo puede mejorar, por ejemplo:
* Ampliarlo para que todos los formularios, dialogos,etc, de la aplicacion tambien tengan los bordes y titulos transparante, con tan solo tener un solo componente en el formulario principal.
* Mejorarlo para que soporte imagenes en la transparencia.
* Etc..

Como puedes ver amigo escafandra, tu código me ha inspirado...;):D:D
Estaré atento a las criticas y/o sugerencias sobre éste componente.;)
Y espero que le sirva a más de uno.;)
Saludos...
EDITO:
Adjunto el archivo del componente.

[escafandra]

Pues al ver tu código me puesto a trabajar de inmediato para transformar tu código y hacerlo un componente
Si, el paso siguiente era realizar un componente...
Estaré atento a las criticas y/o sugerencias sobre éste componente.;)
Te ha quedado muy bien. Lo he probado deprisa y me ha dado algún error que me ha colgado delphi. No he detectado el por qué, lo miraré mas despacio cuando tenga un rato libre. Una cosa que debes hacer es proporcionarle un icono para que aparezca mas profesional en la barra de controles de delphi.
Como puedes ver amigo escafandra, tu código me ha inspirado...;):D:D
Me agrada que mi código te sirva de ayuda e inspiración así como que responda a tus propósitos en algo que a priori parecía difícil.

Seguro que ayuda a mas de uno. ;)


Saludos.

[escafandra]

Finalmente he conseguido un ratito libre y he realizado alguna modificación en el componente sin perder la esencia del original. El error estaba en cuando se permitía el Hook al WinProc del Owner. No se debe permitir en fase de diseño...

Muestro aquí los pequeños cambios que realicé:


unit AlphaTitleBar;

interface

uses
SysUtils, Classes, Forms, Messages, Windows;

type
TAlphaTitleBar = class(TComponent)
private
{ Private declarations }
FForm: TForm;
FActive: Boolean;
FTransparencyValue: Byte;
FOldOwnerAlphaBlendValue: Byte;
FOldOwnerAlphaBlend: boolean;
OldWndProc: TFarProc;
NewWndProc: Pointer;
procedure HookOwner;
procedure UnhookOwner;
procedure CreateFForm;
procedure DestroyFForm;
Procedure SetActive(value: Boolean);
Procedure SetTransparencyValue(value: Byte);
Procedure UpdateWndProcAndOnCreate;
protected
{ Protected declarations }
procedure CallDefault(var Msg: TMessage);
procedure HookWndProc(var Message: TMessage); virtual;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
Property Active: Boolean read FActive write SetActive default False;
Property TransparencyValue: Byte read FTransparencyValue
write SetTransparencyValue default 170;
end;

procedure Register;

implementation
{$WARN SYMBOL_DEPRECATED OFF}

procedure Register;
begin
RegisterComponents('GenioEscafandra', [TAlphaTitleBar]);; //<--En homenaje a Escafandra
end;

{ TAlphaTitleBar }

procedure TAlphaTitleBar.CallDefault(var Msg: TMessage);
begin
Msg.Result := CallWindowProc(OldWndProc, TForm(Owner).Handle, Msg.Msg,
Msg.wParam, Msg.lParam);
end;

constructor TAlphaTitleBar.Create(AOwner: TComponent);
Var
I: Integer;
begin
if not(AOwner is TForm) then
raise EInvalidCast.Create
('El componente TAlphaTitleBar solo puede ser colocado en un TForm o en sus descendientes.');
with AOwner do
for I := 0 to ComponentCount - 1 do
if (Components[I] is TAlphaTitleBar) and (Components[I] <> Self) then
raise EComponentError.Create
('Solo se permite un solo componente TAlphaTitleBar en un formulario.');
inherited Create(AOwner);
NewWndProc:= nil;
FOldOwnerAlphablendValue:= TForm(Owner).AlphaBlendValue;
FOldOwnerAlphablend:= TForm(Owner).AlphaBlend;

Active := False;
TransparencyValue := 170;
end;

procedure TAlphaTitleBar.CreateFForm;
begin
with (Owner as TForm) do
begin
FForm := TForm.Create(nil);
FForm.BorderStyle := bsNone;
FForm.Left := Left + GetSystemMetrics(SM_CXFRAME);
FForm.Top := Top + GetSystemMetrics(SM_CYCAPTION) +
GetSystemMetrics(SM_CYFRAME);
FForm.Width := Width - 2 * GetSystemMetrics(SM_CXFRAME);
FForm.Height := Height - GetSystemMetrics(SM_CYCAPTION) - 2 *
GetSystemMetrics(SM_CYFRAME);
FForm.Show;

while ControlCount > 0 do
Controls[0].Parent := FForm;

SendMessage(Handle, WM_NCACTIVATE, ShortInt(True), 0);
end;
end;
destructor TAlphaTitleBar.Destroy;
begin
if (Owner <> nil) then
begin
TForm(Owner).AlphablendValue:= FOldOwnerAlphaBlendValue;
TForm(Owner).Alphablend:= FOldOwnerAlphaBlend;
end;
UnhookOwner;
DestroyFForm;
inherited Destroy;
end;

procedure TAlphaTitleBar.DestroyFForm;
begin
if Assigned(FForm) then
begin
while FForm.ControlCount > 0 do
FForm.Controls[0].Parent := (Owner as TForm);
FreeAndNil(FForm);
end;
end;

procedure TAlphaTitleBar.HookWndProc(var Message: TMessage);
begin
with (Owner as TForm) do
Begin
case Message.Msg of
WM_SYSCOMMAND:
case Message.wParam of
SC_MAXIMIZE, SC_MINIMIZE, SC_RESTORE:
begin
SetWindowPos(FForm.Handle, 0, Left + GetSystemMetrics(SM_CXFRAME),
Top + GetSystemMetrics(SM_CYCAPTION) +
GetSystemMetrics(SM_CYFRAME),
Width - 2 * GetSystemMetrics(SM_CXFRAME),
Height - GetSystemMetrics(SM_CYCAPTION) - 2 *
GetSystemMetrics(SM_CYFRAME), 0);
end;
end;
WM_CLOSE:
FForm.Close;
WM_MOVING:
SetWindowPos(FForm.Handle, 0, PRECT(Message.lParam).Left +
GetSystemMetrics(SM_CXFRAME), PRECT(Message.lParam).Top +
GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME), 0, 0,
SWP_NOSIZE);
WM_SIZING:
SetWindowPos(FForm.Handle, 0, PRECT(Message.lParam).Left +
GetSystemMetrics(SM_CXFRAME), PRECT(Message.lParam).Top +
GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME),
PRECT(Message.lParam).Right - PRECT(Message.lParam).Left - 2 *
GetSystemMetrics(SM_CXFRAME), PRECT(Message.lParam).Bottom -
PRECT(Message.lParam).Top - GetSystemMetrics(SM_CYCAPTION) - 2 *
GetSystemMetrics(SM_CYFRAME), 0);
WM_SIZE:
if FForm <> nil then
SetWindowPos(FForm.Handle, 0, Left + GetSystemMetrics(SM_CXFRAME),
Top + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME),
Width - 2 * GetSystemMetrics(SM_CXFRAME),
Height - GetSystemMetrics(SM_CYCAPTION) - 2 *
GetSystemMetrics(SM_CYFRAME), 0);
WM_SETFOCUS:
begin
PostMessage(FForm.Handle, WM_SETFOCUS, 0, 0);
end;
end;
CallDefault(Message);
End;
end;

procedure TAlphaTitleBar.SetActive(value: Boolean);
begin
if value <> FActive then
begin
FActive := value;
TForm(Owner).AlphaBlend := value;
TForm(Owner).Invalidate;
UpdateWndProcAndOnCreate;
end;
end;

procedure TAlphaTitleBar.SetTransparencyValue(value: Byte);
begin
if value <> FTransparencyValue then
begin
FTransparencyValue := value;
TForm(Owner).AlphaBlendValue := value;
TForm(Owner).Invalidate;
end;
end;

procedure TAlphaTitleBar.HookOwner;
begin
if not Assigned(Owner) or (NewWndProc <> nil) then
Exit;
OldWndProc := TFarProc(GetWindowLong(TForm(Owner).Handle, GWL_WndProc));
NewWndProc := MakeObjectInstance(HookWndProc);
SetWindowLong(TForm(Owner).Handle, GWL_WndProc, LongInt(NewWndProc))
end;

procedure TAlphaTitleBar.UnhookOwner;
begin
if Assigned(Owner) and Assigned(OldWndProc) then
SetWindowLong(TForm(Owner).Handle, GWL_WndProc, LongInt(OldWndProc));
if Assigned(NewWndProc) then
FreeObjectInstance(NewWndProc);
NewWndProc := nil;
// OldWndProc := nil
end;

procedure TAlphaTitleBar.UpdateWndProcAndOnCreate;
begin
if FActive and not(csDesigning in ComponentState) then
begin
if NewWndProc = nil then
begin
CreateFForm;
HookOwner;
end;
end
else
begin
UnhookOwner;
DestroyFForm;
end;
TForm(Owner).Invalidate;
end;

end.



Saludos.

[rgstuamigo]

Muy bien por la correccion, escafandra...:) a la verdad, como mencioné en mi primer post, estoy trabajando con Delphi XE y Windows 7 y no me ha dado errores por ese lado.
Bueno... viendo y probando dicho compenente me he dado cuenta que necesitamos hacerle más corrección por ejemplo:
El formulario que hace de cortina, debería copiar ciertas propiedades del formulario original tales como:

La propiedad Visible, ya que si el formulario original esta en false, nuestro componente falla.:o
La propiedad color, entre otras.;)

¿Qué opinas al respecto?:confused:
Saludos...:)

[escafandra]

Tienes toda la razón ;). También habría que controlar el cursor.

Mira estos cambios:

unit AlphaTitleBar;

interface

uses
SysUtils, Classes, Forms, Messages, Windows;

type
TAlphaTitleBar = class(TComponent)
private
{ Private declarations }
FForm: TForm;
FActive: Boolean;
FTransparencyValue: Byte;
FOldOwnerAlphaBlendValue: Byte;
FOldOwnerAlphaBlend: boolean;
OldWndProc: TFarProc;
NewWndProc: Pointer;
procedure HookOwner;
procedure UnhookOwner;
procedure CreateFForm;
procedure DestroyFForm;
Procedure SetActive(value: Boolean);
Procedure SetTransparencyValue(value: Byte);
Procedure UpdateWndProcAndOnCreate;
protected
{ Protected declarations }
procedure CallDefault(var Msg: TMessage);
procedure HookWndProc(var Message: TMessage); virtual;
procedure MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
Property Active: Boolean read FActive write SetActive default False;
Property TransparencyValue: Byte read FTransparencyValue
write SetTransparencyValue default 170;
end;

procedure Register;

implementation
{$WARN SYMBOL_DEPRECATED OFF}

procedure Register;
begin
RegisterComponents('GenioEscafandra', [TAlphaTitleBar]);; //<--En homenaje a Escafandra
end;

{ TAlphaTitleBar }

procedure TAlphaTitleBar.CallDefault(var Msg: TMessage);
begin
Msg.Result := CallWindowProc(OldWndProc, TForm(Owner).Handle, Msg.Msg,
Msg.wParam, Msg.lParam);
end;

constructor TAlphaTitleBar.Create(AOwner: TComponent);
Var
I: Integer;
begin
if not(AOwner is TForm) then
raise EInvalidCast.Create
('El componente TAlphaTitleBar solo puede ser colocado en un TForm o en sus descendientes.');
with AOwner do
for I := 0 to ComponentCount - 1 do
if (Components[I] is TAlphaTitleBar) and (Components[I] <> Self) then
raise EComponentError.Create
('Solo se permite un solo componente TAlphaTitleBar en un formulario.');
inherited Create(AOwner);
NewWndProc:= nil;
FOldOwnerAlphablendValue:= TForm(Owner).AlphaBlendValue;
FOldOwnerAlphablend:= TForm(Owner).AlphaBlend;
Active := False;
TransparencyValue := 170;
end;

procedure TAlphaTitleBar.CreateFForm;
begin
with (Owner as TForm) do
begin
FForm := TForm.Create(nil);
FForm.BorderStyle := bsNone;
FForm.Left := Left + GetSystemMetrics(SM_CXFRAME);
FForm.Top := Top + GetSystemMetrics(SM_CYCAPTION) +
GetSystemMetrics(SM_CYFRAME);
FForm.Width := Width - 2 * GetSystemMetrics(SM_CXFRAME);
FForm.Height := Height - GetSystemMetrics(SM_CYCAPTION) - 2 *
GetSystemMetrics(SM_CYFRAME);
FForm.Show;
FForm.OnMouseMove:= MouseMove;

while ControlCount > 0 do
Controls[0].Parent := FForm;

SendMessage(Handle, WM_NCACTIVATE, ShortInt(True), 0);
end;
end;
destructor TAlphaTitleBar.Destroy;
begin
if (Owner <> nil) then
begin
TForm(Owner).AlphablendValue:= FOldOwnerAlphaBlendValue;
TForm(Owner).Alphablend:= FOldOwnerAlphaBlend;
end;
UnhookOwner;
DestroyFForm;
inherited Destroy;
end;

procedure TAlphaTitleBar.DestroyFForm;
begin
if Assigned(FForm) then
begin
while FForm.ControlCount > 0 do
FForm.Controls[0].Parent := (Owner as TForm);
FreeAndNil(FForm);
end;
end;

procedure TAlphaTitleBar.HookWndProc(var Message: TMessage);
begin
with (Owner as TForm) do
Begin
case Message.Msg of
WM_SYSCOMMAND:
case Message.wParam of
SC_MAXIMIZE, SC_MINIMIZE, SC_RESTORE:
begin
SetWindowPos(FForm.Handle, 0, Left + GetSystemMetrics(SM_CXFRAME),
Top + GetSystemMetrics(SM_CYCAPTION) +
GetSystemMetrics(SM_CYFRAME),
Width - 2 * GetSystemMetrics(SM_CXFRAME),
Height - GetSystemMetrics(SM_CYCAPTION) - 2 *
GetSystemMetrics(SM_CYFRAME), 0);
end;
end;
WM_CLOSE:
FForm.Close;
WM_MOVING:
SetWindowPos(FForm.Handle, 0, PRECT(Message.lParam).Left +
GetSystemMetrics(SM_CXFRAME), PRECT(Message.lParam).Top +
GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME), 0, 0,
SWP_NOSIZE);
WM_SIZING:
SetWindowPos(FForm.Handle, 0, PRECT(Message.lParam).Left +
GetSystemMetrics(SM_CXFRAME), PRECT(Message.lParam).Top +
GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME),
PRECT(Message.lParam).Right - PRECT(Message.lParam).Left - 2 *
GetSystemMetrics(SM_CXFRAME), PRECT(Message.lParam).Bottom -
PRECT(Message.lParam).Top - GetSystemMetrics(SM_CYCAPTION) - 2 *
GetSystemMetrics(SM_CYFRAME), 0);
WM_SIZE:
if FForm <> nil then
SetWindowPos(FForm.Handle, 0, Left + GetSystemMetrics(SM_CXFRAME),
Top + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME),
Width - 2 * GetSystemMetrics(SM_CXFRAME),
Height - GetSystemMetrics(SM_CYCAPTION) - 2 *
GetSystemMetrics(SM_CYFRAME), 0);
WM_SETFOCUS:
PostMessage(FForm.Handle, WM_SETFOCUS, 0, 0);
WM_SHOWWINDOW:
FForm.Visible:= boolean(Message.wParam);
WM_PAINT:
FForm.Color:= Color;
end;
CallDefault(Message);
end;
end;

procedure TAlphaTitleBar.SetActive(value: Boolean);
begin
if value <> FActive then
begin
FActive := value;
if not(csDesigning in ComponentState) then
TForm(Owner).AlphaBlend := value;
TForm(Owner).Invalidate;
UpdateWndProcAndOnCreate;
end;
end;

procedure TAlphaTitleBar.SetTransparencyValue(value: Byte);
begin
if value <> FTransparencyValue then
begin
FTransparencyValue := value;
if not(csDesigning in ComponentState) then
TForm(Owner).AlphaBlendValue := value;
TForm(Owner).Invalidate;
end;
end;

procedure TAlphaTitleBar.HookOwner;
begin
if not Assigned(Owner) or (NewWndProc <> nil) then
Exit;
OldWndProc := TFarProc(GetWindowLong(TForm(Owner).Handle, GWL_WndProc));
NewWndProc := MakeObjectInstance(HookWndProc);
SetWindowLong(TForm(Owner).Handle, GWL_WndProc, LongInt(NewWndProc))
end;

procedure TAlphaTitleBar.UnhookOwner;
begin
if Assigned(Owner) and Assigned(OldWndProc) then
SetWindowLong(TForm(Owner).Handle, GWL_WndProc, LongInt(OldWndProc));
if Assigned(NewWndProc) then
FreeObjectInstance(NewWndProc);
NewWndProc := nil;
// OldWndProc := nil
end;

procedure TAlphaTitleBar.UpdateWndProcAndOnCreate;
begin
if FActive and not(csDesigning in ComponentState) then
begin
if NewWndProc = nil then
begin
CreateFForm;
HookOwner;
end;
end
else
begin
UnhookOwner;
DestroyFForm;
end;
TForm(Owner).Invalidate;
end;

procedure TAlphaTitleBar.MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
FForm.Cursor:= TForm(Owner).Cursor;
end;

end.


Saludos.

[cesarsoftware]

Hola compañeros.

Recupero este tema para que no digais que no he buscado:D

Creo que yo necesito los mismo, pero al reves, me explico (y pido ayuda porque no consigo el efecto que quiero), 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.

[Casimiro Notevi]

Hombre, si no tratas de dar una solución al tema iniciado, entonces deberías haber creado otro hilo nuevo ;)