AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Cursor Flickert über TImage

Ein Thema von Memnarch · begonnen am 3. Dez 2010 · letzter Beitrag vom 8. Dez 2010
 
Benutzerbild von turboPASCAL
turboPASCAL

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

AW: Cursor Flickert über TImage

  Alt 8. Dez 2010, 15:14
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.

Angehängte Dateien
Dateityp: zip TestMe.zip (206,0 KB, 3x aufgerufen)
Matti
Meine Software-Projekte - Homepage - Grüße vom Rüsselmops -Mops Mopser
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 08:58 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz