Performance Problem - viele VCL Komponenten!

[Bummi]

wie wäre es mit sowas, nur als Anregung ....

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TPlatzrecord=Record
    x:Integer;
    y:Integer;
    b:Double;
    h:Double;
    farbe:TColor;
    Nr:Integer;
  End;

  TPlatzrecordArray=Array of TPlatzrecord;

  TForm1 = class(TForm)
    Button1: TButton;
    PaintBox1: TPaintBox;
    procedure Button1Click(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    FPlatzrecordArray:TPlatzrecordArray;
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation
const
 cColor:Array [0..9] of TColor=(clred,clBlue,cllime,clYellow,clmaroon,clSilver,clGray,clNavy,clBlack,clWhite);

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  x,y:Integer;
begin
    SetLength(FPlatzrecordArray,200);
    for x := 0 to 9 do
    for y := 0 to 19 do
      begin
      FPlatzrecordArray[y*10 + x].x := x;
      FPlatzrecordArray[y*10 + x].y := y;
      FPlatzrecordArray[y*10 + x].nr := y*10 + x;
      FPlatzrecordArray[y*10 + x].h  := 0.8;
      FPlatzrecordArray[y*10 + x].b  := 0.7;
      FPlatzrecordArray[y*10 + x].Farbe  := cColor[y div 2];
      end;
    PaintBox1.Invalidate;
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  scale:Double;
  x,y:Integer;
  c:TCanvas;
  r:TRect;
begin
  if High(FPlatzrecordArray)<>199 then Exit;

  Scale := paintBox1.Width / 20;
  if paintBox1.height / 20 < Scale  then Scale := paintBox1.height / 20;
  c := PaintBox1.Canvas;
    for x := 0 to 9 do
    for y := 0 to 19 do
      begin
      r.Left := round(FPlatzrecordArray[y*10 + x].x * scale);
      r.Top := round(FPlatzrecordArray[y*10 + x].y * scale);
      r.Right := r.Left + round(FPlatzrecordArray[y*10 + x].b * scale);
      r.Bottom := r.Top + round(FPlatzrecordArray[y*10 + x].h * scale);
      c.Brush.Color := FPlatzrecordArray[y*10 + x].Farbe;
      c.FillRect(r);
      c.Rectangle(r.Left,r.Top,r.Right,r.Bottom);
      c.TextOut(r.Left + (r.Right - r.Left - c.TextWidth(IntToStr(FPlatzrecordArray[y*10 + x].nr))) div 2,
                r.top + (r.bottom - r.top - c.TextHeight(IntToStr(FPlatzrecordArray[y*10 + x].nr))) div 2,
                IntToStr(FPlatzrecordArray[y*10 + x].nr));

      end;



end;

end.