synedit.pas

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

    property SelectionMode: TSynSelectionMode
      read FSelectionMode write SetSelectionMode default smNormal;
    property TabWidth: integer read fTabWidth write SetTabWidth default 8;
    property WantReturns: boolean read fWantReturns write SetWantReturns default True;
    property WantTabs: boolean read fWantTabs write SetWantTabs default False;
    property WordWrap: TSynWordWrap read fWordWrap write SetWordWrap;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnClearBookmark: TPlaceMarkEvent read fOnClearMark
      write fOnClearMark;
    property OnCommandProcessed: TProcessCommandEvent
      read fOnCommandProcessed write fOnCommandProcessed;
    property OnContextHelp: TContextHelpEvent
      read fOnContextHelp write fOnContextHelp;
    property OnDropFiles: TDropFilesEvent read fOnDropFiles write fOnDropFiles;
    property OnGutterClick: TGutterClickEvent
      read fOnGutterClick write fOnGutterClick;
    property OnGutterGetText: TGutterGetTextEvent read fOnGutterGetText
      write fOnGutterGetText;
    property OnGutterPaint: TGutterPaintEvent read fOnGutterPaint
      write fOnGutterPaint;
    property OnMouseCursor: TMouseCursorEvent read fOnMouseCursor
      write fOnMouseCursor;
    property OnPaint: TPaintEvent read fOnPaint write fOnPaint;
    property OnPlaceBookmark: TPlaceMarkEvent
      read FOnPlaceMark write FOnPlaceMark;
    property OnProcessUserCommand: TProcessCommandEvent
      read FOnProcessUserCommand write FOnProcessUserCommand;
    property OnReplaceText: TReplaceTextEvent read fOnReplaceText
      write fOnReplaceText;
    property OnSpecialLineColors: TSpecialLineColorsEvent
      read fOnSpecialLineColors write fOnSpecialLineColors;
    property OnStatusChange: TStatusChangeEvent
      read fOnStatusChange write fOnStatusChange;
    property OnPaintTransient: TPaintTransient
      read fOnPaintTransient write fOnPaintTransient;
    property OnScroll: TScrollEvent
      read fOnScroll write fOnScroll;
  published
    property Cursor default crIBeam;
  end;

  TSynEdit = class(TCustomSynEdit)
  published
    // inherited properties
    property Align;
{$IFDEF SYN_COMPILER_4_UP}
    property Anchors;
    property Constraints;
{$ENDIF}
    property Color;
{$IFDEF SYN_CLX}
{$ELSE}
    property Ctl3D;
    property ParentCtl3D;
{$ENDIF}

    {$IFDEF CODEFOLDING}
    //### Code Folding ###
    property CodeFolding;
    //### End Code Folding ###
    {$ENDIF}

    (* 增加的属性放置于此，便于修改 *)
    property ActiveLine;
    property LineDivider;
    property RightEdge;
    property LineSpacing;
    property LineSpacingRule;
    property BlockWidth;
    property ScrollBars;
    property Background;
    property UnicodeFontName;
    (* end *)

    property Enabled;
    property Font;
    property Height;
    property Name;
    property ParentColor default False;
    property ParentFont default False;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop default True;
    property Visible;
    property Width;
    // inherited events
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
{$IFDEF SYN_CLX}
{$ELSE}
{$IFDEF SYN_COMPILER_4_UP}
    property OnEndDock;
    property OnStartDock;
{$ENDIF}
{$ENDIF}
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    // TCustomSynEdit properties
    property BookMarkOptions;
    property BorderStyle;
    property Gutter;
    property HideSelection;
    property Highlighter;
    property InsertCaret;
    property InsertMode;
    property Keystrokes;
    property Lines;
    property MaxScrollWidth;
    property MaxUndo;
    property Options;
    property OverwriteCaret;
    property ReadOnly;
    property SearchEngine;
    property SelectedColor;
    property SelectionMode;
    property TabWidth;
    property WantReturns;
    property WantTabs;
    property WordWrap;
    // TCustomSynEdit events
    property OnChange;
    property OnClearBookmark;
    property OnCommandProcessed;
    property OnContextHelp;
    property OnDropFiles;
    property OnGutterClick;
    property OnGutterGetText;
    property OnGutterPaint;
    property OnMouseCursor;
    property OnPaint;
    property OnPlaceBookmark;
    property OnProcessCommand;
    property OnProcessUserCommand;
    property OnReplaceText;
    property OnScroll;
    property OnSpecialLineColors;
    property OnStatusChange;
    property OnPaintTransient;
  end;

implementation

{$R SynEdit.res}

uses
{$IFDEF SYN_CLX}
  QStdActns,
  QClipbrd,
  QSynEditWordWrap,
  QSynEditStrConst;
{$ELSE}
  {$IFDEF SYN_COMPILER_4_UP}
  StdActns,
  {$ENDIF}
  Clipbrd,
  ShellAPI,

  {$IFDEF CODEFOLDING}
  //### Code Folding ###
  SynCompletionProposal,
  //### End Code Folding ###
  {$ENDIF}

  SynEditWordWrap,
  SynEditStrConst;
{$ENDIF}

{ SynEdit Flat Scroll }

//修改 用于支持平面滚动条
function  FlatSB_GetScrollInfo(hWnd : HWND; BarFlag : integer; var ScrollInfo : TScrollInfo) : Bool; stdcall;
          external comctl32 name 'FlatSB_GetScrollInfo';
function  FlatSB_SetScrollInfo(hWnd : HWND; BarFlag : integer; const ScrollInfo : TScrollInfo; Redraw : Bool) : integer; stdcall;
          external comctl32 name 'FlatSB_SetScrollInfo';
function  InitializeFlatSB(hWnd : HWND): Bool; stdcall;
          external comctl32 name 'InitializeFlatSB';
function  FlatSB_SetScrollProp(p1 : HWND; index : integer; newValue : integer; p4 : Bool) : Bool; stdcall;
          external comctl32 name 'FlatSB_SetScrollProp';
procedure UninitializeFlatSB(hWnd : HWND); stdcall;
          external comctl32 name 'UninitializeFlatSB';
function  FlatSB_ShowScrollBar(hWnd: HWND; wBar: Integer; bShow: BOOL): BOOL; stdcall;
          external comctl32 name 'FlatSB_ShowScrollBar';
function  FlatSB_EnableScrollBar(hWnd: HWND; wSBflags, wArrows: UINT): BOOL; stdcall;
          external comctl32 name 'FlatSB_EnableScrollBar';

const
  WSB_PROP_HSTYLE         = $00000200;
  WSB_PROP_VSTYLE         = $00000100;
  FSS_FSB_FLAT_MODE       = 2;
  FSS_FSB_ENCARTA_MODE    = 1;
  FSS_FSB_REGULAR_MODE    = 0;
//END

{$IFDEF SYN_CLX}
const
  FrameWidth = 2; { the border width when BoderStyle = bsSingle (until we support TWidgetStyle...)  }
{$ENDIF}

function TrimTrailingSpaces(const S: string): string;
var
  I: Integer;
begin
  I := Length(S);
  while (I > 0) and (S[I] in [#32, #9]) do
    Dec(I);
  Result := Copy(S, 1, I);
end;

{ THookedCommandHandlerEntry }

type
  THookedCommandHandlerEntry = class(TObject)
  private
    fEvent: THookedCommandEvent;
    fData: pointer;
    constructor Create(AEvent: THookedCommandEvent; AData: pointer);
    function Equals(AEvent: THookedCommandEvent): boolean;
  end;

constructor THookedCommandHandlerEntry.Create(AEvent: THookedCommandEvent;
  AData: pointer);
begin
  inherited Create;
  fEvent := AEvent;
  fData := AData;
end;

function THookedCommandHandlerEntry.Equals(AEvent: THookedCommandEvent): boolean;
begin
  with TMethod(fEvent) do
    Result := (Code = TMethod(AEvent).Code) and (Data = TMethod(AEvent).Data);
end;

{ TCustomSynEdit }

function TCustomSynEdit.PixelsToNearestRowColumn(aX, aY: integer): TDisplayCoord;
// Result is in display coordinates
var
  f: Single;
begin
{$IFDEF SYN_CLX}
  with ClientRect.TopLeft do
  begin
    Dec( aX, X );
    Dec( aY, Y );
  end;
{$ENDIF}
  f := (aX - fGutterWidth - 2) / fCharWidth;
  // don't return a partially visible last line
  if aY >= fLinesInWindow * LineHeight then
  begin
    aY := fLinesInWindow * LineHeight - 1;
    if aY < 0 then
      aY := 0;
  end;
  Result.Column := Max( 1, LeftChar + Round(f) );
  Result.Row := Max( 1, TopLine + (aY div LineHeight) );
end;

function TCustomSynEdit.PixelsToRowColumn(aX, aY: integer): TDisplayCoord;
begin
{$IFDEF SYN_CLX}
  with ClientRect.TopLeft do
  begin
    Dec( aX, X );
    Dec( aY, Y );
  end;
{$ENDIF}
  Result.Column := Max( 1, LeftChar + ( (aX - fGutterWidth - 2) div fCharWidth ) );
  Result.Row := Max( 1, TopLine + (aY div LineHeight) );
end;

function TCustomSynEdit.RowColumnToPixels(const RowCol: TDisplayCoord): TPoint;
begin
  Result.X := (RowCol.Column-1) * fCharWidth + fTextOffset;
  Result.Y := (RowCol.Row - fTopLine) * LineHeight;
{$IFDEF SYN_CLX}
  with ClientRect.TopLeft do
  begin
    Inc( Result.X, X );
    Inc( Result.Y, Y );
  end;
{$ENDIF}
end;

procedure TCustomSynEdit.ComputeCaret(X, Y: Integer);
//X,Y are pixel coordinates
var
  vCaretNearestPos : TDisplayCoord;
begin
  vCaretNearestPos := PixelsToNearestRowColumn(X, Y);
  vCaretNearestPos.Row := MinMax(vCaretNearestPos.Row, 1, DisplayLineCount);
  SetInternalDisplayXY(vCaretNearestPos);
end;

procedure TCustomSynEdit.ComputeScroll(X, Y: Integer);
//X,Y are pixel coordinates
var
  iScrollBounds: TRect; { relative to the client area }
begin
  { don't scroll if dragging text from other control }
  if (not MouseCapture) and (not Dragging) then
  begin
    fScrollTimer.Enabled := False;
    Exit;
  end;

  iScrollBounds := Bounds(fGutterWidth, 0, fCharsInWindow * fCharWidth,
    fLinesInWindow * LineHeight);
  if BorderStyle = bsNone then
    InflateRect( iScrollBounds, -2, -2 );

  if X < iScrollBounds.Left then
    fScrollDeltaX := (X - iScrollBounds.Left) div fCharWidth - 1
  else if X >= iScrollBounds.Right then
    fScrollDeltaX := (X - iScrollBounds.Right) div fCharWidth + 1
  else
    fScrollDeltaX := 0;

  if Y < iScrollBounds.Top then
    fScrollDeltaY := (Y - iScrollBounds.Top) div LineHeight - 1
  else if Y >= iScrollBounds.Bottom then
    fScrollDeltaY := (Y - iScrollBounds.Bottom) div LineHeight + 1
  else
    fScrollDeltaY := 0;

  fScrollTimer.Enabled := (fScrollDeltaX <> 0) or (fScrollDeltaY <> 0);