fmmain.pas

Delphi脚本控件

  ToggleBreakpoint(CurrentEditor.CaretY);
end;

procedure TFormMain.ToggleBreakpoint(ALine: Integer);
begin
  if CurrentEditor = nil then
    Exit;

  if (ALine >= 1) and (ALine <= CurrentEditor.Lines.Count) then
    CurrentEditor.InvalidateLine(ALine)
  else
    CurrentEditor.Invalidate;

  if PaxScripter1.ScripterState in [ssPaused, ssRunning] then
    AddBreakpoints;  
end;

procedure TFormMain.mAddBreakpointClick(Sender: TObject);
var
  LineRecord: TLineRecord;
  S: String;
  I: Integer;
begin
  if CurrentEditor = nil then
    Exit;

  LineRecord := GetLineRecord(CurrentLineNumber);

  S := CurrentModuleName + ':' + IntToStr(CurrentLineNumber);
  I := ListBoxBreakpoints.Items.IndexOf(S);

  if LineRecord = nil then
  begin
    LineRecord := TLineRecord.Create(CurrentModuleName, CurrentLineNumber,
                                     '', 0, []);
    SetLineRecord(CurrentLineNumber, LineRecord);

    if I = -1 then
      I := ListBoxBreakpoints.Items.Add(S);
  end;

  if dlBreakpointLine in LineRecord.LineInfos then
  begin
    LineRecord.LineInfos := LineRecord.LineInfos - [dlBreakpointLine];
    LineRecord.LineInfos := LineRecord.LineInfos - [dlBadBreakpointLine];

    if I >= 0 then
      ListBoxBreakpoints.Items.Delete(I);
  end
  else if dlBadBreakpointLine in LineRecord.LineInfos then
  begin
    LineRecord.LineInfos := LineRecord.LineInfos - [dlBadBreakpointLine];
    LineRecord.LineInfos := LineRecord.LineInfos - [dlBreakpointLine];

    if I >= 0 then
      ListBoxBreakpoints.Items.Delete(I);
  end
  else
  begin
    LineRecord.LineInfos := LineRecord.LineInfos - [dlBadBreakpointLine];
    LineRecord.LineInfos := LineRecord.LineInfos + [dlBreakpointLine];

    if I = -1 then
      ListBoxBreakpoints.Items.Add(S);
  end;

  ToggleBreakpoint(CurrentLineNumber);
end;

function TFormMain.GetLineInfos(ALine: Integer): TLineInfos;
begin
  Result := [];
  if ALine > 0 then
  begin
    if ALine = CurrentEditor.TraceLine then
      Include(Result, dlTraceLine);
    if IsExecutableLine(ALine) then
      Include(Result, dlExecutableLine);
    if IsBreakpointLine(ALine) then
      Include(Result, dlBreakpointLine);
    if IsBadBreakpointLine(ALine) then
      Include(Result, dlBadBreakpointLine);
    if IsErrorLine(ALine) then
      Include(Result, dlErrorLine);
  end;
end;

procedure TFormMain.EditorSpecialLineColors(Sender: TObject; Line: Integer;
  var Special: Boolean; var FG, BG: TColor);
var
  LI: TLineInfos;
begin
  LI := GetLineInfos(Line);
  if dlTraceLine in LI then
  begin
    Special := TRUE;
    FG := clWhite;
    BG := clBlue;
  end
  else if dlErrorLine in LI then
  begin
    Special := TRUE;
    FG := clBlack;
    BG := clYellow;
  end
  else if dlBadBreakpointLine in LI then
  begin
    Special := TRUE;
    FG := clWhite;
    if dlExecutableLine in LI then
      BG := clGreen
    else
      BG := clGray;
  end
  else if dlBreakpointLine in LI then
  begin
    Special := TRUE;
    FG := clWhite;
    if dlExecutableLine in LI then
      BG := clRed
    else
      BG := clGray;
  end;
end;

procedure TFormMain.SetTraceLine(const ModuleName: String; ALine: integer);
var
  Editor: TEditor;
begin
  if IDEState = ideInit then
    if PaxScripter1.ScripterState <> ssTerminated then
      SetIDEState(idePaused);

  if PaxScripter1.ScripterState = ssTerminated then
    SetIDEState(ideInit);

  ProcessWatches;
  ProcessCallStack;

  Editor := FindEditor(ModuleName);
  if Editor = nil then
    Exit;

  Editor.TraceLine := ALine;

  GoToLine(ModuleName, ALine);
end;

function TFormMain.IsExecutableLine(ALine: integer): boolean;
begin
  result := true;
end;

function TFormMain.IsBreakpointLine(ALine: integer): boolean;
var
  LineRecord: TLineRecord;
begin
  LineRecord := GetLineRecord(ALine);
  if LineRecord = nil then
  begin
    result := false;
    Exit;
  end;
  result := dlBreakpointLine in LineRecord.LineInfos;
end;

function TFormMain.IsBadBreakpointLine(ALine: integer): boolean;
var
  LineRecord: TLineRecord;
begin
  LineRecord := GetLineRecord(ALine);
  if LineRecord = nil then
  begin
    result := false;
    Exit;
  end;
  result := dlBadBreakpointLine in LineRecord.LineInfos;
end;

function TFormMain.IsErrorLine(ALine: integer): boolean;
var
  LineRecord: TLineRecord;
begin
  LineRecord := GetLineRecord(ALine);
  if LineRecord = nil then
  begin
    result := false;
    Exit;
  end;
  result := dlErrorLine in LineRecord.LineInfos;
end;

procedure TFormMain.mNewProjectClick(Sender: TObject);
var
  InputString: String;
begin
  InputString:= InputBox('Input project name', '', '');
  if InputString <> '' then
    CreateNewProject(InputString);
end;

procedure TFormMain.mAddToProjectClick(Sender: TObject);
var
  FileName, ModuleName, LanguageName: String;
  P: Integer;
  L: TPaxLanguage;
begin
  if FormNew.ShowAddToProject = mrOK then
  begin
    LanguageName := FormNew.LanguageName;
    FileName := FormNew.Text;

    L := PaxScripter1.FindLanguage(LanguageName);

    P := Pos('.', FileName);
    if P = 0 then
      FileName := FileName + '.' + L.FileExt;

    ModuleName := FileName;
    AddToProject(ModuleName, FileName, LanguageName);
  end;
end;

procedure TFormMain.mRemoveFromProjectClick(Sender: TObject);
begin
  if FormDelete.ShowModal = mrOK then
  begin
  end;
end;

procedure TFormMain.RunScriptClick(Sender: TObject);
begin
  Trace(rmRun);
end;

procedure TFormMain.mTraceIntoClick(Sender: TObject);
begin
  Trace(rmTraceInto);
end;

procedure TFormMain.mStepOverClick(Sender: TObject);
begin
  Trace(rmStepOver);
end;

procedure TFormMain.mTraceToNextSourceLineClick(Sender: TObject);
begin
  Trace(rmTraceToNextSourceLine);
end;

procedure TFormMain.mRunToCursorClick(Sender: TObject);
begin
  Trace(rmRunToCursor, CurrentModuleName, CurrentLineNumber - 1);
end;

procedure TFormMain.mCompileClick(Sender: TObject);
begin
  CompileAndRun := false;
  PaxScripter1.ScripterState := ssInit;
  PaxScripter1.Compile;
  CompileAndRun := true;

  RebuildCodeExplorerTree;
end;

function TFormMain.FindPage(const ModuleName: String): TTabSheet;
var
  I: Integer;
begin
  result := nil;
  with PageControl1 do
  for I:=PageCount - 1 downto 0 do
    if Pages[I].Caption = ModuleName then
    begin
      result := Pages[I];
      Exit;
    end;
end;

function TFormMain.FindEditor(Page: TTabSheet): TEditor;
begin
  if Page = nil then
    result := nil
  else
    result := TEditor(Page.FindComponent('Editor'));
end;

function TFormMain.FindEditor(const ModuleName: String): TEditor;
var
  Page: TTabSheet;
begin
  Page := FindPage(ModuleName);
  if Page = nil then
    result := nil
  else
    result := TEditor(Page.FindComponent('Editor'));
end;

function TFormMain.CurrentEditor: TEditor;
begin
  result := FindEditor(PageControl1.ActivePage);
end;

function TFormMain.CurrentModuleName: String;
begin
  if Assigned(PageControl1.ActivePage) then
    result := PageControl1.ActivePage.Caption
  else
    result := '';
end;

function TFormMain.CurrentModuleID: Integer;
begin
  if Assigned(PageControl1.ActivePage) then
    result := PageControl1.ActivePageIndex
  else
    result := -1;
end;

function TFormMain.CurrentLineNumber: Integer;
begin
  if CurrentEditor = nil then
    result := -1
  else
    result := CurrentEditor.CaretY;
end;

function TFormMain.CurrentPosNumber: Integer;
begin
  if CurrentEditor = nil then
    result := -1
  else
    result := CurrentEditor.CaretX;
end;

function TFormMain.GetLineRecord(LineNumber: Integer): TLineRecord;
begin
  if CurrentEditor = nil then
    result := nil
  else
    result := TLineRecord(CurrentEditor.Lines.Objects[LineNumber - 1]);
end;

procedure TFormMain.SetLineRecord(LineNumber: Integer; LineRecord: TLineRecord);
begin
  if CurrentEditor = nil then
    Exit;
  if LineNumber < CurrentEditor.Lines.Count then
    CurrentEditor.Lines.Objects[LineNumber - 1] := LineRecord;
end;

procedure TFormMain.UpdateBottomLeftLabel;
begin
  if CurrentLineNumber >= 0 then
    LabelBottomLeft.Caption :=Format('%d : %d', [CurrentLineNumber, CurrentPosNumber])
  else
    LabelBottomLeft.Caption := '';
end;

procedure TFormMain.AddBreakpoints;
var
  I, J: Integer;
  Editor: TEditor;
  LineRecord: TLineRecord;
  Success: Boolean;
begin
  PaxScripter1.RemoveAllBreakpoints;

  with PageControl1 do
  for I:=0 to PageCount - 1 do
  begin
    Editor := FindEditor(Pages[I]);
    if Editor <> nil then
      for J:=0 to Editor.Lines.Count - 1 do
        if Editor.Lines.Objects[J] <> nil then
        begin
          LineRecord := TLineRecord(Editor.Lines.Objects[J]);

          Success := true;
          with PaxScripter1, LineRecord do
            if dlBreakpointLine in LineRecord.LineInfos then
              Success := AddBreakpoint(ModuleName, LineNumber - 1);

          if not Success then
          begin
            LineRecord.LineInfos := LineRecord.LineInfos - [dlBreakpointLine];
            LineRecord.LineInfos := LineRecord.LineInfos + [dlBadBreakpointLine];
          end;
        end;
  end;
end;

procedure TFormMain.RemoveAllBreakpoints;
var
  I: Integer;
  Editor: TEditor;
begin
  PaxScripter1.RemoveAllBreakpoints;
  with PageControl1 do
  for I:=0 to PageCount - 1 do
  begin
    Editor := FindEditor(Pages[I]);
    if Editor <> nil then
      Editor.RemoveLineInfos([dlBreakpointLine, dlBadBreakpointLine]);
  end;
end;

procedure TFormMain.RemoveError;
var
  I: Integer;
  Editor: TEditor;
begin
  PaxScripter1.DiscardError;

  with PageControl1 do
  for I:=0 to PageCount - 1 do
  begin
    Editor := FindEditor(Pages[I]);
    if Editor <> nil then
      Editor.RemoveLineInfos([dlErrorLine]);
  end;

  LabelBottomRight.Caption := '';
end;

function TFormMain.ScriptHasBeenChanged: Boolean;
var
  I: Integer;
  Editor: TEditor;
  ModuleName, S1, S2: String;
begin
  result := false;

  if not ScriptWasAssigned then
    Exit;

  with PageControl1 do
  for I:=0 to PageCount - 1 do
  begin
    ModuleName := Pages[I].Caption;
    if PaxScripter1.Modules.IndexOf(ModuleName) = -1 then
    begin
      result := true;
      Exit;
    end;

    Editor := FindEditor(Pages[I]);
    S1 := Editor.Lines.Text;
    S2 := PaxScripter1.SourceCode[ModuleName];
    if S1 <> S2 then
    begin
      result := true;
      Exit;
    end;
  end;

  for I:=0 to PaxScripter1.Modules.Count - 1 do
  begin
    ModuleName := PaxScripter1.Modules[I];
    if FindEditor(ModuleName) = nil then
    begin
      result := true;
      Exit;
    end;
  end;
end;

procedure TFormMain.EditorKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
//  if PaxScripter1.IsError then
//    RemoveError;
  UpdateBottomLeftLabel;
end;

procedure TFormMain.EditorMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if PaxScripter1.IsError then
    RemoveError;
  UpdateBottomLeftLabel;
end;

procedure TFormMain.EditorMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if PaxScripter1.IsError then
    RemoveError;
  UpdateBottomLeftLabel;
end;

procedure TFormMain.PaintGutterGlyphs(ACanvas: TCanvas; AClip: TRect;
  FirstLine, LastLine: integer);
var
  LH, X, Y: integer;
  LI: TLineInfos;
  ImgIndex: integer;
  Editor: TEditor;
begin
  if CurrentEditor = nil then
    Exit;

  Editor := CurrentEditor;

  X := 14;
  LH := Editor.LineHeight;
  Y := (LH - imglGutterGlyphs.Height) div 2
    + LH * (FirstLine - Editor.TopLine);
  while FirstLine <= LastLine do begin
    LI := GetLineInfos(FirstLine);
    if dlTraceLine in LI then begin
      if dlBreakpointLine in LI then
        ImgIndex := 2
      else
        ImgIndex := 1;
    end else if dlExecutableLine in LI then begin
      if dlBreakpointLine in LI then
        ImgIndex := 3
      else
      begin
        if Length(Editor.Lines[FirstLine - 1]) > 0 then
          ImgIndex := 0
        else
          ImgIndex := -1;
      end;
    end else begin
      if dlBreakpointLine in LI then
        ImgIndex := 4
      else