Club Delphi  
    Paypal   FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > API de Windows
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 26-09-2011
Avatar de rcarrillom
[rcarrillom] rcarrillom is offline
Miembro Premium
 
Registrado: dic 2004
Ubicación: UK / North Sea / Norway / Golfo de México / Frente a mi Laptop
Posts: 220
Poder: 22
rcarrillom Va por buen camino
Cita:
Empezado por rgstuamigo Ver Mensaje
"Uno no pierde nada con intentarlo"
Tiempo amigo mío (en caso de que no funcione el intento), que es lo más valioso
__________________
eLcHiCoTeMiDo - Rompecorazones profesional
Yo no soy presumido; ¿Pero de qué sirve mi humilde opinión contra la de los espejos?
Salva a un nylon, usa prendas de piel de foca
Responder Con Cita
  #2  
Antiguo 26-09-2011
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.210
Poder: 22
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
Quizás este artículo te interese.

Saludos.
Responder Con Cita
  #3  
Antiguo 26-09-2011
Avatar de rgstuamigo
rgstuamigo rgstuamigo is offline
Miembro
 
Registrado: jul 2008
Ubicación: Santa Cruz de la Sierra-Bolivia
Posts: 1.646
Poder: 19
rgstuamigo Va por buen camino
Arrow

Cita:
Empezado por rcarrillom Ver Mensaje
Tiempo amigo mío (en caso de que no funcione el intento), que es lo más valioso
Teneis razon por esa parte pero, si nunca lo intentas pues nunca aprendes nada nuevo.
Cita:
Empezado por escafandra Ver Mensaje
Quizás este artículo te interese.
Pues claro que me interesa mi buen amigo escafandra .
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; aunque para eso creo que voy estar haciendo algunas preguntas si me topo con algo que no entienda.
Saludos... y gracias....
__________________
"Pedid, y se os dará; buscad, y hallaréis; llamad, y se os abrirá." Mt.7:7
Responder Con Cita
  #4  
Antiguo 29-09-2011
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.210
Poder: 22
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
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 (lo mismo que delphi usando AlphaBlend). También realiza un ejemplo con la API UpdateLayeredWindow, 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 ) 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:
Código Delphi [-]
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í tenéis el ejemplo completo.


Saludos.

Última edición por ecfisa fecha: 09-03-2013 a las 00:33:29. Razón: Actualizar enlace FTP
Responder Con Cita
  #5  
Antiguo 29-09-2011
Avatar de roman
roman roman is offline
Moderador
 
Registrado: may 2003
Ubicación: Ciudad de México
Posts: 20.269
Poder: 10
roman Es un diamante en brutoroman Es un diamante en brutoroman Es un diamante en bruto
Cita:
Empezado por escafandra Ver Mensaje
He preparado una "chapucilla" como ejemplo en delphi, sencillo y con mejor rendimiento gráfico (creo ) 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

Muy ingenioso.

// Saludos
Responder Con Cita
  #6  
Antiguo 29-09-2011
Avatar de Chris
[Chris] Chris is offline
Miembro Premium
 
Registrado: abr 2007
Ubicación: Jinotepe, Nicaragua
Posts: 1.678
Poder: 21
Chris Va por buen camino
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!
__________________
Perfil Github - @chrramirez - Delphi Blog - Blog Web
Responder Con Cita
  #7  
Antiguo 29-09-2011
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.210
Poder: 22
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
Cita:
Empezado por roman Ver Mensaje
¡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

Muy ingenioso.

// Saludos
Bueno, no es mas que una chapucilla, una idea, una prueba de concepto.

Cita:
Empezado por Chris Ver Mensaje
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.


Saludos.
Responder Con Cita
  #8  
Antiguo 30-09-2011
Avatar de rgstuamigo
rgstuamigo rgstuamigo is offline
Miembro
 
Registrado: jul 2008
Ubicación: Santa Cruz de la Sierra-Bolivia
Posts: 1.646
Poder: 19
rgstuamigo Va por buen camino
Thumbs up

Cita:
Empezado por escafandra Ver Mensaje
...
He preparado una "chapucilla" como ejemplo en delphi, sencillo y con mejor rendimiento gráfico (creo ) 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, 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
    { 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:
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...
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.
Archivos Adjuntos
Tipo de Archivo: zip AlphaTitleBar.zip (1,8 KB, 20 visitas)
__________________
"Pedid, y se os dará; buscad, y hallaréis; llamad, y se os abrirá." Mt.7:7

Última edición por rgstuamigo fecha: 30-09-2011 a las 21:53:16.
Responder Con Cita
  #9  
Antiguo 01-10-2011
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.210
Poder: 22
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
Cita:
Empezado por rgstuamigo Ver Mensaje
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...
Cita:
Empezado por rgstuamigo Ver Mensaje
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.
Cita:
Empezado por rgstuamigo Ver Mensaje
Como puedes ver amigo escafandra, tu código me ha inspirado...
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.
Responder Con Cita
  #10  
Antiguo 03-10-2011
Avatar de escafandra
[escafandra] escafandra is offline
Miembro Premium
 
Registrado: nov 2007
Posts: 2.210
Poder: 22
escafandra Tiene un aura espectacularescafandra Tiene un aura espectacular
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é:

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;
  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.
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
tildes en la barra de título tino00 API de Windows 0 06-12-2008 19:13:34
Popup de la barra de titulo _cero_ C++ Builder 2 05-06-2008 18:02:21
Tamaño del TITULO de FORMULARIOS... Rogersito Plus OOP 2 18-10-2006 15:38:35
URL en la barra de titulo??? Jonnathan Varios 7 30-01-2006 20:43:24
Label en la Barra de Titulo... nicolasdom Varios 1 04-10-2004 23:46:31


La franja horaria es GMT +2. Ahora son las 12:21:01.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2026, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi