Mostrar mensajes con movibilidad

[[nlsgarcia]]

pape19,

Empezado por pape19

...mostrar en la pantalla principal de mi aplicación un mensaje que vaya corriendo...como los que muestran generalmente los noticieros de TV en la parte inferior...

Revisa este código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, StrUtils, ExtCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Timer1: TTimer;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Msg, MsgRev, AuxMsg : String;
  PixelsFont, p, Pausa : Integer;

implementation

{$R *.dfm}

function CalculatePixels(F : TFont) : LongWord;
var
   C : TBitmap;
begin
   C := TBitmap.Create;
   C.Canvas.Font.Name := F.Name;
   C.Canvas.Font.Size := F.Size;
   Result := C.Canvas.TextWidth(' ');
   C.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Edit1.ReadOnly := True;
   Timer1.Enabled := False;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin

   AuxMsg := Edit1.Text;

   if p <= Length(MsgRev) then
      Insert(MsgRev[p],AuxMsg,0)
   else
      Insert(' ',AuxMsg,0);

   Edit1.Text := AuxMsg;

   Inc(p);

   if p = Edit1.Width Div PixelsFont + 1 then
      p := 1;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin

   if Timer1.Enabled then
      Exit;

   Edit1.Font.Name := 'Lucida Console'; // Solo TrueType fonts de tipo Monospaced
   Edit1.Font.Color := clBlue;
   Edit1.Font.Size := 12;

   PixelsFont := CalculatePixels(Edit1.Font);

   Msg := 'Nelson Garcia';
   MsgRev := ReverseString(Msg);

   if Pausa = 0 then
      p := 1
   else
   begin
      p := Pausa;
      Pausa := 0;
   end;

   Timer1.Interval := 150;
   Timer1.Enabled := True;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
   Timer1.Enabled := False;
   Pausa := p;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   Timer1.Enabled := False;
   Pausa := 0;
   Edit1.Text := EmptyStr;
end;

end.

El código anterior en Delphi 7 sobre Windows 7 Professional x32, implementa un generador de carácteres simple, como se muestra en la siguiente imagen:



Notas:

1- El generador esta basado en TrueType fonts de tipo Monospaced como Lucida Console, Courier New y Lucida Sans Typewriter, si se usan fonts de tipo proporcional el generador funcionara de forma aleatoria.

2- La idea de usar un tipo de letra mono espaciada, es lograr un efecto más fluido en el movimiento de los carácteres.

Espero sea útil

Nelson.