Hallo,

für die Anzeige eines Arrays von Bauteilen verwende ich ein Array von VCL TLabel.

Ich bräuchte nun mal Hilfe wie ich das Erzeugen eines Arrays von VCL TLabel zur Laufzeit beschleunigen könnte.
Insbesondere das Positionieren der TLabel dauert extrem lange (z.B. 57 Reihen * 78 Bauteile ca. 1/2 Stunde!).

Ich weiß momentan nicht was ich falsch mache...

Hier der Quelltext:

zusammenfalten · markieren

Delphi-Quellcode:

unit SubstratPanelThreadUnit;

interface

uses
  System.Classes,
  System.SysUtils,
  System.Threading,
  Vcl.StdCtrls,
  Vcl.Graphics,
  Vcl.Forms,
  Vcl.Dialogs,
  uOrderInterfaces,
  uAutomatic;

type

  TSubstratPanelThread = class(TThread)
  private
    { Private-Deklarationen }
    FSubPanelXAnzahl : Integer; // Anzahl Chips pro Streifen
    FSubPanelYAnzahl : Integer; // Anzahl Streifen pro Substrat
    FSubPanelXSize, FSubPanelYSize : Integer; // Grösse eines Widerstandes
    FSubPanelXOffset, FSubPanelYOffset : Integer; // Startpunkt X1/Y1
    FSubPanelXAbstand, FSubPanelYAbstand : Integer; // Abstand zwischen Widerstände
    FActXCoord, FActYCoord : Integer; // Aktuelle X/Y Koordinate für ein Widerstand
    FChuckTemperatur : Integer; // Aktuelle Chucktemperatur
    FOrder: TOrder;
    FAutomaticMainState : TMainState;
    procedure SAnzeigeCreateEinzelChip;
    procedure SAnzeigeResetEinzelChip;
    procedure SAnzeigeNotSupported;
    procedure CheckOrderStatus;
  protected
    procedure Execute; override;
  public
    { Public-Deklaration }
    constructor Create;
  end;

var
  SubstratPanelThread : TSubstratPanelThread; // Benötigt als Referenz

implementation

uses
  main,
  uOrderConsts,
  uHelpers,
  WartUnit,
  VarUnit,
  ConstUnit,
  IniOptionsUnit;

constructor TSubstratPanelThread.Create;
begin
  Forder.Status := osIdle;
  FreeOnTerminate := True; // Bei Programmende dann alles freigeben
  inherited Create(False); // Thread wird bei Create sofort gestartet
end;

{---------------------------------------------------------------}
{ procedure Execute => Thread ausführen (UpdateSubstratAnzeige) }
{---------------------------------------------------------------}
procedure TSubstratPanelThread.Execute;
begin

  // Thread läuft in Endlosschleife
  //===============================
  repeat

    TSubstratPanelThread.Synchronize(NIL, CheckOrderStatus);

    if (gbSubstratAnzeigeInit) or
       (gbSubstratAnzeigeReset and
        (FOrder.Status = osConfirmed) and
        ((FAutomaticMainState = msSetup) or
         (FAutomaticMainState = msStarted))) then
    begin

      gbSubstratAnzeigeReady := False; // Wird "TRUE" wenn INIT/RESET fertig ist

      if gbSubstratAnzeigeInit then
      begin

        TSubstratPanelThread.Synchronize(NIL,SAnzeigeCreateEinzelChip);
        gbSubstratAnzeigeInit := False; // Weiteren Aufruf unterdrücken!

      end else
      begin

        case Forder.SubstrateSize of

          Size0402:
            begin
              FSubPanelXAnzahl := NUMBER_OF_CHIPS_PER_STRIP_0402;
              FSubPanelYAnzahl := NUMBER_OF_STRIPS_PER_SUBSTRATE_0402;
              FSubPanelXSize := PIXELSIZE_X_PER_CHIP_0402;
              FSubPanelYSize := PIXELSIZE_Y_PER_CHIP_0402;
              FSubPanelXOffset := PIXELOFFSET_X_CHIP_0402;
              FSubPanelYOffset := PIXELOFFSET_Y_CHIP_0402;
              FSubPanelXAbstand := PIXELABSTAND_X_CHIP_0402;
              FSubPanelYAbstand := PIXELABSTAND_Y_CHIP_0402;
              gbSubstratAnzeigeIsActive := IniOptions.Prober0402DisplayActive;
            end;

          Size0603:
            begin
              FSubPanelXAnzahl := NUMBER_OF_CHIPS_PER_STRIP_0603;
              FSubPanelYAnzahl := NUMBER_OF_STRIPS_PER_SUBSTRATE_0603;
              FSubPanelXSize := PIXELSIZE_X_PER_CHIP_0603;
              FSubPanelYSize := PIXELSIZE_Y_PER_CHIP_0603;
              FSubPanelXOffset := PIXELOFFSET_X_CHIP_0603;
              FSubPanelYOffset := PIXELOFFSET_Y_CHIP_0603;
              FSubPanelXAbstand := PIXELABSTAND_X_CHIP_0603;
              FSubPanelYAbstand := PIXELABSTAND_Y_CHIP_0603;
              gbSubstratAnzeigeIsActive := True;
            end;

          Size0805:
            begin
              FSubPanelXAnzahl := NUMBER_OF_CHIPS_PER_STRIP_0805;
              FSubPanelYAnzahl := NUMBER_OF_STRIPS_PER_SUBSTRATE_0805;
              FSubPanelXSize := PIXELSIZE_X_PER_CHIP_0805;
              FSubPanelYSize := PIXELSIZE_Y_PER_CHIP_0805;
              FSubPanelXOffset := PIXELOFFSET_X_CHIP_0805;
              FSubPanelYOffset := PIXELOFFSET_Y_CHIP_0805;
              FSubPanelXAbstand := PIXELABSTAND_X_CHIP_0805;
              FSubPanelYAbstand := PIXELABSTAND_Y_CHIP_0805;
              gbSubstratAnzeigeIsActive := True;
            end;

          Size1206:
            begin
              FSubPanelXAnzahl := NUMBER_OF_CHIPS_PER_STRIP_1206;
              FSubPanelYAnzahl := NUMBER_OF_STRIPS_PER_SUBSTRATE_1206;
              FSubPanelXSize := PIXELSIZE_X_PER_CHIP_1206;
              FSubPanelYSize := PIXELSIZE_Y_PER_CHIP_1206;
              FSubPanelXOffset := PIXELOFFSET_X_CHIP_1206;
              FSubPanelYOffset := PIXELOFFSET_Y_CHIP_1206;
              FSubPanelXAbstand := PIXELABSTAND_X_CHIP_1206;
              FSubPanelYAbstand := PIXELABSTAND_Y_CHIP_1206;
              gbSubstratAnzeigeIsActive := True;
            end;

          else
            begin
              gbSubstratAnzeigeIsActive := False; // !! BAUGRÖSSE UNBEKANNT !!
            end;

        end; //case

        if gbSubstratAnzeigeIsActive then
        begin

          TSubstratPanelThread.Synchronize(NIL,SAnzeigeResetEinzelChip);

        end else
        begin

          TSubstratPanelThread.Synchronize(NIL,SAnzeigeNotSupported);

        end; //if (Baugrösse ist bekannt)

        gbSubstratAnzeigeReset := False; // Weiteren Aufruf unterdrücken!

      end; //if (Substratanzeige initialisieren oder zurücksetzen)

      {Buttons werden jetzt freigegeben}
      gbSubstratAnzeigeReady := True;

    end; //if (soll etwas mit der Substratanzeige gemacht werden)

    THelpers.Delay(1000);

  until Terminated;

end; //...Execute
{---------------------------------------------------------------}

{---------------------------------------------------------------}
procedure TSubstratPanelThread.CheckOrderStatus;
begin
  FAutomaticMainState := Automatic.MainState;
  Forder := Mainform.Order;
end;
{---------------------------------------------------------------}

{---------------------------------------------------------------}
procedure TSubstratPanelThread.SAnzeigeCreateEinzelChip;
var
  XHilf, YHilf : Integer;
begin

  WartForm.Open('Erstelle Substratanzeige',5,True);

  // Am Anfang ist Baugrösse unbekannt -> Neu erstellen
  //===================================================
  with MainForm.SubstratAnzeigeHeader do
  begin
    Caption := 'Erstelle Anzeige - Bitte warten!';
    Color := clRed; Font.Color := clWhite;
  end;

  // Erst mal nur Baugrössen größer-gleich "0603" unterstützen !!
  // Gesamtes Array 100,100 dauert extrem lange (Mehrere Minuten !!!)
  // bis alle TLabels definiert sind ???!!!
  // Substratanzeige "0402 optional EIN/AUS!
  //==========================================================
  if IniOptions.Prober0402DisplayActive then
  begin
    FSubPanelXAnzahl := NUMBER_OF_CHIPS_PER_STRIP_0402;
    FSubPanelYAnzahl := NUMBER_OF_STRIPS_PER_SUBSTRATE_0402;
  end else
  begin
    FSubPanelXAnzahl := NUMBER_OF_CHIPS_PER_STRIP_0603;
    FSubPanelYAnzahl := NUMBER_OF_STRIPS_PER_SUBSTRATE_0603;
  end;

  for YHilf := 1 to FSubPanelYAnzahl do
  //TParallel.For(1,FSubPanelYAnzahl,procedure (YHilf: Integer)
    begin
      WartForm.Step;
      with MainForm.SubstratAnzeigePanel do
      begin
        Caption := Format('Prepare Row %d',[YHilf]);
        Update;
      end;
      for XHilf := 1 to FSubPanelXAnzahl do
      //TParallel.For(1,FSubPanelXAnzahl,procedure (XHilf: Integer)
        begin
          with MainForm do
          begin
            ShowEinzelchip.Anzeige[XHilf,YHilf] :=
              TLabel.Create(SubstratAnzeigePanel);
            with ShowEinzelchip.Anzeige[XHilf,YHilf] do
            begin
              Name := Format('ChipX%dY%d',[XHilf,YHilf]);
              Parent := SubstratAnzeigePanel;
              Caption := '';
              {Grund Position und Größe eines Widerstandes}
              //Left := SubXPos*2; Width := 2;
              //Top := SubYPos*2; Height := 2;
              //Transparent := False;
              //Visible := False;
            end;
          end;
          //Application.ProcessMessages; // DAUERT HIER ZU LANGE !!
        end;
      // end
      //); //TParallel.For. XHILF
      //Application.ProcessMessages;
  // end
  //); //TParallel.For. YHILF
    end;

  with MainForm do
  begin
    SubstratAnzeigePanel.Caption := 'Anzeige Offline';
    with SubstratAnzeigeHeader do
    begin
      Caption := 'Substratanzeige Offline';
      Color := clSilver; Font.Color := clWindowText;
    end;
  end;

  WartForm.Close;

end; //...SAnzeigeCreateEinzelChip
{---------------------------------------------------------------}

{---------------------------------------------------------------}
procedure TSubstratPanelThread.SAnzeigeResetEinzelChip;
var
  XHilf, YHilf : Integer;
  XMerk, YMerk : Integer;
  AnzahlStrips, AnzahlChips : Integer;
begin

  with MainForm.SubstratAnzeigePanel do
  begin
    Caption := ''; // "Anzeige Offline" AUS
  end;

  {Ausblenden nicht genutzte Widerstände wg. Wechsel Baugröße}
  if (FOrder.SubstrateSize <> gSubstratAnzeigeBGMerken) and
     (gSubstratAnzeigeBGMerken <> SizeUndefined) then
  begin

    WartForm.Open('Lösche Substratanzeige',10,True);

    with MainForm.SubstratAnzeigeHeader do
    begin
      Caption := 'Lösche Anzeige - Bitte warten!';
      Color := clRed; Font.Color := clWhite;
    end;

    {Alle TLabel unsichtbar die ausserhalb aktueller Baugrösse liegen}
    XMerk := FSubPanelXAnzahl + 1;
    YMerk := FSubPanelYAnzahl + 1;

    // Substratanzeige "0402 optional EIN/AUS!
    //========================================
    if IniOptions.Prober0402DisplayActive then
    begin
      AnzahlStrips := NUMBER_OF_STRIPS_PER_SUBSTRATE_0402;
      AnzahlChips := NUMBER_OF_CHIPS_PER_STRIP_0402;
    end else
    begin
      AnzahlStrips := NUMBER_OF_STRIPS_PER_SUBSTRATE_0603;
      AnzahlChips := NUMBER_OF_CHIPS_PER_STRIP_0603;
    end;

    for YHilf := 1 to AnzahlStrips do
    begin
      if YHilf < YMerk then
      begin
        for Xhilf := XMerk to AnzahlChips do
        begin
          with MainForm do
          begin
            ShowEinzelchip.Anzeige[XHilf,YHilf].Visible := False;
          end;
        end;
      end else
      begin
        for XHilf := 1 to AnzahlChips do
        begin
          with MainForm do
          begin
            ShowEinzelchip.Anzeige[XHilf,YHilf].Visible := False;
          end;
          //Application.ProcessMessages; // DAUERT HIER ZU LANGE !!
        end;
      end;
      Application.ProcessMessages;
      WartForm.Step;
      WartForm.Step;
    end;

    WartForm.Close;

  end;

  with MainForm.SubstratAnzeigeHeader do
  begin
    Caption := 'Reset Anzeige - Bitte warten!';
    Color := clRed; Font.Color := clWhite;
  end;

  if (FOrder.SubstrateSize <> gSubstratAnzeigeBGMerken) then
  begin

    WartForm.Open('Initialisiere Substratanzeige',10,True);

    for YHilf := 1 to FSubPanelYAnzahl do // Ausfüllen Array Unten -> Oben
    begin
      for XHilf := 1 to FSubPanelXAnzahl do // Ausfüllen Array Links -> Rechts
      begin
        FActYCoord := FSubPanelYOffset +
                      (FSubPanelYAnzahl-YHilf)*(FSubPanelYSize+FSubPanelYAbstand);
        FActXCoord := FSubPanelXOffset +
                      (XHilf-1)*(FSubPanelXSize+FSubPanelXAbstand);
        with MainForm.ShowEinzelchip.Anzeige[XHilf,YHilf] do
        begin
          //**********************************************************************
          // Anzeige umsetzen wegen Wechsel der Baugröße
          //**********************************************************************
          Color := clBtnFace; //war "clGray" - das ist zu dunkel!
          {Position und Größe eines Widerstandes -> Wechsel Baugröße}
          Left := FActXCoord; Width := FSubPanelXSize;
          Top := FActYCoord; Height := FSubPanelYSize;
          Transparent := False;
          Visible := True;
        end;
        //Application.ProcessMessages; // DAUERT HIER ZU LANGE !!
      end; // ActXCoord
      Application.ProcessMessages;
      WartForm.Step;
      WartForm.Step;
    end; // ActYCoord

    WartForm.Close;

  end else
  begin

    for YHilf := 1 to FSubPanelYAnzahl do // Ausfüllen Array Unten -> Oben
    begin
      for XHilf := 1 to FSubPanelXAnzahl do // Ausfüllen Array Links -> Rechts
      begin
        with MainForm.ShowEinzelchip.Anzeige[XHilf,YHilf] do
        begin
          //**********************************************************************
          // Anzeige nur zurücksetzen für nächstes Substrat
          //**********************************************************************
          Color := clBtnFace; //war "clGray" - das ist zu dunkel!
        end;
        //Application.ProcessMessages; // DAUERT HIER ZU LANGE !!
      end; // ActXCoord
      Application.ProcessMessages;
    end; // ActYCoord

  end;

  // Baugröße merken !
  gSubstratAnzeigeBGMerken := FOrder.SubstrateSize;

  with MainForm.SubstratAnzeigeHeader do
  begin
    if (Automatic.MainState=msStarted) then
    begin
      if gbTK2ElimHotAndCold then
      begin
        if gbTK2ColdMeasExecuting then
        begin
          Caption := Format('L:%s S:%d T:%d°C',
                            [Automatic.TK2LotNrCOLD,
                             Automatic.SubstrateNr,
                             round(Automatic.CurrentTemperature)]);
        end else
        begin
          Caption := Format('L:%s S:%d T:%d°C',
                            [Automatic.TK2LotNrWARM,
                             Automatic.SubstrateNr,
                             round(Automatic.CurrentTemperature)]);
        end;
      end else
      begin
        Caption := Format('L:%s S:%d T:%d°C',
                          [FOrder.Lot,
                           Automatic.SubstrateNr,
                           round(Automatic.CurrentTemperature)]);
      end;
    end else
    begin
      Caption := 'Substratanzeige ist bereit';
    end;
    Color := clSilver; Font.Color := clWindowText;
    Update;
  end;

end; //...SAnzeigeResetEinzelChip
{---------------------------------------------------------------}

{---------------------------------------------------------------}
procedure TSubstratPanelThread.SAnzeigeNotSupported;
begin
  with MainForm do
  begin
    SubstratAnzeigePanel.Caption := 'Anzeige Offline';
    with SubstratAnzeigeHeader do
    begin
      Caption := 'Baugrösse nicht unterstützt!';
      Color := clSilver; Font.Color := clWindowText;
      Update;
    end;
  end;
end; //...SAnzeigeNotSupported
{---------------------------------------------------------------}

end.

Da würde ich mal versuchen Einges zu entzerren.
Warum zig TSubstratPanelThread.Synchronize(NIL,Xxxx); in einer ThreadLoop ?

Ich würde versuchen solche Infos per Message nach aussen zu transportieren,
in einen MessageStack, der dann aussen in aller Ruhe angezeigt wird.

Dafür ist wohl auch TSubstratPanelThread.Queue() gut genug, denke ich, um Deadlocks tzu Vermeiden,
ohne jetzt alle Deine Routinen genau zu verstehen.

Dann solltest Du das Application.ProcessMessage rauswerfen.

Wenn das aus der MainLoop raus ist wäre vielleicht schonmal ein Großteil geschafft.