compform.pas

源代码

end;

procedure TCompileForm.EFindClick(Sender: TObject);
begin
  ReplaceDialog.CloseDialog;
  if FindDialog.Handle = 0 then
    InitializeFindText(FindDialog);
  FindDialog.Execute;
end;

procedure TCompileForm.EFindNextClick(Sender: TObject);
begin
  if FLastFindText = '' then
    EFindClick(Sender)
  else
    FindNext;
end;

function FindOptionsToSearchOptions(const FindOptions: TFindOptions): TSynSearchOptions;
begin
  Result := [];
  if frMatchCase in FindOptions then
    Include(Result, ssoMatchCase);
  if frWholeWord in FindOptions then
    Include(Result, ssoWholeWord);
  if not(frDown in FindOptions) then
    Include(Result, ssoBackwards);
end;

procedure TCompileForm.FindNext;
begin
  if Memo.SearchReplace(FLastFindText, '', FindOptionsToSearchOptions(FLastFindOptions)) = 0 then
    MsgBoxFmt('Cannot find "%s"', [FLastFindText], '', mbError, MB_OK);
end;

procedure TCompileForm.FindDialogFind(Sender: TObject);
begin
  { this event handler is shared between FindDialog & ReplaceDialog }
  with Sender as TFindDialog do begin
    { Save a copy of the current text so that InitializeFindText doesn't
      mess up the operation of Edit | Find Next }
    FLastFindOptions := Options;
    FLastFindText := FindText;
  end;
  FindNext;
end;

procedure TCompileForm.EReplaceClick(Sender: TObject);
begin
  FindDialog.CloseDialog;
  if ReplaceDialog.Handle = 0 then begin
    InitializeFindText(ReplaceDialog);
    ReplaceDialog.ReplaceText := FLastReplaceText;
  end;
  ReplaceDialog.Execute;
end;

procedure TCompileForm.ReplaceDialogReplace(Sender: TObject);
var
  Same: Boolean;
begin
  with ReplaceDialog do begin
    FLastFindOptions := Options;
    FLastFindText := FindText;
    FLastReplaceText := ReplaceText;

    if not(frMatchCase in Options) then
      Same := AnsiCompareText(Memo.SelText, FindText) = 0
    else
      Same := Memo.SelText = FindText;
    if Same then
      Memo.SelText := ReplaceText;

    if Memo.SearchReplace(FindText, '', FindOptionsToSearchOptions(Options)) = 0 then
      MsgBoxFmt('Cannot find "%s"', [FindText], '', mbError, MB_OK)
    else
      if frReplaceAll in Options then begin
        repeat
          Memo.SelText := ReplaceText;
        until Memo.SearchReplace(FindText, '', FindOptionsToSearchOptions(Options)) = 0;
      end;
  end;
end;

procedure TCompileForm.UpdateStatusPanelHeight(H: Integer);
var
  MinHeight, MaxHeight: Integer;
begin
  MinHeight := (3 * DebugOutputList.ItemHeight + 4) +
    SpacerPaintBox.Height + TabSet.Height;
  MaxHeight := BodyPanel.ClientHeight - 48 - SplitPanel.Height;
  if H > MaxHeight then H := MaxHeight;
  if H < MinHeight then H := MinHeight;
  StatusPanel.Height := H;
end;

procedure TCompileForm.SplitPanelMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  if (ssLeft in Shift) and StatusPanel.Visible then begin
    GetCursorPos(P);
    UpdateStatusPanelHeight(BodyPanel.ClientToScreen(Point(0, 0)).Y - P.Y +
      BodyPanel.ClientHeight - (SplitPanel.Height div 2));
  end;
end;

procedure TCompileForm.VOptionsClick(Sender: TObject);
var
  OptionsForm: TOptionsForm;
  Ini: TConfigIniFile;
begin
  OptionsForm := TOptionsForm.Create(Application);
  try
    OptionsForm.StartupCheck.Checked := FOptions.ShowStartupForm;
    OptionsForm.WizardCheck.Checked := FOptions.UseWizard;
    OptionsForm.BackupCheck.Checked := FOptions.MakeBackups;
    OptionsForm.FullPathCheck.Checked := FOptions.FullPathInTitleBar;
    OptionsForm.UndoAfterSaveCheck.Checked := FOptions.UndoAfterSave;
    OptionsForm.PauseOnDebuggerExceptionsCheck.Checked := FOptions.PauseOnDebuggerExceptions;
    OptionsForm.UseSynHighCheck.Checked := FOptions.UseSyntaxHighlighting;
    OptionsForm.CursorPastEOLCheck.Checked := FOptions.CursorPastEOL;
    OptionsForm.TabWidthEdit.Text := IntToStr(FOptions.TabWidth);
    OptionsForm.FontPanel.Font.Assign(Memo.Font);

    if OptionsForm.ShowModal <> mrOK then
      Exit;

    FOptions.ShowStartupForm := OptionsForm.StartupCheck.Checked;
    FOptions.UseWizard := OptionsForm.WizardCheck.Checked;
    FOptions.MakeBackups := OptionsForm.BackupCheck.Checked;
    FOptions.FullPathInTitleBar := OptionsForm.FullPathCheck.Checked;
    FOptions.UndoAfterSave := OptionsForm.UndoAfterSaveCheck.Checked;
    FOptions.PauseOnDebuggerExceptions := OptionsForm.PauseOnDebuggerExceptionsCheck.Checked;
    FOptions.UseSyntaxHighlighting := OptionsForm.UseSynHighCheck.Checked;
    FOptions.CursorPastEOL := OptionsForm.CursorPastEOLCheck.Checked;
    FOptions.TabWidth := StrToInt(OptionsForm.TabWidthEdit.Text);
    UpdateCaption;
    SyncEditorOptions;
    Memo.Font.Assign(OptionsForm.FontPanel.Font);
    UpdateNewButtons;

    { Save new options }
    Ini := TConfigIniFile.Create;
    try
      Ini.WriteBool('Options', 'ShowStartupForm', FOptions.ShowStartupForm);
      Ini.WriteBool('Options', 'UseWizard', FOptions.UseWizard);
      Ini.WriteBool('Options', 'MakeBackups', FOptions.MakeBackups);
      Ini.WriteBool('Options', 'FullPathInTitleBar', FOptions.FullPathInTitleBar);
      Ini.WriteBool('Options', 'UndoAfterSave', FOptions.UndoAfterSave);
      Ini.WriteBool('Options', 'PauseOnDebuggerExceptions', FOptions.PauseOnDebuggerExceptions);
      Ini.WriteBool('Options', 'UseSynHigh', FOptions.UseSyntaxHighlighting);
      Ini.WriteBool('Options', 'EditorCursorPastEOL', FOptions.CursorPastEOL);
      Ini.WriteInteger('Options', 'TabWidth', FOptions.TabWidth);
      Ini.WriteString('Options', 'EditorFontName', Memo.Font.Name);
      Ini.WriteInteger('Options', 'EditorFontSize', Memo.Font.Size);
      Ini.WriteInteger('Options', 'EditorFontCharset', Memo.Font.Charset);
    finally
      Ini.Free;
    end;
  finally
    OptionsForm.Free;
  end;
end;

procedure TCompileForm.SetErrorLine(ALine: Integer);
begin
  if FErrorLine <> ALine then begin
    if FErrorLine > 0 then
      Memo.InvalidateLine(FErrorLine);
    FErrorLine := ALine;
    if FErrorLine > 0 then
      Memo.InvalidateLine(FErrorLine);
  end;
end;

procedure TCompileForm.SetStepLine(ALine: Integer);
begin
  if FStepLine <> ALine then begin
    if FStepLine > 0 then
      Memo.InvalidateLine(FStepLine);
    FStepLine := ALine;
    if FStepLine > 0 then
      Memo.InvalidateLine(FStepLine);
  end;
end;

procedure TCompileForm.HideError;
begin
  SetErrorLine(0);
  StatusBar.Panels[spRunStatus].Text := '';
end;

procedure TCompileForm.MemoStatusChange(Sender: TObject;
  Changes: TSynStatusChanges);
const
  InsertText: array[Boolean] of String = ('Overwrite', 'Insert');
begin
  if (scCaretX in Changes) or (scCaretY in Changes) then begin
    HideError;
    StatusBar.Panels[spCaretPos].Text := Format('%4d:%4d', [Memo.CaretY, Memo.CaretX]);
  end;
  if scModified in Changes then begin
    if Memo.Modified then
      StatusBar.Panels[spModified].Text := 'Modified'
    else
      StatusBar.Panels[spModified].Text := '';
  end;
  if (scInsertMode in Changes) or (scReadOnly in Changes) then begin
    if Memo.ReadOnly then
      StatusBar.Panels[spInsertMode].Text := 'Read only'
    else
      StatusBar.Panels[spInsertMode].Text := InsertText[Memo.InsertMode];
  end;
end;

procedure TCompileForm.MemoChange(Sender: TObject);
begin
  FModifiedSinceLastCompile := True;
  if not FDebugging then begin
    { Modified while not debugging; free the debug info and clear the dots }
    if Assigned(FLineState) then
      Memo.InvalidateGutter;
    DestroyDebugInfo;
  end;
  { Need HideError here because we don't get an OnStatusChange event when the
    Delete key is pressed }
  HideError;
end;

procedure TCompileForm.MemoSpecialLineColors(Sender: TObject;
  Line: Integer; var Special: Boolean; var FG, BG: TColor);
begin
  if FErrorLine = Line then begin
    Special := True;
    FG := clWhite;
    BG := clMaroon;
  end
  else if FStepLine = Line then begin
    Special := True;
    FG := clWhite;
    BG := clBlue;
  end;
end;

procedure TCompileForm.MemoPaint(Sender: TObject; ACanvas: TCanvas);
{ Draws the gutter dots }
var
  CR: TRect;
  H, Y, I: Integer;
begin
  if FLineState = nil then Exit;
  H := Memo.LineHeight;
  Y := 0;
  CR := ACanvas.ClipRect;
  for I := Memo.TopLine to Memo.Lines.Count do begin
    if Y >= CR.Bottom then
      Break;
    if (Y + H > CR.Top) and (I <= FLineStateCount) and
       (FLineState[I] <> lnUnknown) then begin
      case FLineState[I] of
        lnHasEntry: begin
            ACanvas.Pen.Color := clGray;
            ACanvas.Brush.Color := clSilver;
          end;
        lnEntryProcessed: begin
            ACanvas.Pen.Color := clGreen;
            ACanvas.Brush.Color := clLime;
          end;
      end;
      ACanvas.Rectangle(8, Y + (H div 2) - 3, 13, Y + (H div 2) + 2);
    end;
    Inc(Y, H);
  end;
end;

procedure TCompileForm.MemoWndProc(var Message: TMessage);

  function GetCodeVariableDebugEntryFromLineCol(Line, Col: Integer): PVariableDebugEntry;
  var
    I: Integer;
  begin
    Result := nil;
    for I := 0 to FVariableDebugEntriesCount-1 do begin
      if (FVariableDebugEntries[I].LineNumber = Line) and
         (FVariableDebugEntries[I].Col = Col) then begin
        Result := @FVariableDebugEntries[I];
        Break;
      end;
    end;
  end;

var
  Line, Col, I, J: Integer;
  P, P2: TPoint;
  S, Output: String;
  DebugEntry: PVariableDebugEntry;
begin
  if (Message.Msg = CM_HINTSHOW) and (FDebugClientWnd <> 0) then begin
    with TCMHintShow(Message).HintInfo^ do begin
      P := Memo.PixelsToRowColumn(Point(CursorPos.X - Memo.CharWidth div 2,
        CursorPos.Y));
      if P.Y <= Memo.Lines.Count then begin
        Line := P.Y;
        Col := P.X;
        S := Memo.Lines[Line-1];

        if (Col >= 1) and (Col <= Length(S)) and (S[Col] in ['a'..'z','A'..'Z','0'..'9','_']) then begin
          while (Col > 1) and (S[Col-1] in ['a'..'z','A'..'Z','0'..'9','_']) do
            Dec(Col);
          DebugEntry := GetCodeVariableDebugEntryFromLineCol(Line, Col);
          if DebugEntry <> nil then begin
            J := Col;
            while S[J] in ['a'..'z','A'..'Z','0'..'9','_'] do
              Inc(J);
            case EvaluateVariableEntry(DebugEntry, Output) of
              1: HintStr := Output;
              2: HintStr := Output;
            else
              HintStr := 'Unknown error';
            end;
            P2 := Memo.RowColumnToPixels(Point(Col, P.Y));
            CursorRect := Bounds(P2.X, P2.Y, (J-Col) * Memo.CharWidth,
              Memo.LineHeight);
            HideTimeout := High(Integer);  { infinite }
            Exit;
          end;
        end;

        I := 1;
        while I <= Length(S) do begin
          if S[I] = '{' then begin
            if (I < Length(S)) and (S[I+1] = '{') then
              { Skip '{{' }
              Inc(I, 2)
            else begin
              J := SkipPastConst(S, I);
              if J = 0 then  { unclosed constant? }
                Break;
              if (P.X >= I) and (P.X < J) then begin
                HintStr := Copy(S, I, J-I);
                case EvaluateConstant(HintStr, Output) of
                  1: HintStr := HintStr + ' = "' + Output + '"';
                  2: HintStr := HintStr + ' = ' + Output;
                else
                  HintStr := HintStr + ' = Unknown error';
                end;
                P2 := Memo.RowColumnToPixels(Point(I, P.Y));
                CursorRect := Bounds(P2.X, P2.Y, (J-I) * Memo.CharWidth,
                  Memo.LineHeight);
                HideTimeout := High(Integer);  { infinite }
                Break;
              end;
              I := J;
            end;
          end
          else begin
            if S[I] in ConstLeadBytes^ then
              Inc(I);
            Inc(I);
          end;
        end;
      end;
    end;
  end
  else
    Memo.WndProc(Message);
end;

procedure TCompileForm.MemoDropFiles(Sender: TObject; X, Y: Integer;
  AFiles: TStrings);
begin
  if (AFiles.Count > 0) and ConfirmCloseFile(True) then
    OpenFile(AFiles[0]);
end;

procedure TCompileForm.StatusBarResize(Sender: TObject);
begin
  { Without this, on Windows XP with themes, the status bar's size grip gets
    corrupted as the form is resized }
  if StatusBar.HandleAllocated then
    InvalidateRect(StatusBar.Handle, nil, True);
end;

procedure TCompileForm.WMDebuggerHello(var Message: TMessage);
var
  PID: DWORD;
  WantCodeText: Boolean;
begin
  FDebugClientWnd := HWND(Message.WParam);

  { Save debug client process handle }
  if FDebugClientProcessHandle <> 0 then begin
    { Shouldn't get here, but just in case, don't leak a handle }
    CloseHandle(FDebugClientProcessHandle);
    FDebugClientProcessHandle := 0;
  end;
  PID := 0;
  GetWindowThreadProcessId(FDebugClientWnd, @PID);
  if PID <> 0 then
    FDebugClientProcessHandle := OpenProcess(PROCESS_TERMINATE, False, PID);

  WantCodeText := Bool(Message.LParam);
  if WantCodeText then
    SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeText, FCompiledCodeText);
  SendCopyDataMessageStr(FDebugClientWnd, Handle, CD_DebugClient_CompiledCodeDebugInfo, FCompiledCodeDebugInfo);

  UpdateRunMenu;
end;

procedure TCompileForm.WMDebuggerGoodbye(var Message: TMe