Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Los mejores trucos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 01-07-2006
Avatar de dec
dec dec is offline
Moderador
 
Registrado: dic 2004
Ubicación: Alcobendas, Madrid, España
Posts: 13.119
Poder: 34
dec Tiene un aura espectaculardec Tiene un aura espectacular
Formularios transparentes

Código Delphi [-]
{
  Esto es un ejemplo para utilizar la propiedad de atenuación
  que viene en Windows 2000 y Windows XP.

  Por Pedro A. De Fuentes Quesada.
  pedroq ARROBA airtel.net
  http://www.pedroq.da.ru/
}

Unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TfrmMain = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Text1: TEdit;
    Text2: TEdit;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.DFM}

// Declaraciones para Layered Windows
Const WS_EX_LAYERED = $80000;
Const LWA_ALPHA  = $2;
Const GWL_EXSTYLE = (-20);
Const RDW_INVALIDATE = $1;
Const RDW_ERASE = $4;
Const RDW_ALLCHILDREN = $80;
Const RDW_FRAME = $400;

Var
  mAlpha: LongInt;

Procedure LayerWindow (dwFlags: Integer);

Type
  TSetLayeredWindowAttributes = Function (Wnd: HWND;
                                          crKey: Word;
                                          Alpha: Word;
                                          dwFlags: Word): Integer; stdcall;
Var
  exLibrary: THandle;
  SetLayeredWindowAttributes: TSetLayeredWindowAttributes;
Begin
  exLibrary := LoadLibrary(PChar('user32.dll'));

   If exLibrary = 0 then
   Raise Exception.Create('No se pudo cargar user32.DLL');

   @SetLayeredWindowAttributes := GetProcAddress(exLibrary, 'SetLayeredWindowAttributes');

   If @SetLayeredWindowAttributes = nil then
     Begin
       FreeLibrary(exLibrary);
     Raise
       Exception.Create('No se pudo encontrar SetLayeredWindowAttributes en user32.DLL');
     End;

  // Cuando dwFlags = 0, simplemente se hace transparente el formulario en base al valor
  // introducido en el Edit2
  If dwFlags = 0 then
    Begin
      SetWindowLong(frmMain.Handle, GWL_EXSTYLE, GetWindowLong(frmMain.Handle, GWL_EXSTYLE) Or WS_EX_LAYERED);
      SetLayeredWindowAttributes(frmMain.Handle, 0, (255 * mAlpha) div 100, LWA_ALPHA);
   End;

  // Cuando dwFlags = 1, se aplica el efecto fade, que consiste en mostrar el formulario
  // desde la nada (al 1% de visibilidad), y con el intervalo marcado en el Edit1
  If dwFlags = 1 then
    Begin
      SetLayeredWindowAttributes(frmMain.Handle, 0, (255 * mAlpha) div 100, LWA_ALPHA);
    End;

  // Cuando dwFlags = 2, se muestra el formulario normalmente
  If dwFlags = 2 then
    Begin
      SetWindowLong(frmMain.Handle, GWL_EXSTYLE, GetWindowLong(frmMain.Handle, GWL_EXSTYLE) And Not WS_EX_LAYERED);
      RedrawWindow (frmMain.Handle, nil, 0, RDW_ERASE Or RDW_INVALIDATE Or RDW_FRAME Or RDW_ALLCHILDREN);
    End;

  FreeLibrary(exLibrary);
End;

Procedure TfrmMain.Button1Click(Sender: TObject);
Var
  cAlpha: Integer;
Begin
  LayerWindow (0);

  cAlpha := StrToInt(Text1.Text);

  SetWindowLong(frmMain.Handle, GWL_EXSTYLE, GetWindowLong(frmMain.Handle, GWL_EXSTYLE) Or WS_EX_LAYERED);

  mAlpha := cAlpha;

  Timer1.Interval := StrToInt(Text2.Text);

  Timer1.Enabled := True;
End;

Procedure TfrmMain.Timer1Timer(Sender: TObject);
Begin
  LayerWindow (1);

  mAlpha := mAlpha + 10;
   If mAlpha >= 100 Then
     Begin
       Timer1.Enabled := False;
       LayerWindow (2);
     End;
End;

Procedure TfrmMain.Button2Click(Sender: TObject);
Begin
  mAlpha := StrToInt (Text1.Text);
  SetWindowLong(frmMain.Handle, GWL_EXSTYLE, GetWindowLong(frmMain.Handle, GWL_EXSTYLE) Or WS_EX_LAYERED);
  LayerWindow (1);
End;

End.
Responder Con Cita
  #2  
Antiguo 18-11-2006
keesca keesca is offline
Registrado
 
Registrado: nov 2006
Posts: 1
Poder: 0
keesca Va por buen camino
componente rave en delphi 2006
Responder Con Cita
Respuesta



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


La franja horaria es GMT +2. Ahora son las 01:17:58.


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