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.

[Memnarch]

@tURBOpASCAL:
Flackert leider
Liegt wohl am PC beziehungsweise KÖNNTE daran liegen dass dieser rechner eine relativ geringe taktrate hat(3GHZ Hyper dingensbummens, also wahrscheinlich pro virtueller kern 1.5GHZ) oder an XP.

Aber auch hier wieder: wenn ich den Cursor auf crDrag umstelle in Delphi, klappt wieder alles wunderbar >.<

Aber danke

EDIT: auf meinem Homerechner(Win7 64BIt) flackert dein Prog nicht


MFG
Memnarch