Form creates 2 Frames - How to call procedure in Frame 2 from inside Frame 1?

468 views Asked by At

Right now Frame 1 is in a loop (looking for data from Serial Comport) and writes to a string variable A in a separate unit. Frame1 then loops until another boolean variable B is true meaning Frame2 has processed its routine. Frame 2 uses a timer to check for changes in variable A then executes a procedure when the variable has changed and sets boolean variable B to true. Looping in Frame 1 and checking for variable B to become true leads to Frame 2 can't fire it's timer anymore because probably the message queue doesn't become empty anymore.

Right now i can only help myself with sleep(xxx). But i want better performance.

Please help :)

Thank you

Edit1: i forgot to mention the point from the topic header. i want to get rid of the timer and call the procedure in frame2 directly.

Edit2: code:

Frame1:

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;

Frame2: code:

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;
2

There are 2 answers

3
mrNone On BEST ANSWER

I think your problem can be solved with callbacks. Something like this:

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

of Object means that this procedure should be class method.

If you define variable with this type and than assign some procedure with the same attributes you can call it by calling this variable:

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;

You should do something like this in your case. It's just example because I didn't see all your code, but I'll try to make it workable:

Frame1:

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: You don't need Timer anymore. Everything will be processed in event:

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;

And the last thing: you have to assign method Process of TFrmProcessing to Callback of Frame1. I think you should do it at Form1.Create or another method you are using for initialization:

...
procedure Form1.FormCreate(Sender:TObject);
begin
...
Frame1.Callback := FrmProcessing.Process;
...
end;
1
The Bitman On

TFrame is just a FRAME to handle a block of components together and/or in embedded manner. It has not an own processing thread. For asynchronous processing use TThread objects or (in newer Delphi versions) the Threading library elements.

I don't understand how your frames run in separated threads... But it is not so important. I created an example for each-other controlling threads. It could be more concise but I want to use some interaction not just between the threads but the direction of the user as well. I hope it will be more understandable after some explanatory text.

The Button1Click starts the processing. It starts two processes : the controller and the controlled one. The controlled thread processing until the controller don't trigger a sign to stop working. This sign is sent by the call of the Interrupt method of the TThread instances. This call switch the Interrupted property value of the thread instance to TRUE.

The FALSE state of the CheckBox1.Checked property will stop the controller process and it will notify the other one to stop as well.

The TTestBaseProcess just a common ancestor to do the "processing" and to show the "partial results".

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