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

[alex517]

Ist es nicht einfacher wie schon erwähnt ein TDrawGrid zu verwenden?

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.ExtCtrls, Vcl.StdCtrls;


type
  TChipData = Integer; // oder auch Record ...

  TForm1 = class(TForm)
    DrawGrid1: TDrawGrid;
    Panel1: TPanel;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    procedure DrawGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    FRowCount: Integer;
    FColCount: Integer;
    FChipData: array of array of TChipData;
    procedure LoadChipData;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation
uses
  Math;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FColCount := 100;
  FRowCount := 100;

  SetLength(FChipData, FColCount, FRowCount);

  DrawGrid1.RowCount := FRowCount;
  DrawGrid1.ColCount := FColCount;

  DrawGrid1.FixedRows := 0;
  DrawGrid1.FixedCols := 0;
  DrawGrid1.DefaultColWidth := 6;
  DrawGrid1.DefaultRowHeight := 6;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  SetLength(FChipData, 0, 0);
end;

procedure TForm1.LoadChipData;

  function PosImKreis(x, y, r: Integer): Boolean;
  begin
    Result := Power(x, 2) + Power(y, 2) <= Power(r, 2)
  end;

var
  x, y, q: Integer;
  x0, y0, r: Integer;
begin
  x0 := FColCount div 2;
  y0 := FRowCount div 2;
  r := FRowCount div 2;

  Randomize;

  SetLength(FChipData, 0, 0);
  SetLength(FChipData, FColCount, FRowCount);

  for x := 0 to FColCount -1 do
    for y := 0 to FRowCount -1 do
    begin
      if PosImKreis(x - x0, y - y0, r) then
      begin
        q := Random(100) +1;
        if q > 3 then // damit nicht so viel Ausschuß entsteht ;)
          q := 1;
      end else
        q := 0;

      FChipData[ x,y] := q;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  LoadChipData;
  DrawGrid1.Invalidate;
end;

procedure TForm1.DrawGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
begin
  if InRange(ACol, 0, FColCount) and InRange(ARow, 0, FRowCount) then
    case FChipData[ACol, ARow] of
      0: DrawGrid1.Canvas.Brush.Color := clWhite;
      1: DrawGrid1.Canvas.Brush.Color := clLime;
      2: DrawGrid1.Canvas.Brush.Color := clBlue;
      3: DrawGrid1.Canvas.Brush.Color := clRed;
    end;

  DrawGrid1.Canvas.FillRect(Rect);
end;

procedure TForm1.DrawGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  P: TGridCoord;
begin
  P := DrawGrid1.MouseCoord(X, Y);
  if InRange(P.X, 0, FColCount) and InRange(P.Y, 0, FRowCount) then
    Panel1.Caption := Format('Chip: %d-%d Quality: %d', [P.X, P.Y, FChipData[P.X, P.Y]])
  else
    Panel1.Caption := '';
end;



end.