TThread Syncronise & TCriticalSection.Enter

[Blup]

Da war auch noch ein Fehler in der While-Schleife.
Mein Vorschlag, ohne das ich jetzt getestet hab:

Delphi-Quellcode:

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.Variants, System.UITypes,
  System.Classes, FMX.Types, FMX.Graphics, FMX.Dialogs, FMX.Types3D, FMX.Forms,
  FMX.Forms3D, FMX.Controls3D, IdGlobal, IdStack, FMX.Layers3D, FMX.StdCtrls,
  FMX.Controls, FMX.Layouts, FMX.Memo, SyncObjs;

type
  TForm1 = class(TForm3D)
    Memo: TMemo;
    ProgressBar: TProgressBar;
    Layer3D1: TLayer3D;
    AniIndicator1: TAniIndicator;
    procedure Form3DCreate(Sender: TObject);
  private
    FProgress: Integer;
    procedure SetProgress(AValue: Integer);
    procedure DoOnThreadTerminate(Sender: TObject);
  public
    property Progress: Integer read FProgress write SetProgress;
  end;

  TMyThread = class(TThread)
  protected
    FIp: Integer;
    FStr: string;
    procedure Execute; override;
  public
    constructor Create(AIP: Integer; AFinishEvent: TNotifyEvent);
    property Ip: Integer read FIp;
    property Str: String read FStr;
  end;

var
  Form1: TForm1;
  stack : TIdStack;

const
  NET : String = '172.17.4.';

implementation

{$R *.fmx}

procedure TForm1.Form3DCreate(Sender: TObject);
var
  i : integer;
begin
  ProgressBar.Min := 0;
  ProgressBar.Max := 254;
  Progress := 0;

  for i := 1 to 254 do
    MyThread.Create(I, DoOnThreadTerminate);
end;

procedure TForm1.DoOnThreadTerminate(Sender: TObject);
var
  sIpStr: string;
  i: Integer;
begin
  with TMyThread(Sender) do
    sIpStr := Format('...%3d - %s', [Ip, Str]);

  i := 0;
  while (i < Memo.Lines.Count) and (Memo.Lines[i] < sIpStr) do
    Inc(i);

  Memo.Lines.Insert(i, sIpStr);

  Progress := Progress + 1;
end;

procedure TForm1.SetProgress(AValue: Integer);
begin
  FProgress := Value;
  ProgressBar.Value := AValue
  if FProgress = 254 then
    AniIndicator1.Enabled := False;
end;

{ MyThread }

constructor TMyThread.Create(AIp: Integer; AFinishEvent: TNotifyEvent);
begin
  inherited Create;
  FIp         := AIp;
  OnTerminate := AFinishEvent;
end;

procedure TMyThread.Execute;
begin
  inherited;

  TIdStack.IncUsage;
  try
    FStr := Gstack.HostByAddress(NET + IntToStr(FIp));
  except on E: Exception do
    FStr := 'inexistent domain';
  end;
  TIdStack.DecUsage;
end;

end.