Ver Mensaje Individual
  #1  
Antiguo 23-05-2008
Avatar de xEsk
[xEsk] xEsk is offline
Miembro Premium
 
Registrado: feb 2006
Posts: 454
Reputación: 19
xEsk Va por buen camino
TProgressBar cíclico nativo (marquee) (añadida solución 3)

Hola,

Algunas veces seguro que os habéis encontrado con la necesidad de mostrar un proceso que no sabéis cuanto tiempo os va a durar, y sería bonito poder indiciar que el programa esta trabajando, pero el Delphi después de tanto tiempo, aun no soporta la propiedad Marquee en su TProgressBar. Pues aquí os propongo como convertir un TProgressBar nativo del Delphi (Win32) en un TProgressBar con la propiedad marquee, sin tener que usar componentes de terceros, que además la mayoría no son nativos (para gente obsesionada en que los programas deben usar los temas de Windows (como yo) seguro que les gustará).

Preparativos

Incluir la unit CommCtrl al uses, para incluir las constantes: PBS_MARQUEE y PBM_SETMARQUEE.

Si no tenéis estas constantes definidas en vuestro Delphi, aquí os pongo su valor:
Código Delphi [-]
{ For Windows >= XP }
{$EXTERNALSYM PBS_MARQUEE}
PBS_MARQUEE             = $08;
{$EXTERNALSYM PBM_SETMARQUEE}
PBM_SETMARQUEE          = WM_USER+10;
NOTA: Debeis tener en cuenta, que esta propiedad solo esta disponible para sistemas operativos Windows XP y superiores.


Solución 1 - Asignar la propiedad marquee a cualquier TProgressBar

Al crear el formulario le asignamos la propiedad marquee al TProgressBar que hay que convertir:

Código Delphi [-]
SetWindowLong(ProgressBar.Handle, GWL_STYLE, GetWindowLong(ProgressBar.Handle, GWL_STYLE) or PBS_MARQUEE);

Cuando esta en movimiento, este parpadea un poco, pero es facil solucionarlo poniendo la propiedad DoubleBuffered a True.


Como activar/detener el ProgressBar:

Activar:
Código Delphi [-]
SendMessage(ProgressBar.Handle, PBM_SETMARQUEE, WPARAM(True), Velocidad);

Detener:
Código Delphi [-]
SendMessage(ProgressBar.Handle, PBM_SETMARQUEE, WPARAM(False), 0);

Parametros:

[1] El Handle del TProgressBar que vamos a modificar
[2] La propiedad que vamos a modificar del TProgressBar
[3] Lo que vamos a hacer, si activarlo o desactivarlo (true = activar, false = desactivar)
[4] La velocidad de movimiento de la barra de progreso.

Ejemplo final:

Un par de botones, un SpinEdit y el ProgressBar a modificar.

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, CommCtrl, StdCtrls, Spin;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    Button2: TButton;
    SpinEdit1: TSpinEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetWindowLong(ProgressBar1.Handle, GWL_STYLE, GetWindowLong(ProgressBar1.Handle, GWL_STYLE) or PBS_MARQUEE);
  // sin parpadeos
  ProgressBar1.DoubleBuffered:=True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, WPARAM(True), SpinEdit1.Value);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  SendMessage(ProgressBar1.Handle, PBM_SETMARQUEE, WPARAM(False), 0);
end;

end.

Solución 2 - Crear un componente derivado del TProgressBar para no tener que ir configurándolo todas las veces

Código fuente del nuevo componente:

Código Delphi [-]
  
TProgressBarMarquee = class(TProgressBar)
  private
    FSpeed: Integer;
    FMarqueeEnabled: Boolean;
    procedure SetFarqueeEnabled(const Value: Boolean);
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent); override;
    property MarqueeSpeed: Integer read FSpeed write FSpeed default 40;
    property MarqueeEnabled: Boolean read FMarqueeEnabled write SetFarqueeEnabled;
  end;

{ TProgressBarMarquee }

constructor TProgressBarMarquee.Create(AOwner: TComponent);
begin
  inherited;
  FSpeed:=40;
end;

procedure TProgressBarMarquee.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style:=Params.Style or PBS_MARQUEE;
end;

procedure TProgressBarMarquee.SetFarqueeEnabled(const Value: Boolean);
begin
  FMarqueeEnabled:=Value;
  // enviar mensjae al TProgressBar con los nuevos valores
  SendMessage(Handle, PBM_SETMARQUEE, WPARAM(FMarqueeEnabled), FSpeed);
end;

La segunda versión podría modificarse para soportar también el modo normal del TProgressBar, pero esto ya se lo dejo para quien quiera entretenerse xD Igual que ahora mismo tiene todo los métodos del TProgressBar estándar y no son necesarios.



Solución 3 - Nueva! - Ampliar las funciones del TProgressBar usando Class Helpers

Esta tercera opción, no es válida para todas las versiones de Delphi, en concreto funciona a partir del Delphi 8 (Delphi 8, BDS 2005, BDS 2006 y D2007). Así pues, esta solución utiliza la extensión del lenguaje de Object Pascal llamada Class Helpers para modificar el TProgressBar estándar.

Veamos como implementarla:

Código Delphi [-]
  TProgressBarMarquee = class Helper for TProgressBar
  public
    procedure StartMarquee(Speed: Integer);
    procedure StopMarquee;
    procedure DisableMarquee;
  end;

{ TProgressBarMarquee }

procedure TProgressBarMarquee.StartMarquee(Speed: Integer);
begin
  SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) or PBS_MARQUEE);
  SendMessage(Handle, PBM_SETMARQUEE, WPARAM(True), Speed);
end;

procedure TProgressBarMarquee.StopMarquee;
begin
  SendMessage(Handle, PBM_SETMARQUEE, WPARAM(False), 0);
end;

procedure TProgressBarMarquee.DisableMarquee;
begin
  SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) - PBS_MARQUEE);
end;

La pregunta es, que ganamos respecto a crear un componente derivado del TProgressBar (solución 2) a usar un "helper" para el TProgressBar, pues que la tercera solución lo que hace realmente es "ampliar" el componente TProgressBar, así pues todos los TProgressBar estándar, cuentan ahora con estos 3 nuevos métodos.

Personalmente, esta tercera opción es mi favorita :)

Saludos,
xEsk.
Responder Con Cita