fdoc.pas

Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器

      frmMain.Modified1.Checked := True;
    end;
    frmMain.stbMain.Panels[2].Text := SModified
  end
  else begin
    if bModified = True then begin
      bModified := False;
      frmMain.tcFiles.Repaint;
      dmMain.actEditModified.Checked := False;
      frmMain.Modified1.Checked := False;
    end;
    frmMain.stbMain.Panels[2].Text := '';
  end;
  frmMain.stbMain.Panels[3].Text := GetsciMainState;

end;

procedure TfrmDoc.sciMainPaintTransient(Sender: TObject; Canvas: TCanvas;
  TransientType: TTransientType);
const
  BracketSet = ['{', '[', '(', '}', ']', ')', '<', '>'];
  OpenChars: array[0..3] of Char = ('{', '[', '(', '<');
  CloseChars: array[0..3] of Char = ('}', ']', ')', '>');
var
  P1, P2: TPoint;
  s: String;
  B1, B2: Char;
  Attri: TSynHighlighterAttributes;
  R1, R2: TRect;

  function GetOpposite(C: Char): Char;
  var
    i: integer;
  begin
    Result := #0;
    for i := 0 to High(OpenChars) do
      if C = OpenChars[i] then begin
        Result := CloseChars[i];
        Exit;
      end;
    for i := 0 to High(CloseChars) do
      if C = CloseChars[i] then begin
        Result := OpenChars[i];
        Exit;
      end;
  end;
begin
  if (not gbHighlightBrackets) or (SciMain.Highlighter = nil) then
    Exit;
  P1 := SciMain.CaretXY;
  sciMain.GetHighlighterAttriAtRowCol(P1, s, Attri);
  P2 := sciMain.GetMatchingBracketEx(P1, True);
  if (fPrevBrack1.x <> P1.x) or (fPrevBrack1.y <> P1.y) or (fPrevBrack2.x <> P2.x) or
    (fPrevBrack2.y <> P2.y) then begin
    sciMain.InvalidateLine(fPrevBrack1.y);
    fPrevBrack1 := P1;
    sciMain.InvalidateLine(fPrevBrack2.y);
    fPrevBrack2 := P2;
  end;
  if ({(P2.x = 0) and (P2.y = 0)) or }sciMain.SelAvail) or (Length(S) <> 1) then
    Exit;
  B1 := S[1];

  if B1 in BracketSet then begin
    with Canvas.Font do begin
      Assign(sciMain.Font);
      Style := Attri.Style;
      if (p2.x <> 0) and (p2.y <> 0) then
        Color := gcMatchBracketColor   // Inverse Font Color
      else
        Color := gcBadBracketColor;
    end;
    Canvas.Font.Style := [fsBold];
    if (p2.x <> 0) and (p2.y <> 0) then
      Canvas.Brush.Color := gcMatchBracketColorBack  // Backcolor
    else
      Canvas.Brush.Color := gcBadBracketColorBack;
    B2 := GetOpposite(B1);
    P1 := sciMain.RowColumnToPixels(P1);
    P2 := sciMain.RowColumnToPixels(P2);
    R1.Top := P1.y;
    R1.Bottom := R1.Top + Canvas.TextHeight(B1);
    R1.Left := P1.x;
    R1.Right := R1.Left + Canvas.TextWidth(B1);
    Canvas.FillRect(R1);
    Canvas.TextOut(P1.x, P1.y, B1);
    R2.Top := P2.y;
    R2.Bottom := R2.Top + Canvas.TextHeight(B2);
    R2.Left := P2.x;
    R2.Right := R2.Left + Canvas.TextWidth(B2);
    Canvas.FillRect(R2);
    Canvas.TextOut(P2.x, P2.y, B2);
  end;
end;

procedure TfrmDoc.DoUpdateCaption;
var
  x: integer;
begin
  x := GetIconIndexFromFile(FileName, true);
  dmMain.imlShellIcon.GetIcon(x, Icon);
end;

procedure TfrmDoc.ShowPropertiesDialog;
var
  i: integer;
begin
  with TFilePropertiesDialog.Create(Self) do begin
    try
      Editor := Self;
      if ShowModal = mrOK then begin
        //fEditor.SetLinebr(TLineBreak(cboLinebreak.ItemIndex + 1));
        sciMain.ReadOnly := chkReadOnly.Checked;
        sciMain.Modified := chkModfified.Checked;
        dmMain.actEditReadOnly.Checked := sciMain.ReadOnly;
        dmMain.actEditModified.Checked := sciMain.Modified;
        sciMain.Highlighter := cboLanguage.Items.Objects[cboLanguage.ItemIndex] as TSynCustomHighlighter;
        fLineBreak := TLineBreak(cboLinebreak.ItemIndex + 1);
        for I:= 0 to frmMain.LineBreak1.Count - 1 do
          if frmMain.LineBreak1.Items[i].Tag = Integer(fLineBreak) then
            frmMain.LineBreak1.Items[i].Checked := true
          else
            frmMain.LineBreak1.Items[i].Checked := false;

      end;
    finally
      Free;
    end;
  end;
end;

procedure TfrmDoc.NeedUpdateFunc(Y: Integer);
var
  i,b,g,f,linecnt: Integer;
  d: Pchar;
begin
  linecnt := 0;
  if sciMain.SelLength > 1 then begin
    // This means we have some stuff selected. It could also mean that there is a function
    // located in the selected text. so we want to check if any functions are there and
    // remove them from the list
    d := PChar(sciMain.SelText);
    linecnt := 0;
    for i:= 0 to StrLen(d) do begin
      if d[i] = chr(10) then inc(LineCnt);
    end;
    for i:= cmbKeywords.Items.Count - 1 downto 0 do begin
      if Pos(cmbKeywords.Items[i], sciMain.SelText) <> 0 then
        cmbKeywords.Items.Delete(i);
    end;
  end;
  y := y - linecnt;
  for i:= 0 to cmbKeywords.Items.Count - 1 do begin
    b := Pos(cmbKeywords.Items[i], sciMain.Lines[Integer(cmbKeywords.Items.Objects[i])]);
    if y < 0 then f := -(y);
    if Integer(cmbKeywords.Items.Objects[i]) + dmMain.iAdd > (sciMain.CaretXY.Y) then begin

      g := Integer(cmbKeywords.Items.Objects[i]) + y;
      cmbKeywords.Items.Objects[i] := TObject(g);
    end;
  end;
  dmMain.iAdd := 0;
end;

procedure TfrmDoc.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
    if (bCloseAll = False) then
      if (sciMain.Modified) or (hxMain.Modified) then
        if dmMain.CloseAll(Self) = mrCancel then
          CanClose := False;
end;

procedure TfrmDoc.sciMainReplaceText(Sender: TObject; const ASearch,
  AReplace: String; Line, Column: Integer; var Action: TSynReplaceAction);
var
  APos: TPoint;
  EditRect: TRect;  
begin
  if ASearch = AReplace then
    Action := raSkip
  else begin
    APos := Point(Column, Line);
    APos := sciMain.ClientToScreen(sciMain.RowColumnToPixels(APos));
    EditRect := ClientRect;
    EditRect.TopLeft := ClientToScreen(EditRect.TopLeft);
    EditRect.BottomRight := ClientToScreen(EditRect.BottomRight);
    if bReplaceAll = False then begin
      if ConfirmReplaceDialog = nil then
        ConfirmReplaceDialog := TConfirmReplaceDialog.Create(Application);
      ConfirmReplaceDialog.PrepareShow(EditRect, APos.X, APos.Y,
        APos.Y + sciMain.LineHeight, ASearch);
      case ConfirmReplaceDialog.ShowModal of
        mrYes: Action := raReplace;
        mrYesToAll: Action := raReplaceAll;
        mrNo: Action := raSkip;
        else Action := raCancel;
      end;
    end
    else
      Action := raReplaceAll;
  end;
  bReplaceAll := False;
end;

procedure TfrmDoc.DoFormatLines;
var
  i, j, re: integer;
  lin: TStrings;
  b, m: boolean;
  procedure BreakLine(AIndex, AAt: integer);
  var
    fp, lp: string;
  begin
    if length(lin[AIndex]) > AAt then begin
      fp := Copy(lin[AIndex], 1, AAt);
      lp := Copy(lin[AIndex], AAt + 1, Length(lin[AIndex]) - AAt);
      lin[AIndex] := fp;
      lin.Insert(AIndex + 1, lp);
    end;
  end;
begin
  re := sciMain.RightEdge;
  lin := sciMain.Lines;
  lin.BeginUpdate;
  m := false;
  i := 0;
  while i < lin.Count do begin
    b := false;
    if Length(lin[i]) > re then begin
      m := true;
      for j := re downto re div 2 do
        if IsWhiteSpaceEx(lin[i][j]) then begin
          BreakLine(i, j);
          b := true;
          Break;
        end;
      if not b then begin
        for j := re to re + 5 do
          if IsWhiteSpaceEx(lin[i][j]) then begin
            BreakLine(i, j);
            b := true;
            Break;
          end;
        end;
      if not b then
        BreakLine(i, re);
    end;
    Inc(i);
  end;
  lin.EndUpdate;
  sciMain.Modified := m;
end;


procedure TfrmDoc.cmbLangChange(Sender: TObject);
begin
  sciMain.Highlighter := dmMain.SetHighlighter(cmbLang.text);
  ListFunctions;
  dmMain.synSpell.Editor := sciMain;
end;


procedure TfrmDoc.FormDestroy(Sender: TObject);
begin
  bDestroying := True;
end;

procedure TfrmDoc.ListFunctions;
var
  ptCaret: TPoint;
  i,b,c,l,g,m,x: Integer;
  idx: Integer;
  d: PChar;
  OnlySpaces: Boolean;
  attr: TSynHighlighterAttributes;
  mf: String;
  s: String;
begin
  ptCaret := sciMain.CaretXY;
  cmbKeywords.Clear;
  if sciMain.Highlighter = nil then exit;
  if sciMain.Highlighter.FunctionKeys.Count = 0 then exit;
  for m:=0 to sciMain.Lines.Count - 1 do begin
    for g := 0 to sciMain.Highlighter.FunctionKeys.Count - 1 do begin
      i:= Pos(sciMain.Highlighter.FunctionKeys[g], LOwerCase(sciMain.Lines[m]));
      d := PChar(sciMain.Highlighter.FunctionKeys[g]);
      OnlySpaces := false;
      if i <> 0 then begin
        if PChar(sciMain.Lines[m])[i+StrLen(d)-1] <> ' ' then continue;
        if (i > 1) and (sciMain.Highlighter.CanhaveCharsBefore = false) then begin
          for x := 1 to i do begin
            if (OnlySpaces = False) and (d[x] <> ' ') and (d[x] <> '') and (x <> i) then begin
              OnlySpaces := True;
            end;
          end;
        end;
        ptCaret.X := i;
        ptCaret.y := m+1;
        sciMain.GetHighlighterAttriAtRowCol(ptCaret, mf, attr);
        if (onlySpaces = false) and (attr = sciMain.Highlighter.CommentAttribute) then
          OnlySpaces := True;
        if OnlySpaces = False then begin

          s := RightStr(sciMain.Lines[m], StrLen(PChar(sciMain.Lines[m])) - StrLen(PChar(sciMain.Highlighter.FunctionKeys[g]))-i);
          d := PChar(s);
          {if d[0]= ' ' then begin
            l := 1;
          end;}
          idx := -1;
          for c := 0 to cmbKeywords.Items.Count - 1 do begin
            if Integer(cmbKeywords.Items.Objects[c]) = (m+1) then begin
            cmbKeywords.Items.Delete(c);
          end;
        end;
        if idx = -1 then idx := cmbKeywords.Items.Count;
        //if l > 0 then begin
          s := Rightstr(sciMain.Lines[m], strLen(PChar(s)));

//          if (cmbKeywords.Items.IndexOf(s) = -1) then
            cmbKeywords.Items.InsertObject(idx, s, TOBject(m+1));
       end;
      end;
      end;
    end;
end;
procedure TfrmDoc.cmbKeywordsChange(Sender: TObject);
var
  lPoint: TPoint;
begin
  lPoint.y := Integer(cmbKeywords.Items.Objects[cmbKeywords.ItemIndex]);
  lPoint.X := 0;
  sciMain.CaretXY := lPoint;
  sciMain.SetFocus;
end;

procedure TfrmDoc.UpdatePageLabel;
begin
  lbPage.Caption := Format('Page %d of %d', [SynEditPrintPreview.PageNumber, dmMain.Print.PageCount]);
end;


procedure TfrmDoc.spbtnCloseClick(Sender: TObject);
begin
  pnlPrintPreview.Visible := False;
end;

procedure TfrmDoc.Print;
begin
  dmMain.Print.SynEdit := sciMain;
  dmMain.Print.Title := 'cEdit - ' + FileName;
  dmMain.PrintDialog.FromPage := 1;
  dmMain.PrintDialog.ToPage := dmMain.Print.PageCount;
  dmMain.PrintDialog.MinPage := 0;
  dmMain.PrintDialog.MaxPage := dmMain.Print.PageCount;
  if dmMain.PrintDialog.Execute then begin
    dmMain.Print.PrintRange(dmMain.PrintDialog.FromPage, dmMain.PrintDialog.ToPage);
  end;
end;


procedure TfrmDoc.spbtnFirstClick(Sender: TObject);
begin
  SynEditPrintPreview.FirstPage;
  UpdatePageLabel;
end;

procedure TfrmDoc.spbtnPreviousPageClick(Sender: TObject);
begin
  SynEditPrintPreview.PreviousPage;
  UpdatePageLabel;

end;

procedure TfrmDoc.spbtnNextPageClick(Sender: TObject);
begin
  SynEditPrintPreview.NextPage;
  UpdatePageLabel;

end;

procedure TfrmDoc.spbtnLastClick(Sender: TObject);
begin
  SynEditPrintPreview.LastPage;
  UpdatePageLabel;

end;

procedure TfrmDoc.edtZoomChange(Sender: TObject);
var
  i, code: Integer;
begin
  val(edtZoom.Text, i, code);
  if code = 0 then begin
    SynEditPrintPreview.ScalePercent := i;
  end;
end;

procedure TfrmDoc.chbLineNumbersClick(Sender: TObject);
begin
  dmMain.Print.LineNumbers := chbLineNumbers.Checked;
  SynEditPrintPreview.UpdatePreview;
  SynEditPrintPreview.Refresh;
end;

procedure TfrmDoc.spbtnPrintClick(Sender: TObject);
var
  p: TSynEditUndoList;
  d: TsyneditUndoItem;
begin
  Print;
end;

procedure TfrmDoc.SetHigh(str: String);
begin
  dmMain.SetHighlighter(str);
end;

procedure TfrmDoc.cmbKeywordsDropDown(Sender: TObject);
begin
  ListFunctions;
end;

end.