laufschrift

[markus lemcke]

hallo,

ich will einen bildschirmschoner programmieren. hierfür bräuchte ich eine laufschrift! wie programmiert man sowas?

gruß

markus

[Hans-Peter Tschan]

Hallo Markus !!!

In der einfachsten Form mit 2 globalen Variablen (Typ integer) x, dx und einem Timer: x weist Du im OnCreate-Ereignis die Left-Position des Labels zu, dx gibt die Schrittweite an. Je größer dx, um so ruckeliger erscheint die Bewegung...

x := Label1.Left; dx := 2;

Im OnTimer-Ereignis folgenden Code:

if (x + dx < 0) or (x + dx + Label1.Width > Form1.Width) then
begin
dx := -dx;
end;
x := x + dx;
Label1.Left := x;

Wie gesagt, das ist die einfachste Form: der Text pendelt horizontal hin und her.

Viele Grüße, Hans-Pete

[markus lemcke]

schön! ich will aber das er rechts verschwindet und links wieder auftaucht!

gruß

marku

[Hans-Peter Tschan]

Hi Markus,

na dann machen wir das anders: Ne globale Variable lbl vom Typ TLabel und 2 Labels und 1 Timer auf die Form:

Ins OnCreate-Ereignis:<br><br>
Label2.Visible := false;<br>
Label1.Visible := true;<br>
Label2.Left := -Label2.Width;<br><br>
lbl := TLabel.Create(self);<br><br>
Ins OnTimer-Ereignis:<br><br>
if Label1.Left + Label1.Width > Width then<br>
begin<br>
Label2.Visible := true;<br>
Label2.Left := Label2.Left + 2;<br>
end;<br>
if Label1.Left > Width then<br>
begin<br>
Label1.Visible := false;<br>
Label1.Left := - Label1.Width;<br>
lbl := Label2;<br>
label2 := Label1;<br>
label1 := lbl;<br>
end;<br>
Label1.Left := Label1.Left + 2;<br><br>
Viele Grüße, Hans-Pete

[markus lemcke]

hi,

dein code funzt tadellos! nur kapieren tue ich ihn noch nicht so ganz wo wird label 1 wieder sichtbar?

gruß

marku

[markus lemcke]

die funktionsweise deines codes gibt mir rätsel auf

gruß

marku

[Hans-Peter Tschan]

Hi Markus,

nun, das ganze ist gar nicht so schwer: nach erzeugen der Form, ist label2 unsichtbar und liegt genau um die Länge des Textes "außerhalb der Form links". Label1 wandert nach rechts. In dem Moment, wo Label1 rechts "aus der Form rauswandert", aber noch zu sehen ist, wird Label2 sichtbar und wandert ebenfalls nach rechts (erste if-Abfrage). Wenn nun label1 ganz verschwunden ist. setze ich label1 an die Stelle, wo label2 beim Programmstart war, nämlich "links von der Form". Jetzt würde aber label2 vollständig sichtbar werden und dann stehen bleiben, da label1 links von der Form liegt und somit die Bedingung der ersten if-Abfrage nicht erfüllt wäre. Label1 würde wieder rechts rauslaufen und label2 solange loslaufen, bis die 2. if-Bedingung erfüllt wäre
Deshalb tausche ich das label-objekt: Label2 wird label1 und label1 wird label2, mit hilfe der Instanz lbl. Damit stelle ich den "Urzustand" wieder her. Mach Dir mal den Spaß und kommentiere die Zeilen lbl := Label2; label2 := Label1; label1 := lbl; aus...
Die Visible-Eigenschaft mußt Du übrigens nicht setzen; ich hatte das mal vor geraumer Zeit mit der Visible-Eigenschaft gecodet und noch im Hinterkopf; das mit dem Tauschen ist mir vorhin neben der Arbeit auf die Schnelle eingefallen :-)

Viele Grüße, Hans-Pete

[markus lemcke]

hi!!

ich habe gerade deine code gedebuggt und ihn so ähnlich interpretiert wie du jetzt geschrieben hast! also, ich habe es so verstanden, dass label2 nur dafür sorgt, dass der eine raus und der andere rein läuft! aber die großen strecken läuft label1!! richtig?

gruß

marku

[Hans-Peter Tschan]

Hi Markus,

ja genau, label2 läuft eigentlich nur raus, während label1 "schaffen" muss...

Viele Grüße, Hans-Pete

[Jens Schumann]

Hallo Markus,<br>Deine Frage hat mich animiert eine kleine Komponente dafür zu basteln. Für Fehlerhinweise und Verbesserungen bin ich immer offen:
<pre>
unit JsRunningText;

interface

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

type
TJsRunningTextFrame = class(TPersistent)
private
FVisible : Boolean;
FOnChange : TNotifyEvent;
FColor: TColor;
procedure SetVisible(const Value: Boolean);
procedure SetOnChange(const Value: TNotifyEvent);
procedure SetColor(const Value: TColor);
protected
procedure Change; virtual;
public
constructor Create;
procedure Assign(Source : TPersistent); override;
published
property Color : TColor read FColor write SetColor;
property Visible : Boolean read FVisible write SetVisible default True;
property OnChange : TNotifyEvent read FOnChange write SetOnChange;
end;

TJsRunningTextDirection = (tdLeft, tdRight, tdUp, tdDown);

TJsRunningText = class(TGraphicControl)
private
{ Private-Deklarationen }
FText : TStrings;
FFrame : TJsRunningTextFrame;
FTimer : TTimer;
FInterval : Cardinal;
FRun : Boolean;
FColor : TColor;
FInternalBmp : TBitmap; // Durch das Verwenden einer internen Bitmap entsteht kein geflacker !!!
FDirection : TJsRunningTextDirection;
FXPos : Integer;
FYPos : Integer;
FFont : TFont;
FSteps : Integer;
FMaxTextWidth : Integer;
FTextHeight : Integer;
FMaxTextHeight : Integer;
procedure SetText(const Value: TStrings);
procedure SetFrame(const Value: TJsRunningTextFrame);
procedure FrameChangeEvent(Sender : TObject);
procedure TimerEvent(Sender : TObject);
procedure FontChangeEvent(Sender : TObject);
procedure TextChangeEvent(Sender : TObject);
procedure SetInterval(const Value: Cardinal);
procedure SetRun(const Value: Boolean);
procedure SetColor(const Value: TColor);
procedure SetDirection(const Value: TJsRunningTextDirection);
procedure SetFont(const Value: TFont);
procedure SetSteps(const Value: Integer);
function GetMaxTextWidth : Integer;
function GetTextHeight : Integer;
protected
{ Protected-Deklarationen }
procedure Paint; override;
procedure PaintFrame;
procedure PaintBackGround;
procedure PaintRunningText;
procedure PaintTextOnce(X,Y : Integer);
procedure PaintBmp;
public
{ Public-Deklarationen }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
published
{ Published-Deklarationen }
property Color : TColor read FColor write SetColor; // Hintergrundfarbe
property Direction : TJsRunningTextDirection read FDirection write SetDirection default tdLeft; // Richtung
property Font : TFont read FFont write SetFont; // Textfarbe
property Interval : Cardinal read FInterval write SetInterval default 100; // Timerinterval
property Text : TStrings read FText write SetText; // Text (!!! es können ganze Texte laufen !!!)
property Frame : TJsRunningTextFrame read FFrame write SetFrame; // Rahmen
property Steps : Integer read FSteps write SetSteps default 1; // Anzahl der Schritte in Pixel pro Interval
property Run : Boolean read FRun write SetRun default False;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('MyComps', [TJsRunningText]);
end;

{ TJsRunningText }

constructor TJsRunningText.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FText:=TStringList.Create;
FInternalBmp:=TBitmap.Create;
Width:=150;
Height:=50;
FFrame:=TJsRunningTextFrame.Create;
FFrame.OnChange:=FrameChangeEv

[Jens Schumann]

unit JsRunningText;

interface

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

type
TJsRunningTextFrame = class(TPersistent)
private
FVisible : Boolean;
FOnChange : TNotifyEvent;
FColor: TColor;
procedure SetVisible(const Value: Boolean);
procedure SetOnChange(const Value: TNotifyEvent);
procedure SetColor(const Value: TColor);
protected
procedure Change; virtual;
public
constructor Create;
procedure Assign(Source : TPersistent); override;
published
property Color : TColor read FColor write SetColor;
property Visible : Boolean read FVisible write SetVisible default True;
property OnChange : TNotifyEvent read FOnChange write SetOnChange;
end;

TJsRunningTextDirection = (tdLeft, tdRight, tdUp, tdDown);

TJsRunningText = class(TGraphicControl)
private
{ Private-Deklarationen }
FText : TStrings;
FFrame : TJsRunningTextFrame;
FTimer : TTimer;
FInterval : Cardinal;
FRun : Boolean;
FColor : TColor;
FInternalBmp : TBitmap; // Durch das Verwenden einer internen Bitmap entsteht kein geflacker !!!
FDirection : TJsRunningTextDirection;
FXPos : Integer;
FYPos : Integer;
FFont : TFont;
FSteps : Integer;
FMaxTextWidth : Integer;
FTextHeight : Integer;
FMaxTextHeight : Integer;
procedure SetText(const Value: TStrings);
procedure SetFrame(const Value: TJsRunningTextFrame);
procedure FrameChangeEvent(Sender : TObject);
procedure TimerEvent(Sender : TObject);
procedure FontChangeEvent(Sender : TObject);
procedure TextChangeEvent(Sender : TObject);
procedure SetInterval(const Value: Cardinal);
procedure SetRun(const Value: Boolean);
procedure SetColor(const Value: TColor);
procedure SetDirection(const Value: TJsRunningTextDirection);
procedure SetFont(const Value: TFont);
procedure SetSteps(const Value: Integer);
function GetMaxTextWidth : Integer;
function GetTextHeight : Integer;
protected
{ Protected-Deklarationen }
procedure Paint; override;
procedure PaintFrame;
procedure PaintBackGround;
procedure PaintRunningText;
procedure PaintTextOnce(X,Y : Integer);
procedure PaintBmp;
public
{ Public-Deklarationen }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
published
{ Published-Deklarationen }
property Color : TColor read FColor write SetColor; // Hintergrundfarbe
property Direction : TJsRunningTextDirection read FDirection write SetDirection default tdLeft; // Richtung
property Font : TFont read FFont write SetFont; // Textfarbe
property Interval : Cardinal read FInterval write SetInterval default 100; // Timerinterval
property Text : TStrings read FText write SetText; // Text (!!! es können ganze Texte laufen !!!)
property Frame : TJsRunningTextFrame read FFrame write SetFrame; // Rahmen
property Steps : Integer read FSteps write SetSteps default 1; // Anzahl der Schritte in Pixel pro Interval
property Run : Boolean read FRun write SetRun default False;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('MyComps', [TJsRunningText]);
end;

{ TJsRunningText }

constructor TJsRunningText.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FText:=TStringList.Create;
FInternalBmp:=TBitmap.Create;
Width:=150;
Height:=50;
FFrame:=TJsRunningTextFrame.Create;
FFrame.OnChange:=FrameChangeEvent;
FFont:=TFont.Create;
FFont.OnChange:=FontChangeEvent;
FTimer:=TTimer.Create(Self);
FTimer.Enabled:=False;
FTimer.OnTimer:=TimerEvent;

[Jens Schumann]

Hallo Markus,<br>Deine Frage hat mich animiert eine kleine Komponente zu basteln. Das besondere ist, Du kannst die Richtung (nach links, rechts, oben o. unten) vorgeben und der Text kann mehrere Zeilen haben. Für Fehlerhinweise und Verbesserungsvorschläge bin ich immer offen:
<pre>
unit JsRunningText;

interface

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

type
TJsRunningTextFrame = class(TPersistent)
private
FVisible : Boolean;
FOnChange : TNotifyEvent;
FColor: TColor;
procedure SetVisible(const Value: Boolean);
procedure SetOnChange(const Value: TNotifyEvent);
procedure SetColor(const Value: TColor);
protected
procedure Change; virtual;
public
constructor Create;
procedure Assign(Source : TPersistent); override;
published
property Color : TColor read FColor write SetColor;
property Visible : Boolean read FVisible write SetVisible default True;
property OnChange : TNotifyEvent read FOnChange write SetOnChange;
end;

TJsRunningTextDirection = (tdLeft, tdRight, tdUp, tdDown);

TJsRunningText = class(TGraphicControl)
private
{ Private-Deklarationen }
FText : TStrings;
FFrame : TJsRunningTextFrame;
FTimer : TTimer;
FInterval : Cardinal;
FRun : Boolean;
FColor : TColor;
FInternalBmp : TBitmap; // Durch das Verwenden einer internen Bitmap entsteht kein geflacker !!!
FDirection : TJsRunningTextDirection;
FXPos : Integer;
FYPos : Integer;
FFont : TFont;
FSteps : Integer;
FMaxTextWidth : Integer;
FTextHeight : Integer;
FMaxTextHeight : Integer;
procedure SetText(const Value: TStrings);
procedure SetFrame(const Value: TJsRunningTextFrame);
procedure FrameChangeEvent(Sender : TObject);
procedure TimerEvent(Sender : TObject);
procedure FontChangeEvent(Sender : TObject);
procedure TextChangeEvent(Sender : TObject);
procedure SetInterval(const Value: Cardinal);
procedure SetRun(const Value: Boolean);
procedure SetColor(const Value: TColor);
procedure SetDirection(const Value: TJsRunningTextDirection);
procedure SetFont(const Value: TFont);
procedure SetSteps(const Value: Integer);
function GetMaxTextWidth : Integer;
function GetTextHeight : Integer;
protected
{ Protected-Deklarationen }
procedure Paint; override;
procedure PaintFrame;
procedure PaintBackGround;
procedure PaintRunningText;
procedure PaintTextOnce(X,Y : Integer);
procedure PaintBmp;
public
{ Public-Deklarationen }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
published
{ Published-Deklarationen }
property Color : TColor read FColor write SetColor; // Hintergrundfarbe
property Direction : TJsRunningTextDirection read FDirection write SetDirection default tdLeft; // Richtung
property Font : TFont read FFont write SetFont; // Textfarbe
property Interval : Cardinal read FInterval write SetInterval default 100; // Timerinterval
property Text : TStrings read FText write SetText; // Text (!!! es können ganze Texte laufen !!!)
property Frame : TJsRunningTextFrame read FFrame write SetFrame; // Rahmen
property Steps : Integer read FSteps write SetSteps default 1; // Anzahl der Schritte in Pixel pro Interval
property Run : Boolean read FRun write SetRun default False;
end;
</pre&gt

[Jens Schumann]

<pre>
procedure Register;

implementation

procedure Register;
begin
RegisterComponents('MyComps', [TJsRunningText]);
end;

{ TJsRunningText }

constructor TJsRunningText.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FText:=TStringList.Create;
FInternalBmp:=TBitmap.Create;
Width:=150;
Height:=50;
FFrame:=TJsRunningTextFrame.Create;
FFrame.OnChange:=FrameChangeEvent;
FFont:=TFont.Create;
FFont.OnChange:=FontChangeEvent;
FTimer:=TTimer.Create(Self);
FTimer.Enabled:=False;
FTimer.OnTimer:=TimerEvent;
FInterval:=100;
FText:=TStringList.Create;
TStringList(FText).OnChange:=TextChangeEvent;
FRun:=False;
FColor:=clBtnFace;
FDirection:=tdLeft;
FXPos:=0;
FYPos:=0;
FSteps:=1;
end;

destructor TJsRunningText.Destroy;
begin
FTimer.Free;
FFrame.Free;
FInternalBmp.Free;
FFont.Free;
FText.Free;
inherited Destroy;
end;

procedure TJsRunningText.FontChangeEvent(Sender: TObject);
begin
FMaxTextWidth:=GetMaxTextWidth;
FTextHeight:=GetTextHeight;
FMaxTextHeight:=FTextHeight*FText.Count;
Paint;
end;

procedure TJsRunningText.FrameChangeEvent(Sender: TObject);
begin
Paint;
end;

function TJsRunningText.GetMaxTextWidth: Integer;
var
iCnt : Integer;
begin
Result:=0;
With FInternalBmp.Canvas do
begin
Font.Assign(FFOnt);
For iCnt:=0 to FText.Count-1 do
If TextWidth(FText[iCnt])>Result then
Result:=TextWidth(FText[iCnt])
end;
end;
</pre&gt

[Jens Schumann]

<pre>
function TJsRunningText.GetTextHeight: Integer;
begin
Result:=0;
With FInternalBmp.Canvas do
begin
Font.Assign(FFont);
Result:=TextHeight('Ö,y');
end;
end;

procedure TJsRunningText.Paint;
begin
PaintBackGround;
If FRun then
PaintRunningText
else
begin
FXPos:=ClientWidth div 2 - FMaxTextWidth div 2;
FYPos:=ClientHeight div 2 - FMaxTextHeight div 2;
PaintTextOnce(FXPos,FYPos);
end;
PaintBmp;
If csDesigning in ComponentState then
with Canvas do
begin
Pen.Style := psDash;
Pen.Color:=clBlack;
Brush.Style := bsClear;
Rectangle(0, 0, Width, Height);
end;
end;

procedure TJsRunningText.PaintBackGround;
begin
With FInternalBmp.Canvas do
begin
Brush.Style:=bsSolid;
Brush.Color:=FColor;
Pen.Color:=FColor;
Pen.Width:=1;
Rectangle(ClientRect);
end;
PaintFrame;
end;

procedure TJsRunningText.PaintBmp;
begin
BitBlt(Canvas.Handle,0,0,Width,Height,FInternalBmp .Canvas.Handle,0,0,SRCCOPY);
end;

procedure TJsRunningText.PaintFrame;
begin
If Not FFrame.Visible then Exit;
With FInternalBmp.Canvas do
begin
Brush.Style:=bsClear;
Pen.Color:=FFrame.Color;
Pen.Width:=1;
Rectangle(ClientRect);
end;
end;

procedure TJsRunningText.PaintRunningText;
begin
With FInternalBmp.Canvas do
begin
Brush.Style:=bsClear;
Font.Assign(FFont);
Case FDirection of
tdLeft : begin
Dec(FXPos,FSteps);
FYPos:=ClientHeight div 2 - FMaxTextHeight div 2;
end;
tdRight : begin
Inc(FXPos,FSteps);
FYPos:=ClientHeight div 2 - FMaxTextHeight div 2;
end;
tdUp : begin
Dec(FYPos,FSteps);
FXPos:=ClientWidth div 2 - FMaxTextWidth div 2;
end;
tdDown : begin
Inc(FYPos,FSteps);
FXPos:=ClientWidth div 2 - FMaxTextWidth div 2;
end;
end; // Case FDirection of
PaintTextOnce(FXPos,FYPos);
Case FDirection of
tdLeft : begin
If FXPos<0 then
PaintTextOnce(ClientWidth+FXPos,FYPos);
If (FXPos+FMaxTextWidth<=0) then
FXPos:=ClientWidth-FMaxTextWidth;
end;
tdRight : begin
If (FXPos+FMaxTextWidth>ClientWidth) then
PaintTextOnce(-(ClientWidth-FXpos),FYPos);
If (FXPos>=ClientWidth) then
FXPos:=0;
end;
tdUp : begin
If (FYPos-FMaxTextHeight)<0 then
PaintTextOnce(FXPos,ClientHeight+FYPos);
If (FYPos+FMaxTextHeight<=0) then
FYPos:=ClientHeight-FMaxTextHeight;
end;
tdDown : begin
If (FYPos+FMaxTextHeight>ClientHeight) then
PaintTextOnce(FXPos,-(ClientHeight-FYpos));
If (FYPos>=ClientHeight) then
FYPos:=0;
end;
end; // Case FDirection of
end; // With Canvas do
end;
</pre&gt

[Jens Schumann]

<pre>
procedure TJsRunningText.PaintTextOnce(X,Y : Integer);
var
MaxTextHeight : Integer;
iCnt : Integer;
begin
MaxTextHeight:=FTextHeight*FText.Count;
With FInternalBmp.Canvas do
begin
Brush.Style:=bsClear;
Font.Assign(FFont);
For iCnt:=0 to FText.Count-1 do
TextOut(X,Y+iCnt*FTextHeight,FText[iCnt])
end;
end;

procedure TJsRunningText.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
FInternalBmp.Width:=AWidth;
FInternalBmp.Height:=AHeight;
end;

procedure TJsRunningText.SetColor(const Value: TColor);
begin
If FColor<>Value then
begin
FColor:=Value;
Paint;
end;
end;

procedure TJsRunningText.SetDirection(const Value: TJsRunningTextDirection);
begin
If FDirection<>Value then
FDirection:=Value;
end;

procedure TJsRunningText.SetFont(const Value: TFont);
begin
FFont.Assign(Value);
end;

procedure TJsRunningText.SetFrame(const Value: TJsRunningTextFrame);
begin
FFrame.Assign(Value);
end;

procedure TJsRunningText.SetInterval(const Value: Cardinal);
begin
FInterval := Value;
FTimer.Interval:=FInterval;
end;

procedure TJsRunningText.SetRun(const Value: Boolean);
begin
If FRun<>Value then
begin
FRun:=Value;
FTimer.Enabled:=FRun;
Paint;
end;
end;

procedure TJsRunningText.SetSteps(const Value: Integer);
begin
If FSteps<>Value then
FSteps:=Value;
end;

procedure TJsRunningText.SetText(const Value: TStrings);
begin
FText.Assign(Value);
end;

procedure TJsRunningText.TextChangeEvent(Sender: TObject);
begin
FMaxTextWidth:=GetMaxTextWidth;
FTextHeight:=GetTextHeight;
FMaxTextHeight:=FTextHeight*FText.Count;
Paint;
end;

procedure TJsRunningText.TimerEvent(Sender: TObject);
begin
Paint;
end;

{ TJsRunningTextFrame }

procedure TJsRunningTextFrame.Assign(Source: TPersistent);
begin

end;

procedure TJsRunningTextFrame.Change;
begin
If Assigned(FOnChange) then
FOnChange(Self);
end;

constructor TJsRunningTextFrame.Create;
begin
inherited Create;
FColor:=clBlack;
FVisible:=True;
end;

procedure TJsRunningTextFrame.SetColor(const Value: TColor);
begin
If FColor<>Value then
begin
FColor:=Value;
Change;
end;
end;

procedure TJsRunningTextFrame.SetOnChange(const Value: TNotifyEvent);
begin
FOnChange := Value;
end;

procedure TJsRunningTextFrame.SetVisible(const Value: Boolean);
begin
If FVisible<>Value then
begin
FVisible:=Value;
Change;
end;
end;

end.
</pre&gt