Barra de título transparente en los formularios

[[escafandra]]

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

Mira estos cambios:

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

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

Código Delphi [-]
  // 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 Noteví]

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