Auf's Neue: Performance bei vielen VCL Komponenten - anderer Ansatz ?

[Zacherl]

Hier mal mein auf die Schnelle gebastelter Ansatz:

Delphi-Quellcode:

type
  TChipData = record
  public
    Quality: Integer;
    HasFocus: Boolean;
  end;

var
  ChipData: array[0..29] of array[0..29] of TChipData;
  FocusedChip: TPoint;

procedure TForm2.FormCreate(Sender: TObject);
var
  I, J: Integer;
begin
  FocusedChip := Point(-1, -1);
  // Generate random chip distribution and qualities
  Randomize;
  FillChar(ChipData, SizeOf(ChipData), #0);
  for I := Low(ChipData) to High(ChipData) do
  begin
    for J := Low(ChipData[I]) to High(ChipData[I]) do
    begin
      ChipData[I][J].Quality := Random(4);
    end;
  end;
end;

const
  CHIPSIZE = 12; // The width and height of a single chip rect in pixels

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  CX, CY: Integer;
begin
  CX := X div CHIPSIZE;
  CY := Y div CHIPSIZE;
  if (CY <= High(ChipData)) and (CX <= High(ChipData[0])) then
  begin
    if (FocusedChip.X <> CX) or (FocusedChip.Y <> CY) then
    begin
      if (FocusedChip.X >= 0) and (FocusedChip.Y >= 0) then
      begin
        ChipData[FocusedChip.Y][FocusedChip.X].HasFocus := false;
        MouseLeave(FocusedChip.X, FocusedChip.Y);
        FocusedChip := Point(-1, -1);
      end;
      FocusedChip.X := CX;
      FocusedChip.Y := CY;
      ChipData[CY][CX].HasFocus := true;
      MouseEnter(CX, CY);
    end;
  end else if (FocusedChip.X >= 0) and (FocusedChip.Y >= 0) then
  begin
    ChipData[FocusedChip.Y][FocusedChip.X].HasFocus := false;
    MouseLeave(FocusedChip.X, FocusedChip.Y);
    FocusedChip := Point(-1, -1);
  end;
end;

procedure TForm2.FormPaint(Sender: TObject);
var
  X, Y: Integer;
  R: TRect;
begin
  Canvas.Brush.Color := Color;
  Canvas.FillRect(ClientRect);
  for Y := Low(ChipData) to High(ChipData) do
  begin
    for X := Low(ChipData[Y]) to High(ChipData[Y]) do
    begin
      case ChipData[Y][X].Quality of
        0: Canvas.Brush.Color := clWhite;
        1: Canvas.Brush.Color := clGreen;
        2: Canvas.Brush.Color := clBlue;
        3: Canvas.Brush.Color := clRed;
      end;
      R := Rect(X * CHIPSIZE, Y * CHIPSIZE, X * CHIPSIZE + CHIPSIZE,
        Y * CHIPSIZE + CHIPSIZE);
      Canvas.FillRect(R);
      if (ChipData[Y][X].HasFocus) then
      begin
        Canvas.TextRect(R, R.Left, R.Top, IntToStr(ChipData[Y][X].Quality));
      end;
    end;
  end;
end;

procedure TForm2.MouseEnter(CX, CY: Integer);
begin
  // This is a custom method! NOT the OnMouseEnter event of the form
  RepaintChip(CX, CY);
end;

procedure TForm2.MouseLeave(CX, CY: Integer);
begin
  // This is a custom method! NOT the OnMouseLeave event of the form
  RepaintChip(CX, CY);
end;

procedure TForm2.RepaintChip(CX, CY: Integer);
var
  R: TRect;
begin
  R := Rect(CX * CHIPSIZE, CY * CHIPSIZE, CX * CHIPSIZE + CHIPSIZE,
    CY * CHIPSIZE + CHIPSIZE);
  InvalidateRect(WindowHandle, R, false);
end;

Die Daten zu den einzelnen Chips befinden sich im 2-dimensionalen ChipData Array (ChipData[Y][X] erlaubt den Zugriff auf einen spezifischen Chip). Die Größe des Arrays ist zu testzwecken statisch, kann aber auch ohne Probleme dynamisch festgelegt werden.

Da du bei einem MouseEnter und MouseLeave neu zeichnen willst (Text anzeigen oder wieder entfernen), machen die Events momentan nichts weiter, als das OnPaint Event des Formulars neu auszulösen. Um Flackern zu vermeiden, benutze ich hierfür InvalidateRect.