Delphi Thread Example

Delphi Thread Example

Threads mean a lot with the latest computer technology. They allow you to perform multiple tasks at the same time without them interfering with each other. For example, imagine a road. If this road is only 1 lane, and there is a large truck driving slowly, then everyone else gets stuck behind that truck and cannot pass. When the road has two lanes, all the faster moving cars can move over to the other lane and pass the slow truck.

Threads allow similar capabilities: One block of code can be running on its own while another block of code is also running on its own - in the same application. By default, any simple application has its own main thread. You have the choice of adding more threads to allow more things to go on at the same time. For example, you might need to write a thread which performs some very lengthy calculations, while allowing the main GUI thread to continue responding.

Given a sample program and unit source code to understand easily about Delphi thread usage.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Edit1: TEdit;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    procedure AddMemoItems;
    { Private declarations }
  public
    { Public declarations }
  end;

  TNewObj = class
    private
      procedure GetValue;
    public
    end;

  TAddMemoItems = procedure of object;// Method pointer

  TNewThread = class(TThread)         // Creating a Thread object
  private
    FName: TMemo;                     // Assigning the Memo control into the pointer
    FAscFlag : Boolean;               // Assigning the loop order flag into the pointer
    FAddMemoItems : TAddMemoItems;    // variable of method pointer
    FPause : Boolean;
    procedure RefreshThread;          // Normal procedure to use for thread synchronize process
  protected
    procedure Execute; override;      // Actual thread execution
    procedure Pause;
    procedure Start;
  public
    constructor Create(Name: TMemo; AscFlag:Boolean; AddMemoItems: TAddMemoItems);
            // Constructor method of thread and passing Memo, loop Asending flag and Method pointer as parameters
    destructor Destroy; override;
  end;


var
  Form1: TForm1;
  t1, t2, t3 : TNewThread;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  t1 := TNewThread.Create(Memo1,true, AddMemoItems);
  t3 := TNewThread.Create(Memo1,true, nil);
  //ShowMessage('Start next thread');
  t2 := TNewThread.Create(Memo2,false, nil);
  //t1.Priority := tpLower;
  //t1.Resume;
  //ShowMessage('Start next thread');
  //t2.Priority := tpLower;
  //t2.Resume;
end;

procedure TForm1.AddMemoItems;
var
  i : integer;
begin
  for i := 1 to 1000 do
  begin
    Memo1.Lines.Add(IntToStr(i));
  end;
end;

{ TNewThread }

constructor TNewThread.Create(Name: TMemo; AscFlag:Boolean; AddMemoItems: TAddMemoItems);
begin
  inherited Create(True);
  //FName := 'th'+Name;
  FName    := Name;
  FAscFlag := AscFlag;
  FAddMemoItems := AddMemoItems;
  Priority := tpLower;
  Resume;
end;

destructor TNewThread.Destroy;
begin

  inherited;
end;

procedure TNewThread.Execute;
var
  i, iStNo : integer;
begin
  inherited;
  iStNo := 0;
  if FAscFlag then
  begin
    if Assigned(FAddMemoItems) then
      FAddMemoItems
    else
    begin
      for i := 1 to 1000 do
      begin
        while FPause do Inc(iStNo);
        FName.Lines.Add(IntToStr(i));
        //Synchronize(RefreshThread);
        Sleep(Random(10));
      end;
    end;
  end
  else
  begin
    for i := 1000 downto 1 do
    begin
      while FPause do Inc(iStNo);
      FName.Lines.Add(IntToStr(i));
      //Synchronize(RefreshThread);
      Sleep(Random(10));
    end;
  end;
end;

procedure TNewThread.Pause;
begin
  FPause := True;
end;

procedure TNewThread.RefreshThread;
begin
  //Nothing do
end;

procedure TNewThread.Start;
begin
  FPause := False;
end;

{ TNewObj }

procedure TNewObj.GetValue;
begin
  ShowMessage(Form1.Edit1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  obj : TNewObj;
begin
  obj := TNewObj.Create;
  obj.GetValue;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  t3.Pause;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  t3.Start;
end;

end.

Delphi JSON parsing

you can transform the JSON string representation into a JSON with one of the following code snippets.

Using ParseJSONValue:

procedure CreateJsonString;
var
  LJSONObject: TJSONObject;
 const
  JSONString =
    '{' +
    '    "name": {'+
    '        "A JSON Object": {' +
    '          "id": "1"' +
    '        },' +
    '        "Another JSON Object": {' +
    '          "id": "2"' +
    '        }' +
    '    },' +
    '    "totalobjects": "2"' +
    '}';
begin

  LJSONObject := nil;
  try

    { convert String to JSON }
    LJSONObject := TJSONObject.ParseJSONValue(TEncoding.ASCII.GetBytes(JSONString), 0) as TJSONObject;

    { output the JSON to console as String }
    Writeln(LJSONObject.ToString);
  finally
    LJSONObject.Free;
  end;

Using Parse:
procedure ConsumeJsonBytes;
var
  LJSONObject: TJSONObject;

begin
  LJSONObject := nil;
  try
    LJSONObject := TJsonObject.Create;
    { convert String to JSON }
    LJSONObject.Parse(BytesOf(GJSONString), 0);

    { output the JSON to console as String }
    Writeln(LJSONObject.ToString);
  finally
    LJSONObject.Free;
  end;
end;

TJSONObject.ParseJSONValue() returns a nil pointer if parsing fails. Embarcadero's example does not check for that condition. If parsing failed, that would account for the "invalid type cast" error being raised by the as operator.

TJSONObject.Parse() returns -1 if parsing fails. Embarcadero's example does not check for that condition.

Because TJSONObject parses bytes, not characters, I suggest you not use TFile.ReadAllText(), which will read bytes and decode them to UTF-16 using TEncoding.Default if the file does not have have a BOM. In your particular example, that is not an issue since your JSON contains only ASCII characters. But that can be an issue if non-ASCII Unicode characters are used. JSON uses UTF-8 by default (which is why the IsUTF8 parameter of TJSONObject.ParseJSONValue() is true by default).

In any case, your code does not match the structure of the JSON data you have shown. Your JSON data is an array of objects, so the first item parsed will be a TJSONArray, not a TJSONObject. If you use TSJONObject.ParseJSONValue(), it will return a TJSONValue that can be type-casted to TJSONArray:


procedure TfMain.loadScenarioData(aFilename: string);
var
  vJSONBytes: TBytes;
  vJSONScenario: TJSONObject;
  vJSONArray: TJSONArray;
  vJSONValue: TJSONValue;
  vJSONObject: TJSONObject;
  vJSONPair: TJSONPair;
  vJSONScenarioEntry: TJSONString;
  vJSONScenarioValue: string;
  vParseResult: Integer;
begin
  vJSONBytes := TFile.ReadAllBytes(aFileName);

  vJSONScenario := TJSONObject.Create;
  try
    vParseResult := vJSONScenario.Parse(vJSONBytes, 0);
    if vParseResult >= 0 then
    begin
      //BetFair Specific 'caption' key
      vJSONArray := vJSONScenario.Get(0) as TJSONArray;
      for vJSONValue in vJSONArray do
      begin
        vJSONObject := vJSONValue as TJSONObject;
        vJSONPair := vJSONObject.Get('caption');
        vJSONScenarioEntry := vJSONPair.JsonString;
        vJSONScenarioValue := vJSONScenarioEntry.Value;
        cbScenario.Items.Add(vJSONScenarioValue);
      end;
    end;
  finally
    vJSONScenario.Free;
  end;
end;