runfusss.pas

Suite of components to add scripting capabilities to your applications, including Pascal & Basic scr

unit RunFusSS;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, atScript,
  atBasic, atPascal, AdvMemo, TypInfo, CompInsp, FDMain, RunFus, PropList;

type
  TShowEditorEvent = procedure(Sender: TObject; AEditor: TControl; ALine: integer) of object;

  TSSEventSaver = class(TComponent)
  private
    FScripter: TatCustomScripter;
    FTempEventsProperty: string;
    FParentForm: TCustomForm;
    function GetEventsProperty: string;
    procedure SetEventsProperty(Value: string);
    procedure SetScripter(const Value: TatCustomScripter);
    procedure ReadEventsProperty(Reader: TReader);
    procedure StoreEventsProperty(Writer: TWriter);
    function GetParentForm: TCustomForm;
    procedure SetParentForm(const Value: TCustomForm);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure DefineProperties(Filer: TFiler); override;
  public
    property ParentForm: TCustomForm read GetParentForm write SetParentForm;
  published
    property Scripter: TatCustomScripter read FScripter write SetScripter;
  end;

  TSSInspector = class(TRFInspector)
  private
    { Private declarations }
    FScripter: TatCustomScripter;
    FEditor: TAdvMemo;
    FOnShowEditor: TShowEditorEvent;
    procedure SetScripter(const Value: TatCustomScripter);
    procedure SetEditor(const Value: TAdvMemo);
  protected
    { Protected declarations }
    function ValidPropertyIndex(AIndex: integer): boolean;
    procedure Filter(Prop: TProperty; var Result: Boolean); override;
    procedure DoShowEditor(ALine: integer); virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetValue(TheIndex: Integer): string; override;
    procedure GetValuesList(TheIndex: Integer; const Strings: TStrings); override;
    procedure SetValue(TheIndex: Integer; const Value: string); override;
    function GetEnableExternalEditor(TheIndex: Integer): Boolean; override;
    function CallEditor(TheIndex: Integer): Boolean; override;
  published
    { Published declarations }
    property Scripter: TatCustomScripter read FScripter write SetScripter;
    property Editor: TAdvMemo read FEditor write SetEditor;
    property OnShowEditor: TShowEditorEvent read FOnShowEditor write FOnShowEditor;
  end;

implementation

procedure TSSInspector.SetScripter(const Value: TatCustomScripter);
begin
  FScripter:=Value;
  if Assigned(FScripter) then FScripter.FreeNotification(Self);
end;

procedure TSSInspector.SetEditor(const Value: TAdvMemo);
begin
  FEditor := Value;
  if Assigned(FEditor) then FEditor.FreeNotification(Self);
end;

procedure TSSInspector.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if not (csDestroying in ComponentState) and (Operation=opRemove) then
  begin
    if (AComponent=FScripter) then FScripter := nil;
    if (AComponent=FEditor) then FEditor := nil;
  end;
end;

function TSSInspector.GetValue(TheIndex: Integer): string;
begin
  if Assigned(FScripter) and ValidPropertyIndex(TheIndex) and (Properties[TheIndex].TypeKind=tkMethod) then
    Result := FScripter.EventBroker.GetAssignedRoutineName(Instance, Properties[TheIndex].Name, FScripter)
  else Result := inherited GetValue(TheIndex);
end;
         
procedure TSSInspector.GetValuesList(TheIndex: Integer; const Strings: TStrings);
begin
  inherited GetValuesList(TheIndex,Strings);
  if ValidPropertyIndex(TheIndex) then
    with Properties[TheIndex] do
      if Assigned(FScripter) and (TypeKind=tkMethod) then
      begin
        if Assigned(FEditor) and (FEditor.Lines.Text <> FScripter.SourceCode.Text) then
          FScripter.SourceCode := FEditor.Lines;
        if not FScripter.Compiled then
          FScripter.Compile;
        FScripter.ScriptInfo.Routines.GetNames(Strings);
        if Strings.IndexOf(FScripter.ScriptInfo.MainRoutineName) <> -1 then
          Strings.Delete(Strings.IndexOf(FScripter.ScriptInfo.MainRoutineName));
      end;
end;

procedure TSSInspector.SetValue(TheIndex: Integer; const Value: string);
begin
  if ValidPropertyIndex(TheIndex) then
    with Properties[TheIndex] do
      if Assigned(FScripter) and (TypeKind=tkMethod) then
        FScripter.EventBroker.SetEvent(Self.Instance, Self.Properties[TheIndex].Name,
          Value, FScripter, epReplaceCall)
      else inherited SetValue(TheIndex,Value);
end;

function TSSInspector.GetEnableExternalEditor(TheIndex: Integer): Boolean;
begin
  result := inherited GetEnableExternalEditor(TheIndex);
  if ValidPropertyIndex(TheIndex) then
    with Properties[TheIndex] do
      result := result or (Assigned(FScripter) and Assigned(FEditor) and (TypeKind=tkMethod));
end;

procedure TSSInspector.DoShowEditor(ALine: integer);
begin
  if Assigned(FEditor) then
  begin
    if Assigned(FOnShowEditor) then
      FOnShowEditor(Self, FEditor, ALine)
    else
    begin
      FEditor.CurY := ALine;
      if Assigned(FEditor.Owner) and (FEditor.Owner is TForm) then
      begin
        TForm(FEditor.Owner).Visible := true;
        TForm(FEditor.Owner).BringToFront;
        TForm(FEditor.Owner).ActiveControl := FEditor;
        PostMessage(TForm(FEditor.Owner).Handle, WM_SETFOCUS, 0, 0);
      end;
    end;
  end;
end;

function TSSInspector.CallEditor(TheIndex: Integer): Boolean;
var
  ProcName: string;
  Prop: TProperty;
  Line: integer;
begin
  if ValidPropertyIndex(TheIndex) then
    Prop := Properties[TheIndex]
  else
    Prop := nil;
  if Assigned(Prop) and Assigned(FScripter) and Assigned(FEditor) and (Prop.TypeKind=tkMethod) then
  begin
    ProcName := GetValue(TheIndex);
    if (ProcName = '') and (Instance is TComponent) then
      ProcName := FScripter.BuildEventHandlerName(TComponent(Instance), Prop.Name);
    if FEditor.Lines.Text <> FScripter.SourceCode.Text then
      FScripter.SourceCode := FEditor.Lines;
    Line := FScripter.DeclareEventHandler(ProcName);
    SetValue(TheIndex, ProcName);
    Result := true;
    FEditor.Lines.Assign(FScripter.SourceCode);
    DoShowEditor(Line);
  end
  else
    result := inherited CallEditor(TheIndex);
end;

procedure TSSInspector.Filter(Prop: TProperty; var Result: Boolean);
begin
  if (Prop.TypeKind = tkMethod) then
    Result := (Mode = imEvents) and Assigned(FScripter) and
      (FScripter.EventBroker.EventAdapters.FindAdapter(Prop.PropType) <> nil);
  inherited Filter(Prop, Result);
end;

{ TSSEventSaver }

procedure TSSEventSaver.StoreEventsProperty(Writer: TWriter);
begin
  Writer.WriteString(GetEventsProperty);
end;

procedure TSSEventSaver.ReadEventsProperty(Reader: TReader);
begin
  SetEventsProperty(Reader.ReadString);
end;

procedure TSSEventSaver.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('ScripterEvents', ReadEventsProperty, StoreEventsProperty, true);
end;

procedure TSSEventSaver.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if not (csDestroying in ComponentState) and (Operation=opRemove) then
  begin
    if (AComponent = FScripter) then
      FScripter := nil;
  end;
end;

procedure TSSEventSaver.SetScripter(const Value: TatCustomScripter);
begin
  FScripter := Value;
  if Assigned(FScripter) then
  begin
    FScripter.FreeNotification(Self);
    SetEventsProperty(FTempEventsProperty);
  end;
end;

procedure TSSEventSaver.SetParentForm(const Value: TCustomForm);
begin
  if FParentForm <> Value then
  begin
    FParentForm := Value;
    if Assigned(FParentForm) then
    begin
      FParentForm.FreeNotification(Self);
      SetEventsProperty(FTempEventsProperty);
    end;
  end;
end;

function TSSEventSaver.GetEventsProperty: string;
var
  SL: TStringList;
  c: integer;
begin
  result := '';
  if Assigned(FScripter) and Assigned(ParentForm) then
  begin
    SL := TStringList.Create;
    try
      {varre os eventos setados e seta tudo}
      for c := 0 to FScripter.EventBroker.Dispatchers.Count - 1 do
        with FScripter.EventBroker.Dispatchers[c] do
        begin
          if (Instance is TComponent) and (TComponent(Instance).Owner = ParentForm)
            and (TComponent(Instance).Name <> '') then
          begin
            SL.Values[Format('%s.%s', [TComponent(Instance).Name, PropInfo^.Name])] := RoutineName;
          end;
        end;
    finally
      result := SL.Text;
      SL.Free;
    end;
  end;
end;

procedure TSSEventSaver.SetEventsProperty(Value: string);
var
  SL: TStringList;
  c: integer;
  CompName, PropName: string;
  ALeftPart: string;
  Comp: TComponent;
  p: integer;
begin
  if (Value <> '') and Assigned(FScripter) and Assigned(ParentForm) then
  begin
    FTempEventsProperty := '';
    SL := TStringList.Create;
    try
      SL.Text := Value;
      for c := 0 to SL.Count - 1 do
      begin
        ALeftPart := SL.Names[c];
        P := Pos('.', ALeftPart);
        if (P > 1) and (P < Length(ALeftPart)) then
        begin
          CompName := Copy(ALeftPart, 1, P - 1);
          PropName := Copy(ALeftPart, P + 1, MaxInt);
          Comp := ParentForm.FindComponent(CompName);
          if Comp <> nil then
          begin
            FScripter.EventBroker.SetEvent(Comp, PropName, SL.Values[SL.Names[c]], FScripter, epReplaceCall);
          end;
        end;
      end;
    finally
      SL.Free;
    end;
  end else
    FTempEventsProperty := Value;
end;

function TSSEventSaver.GetParentForm: TCustomForm;
begin
  if Assigned(FParentForm) then
    result:=FParentForm
  else
    if Assigned(Owner) and (Owner is TCustomForm) then
      result := TCustomForm(Owner)
    else
      result := nil;
end;

function TSSInspector.ValidPropertyIndex(AIndex: integer): boolean;
begin
  result := (AIndex >= 0) and (AIndex < PropertyCount);
end;

end.