Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Otros temas > Trucos
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Los mejores trucos

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 31-12-2013
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Poder: 14
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
Barra de Progreso Infinita en Windows con Delphi 7

Club Delphi,

Revisen este código:
Código Delphi [-]
// Barra de Progreso Infinita en Delphi 7

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ShellAPI, XPMan, StdCtrls;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function EnableTheming(fEnable : Boolean) : HResult; stdcall; external 'UxTheme.dll'

const
  PBS_MARQUEE = $08;
  PBS_SMOOTH = $01;
  PBM_SETMARQUEE = WM_USER + 10;

var
  Form1: TForm1;
  D7Theme: TXPManifest;
  CS: Cardinal;

implementation

{$R *.dfm}

// Enable ProgressBar Infinity
procedure TForm1.Button1Click(Sender: TObject);
begin
   CS := GetWindowLong(ProgressBar1.Handle, GWL_STYLE);
   CS := CS or PBS_MARQUEE;
   SetWindowLong(ProgressBar1.Handle, GWL_STYLE, CS);
   SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, Integer(True), 0);
end;

// Disable ProgressBar Infinity
procedure TForm1.Button2Click(Sender: TObject);
begin
   SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, Integer(False), 0);
   CS := GetWindowLong(ProgressBar1.Handle, GWL_STYLE);
   CS := CS or PBS_SMOOTH;
   SetWindowLong(ProgressBar1.Handle, GWL_STYLE, CS);
   SendMessage(ProgressBar1.Handle, PBS_SMOOTH, Integer(False), 0);
end;

initialization
  D7Theme := TXPManifest.Create(nil);

finalization
  D7Theme.Free;

end.
El código anterior permite implementar una barra de progreso infinita por medio de Visuals Themes, el código fue hecho en Delphi 7 bajo Windows 7 Professional x32 y probado en Windows XP Professional x32, Windows Vista Home Premium x32, Windows 7 Profesional x32 y x64 y Windows 8.1 Professional x32 funcionando correctamente en todos los casos, como se muestra en la siguiente imagen:



El ejemplo esta disponible en : http://terawiki.clubdelphi.com/Delph...r+Infinity.rar

Referencia:
Cita:
About Progress Bar Controls : http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx
Espero sea útil

Nelson.
Responder Con Cita
  #2  
Antiguo 31-12-2013
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 27.654
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
Responder Con Cita
  #3  
Antiguo 31-12-2013
Avatar de radenf
radenf radenf is offline
Miembro
 
Registrado: oct 2007
Ubicación: Viña del Mar,Chile
Posts: 608
Poder: 11
radenf Va por buen camino
Muchas gracias [nlsgarcia]
Funciona perfecto en W7 x64 compilada con D2007.
Saludos y muchas felicidades
Responder Con Cita
  #4  
Antiguo 31-12-2013
Avatar de ElKurgan
[ElKurgan] ElKurgan is online now
Miembro Premium
 
Registrado: nov 2005
Posts: 1.015
Poder: 14
ElKurgan Va por buen camino
Thumbs up

gracias por el aporte, amigo
Responder Con Cita
  #5  
Antiguo 13-01-2014
Avatar de FideRosado
FideRosado FideRosado is offline
Miembro
 
Registrado: jun 2010
Ubicación: Pinar del Rio Cuba
Posts: 141
Poder: 8
FideRosado Va por buen camino
respuesta

a mi me da un error en windows xp.. miren a ver si me ayudan a resolverlo..

http://www.clubdelphi.com/foros/atta...1&d=1389575751
Imágenes Adjuntas
Tipo de Archivo: jpg error.JPG (31,9 KB, 26 visitas)
Responder Con Cita
  #6  
Antiguo 17-01-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Poder: 14
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
FideRosado,

Cita:
Empezado por FideRosado
...me da un error en Windows XP...
Te comento:

1- La Barra de Progreso Infinita funciona correctamente en Windows XP Professional x32.

2- El error que se presenta en Windows XP no esta asociado al estilo PBS_MARQUEE que permite implementar la Barra de Progreso Infinita, si no en el estilo PBS_SMOOTH el cual no es soportado en XP Themes.

Revisa este código:
Código Delphi [-]
// Disable ProgressBar Infinito
procedure TForm1.Button2Click(Sender: TObject);
begin
   SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, Integer(False), 0);
   if SysUtils.Win32MajorVersion >= 6 then // Verifica la versión de Windows
   begin
      CS := GetWindowLong(ProgressBar1.Handle, GWL_STYLE);
      CS := CS or PBS_SMOOTH;
      SetWindowLong(ProgressBar1.Handle, GWL_STYLE, CS);
      SendMessage(ProgressBar1.Handle, PBS_SMOOTH, Integer(False), 0);
   end;
end;
El código anterior permite detener la ejecución de la Barra de Progreso Infinita y no aplica el estilo PBS_SMOOTH si la versión de Windows es inferior a Windows Vista.

Espero sea útil

Nelson.

Última edición por nlsgarcia fecha: 17-01-2014 a las 08:54:15.
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

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

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Barra de progreso nabucodonosor Delphi para la web 3 01-11-2012 11:57:04
Barra de Progreso XcamX MySQL 1 21-12-2010 12:24:52
Barra de progreso? marlulipe Impresión 5 26-02-2008 17:51:55
Barra de progreso con TNMFTP pborges36 Internet 1 30-06-2006 01:50:03
Mostrar progreso de descarga de IndyFTP con barra de progreso devicer Internet 2 05-12-2005 15:59:32


La franja horaria es GMT +2. Ahora son las 08:31:05.


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