fmmain.pas

Delphi脚本控件

    end;
  end;

  AssignFile(T, ProjectName);
  Rewrite(T);
  try
    if S <> '' then
      writeln(T, S);

    for I:=0 to ModuleCount - 1 do
    begin
      writeln(T, ModuleNames[I]);
      Editor := FindEditor(ModuleNames[I]);
      if Editor <> nil then
      begin
        S := ModuleNames[I];
        if Pos(PathDelim, S) > 0 then
          S := PaxScripter1.FindFullFileName(S);
        Editor.Lines.SaveToFile(S);
      end;
    end;
  finally
    CloseFile(T);
  end;
end;

procedure TFormMain.ShowError(Sender: TPaxScripter);
var
  Description, ModuleName: String;
  TextPosition: Integer;
  Editor: TEditor;
  TabSheet: TTabSheet;
  LineRecord: TLineRecord;
begin
  BringToFront;

  Description := Sender.ErrorDescription;
  ModuleName := Sender.ErrorModuleName;
  TextPosition := Sender.ErrorTextPos;

  TabSheet := FindPage(ModuleName);
  if TabSheet <> nil then
  begin
    PageControl1.ActivePage := TabSheet;
    Editor := FindEditor(TabSheet);
    Editor.SelStart := TextPosition;
    Editor.SelEnd := TextPosition;
    Editor.SetFocus;
  end
  else
    Exit;

  LineRecord := GetLineRecord(CurrentLineNumber);

  if LineRecord = nil then
  begin
    LineRecord := TLineRecord.Create(CurrentModuleName, CurrentLineNumber,
                                     '', 0, [dlErrorLine]);
    SetLineRecord(CurrentLineNumber, LineRecord);
    Editor.Invalidate;
  end
  else
    LineRecord.LineInfos := LineRecord.LineInfos + [dlErrorLine];

  LabelBottomRight.Caption := 'Error: ' + Description;
end;

procedure TFormMain.mUndoClick(Sender: TObject);
begin
  CurrentEditor.Undo;
end;

procedure TFormMain.mRedoClick(Sender: TObject);
begin
  CurrentEditor.Redo;
end;

procedure TFormMain.mCutClick(Sender: TObject);
begin
  CurrentEditor.CutToClipboard;
end;

procedure TFormMain.mCopyClick(Sender: TObject);
begin
  CurrentEditor.CopyToClipboard;
end;

procedure TFormMain.mPasteClick(Sender: TObject);
begin
  CurrentEditor.PasteFromClipboard;
end;

procedure TFormMain.mDeleteClick(Sender: TObject);
begin
  CurrentEditor.SelText := '';
end;

procedure TFormMain.mSelectAllClick(Sender: TObject);
begin
  CurrentEditor.SelectAll;
end;

procedure TFormMain.PaxScripter1ShowError(Sender: TPaxScripter);
begin
  ShowError(Sender);
end;

procedure AssignLabel(L: TLabel; const S: String);
begin
  if L.Caption <> S then
    L.Caption := S;
end;

procedure TFormMain.PaxScripter1Print(Sender: TPaxScripter; const S: String);
var
  K: Integer;
begin
  FormConsole.Show;
  K := FormConsole.Memo1.Lines.Count;
  if K = 0 then
    FormConsole.Memo1.Lines.Add(S)
  else
    FormConsole.Memo1.Lines[K-1] := FormConsole.Memo1.Lines[K-1] + S;
end;

procedure TFormMain.PaxScripter1BeforeRunStage(Sender: TPaxScripter);
begin
  if PaxScripter1.IsError then
    RemoveError;

  SaveProject;
  RemoveTraceLine;
  UpdateLineNumbers;
  AddBreakpoints;

  RebuildCodeExplorerTree;
end;

procedure TFormMain.PaxScripter1BeforeCompileStage(Sender: TPaxScripter);
begin
  if SignSyntaxCheck then
    Exit;

  AssignLabel(Compiling.LabelProject, 'Project: ' + ProjectName);
  Compiling.BeginCompiling;
  Compiling.Show;
end;

procedure TFormMain.PaxScripter1AssignScript(Sender: TPaxScripter);
var
  I: Integer;
  ModuleName, LanguageName: String;
begin
  ScriptWasAssigned := true;

  with PageControl1 do
    for I:=0 to PageCount - 1 do
    begin
      ModuleName := Pages[I].Caption;
      LanguageName := PaxScripter1.FileExtToLanguageName(ModuleName);
      PaxScripter1.AddModule(ModuleName, LanguageName);
      PaxScripter1.AddCode(ModuleName, FindEditor(Pages[I]).Text);
    end;
end;

procedure TFormMain.UpdateLineNumbers;
var
  I, J: Integer;
  Editor: TEditor;
  LR: TLineRecord;
begin
  with PageControl1 do
    for I:=0 to PageCount - 1 do
    begin
      Editor := FindEditor(Pages[I]);
      if Editor = nil then
        Continue;
      for J:=0 to Editor.Lines.Count - 1 do
      begin
        LR := TLineRecord(Editor.Lines.Objects[J]);
        if LR <> nil then
          LR.LineNumber := J + 1;
      end;
    end;
end;

procedure TFormMain.PaxScripter1CompilerProgress(Sender: TPaxScripter;
  ModuleNumber: Integer);
begin
  if SignSyntaxCheck then
    Exit;

  Application.ProcessMessages;
  AssignLabel(Compiling.LabelStatus, 'Compiling: ' + PaxScripter1.CurrentModuleName);
  AssignLabel(Compiling.LabelCurrLineNumber, IntToStr(PaxScripter1.CurrentSourceLine));
  AssignLabel(Compiling.LabelTotalLinesCount, IntToStr(PaxScripter1.TotalLineCount));
  AssignLabel(Compiling.LabelError, '');
end;

procedure TFormMain.PaxScripter1AfterCompileStage(Sender: TPaxScripter);
var
  I, K: Integer;
  M: TPaxModule;
begin
  if SignSyntaxCheck then
    Exit;

  K := PaxScripter1.Modules.Count;
  if K > ModuleCount then
  for I:= ModuleCount to K - 1 do
  begin
    M := PaxScripter1.GetPaxModule(I);
    AddToProject(M.Name,
                 M.FileName,
                 M.LanguageName);
  end;

  Compiling.EndCompiling;

  if CompileAndRun and (not PaxScripter1.IsError) then
  begin
    Compiling.Hide;
    Exit;
  end;

  if PaxScripter1.IsError then
  begin
    AssignLabel(Compiling.LabelStatus, 'Done: There are errors');
    AssignLabel(Compiling.LabelError, PaxScripter1.ErrorDescription);
  end
  else
  begin
    AssignLabel(Compiling.LabelStatus, 'Done');
    AssignLabel(Compiling.LabelError, 'Successful');
  end;

  Compiling.Hide;
  Compiling.ShowModal;
end;

procedure TFormMain.OnlineHelp1Click(Sender: TObject);
var
  S: String;
begin
  S := GetCurrentDir + helpsite;
{$IFNDEF LINUX}
  ShellExecute(Handle , 'open', PChar(S), nil, nil, SW_MAXIMIZE);
{$ENDIF}
end;

function TFormMain.ModuleCount: Integer;
begin
  result := PageControl1.PageCount;
end;

function TFormMain.GetModName(Index: Integer): String;
begin
  if (ModuleCount > 0) and (Index < ModuleCount) then
    result := PageControl1.Pages[Index].Caption
  else
    result := '';
end;

procedure TFormMain.ListBoxBreakpointsDblClick(Sender: TObject);
var
  I: Integer;
  S, ModName: String;
begin
  I := ListBoxBreakpoints.ItemIndex;
  if I = -1 then
    Exit;
  S := ListBoxBreakpoints.Items[I];
  ModName := Copy(S, 1, Pos(':', S) - 1);
  I := StrToInt(Copy(S, Pos(':', S) + 1, Length(S)));
  GotoLine(ModName, I);
end;

procedure TFormMain.PaxScriptHomePage1Click(Sender: TObject);
begin
{$IFNDEF LINUX}
  ShellExecute(Handle , 'open', PChar(paxsite), nil, nil, SW_MAXIMIZE);
{$ENDIF}
end;

procedure TFormMain.AddWatch1Click(Sender: TObject);
var
  S: String;
begin
  S := InputBox('Input expression', '', '');
  if S <> '' then
  begin
    WatchList.Add(S);
    ListBoxWatches.Items.Add(S);
    ProcessWatches;
  end;
end;

procedure TFormMain.mConsoleClick(Sender: TObject);
begin
  FormConsole.Show;
end;

procedure TFormMain.ViewSource1Click(Sender: TObject);
var
  F: TForm;
  M: TMemo;
begin
  if not FileExists(ProjectName) then
    raise Exception.Create('Cannot open '+ProjectName);
  F := TForm.Create(Self);
  F.Left := 200;
  F.Top := 100;
  M := TMemo.Create(F);
  M.Parent := F;
  M.Align := alClient;
  M.Lines.LoadFromFile(ProjectName);
  F.ShowModal;
  M.Lines.SaveToFile(ProjectName);
end;

// Code explorer - start

procedure TFormMain.SetupClassNode(N: TTreeNode; ID: Integer);
var
  R: TNodeRec;
begin
  with TreeView1.Items do
  begin
    with R do
    begin
      NConsts := AddChild(N, 'Constants');
      NFields := AddChild(N, 'Fields');
      NMethods := AddChild(N, 'Methods');
      NProperties := AddChild(N, 'Properties');
      NClasses := AddChild(N, 'Classes');
      NStructures := AddChild(N, 'Structures');
      NEnums := AddChild(N, 'Enums');
    end;

    PaxScripter1.EnumMembers(ID, CurrentModuleID, EnumProc, @R);

    with R do
    begin
      if NConsts.Count = 0 then
        NConsts.Delete;
      if NFields.Count = 0 then
        NFields.Delete;
      if NMethods.Count = 0 then
        NMethods.Delete;
      if NProperties.Count = 0 then
        NProperties.Delete;
      if NClasses.Count = 0 then
        NClasses.Delete;
      if NStructures.Count = 0 then
        NStructures.Delete;
      if NEnums.Count = 0 then
        NEnums.Delete;
    end;
  end;
end;

procedure TFormMain.SetupFuncNode(N: TTreeNode; ID: Integer);
var
  R: TNodeRec;
begin
  with TreeView1.Items do
  begin
    with R do
    begin
      NParams := AddChild(N, 'Parameters');
      NConsts := AddChild(N, 'Constants');
      NFields := AddChild(N, 'Local variables');
      NMethods := AddChild(N, 'Methods');
      NClasses := AddChild(N, 'Classes');
      NStructures := AddChild(N, 'Structures');
      NEnums := AddChild(N, 'Enums');
    end;

    PaxScripter1.EnumMembers(ID, CurrentModuleID, EnumProc, @R);

    with R do
    begin
      if NParams.Count = 0 then
        NParams.Delete;
      if NConsts.Count = 0 then
        NConsts.Delete;
      if NFields.Count = 0 then
        NFields.Delete;
      if NMethods.Count = 0 then
        NMethods.Delete;
      if NClasses.Count = 0 then
        NClasses.Delete;
      if NStructures.Count = 0 then
        NStructures.Delete;
      if NEnums.Count = 0 then
        NEnums.Delete;
    end;
  end;
end;

procedure TFormMain.EnumProc(const Name: String;
                          ID: Integer;
                          Kind: TPAXMemberKind;
                          ml: TPAXModifierList;
                          Data: Pointer);
var
  P: PNodeRec;
  TypeName: String;
  PosObject: TPosObject;
begin
  with PaxScripter1 do
    PosObject := TPosObject.Create(GetModule(ID),
                                   GetPosition(ID),
                                   Length(GetName(ID)));
  PosList.Add(PosObject);

  P := PNodeRec(Data);

  with PaxScripter1 do
    TypeName := GetName(GetTypeID(ID));

  with TreeView1.Items do
  case Kind of
    mkParam: AddChildObject(P^.NParams, Name + ': ' + TypeName, PosObject);
    mkField: AddChildObject(P^.NFields, Name + ': ' + TypeName, PosObject);
    mkMethod: SetupFuncNode(AddChildObject(P^.NMethods, Name, PosObject), ID);
    mkConst: AddChildObject(P^.NConsts, Name + ': ' + TypeName, PosObject);
    mkClass: SetupClassNode(AddChildObject(P^.NClasses, Name, PosObject), ID);
    mkStructure: SetupClassNode(AddChildObject(P^.NStructures, Name, PosObject), ID);
    mkEnum: SetupClassNode(AddChildObject(P^.NEnums, Name, PosObject), ID);
    mkProp: AddChildObject(P^.NProperties, Name  + ': ' + TypeName, PosObject);
  end;
end;

procedure TFormMain.RebuildCodeExplorerTree;
begin
  with TreeView1.Items do
  begin
    Clear;
    SetupClassNode(Add(nil, 'NonameNamespace'), PaxScripter1.GetRootID);
  end;
end;

procedure TFormMain.TreeView1DblClick(Sender: TObject);
var
  N: TTreeNode;
  PosObject: TPosObject;
begin
  if CurrentEditor = nil then
    Exit;

  N := TTreeView(Sender).Selected;
  if N = nil then
    Exit;

  PosObject := TPosObject(N.Data);

  if PosObject <> nil then
    if PosObject.Module = CurrentModuleID then
      if PosObject.Position >= 0 then
    with CurrentEditor do
    begin
      SetFocus;
      SelStart := PosObject.Position + 1;
//      SelLength := PosObject.Length;
    end;
end;

procedure TFormMain.TreeView1Click(Sender: TObject);
begin
  TreeView1DblClick(Sender);
end;

procedure TFormMain.PageControl1Change(Sender: TObject);
begin
  RebuildCodeExplorerTree;
end;

// Code explorer - end


procedure TFormMain.Find1Click(Sender: TObject);
var
  S: String;
  L, LS: Integer;
begin
  if CurrentEditor = nil then
    Exit;

  SearchString := InputBox('Text to find', '', SearchString);
  SearchAgain1Click(Sender);
end;

procedure TFormMain.SearchAgain1Click(Sender: TObject);
var
  S, SS: String;
  L, LS: Integer;
begin
  if CurrentEditor = nil then
    Exit;

  L := Length(SearchString);
  S := UpperCase(CurrentEditor.Lines.Text);
  SS := UpperCase(SearchString);
  LS := Length(S);

  while SearchPos < LS do
  begin
    if Copy(S, SearchPos, L) = SS then
    begin
      with CurrentEditor do
      begin
        SetFocus;
        SelStart := SearchPos;
      end;
      Inc(SearchPos);
      Exit;
    end;
    Inc(SearchPos);
  end;
  SearchPos := 1;
  ShowMessage('Search string ' + SearchString + ' not found.');
end;

initialization
  RegisterConstant('PAX_SELF', ParamStr(0), -1);
end.