1

现在，第 1 帧处于循环中（从 Serial Comport 中查找数据）并在单独的单元中写入字符串变量 A。然后 Frame1 循环，直到另一个布尔变量 B 为真，这意味着 Frame2 已经处理了它的例程。第 2 帧使用计时器检查变量 A 的变化，然后在变量发生变化时执行一个过程，并将布尔变量 B 设置为 true。在第 1 帧中循环并检查变量 B 是否为真会导致第 2 帧无法再触发它的计时器，因为消息队列可能不再为空。

现在我只能帮助自己睡觉（xxx）。但我想要更好的表现。

请帮忙 ：）

谢谢

Edit1：我忘了从主题标题中提及这一点。我想摆脱计时器并直接调用frame2中的过程。

编辑2：代码：

框架1：

procedure TFrmSerial.TimerSerialTimer(Sender: TObject);
var
resultserial:string;
sl:Tstringlist;
iloop:integer;
begin
  if CheckBox1.Checked  then
  begin
              TimerSerialTimer.Enabled:=false;
              readString(resultserial); //reads comport data to string
      
              if (resultserial<>'')  then
              begin
                      sl:=TStringList.Create;
                      sl.Sorted:=true;
                      sl.Duplicates:=dupIgnore;

                      try
                        sl.Text:=resultserial;
                        unit3.DataProcessed:=true;
                        
                 repeat
                         
                         if (unit3.DataProcessed=true) then
                         begin
                             edit1.Text:=sl[0];
                             sl.Delete(0);
                             unit3.DataProcessed:=false;
                         end
                         else if (unit3.DataProcessed=false) then
                         begin
                               sleep(800);
                               unit3.DataProcessed:=true;  //ugly workaround
                         end                        
                         else
                         begin
                             showmessage('undefined state');
                         end;
                
                 until (sl.Count=0);
                      finally
                        sl.Free;
                      end;

                end;

                TimerSerialTimer.Enabled:=true;
  end;
end;

框架2：代码：

procedure TFrmProcessing.Timer1Timer(Sender: TObject);
begin
  if self.Visible then
  begin
    timer1.enabled:=false;
    if   ProcessString<>ProcessStringBefore then
    begin
      ProcessStringBefore:=ProcessString;
      if length(ProcessString)>2 then DoWork;
    end;
    unit3.DataProcessed:=true;
    timer1.enabled:=true;
  end;
end;
4

2 回答 2

2

TFrame只是一个框架，可以一起和/或以嵌入式方式处理一组组件。它没有自己的处理线程。对于异步处理，使用TThread对象或（在较新的 Delphi 版本中）线程库元素。

我不明白你的框架是如何在分开的线程中运行的……但这并不重要。我为彼此控制的线程创建了一个示例。它可能更简洁，但我不仅想在线程之间使用一些交互，还想在用户的方向上使用一些交互。我希望在一些解释性文字之后会更容易理解。

Button1Click 开始处理。它启动两个进程：控制器和受控进程。受控线程处理，直到控制器不触发停止工作的标志。该标志是通过调用InterruptTThread 实例的方法发送的。此调用Interrupted将线程实例的属性值切换为TRUE.

CheckBox1.Checked 属性的FALSE状态将停止控制器进程，并通知另一个停止。

TTestBaseProcess 只是一个共同的祖先来进行“处理”并显示“部分结果”。

单元1.pas：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    CheckBox1: TCheckBox;
    ListBox2: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TTestBaseProcess = class ( TThread )
    private
      fListBox : TListBox;
      fDelay : cardinal;

    protected
      procedure doSomeComplicatedForAWhile; virtual;
      procedure showSomePartialResults; virtual;

    public
      constructor Create( listBox_ : TListBox; delay_ : cardinal );

  end;

  TControlledProcess = class ( TTestBaseProcess )
    private
      fButton : TButton;
    protected
      procedure Execute; override;
      procedure enableButton( enabled_ : boolean ); virtual;

    public
      constructor Create( listBox_ : TListBox; button_ : TButton );

  end;

  TControllerProcess = class ( TTestBaseProcess )
    private
      fCheckBox : TCheckBox;
      fControlledThread : TThread;

    protected
      procedure Execute; override;

    public
      constructor Create( listBox_ : TListBox; checkBox_ : TCheckBox; controlledThread_ : TThread );

  end;

procedure TTestBaseProcess.doSomeComplicatedForAWhile;
begin
  sleep( fDelay );
end;

procedure TTestBaseProcess.showSomePartialResults;
begin
  Synchronize(

    procedure
    begin
      fListBox.items.add( 'Zzz' );
    end

  );
end;

constructor TTestBaseProcess.Create( listBox_ : TListBox; delay_ : cardinal );
begin
  if ( listBox_ <> NIL ) then
    if ( delay_ > 0 ) then
    begin
      inherited Create( TRUE );
      fListBox := listBox_;
      fDelay := delay_;
    end else
      raise Exception.Create( 'Invalid input parameter...' )
  else
    raise Exception.Create( 'Invalid input parameter...' );
end;


constructor TControlledProcess.Create( listBox_ : TListBox; button_ : TButton );
begin
  if ( button_ <> NIL) then
  begin
    inherited Create( listBox_, 500 );
    fButton := button_;
  end else
    raise Exception.Create( 'Invalid input parameter...' );
end;

procedure TControlledProcess.Execute;
begin
  enableButton( FALSE );
  while ( not terminated ) do
  begin
    doSomeComplicatedForAWhile;
    showSomePartialResults;
  end;
  enableButton( TRUE );
end;

procedure TControlledProcess.enableButton( enabled_ : boolean );
begin
  Synchronize(

    procedure
    begin
      fButton.Enabled := enabled_;
    end

  );
end;

constructor TControllerProcess.Create( listBox_ : TListBox; checkBox_ : TCheckBox; controlledThread_ : TThread );
begin
  if ( checkBox_ <> NIL ) then
    if ( controlledThread_ <> NIL ) then
    begin
      inherited Create( listBox_, 1000 );
      fCheckBox := checkBox_;
      fControlledThread := controlledThread_;
    end else
      raise Exception.Create( 'Invalid input parameter...' )
  else
    raise Exception.Create( 'Invalid input parameter...' );
end;

procedure TControllerProcess.Execute;
begin
  while ( fCheckBox.Checked ) do
  begin
    doSomeComplicatedForAWhile;
    showSomePartialResults;
  end;
  fControlledThread.terminate;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  aT1, aT2 : TThread;
begin
  CheckBox1.Checked := TRUE;
  ListBox1.Items.Clear;
  ListBox2.Items.Clear;
  aT1 := TControlledProcess.Create( ListBox1, Button1 );
  aT2 := TControllerProcess.Create( ListBox2, CheckBox1, aT1 );
  aT1.start;
  aT2.start;
end;

end.

单元1.dfm：

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 311
  ClientWidth = 423
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 8
    Top = 39
    Width = 201
    Height = 266
    ItemHeight = 13
    TabOrder = 0
  end
  object Button1: TButton
    Left = 8
    Top = 8
    Width = 201
    Height = 25
    Caption = 'Button1'
    TabOrder = 1
    OnClick = Button1Click
  end
  object CheckBox1: TCheckBox
    Left = 215
    Top = 12
    Width = 97
    Height = 17
    Caption = 'CheckBox1'
    TabOrder = 2
  end
  object ListBox2: TListBox
    Left = 215
    Top = 39
    Width = 201
    Height = 266
    ItemHeight = 13
    TabOrder = 3
  end
end
于 2020-07-24T22:27:10.107 回答
1

我认为您的问题可以通过回调解决。像这样的东西：

type
...
TMyCallback = procedure of Object;
...

of Object意味着这个过程应该是类方法。

如果您使用此类型定义变量，然后分配一些具有相同属性的过程，您可以通过调用此变量来调用它：

type
  TMyCallback = procedure of Object;
  TForm2 = class(TForm)
    private
      ...
    protected
      ...
    public
      callback:TMyCallback;
      ...
    end;

...

procedure Form1.DoSomething;
begin
// do something
end;

procedure Form1.DoSomethingWithEvent;
begin
   callback := DoSomething; //assign procedure to variable
   if assigned(callback)
      callback;             //call procedure DoSomething
end;

你应该在你的情况下做这样的事情。这只是示例，因为我没有看到您的所有代码，但我会尝试使其可行：

框架1：

type
TSerialEvent = function(aResult:String):Boolean of Object;

Frame1 = class(TFrame)
  private
     ...
  protected
     ...
  public
     ...
     Callback:TSerialEvent;
end;

...

procedure TFrmSerial.TimerSerialTimer(Sender: TObject);
var
  resultserial:string;
  sl:Tstringlist;
  iloop:integer;
begin
  if CheckBox1.Checked  then
  begin
    TimerSerialTimer.Enabled:=false;
    readString(resultserial); //reads comport data to string
      
    if (resultserial<>'')  then
    begin
      sl:=TStringList.Create;
      sl.Sorted:=true;
      sl.Duplicates:=dupIgnore;

      try
        sl.Text:=resultserial;
                        
        repeat   
        edit1.Text := sl[0];
        sl.Delete(0);
        if assigned(Callback) then
          begin
          //Let's call Process method of TFrmProcessing:
          if not Callback(edit1.text) then  //it's not good idea to use edit1.text as proxy, but we have what we have
            raise Exception.Create('Serial string was not processed');     
          end
        else
          raise Exception.Create('No Callback assigned');           
                
        until (sl.Count=0);
        finally
          sl.Free;
        end;

      end;

    TimerSerialTimer.Enabled:=true;
  end;
end;

Frame2：你不再需要 Timer。一切都将在事件中处理：

type
TFrmProcessing = class(TFrame)
   private
   ...
   protected
   ...
   public
   ...
   function Process(aResult:String):Boolean;
end;

function TFrmProcessing.Process(aResult:String):Boolean;
begin
 result := false;
 if self.Visible then
  begin
    if aResult <> ProcessStringBefore then
    begin
      ProcessStringBefore := aResult;
      if length(ProcessString) > 2 then DoWork;
      result := true;
    end;
  end; 
end;

最后一件事：你必须分配to Processof的方法。我认为您应该在或您用于初始化的其他方法中执行此操作：TFrmProcessingCallbackFrame1Form1.Create

...
procedure Form1.FormCreate(Sender:TObject);
begin
...
Frame1.Callback := FrmProcessing.Process;
...
end;
于 2020-07-24T10:53:20.757 回答