unit1.pas

这是所谓的折叠函数的代码,有兴趣的可拿去研究研究,经典

unit Unit1;
{
【功能说明】
1、“打开文件按钮”
  打开一个pas文件，加载到编辑区。当提示是否折叠刷新时，请点确定。

2、“保存文件按钮”
  首先确保已经“折叠刷新”过，否则不能保存。

3、“折叠刷新按钮”
  打开或粘贴一段程序后，首先要进行“折叠刷新”才能折叠。

4、“折叠级数”
  录入折叠级数，或把光标置于要折叠的行，可进行该层的折叠。

5、“画线按钮”
  选中后，光标置于含有begin /end 的行，会自动出现红色线标识。

6、折叠方法：
  光标置于含有begin的行，点击编辑区左面的灰色区域，即可实现折叠。

}
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SynEdit, SynEditHighlighter, SynHighlighterPas, SynMemo,
  StdCtrls, ComCtrls, uUPClickSplitter, ExtCtrls, ImgList,
  SynHighlighterMulti, SynEditTypes, FrStatus, Menus, StdActns, ActnList, StrUtils,
  SynEditMiscClasses, SynEditSearch, SynEditRegexSearch, Buttons;

type
  TForm1 = class(TForm)
    SynPasSyn1: TSynPasSyn;
    Panel1: TPanel;
    SynMemo1: TSynMemo;
    UPClickSplitter1: TUPClickSplitter;
    Panel2: TPanel;
    TreeView1: TTreeView;
    Panel3: TPanel;
    Panel4: TPanel;
    UPClickSplitter2: TUPClickSplitter;
    Button4: TButton;
    Button1: TButton;
    ImageList1: TImageList;
    Button3: TButton;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    Label1: TLabel;
    Button2: TButton;
    Button6: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    CheckBox1: TCheckBox;
    sBar1: TFriendlyStatusBar;
    Button5: TButton;
    PopupMenu1: TPopupMenu;
    ActionList1: TActionList;
    EditCut1: TEditCut;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    EditSelectAll1: TEditSelectAll;
    EditDelete1: TEditDelete;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    Memo1: TMemo;
    N1: TMenuItem;
    Button7: TButton;
    Button8: TButton;
    N2: TMenuItem;
    N6: TMenuItem;
    Button9: TButton;
    Button10: TButton;
    Edit3: TEdit;
    Edit4: TEdit;
    SynEditSearch: TSynEditSearch;
    SynEditRegexSearch: TSynEditRegexSearch;
    Panel5: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    AcSearch: TAction;
    AcSearchNext: TAction;
    AcSearchBack: TAction;
    procedure SynMemo1Scroll(Sender: TObject; ScrollBar: TScrollBarKind);
    procedure Button4Click(Sender: TObject);

    procedure TreeView1Expanded(Sender: TObject; Node: TTreeNode);
    procedure TreeView1Collapsing(Sender: TObject; Node: TTreeNode;
      var AllowCollapse: Boolean);

    procedure SynMemo1Click(Sender: TObject);
    procedure SynMemo1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TreeView1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure SynMemo1GutterClick(Sender: TObject; Button: TMouseButton; X,
      Y, Line: Integer; Mark: TSynEditMark);
    procedure SynMemo1PaintTransient(Sender: TObject; Canvas: TCanvas;
      TransientType: TTransientType);
    procedure CheckBox1Click(Sender: TObject);
    procedure SynMemo1Change(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure SynMemo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure N1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure AcSearchExecute(Sender: TObject);
    procedure AcSearchNextExecute(Sender: TObject);
    procedure AcSearchBackExecute(Sender: TObject);
    procedure AcSearchNextUpdate(Sender: TObject);
    procedure AcSearchBackUpdate(Sender: TObject);
  private
    FKeyList: TStrings;
    FStrList: TStrings; //保存去掉注释的synMemo内容；

    FDoPainEvent: Boolean;

    FInFun: Boolean; //进入函数时为true

    FPixBegin, FPixEnd: TPoint;

    //判断函数是否定义完毕
    FfunDefined: Boolean;
    FfunOpen: Boolean;
    FfunClose: Boolean;

    FScrollTree: Boolean;

    fSearchFromCaret: Boolean;

    procedure ToTree;
    function VisIndex(ANode: TTreeNode): Integer;
    function VisNode(VisRow: Integer): TTreeNode;
    procedure ScrollTree;
    procedure KillZhuShi;
    procedure AllCollapse(nLevel: Integer);
    procedure DrawRect(x1, y1, x2, y2: Integer);
    function FunDefined(sLine: string): Boolean; //判断函数是否定义完毕

    procedure DoLockScreen(sHint: string);
    procedure DoUnLockScreen;

    function FindBeginEnd(var FromLine, ToLine: Integer): Boolean;

    //独立函数------------------------------------------------------------------------------
    function IsNumber(Value: string): Boolean;
    procedure DisPoseTree(ATree: TTreeView);
    function ShowWarnMsg(ErrorStr: string; IncCancel: Boolean = False): Integer;
    function FindKeyStr(const SourStr: string; KeyStr: string): Boolean;
    procedure ShowSearchReplaceDialog(AReplace: Boolean);
    procedure DoSearchReplaceText(AReplace: Boolean;
      ABackwards: Boolean);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses csfuna, dlgSearchText, dlgReplaceText, dlgConfirmReplace,
  SynEditMiscProcs;

//csw : Add >>为查找而准备的--------------------
var
  gbSearchBackwards: Boolean;
  gbSearchCaseSensitive: Boolean;
  gbSearchFromCaret: Boolean;
  gbSearchSelectionOnly: Boolean;
  gbSearchTextAtCaret: Boolean;
  gbSearchWholeWords: Boolean;
  gbSearchRegex: Boolean;

  gsSearchText: string;
  gsSearchTextHistory: string;
  gsReplaceText: string;
  gsReplaceTextHistory: string;

resourcestring
  STextNotFound = 'Text not found';
  //csw : End <<--------------------

{$R *.dfm}
  //-静态函数-----------------------------------------------------------------------------
function TForm1.IsNumber(Value: string): Boolean;
var
  V: Double;
  E: Integer;
begin
  Val(Value, V, E);
  result := E = 0;
end;

procedure TForm1.DisPoseTree(ATree: TTreeView);
var i: Integer;
  ThisNode: TTreeNode;
begin
  for i := ATree.Items.count - 1 downto 0 do
  begin
    ThisNode := ATree.Items[i];
    if ThisNode.data <> nil then
      Dispose(ThisNode.data);
    ThisNode.data := nil;
  end;
end;

function TForm1.ShowWarnMsg(ErrorStr: string; IncCancel: Boolean = False): Integer;
var
  Buttons: Word;
begin
  if not IncCancel then
    Buttons := MB_OK + MB_ICONWARNING
  else
    Buttons := MB_OKCANCEL + MB_ICONWARNING;

  result := application.MessageBox(PChar(ErrorStr), '警告！', Buttons);
end;

function TForm1.FindKeyStr(const SourStr: string; KeyStr: string): Boolean;
var i, cnt, keyCnt, StrCnt: Integer;
  Str: string;
begin

  result := False;
  Str := LowerCase(SourStr);
  KeyStr := LowerCase(KeyStr);

  StrCnt := Length(Str);
  keyCnt := Length(KeyStr);
  i := Pos(KeyStr, Str);

  if i <= 0 then Exit;

  if i = 1 then
  begin
    if StrCnt = keyCnt then //'begin'
    begin
      result := true;
      Exit;
    end;

    if Str[keyCnt + 1] <> ' ' then Exit; //'beginNo'
  end;

  if i > 1 then
  begin
    // if (Pos('//', KeyStr) < i) then Exit; //该关键字被注释

    if (Str[i - 1] <> ' ') then Exit; // 'Nobegin'
    if (i + keyCnt - 1) = StrCnt then //'  begin'
    begin
      result := true;
      Exit;
    end;

    if (Str[i + keyCnt] <> ' ') then Exit; //'  beginNo'
  end;
  result := true;
end;

//------------------------------------------------------------------------------
function TForm1.VisIndex(ANode: TTreeNode): Integer;
var i, VisI: Integer;
  AbsI: Integer;

begin
  result := -1;
  VisI := 0;
  if ANode = nil then
    Exit;

  AbsI := ANode.AbsoluteIndex;
  for i := 0 to AbsI do
  begin
    if TreeView1.Items[i] = ANode then
    begin
      result := VisI;
      Break;
    end;
    if TreeView1.Items[i].IsVisible then
      inc(VisI);
  end;
end;

{ToDo : visNode}
function TForm1.VisNode(VisRow: Integer): TTreeNode;
var i, j: Integer;
  ThisNode: TTreeNode;
begin
  j := -1;
  result := nil;

  //方法1------------------------------------------------------------------------------
  {ThisNode := TreeView1.Items[0];
  while ThisNode <> nil do
  begin
    inc(j);
    if j = VisRow then
    begin
      result := thisnode;
      Break;
    end;

    ThisNode := ThisNode.GetNextVisible;
  end;
      }

  //方法2------------------------------------------------------------------------------
  for i := 0 to TreeView1.Items.count - 1 do //
  begin
    if TreeView1.Items[i].IsVisible then
    begin
      inc(j);
      if j = VisRow then
      begin
        result := TreeView1.Items[i];
        Break;
      end;
    end;
  end;

end;

{ToDo : FormCreate}
procedure TForm1.FormCreate(Sender: TObject);
begin
  FStrList := TStringList.Create;
end;
//------------------------------------------------------------------------------
{ToDo : KillZhuShi}
procedure TForm1.KillZhuShi;
var TmpLine, CLine: string;
  i, j, StrCnt, PosI: Integer;
  JiCnt: Integer; // '{}'型注释计数
begin
  JiCnt := 0;
  FStrList.Clear;
  for i := 0 to SynMemo1.Lines.count - 1 do
  begin

    TmpLine := SynMemo1.Lines[i];
    StrCnt := Length(TmpLine);

    //PosI :=
    if (Pos('{', TmpLine) > 0) or (Pos('}', TmpLine) > 0) then
    begin
      CLine := '';
      for j := 1 to StrCnt do
      begin
        if (TmpLine[j] <> '}') and (TmpLine[j] <> '{') then
          if JiCnt = 0 then CLine := CLine + TmpLine[j];

        if TmpLine[j] = '{' then
        begin
          JiCnt := 1;
          CLine := CLine + ' ';
        end;

        if TmpLine[j] = '}' then
          if JiCnt = 1 then
            JiCnt := 0;
      end;

      PosI := Pos('//', CLine);
      if PosI > 0 then
      begin
        Delete(CLine, PosI, StrCnt);
        FStrList.Add(CLine);
      end
      else
        FStrList.Add(CLine);

      Continue;
    end;

    if JiCnt = 0 then
    begin
      PosI := Pos('//', TmpLine);
      if PosI > 0 then
      begin
        Delete(TmpLine, PosI, StrCnt);
        FStrList.Add(TmpLine);
        Continue;
      end
      else
        FStrList.Add(TmpLine);
    end;

    if JiCnt = 1 then
      FStrList.Add('');
  end;

end;

procedure TForm1.ScrollTree;
begin
  // self.Caption := IntToStr(SynMemo1.TopLine);
  if TreeView1.Items.count > 0 then
  begin
    LockWindowUpdate(handle);
    // if TreeView1.Items[SynMemo1.TopLine - 1].IsVisible then

    TreeView1.TopItem := VisNode(SynMemo1.TopLine - 1);
    LockWindowUpdate(0);
  end;
end;

procedure TForm1.SynMemo1Scroll(Sender: TObject;
  ScrollBar: TScrollBarKind);
begin
  // ScrollTree;
end;

procedure TForm1.Button4Click(Sender: TObject);
var ThisNode, ANode: TTreeNode;
  i: Integer;
  mLineStr, TrimLine: string;
  TEvent: TTvexpandedEvent;
  PLine: ^string;
  IsZhuShi: Boolean;

label LaNodeData;
begin
  if ShowWarnMsg('折叠刷新是以当前显示文本建立折叠索引，' + #13 +
    '如果存在已折叠部分并还有用，请先展开。' + #13
    + '开始进行折叠刷新吗？', true) <> idok then Exit;

  DisPoseTree(TreeView1);
  TreeView1.Items.Clear;

  KillZhuShi; //去除注释，保存在FstrList中
  if FStrList.count <= 0 then Exit;

  if SynMemo1.Lines.count < 1 then
    Exit;

  try
    DoLockScreen('正在创建折叠索引');

    New(PLine);
    if TreeView1.Items.count < 1 then
    begin
      ThisNode := TreeView1.Items.Add(nil, SynMemo1.Lines[0]);
      PLine^ := SynMemo1.Lines[0];
      ThisNode.data := PLine;
      //  ThisNode := TreeView1.Items.add(nil, SynMemo1.Lines[0]);

    end;

    ThisNode.ImageIndex := -1; //
    if FindKeyStr(FStrList[0], 'begin') or FindKeyStr(FStrList[0], 'case')
      or FindKeyStr(FStrList[0], 'try')
      //or FindKeyStr(SynMemo1.Lines[0], 'public')
    then
      ThisNode.StateIndex := 99;

    //循环------------------------------------------------------------------------------
    for i := 1 to SynMemo1.Lines.count - 1 do
    begin
      mLineStr := LowerCase(Trim(FStrList[i]));

      if (FindKeyStr(mLineStr, 'end;') or FindKeyStr(mLineStr, 'end')) then
      begin
        if ThisNode.Level = 0 then
        begin
          ThisNode := TreeView1.Items.Add(ThisNode, 'end') //
        end
        else
        begin
          if ThisNode.StateIndex = 99 then
            ThisNode := TreeView1.Items.Add(ThisNode, 'end') //
          else
          begin
            if ThisNode.Parent.StateIndex = 99 then
              ThisNode := TreeView1.Items.Add(ThisNode.Parent, 'end')
            else
              ShowMessage('error');
          end;
        end;
        ThisNode.StateIndex := 88;
      end

      else if FindKeyStr(FStrList[i - 1], 'begin')
        or FindKeyStr(FStrList[i - 1], 'case')
        or FindKeyStr(FStrList[i - 1], 'try')
        // or FindKeyStr(SynMemo1.Lines[i - 1], 'public')
      then //上一行是begin -----------------------------------------
      begin
        ThisNode := TreeView1.Items.AddChild(ThisNode, '   '); //普通行

        if FindKeyStr(mLineStr, 'begin') or FindKeyStr(mLineStr, 'case')
          or FindKeyStr(mLineStr, 'try')
          //or FindKeyStr(mLineStr, 'public')

        then //begin行 ------------------------------------------------
        begin
          // ThisNode := TreeView1.Items.add(ThisNode, 'begin');
          ThisNode.Text := mLineStr;
          ThisNode.StateIndex := 99;
        end;

        //csw : Add >>添加function标题--------------------
        {if FindKeyStr(mLineStr, 'function') or FindKeyStr(mLineStr, 'procedure') then
        begin
          Delete(mLineStr, Pos('(', mLineStr), Length(mLineStr));
          ThisNode.Text := mLineStr;
        end;}

      end

      else
      begin

        if FindKeyStr(mLineStr, 'begin') or FindKeyStr(mLineStr, 'case')
          or FindKeyStr(mLineStr, 'try')
          //or FindKeyStr(mLineStr, 'public')
        then //begin行--------------------------------------------------
        begin
          ThisNode := TreeView1.Items.Add(ThisNode, mLineStr);
          ThisNode.StateIndex := 99;
        end
        else
        begin
          { if findkeystr(mlinestr,'function') or findkeystr(mlinestr,'procedure') then
           begin
             if thisnode.Level then

           end