Ver Mensaje Individual
  #6  
Antiguo 23-07-2015
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Reputación: 36
ecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to behold
Hola pape19.

Quedé pensando en que se podría hacer una unidad que se encarge de gestionar el comportamiento para controles que tengan la propiedad Text o Caption, algo así:
Código Delphi [-]
unit uMarquee;

interface

uses Controls, ExtCtrls, TypInfo, Windows, Graphics, Dialogs, SysUtils;

type
  TSentido = (rtRight, rtLeft);
  TMarquee = class(TObject)
  private
    FControl  : TControl;
    FText     : string;
    FTimer    : TTimer;
    FSentido  : TSentido;
    procedure FTimerTime(Sender: TObject);
    procedure SetActive(const Value: Boolean);
    procedure SetInterval(const Value: Cardinal);
    procedure SetControl(const Value: TControl);
  public
    constructor Create(AOwner: TControl);
    destructor Destroy; override;
    property Component: TControl read FControl write SetControl;
    property Sentido  : TSentido read FSentido write FSentido;
    property Interval : Cardinal write SetInterval;
    property Active   : Boolean write SetActive;
  end;

implementation

constructor TMarquee.Create(AOwner: TControl);
begin
  FTimer         := TTimer.Create(nil);
  FTimer.Enabled := False;
  FTimer.OnTimer := FTimerTime;
  FSentido       := rtRight;
end;

destructor TMarquee.Destroy;
begin
  FTimer.Free;
  inherited;
end;

procedure TMarquee.FTimerTime(Sender: TObject);
begin
  if FSentido = rtRight then
    FText := Copy(FText, Length(FText), 1) + Copy(FText, 1, Length(FText) -1)
  else
    FText := Copy(FText, 2, Length(FText)-1) + Copy(FText,1, 1);

  if Assigned(GetPropInfo(FControl, 'Text')) then
    SetStrProp(FControl, GetPropInfo(FControl, 'Text'), FText);

  if Assigned(GetPropInfo(FControl, 'Caption')) then
    SetStrProp(FControl, GetPropInfo(FControl, 'Caption'), FText);
end;

procedure TMarquee.SetActive(const Value: Boolean);
begin
  if Value <> FTimer.Enabled then
    FTimer.Enabled := Value;
end;

procedure TMarquee.SetControl(const Value: TControl);
var
  l : Integer;
  F : TFont;
begin
  if FControl <> Value then
    FControl := Value;

  if IsPublishedProp(FControl, 'Text') then
    FText := GetStrProp(FControl, 'Text');
  if IsPublishedProp(FControl, 'Caption') then
     FText := GetStrProp(FControl, 'Caption');

  if IsPublishedProp(FControl, 'Font') then
  begin
    F := TFont(GetObjectProp(FControl, 'Font', TFont));
    l := (FControl.Width - Length(FText) * F.Size) div 2;
    FText :=FText + StringOfChar(' ', l);
  end;
end;

procedure TMarquee.SetInterval(const Value: Cardinal);
begin
  if Value <> FTimer.Interval then
    FTimer.Interval := Value;
end;

end.

Ejemplo de uso:
Código Delphi [-]
implementation 

uses uMarquee;

var
  m1,m2, m3, m4 : TMarquee;

procedure TForm1.FormCreate(Sender: TObject);
var
  s: string;
begin
  s := 'Prueba de desplazamiento de texto';
  Label1.Caption := s;
  Edit1.Text     := s;
  ComboBox1.Text := s;
  Form1.Caption  := s;

  m1 := TMarquee.Create(nil);
  m1.Component := Label1;
  m1.Interval  := 50;

  m2 := TMarquee.Create(nil);
  m2.Component := Edit1;
  m2.Interval  := 50;
  m2.Sentido   := rtLeft; // rtRight por defecto

  m3 := TMarquee.Create(nil);
  m3.Component := ComboBox1;
  m3.Interval  := 70;

  m4 := TMarquee.Create(nil);
  m4.Component := Form1;
  m4.Interval  := 80;
  m4.Sentido   := rtLeft;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  m1.Active := CheckBox1.Checked;
  m2.Active := CheckBox1.Checked;
  m3.Active := CheckBox1.Checked;
  m4.Active := CheckBox1.Checked;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  m1.Free;
  m2.Free;
  m3.Free;
  m4.Free;
end;

Salida:


Saludos
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....

Última edición por ecfisa fecha: 24-07-2015 a las 17:26:44. Razón: Corregir enlace a la imágen
Responder Con Cita