* * *

Author Topic: Looking for threading advice[SOLVED]  (Read 2232 times)

jbmckim

  • Jr. Member
  • **
  • Posts: 81
Re: Looking for threading advice
« Reply #15 on: March 12, 2018, 09:06:22 pm »
Whoa yeah engkin, were you ever right.   The plethora of ProcessMessages  calls were an attempt to mitigate some latency issues with the Start/Stop buttons.   That problem was elsewhere.  Also, haven't worked in pascal  since the Turbo days about 30 years ago, so the class structure and its usage is a bit foreign to me.  Hence, this hacking prototype first, then on to the main event.

Also, the call to ProcessMessages should not have been in the thread.

Code: Pascal  [Select]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, fgl, FileUtil, Forms, Controls, Graphics, Dialogs,
  9.   StdCtrls, Spin, ExtCtrls, MTProcs;
  10.  
  11. type
  12.  
  13.   { TInstrument }
  14.  
  15.   TInstrument = Class
  16.   private
  17.   public
  18.     procedure GetData(index : integer);
  19.   end;
  20.   TInstList = specialize TFPGObjectList<TInstrument>;
  21.  
  22.   { TForm1 }
  23.  
  24.   TForm1 = class(TForm)
  25.     ThreadsRunningLabel: TLabel;
  26.     NumberOfThreadsLabel: TLabel;
  27.     NumThreadsSpinEdit: TSpinEdit;
  28.     StartButton: TButton;
  29.     StopButton: TButton;
  30.     Timer1: TTimer;
  31.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  32.     procedure StopButtonClick(Sender: TObject);
  33.     procedure StartButtonClick(Sender: TObject);
  34.     procedure DoData(Index:PtrInt; Data:Pointer; Item: TMultiThreadProcItem);
  35.     procedure Timer1StartTimer(Sender: TObject);
  36.   private
  37.     FInstrumentList :TInstList;
  38.     FInstrument : TInstrument;
  39.   public
  40.     procedure TestMtProcs;
  41.   end;
  42.  
  43. var
  44.   Form1 : TForm1;
  45.   bEnd  : boolean = false;
  46. implementation
  47.  
  48. {$R *.lfm}
  49.  
  50. procedure TForm1.DoData(Index:PtrInt; Data:Pointer; Item: TMultiThreadProcItem);
  51. var
  52.   BoxStyle : integer = 0;
  53.  
  54. begin
  55.  
  56.   TInstList(Data)[Index].GetData(Index);
  57.  
  58. end;
  59.  
  60. procedure TForm1.Timer1StartTimer(Sender: TObject);
  61. begin
  62.  
  63. end;
  64.  
  65. { TInstrument }
  66.  
  67. procedure TInstrument.GetData(index : integer);
  68. var
  69.   i : integer = 0;
  70.  
  71. begin
  72.  
  73.   for i := 0 to 10 do
  74.     Sleep(10);
  75.  
  76. end;
  77.  
  78. procedure TForm1.StartButtonClick(Sender: TObject);
  79. var
  80.   iNumThreads : integer = 0;
  81.   i           : integer = 0;
  82.  
  83. begin
  84.  
  85.   iNumThreads := NumThreadsSpinEdit.Value;
  86.  
  87.   FInstrumentList := TInstList.Create(true);
  88.   StartButton.Enabled := false;
  89.   StopButton.Enabled  := true;
  90.  
  91.   StartButton.Refresh;
  92.   StopButton.Refresh;
  93.  
  94.   bEnd := false;
  95.  
  96.   for i := 0 to (iNumThreads - 1) do
  97.   begin
  98.     FInstrument := TInstrument.Create;
  99.     FInstrumentList.Add(FInstrument);
  100.   end;
  101.  
  102.   StartButton.Enabled := false;
  103.   StopButton.Enabled := true;
  104.   NumThreadsSpinEdit.Enabled := false;
  105.  
  106.   StartButton.Refresh;
  107.   StopButton.Refresh;
  108.   NumThreadsSpinEdit.Refresh;
  109.  
  110.   bEnd := false;
  111.   ThreadsRunningLabel.Caption:= IntToStr(FInstrumentList.count) + ' threads running';
  112.  
  113.   while (bEnd = false) do
  114.   begin
  115.     Application.ProcessMessages;
  116.     TestMtProcs();
  117.     end;
  118.  
  119.   ThreadsRunningLabel.Caption:='No Threads Running';
  120.  
  121. end;
  122.  
  123. procedure TForm1.StopButtonClick(Sender: TObject);
  124.  
  125. begin
  126.  
  127.   StartButton.Enabled := true;
  128.   StopButton.Enabled := false;
  129.   NumThreadsSpinEdit.Enabled := true;
  130.   StartButton.Refresh;
  131.   StopButton.Refresh;
  132.   NumThreadsSpinEdit.Refresh;
  133.   bEnd := True
  134.  
  135. end;
  136.  
  137. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  138. begin
  139.   bEnd := true;
  140. end;
  141.  
  142. procedure TForm1.TestMtProcs;
  143. var
  144.   i : integer = 0;
  145.  
  146. begin
  147.  
  148. ProcThreadpool.DoParallel(@DoData, 0, FInstrumentList.count - 1, Pointer(FInstrumentList));
  149.  
  150. end;
  151.  
  152. end.
  153.            


 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus