Einzelnen Beitrag anzeigen

Benutzerbild von Memnarch
Memnarch

Registriert seit: 24. Sep 2010
737 Beiträge
 
#15

AW: Cursor Flickert über TImage

  Alt 8. Dez 2010, 08:34
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

Geändert von Memnarch ( 8. Dez 2010 um 08:49 Uhr)
  Mit Zitat antworten Zitat