unit Punkt; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Extctrls, 
  StdCtrls; 
 
type 
  TBg = (efNormal, efBig, efBigger); 
  TEffect = (efNone, efRoll, efBlink); 
  TWhat = (efText, efEffect, efNumber, efSize, efColor, efPoints); 
 
  TChange = procedure(Sender: TObject; Value: TWhat) of object; 
  TClock = procedure(Sender: TObject; Value: TEffect) of object; 
 
  TPunkt = class(TCustomLabel) 
  private 
    FVorn: TNotifyevent; 
    FChange: TChange; 
    FClock: TClock; 
    gr, strt, lgt: integer; 
    txt, dppl: string; 
    blk, lin: boolean; 
    frb, hig: TColor; 
    wieviel: word; 
    Timer: TTimer; 
    ef: TEffect; 
    t: cardinal; 
    fsz: TBg; 
  protected 
    procedure settxt(s: string); 
    procedure setviel(w: word); 
    procedure festlegen(b: boolean); 
    procedure seteffekt(b: TEffect); 
    procedure TimerRoll(Sender: TObject); 
    procedure TimerBlink(Sender: TObject); 
    procedure setfarbe(f: TColor); 
    procedure setfsz(i: TBg); 
    procedure sethig(c: TColor); 
    procedure setlin(b: boolean); 
  public 
    constructor Create(Owner: TComponent); override; 
    procedure paint; override; 
    procedure resize; override; 
    destructor Destroy; override; 
  published 
    property OnDblClick; 
    property OnClick; 
    property OnMouseMove; 
    property OnMouseDown; 
    property OnMouseUp; 
    property OnKomplett: TNotifyEvent read FVorn write FVorn; 
    property OnChange: TChange read FChange write FChange; 
    property OnClock: TClock read FClock write FClock; 
    property Buchstaben: word read wieviel write setviel; 
    property Effekt: TEffect read ef write seteffekt; 
    property Punkte: TColor read frb write setfarbe; 
    property Schrift: string read txt write settxt; 
    property Farbe: TColor read hig write sethig; 
    property Groesse: TBg read fsz write setfsz; 
    property Gitter: boolean read lin write setlin; 
  end; 
 
procedure Register; 
 
implementation 
 
constructor TPunkt.Create(Owner: TComponent); 
begin 
  inherited Create(Owner); 
  strt := 1; 
  lin := true; 
  Font.Name := 'Fixedsys'; 
  Font.size := 20; 
  Font.Color := clAqua; 
  frb := Font.color; 
  Color := clBlack; 
  hig := Color; 
  txt := 'Punkte * ';  
  lgt := length(txt); 
  wieviel := lgt; 
  dppl := txt + txt; 
  Caption := txt; 
  gr := 2; 
  Timer := TTimer.create(self); 
  Timer.Interval := 0; 
end; 
 
destructor TPunkt.Destroy; 
begin 
  Timer.free; 
  inherited Destroy; 
end; 
 
procedure TPunkt.resize; 
begin 
  autosize := false; 
  autosize := true; 
end; 
 
procedure TPunkt.festlegen(b: boolean); 
begin 
  if b then 
    if wieviel > lgt then wieviel := lgt; 
  caption := copy(txt, 1, wieviel); 
  repaint; 
end; 
 
procedure TPunkt.settxt(s: string); 
begin 
  if txt = s then exit; 
  t := Timer.interval; 
  Timer.interval := 0; 
  strt := 1; 
  txt := s; 
  lgt := length(txt); 
  dppl := txt + txt; 
  if lgt < wieviel then 
    wieviel := lgt; 
  festlegen(true); 
  Timer.interval := t; 
  if not (csLoading in componentstate) then 
    if assigned(FChange) then FChange(self, efText); 
end; 
 
procedure TPunkt.setviel(w: word); 
begin 
  if w = wieviel then exit; 
  t := Timer.interval; 
  Timer.interval := 0; 
  strt := 1; 
  wieviel := w; 
  festlegen(not (csLoading in componentstate)); 
  Timer.interval := t; 
  if not (csLoading in componentstate) then 
    if assigned(FChange) then FChange(self, efNumber); 
end; 
 
procedure TPunkt.paint; 
var i: integer; 
begin 
  inherited; 
  if lin then 
    with canvas do begin 
      pen.color := self.color; 
      for i := 0 to height div gr do begin 
        moveto(0, i * gr); 
        lineto(width, i * gr); 
      end; 
      for i := 0 to width div gr do begin 
        moveto(i * gr, 0); 
        lineto(i * gr, height); 
      end; 
    end; 
end; 
 
procedure TPunkt.TimerRoll(Sender: TObject); 
begin 
  inc(strt); 
  if strt > lgt then strt := 1; 
  caption := copy(dppl, strt, wieviel); 
  if not (csLoading in componentstate) then begin 
    if assigned(FClock) then FClock(self, efRoll); 
    if (strt = 1) then 
      if assigned(FVorn) then FVorn(self); 
  end; 
end; 
 
procedure TPunkt.TimerBlink(Sender: TObject); 
begin 
  if blk then Font.color := frb 
  else Font.color := color; 
  blk := not blk; 
  if not blk and not (csLoading in componentstate) then 
    if assigned(FClock) then FClock(self, efBlink); 
end; 
 
procedure TPunkt.seteffekt(b: TEffect); 
begin 
  if b = ef then exit; 
  ef := b; 
  strt := 1; 
  case ef of 
    efRoll: begin 
        Font.color := frb; 
        Timer.OnTimer := TimerRoll; 
        Timer.interval := 333; 
      end; 
    efBlink: begin 
        Timer.OnTimer := TimerBlink; 
        Timer.interval := 200; 
        blk := false; 
      end; 
  else begin 
      Timer.interval := 0; 
      Font.color := frb; 
    end; 
  end; 
  festlegen(false); 
  if not (csLoading in componentstate) then 
    if assigned(FChange) then FChange(self, efEffect); 
end; 
 
procedure TPunkt.setfarbe(f: TColor); 
begin 
  if frb = f then exit; 
  frb := f; 
  Font.color := f; 
  if not (csLoading in componentstate) then 
    if assigned(FChange) then FChange(self, efPoints); 
end; 
 
procedure TPunkt.setfsz(i: TBg); 
begin 
  if i = fsz then exit; 
  fsz := i; 
  case fsz of 
    efNormal: begin 
        gr := 2; 
        Font.size := 20; 
      end; 
    efBig: begin 
        gr := 3; 
        Font.size := 25; 
      end; 
  else begin 
      gr := 4; 
      Font.size := 35; 
    end; 
  end; 
  if not (csLoading in componentstate) then 
    if assigned(FChange) then FChange(self, efSize); 
end; 
 
procedure TPunkt.sethig(c: TColor); 
begin 
  if c = hig then exit; 
  hig := c; 
  color := c; 
  if not (csLoading in componentstate) then 
    if assigned(FChange) then FChange(self, efColor); 
end; 
 
procedure TPunkt.setlin(b: boolean); 
begin 
  if b = lin then exit; 
  lin := b; 
  repaint; 
end; 
 
procedure Register; 
begin 
  RegisterComponents('DBR', [TPunkt]); 
end; 
 
end. 
 
//------------------------ Beispielaufrufe ------------------------- 
 
 
// Fünf mal blinken lassen 
 
var z: integer; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  z := 0; 
  Punkt1.effekt := efBlink; 
end; 
 
procedure TForm1.Punkt1Clock(Sender: TObject; Value: TEffect); 
begin 
  if Value = efBlink then begin 
    inc(z); 
    if z = 5 then Punkt1.Effekt := efNone; 
  end; 
end; 
 
// längeren Text zuweisen und komplett anzeigen 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  Punkt1.schrift := 'Das ist ein Test!'; 
  Punkt1.Buchstaben := length(Punkt1.schrift); 
end; 
 
// kürzeren Text zuweisen 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  Punkt1.schrift := 'A'; 
end; 
 
// Textdatei mittels Laufschrift anzeigen 
 
procedure TForm1.Button4Click(Sender: TObject); 
var sl: TStringlist; 
begin 
  sl := TStringlist.create; 
  sl.loadfromfile('c:\test.txt'); 
  sl.text := stringreplace(sl.text, #13#10, #32, [rfreplaceall]); 
  sl.text := stringreplace(sl.text, #9, #32, [rfreplaceall]); 
  Punkt1.schrift := sl.text; 
  Punkt1.Buchstaben := 25; // z.B. 
  sl.free; 
  Punkt1.Effekt := efRoll; 
end; 
 
// Text zweimal komplett durchlaufen lassen 
 
var i: integer; 
 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  i := 0; 
  Punkt1.schrift := 'Laufschrift - Test - '; 
  Punkt1.Buchstaben := maxword; 
  Punkt1.effekt := efRoll; 
end; 
 
procedure TForm1.Punkt1Komplett(Sender: TObject); 
begin 
  inc(i); 
  if i = 2 then Punkt1.Effekt := efNone; 
end; 
 
// Blinken bzw. Laufen beenden 
 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
  Punkt1.Effekt := efNone; 
end;

unit PunktX; 
 
interface 
 
uses 
  Windows, SysUtils, Classes, Graphics, Controls, Forms, Extctrls; 
 
type 
  TGrs = (xSmall, xBig, xBigger, xBiggest); 
  TEff = (xNone, xRollLetter, xRollColor, xBlink, 
    xRollDown, xRollUp, xRollPoint, xFalling); 
  TWht = (xText, xEffect, xLetters, xSize, xColor, xPoints, xGrid); 
 
  TChange = procedure(Sender: TObject; Value: TWht) of object; 
  TClock = procedure(Sender: TObject; Value: TEff) of object; 
  TNeu = procedure(Sender: TObject; Value: TEff; Inside: Boolean) of object; 
 
  TPunktX = class(TCustomPanel) // kein Flackern
  private 
    FVorn: TNotifyEvent; 
    FChange: TChange; 
    FClock: TClock; 
    FNeu: TNeu; 
    fllarr: array of integer; 
    lgt, gr, strt, rd, rll, stl, lauf: integer; 
    lin, blk, se, auch: boolean; 
    arr: array of TColor; 
    bm, gsmt: TBitmap; 
    hig, neg: TColor; 
    sl: TStringlist; 
    txt, pf: string; 
    wieviel: word; 
    Timer: TTimer; 
    r, g, b: byte; 
    ps: cardinal; 
    sz: TSize; 
    fsz: TGrs; 
    ef: TEff; 
  protected 
    procedure TimerGo(Sender: TObject); 
    procedure setlin(b: boolean); 
    procedure seteffekt(b: TEff); 
    procedure settxt(s: string); 
    procedure sethig(c: TColor); 
    procedure setviel(w: word); 
    procedure setpf(c: string); 
    procedure raus(b: boolean); 
    procedure setfsz(i: TGrs); 
    procedure getgrsse; 
    procedure setfarr; 
    procedure warten; 
  public 
    constructor Create(Owner: TComponent); override; 
    destructor Destroy; override; 
    procedure Resize; override; 
    procedure Paint; override; 
  published 
    property Pause: Cardinal read ps write ps; 
    property Farben: string read pf write setpf; 
    property Groesse: TGrs read fsz write setfsz; 
    property Effekt: TEff read ef write seteffekt; 
    property Schrift: string read txt write settxt; 
    property Gitter: boolean read lin write setlin; 
    property Hintergrund: TColor read hig write sethig; 
    property Zeichenzahl: word read wieviel write setviel; 
    property PauseOhneSchrift: boolean read auch write auch; 
    property OnKomplett: TNotifyEvent read FVorn write FVorn; 
    property OnChange: TChange read FChange write FChange; 
    property OnClock: TClock read FClock write FClock; 
    property OnReinRaus: TNeu read FNeu write FNeu; 
    property Visible; 
    property OnClick; 
    property OnDblClick; 
    property OnMouseUp; 
    property OnMouseMove; 
    property OnMouseDown; 
  end; 
 
procedure Register; 
 
implementation 
 
constructor TPunktX.Create(Owner: TComponent); 
begin 
  inherited Create(Owner); 
  lin := true; 
  auch := false; 
  se := false; 
  pf := '$EE $FF4000 $9900'; 
  bm := TBitmap.create; 
  gsmt := TBitmap.create; 
  gsmt.canvas.brush.style := bsClear; 
  sethig(clWhite); 
  bm.canvas.Font.name := 'Fixedsys'; 
  bm.canvas.Font.size := 25; 
  fsz := xBig; 
  gr := 3; 
  sl := TStringlist.create; 
  getgrsse; 
  Timer := TTimer.Create(self); 
  Timer.interval := 0; 
  strt := 0; 
  rll := 0; 
  rd := 0; 
  blk := false; 
  Timer.OnTimer := TimerGo; 
  wieviel := 6; 
  setfarr; 
  settxt('PunktX '); 
end; 
 
destructor TPunktX.Destroy; 
begin 
  Timer.free; 
  sl.free; 
  bm.free; 
  gsmt.free; 
  arr := nil; 
  fllarr := nil; 
  inherited Destroy; 
end; 
 
procedure TPunktX.getgrsse; 
begin 
  sz := bm.canvas.textextent('W'); 
  bm.width := sz.cx; 
  bm.height := sz.cy; 
end; 
 
procedure TPunktX.raus(b: boolean); 
begin 
  if not (csLoading in componentstate) then begin 
    if assigned(FNeu) then FNeu(self, ef, b); 
    if b or auch then warten; 
  end; 
end; 
 
procedure TPunktX.Resize; 
begin 
  width := wieviel * sz.cx + 2; 
  height := sz.cy + 2; 
  gsmt.width := width; 
  gsmt.height := height; 
end; 
 
procedure TPunktX.settxt(s: string); 
begin 
  if (s = txt) or (s = '') then exit; 
  txt := s; 
  lgt := length(txt); 
  if wieviel > lgt then wieviel := lgt; 
  strt := 0; 
  rll := 0; 
  resize; 
  setpf(#1 + pf); 
  if not (csLoading in componentstate) then 
    if assigned(FChange) then FChange(self, xText); 
end; 
 
procedure TPunktX.setpf(c: string); 
var x: integer; 
  ev: boolean; 
begin 
  if (c = pf) then exit; 
  ev := copy(c, 1, 1) = #1; 
  pf := trim(c); 
  if pf = '' then pf := ColorToString(neg); 
  sl.commatext := pf; 
  while sl.count < lgt do 
    sl.text := sl.text + sl.text; 
  setlength(arr, lgt); 
  for x := 0 to high(arr) do 
  try 
    arr[x] := StringToColor(sl[x]); 
  except 
    arr[x] := neg; 
  end; 
  sl.clear; 
  repaint; 
  if not (csLoading in componentstate) and not ev then 
    if assigned(FChange) then FChange(self, xPoints); 
end; 
 
procedure TPunktX.setfsz(i: TGrs); 
var m: cardinal; 
begin 
  if i = fsz then exit; 
  m := Timer.interval; 
  Timer.interval := 0; 
  fsz := i; 
  with bm.canvas do 
    case fsz of 
      xSmall: begin 
          gr := 2; 
          Font.size := 20; 
        end; 
      xBig: begin 
          gr := 3; 
          Font.size := 25; 
        end; 
      xBigger: begin 
          gr := 4; 
          Font.size := 35; 
        end; 
    else begin 
        gr := 5; 
        Font.size := 50; 
      end; 
    end; 
  rd := 0; 
  getgrsse; 
  setfarr; 
  Resize; 
  repaint; 
  Timer.interval := m; 
  if not (csLoading in componentstate) then 
    if assigned(FChange) then FChange(self, xSize); 
end; 
 
procedure TPunktX.setlin(b: boolean); 
begin 
  if b = lin then exit; 
  lin := b; 
  repaint; 
  if not (csLoading in componentstate) then 
    if assigned(FChange) then FChange(self, xGrid); 
end; 
 
procedure TPunktX.setviel(w: word); 
begin 
  if w > lgt then w := lgt; 
  if (w = wieviel) or (w = 0) then exit; 
  wieviel := w; 
  strt := 0; 
  rll := 0; 
  setfarr; 
  resize; 
  if not (csLoading in componentstate) then 
    if assigned(FChange) then FChange(self, xLetters); 
end; 
 
procedure TPunktX.warten; 
var zeit, m: cardinal; 
begin 
  if ps = 0 then exit; 
  m := Timer.interval; 
  Timer.interval := 0; 
  zeit := gettickcount + ps; 
  repeat 
    application.processmessages; 
    if application.terminated then exit; 
  until (gettickcount >= zeit); 
  Timer.interval := m; 
end; 
 
procedure TPunktX.setfarr; 
var x: integer; 
begin 
  setlength(fllarr, wieviel); 
  for x := 0 to wieviel - 1 do 
    fllarr[x] := 0; 
  stl := 0; 
  lauf := 0; 
end; 
 
procedure TPunktX.sethig(c: TColor); 
begin 
  if (c = hig) then exit; 
  hig := ColorToRGB(c); 
  bm.canvas.brush.color := hig; 
  gsmt.canvas.pen.color := hig; 
  r := getrvalue(hig); 
  g := getgvalue(hig); 
  b := getbvalue(hig); 
  neg := rgb(255 - r, 255 - g, 255 - b); 
  repaint; 
  if not (csLoading in componentstate) then 
    if assigned(FChange) then FChange(self, xColor); 
end; 
 
procedure TPunktX.seteffekt(b: TEff); 
begin 
  if (b = ef) then exit; 
  Timer.interval := 0; 
  se := true; 
  ef := b; 
  if not (ef in [xRollDown, xRollUp]) then rd := 0; 
  setfarr; 
  strt := 0; 
  rll := 0; 
  blk := false; 
  repaint; 
  case ef of 
    xBlink: Timer.interval := 220; 
    xRollPoint, xFalling: Timer.interval := 110; 
    xRollLetter, xRollColor: Timer.interval := 330; 
    xRollDown, xRollUp: begin 
        rd := -rd; 
        Timer.interval := 120; 
      end; 
  else repaint; 
  end; 
  if not (csLoading in componentstate) then 
    if assigned(FChange) then FChange(self, xEffect); 
end; 
 
procedure TPunktX.TimerGo(Sender: TObject); 
begin 
  case ef of 
    xRollPoint: begin 
        inc(rll); 
        if rll * gr >= sz.cx then begin 
          rll := 0; 
          inc(strt); 
          if strt >= lgt then strt := 0; 
        end; 
      end; 
    xRollColor: begin 
        dec(strt); 
        if strt < 0 then strt := lgt - 1; 
      end; 
    xRollLetter: begin 
        inc(strt); 
        if strt >= lgt then strt := 0; 
      end; 
    xBlink: blk := not blk; 
    xRollDown: begin 
        inc(rd, gr); 
        if rd > sz.cy then begin 
          rd := -sz.cy; 
          raus(false); 
        end; 
      end; 
    xRollUp: begin 
        dec(rd, gr); 
        if rd < -sz.cy then begin 
          rd := sz.cy; 
          raus(false); 
        end; 
      end; 
    xFalling: begin 
        inc(fllarr[stl], gr * 3); 
        if fllarr[stl] > sz.cy + gr * 2 then fllarr[stl] := 0; 
        inc(stl); 
      end; 
  end; 
  repaint; 
  if not (csLoading in componentstate) and not blk then 
    if assigned(FClock) then FClock(self, ef); 
  if not se then begin 
    if (stl = wieviel) then 
      inc(lauf); 
    if lauf in [5, 12] then begin 
      lauf := 6; 
      raus(false); 
    end; 
    if (strt = 0) then 
      if (ef = xRollLetter) or (ef = xRollColor) 
        or (ef = xRollPoint) and (rll = 0) 
        or (ef = xFalling) and (stl = wieviel) and (fllarr[wieviel - 1] = 0) 
        then begin 
        if not (csLoading in componentstate) then 
          if assigned(FVorn) then FVorn(self); 
        warten; 
      end; 
    if (ef in [xRollUp, xRollDown]) and (rd = 0) 
      then raus(true); 
  end; 
  se := false; 
  if stl = wieviel then stl := 0; 
end; 
 
procedure TPunktX.paint; 
var x, y, z, k: integer; 
begin 
  x := 1; 
  while x <= wieviel do begin 
    case ef of 
      xRollPoint, xRollLetter: begin 
          y := x + strt; 
          if y > lgt then y := y - lgt; 
          z := y - 1; 
        end; 
      xRollColor: begin 
          z := x + strt - 1; 
          if z >= lgt then z := z - lgt; 
          y := x; 
        end; 
    else begin 
        y := x; 
        z := x - 1; 
      end; 
    end; 
    with bm.canvas do begin 
      fillrect(cliprect); 
      if blk then 
        Font.color := hig else 
        Font.color := arr[z]; 
      textout(0, rd, txt[y]); 
    end; 
    gsmt.canvas.draw(1 + (x - 1) * sz.cx - gr * rll, 1 + fllarr[x - 1], bm); 
    if (ef = xRollPoint) and (x = wieviel) then begin 
      with bm.canvas do begin 
        fillrect(cliprect); 
        y := strt + wieviel + 1; 
        if y > lgt then y := y - lgt; 
        Font.color := arr[y - 1]; 
        textout(0, rd, txt[y]); 
      end; 
      gsmt.canvas.draw(1 + x * sz.cx - gr * rll, 1, bm); 
    end 
    else if ef = xFalling then begin 
      if fllarr[x - 1] < 0 then k := sz.cy else k := -sz.cy; 
      with bm.canvas do fillrect(cliprect); 
      gsmt.canvas.draw(1 + (x - 1) * sz.cx - gr * rll, 1 + 
        fllarr[x - 1] + k, bm); 
    end; 
    inc(x); 
  end; 
  if lin then 
    with gsmt.canvas do begin 
      for x := 0 to height div gr do begin 
        moveto(0, x * gr); 
        lineto(width - 1, x * gr); 
      end; 
      for x := 0 to width div gr do begin 
        moveto(x * gr, 0); 
        lineto(x * gr, height - 1); 
      end; 
    end; 
  gsmt.canvas.rectangle(0, 0, width, height); 
  canvas.draw(0, 0, gsmt); 
end; 
 
procedure Register; 
begin 
  RegisterComponents('DBR', [TPunktX]); 
end; 
 
end.

//--------------------  Beispielaufruf 1  ------------------- 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  doublebuffered := true; 
  PunktX1.Schrift := 'DEMO '; 
  PunktX1.Zeichenzahl := 4; 
  PunktX1.Groesse := xBig; 
  PunktX1.Pause := 300; 
  PunktX1.Hintergrund := $99FFFF; 
  PunktX1.farben := 'clNavy'; 
  PunktX1.Effekt := xRollDown; 
end; 
 
procedure TForm1.PunktX1ReinRaus(Sender: TObject; Value: TEff; 
  Inside: Boolean); 
begin 
  if inside then PunktX1.Effekt := xRollPoint 
  else begin 
    if PunktX1.Schrift = 'DEMO ' then 
      PunktX1.Schrift := 'TEST ' else 
      PunktX1.Schrift := 'DEMO '; 
  end; 
end; 
 
procedure TForm1.PunktX1Komplett(Sender: TObject); 
begin 
  PunktX1.Effekt := xRollDown; 
end; 
 
//--------------------  Beispielaufruf 2  ------------------- 
 
var 
  z: integer = 0; 
  frb: array[0..5] of string = 
  ('clBlack', 'clRed', 'clGreen', 'clMaroon', 'clBlue', 'clPurple'); 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  doublebuffered := true; 
  PunktX1.Schrift := 'Borland'; 
  PunktX1.Zeichenzahl := 7; 
  PunktX1.Groesse := xBigger; 
  PunktX1.Pause := 1000; 
  PunktX1.Hintergrund := Color; 
  PunktX1.farben := frb[z]; 
  PunktX1.Effekt := xRollDown; 
end; 
 
procedure TForm1.PunktX1ReinRaus(Sender: TObject; Value: TEff; 
  Inside: Boolean); 
begin 
  if Value in [xRollup, xRollDown] then begin 
    if not inside then begin 
      inc(z); 
      if z > 5 then z := 0; 
      PunktX1.farben := frb[z]; 
      if PunktX1.Schrift = 'Inprise' 
        then PunktX1.Schrift := 'Borland' 
      else PunktX1.Schrift := 'Inprise'; 
    end; 
    if Value = xRollUp then 
      PunktX1.Effekt := xRollDown else 
      PunktX1.Effekt := xRollUp; 
  end; 
end; 
 
//--------------------  Beispielaufruf 3  ------------------- 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  with PunktX1 do begin 
    Schrift := 'EINS'; 
    Zeichenzahl := 4; 
    Groesse := xBig; 
    Pause := 2000; 
    PauseOhneSchrift := false; 
    Hintergrund := clBlack; 
    farben := 'clLime clyellow'; 
    Effekt := xFalling; 
  end; 
end; 
 
procedure TForm1.PunktX1ReinRaus(Sender: TObject; Value: TEff; 
  Inside: Boolean); 
begin 
  if punktx1.schrift = 'EINS' then begin 
    punktx1.schrift := 'ZWEI'; 
    punktx1.farben := 'clsilver clfuchsia'; 
  end else begin 
    punktx1.schrift := 'EINS'; 
    punktx1.farben := 'clLime clyellow'; 
  end; 
end;