[Delphi] DH Form Effects 0.3

  • 0 Respuestas
  • 3421 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil

[Delphi] DH Form Effects 0.3

  • en: Junio 24, 2016, 09:45:09 pm
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[/li]
  • Animacion marquesina en los labels de arriba hacia abajo y viceversa[/li]
  • Volver transparentes los formularios[/li]
  • Volver transparente la consola del programa[/li]
  • Varios efectos en la ventana de los formularios[/li][/list]

    El codigo :

    Código: Delphi
    1. // Unit : DH Form Effects
    2. // Version : 0.3
    3. // (C) Doddy Hackman 2016
    4.  
    5. unit DH_Form_Effects;
    6.  
    7. interface
    8.  
    9. uses Windows, SysUtils, Vcl.Forms, Vcl.StdCtrls, Vcl.ExtCtrls, Registry;
    10.  
    11. type
    12.   T_DH_Form_Effects = class
    13.   private
    14.  
    15.   public
    16.     constructor Create;
    17.     destructor Destroy; override;
    18.     procedure Effect_Marquee_Label_DownUp(Panel1: TPanel; Label1: TLabel;
    19.       segundos: integer);
    20.     procedure Effect_Marquee_Label_LeftRight(Label2: TLabel; opcion: string;
    21.       segundos: integer);
    22.     procedure Effect_Marquee_Form_Caption_LeftRight(Form1: TForm;
    23.       opcion: string; segundos: integer);
    24.     function Window_Effect(Form: HWND; opcion: string;
    25.       velocidad: integer): bool;
    26.     function Window_Transparent(Form: TForm; level: integer): bool;
    27.     procedure Effect_Load_Another_Form(Form1_Load: TForm; Form2_Load: TForm;
    28.       option: string; autosize: integer; space: integer; seconds: integer);
    29.     function desktop_composition_control(option: string): bool;
    30.     function Effect_Glass_in_Console(): bool;
    31.   end;
    32.  
    33. type
    34.   TTimerEffect_Marquee_Label_DownUp = Class(TTimer)
    35.   public
    36.     procedure OnWork(Sender: TObject);
    37.   end;
    38.  
    39.   TTimerEffect_Marquee_Label_LeftRight = Class(TTimer)
    40.   public
    41.     procedure OnWork(Sender: TObject);
    42.   end;
    43.  
    44.   TTimerEffect_Marquee_Form_Caption_LeftRight = Class(TTimer)
    45.   public
    46.     procedure OnWork(Sender: TObject);
    47.   end;
    48.  
    49. var
    50.   Timer_Effect_Marquee_Label_DownUp: TTimerEffect_Marquee_Label_DownUp;
    51.   PanelToMove1: TPanel;
    52.   LabelToMove1: TLabel;
    53.  
    54. var
    55.   TimerEffect_Marquee_Label_LeftRight: TTimerEffect_Marquee_Label_LeftRight;
    56.   LabelToMove2: TLabel;
    57.   Option_Marquee_Label_LeftRight: string;
    58.  
    59. var
    60.   TimerEffect_Marquee_Form_Caption_LeftRight
    61.     : TTimerEffect_Marquee_Form_Caption_LeftRight;
    62.   FormCaptionToMove: TForm;
    63.   Option_Marquee_Form_Caption_LeftRight: string;
    64.  
    65. implementation
    66.  
    67. constructor T_DH_Form_Effects.Create;
    68. begin
    69.   inherited Create;
    70.   //
    71. end;
    72.  
    73. destructor T_DH_Form_Effects.Destroy;
    74. begin
    75.   inherited Destroy;
    76. end;
    77.  
    78. // Timers
    79.  
    80. procedure TTimerEffect_Marquee_Label_DownUp.OnWork(Sender: TObject);
    81. begin
    82.   LabelToMove1.Top := LabelToMove1.Top - 10;
    83.   if LabelToMove1.Top + LabelToMove1.Height < 0 then
    84.   begin
    85.     LabelToMove1.Top := PanelToMove1.Height;
    86.   end;
    87. end;
    88.  
    89. procedure TTimerEffect_Marquee_Form_Caption_LeftRight.OnWork(Sender: TObject);
    90. var
    91.   code: string;
    92.   opcion: string;
    93. begin
    94.   code := FormCaptionToMove.Caption;
    95.   opcion := Option_Marquee_Form_Caption_LeftRight;
    96.   if opcion = 'left' then
    97.   begin
    98.     FormCaptionToMove.Caption := Copy(code, 2, Length(code) - 1) +
    99.       Copy(code, 1, 1);
    100.   end
    101.   else if (opcion = 'right') then
    102.   begin
    103.     FormCaptionToMove.Caption := Copy(code, Length(code) - 1, 1) +
    104.       Copy(code, 1, Length(code) - 1);
    105.   end
    106.   else
    107.   begin
    108.     FormCaptionToMove.Caption := Copy(code, 2, Length(code) - 1) +
    109.       Copy(code, 1, 1);
    110.   end;
    111. end;
    112.  
    113. procedure TTimerEffect_Marquee_Label_LeftRight.OnWork(Sender: TObject);
    114. // Based on : http://delphi.about.com/od/vclusing/a/marquee.htm
    115. // Thanks to Zarko Gajic
    116. var
    117.   code: string;
    118.   opcion: string;
    119. begin
    120.   code := LabelToMove2.Caption;
    121.   opcion := Option_Marquee_Label_LeftRight;
    122.   if opcion = 'left' then
    123.   begin
    124.     LabelToMove2.Caption := Copy(code, 2, Length(code) - 1) + Copy(code, 1, 1);
    125.   end
    126.   else if (opcion = 'right') then
    127.   begin
    128.     LabelToMove2.Caption := Copy(code, Length(code) - 1, 1) +
    129.       Copy(code, 1, Length(code) - 1);
    130.   end
    131.   else
    132.   begin
    133.     LabelToMove2.Caption := Copy(code, 2, Length(code) - 1) + Copy(code, 1, 1);
    134.   end;
    135. end;
    136.  
    137. //
    138.  
    139. // Functions
    140.  
    141. procedure T_DH_Form_Effects.Effect_Load_Another_Form(Form1_Load: TForm;
    142.   Form2_Load: TForm; option: string; autosize: integer; space: integer;
    143.   seconds: integer);
    144. var
    145.   width: integer;
    146.   Height: integer;
    147.   i: integer;
    148. begin
    149.  
    150.   if (autosize = 1) then
    151.   begin
    152.     width := Form2_Load.width;
    153.     Height := Form1_Load.Height;
    154.   end
    155.   else
    156.   begin
    157.     width := Form2_Load.width;
    158.     Height := Form2_Load.Height;
    159.   end;
    160.  
    161.   if (option = 'effect1') then
    162.   begin
    163.     Form2_Load.width := 1;
    164.     Form2_Load.Height := Form1_Load.Height;
    165.     Form2_Load.Left := space + Form1_Load.Left + Form1_Load.width;
    166.     Form2_Load.Top := Form1_Load.Top;
    167.     Form2_Load.Show;
    168.     for i := 1 to width do
    169.     begin
    170.       if (Form2_Load.width = width) then
    171.       begin
    172.         break;
    173.       end
    174.       else
    175.       begin
    176.         Form2_Load.width := i + seconds;
    177.         Form2_Load.Update;
    178.       end;
    179.     end;
    180.   end
    181.   else if (option = 'effect2') then
    182.   begin
    183.     Form2_Load.Hide;
    184.     Form2_Load.Height := Height;
    185.     Form2_Load.Left := Form1_Load.Left + width;
    186.     Form2_Load.Top := Form1_Load.Top;
    187.     Form2_Load.Left := space + Form1_Load.Left + Form1_Load.width;
    188.     Window_Effect(Form2_Load.Handle, 'effect1', seconds);
    189.     Form2_Load.Show;
    190.   end
    191.   else
    192.   begin
    193.     Form2_Load.width := 1;
    194.     Form2_Load.Height := Form1_Load.Height;
    195.     Form2_Load.Left := space + Form1_Load.Left + Form1_Load.width;
    196.     Form2_Load.Top := Form1_Load.Top;
    197.     Form2_Load.Show;
    198.     for i := 1 to width do
    199.     begin
    200.       if (Form2_Load.width = width) then
    201.       begin
    202.         break;
    203.       end
    204.       else
    205.       begin
    206.         Form2_Load.width := i + seconds;
    207.         Form2_Load.Update;
    208.       end;
    209.     end;
    210.   end;
    211. end;
    212.  
    213. procedure T_DH_Form_Effects.Effect_Marquee_Label_DownUp(Panel1: TPanel;
    214.   Label1: TLabel; segundos: integer);
    215. begin
    216.  
    217.   // To hide panel : BevelOuter = bvNone
    218.  
    219.   PanelToMove1 := Panel1;
    220.   LabelToMove1 := Label1;
    221.   Timer_Effect_Marquee_Label_DownUp :=
    222.     TTimerEffect_Marquee_Label_DownUp.Create(nil);
    223.   Timer_Effect_Marquee_Label_DownUp.Interval := segundos * 1000;
    224.   Timer_Effect_Marquee_Label_DownUp.OnTimer :=
    225.     Timer_Effect_Marquee_Label_DownUp.OnWork;
    226.   Timer_Effect_Marquee_Label_DownUp.Enabled := True;
    227. end;
    228.  
    229. procedure T_DH_Form_Effects.Effect_Marquee_Form_Caption_LeftRight(Form1: TForm;
    230.   opcion: string; segundos: integer);
    231. begin
    232.   if (opcion = 'left') then
    233.   begin
    234.     FormCaptionToMove := Form1;
    235.     FormCaptionToMove.Caption := FormCaptionToMove.Caption + ' ';
    236.   end
    237.   else if (opcion = 'right') then
    238.   begin
    239.     FormCaptionToMove := Form1;
    240.     FormCaptionToMove.Caption := FormCaptionToMove.Caption + '  ';
    241.   end
    242.   else
    243.   begin
    244.     FormCaptionToMove := Form1;
    245.     FormCaptionToMove.Caption := FormCaptionToMove.Caption + ' ';
    246.   end;
    247.  
    248.   Option_Marquee_Form_Caption_LeftRight := opcion;
    249.   TimerEffect_Marquee_Form_Caption_LeftRight :=
    250.     TTimerEffect_Marquee_Form_Caption_LeftRight.Create(nil);
    251.   TimerEffect_Marquee_Form_Caption_LeftRight.Interval := segundos * 1000;
    252.   TimerEffect_Marquee_Form_Caption_LeftRight.OnTimer :=
    253.     TimerEffect_Marquee_Form_Caption_LeftRight.OnWork;
    254.   TimerEffect_Marquee_Form_Caption_LeftRight.Enabled := True;
    255. end;
    256.  
    257. procedure T_DH_Form_Effects.Effect_Marquee_Label_LeftRight(Label2: TLabel;
    258.   opcion: string; segundos: integer);
    259. begin
    260.   if (opcion = 'left') then
    261.   begin
    262.     LabelToMove2 := Label2;
    263.     LabelToMove2.Caption := LabelToMove2.Caption + ' ';
    264.   end
    265.   else if (opcion = 'right') then
    266.   begin
    267.     LabelToMove2 := Label2;
    268.     LabelToMove2.Caption := LabelToMove2.Caption + '  ';
    269.   end
    270.   else
    271.   begin
    272.     LabelToMove2 := Label2;
    273.     LabelToMove2.Caption := LabelToMove2.Caption + ' ';
    274.   end;
    275.   Option_Marquee_Label_LeftRight := opcion;
    276.   TimerEffect_Marquee_Label_LeftRight :=
    277.     TTimerEffect_Marquee_Label_LeftRight.Create(nil);
    278.   TimerEffect_Marquee_Label_LeftRight.Interval := segundos * 1000;
    279.   TimerEffect_Marquee_Label_LeftRight.OnTimer :=
    280.     TimerEffect_Marquee_Label_LeftRight.OnWork;
    281.   TimerEffect_Marquee_Label_LeftRight.Enabled := True;
    282. end;
    283.  
    284. function T_DH_Form_Effects.Window_Effect(Form: HWND; opcion: string;
    285.   velocidad: integer): bool;
    286. begin
    287.   try
    288.     begin
    289.       if (opcion = 'slide') then
    290.       begin
    291.         AnimateWindow(Form, velocidad, AW_SLIDE);
    292.       end
    293.       else if (opcion = 'blend') then
    294.       begin
    295.         AnimateWindow(Form, velocidad, AW_BLEND);
    296.       end
    297.       else if (opcion = 'hide') then
    298.       begin
    299.         AnimateWindow(Form, velocidad, AW_HIDE);
    300.       end
    301.       else if (opcion = 'center') then
    302.       begin
    303.         AnimateWindow(Form, velocidad, AW_CENTER);
    304.       end
    305.       else if (opcion = 'effect1') then
    306.       begin
    307.         AnimateWindow(Form, velocidad, AW_HOR_POSITIVE);
    308.       end
    309.       else if (opcion = 'effect2') then
    310.       begin
    311.         AnimateWindow(Form, velocidad, AW_HOR_NEGATIVE);
    312.       end
    313.       else if (opcion = 'effect3') then
    314.       begin
    315.         AnimateWindow(Form, velocidad, AW_VER_POSITIVE);
    316.       end
    317.       else if (opcion = 'effect4') then
    318.       begin
    319.         AnimateWindow(Form, velocidad, AW_VER_NEGATIVE);
    320.       end
    321.       else
    322.       begin
    323.         Result := False;
    324.       end;
    325.       Result := True;
    326.     end;
    327.   except
    328.     begin
    329.       Result := False;
    330.     end;
    331.   end;
    332. end;
    333.  
    334. function T_DH_Form_Effects.Window_Transparent(Form: TForm;
    335.   level: integer): bool;
    336. begin
    337.  
    338.   // Effect in Desktop Dark
    339.   // Level : 240
    340.   // Level : 235
    341.   // Level : 230
    342.  
    343.   // Effect in Desktop White
    344.   // Level : 220
    345.  
    346.   try
    347.     begin
    348.       Form.AlphaBlend := True;
    349.       Form.AlphaBlendValue := level;
    350.       Form.Visible := True;
    351.       Result := True;
    352.     end;
    353.   except
    354.     begin
    355.       Result := False;
    356.     end;
    357.   end;
    358. end;
    359.  
    360. function T_DH_Form_Effects.desktop_composition_control(option: string): bool;
    361. var
    362.   Registry: TRegistry;
    363. begin
    364.   if not(option = '') then
    365.   begin
    366.     try
    367.       begin
    368.         Registry := TRegistry.Create;
    369.         Registry.RootKey := HKEY_CURRENT_USER;
    370.         Registry.OpenKey('Software\Microsoft\Windows\DWM', True);
    371.         if (option = 'on') then
    372.         begin
    373.           Registry.WriteString('CompositionPolicy', '0');
    374.         end;
    375.         if (option = 'off') then
    376.         begin
    377.           Registry.WriteString('CompositionPolicy', '1');
    378.         end;
    379.         Registry.Free;
    380.         Result := True;
    381.       end;
    382.     except
    383.       begin
    384.         Result := False;
    385.       end;
    386.     end;
    387.   end
    388.   else
    389.   begin
    390.     Result := False;
    391.   end;
    392. end;
    393.  
    394. // Function for Effect Glass in Console
    395. // Credits : Based on http://www.delphibasics.info/home/delphibasicssnippets/glasseffectinadelphiconsoleapplication
    396. // Thanks to Rodrigo Ruz
    397. // Note : You need enable desktop composition to use this function , else use the function
    398. // desktop_composition_control() to enable
    399.  
    400. type
    401.   DWM_BLURBEHIND = record
    402.     controls: DWORD;
    403.     check: bool;
    404.     color_now: HRGN;
    405.     max_now: bool;
    406.   end;
    407.  
    408. procedure DwmEnableBlurBehindWindow(HWND: HWND;
    409.   const pBlurBehind: DWM_BLURBEHIND); safecall;
    410.   external 'dwmapi.dll' name 'DwmEnableBlurBehindWindow';
    411. function GetConsoleWindow: HWND; stdcall;
    412.   external kernel32 name 'GetConsoleWindow';
    413.  
    414. function check_console: Boolean;
    415. var
    416.   Handle: THandle;
    417. begin
    418.   Handle := GetStdHandle(Std_Output_Handle);
    419.   Win32Check(Handle <> Invalid_Handle_Value);
    420.   if (Handle <> 0) then
    421.   begin
    422.     Result := True;
    423.   end
    424.   else
    425.   begin
    426.     Result := False;
    427.   end;
    428. end;
    429.  
    430. procedure Effect_Glass(Handle: HWND; active: Boolean; rgn: HRGN = 0;
    431.   max: Boolean = False; control: Cardinal = 1);
    432. var
    433.   effect: DWM_BLURBEHIND;
    434. begin
    435.   effect.controls := control;
    436.   effect.check := active;
    437.   effect.color_now := rgn;
    438.   effect.max_now := max;
    439.  
    440.   DwmEnableBlurBehindWindow(Handle, effect);
    441. end;
    442.  
    443. function T_DH_Form_Effects.Effect_Glass_in_Console(): bool;
    444. begin
    445.   if (check_console) then
    446.   begin
    447.     try
    448.       begin
    449.         Effect_Glass(GetConsoleWindow(), True);
    450.         Result := True;
    451.       end;
    452.     except
    453.       begin
    454.         //
    455.       end;
    456.     end;
    457.   end
    458.   else
    459.   begin
    460.     Result := False;
    461.   end;
    462. end;
    463.  
    464. //
    465.  
    466. end.
    467.  
    468. // The End ?
    469.  

    Ejemplos de uso :

    Código: Delphi
    1. procedure TForm1.Form_EffectsClick(Sender: TObject);
    2.  
    3. var
    4.   effects_manager: T_DH_Form_Effects;
    5.  
    6. begin
    7.  
    8.   effects_manager := T_DH_Form_Effects.Create();
    9.  
    10.   effects_manager.window_transparent(Form1, 240);
    11.   effects_manager.window_effect(Form1.Handle,'center',100);
    12.   effects_manager.Effect_Marquee_Label_DownUp(Panel1, Label1, 1);
    13.   effects_manager.Effect_Marquee_Label_LeftRight(Label2, 'left', 1);
    14.   Effect_Marquee_Form_Caption_LeftRight(Form1, 'right', 1);
    15.   Effect_Load_Another_Form(Form1, About, 'effect2', 1, 5, 300);
    16.   Effect_Load_Another_Form(Form1, About, 'effect1', 1,10,200);
    17.  
    18.   effects_manager.Free;
    19.  
    20. end;
    21.  

    Si quieren bajar el codigo lo pueden hacer de aca :

    You are not allowed to view links. Register or Login.
    You are not allowed to view links. Register or Login.

    Eso seria todo.

 

[Sintaxis general de Delphi] By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3493
Último mensaje Febrero 24, 2010, 04:35:15 pm
por ANTRAX
Eliminar acentos y otros agregados de un caracter/cadena Delphi 2009

Iniciado por ANTRAX

Respuestas: 0
Vistas: 5370
Último mensaje Febrero 24, 2010, 04:57:14 pm
por ANTRAX
1er troyano en Delphi By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 5590
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
[Delphi] Project Arsenal X 0.2 (Regalo de navidad)

Iniciado por BigBear

Respuestas: 2
Vistas: 5522
Último mensaje Diciembre 28, 2015, 10:27:44 am
por BigBear
[Delphi] Creacion de un Troyano de conexion inversa

Iniciado por BigBear

Respuestas: 4
Vistas: 6560
Último mensaje Mayo 05, 2017, 09:10:55 am
por _inicio_cerrarsesión