syneditor.pas

用delphi写的delphi源代码 用delphi写的delphi源代码 用delphi写的delphi源代码 用delphi写的delphi源代码

{-------------------------------------------------------------------------------

   单元: SynEditor.pas

   作者: 姚乔锋

   日期: 2004.11.26

   说明: 继承SynEdit增加一些关于文档编辑方面和一些增强型功能的功能

   版本: 1.00

-------------------------------------------------------------------------------}

unit SynEditor;

interface

uses
  SysUtils, Classes, Clipbrd, Messages, Forms, Controls, Windows, Dialogs,
  Graphics, SynEdit, SynMemo, SynEditTextBuffer, SynEditHighlighter,
  SynEditPrint, SynEditExport, SynEditTypes, SynEditKeyCmds, SynEditMiscClasses,
  SynEditMiscProcs, SynMsgDialog, SynEditStrRes, SynExportRTF, SynExportHTML,
  SynExportTeX;

const

//******************************************************************************
// 新增加的自定义命令
//******************************************************************************
  // ecGotoLastChange 跳转到上次修改的位置
  ecGotoLastChange   = 901;
  // ecUpperCase 转换当前单词或选中文本中的字母为大写字母
  ecAutoUpperCase        = 902;
  // ecLowerCase 转换当前单词或选中文本中的字母为小写字母
  ecAutoLowerCase        = 903;
  // ecToggleCase 切换转换当前单词或选中文本中的字母大小写
  ecAutoToggleCase       = 904;
  // ecTitleCase 转换当前单词或选中文本中的词首字母大写
  ecAutoTitleCase        = 905;
  // ecPrint 打印本身的内容 传入参数AChar为'1'时显示 TPrintDialog
  ecPrint            = 906;
  // ecClearMarkers 清除所有的书签标记
  ecClearMarkers     = 907;
  // ecDeleteCursorWord 删除当前光标单词
  ecDeleteCursorWord = 908;
  // ecSelectLine 选中当前一行
  ecSelectLine       = 909;
  // ecSelNextWord 选择下一个单词
  ecSelNextWord      = 910;
  // ecSelPrevWord 选择上一个单词
  ecSelPrevWord      = 911;
  // ecSelNextLine 选择下行
  ecSelNextLine      = 912;
  // ecSelLastLine 选择上行
  ecSelPrevLine      = 913;


type

  // TSynDocumentState 编辑器文档状态类型
  TSynDocumentState = (
    smsNormal,    // 新建文档状态
    smsDocument   // 打开文档状态
  );

  // TSynDocumentOptions 载入文档或者保存时的选项
  TSynDocumentOptions = set of (
    doSelection,  // 载入文档到当前位置或保存文档选择部分
    doReset,      // 载入或保存后将文档还原最原始编辑状态
    doDefine      // 载入或保存时使用对话框
    );

  // TSynDocumentEvent 载入文档或者保存时的事件
  TSynDocumentEvent = procedure(Sender: TObject;
    Stream : TStream;              //载入文档或输出文档的流,可改写
    Options : TSynDocumentOptions  //载入文档或输出文档的选项
  ) of Object;

  TCustomSynEditor = class(TSynMemo)
  private
    FDocumentName: string;
    FOnLoadDocument: TSynDocumentEvent;
    FOnSaveDocument: TSynDocumentEvent;
    FOnCloseDocument: TNotifyEvent;
    FDocumentState: TSynDocumentState;
    FLastChangePos : TBufferCoord;
    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
    // getDocumentFormat 返回编辑器的文本格式
    function getDocumentFormat: TSynEditFileFormat;
    // SetDocumentFormat 设置编辑器的文本格式
    procedure SetDocumentFormat(const Value: TSynEditFileFormat);
    // SetDocumentName 改变载入文档的名称
    procedure SetDocumentName(const Value: string);
  protected
    // 重载DoChange事件
    procedure DoChange; override;
    // DoLoadDocument 执行 OnLoadDocument 的事件
    procedure DoLoadDocument(Stream: TStream;
      Options : TSynDocumentOptions); virtual;
    // DoSaveDocument 执行 OnSaveDocument 的事件
    procedure DoSaveDocument(Stream: TStream;
      Options : TSynDocumentOptions); virtual;
    // DoCloseDocument 执行 OnCloseDocument 的事件
    procedure DoCloseDocument; virtual;
  public
    destructor Destroy; override;
    // LoadDocument 加载一个文档
    function LoadDocument(Document : string; OpenDialog : TOpenDialog;
      Options: TSynDocumentOptions) : boolean;
    // SaveDocument 加载一个文档 其它参考LoadDocument
    function SaveDocument(Document : string; SaveDialog : TSaveDialog;
      Options: TSynDocumentOptions) : boolean;
    // ExportDocument 导出一个文档 导出的类型由Exporter决定
    procedure ExportDocument(Document : string; Exporter : TSynCustomExporter;
      Options: TSynDocumentOptions);
    // CloseDocument 关闭文档 SaveDialog 不能为空
    function CloseDocument(SaveDialog : TSaveDialog;
      Reset : boolean): boolean;
    // Reset 还原编辑状态
    procedure Reset;
    // ExecuteCommand 执行自定义增强的命令
    procedure ExecuteCommand(Command: TSynEditorCommand;
      AChar: char; Data: pointer); override;
    // DocumentName 加载的文件的名称
    property DocumentName : string read FDocumentName write SetDocumentName;
    // DocumentState 保存一个状态，说明当前是否有加载文件
    property DocumentState : TSynDocumentState read FDocumentState  write FDocumentState;
    // DocumentFormat 加载文件的存储格式
    property DocumentFormat : TSynEditFileFormat read getDocumentFormat write SetDocumentFormat;
    // OnLoadDocument 加载文件时的事件
    property OnLoadDocument : TSynDocumentEvent read FOnLoadDocument write FOnLoadDocument;
    // OnSaveDocument 保存文件时的事件
    property OnSaveDocument : TSynDocumentEvent read FOnSaveDocument write FOnSaveDocument;
    // OnCloseDocument 关闭文件时的事件
    property OnCloseDocument : TNotifyEvent read FOnCloseDocument write FOnCloseDocument;
  end;

  TSynEditor = class(TCustomSynEditor)
  published
    property DocumentName;
    property DocumentState;
    property DocumentFormat;
    property OnLoadDocument;
    property OnSaveDocument;
    property OnCloseDocument;
  end;

var
  FocusSynEditor : TCustomSynEditor;

implementation

{ TCustomSynEditor }

function TCustomSynEditor.CloseDocument(SaveDialog: TSaveDialog;
  Reset: boolean): boolean;
begin
  result := false;
  If Modified then
  begin
    case MessageDlg(format(sSavePromptText, [DocumentName]), sSavePromptTitle,
      mtConfirmation, [sSavePromptYesBtn, sSavePromptNotBtn,
      sSavePromptCancelBtn]) of
      1 :
      begin
        If (FDocumentState = smsNormal) and
         (not SaveDocument(DocumentName, SaveDialog, [doDefine, doReset])) then
         exit
        else if (FDocumentState = smsDocument) and
         (not SaveDocument(DocumentName, SaveDialog, [doReset])) then
         exit;
      end;
      3 : exit;
    end;
  end;
  DoCloseDocument;
  If Reset then
  begin
     FDocumentState := smsNormal;
     FDocumentName := '';
     Lines.Clear;
     Self.Reset;
  end;
  result := true;
end;

destructor TCustomSynEditor.Destroy;
begin
  if FocusSynEditor = self then
    FocusSynEditor := nil;
  inherited;
end;

procedure TCustomSynEditor.DoChange;
begin
  FLastChangePos := CaretXY;
  inherited;
end;

procedure TCustomSynEditor.DoCloseDocument;
begin
  IF Assigned(FOnCloseDocument) then
    FOnCloseDocument(self);
end;

procedure TCustomSynEditor.DoLoadDocument(Stream: TStream;
  Options: TSynDocumentOptions);
begin
  IF Assigned(FOnLoadDocument) then
    FOnLoadDocument(self, Stream, Options);
end;

procedure TCustomSynEditor.DoSaveDocument(Stream: TStream;
  Options: TSynDocumentOptions);
begin
  IF Assigned(FOnSaveDocument) then
    FOnSaveDocument(self, Stream, Options);
end;

procedure TCustomSynEditor.ExecuteCommand(Command: TSynEditorCommand;
  AChar: char; Data: pointer);

  procedure UpperCase;
  begin
    If SelAvail then
      Inherited ExecuteCommand(ecUpperCaseBlock, #0, nil)
    else Inherited ExecuteCommand(ecUpperCase, #0, nil);
  end;

  procedure LowerCase;
  begin
    If SelAvail then
      Inherited ExecuteCommand(ecLowerCaseBlock, #0, nil)
    else Inherited ExecuteCommand(ecLowerCase, #0, nil);
  end;

  procedure ToggleCase;
  begin
    If SelAvail then
      Inherited ExecuteCommand(ecToggleCaseBlock, #0, nil)
    else Inherited ExecuteCommand(ecToggleCase, #0, nil);
  end;

  procedure TitleCase;
  var
    s, l : string;
    i, p, t : integer;
    IdentChars, WhiteChars : TSynIdentChars;
    BB, BE, PBB, PBE  : TBufferCoord;
  begin
    If SelAvail then
    begin
      PrepareIdentChars( IdentChars, WhiteChars );
      Lines.BeginUpdate;
      BB := BlockBegin;
      BE := BlockEnd;
      //按行来进行字母检索
      for i := BB.Line to BE.Line do
      begin
        l := Lines[I-1];
        PBB.Char := 1;
        PBE.Char := Length(l)-1;
        if SelectionMode = smColumn then
        begin
          PBB := WordStartEx(BufferCoord(BB.Char, BB.Line+i-1));
          PBE := WordEndEx(BufferCoord(BE.Char, BB.Line+i-1));
        end
        else begin
          if i = BB.Line then
            PBB := WordStartEx(BufferCoord(BB.Char, BB.Line+i-1))
          else
            PBB := BufferCoord(1, BB.Line + i - 1);
          if i = BE.Line then
            PBE := WordStartEx(BufferCoord(BE.Char, BB.Line+i-1))
          else
            PBE := BufferCoord(Length(l), BB.Line + i - 1);
        end;
        s := Copy(l, PBB.Char, PBE.Char - PBB.Char + 1);
        P := Length(s);
        //对每一行的字母进行循环
        while P > 1 do
        begin
          if not (s[P] in WhiteChars) then
          begin
            t := StrRScanForCharInSet(s, p, WhiteChars) + 1;
            if t > 0 then
            begin
              If s[t] in ['a'..'z'] then
                s[t] := char(ord(s[t])-32);
              p := t;
            end;
          end;
          dec(p);
        end;
        If s[1] in ['a'..'z'] then
          s[1] := char(ord(s[1])-32);
        L := Copy(l, 1, PBB.Char-1) + s + copy(l, PBE.Char + 1, MaxInt);
        Lines[i-1] := l;
      end;
      BlockBegin := BB;
      BlockEnd := BE;
      Lines.EndUpdate;
    end else Inherited ExecuteCommand(ecTitleCase, #0, nil);
  end;

  procedure Print;
  begin
    TSynEditPrint(Data).SynEdit := self;
    TSynEditPrint(Data).Highlighter := Highlighter;
    if AChar = '1' then
      with TPrintDialog.Create(self) do
      begin
        try