fdoc.pas

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

unit fDoc;

interface

uses
  Windows, Messages, strUtils, SysUtils, Variants, Classes, Graphics, Forms,
  Dialogs,StdCtrls, IniFiles, Controls, SynEdit, ShellAPI,
  SynCompletionProposal, SynEditPlugins, SynMacroRecorder, Grids, hexEditor, uOptVars,
  SynSpellCheck, ExtCtrls, Menus, ComCtrls, ToolWin, ImgList,SynEditHighlighter,
  Tabs, SynEditSearch, SynEditRegexSearch, SynEditMiscClasses, SynEditTypes,
  jpeg, UHighlighterProcs, SynEditPrintPreview, Buttons, SynEditTextBuffer, uTypes;

type
  TfrmDoc = class(TForm)
    pnlLang: TPanel;
    pnlHold: TPanel;
    hxMain: THexEditor;
    imgKey: TImage;
    imgLang: TImage;
    cmbLang: TComboBox;
    cmbKeywords: TComboBox;
    sciMain: TSynEdit;
    pnlPrintPreview: TPanel;
    pnlPrintPreviewNavigation: TPanel;
    pnlPrintPreviewNavigationRight: TPanel;
    Label1: TLabel;
    chbLineNumbers: TCheckBox;
    edtZoom: TEdit;
    UpDown1: TUpDown;
    pnlClient: TPanel;
    spbtnClose: TSpeedButton;
    spbtnPrint: TSpeedButton;
    spbtnLast: TSpeedButton;
    spbtnNextPage: TSpeedButton;
    spbtnPreviousPage: TSpeedButton;
    spbtnFirst: TSpeedButton;
    lbPage: TLabel;
    SynEditPrintPreview: TSynEditPrintPreview;
    popEdit: TPopupMenu;
    Undo2: TMenuItem;
    Redo2: TMenuItem;
    N46: TMenuItem;
    Cut2: TMenuItem;
    AppendCut2: TMenuItem;
    Copy2: TMenuItem;
    AppendCopy2: TMenuItem;
    Paste2: TMenuItem;
    Delete2: TMenuItem;
    N47: TMenuItem;
    SelectAll2: TMenuItem;
    N50: TMenuItem;
    HexEdit2: TMenuItem;
    N48: TMenuItem;
    CheckSpelling2: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure sciMainMacroRecord(Sender: TObject; message, wParam,
      lParam: Integer);
    procedure FormCreate(Sender: TObject);
    procedure sciMainStatusChange(Sender: TObject;
      Changes: TSynStatusChanges);
    procedure sciMainPaintTransient(Sender: TObject; Canvas: TCanvas;
      TransientType: TTransientType);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure sciMainReplaceText(Sender: TObject; const ASearch,
      AReplace: String; Line, Column: Integer;
      var Action: TSynReplaceAction);
    procedure cmbLangChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure cmbKeywordsChange(Sender: TObject);
    procedure spbtnCloseClick(Sender: TObject);
    procedure spbtnFirstClick(Sender: TObject);
    procedure spbtnPreviousPageClick(Sender: TObject);
    procedure spbtnNextPageClick(Sender: TObject);
    procedure spbtnLastClick(Sender: TObject);
    procedure edtZoomChange(Sender: TObject);
    procedure chbLineNumbersClick(Sender: TObject);
    procedure spbtnPrintClick(Sender: TObject);
    procedure cmbKeywordsDropDown(Sender: TObject);
  private
    m_sFileName: String;
    m_sFTPFileName: String;    
    fPrevBrack1, fPrevBrack2: TPoint;
    bUpdate: Boolean;
    bModified: Boolean;
    sHighlighter: String;
    { Private declarations }
    function GetsciMainState: string;
  public
    strMacro: TStringList;
    fLineBreak: TLineBreak;
    propFile: String;
    bHexMode: Boolean;
    pKeywords: String;
    pWords: PChar;
    findFlags: TSynSearchOptions;
    findString: String;
    bDestroying: Boolean;
    LineInt: Integer;
    LineStore: TStringList;
    XY: Integer;
//    bfMatchWholeWord, bfMatchCase, bfFromCaret, bfSelText: Boolean;
    isFTP: Boolean;
    cString: String;
    FTPName: String;
    FTPDir: String;
    { Public declarations }
    procedure LoadSettings;
    procedure SetHigh(str: String);
    procedure ShowPropertiesDialog;
    procedure NeedUpdateFunc(Y: Integer);
    procedure DoUpdateCaption;
    procedure DoFormatLines;
    procedure ListFunctions;
    procedure ListFunctionsY(Y: Integer; Y2: Integer);
    procedure UpdatePageLabel;
    procedure Print;
    property FileName: String Read m_sFileName Write m_sFileName;
    property FTPFileName: String Read m_sFTPFileName Write m_sFTPFileName;
  end;

var
  frmDoc: TfrmDoc;

implementation

uses dlgFileProperties, fMain, dMain, dlgConfirmReplace, fOpenWindows;

{$R *.dfm}

resourcestring
  SInsert = 'Insert';
  SOverwrite = 'Overwrite';
  SReadOnly = 'Read Only';



procedure TfrmDoc.FormClose(Sender: TObject; var Action: TCloseAction);
var
  idx: Integer;
begin
  idx := frmMain.tcFiles.Tabs.IndexOfObject(Self);
  With sciMain do begin
    dmMain.actToggle0.Checked := false;
    dmMain.actToggle1.Checked := false;
    dmMain.actToggle2.Checked := false;
    dmMain.actToggle3.Checked := false;
    dmMain.actToggle4.Checked := false;
    dmMain.actToggle5.Checked := false;
    dmMain.actToggle6.Checked := false;
    dmMain.actToggle7.Checked := false;
    dmMain.actToggle8.Checked := false;
    dmMain.actToggle9.Checked := false;
  end;
  if idx > -1 then begin
    frmMain.tcFiles.Tabs.Delete(idx);
  end;
  dmMain.actEditHex.Checked := false;
  dmMain.SynAutoCorrect.Editor := sciMain;
{  if frmMain.MDIChildCount = 1 then
    dmMain.SynAutoCorrect.Destroy;
    //dmMain.SynAutoCorrect.Editor := nil;}
  Action := caFree;
end;




procedure TfrmDoc.FormActivate(Sender: TObject);
var
  idx: integer;
  i: integer;
begin
  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;

  With sciMain do begin
    dmMain.actToggle0.Checked := IsBookmark(0);
    dmMain.actToggle1.Checked := IsBookmark(1);
    dmMain.actToggle2.Checked := IsBookmark(2);
    dmMain.actToggle3.Checked := IsBookmark(3);
    dmMain.actToggle4.Checked := IsBookmark(4);
    dmMain.actToggle5.Checked := IsBookmark(5);
    dmMain.actToggle6.Checked := IsBookmark(6);
    dmMain.actToggle7.Checked := IsBookmark(7);
    dmMain.actToggle8.Checked := IsBookmark(8);
    dmMain.actToggle9.Checked := IsBookmark(9);
    frmMain.oggleBookmark1.Checked := IsBookMark(0);
    frmMain.oggleBookmark10.Checked := IsBookMark(9);
    frmMain.oggleBookmark2.Checked := IsBookMark(1);
    frmMain.oggleBookmark3.Checked := IsBookMark(2);
    frmMain.oggleBookmark4.Checked := IsBookMark(3);
    frmMain.oggleBookmark5.Checked := IsBookMark(4);
    frmMain.oggleBookmark6.Checked := IsBookMark(5);
    frmMain.oggleBookmark7.Checked := IsBookMark(6);
    frmMain.oggleBookmark8.Checked := IsBookMark(7);
    frmMain.oggleBookmark9.Checked := IsBookMark(8);

  end;

  with frmMain do begin
    dmMain.actEditHex.Checked := bHexMode;
    frmMain.HexEdit1.Checked := bHexMode;
    frmMain.tbbHex.Down := bHexMode;
    dmMain.actEditModified.Checked := sciMain.Modified;
    frmMain.Modified1.Checked := sciMain.Modified;

    dmMain.actEditReadOnly.Checked := sciMain.ReadOnly;
    frmMain.Readonly1.Checked := sciMain.ReadOnly;

  end;

  idx := frmMain.tcFiles.Tabs.IndexOfObject(Self);
  sciMainStatusChange(nil, []);
  if (idx > -1) and (idx <> frmMain.tcFiles.TabIndex) then begin
    frmMain.tcFiles.TabIndex := idx;
    frmMain.tcFilesChange(nil);
  end;
  if frmMain.tbbMacRec.Down then begin
    frmMain.tbbMacRec.Down := False;
    frmMain.tbbMacRecClick(nil);
  end;
  dmMain.SynAutoCorrect.Editor := sciMain;
  dmMain.synSpell.Editor := sciMain;
  if (sciMain.Highlighter = nil) then begin
    dmMain.SetSelLang('');
    exit; // This next step can be ignored if there's no highlighter
  end;
  dmMain.SetSelLang(sciMain.Highlighter.LanguageName);
  sciMain.SetFocus;
  Windows.SetFocus(sciMain.Handle);
end;

procedure TfrmDoc.ListFunctionsY(Y: Integer; Y2: integer);
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;
  if sciMain.Highlighter = nil then exit;
  if sciMain.Highlighter.FunctionKeys.Count = 0 then exit;
  for m:=y to y2 - 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 (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;
        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 :=  cmbKeywords.Items.Count - 1 downto 0 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.LoadSettings;

begin
  { sciMain - Options Pane }
  sciMain.SetOptionFlag(eoAutoIndent, bAutoIndent);
  sciMain.SetOptionFlag(eoAltSetsColumnMode, bAltSetsColumnMode);
  sciMain.SetOptionFlag(eoDragDropEditing, bDragDropEditing);
  sciMain.SetOptionFlag(eoDropFiles, bDragDropFiles);
  sciMain.SetOptionFlag(eoKeepCaretX, bMaintainCaretColumn);
  sciMain.WantTabs := bWantTabs;
  sciMain.SetOptionFlag(eoSmartTabs, bSmartTabs);
  sciMain.SetOptionFlag(eoSmartTabDelete, bSmartTabDelete);
  sciMain.SetOptionFlag(eoRightMouseMovesCursor, bRightMouseMovesCursor);
  sciMain.SetOptionFlag(eoEnhanceHomeKey, bEnhanceHomeKey);
  sciMain.SetOptionFlag(eoHideShowScrollBars, bHideScrollBarsAsNeeded);
  sciMain.SetOptionFlag(eoHalfPageScroll, bHalfPageScroll);
  sciMain.SetOptionFlag(eoScrollbyOneLess, bScrollByOneLess);
  sciMain.SetOptionFlag(eoScrollPastEOF, bScrollPastEndOfFile);
  sciMain.SetOptionFlag(eoScrollPastEOL, bScrollPastEndofLine);
  sciMain.SetOptionFlag(eoShowScrollHint, bShowScrollHint);
  sciMain.SetOptionFlag(eoScrollHintFollows, bScrollHintFollowsMouse);
  sciMain.SetOptionFlag(eoTabsToSpaces, bTabsToSpaces);
  sciMain.SetOptionFlag(eoTrimTrailingSpaces, bTrimTrailingSpaces);
  sciMain.SetOptionFlag(eoGroupUndo, bGroupUndo);
  sciMain.SetOptionFlag(eoDisableScrollArrows, bDisableScrollArrows);
  sciMain.InsertCaret := TSynEditCaretType(iInsertCaretMode);
  sciMain.OverwriteCaret := TSynEditCaretType(iOverWriteCaretMode);

  { sciMain - Display Pane }
  sciMain.Gutter.Visible := bGutterVisible;
  sciMain.Gutter.AutoSize := bGutterAutoSize;
  sciMain.Gutter.ShowLineNumbers := bGutterShowLineNumbers;
  sciMain.Gutter.ZeroStart := bGutterStartAtZero;
  sciMain.Gutter.LeadingZeros := bGutterShowLeadingZeros;
  sciMain.Gutter.UseFontStyle := bGutterUseGutterFont;
  sciMain.Gutter.Color := cGutterColor;
  sciMain.Gutter.Font := fGutterFont;

  sciMain.RightEdge := iEdgeColumn;
  sciMain.RightEdgeColor := iEdgeColor;

  sciMain.ExtraLineSpacing := iExtraLines;
  sciMain.TabWidth := iTabWidth;

  sciMain.BookMarkOptions.EnableKeys := bBookmarkKeys;
  sciMain.BookMarkOptions.GlyphsVisible := bBookmarksVisible;

  sciMain.Font := fEditorFont;
end;


procedure TfrmDoc.FormShow(Sender: TObject);
begin

  if (sciMain.Highlighter = nil) then exit; // This next step can be ignored if there's no highlighter
  dmmain.SetSelLang(sciMain.Highlighter.LanguageName);
  bUpdate := True;
end;

procedure TfrmDoc.sciMainMacroRecord(Sender: TObject; message, wParam,
  lParam: Integer);

begin
  if strMacro = nil then strMacro := TStringList.Create;
  strMacro.Add(IntToStr(Message) + '%' + IntToStr(wParam) + '%' + IntToStr(lParam));
end;

procedure TfrmDoc.FormCreate(Sender: TObject);
begin
//  dmMain.SynAutoCorrect.Create(nil);
  dmMain.propose.AddEditor(sciMain);
  bHexMode := False;
  LineStore := TStringList.Create;
  LineStore.Add(IntToStr(sciMain.CaretY));
  LoadSettings;
//  SynSpellCheck.LoadDictionary('English');
end;

function TfrmDoc.GetsciMainState: string;
begin
  if sciMaIn.ReadOnly then
    Result := SReadOnly
  else if sciMain.InsertMode then
      Result := SInsert
    else
      Result := SOverwrite;

end;

procedure TfrmDoc.sciMainStatusChange(Sender: TObject;
  Changes: TSynStatusChanges);
resourcestring
  SModified = 'Modified';
var
  ptCaret: TPoint;
  s: String;
  bMoveDown: Boolean;
begin
  if sciMain.Highlighter <> nil then
    if (sciMain.Highlighter.LanguageName <> sHighlighter) then begin
      sHighlighter := sciMain.Highlighter.GetLanguageName;
      s := GetLangName(sciMain.Highlighter) + '.lst';
      s := ansiReplaceText(s, '\', '');
      s := ansiReplaceText(s, '/', '');
      s := ExtractFilePath(Application.ExeName) + 'propose\' + s;
      if FileExists(s) then
        dmMain.Propose.ItemList.LoadFromFile(s);
      s := GetLangName(sciMain.Highlighter) + '.ins';
      s := ansiReplaceText(s, '\', '');
      s := ansiReplaceText(s, '/', '');
      s := ExtractFilePath(Application.ExeName) + 'propose\' + s;
      if FileExists(s) then
        dmMain.Propose.InsertList.LoadFromFile(s);
    end;
  ptCaret := sciMain.CaretXY;
  if LineStore[LineInt] <> IntToStr(ptCaret.Y) then begin
    if bDestroying <> true then begin
      LineInt := LineStore.Count;
      LineStore.add(IntToStr(ptCaret.y));
    end;
  end;

  if (ptCaret.X > 0) and (ptCaret.Y > 0) then
    frmMain.stbMain.Panels[1].Text := Format(' %6d:%3d ', [ptCaret.Y, ptCaret.X])
  else
    frmMain.stbMain.Panels[1].Text := '';
  if sciMain.Modified then begin
    if bModified = False then begin
      bModified := True;
      frmMain.tcFiles.Repaint;
      dmMain.actEditModified.Checked := True;