Image - Keine Reaktion

[Luckie]

So würde ich es amchen:

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private declarations }
    MyBmp: TBitmap;
    Counter: Cardinal;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Counter := 0;
  MyBmp := TBitmap.Create;
  MyBmp.Canvas.Brush.Color := clGreen;
  MyBmp.Width := Width;
  MyBmp.Height := Height;
  MyBmp.Canvas.Font.Name := 'Tahoma';
  MyBmp.Canvas.Font.Size := 36;
  MyBmp.Canvas.Font.Color := clRed;
  MyBmp.Canvas.Font.Style := [fsBold];
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(MyBmp);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  MyBmp.Width := 0;
  MyBmp.Height := 0;
  MyBmp.Width := Width;
  MyBmp.Height := Height;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  rect: TRect;
begin
  Inc(Counter);
  rect := PaintBox1.BoundsRect;
  DrawText(MyBmp.Canvas.Handle, PChar(IntToStr(Counter)), length(IntToStr(Counter)), rect, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
  InvalidateRect(Handle, nil, False);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  BitBlt(PaintBox1.Canvas.Handle, 0, 0, PaintBox1.Width, PaintBox1.Height, MyBmp.Canvas.Handle, 0, 0, SRCCOPY);
end;