Ver Mensaje Individual
  #17  
Antiguo 04-10-2011
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.210
Reputación: 22
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
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.
Responder Con Cita