表单创建 2 个框架 - 如何从框架 1 内部调用框架 2 中的过程？
Form creates 2 Frames - How to call procedure in Frame 2 from inside Frame 1?
现在第 1 帧处于循环中（从 Serial Comport 寻找数据）并写入单独单元中的字符串变量 A。然后 Frame1 循环直到另一个布尔变量 B 为真，这意味着 Frame2 已处理其例程。
Frame 2 使用计时器检查变量 A 的变化，然后在变量发生变化时执行一个过程并将布尔变量 B 设置为 true。
在第 1 帧中循环并检查变量 B 是否变为真会导致第 2 帧无法再触发它的计时器，因为消息 queue 可能不再为空。
现在我只能帮助自己睡觉(xxx)。但是我想要更好的性能。
请帮忙:)
谢谢
Edit1：我忘了提到主题 header 的要点。我想摆脱定时器，直接调用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;
我想你的问题可以通过回调来解决。像这样：
type
...
TMyCallback = procedure of Object;
...
of Object表示这个程序应该是class方法。
如果你用这种类型定义变量，而不是分配一些具有相同属性的过程，你可以通过调用这个变量来调用它：
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;
第2帧：
你不再需要定时器了。一切都将在事件中处理：
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;
最后一件事：您必须将 TFrmProcessing 的方法 Process 分配给 Frame1 的 Callback。我认为您应该在 Form1.Create 或您用于初始化的其他方法中执行此操作：
...
procedure Form1.FormCreate(Sender:TObject);
begin
...
Frame1.Callback := FrmProcessing.Process;
...
end;
TFrame 只是一个 FRAME，以嵌入式方式一起处理一块组件 and/or。它没有自己的处理线程。对于异步处理，使用 TThread 对象或（在较新的 Delphi 版本中）线程库元素。
我不明白你的框架如何 运行 在不同的线程中...但这不是那么重要。我为彼此控制线程创建了一个示例。它可以更简洁，但我想不仅在线程之间使用一些交互，而且还想在用户方向上使用一些交互。我希望在一些解释性文字之后它会更容易理解。
Button1Click 开始处理。它启动两个进程：控制器和受控进程。受控线程处理直到控制器不触发停止工作的标志。这个标志是通过调用 TThread 实例的 Interrupt 方法发送的。此调用将线程实例的 Interrupted 属性 值切换为 TRUE.
CheckBox1.Checked 属性 的 FALSE 状态将停止控制器进程，并通知另一个停止。
TTestBaseProcess 只是进行“处理”和显示“部分结果”的共同祖先。
Unit1.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.
Unit1.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
现在第 1 帧处于循环中（从 Serial Comport 寻找数据）并写入单独单元中的字符串变量 A。然后 Frame1 循环直到另一个布尔变量 B 为真，这意味着 Frame2 已处理其例程。 Frame 2 使用计时器检查变量 A 的变化，然后在变量发生变化时执行一个过程并将布尔变量 B 设置为 true。 在第 1 帧中循环并检查变量 B 是否变为真会导致第 2 帧无法再触发它的计时器，因为消息 queue 可能不再为空。
现在我只能帮助自己睡觉(xxx)。但是我想要更好的性能。
请帮忙:)
谢谢
Edit1：我忘了提到主题 header 的要点。我想摆脱定时器，直接调用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;
我想你的问题可以通过回调来解决。像这样：
type
...
TMyCallback = procedure of Object;
...
of Object表示这个程序应该是class方法。
如果你用这种类型定义变量，而不是分配一些具有相同属性的过程，你可以通过调用这个变量来调用它：
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;
第2帧： 你不再需要定时器了。一切都将在事件中处理：
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;
最后一件事：您必须将 TFrmProcessing 的方法 Process 分配给 Frame1 的 Callback。我认为您应该在 Form1.Create 或您用于初始化的其他方法中执行此操作：
...
procedure Form1.FormCreate(Sender:TObject);
begin
...
Frame1.Callback := FrmProcessing.Process;
...
end;
TFrame 只是一个 FRAME，以嵌入式方式一起处理一块组件 and/or。它没有自己的处理线程。对于异步处理，使用 TThread 对象或（在较新的 Delphi 版本中）线程库元素。
我不明白你的框架如何 运行 在不同的线程中...但这不是那么重要。我为彼此控制线程创建了一个示例。它可以更简洁，但我想不仅在线程之间使用一些交互，而且还想在用户方向上使用一些交互。我希望在一些解释性文字之后它会更容易理解。
Button1Click 开始处理。它启动两个进程：控制器和受控进程。受控线程处理直到控制器不触发停止工作的标志。这个标志是通过调用 TThread 实例的 Interrupt 方法发送的。此调用将线程实例的 Interrupted 属性 值切换为 TRUE.
CheckBox1.Checked 属性 的 FALSE 状态将停止控制器进程，并通知另一个停止。
TTestBaseProcess 只是进行“处理”和显示“部分结果”的共同祖先。
Unit1.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.
Unit1.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