lazarus free pascal不支持匿名方法

时间:2021-01-27 13:59:43   收藏:0   阅读:0
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Unit2;
type
  TMyProc = procedure of object;

  { TForm1 }

  TForm1 = class(TForm)
    CheckBox1: TCheckBox;
    Frame1_1: TFrame1;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    procedure DoWork;
  public
    procedure Exec;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure UpdateTime;
begin
  while not Form1.CheckBox1.Checked do
  begin
    TThread.Synchronize(nil, @Form1.Exec);
    TThread.Sleep(500);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
type
  PThreadMethod = ^TThreadMethod;

var
  Method: TMethod;
  Proc: TThreadMethod;

  procedure NestedProc;
  begin
    while not Form1.CheckBox1.Checked do
    begin
      TThread.Synchronize(nil, @Exec);
      TThread.Sleep(500);
    end;
  end;

begin
  Method.Data := @Self;
  Method.Code := @NestedProc;  //可以
  Method.Code := @UpdateTime;  //可以
  Proc := PThreadMethod(@Method)^;
  TThread.ExecuteInThread(Proc);
end;

procedure TForm1.DoWork;
begin
  while not CheckBox1.Checked do
  begin
    TThread.Synchronize(nil, @Exec);
    TThread.Sleep(500);
  end;
end;

procedure TForm1.Exec;
begin
  Label1.Caption := DateTimeToStr(Now);
end;

end.

 

评论(0
© 2014 mamicode.com 版权所有 京ICP备13008772号-2  联系我们:gaon5@hotmail.com
迷上了代码!