Label Ticker als Buchstaben-Laufschrift

[Mirilin]

Delphi-Quellcode:

 unit HorzMarquee;

interface

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

type
  TMainForm = class(TForm)
    PanelMarquee: TPanel;
    Timer: TTimer;
    PB: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
  private
    Text : String;
    P    : TPoint;
    Bit  : TBitmap;
    w    : Integer;
    sw   : Integer;
    GoLeft : Boolean;
    procedure GetVisibleText;
    procedure WM_Destroy(var Msg : TMessage);message WM_DESTROY;
    procedure DrawVisibleText;
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
var
  FSize : Size;
begin
  Bit := TBitmap.Create;
  Bit.Width := PB.Width;
  Bit.Height := PB.Height;
  Bit.Canvas.Font.Name := 'Courier New';
  Bit.Canvas.Font.Size := 25;
  GetTextExtentPoint32(Bit.Canvas.Handle,'A',1,FSize);
  w := FSize.cx;
  P.x := 0;
  P.y := (Bit.Height-FSize.cy) div 2;
  Text  := 'Der Meister geht schlafen...';
  GetTextExtentPoint32(Bit.Canvas.Handle,PChar(Text),Length(Text),FSize);
  sw   := FSIze.cx;
  GoLeft := false;
  GetVisibleText();

end;



procedure TMainForm.WM_Destroy(var Msg: TMessage);
begin
  Bit.Free;
end;

procedure TMainForm.TimerTimer(Sender: TObject);
begin
  GetVisibleText();
  DrawVisibleText();
end;

procedure TMainForm.GetVisibleText;
begin
  if GoLeft then
  begin
    Dec(P.x,w);
    if P.x<-sw then
    begin
      P.x := Bit.Width;
    end;
  end
  else begin
    Inc(P.x,w);
    if P.x>Bit.Width then
    begin
      P.x := -sw;
    end;
  end
end;

procedure TMainForm.DrawVisibleText;
begin
  Bit.Canvas.FillRect(Rect(0,0,Bit.Width,Bit.HEight));
  Bit.Canvas.TextOut(P.x,P.y,Text);
  PB.Canvas.Draw(0,0,Bit);
  Application.ProcessMessages;
end;

end.

Wohl nicht die Beste, aber dennoch eine Möglichkeit