adstmach.pas

Async Professional 4.04

    I  : Integer;
  begin
    Result := nil;
    if not Assigned(C) then
      Exit;

    {Look through all of the owned components}
    for I := 0 to C.ComponentCount - 1 do begin
      if C.Components[I] is TApdCustomStateMachine then begin
        Result := TApdCustomStateMachine (C.Components[I]);
        Exit;
      end;

      {If this isn't one, see if it owns other components}
      Result := FindStateMachine (C.Components[I]);
    end;
  end;

begin
  {Search the entire form}
  Result := FindStateMachine (C);
end;

procedure TApdStateCustomDataSource.StateMachineStart (                  
              AOwner : TApdCustomStateMachine);                          
begin                                                                    
  if not Assigned (AOwner) then                                          
    raise EStateMachine.Create (ecNoStateMachine, False); 
  FStateMachine := AOwner;                                               
  FPauseDepth := 0;                                                      
end;                                                                     

procedure TApdStateCustomDataSource.StateMachineStop;                    
begin                                                                    
  FPauseDepth := 0;                                                      
  Resume;                                                                
end;                                                                     

{ TApdStateComPortSource }

constructor TApdStateComPortSource.Create (AOwner : TComponent);
begin
  inherited Create (AOwner);

  FBuffer     := nil;
  FBufferSize := 0;

  PacketList  := TList.Create;
  FComPort    := SearchComPort(Owner);
end;

destructor TApdStateComPortSource.Destroy;
begin
  if Assigned (FBuffer) then
    FreeMem (FBuffer, FBufferSize);

  PacketList.Free;

  inherited Destroy;
end;

procedure TApdStateComPortSource.Output (AString : string);
begin
  if Assigned (FComPort) then
    FComPort.Output := AString; 
end;

procedure TApdStateComPortSource.OutputBlock (ABlock : Pointer;
                                              ASize : Integer);
begin
  if Assigned (FComPort) then
    FComPort.PutBlock (ABlock, ASize);
end;

procedure TApdStateComPortSource.Pause;
var
  i : Integer;

begin
  inherited Pause;

  for I := 0 to pred (PacketList.Count) do 
    TApdDataPacket (PacketList[I]).Enabled := False;
end;

procedure TApdStateComPortSource.Resume;
var
  i : Integer;

begin
  inherited Resume;

  if not Paused then
    for I := 0 to pred (PacketList.Count) do
      if (TApdDataPacket (PacketList[I]).StartString <> '') or
         (TApdDataPacket (PacketList[I]).PacketSize > 0) or
         (TApdDataPacket (PacketList[I]).EndString <> '') then
      TApdDataPacket (PacketList[I]).Enabled := True;
end;

procedure TApdStateComPortSource.SetComPort (const Value : TApdCustomComPort);
begin
  FComPort := Value;
end;

procedure TApdStateComPortSource.StateActivate (State : TApdCustomState);
begin
  FComPort.AddStringToLog(Name+ ': Activate');
  if State.OutputOnActivate <> '' then
    FComPort.Output := State.OutputOnActivate;
end;

procedure TApdStateComPortSource.StateChange (
                                      OldState, NewState : TApdCustomState);
var
  I : Integer;                                      
begin                                      
  { disable the packets }
  for I := 0 to pred(PacketList.Count) do begin
    TApdDataPacket(PacketList[I]).Free;
    PacketList[I] := nil;
  end;
  PacketList.Clear;
end;

procedure TApdStateComPortSource.StateMachineActivate (
                                                State : TApdCustomState;
                                                Condition : TApdStateCondition;
                                                Index : Integer);
begin
  if Assigned (State) and (State.ActionState) then begin
    Exit;
  end;

  PacketList.Add(TApdDataPacket.Create(Self));
  with TApdDataPacket(PacketList[Index]) do begin
    Tag := Index;
    AutoEnable := False;
    Enabled := False;

    { assign the port and OnPacket event handler }
    ComPort := FComPort;
    OnPacket := PacketEvent;
    OnTimeout := PacketTimeout;

    { set up the Start and End conditions }
    StartString := State.Conditions[Index].StartString;
    if StartString = '' then
      StartCond := scAnyData
    else
      StartCond := scString;

    EndCond := [];
    EndString := State.Conditions[Index].EndString;
    if EndString <> '' then
      EndCond := EndCond + [ecString];
    PacketSize := State.Conditions[Index].PacketSize;
    if PacketSize > 0 then
      EndCond := EndCond + [ecPacketSize];

    Timeout := State.Conditions[Index].Timeout;
    { If there is a definition to the data packet then go ahead and use that
      otherwise, if it's an empty data packet then assume that state fires }
    if (StartString <> '') or (PacketSize > 0) or (EndString <> '') then begin
      Enabled := True;
      InternalManager.KeepAlive := True;
    end else
      FStateMachine.ChangeState (Index);
  end;
end;

procedure TApdStateComPortSource.StateMachineDeactivate (State : TApdCustomState);
var
  I : Integer;
begin
  { disable and free our Condition's data packets }
  for I := 0 to pred(PacketList.Count) do begin
    TApdDataPacket(PacketList[I]).Free;
    PacketList[I] := nil;
  end;
end;

procedure TApdStateComPortSource.StateMachineStart (                     
              AOwner : TApdCustomStateMachine);                          
begin
  inherited StateMachineStart (AOwner);                                  

  if not Assigned(FComPort) then
    raise EPortNotAssigned.Create(ecPortNotAssigned, False);
  if not(FComPort.Open) and (FComPort.AutoOpen) then
    FComPort.Open := True;
  if Assigned (ComPort.Dispatcher) then
    ComPort.Dispatcher.RegisterEventTriggerHandler (TriggerHandler); 
end;

procedure TApdStateComPortSource.StateMachineStop;
begin
  inherited StateMachineStop;

  if not Assigned (FComPort) then
    Exit;
  if Assigned (FComport.Dispatcher) then
    ComPort.Dispatcher.DeregisterEventTriggerHandler (TriggerHandler); 
end;

procedure TApdStateComPortSource.TriggerHandler (Msg, wParam : Cardinal;
                                                 lParam : Longint);
var
  Count  : Word absolute wParam;

begin
  if (Msg = APW_TRIGGERAVAIL) and
     (Assigned (FComPort)) then begin

     if (not Assigned (FBuffer)) then begin
       if Count > 8192 then
         FBufferSize := Count + 8192
       else
         FBufferSize := 8192;
       GetMem (FBuffer, FBufferSize);
     end;
     if Count > FBufferSize then begin
       FreeMem (FBuffer, FBufferSize);
       GetMem (FBuffer, FBufferSize + 8192);
     end;

    ComPort.Dispatcher.GetBlock (FBuffer, Count);
    PChar (FBuffer)[Count] := #$00;
    if Assigned (FOnGetData) then
      FOnGetData (Self, FBuffer, Count);
    if Assigned (FOnGetDataString) then
      FOnGetDataString (Self, PChar (FBuffer));
    if Assigned (StateMachine) and
       Assigned (StateMachine.CurrentState) then begin
       if Assigned (StateMachine.CurrentState.FOnGetData) then
         StateMachine.CurrentState.FOnGetData (StateMachine.CurrentState,
                                               FBuffer, Count);
       if Assigned (StateMachine.CurrentState.FOnGetDataString) then
         StateMachine.CurrentState.FOnGetDataString (StateMachine.CurrentState,
                                                     PChar (FBuffer));
    end;
  end;
end;

procedure TApdStateComPortSource.Notification (AComponent : TComponent;
              Operation : TOperation);
begin
  inherited Notification (AComponent, Operation);

  if (Operation = opRemove) then begin
    {See if our com port is going away}
    if (AComponent = FComPort) then
      FComPort := nil;
  end else if (Operation = opInsert) then begin
    {Check for a com port being installed}
    if not Assigned(FComPort) and (AComponent is TApdCustomComPort) then
      FComPort := TApdCustomComPort(AComponent);
  end;
end;

procedure TApdStateComPortSource.PacketEvent(Sender: TObject;
  Data: Pointer; Size: Integer);
var
  Index : Integer;
  DataString : String;
begin
  Index := TApdDataPacket(Sender).Tag;
  {$IFOPT H-}
  if Size > 255 then
    raise EStringSizeError.Create(ecPacketTooLong, False);
  {$ENDIF}
   SetLength (DataString, Size);
   Move (Data^, DataString[1], Size); 
  StateMachine.SetData (Data, DataString, Size);
  StateMachine.ChangeState (Index);
end;

procedure TApdStateComPortSource.PacketTimeout(Sender: TObject);
var
  i         : Integer;
  NextState : Integer;
begin
  NextState := -1;
  if (Assigned (StateMachine)) and
     (Assigned (StateMachine.CurrentState)) then begin
    for i := 0 to StateMachine.CurrentState.Conditions.Count - 1 do
      if StateMachine.CurrentState.Conditions[i].DefaultError then begin
        NextState := i;
        Break;
      end;
    { if a default error was not found, use the default next }
    if NextState = -1 then begin
      for i := 0 to StateMachine.CurrentState.Conditions.Count - 1 do
        if StateMachine.CurrentState.Conditions[i].DefaultNext then begin
          NextState := i;
          Break;
        end;
      end;
    if NextState <> - 1 then
      StateMachine.ChangeState (NextState);
  end;
end;

procedure TApdStateComPortSource.StateDeactivate (State : TApdCustomState);
begin
  FComPort.AddStringToLog (Name + ': Deactivate'); 
end;

{ TApdCustomStateMachine }

procedure TApdCustomStateMachine.Cancel;
begin
  DoDeactivate;                                                          
end;

procedure TApdCustomStateMachine.ChangeState (ConditionIndex : Integer); 
begin                                                                    
  if Paused then                                                         
    Exit;                                                                
  PostMessage (Handle, apw_StateChange, ConditionIndex, 0);              
end;                                                                     

procedure TApdCustomStateMachine.CMCtl3DChanged(var Message: TMessage);
begin
  if NewStyleControls and (FBorderStyle = bsSingle) then
    RecreateWnd;
  inherited;
end;

procedure TApdCustomStateMachine.CMDesignHitTest (var Msg : TWMMouse);
var
  i : Integer;
  Point : TPoint;
  State : TApdCustomState;
  AddType : TApdConnectAddType;
begin
  Msg.Result := 0;
  if (Msg.Keys and MK_LBUTTON) <> 0 then begin
    Point.x := Msg.XPos;
    Point.y := Msg.YPos;
    if (Point.x < Left) or (Point.x > Left + Width) or
       (Point.y < Top) or (Point.y > Top + Height) then
      Exit;
    for i := 0 to pred (ControlCount) do begin
      if Controls[i] is TApdCustomState then begin
        State := TApdCustomState(Controls[i]);
        if (Point.x >= State.Left) and
           (Point.x <= State.Left + State.Width) and