Ticker-Text

[fiasko]

Zitat:

Zitat von Christian Seehase

Mal sehen, ob mir dazu was einfällt. Langsam fängt die Sache an interessant zu werden ;-)

Jo, wenn ich heut nach'Hause komme, werd ich mich wohl gleich mal rannsetzen *gg*


Thomas

[Christian Seehase]

Moin Luckie,

:mrgreen: :mrgreen: :mrgreen:

der ist aber auch einfach zu schön. (dicht gefolgt von mecker ;-) )

[Luckie]

Und wehe der Ticker läuft morgen nicht. http://www.luckie-online.de/_pics/mecker.gif

Aber wer sagt das ein Ticker pixelweise scrollen muß? Klar es sieht schöner aus, aber dürfte auch recht schwer zu realisieren sein.
Man müßte ja praktisch die Buchstaben selber zeichnen oder so.

[Christian Seehase]

Moin Luckie,

das denke ich nicht.

Ich hab' mir das so gedacht (Umsetzung offen ;-) ):

1. Der Text wird auf eine Bitmap geschrieben
2. Die Bitmap wird ausgegeben
3. Die erste Spalte der Bitmap wird nach hinten verschoben (wie vorher die Buchstaben
4. Weiter mit Punkt 2

Als zweite Variante könnte man auch, statt eine Spalte der Bitmap zu verschieben, einen Spaltenzähler mitlaufen lassen, ab diesem ausgeben, und den Rest mit dem Anfang der Bitmap aufüllen.


[EDIT]
Das :oops: :pale: :oops: *MitDemKopfVorDieWandHau* bezog sich auch darauf, dass ich das Problem mit dem Ruckeln verkannt hatte.
Es ruckelt nun einmal, wenn man Buchstabenweise Scrollt :? :mrgreen:
[/EDIT]

[sakura]

Und jetzt das pixelweise Scrollen als kleine liebe Komponente.

Delphi-Quellcode:

unit uDPTicker;

interface

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

type
  TdpTicker = class(TGraphicControl)
  private
    FTimer: TTimer;
    FXPos, FTextWidth: Integer;
    FRunAtDesignTime: Boolean;
    procedure OnTimer(Sender: TObject);
    function GetCaption: TCaption;
    procedure SetCaption(const Value: TCaption);
    function GetSpeed: Integer;
    procedure SetSpeed(const Value: Integer);
    procedure SetRunAtDesignTime(const Value: Boolean);
  protected
    procedure Paint; override;
    procedure SetEnabled(Value: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Speed: Integer read GetSpeed write SetSpeed;
    property Caption: TCaption read GetCaption write SetCaption;
    property RunAtDesignTime: Boolean read FRunAtDesignTime write SetRunAtDesignTime;

    property Align;
    property Anchors;
    property Color;
    property Enabled;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Font;
    property Height;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Width;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Delphi-PRAXiS', [TdpTicker]);
end;

{ TdpTicker }

constructor TdpTicker.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 150;
  Height := 25;
  FTimer := TTimer.Create(Self);
  FTimer.Interval := 15;
  FTimer.OnTimer := OnTimer;
  FRunAtDesignTime := False;
  FTimer.Enabled := not (csDesigning in ComponentState);
end;

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

function TdpTicker.GetCaption: TCaption;
begin
  Result := inherited Caption;
end;

function TdpTicker.GetSpeed: Integer;
begin
  Result := FTimer.Interval;
end;

procedure TdpTicker.OnTimer(Sender: TObject);
begin
  Paint;
end;

procedure TdpTicker.Paint;
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.Canvas.Brush.Color := Color;
    Bmp.Canvas.Brush.Style := bsSolid;

    Bmp.Canvas.Font.Assign(Font);
    Bmp.Width := Width;
    Bmp.Height := Height;

    Bmp.Canvas.TextOut(FXPos, (Height - Canvas.TextHeight(Caption)) div 2,
        Caption);
    Dec(FXPos);
    if FXPos + FTextWidth < 0 then
      FXPos := Width;

    Canvas.CopyRect(Canvas.ClipRect, Bmp.Canvas, Canvas.ClipRect);
  finally
    Bmp.Free;
  end;
end;

procedure TdpTicker.SetCaption(const Value: TCaption);
begin
  inherited Caption := Value;
  FXPos := Width;
  if Canvas <> nil then
    FTextWidth := Canvas.TextWidth(Caption);
end;

procedure TdpTicker.SetEnabled(Value: Boolean);
begin
  inherited Enabled := Value;
  FTimer.Enabled := ((not (csDesigning in ComponentState)) or FRunAtDesignTime)
      and Enabled;
end;

procedure TdpTicker.SetRunAtDesignTime(const Value: Boolean);
begin
  FRunAtDesignTime := Value;
  FTimer.Enabled := ((not (csDesigning in ComponentState)) or FRunAtDesignTime)
      and Enabled;
end;

procedure TdpTicker.SetSpeed(const Value: Integer);
begin
  FTimer.Interval := Value;
end;

end.

...:cat:...

[fiasko]

Zitat:

Zitat von sakura

Und jetzt das pixelweise Scrollen als kleine liebe Komponente:

Verdammt, wohl zu spät nach Hause gekommen X-(

[sakura]

Mach was draus ;) Links-Rechts scrollen, Hoch-Runter scrollen, etc. Ausserdem kannst Du die Komponente ja transparent machen. Obiges Beispiel ist übrigens flickerfrei.

"Entwicklungszeit" waren 15 Minuten. Also, nimm die Outline und mach was richtig geiles daraus. Danke.

...:cat:...

[R.Meyrat]

Hallo

Ich habe mal die Komponente von sakura erweitert. Neu ist die Eigenschaft Direction (TickerUp,Ticker Down etc.) dazu gekommen.
Die Eigenschaft Transparent ist zwar da, aber wird beim Paint noch nicht gebraucht. Hab noch keinen Weg, wie das transparent gezeichnet werden soll :roll: . Aber ich bin sicher, die Lösung wird nicht lange auf sich warten lassen. :D

Die Unit als File liegt bei.


Gruss Roger

[Luckie]

Könntet ihr bitte in Zukunft das als Zip-Archiv anhängen? Und eventuell nur die interssanten Stellen posten? Mit so ewig langen Quellcode im Posting wird das ganze etwas unübersichtlich. Danke.

[Stephan]

Hi,

um das flackern zu verhindern könntest du mal folgendes versuchen:

form1.doublebuffered := true;

(bei der nicht pixel genauen Scrollvariante)