[Delphi] DH Form Effects 0.3

Una clase en Delphi para darle efectos a los formularios.

Tiene las siguientes opciones :

Animacion marquesina en los labels de izquierda a derecha y viceversa
Animacion marquesina en los labels de arriba hacia abajo y viceversa
Volver transparentes los formularios
Volver transparente la consola del programa
Varios efectos en la ventana de los formularios

El codigo :

Código

// Unit : DH Form Effects
// Version : 0.3
// (C) Doddy Hackman 2016
 
unit DH_Form_Effects;
 
interface
 
uses Windows, SysUtils, Vcl.Forms, Vcl.StdCtrls, Vcl.ExtCtrls, Registry;
 
type
  T_DH_Form_Effects = class
  private
 
  public
    constructor Create;
    destructor Destroy; override;
    procedure Effect_Marquee_Label_DownUp(Panel1: TPanel; Label1: TLabel;
      segundos: integer);
    procedure Effect_Marquee_Label_LeftRight(Label2: TLabel; opcion: string;
      segundos: integer);
    procedure Effect_Marquee_Form_Caption_LeftRight(Form1: TForm;
      opcion: string; segundos: integer);
    function Window_Effect(Form: HWND; opcion: string;
      velocidad: integer): bool;
    function Window_Transparent(Form: TForm; level: integer): bool;
    procedure Effect_Load_Another_Form(Form1_Load: TForm; Form2_Load: TForm;
      option: string; autosize: integer; space: integer; seconds: integer);
    function desktop_composition_control(option: string): bool;
    function Effect_Glass_in_Console(): bool;
  end;
 
type
  TTimerEffect_Marquee_Label_DownUp = Class(TTimer)
  public
    procedure OnWork(Sender: TObject);
  end;
 
  TTimerEffect_Marquee_Label_LeftRight = Class(TTimer)
  public
    procedure OnWork(Sender: TObject);
  end;
 
  TTimerEffect_Marquee_Form_Caption_LeftRight = Class(TTimer)
  public
    procedure OnWork(Sender: TObject);
  end;
 
var
  Timer_Effect_Marquee_Label_DownUp: TTimerEffect_Marquee_Label_DownUp;
  PanelToMove1: TPanel;
  LabelToMove1: TLabel;
 
var
  TimerEffect_Marquee_Label_LeftRight: TTimerEffect_Marquee_Label_LeftRight;
  LabelToMove2: TLabel;
  Option_Marquee_Label_LeftRight: string;
 
var
  TimerEffect_Marquee_Form_Caption_LeftRight
    : TTimerEffect_Marquee_Form_Caption_LeftRight;
  FormCaptionToMove: TForm;
  Option_Marquee_Form_Caption_LeftRight: string;
 
implementation
 
constructor T_DH_Form_Effects.Create;
begin
  inherited Create;
  //
end;
 
destructor T_DH_Form_Effects.Destroy;
begin
  inherited Destroy;
end;
 
// Timers
 
procedure TTimerEffect_Marquee_Label_DownUp.OnWork(Sender: TObject);
begin
  LabelToMove1.Top := LabelToMove1.Top - 10;
  if LabelToMove1.Top + LabelToMove1.Height < 0 then
  begin
    LabelToMove1.Top := PanelToMove1.Height;
  end;
end;
 
procedure TTimerEffect_Marquee_Form_Caption_LeftRight.OnWork(Sender: TObject);
var
  code: string;
  opcion: string;
begin
  code := FormCaptionToMove.Caption;
  opcion := Option_Marquee_Form_Caption_LeftRight;
  if opcion = 'left' then
  begin
    FormCaptionToMove.Caption := Copy(code, 2, Length(code) - 1) +
      Copy(code, 1, 1);
  end
  else if (opcion = 'right') then
  begin
    FormCaptionToMove.Caption := Copy(code, Length(code) - 1, 1) +
      Copy(code, 1, Length(code) - 1);
  end
  else
  begin
    FormCaptionToMove.Caption := Copy(code, 2, Length(code) - 1) +
      Copy(code, 1, 1);
  end;
end;
 
procedure TTimerEffect_Marquee_Label_LeftRight.OnWork(Sender: TObject);
// Based on : http://delphi.about.com/od/vclusing/a/marquee.htm
// Thanks to Zarko Gajic
var
  code: string;
  opcion: string;
begin
  code := LabelToMove2.Caption;
  opcion := Option_Marquee_Label_LeftRight;
  if opcion = 'left' then
  begin
    LabelToMove2.Caption := Copy(code, 2, Length(code) - 1) + Copy(code, 1, 1);
  end
  else if (opcion = 'right') then
  begin
    LabelToMove2.Caption := Copy(code, Length(code) - 1, 1) +
      Copy(code, 1, Length(code) - 1);
  end
  else
  begin
    LabelToMove2.Caption := Copy(code, 2, Length(code) - 1) + Copy(code, 1, 1);
  end;
end;
 
//
 
// Functions
 
procedure T_DH_Form_Effects.Effect_Load_Another_Form(Form1_Load: TForm;
  Form2_Load: TForm; option: string; autosize: integer; space: integer;
  seconds: integer);
var
  width: integer;
  Height: integer;
  i: integer;
begin
 
  if (autosize = 1) then
  begin
    width := Form2_Load.width;
    Height := Form1_Load.Height;
  end
  else
  begin
    width := Form2_Load.width;
    Height := Form2_Load.Height;
  end;
 
  if (option = 'effect1') then
  begin
    Form2_Load.width := 1;
    Form2_Load.Height := Form1_Load.Height;
    Form2_Load.Left := space + Form1_Load.Left + Form1_Load.width;
    Form2_Load.Top := Form1_Load.Top;
    Form2_Load.Show;
    for i := 1 to width do
    begin
      if (Form2_Load.width = width) then
      begin
        break;
      end
      else
      begin
        Form2_Load.width := i + seconds;
        Form2_Load.Update;
      end;
    end;
  end
  else if (option = 'effect2') then
  begin
    Form2_Load.Hide;
    Form2_Load.Height := Height;
    Form2_Load.Left := Form1_Load.Left + width;
    Form2_Load.Top := Form1_Load.Top;
    Form2_Load.Left := space + Form1_Load.Left + Form1_Load.width;
    Window_Effect(Form2_Load.Handle, 'effect1', seconds);
    Form2_Load.Show;
  end
  else
  begin
    Form2_Load.width := 1;
    Form2_Load.Height := Form1_Load.Height;
    Form2_Load.Left := space + Form1_Load.Left + Form1_Load.width;
    Form2_Load.Top := Form1_Load.Top;
    Form2_Load.Show;
    for i := 1 to width do
    begin
      if (Form2_Load.width = width) then
      begin
        break;
      end
      else
      begin
        Form2_Load.width := i + seconds;
        Form2_Load.Update;
      end;
    end;
  end;
end;
 
procedure T_DH_Form_Effects.Effect_Marquee_Label_DownUp(Panel1: TPanel;
  Label1: TLabel; segundos: integer);
begin
 
  // To hide panel : BevelOuter = bvNone
 
  PanelToMove1 := Panel1;
  LabelToMove1 := Label1;
  Timer_Effect_Marquee_Label_DownUp :=
    TTimerEffect_Marquee_Label_DownUp.Create(nil);
  Timer_Effect_Marquee_Label_DownUp.Interval := segundos * 1000;
  Timer_Effect_Marquee_Label_DownUp.OnTimer :=
    Timer_Effect_Marquee_Label_DownUp.OnWork;
  Timer_Effect_Marquee_Label_DownUp.Enabled := True;
end;
 
procedure T_DH_Form_Effects.Effect_Marquee_Form_Caption_LeftRight(Form1: TForm;
  opcion: string; segundos: integer);
begin
  if (opcion = 'left') then
  begin
    FormCaptionToMove := Form1;
    FormCaptionToMove.Caption := FormCaptionToMove.Caption + ' ';
  end
  else if (opcion = 'right') then
  begin
    FormCaptionToMove := Form1;
    FormCaptionToMove.Caption := FormCaptionToMove.Caption + '  ';
  end
  else
  begin
    FormCaptionToMove := Form1;
    FormCaptionToMove.Caption := FormCaptionToMove.Caption + ' ';
  end;
 
  Option_Marquee_Form_Caption_LeftRight := opcion;
  TimerEffect_Marquee_Form_Caption_LeftRight :=
    TTimerEffect_Marquee_Form_Caption_LeftRight.Create(nil);
  TimerEffect_Marquee_Form_Caption_LeftRight.Interval := segundos * 1000;
  TimerEffect_Marquee_Form_Caption_LeftRight.OnTimer :=
    TimerEffect_Marquee_Form_Caption_LeftRight.OnWork;
  TimerEffect_Marquee_Form_Caption_LeftRight.Enabled := True;
end;
 
procedure T_DH_Form_Effects.Effect_Marquee_Label_LeftRight(Label2: TLabel;
  opcion: string; segundos: integer);
begin
  if (opcion = 'left') then
  begin
    LabelToMove2 := Label2;
    LabelToMove2.Caption := LabelToMove2.Caption + ' ';
  end
  else if (opcion = 'right') then
  begin
    LabelToMove2 := Label2;
    LabelToMove2.Caption := LabelToMove2.Caption + '  ';
  end
  else
  begin
    LabelToMove2 := Label2;
    LabelToMove2.Caption := LabelToMove2.Caption + ' ';
  end;
  Option_Marquee_Label_LeftRight := opcion;
  TimerEffect_Marquee_Label_LeftRight :=
    TTimerEffect_Marquee_Label_LeftRight.Create(nil);
  TimerEffect_Marquee_Label_LeftRight.Interval := segundos * 1000;
  TimerEffect_Marquee_Label_LeftRight.OnTimer :=
    TimerEffect_Marquee_Label_LeftRight.OnWork;
  TimerEffect_Marquee_Label_LeftRight.Enabled := True;
end;
 
function T_DH_Form_Effects.Window_Effect(Form: HWND; opcion: string;
  velocidad: integer): bool;
begin
  try
    begin
      if (opcion = 'slide') then
      begin
        AnimateWindow(Form, velocidad, AW_SLIDE);
      end
      else if (opcion = 'blend') then
      begin
        AnimateWindow(Form, velocidad, AW_BLEND);
      end
      else if (opcion = 'hide') then
      begin
        AnimateWindow(Form, velocidad, AW_HIDE);
      end
      else if (opcion = 'center') then
      begin
        AnimateWindow(Form, velocidad, AW_CENTER);
      end
      else if (opcion = 'effect1') then
      begin
        AnimateWindow(Form, velocidad, AW_HOR_POSITIVE);
      end
      else if (opcion = 'effect2') then
      begin
        AnimateWindow(Form, velocidad, AW_HOR_NEGATIVE);
      end
      else if (opcion = 'effect3') then
      begin
        AnimateWindow(Form, velocidad, AW_VER_POSITIVE);
      end
      else if (opcion = 'effect4') then
      begin
        AnimateWindow(Form, velocidad, AW_VER_NEGATIVE);
      end
      else
      begin
        Result := False;
      end;
      Result := True;
    end;
  except
    begin
      Result := False;
    end;
  end;
end;
 
function T_DH_Form_Effects.Window_Transparent(Form: TForm;
  level: integer): bool;
begin
 
  // Effect in Desktop Dark
  // Level : 240
  // Level : 235
  // Level : 230
 
  // Effect in Desktop White
  // Level : 220
 
  try
    begin
      Form.AlphaBlend := True;
      Form.AlphaBlendValue := level;
      Form.Visible := True;
      Result := True;
    end;
  except
    begin
      Result := False;
    end;
  end;
end;
 
function T_DH_Form_Effects.desktop_composition_control(option: string): bool;
var
  Registry: TRegistry;
begin
  if not(option = '') then
  begin
    try
      begin
        Registry := TRegistry.Create;
        Registry.RootKey := HKEY_CURRENT_USER;
        Registry.OpenKey('Software\Microsoft\Windows\DWM', True);
        if (option = 'on') then
        begin
          Registry.WriteString('CompositionPolicy', '0');
        end;
        if (option = 'off') then
        begin
          Registry.WriteString('CompositionPolicy', '1');
        end;
        Registry.Free;
        Result := True;
      end;
    except
      begin
        Result := False;
      end;
    end;
  end
  else
  begin
    Result := False;
  end;
end;
 
// Function for Effect Glass in Console
// Credits : Based on http://www.delphibasics.info/home/delphibasicssnippets/glasseffectinadelphiconsoleapplication
// Thanks to Rodrigo Ruz
// Note : You need enable desktop composition to use this function , else use the function
// desktop_composition_control() to enable
 
type
  DWM_BLURBEHIND = record
    controls: DWORD;
    check: bool;
    color_now: HRGN;
    max_now: bool;
  end;
 
procedure DwmEnableBlurBehindWindow(HWND: HWND;
  const pBlurBehind: DWM_BLURBEHIND); safecall;
  external 'dwmapi.dll' name 'DwmEnableBlurBehindWindow';
function GetConsoleWindow: HWND; stdcall;
  external kernel32 name 'GetConsoleWindow';
 
function check_console: Boolean;
var
  Handle: THandle;
begin
  Handle := GetStdHandle(Std_Output_Handle);
  Win32Check(Handle <> Invalid_Handle_Value);
  if (Handle <> 0) then
  begin
    Result := True;
  end
  else
  begin
    Result := False;
  end;
end;
 
procedure Effect_Glass(Handle: HWND; active: Boolean; rgn: HRGN = 0;
  max: Boolean = False; control: Cardinal = 1);
var
  effect: DWM_BLURBEHIND;
begin
  effect.controls := control;
  effect.check := active;
  effect.color_now := rgn;
  effect.max_now := max;
 
  DwmEnableBlurBehindWindow(Handle, effect);
end;
 
function T_DH_Form_Effects.Effect_Glass_in_Console(): bool;
begin
  if (check_console) then
  begin
    try
      begin
        Effect_Glass(GetConsoleWindow(), True);
        Result := True;
      end;
    except
      begin
        //
      end;
    end;
  end
  else
  begin
    Result := False;
  end;
end;
 
//
 
end.
 
// The End ?

Ejemplos de uso :

Código

procedure TForm1.Form_EffectsClick(Sender: TObject);
 
var
  effects_manager: T_DH_Form_Effects;
 
begin
 
  effects_manager := T_DH_Form_Effects.Create();
 
  effects_manager.window_transparent(Form1, 240);
  effects_manager.window_effect(Form1.Handle,'center',100);
  effects_manager.Effect_Marquee_Label_DownUp(Panel1, Label1, 1);
  effects_manager.Effect_Marquee_Label_LeftRight(Label2, 'left', 1);
  Effect_Marquee_Form_Caption_LeftRight(Form1, 'right', 1);
  Effect_Load_Another_Form(Form1, About, 'effect2', 1, 5, 300);
  Effect_Load_Another_Form(Form1, About, 'effect1', 1,10,200);
 
  effects_manager.Free;
 
end;

Si quieren bajar el codigo lo pueden hacer de aca :

SourceForge.
Github.

Eso seria todo.