comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

[Delphi] DH Form Effects 0.3

  • 0 Respuestas
  • 1336 Vistas

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

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil
« 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
  • 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: 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 :

No tienes permisos para ver links. Registrate o Entra con tu cuenta.
No tienes permisos para ver links. Registrate o Entra con tu cuenta.

Eso seria todo.

 

¿Te gustó el post? COMPARTILO!



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

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1983
Ú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: 3126
Ú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: 3255
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
Poner splash screen con progress bar en delphi

Iniciado por ANTRAX

Respuestas: 0
Vistas: 2886
Último mensaje Febrero 24, 2010, 04:54:23 pm
por ANTRAX
[Delphi] Creacion de un Server Builder con recursos

Iniciado por BigBear

Respuestas: 1
Vistas: 1410
Último mensaje Marzo 09, 2015, 07:56:20 pm
por Flemon