Project Structure

• ListMonitor.dpr
• ListMonitor_MainForm.pas
• ListMonitor_MainForm.dfm {FormListMonitor}
• ListMonitor_Threads.pas

program ListMonitor;

uses
  Forms,
  ListMonitor_MainForm in 'ListMonitor_MainForm.pas' {FormListMonitor},
  ListMonitor_Threads in 'ListMonitor_Threads.pas';

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TFormListMonitor, FormListMonitor);
  Application.Run;
end.

unit ListMonitor_MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Generics.Collections;

type
  TFormListMonitor = class(TForm)
    ListBox1: TListBox;
    ListBox2: TListBox;
    ListBox3: TListBox;
    btnStartThreads: TButton;
    btnStatus: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnStartThreadsClick(Sender: TObject);
    procedure btnStatusClick(Sender: TObject);
  private
    fThreads: TObjectList<TThread>; // owns and destroys
    fListBoxes: TList<TListBox>;
  public
    { Public declarations }
  end;

var
  FormListMonitor: TFormListMonitor;

implementation

{$R *.dfm}

uses
  ListMonitor_Threads;

procedure TFormListMonitor.btnStartThreadsClick(Sender: TObject);
var
  I: Integer;
begin
  for I := 1 to 3 do
    fThreads.Add (TAddToListThread.Create (False));
end;

procedure TFormListMonitor.btnStatusClick(Sender: TObject);
var
  aListBox: TListBox;
begin
  for aListBox in fListBoxes do
  begin
    if System.TMonitor.TryEnter(aListBox) then
    try
      aListBox.Items.Add('Available');
    finally
      System.TMonitor.Exit(aListBox);
    end;
  end;
end;

procedure TFormListMonitor.FormCreate(Sender: TObject);
begin
  fThreads := TObjectList<TThread>.Create;
  fListBoxes := TList<TListBox>.Create;
  fListBoxes.Add (ListBox1);
  fListBoxes.Add (ListBox2);
  fListBoxes.Add (ListBox3);
end;

procedure TFormListMonitor.FormDestroy(Sender: TObject);
begin
  // ends all threads in a clean, way...
  // ... but this can take a lot of time
  // fThreads.Free;
end;

end.

object FormListMonitor: TFormListMonitor
  Left = 0
  Top = 0
  Caption = 'ListMonitor'
  ClientHeight = 313
  ClientWidth = 625
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 24
    Top = 72
    Width = 169
    Height = 201
    ItemHeight = 13
    TabOrder = 0
  end
  object ListBox2: TListBox
    Left = 224
    Top = 72
    Width = 169
    Height = 201
    ItemHeight = 13
    TabOrder = 1
  end
  object ListBox3: TListBox
    Left = 424
    Top = 72
    Width = 169
    Height = 201
    ItemHeight = 13
    TabOrder = 2
  end
  object btnStartThreads: TButton
    Left = 24
    Top = 24
    Width = 169
    Height = 25
    Caption = 'btnStartThreads'
    TabOrder = 3
    OnClick = btnStartThreadsClick
  end
  object btnStatus: TButton
    Left = 224
    Top = 24
    Width = 169
    Height = 25
    Caption = 'btnStatus'
    TabOrder = 4
    OnClick = btnStatusClick
  end
end

unit ListMonitor_Threads;

interface

uses
  Classes, StdCtrls, Forms, SysUtils, Windows;

type
  TAddToListThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

implementation

procedure TAddToListThread.Execute;
var
  aList: TListBox;
  I: Integer;
begin
  while not Terminated do
  begin
    aList := Application.MainForm.FindComponent (
      'ListBox' + IntToStr (GetTickCount mod 3 + 1)) as TListBox;
    System.TMonitor.Enter (aList);
    try
      aList.Items.Add(IntToStr (GetCurrentThreadID) + ' starting: ' + TimeToStr (Now));
      for I := 1 to 30 do
        if not Terminated then
          Sleep (100)
        else
          Exit;
      aList.Items.Add(IntToStr (GetCurrentThreadID) + ' stopping: ' + TimeToStr (Now));
    finally
      System.TMonitor.Exit (aList);
    end;
  end;
end;

end.