Thema: Delphi Sinus scroller

Einzelnen Beitrag anzeigen

Benutzerbild von turboPASCAL
turboPASCAL

Registriert seit: 8. Mai 2005
Ort: Sondershausen
4.274 Beiträge
 
Delphi 6 Personal
 
#6

Re: Sinus scroller

  Alt 13. Apr 2007, 10:17
Die Textausgabe ist recht einfach:
Delphi-Quellcode:
type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private-Deklarationen }
    bmp: tbitmap;
    sinArray: array of integer;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses math;

var
  SinTxt : String =
    'Willkommen in der freundlichen Community rund um Borlands/CodeGears'+
    ' Entwicklertool "Delphi". Unser Ziel ist es, eine Diskussionsplattf'+
    'orm für den Gedankenaustausch zwischen Menschen zu schaffen, die si'+
    'ch beruflich oder privat mit Delphi befassen...';

procedure TForm1.FormCreate(Sender: TObject);
var
  i, n,p: integer;
begin
  bmp := tbitmap.Create;
  bmp.Width := paintbox1.Width;
  bmp.Height := paintbox1.Height;
  bmp.PixelFormat := pf24bit;
  bmp.Canvas.Font.Assign(paintbox1.Font);

  SetLength(sinArray, bmp.Width + 1);

  for i := 0 to bmp.Width do
    sinArray[i] := round(sin((i/(pi*10))) * (bmp.Height/ 4) );

  for i := 0 to bmp.Width do
    bmp.Canvas.Pixels[i, bmp.Height div 2 + sinArray[i]] := clSilver;

  bmp.Canvas.Brush.Style := bsClear;
  p := bmp.Canvas.TextHeight('X^_') div 2;
  n := 0;
  for i := 0 to length(sinTxt)-1 do
  begin
    if i+n < bmp.Width then
    begin
      bmp.Canvas.TextOut(
          i+n,
          bmp.Height div 2 + sinArray[i+n] - p,
          SinTxt[i+1]
        );
    end;

    inc(n, bmp.Canvas.TextWidth('X'));
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  sinArray := nil;
  freeandnil(bmp);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  paintbox1.Canvas.Draw(0,0, bmp);
end;

end.
... muss man halt noch animieren....
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat