[英]Form creates 2 Frames - How to call procedure in Frame 2 from inside Frame 1?
现在,第 1 帧处于循环中(从 Serial Comport 中查找数据)并在单独的单元中写入字符串变量 A。 然后 Frame1 循环,直到另一个 boolean 变量 B 为真,这意味着 Frame2 已处理其例程。 帧 2 使用计时器检查变量 A 的变化,然后在变量发生变化时执行一个过程,并将 boolean 变量 B 设置为真。 在第 1 帧中循环并检查变量 B 是否为真会导致第 2 帧无法再触发它的计时器,因为消息队列可能不再为空。
现在我只能帮助自己睡觉(xxx)。 但我想要更好的表现。
请帮忙:)
谢谢
编辑1:我忘了提及主题 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;
TFrame
只是一个框架,用于一起和/或以嵌入式方式处理一组组件。 它没有自己的处理线程。 对于异步处理,使用TThread
对象或(在较新的 Delphi 版本中)线程库元素。
我不明白你的框架是如何在分开的线程中运行的……但这并不重要。 我为彼此控制的线程创建了一个示例。 它可能更简洁,但我不仅想在线程之间使用一些交互,还想在用户的方向上使用一些交互。 我希望在一些解释性文字之后会更容易理解。
Button1Click 开始处理。 它启动两个进程:controller 和受控进程。 直到 controller 的受控线程处理不会触发停止工作的标志。 该标志是通过调用 TThread 实例的Interrupt
方法发送的。 此调用将线程实例的Interrupted
属性值切换为TRUE
。
CheckBox1.Checked 属性的FALSE
state 将停止 controller 进程,它也会通知另一个进程停止。
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
我认为您的问题可以通过回调解决。 像这样的东西:
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;
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;
最后一件事:您必须将TFrmProcessing
的方法Process
分配给Frame1
的Callback
。 我认为您应该在Form1.Create
或您用于初始化的其他方法中执行此操作:
...
procedure Form1.FormCreate(Sender:TObject);
begin
...
Frame1.Callback := FrmProcessing.Process;
...
end;
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.