Cursor Flickert über TImage

[turboPASCAL]

Delphi-Quellcode:

/// ... ///

// ohne Paintbox lässr sich recht gut machen
// Mouseevents haben dann halt das nachsehen...

procedure TForm1.FormCreate(Sender: TObject);
begin
  randomize;
  PaintIdx := 0;

  FBuffer[0] := TBitMap.Create;
  try
    FBuffer[0].PixelFormat := pf24Bit;
    FBuffer[0].Width  := 320;
    FBuffer[0].Height := 320;

    // Width := 1280;  // mit grossen "Bildern" wird es immer mehr Probleme
    // Height := 720;  // geben da die GDI immer mehr Zeit benötigen wird
                       // um diese auf den "Bildfschirm" zu kopieren .
                       // Hier währe es besser auf OpenGL oder DirectX
                       // auszuweichen.

    FBuffer[1] := TBitMap.Create;
    try
      FBuffer[1].Assign(FBuffer[1]);


      if ASSIGNED(Timer1) then
      begin
        Timer1.Interval := 25;    // weniger 25 ms lohnt nicht ! Gab schon mal ein
                                  // Thread zu diesem Thema...
        Timer1.Enabled := True;
      end;
    except
      raise Exception.CreateFmt('Zong ! %s', ['Fehler meim erz. des Bitmaps II']);
    end;

  except
    raise Exception.CreateFmt('Zong ! %s', ['Fehler meim erz. des Bitmaps I']);
  end;


  // --- setup - "move the Quad" ---
  x := FBuffer[0].Width div 2;
  y := FBuffer[0].Height div 2;
  vx := 5;
  vy := 4;
  // -------------------------------
end;

procedure TForm1.FormDestroy(Sender: TObject);
var i: integer;
begin
  Timer1.Enabled := False;

  for i := 0 to 1 do
    if ASSIGNED(FBuffer[i]) then FBuffer[i].Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  // swap the Paintindex
  PaintIdx := 1 - PaintIdx;


  // Paint your Stuff to the Offscreenbitmap
  PaintToBitmap;


  // draw your work //

  // ohne Paintbox...
  Self.Canvas.Draw(0,0, FBuffer[PaintIdx]);
  // ...möglicher weise muss ohne Paintbox noch 'n invalidate hier her...


  // oder mit Paitbox:
  // PaintBox1.Canvas.Draw(0,0, FBuffer[PaintIdx])

  Self.Caption := format('Paint to: %d - View %d', [PaintIdx, 1-PaintIdx]);
end;

procedure TForm1.PaintToBitmap;
begin
  // --- move the Quad ---
  inc(x, vx);
  inc(y, vy);

  if (x < 0) or (x+100 > FBuffer[0].Width) then vx := vx * -1;
  if (y < 0) or (y+100 > FBuffer[0].Height) then vy := vy * -1;
  // ---------------------

  with FBuffer[1-PaintIdx] do
  begin
    Canvas.Brush.Color := clWhite;
    Canvas.FillRect(FBuffer[0].Canvas.ClipRect);
    Canvas.Brush.Color := clGreen;
    Canvas.FillRect(RECT(x, y, x+ 100, y+100));
  end;
end;

end.