DrawCell vom Drawgrid belegt ganzes Programm

[BeBored]

Hallo,

ich sitze mal wieder an meinem Bahnprogramm und möchte eine wichtige Optimierung durchführen und hoffe ihr könnt mir helfen.
Ich zeichne folgt auf ein Drawgrid:

Delphi-Quellcode:

procedure TfrmMain.gridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  I: Integer;
begin
  for I := Low(GleisArray) to High(GleisArray) do
  begin
    if GleisArray[i].Art = 'Text' then
      Gleis.Text(GleisArray[i].x, GleisArray[i].y, GleisArray[i].Feldtext);
    if GleisArray[i].Art = 'Gerade' then
      Gleis.Gerade(GleisArray[i].x, GleisArray[i].y, GleisArray[i].Gesetzt);
    if GleisArray[i].Art = 'WeicheOL' then
      Gleis.WeicheOL(GleisArray[i].x, GleisArray[i].y, GleisArray[i].Gesetzt);
    if GleisArray[i].Art = 'WeicheOLG' then
      Gleis.WeicheOLG(GleisArray[i].x, GleisArray[i].y, GleisArray[i].Gesetzt);
    if GleisArray[i].Art = 'WeicheOR' then
      Gleis.WeicheOR(GleisArray[i].x, GleisArray[i].y, GleisArray[i].Gesetzt);
    if GleisArray[i].Art = 'WeicheORG' then
      Gleis.WeicheORG(GleisArray[i].x, GleisArray[i].y, GleisArray[i].Gesetzt);
    if GleisArray[i].Art = 'WeicheUL' then
      Gleis.WeicheUL(GleisArray[i].x, GleisArray[i].y, GleisArray[i].Gesetzt);
// und so weiter...

GleisArray ist ein Record

Delphi-Quellcode:

TGleisrecord = packed record
    x: Integer;
    y: Integer;
    Feldtext: string;
    Art: string;
    Gesetzt: Boolean;
  end;

und wird so gefüllt:

Delphi-Quellcode:

while not DataModule1.query2.Eof do
  begin
    {==============================================================================
    Das Array wird mit den einzelnen Feldern eingelesen.
    Das Array beginnt bei 1, da es nachher einfacher ist beim auslesen.
    ==============================================================================}
    GleisArray[i].x := DataModule1.query2.FieldByName('x').AsInteger;
    GleisArray[i].y := DataModule1.query2.FieldByName('y').AsInteger;
    GleisArray[i].Feldtext := DataModule1.query2.FieldByName('Feldtext').AsString;
    GleisArray[i].Art := DataModule1.query2.FieldByName('Art').AsString;
    GleisArray[i].Gesetzt := DataModule1.query2.FieldByName('Gesetzt').AsBoolean;
    Inc(i);
    {==============================================================================
    Weiter zum nächsten Datensatz.
    ==============================================================================}
    DataModule1.query2.Next;

Die Klasse Gleis beinhaltet die Bitmaps. Es ist alles als Bitmap vorhanden, ausser dem Text der wird "live" erzeugt.

Delphi-Quellcode:

// Die Gleise
procedure TGleisPic.DiagonalLinks(Spalte, Reihe: Integer; Gruen: Boolean);
var
  p: TRect;
begin
  p := Can.CellRect(Spalte, Reihe);
  if Gruen then
    BitBlt(Can.Canvas.Handle, p.Left, p.Top, p.Right - p.Left, p.Bottom - p.Top, Gleise.DiagonalLinks_G.Canvas.Handle, 0, 0, SRCCOPY)
  else
    BitBlt(Can.Canvas.Handle, p.Left, p.Top, p.Right - p.Left, p.Bottom - p.Top, Gleise.DiagonalLinks_S.Canvas.Handle, 0, 0, SRCCOPY);
end;

// und der Text
procedure TGleisPic.Text(Spalte, Reihe: Integer; Text: string);
var
  p: TRect;
begin
  SetBkMode(Can.Canvas.Handle, OPAQUE);
  Can.Canvas.Font.Color := clBlack;
  Can.Canvas.Font.Size := 7;
  Can.Canvas.Font.Style := [];
  Can.Canvas.Font.Name := 'Arial';
  p := Can.CellRect(Spalte, Reihe);
  Can.Canvas.TextOut(p.Left + 5, p.Top, Text);
end;

Das Bild wird auch fix gezeichnet, aber so schnell hintereinander das die gesammte Anwendung völlig belegt ist.
Ich hatte das ganze auch mit ProcessMessages versucht, aber dann ist das Programm sehr anfällig für Abstürze.

Hat jemand einen Vorschlag wie ich das ganze optimieren oder vielleicht ganz anders angehen könnte?