/examples/multithreading/mainunit.pas

http://github.com/graemeg/lazarus · Pascal · 116 lines · 56 code · 23 blank · 37 comment · 3 complexity · 0054b692a212ce3fb777e4ba60d0742f MD5 · raw file

  1. {
  2. ***************************************************************************
  3. * *
  4. * This source is free software; you can redistribute it and/or modify *
  5. * it under the terms of the GNU General Public License as published by *
  6. * the Free Software Foundation; either version 2 of the License, or *
  7. * (at your option) any later version. *
  8. * *
  9. * This code is distributed in the hope that it will be useful, but *
  10. * WITHOUT ANY WARRANTY; without even the implied warranty of *
  11. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
  12. * General Public License for more details. *
  13. * *
  14. * A copy of the GNU General Public License is available on the World *
  15. * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
  16. * obtain it by writing to the Free Software Foundation, *
  17. * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
  18. * *
  19. ***************************************************************************
  20. Abstract:
  21. Demo to show, how to start a thread and how synchronize with the main
  22. thread.
  23. Important: The cthread unint must be added to the uses section of the .lpr
  24. file. See multithreadingexample1.lpr.
  25. }
  26. unit MainUnit;
  27. {$mode objfpc}{$H+}
  28. interface
  29. uses
  30. Classes, SysUtils, Forms, Controls, Graphics, Dialogs;
  31. type
  32. { TMyThread }
  33. TMyThread = class(TThread)
  34. private
  35. fStatusText: string;
  36. procedure ShowStatus;
  37. protected
  38. procedure Execute; override;
  39. public
  40. constructor Create(CreateSuspended: boolean);
  41. end;
  42. { TForm1 }
  43. TForm1 = class(TForm)
  44. procedure FormCreate(Sender: TObject);
  45. private
  46. public
  47. end;
  48. var
  49. Form1: TForm1;
  50. implementation
  51. {$R *.lfm}
  52. { TForm1 }
  53. procedure TForm1.FormCreate(Sender: TObject);
  54. var
  55. MyThread : TMyThread;
  56. begin
  57. MyThread := TMyThread.Create(True); // With the True parameter it doesn't start automatically
  58. if Assigned(MyThread.FatalException) then
  59. raise MyThread.FatalException;
  60. // Here the code initialises anything required before the threads starts executing
  61. MyThread.Start;
  62. end;
  63. { TMyThread }
  64. procedure TMyThread.ShowStatus;
  65. // this method is only called by Synchronize(@ShowStatus) and therefore
  66. // executed by the main thread
  67. // The main thread can access GUI elements, for example Form1.Caption.
  68. begin
  69. Form1.Caption := fStatusText;
  70. end;
  71. procedure TMyThread.Execute;
  72. var
  73. newStatus : string;
  74. begin
  75. fStatusText := 'TMyThread Starting ...';
  76. Synchronize(@Showstatus);
  77. fStatusText := 'TMyThread Running ...';
  78. while (not Terminated) and (true {any condition required}) do begin
  79. //here goes the code of the main thread loop
  80. newStatus:='TMyThread Time: '+FormatDateTime('YYYY-MM-DD HH:NN:SS',Now);
  81. if NewStatus <> fStatusText then begin
  82. fStatusText := newStatus;
  83. Synchronize(@Showstatus);
  84. end;
  85. end;
  86. end;
  87. constructor TMyThread.Create(CreateSuspended: boolean);
  88. begin
  89. FreeOnTerminate := True;
  90. inherited Create(CreateSuspended);
  91. end;
  92. end.