HTDark | Underground Hacking Forum and Cybersecurity Community
  • Earn real money by being active: Hello Guest, earn real money by simply being active on the forum — post quality content, get reactions, and help the community. Once you reach the minimum credit amount, you’ll be able to withdraw your balance directly. Learn how it works.

Delphi [Delphi] DH Form Effects 0.3

Status
Not open for further replies.
D

Doddy

Leech
User
Joined
Apr 1, 2012
Messages
169
Reputation
0
Reaction score
406
Points
63
Credits
0
‎13 Years of Service‎
57%
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 :

Code: 
>
// 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 :

Code: 
>
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 :

This link is hidden for visitors. Please Log in or register now.
.

This link is hidden for visitors. Please Log in or register now.
.

Eso seria todo.

 
Status
Not open for further replies.
Back
Top