Cursor Flickert über TImage

[Memnarch]

eije, hat den keiner mehr ne Idee

[Memnarch]

Entschuldigt dass ich nocheinmal Pushe, aber ich habe jetzt etwas wirklich merkwürdiges festgestellt.

Als erstes mal bin ich auf PaintBox umgestiegen. Ich geb mich geschlagen, dass ding ist schneller^^.

Zu meinem Cursorflackern(Jetzt wirds komisch):

Nutze ich crDefault /crArrow / crHandPoint(bei der form eingestellt) dan flackert es.

Nutze ich irgendeinen anderen Cursor flackert es nicht

Das will mir gerade überhaupt nicht in den Kopf.

PS: Nutze Delphi 2010 (und wie bereits erwähnt XP)

Kann sich einer erklären wie dass jetzt kommt? Eventuel sollte ich mal nen ganz eigenen cursor ausprobieren ob der flackert o.O

EDIT: OK ich korrigiere mich, von den anderen geht auch nicht jeder aber als schönes beispiel: crDrag/crMultidrag funzen ohne Flackern o.O.

EDIT2: Kann es sein das sich gerade meinen eigenen Beitrag gemeldet habe?(>.<..verklickt)

MFG
Memnarch

[Blup]

Zitat von Memnarch:

EDIT: ich hab ne Idee, jemand von euch schreibt ne DemoApp mit ner TPAintBOx, bei der der Cursor nicht flackert. Packts für mich inen rar und läds hoch.
Dann könnte ich mal austesten ob mein prog oder windows drans chuld ist.

Hab eine bessere Idee, du stellst uns den Quelltext einer Minianwendung bereit, die bei dir dieses Flackern hervorruft. Wir schauen ob das bei uns auch auftritt und was man dagegen tun kann.

[Memnarch]

das ist natürlich auch eine idee.
Kümmer mich drum wenn ich morgen wieder an Delphi sitze(Arbeitsplatz).

[Memnarch]

So hier wie versprochen der quelltext(mini TestProgramm).
Verzeit wenn ich alles hier reinkopiere, aber muss so sein .

Unit1.Pas

Code:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    FBuffer: TBitMap;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Timer1.Enabled := False;
  FBuffer.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FBuffer := TBitMap.Create;
  FBuffer.Width := PaintBox1.Width; //1280
  FBuffer.Height := PaintBox1.Height; //720
  Timer1.Enabled := True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  FBuffer.Canvas.Brush.Color := clWhite;
  FBuffer.Canvas.FillRect(FBuffer.Canvas.ClipRect);
  FBuffer.Canvas.Brush.Color := clGreen;
  FBuffer.Canvas.Rectangle(20, 20, 100, 100);
  BitBlt(PaintBox1.Canvas.Handle, 0, 0, PaintBox1.Width, PaintBox1.Height, FBuffer.Canvas.Handle, 0, 0, SRCCOPY);
end;

end.

PS: source datei selbst darf nicht raus, die zeilen hier zum nachstellen des problems ausnahmsweise mal. Ansonsten müsst ihr für gewöhnlich auf testcode meinerseits verzichten bis ich auch zuhause delphi habe

EDIT: und hat nebenbei einer ne Idee warum eine Cursors flackern und manche nicht?!

EDIT2: Timer löst 20 mal pro sekunde aus.

MFG
Memnarch

[Bummi]

Bei mir Delphi XE, Server 2008 R2, I7-920 , GTX 280M
flackert nichts.

[Memnarch]

Merkwürdig o.O.

Aber wie gesagt: ES gibt auch Cursor symbole die NICHT flackern...und dass ist so richtig komisch >.<
Ich nutze Imo crDrag als Cursor, flackert auch nicht.


MFG
Memnarch

[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