📄 skyedit.pas
字号:
{*******************************************************************************
* SkyEdit -- 一个可以支持彩色语法显示的源代码编辑器 *
* *
* 功能：利用彩色语法来显示及编辑各种开发语言的源代码 *
* 版本：0.81 alpha *
* 作者：顾中军 *
* 实现： *
* 从2003年年末就开始着手写了，由于开始对VCL体系不是很熟悉，故一直是 *
* 边摸索边学习边尝试，再加上每天只能利用晚上的大约两个小时的时间来编写， *
* 有时遇到一些难点又得花上好长时间去寻找解决方法！^o^在2004年最炎热的七 *
* 八月，整个编写工作完全停了下来，唉，没办法，热得我大脑都运转不动了！ *
* 幸好，折腾了这么长时间还是把它给完成了，虽然还略显粗糙。 *
* *
* 2004.03.21 SkyEdit不含语法显示的版本初步完成，可以实现文本编辑； *
* 2004.04.16 加入鼠标拖动文本的功能，开始设计SkyParser类，加入对读 *
* 入文本中含#0的处理（我一个朋友用我写的另一个编辑器看小说时发现文本显 *
* 示不完整，我检查了才发现是#0惹的祸！）；改进了文本显示方式，使得显示 *
* 某中文字符（如“”）时不再出现错位的情况（“”之类的字符显示宽度与半 *
* 角字符差不多）； *
* 2004.05.16 开始实现Tab键的显示（利用显示的一点改进实现的呀）；开 *
* 始现彩色语法显示功能； *
* 2004.05.26 完全实现Tab键的显示；继续改进彩色语法显示部分； *
* 2004.06.08 继续完善彩色语法显示部分； *
* 2004.06.19 加入可视窗口之前的多行注释/宏/字符串的处理； *
* 2004.07.08 继续完善彩色语法显示部分，加入对数字串显示的处理； *
* 2004.09.15 记不太清了，这两个月是上海最热的时候，什么也没做；*.^ *
* 2004.10.30 开始加入Undo/Redo功能；继续改进彩色语法显示部分； *
* 2004.11.15 继续完善Undo/Redo部分；进一步增强彩色语法显示的数字串 *
* 的显示，使其支持多种形式的数字串； *
* 2004.12.10 实现SkyManager类，附带Demo中的一个简单单文档编辑器就 *
* 是使用SkyManager实现了多语言的支持；继续改进Undo/Redo部分；完全实现了 *
* SelStart、SelLength属性（本来不打算提供的），不过建议使用BlockBegin、 *
* BlockEnd来代替； *
* 2004.12.30 加入搜索功能：Find、RepalceAll、Count；加入取当前光标 *
* 处词语、取当前光标处屏幕坐标的方法；加入键盘录入字符时Undo合并功能， *
* 使得Undo/Redo时更为自然流畅； *
* *
* 说明： *
* 由于这是我第一次写数千行代码的控件（以前只写了一些几十几百行的东 *
* 东），因而很多地方都没有写好，只好以后再改进了；另外明年我得先学习一 *
* Java及.Net（没办法，想换个新工作，只得多学点东西），所以在短期内不会 *
* 作大的改进了。 *
* *
* 展望： *
* 1、作为编辑器的一个重要功能：打印，由于时间的原因这次未加入，而且 *
* 我现在没有打印机进行测试，只能以后条件具备时再完善吧； *
* 2、SkyEdit尚未实现自动换行，未来将会加入； *
* 3、语法解析部分虽然实现了，但不是很好，我明年打算研究一下有限自 *
* 动机，我觉得用一些编译器的技术来实现语法解析可能会更好； *
* 4、由于SkyEdit采用从TStringList继承而来的TSkyStringList作为文本 *
* 存储手段，故对大型文件处理起来比较费力，以后可以考虑用流与缓存的方式 *
* 加以改进； *
* 5、SkyEdit还没有书签功能，这也是一个应该加入的功能； *
* 6、对于诸如网址URL、伊妹儿EMail之类的热点链接支持亦是一个挺有用的 *
* 功能，以后再加入吧； *
* 7、查找/替换暂时还只支持对查找/替换串为单行文本的情形，对于多行文 *
* 本作为查找/替换串的情形只能留待以后完善；
* ...... *
* *
* 版权声明： *
* SkyEdit源码公开，你可以在它的基础上进行任何改进，并且你可以将它用 *
* 于任何场合； *
* 如果你有更好的改进，别忘了给我发一份啊； *
* 此外，如果你是在它的基础上改进，请保留我写的文本及说明，毕竟我花 *
* 了不少精力和时间，请尊重我的劳动成果；另外我希望你能将改进的代码公布 *
* 出来，多交流才能更快地进步嘛； *
* 因为SkyEdit的编写过程中，我从mwCustomEdit 0.62 版的源码中学到了不 *
* 少东西，在此向它的作者们表示最衷心的感谢（以下TCustomSkyEdit的实现处 *
* 有进一步的说明）；当然，由于Borland提供了几乎所有的VCL源码，使得我从 *
* 中学到了很多，故而在此对Borland及为Borland作出贡献的人们表示最诚挚的 *
* 祝福，祝Borland开发工具之树常青； *
* *
* *
* 虽然SkyEdit与一些更专业的编辑控件相比显得苗条了些，不过它还是实现 *
* 一个编辑器所应有的基本功能；因此作者在这里希望它能给想要学习和正在学 *
* 习编写控件的朋友一点帮助。 *
* 最后，愿与所有喜爱软件开发的朋友们共勉：让世界因软件而变得更美好！ *
* *
* 网站：不好意思，还没建立自己的网站呢 *
* 妹儿：iamdream@citiz.net *
*******************************************************************************}
unit SkyEdit;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, Menus, StdCtrls,
Graphics, ExtCtrls, Clipbrd, SkyParser;
type
TIndexEvent = procedure(Index: Integer) of object;
{*****************************************************************************
* 主题 TSkySearchType （搜索/替换模式） *
* *
* sktWholeWord: True -> 整词匹配，False -> 不匹配整词 *
* sktMatchCase: True -> 英文区分大小写，False -> 英文不分大小写 *
* sktRegularExpr: True -> 使用正则表达式搜索，False -> 常规搜索(预留) *
* sktBackWard: True -> 反向（向后）搜索， False ->正向（向前）搜索 *
* sktGlobal: True -> 全文搜索，False -> 只搜索选中文本 *
* sktEntireScope: True -> 从头开始搜索全部，False -> 从光标处开始搜索 *
* sktReplaceAll: True -> 替换搜索时全换， False -> 只替换第一个 *
* sktPrompt: True -> 全换时询问， False -> 全换时不提示（预留） *
*****************************************************************************}
TSkySearchType = (sktWholeWord, sktMatchCase, sktRegularExpr, sktBackWard,
sktGlobal, sktEntireScope, sktReplaceAll, sktPrompt);
TSkySearchTypes = set of TSkySearchType;
{*****************************************************************************
* 主题 TChangeMode （导致文本改变的原因或模式） *
* *
* cmInsert: 插入文本； *
* cmDelete: 删除文本； *
* cmLineBreak: 发生断行； *
* cmMultiBegin: 指开始多次增加、删除的操作 *
* cmMultiEnd: 指结束多次增加、删除的操作 *
* （包括有选中文本且需粘贴文本的情况<因其需先删后加>） *
*****************************************************************************}
TChangeMode = (cmNone,
cmInsert, cmDelete, cmLineBreak,
cmMultiBegin, cmMultiEnd
);
{*****************************************************************************
* TChangeRec 保存每次文本改变的信息，用于“撤消/重做” *
*****************************************************************************}
PChangeRec = ^TChangeRec;
TChangeRec = record
ChangeStr: PChar; //被改变的字符串（插入或删除）
ChangeMode: TChangeMode; //改变的原因或模式
ChangeBegin: TPoint; //改变开始处坐标
ChangeEnd: TPoint; //改变结束处坐标
end;
{*****************************************************************************
* TSkyUndoList -- 保存每一步的“撤消/重做”信息 *
* 说明： *
* TSkyUndoList只用一个TList来同时保存Undo/Redo信息。每次Undo后，所有 *
* Undo数据将推入Redo栈；同样，每次Redo后，所有Redo数据亦将推入Undo栈。由 *
* 于Undo/Redo实际位于同一链表中，故Undo/Redo时只需调整共用的栈指针与相关 *
* 数据即可。 *
*****************************************************************************}
TSkyUndoList = class
private
FLastMerge: Boolean; //上一次AddChange.bMerge为True???
FChgModeBuf: TChangeMode;
FList: TList;
FCanUndo: Integer; //可“撤消”的步数
FCanRedo: Integer; //可“重做”的步数
FMaxUndo: Integer; //最大可撤消步数
FCurUndoTop: Integer; //当前可撤消栈顶指针
function GetCanUndo: Integer;
function GetCanRedo: Integer;
procedure SetMaxUndo(const Value: Integer);
procedure SetCurUndoTop(const Value: Integer);
protected
procedure RemoveChange(Index: Integer);
procedure RemoveAllChange;
function GetChange(Index: Integer): TChangeMode; overload;
function GetChange(Index: Integer; var ChgBegin, ChgEnd: TPoint
): TChangeMode; overload;
function GetChange(Index: Integer; var ChgBegin, ChgEnd: TPoint;
var ChgStr: PChar): TChangeMode; overload;
procedure UpdateChgStr(Index: Integer; UpStr: PChar);
procedure UpdateChgPos(Index: Integer; ptBegin, ptEnd: TPoint);
property CurUndoTop: Integer read FCurUndoTop write SetCurUndoTop default 0;
public
constructor Create;
destructor Destroy; override;
procedure AddChange(ChgMode: TChangeMode; ChgBegin, ChgEnd: TPoint;
ChgStr: PChar; bMerge: Boolean = False);
function GetUndoChange(var ChgBegin, ChgEnd: TPoint;
var ChgStr: PChar): TChangeMode;
function GetRedoChange(var ChgBegin, ChgEnd: TPoint;
var ChgStr: PChar): TChangeMode;
function GetTopUndoChangeMode: TChangeMode;
function GetTopRedoChangeMode: TChangeMode;
procedure UpdatePopUndoChgStr(UpStr: PChar);
procedure UpdatePopRedoChgStr(UpStr: PChar);
procedure UpdatePopUndoChgPos(ptBegin, ptEnd: TPoint);
procedure UpdatePopRedoChgPos(ptBegin, ptEnd: TPoint);
published
property CanUndo: Integer read GetCanUndo;
property CanRedo: Integer read GetCanRedo;
property MaxUndo: Integer read FMaxUndo write SetMaxUndo;
end;
TCustomSkyEdit = class;
{*****************************************************************************
* TSkyStringList -- 由TStringList扩展而来，用于支持TSkyEdit *
* 说明： *
* 1、TSkyStringList只是进行了简单扩展，以支持TSkyEdit的实现，主要是 *
* TSkyEdit.Modified以及彩色语法显示的支持；并对文本支持作了扩充，即改为 *
* 显示文件中所有文本，而不是原先遇到#0即结束； *
* 2、其实，可以对本类进一步扩展，把它作为一个“文档”类独立成一个单 *
* 独的控件，使其可连到多个TSkyEdit ，这样便可实现“文档”类的共享，可得 *
* 到一些独特的效果，如多个TSkyEdit的同步更新与显示； *
* 3、对于Undo/Redo，在TCustomSkyEdit实现，故不应直接修改本类的属性， *
* 而应通过TCustomSkyEdit.Text，TCustomSkyEdit.SelText等来改变文本，这样 *
* 才能正确使用Undo/Redo功能。 *
*****************************************************************************}
TSkyStringList = class(TStringList)
private
FModified: Boolean;
FOwner: TCustomSkyEdit;
//FStreamSize: Integer;
FOnAdded: TNotifyEvent;
FOnDeleted: TIndexEvent;
FOnInserted: TIndexEvent;
FOnLoaded: TNotifyEvent;
FOnPutted: TIndexEvent;
protected
procedure Changed; override;
procedure Put(Index: Integer; const S: string); override;
procedure SetTextStr(const Value: String); override;
property OnAdded: TNotifyEvent read FOnAdded write FOnAdded;
property OnDeleted: TIndexEvent read FOnDeleted write FOnDeleted;
property OnInserted: TIndexEvent read FOnInserted write FOnInserted;
property OnLoaded: TNotifyEvent read FOnLoaded write FOnLoaded;
property OnPutted: TIndexEvent read FOnPutted write FOnPutted;
public
constructor Create(AOwner: TCustomSkyEdit); virtual;
procedure LoadFromStream(Stream: TStream); override;
procedure SaveToStream(Stream: TStream); override;
procedure Clear; override;
function Add(const S: string): Integer; override;
procedure Delete(Index: Integer); override;
procedure Insert(Index: Integer; const S: string); override;
property Modified: Boolean read FModified write FModified;
//property Owner: TCustomSkyEdit read FOwner write FOwner;
end;
{*****************************************************************************
* TCustomSkyEdit -- TSkyEdit的基类，整个彩色语法编辑器的核心 *
* 说明： *
* 1、TCustomSkyEdit的代码实现主要参考了TmwCustomEdit 0.62 beta版，其 *
* 很多功能实现则参考了Delphi本身的代码编辑器，主要用作各种通用语言的源代 *
* 码的浏览及编辑； *
* 2、虽然本编辑器的整体架构是由TmwCustomEdit而来，不过在具体的实现上 *
* 与它已有了很多不同，与它后来的版本差别就更大了（我还找了个0.92版的）， *
* 更重要的是本编辑器在基本功能方面已经趋于完善，而TmwCustomEdit 0.62版则 *
* 有很多不完善（它的0.92版已有了很大改进）；如SkyEdit已支持Tab键的显示， *
* 支持鼠标拖动文本等等； *
* 3、SkyEdit与mwCustomEdit最大的不同应该是在对多语言支持的实现上：因 *
* mwCustomEdit采用通常的做法，即为每一种支持语言创建一个Parser类，虽然它 *
* 的语法解析器实现速度更快，但通用性比较差（你得为每一种语言创建对应的解 *
* 析器类）；而SkyEdit则受UltraEdit启发，使用一个通用的SkyParser类来处理 *
* 任何语言（准确地说应该是大多数编程语言），在SkyEdit中有一些通用的函数 *
* 来处理由SkyParser提供的语言定义，这样就实现了很方便的扩展，再加上另一 *
* 个管理SkyParser的SkyManager类，最终实现了限制最小的语言支持的扩展； *
*****************************************************************************}
TCustomSkyEdit = class(TCustomControl)
private
{ Private declarations }
FHideSelection: Boolean;
//FModified: Boolean;
FReadOnly: Boolean;
FWantReturns: Boolean;
FWantTabs: Boolean;
FWordWrap: Boolean;
FInsertMode: Boolean; //当前是插入模式?
FProgramMode: Boolean; //当前是编程编辑模式?
FCursorToLeft: Boolean; //当前光标是向左移动?
FUseTabKey: Boolean; //使用TAB键值来输入?(即不用空格代替)
FCaretVisible: Boolean; //光标是否可见?
FDblClicked: Boolean; //是否为双击?
FShowLineNum: Boolean; //显示行号?
FDraging: Boolean; //正在拖动?
FSelChanged: Boolean; //选中文本已发生变化?
FAlignment: TAlignment;
FBorderStyle: TBorderStyle;
FLines: TStrings;
FOnChange: TNotifyEvent;
FOnSelChanged: TNotifyEvent;
FScrollBars: TScrollStyle;
FMaxLength: Integer;
FLeftCol: Integer; //当前最左列
FTopRow: Integer; //当前最上行
FCurCol: Integer; //当前列
FShowCol: Integer; //当前显示列，用于处理TAB键的显示所附加
FCurRow: Integer; //当前行
FLastCol: Integer; //上一次所在列标 2004.11.14
FMaxCharInLine: Integer; //编辑窗口内每行最多字符数
FTabSpaces: Integer; //当用空格代替TAB键值时空格个数
FPaintLock: Integer; //画时锁定绘制的次数
FCaretLock: Integer; //调整当前光标时锁定次数
FParserLock: Integer; //语法解析器刷新语法锁定次数
FBindLine: Integer; //编辑页面右侧的装订线?之距最左字符数(逻辑上)
FCharWidth: Integer; //当前字体半角字符的宽度
FCharsInWindow: Integer; //当前窗口内每行可见字符数
FLinesInWindow: Integer; //当前窗口内可见字符行数
FTextHeight: Integer; //当前字体的高度
FGutterColor: TColor; //编辑区左侧装订区背景色
FGutterWidth: Integer; //编辑区左侧装订区宽度 <= 0：无装订区
FOriginCursor: TCursor; //编辑区原始光标
FSelBkgColor: TColor; //选中文本背景色
FSelFrgColor: TColor; //选中文本前景色
FBlockBegin: TPoint; //选中文本起始位置
FBlockEnd: TPoint; //选中文本结束位置
FLineNumFont: TFont; //行号显示字体
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -