this slowpoke moves

Render Canvas Font Scroller

var
  Form1: TForm1;
  bmp: TBitmap;
  Time, xx: Integer;
  
//

procedure TForm1.Render(Sender: TObject; var Done: Boolean);
begin
  Time := (Time + 1) mod 100;
  if Time = 0 then
    begin
      Inc(xx);
      Canvas.lock;
      with Bmp.Canvas do
        begin
          Brush.Color := clBlack;
          Brush.Style := bsSolid;
          FillRect(bounds(0, 0, Width, Height));
          Font.Name := 'Arial black';
          Font.Size := Form1.Height div 3;
          Font.Color := clwhite;
          Brush.Style := bsClear;
          TextOut(Form1.Width - xx, 0, 'Yet another flickerless text scroller! Made in delphi!');
        end;
      Application.ProcessMessages;
      Canvas.draw(0, 0, bmp);
      // canvas.CopyRect(bounds(0,0,width,height),offbmp.canvas,bounds(0,0,width,height));
      // canvas.bitbl
    end;
  Done := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  bmp := TBitmap.Create;
  bmp.Width := Form1.Width;
  bmp.Height := Form1.Height;

  with Bmp do
    begin
      Canvas.Brush.Color := clBlack;
      Canvas.FillRect(bounds(0, 0, Width, Height));
    end;

  Application.OnIdle := render;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  bmp.Width := Form1.Width;
  bmp.Height := Form1.Height;
  with Bmp do
    begin
      Canvas.Brush.Color := clBlack;
      Canvas.FillRect(bounds(0, 0, Width, Height));
    end;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate