Cita:
Empezado por escafandra
...
He preparado una " chapucilla" como ejemplo en delphi, sencillo y con mejor rendimiento gráfico (creo ![Stick Out Tongue](http://www.clubdelphi.com/foros/images/smilies/tongue.gif) ) 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..
![Wink](http://www.clubdelphi.com/foros/images/smilies/wink.gif)
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
![Embarrassment](http://www.clubdelphi.com/foros/images/smilies/redface.gif)
, pues he conseguido hacer una version estable:
Aquí está el código de dicho componente:
Código Delphi
[-]unit AlphaTitleBar;
interface
uses
SysUtils, Classes, Forms, Messages, Windows;
type
TAlphaTitleBar = class(TComponent)
private
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
procedure CallDefault(var Msg: TMessage);
procedure HookWndProc(var Message: TMessage); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
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]); end;
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;
end;
procedure TAlphaTitleBar.CreateFForm;
begin
with (Owner as TForm) do
begin
FForm := TForm.Create(nil); 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:
Cita:
* 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...
![Wink](http://www.clubdelphi.com/foros/images/smilies/wink.gif)
![Big Grin](http://www.clubdelphi.com/foros/images/smilies/biggrin.gif)
![Big Grin](http://www.clubdelphi.com/foros/images/smilies/biggrin.gif)
Estaré atento a las criticas y/o sugerencias sobre éste componente.
![Wink](http://www.clubdelphi.com/foros/images/smilies/wink.gif)
Y espero que le sirva a más de uno.
![Wink](http://www.clubdelphi.com/foros/images/smilies/wink.gif)
Saludos...
EDITO:
Adjunto el archivo del componente.