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;
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