this slowpoke moves

Draw Jumping Letters

type
  TLettre = record
     Lettre: Char;
     Sp,
     X,
     Y,
     MinH,
     MaxH: Integer;
     sens: Boolean;
  end;

  TPhrase = array of TLettre;
	var Phrase: TPhrase;
    
//
    
procedure TForm1.InitGraphPhrase(const Ph: TPhrase);
var i: Integer;
begin
  for i:= Low(Ph) to High(Ph) do
  with Ph[i] do
  begin
    PaintBox1.Canvas.Font.Color:= clBtnFace;
    PaintBox1.Canvas.TextOut(X, Y, string(Lettre));
  end;
end;

procedure TForm1.TracePhrase(const Ph: TPhrase);
var i: Integer;
begin
  for i:= Low(Ph) to High(Ph) do
  with Ph[i] do
  begin
    PaintBox1.Canvas.Font.Color:= clBtnFace;
    PaintBox1.Canvas.TextOut(X, Y, string(Lettre));
    PaintBox1.Canvas.Font.Color:= 1+Random(255);
    PaintBox1.Canvas.TextOut(X, Y, string(Lettre));
    if not Sens then
    begin
      if Y>=MinH then Y:= Y-sp
                else Sens:= not Sens;
    end
    else
    if Y<=MaxH then Y:= Y+sp
              else Sens:= not Sens;
  end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  Timer2.enabled := False;
  Timer1.enabled := True;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PaintBox1.Canvas.Font.Size:= 24;
  Randomize;
  CreerPhrase(UpperCase('DelphiFR c''est COol'), Phrase);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  TracePhrase(Phrase);
end;

procedure TForm1.CreerPhrase(const LaPhrase: string; var Tab: TPhrase);
var i: integer;
    DebX: Integer;
begin
  SetLength(Tab, Length(LaPhrase));
  DebX:= 10;
  for i:= 0 to High(Tab) do
  begin
    Tab[i].Lettre:= LaPhrase[i+1];
    Tab[i].Sp:= 1;
    Tab[i].X:= DebX;
    Tab[i].Y:= Random(30)+10;
    Tab[i].MinH:= 10;
    Tab[i].MaxH:= 40;
    Tab[i].sens:= False;
    DebX:= DebX + 10;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  finalize(Phrase);
end;
Beispiel :
procedure TForm1.Button1Click(Sender: TObject);
begin
  InitGraphPhrase(Phrase);
  CreerPhrase(UpperCase(Edit1.Text), Phrase);
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate