syneditmiscclasses.pas

SynEditStudio delphi 代码编辑器

    function GetPattern: string; virtual; abstract;
    procedure SetPattern(const Value: string); virtual; abstract;
    function GetLength(aIndex: integer): integer; virtual; abstract;
    function GetResult(aIndex: integer): integer; virtual; abstract;
    function GetResultCount: integer; virtual; abstract;
    procedure SetOptions(const Value: TSynSearchOptions); virtual; abstract;
  public
    function FindAll(const NewText: string): integer; virtual; abstract;
    function Replace(const aOccurrence, aReplacement: string): string; virtual; abstract;
    property Pattern: string read GetPattern write SetPattern;
    property ResultCount: integer read GetResultCount;
    property Results[aIndex: integer]: integer read GetResult;
    property Lengths[aIndex: integer]: integer read GetLength;
    property Options: TSynSearchOptions write SetOptions;
  end;

  TSynLineDivider = class(TPersistent)
  private
    FVisible: boolean;
    FColor: TColor;
    fOnChange: TNotifyEvent;
    FStyle: TPenStyle;
    procedure DoChange;
    procedure SetColor(const Value: TColor);
    procedure SetStyle(const Value: TPenStyle);
    procedure SetVisible(const Value: boolean);
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
  published
    property Visible: boolean read FVisible write SetVisible;
    property Color : TColor Read FColor write SetColor;
    property Style : TPenStyle read FStyle write SetStyle;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  end;

  TSynActiveLine = class(TPersistent)
  private
    FVisible: boolean;
    FBackground: TColor;
    FForeground: TColor;
    fOnChange: TNotifyEvent;
    FIndicator: TSynGlyph;
    procedure DoChange(Sender : TObject);
    procedure SetBackground(const Value: TColor);
    procedure SetForeground(const Value: TColor);
    procedure SetIndicator(const Value: TSynGlyph);
    procedure SetVisible(const Value: boolean);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Background: TColor read FBackground write SetBackground;
    property Foreground: TColor read FForeground write SetForeground;
    property Indicator : TSynGlyph read FIndicator write SetIndicator;
    property Visible: boolean read FVisible write SetVisible;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  end;

  TSynRightEdge = class(TPersistent)
  private
    FVisible: Boolean;
    FPosition: Integer;
    FColor: TColor;
    fOnChange: TNotifyEvent;
    FStyle: TPenStyle;
    FMouseMove: Boolean;
    procedure DoChange;
    procedure SetColor(const Value: TColor);
    procedure SetPosition(const Value: Integer);
    procedure SetStyle(const Value: TPenStyle);
    procedure SetVisible(const Value: Boolean);
    procedure SetMouseMove(const Value: Boolean);
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
  published
    property MouseMove : Boolean read FMouseMove write SetMouseMove;
    property Visible : Boolean read FVisible write SetVisible;
    property Position : Integer read FPosition write SetPosition;
    property Color : TColor Read FColor write SetColor;
    property Style : TPenStyle read FStyle write SetStyle;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  end;

  TSynWordWrapStyle = (wwsClientWidth, wwsRightEdge, wwsSpecified);

  TSynWordWrap = class(TPersistent)
  private
    FEnabled: Boolean;
    FPosition: Integer;
    fOnChange: TNotifyEvent;
    FIndicator: TSynGlyph;
    FStyle: TSynWordWrapStyle;
    procedure DoChange(Sender: TObject);
    procedure SetEnabled(const Value: Boolean);
    procedure SetIndicator(const Value: TSynGlyph);
    procedure SetPosition(const Value: Integer);
    procedure SetStyle(const Value: TSynWordWrapStyle);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Enabled : Boolean read FEnabled write SetEnabled;
    property Position : Integer read FPosition write SetPosition;
    property Style : TSynWordWrapStyle read FStyle write SetStyle;
    property Indicator : TSynGlyph read FIndicator write SetIndicator;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  end;

  TSynScrollBars = class;
  TGetScrollInfoEvent = function(var ScrollInfo : TScrollInfo): Boolean of object;
  TSetScrollInfoEvent = function(const ScrollInfo : TScrollInfo; Redraw : Boolean) : Integer of object;
  TShowScrollBarEvent = function(const sbShow : Boolean): Boolean of object;
  TEnabledScrollBarEvent = function(const sbArrows : Integer): Boolean of object;
  TSynEditScrollBar = class(TComponent)
  private
    FOnGetScrollInfo : TGetScrollInfoEvent;
    FOnSetScrollInfo : TSetScrollInfoEvent;
    FOnShowScrollBar : TShowScrollBarEvent;
    FOnEnabledScrollBar : TEnabledScrollBarEvent;
    FScrollBars : TSynScrollBars;
  public
    destructor Destroy;override;
    procedure Assign(Source: TPersistent); override;
    function DoGetScrollInfo(var ScrollInfo : TScrollInfo): Boolean;
    function DoSetScrollInfo(const ScrollInfo : TScrollInfo; Redraw : Boolean) : Integer;
    function DoShowScrollBar(const sbShow : Boolean): Boolean;
    function DoEnabledScrollBar(const sbArrows : Integer): Boolean;
  published
    property OnGetScrollInfo : TGetScrollInfoEvent read FOnGetScrollInfo write FOnGetScrollInfo;
    property OnSetScrollInfo : TSetScrollInfoEvent read FOnSetScrollInfo write FOnSetScrollInfo;
    property OnShowScrollBar : TShowScrollBarEvent read FOnShowScrollBar write FOnShowScrollBar;
    property OnEnabledScrollBar : TEnabledScrollBarEvent read FOnEnabledScrollBar write FOnEnabledScrollBar;
  end;

  TScrollBarsStyle = (sbsRegular, sbsEncarta, sbsFlat, sbsCustom);
  TScrollHintFormat = (shfTopLineOnly, shfTopToBottom);
  TSynScrollBars = class(TPersistent)
  private
    FScrollBars: TScrollStyle;
    FStyle: TScrollBarsStyle;
    fHintColor: TColor;
    fHintFormat: TScrollHintFormat;
    FVertical: TSynEditScrollBar;
    FHorizontal: TSynEditScrollBar;
    fOnChange: TNotifyEvent;
    procedure doChange;
    procedure SetHorizontal(const Value: TSynEditScrollBar);
    procedure SetScrollBars(const Value: TScrollStyle);
    procedure SetStyle(const Value: TScrollBarsStyle);
    procedure SetVertical(const Value: TSynEditScrollBar);
  public
    procedure AfterConstruction; override;
    procedure Assign(Source: TPersistent); override;
  published
    property ScrollBars : TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
    property Style : TScrollBarsStyle read FStyle write SetStyle default sbsRegular;
    property Horizontal : TSynEditScrollBar read FHorizontal write SetHorizontal;
    property Vertical : TSynEditScrollBar read FVertical write SetVertical;
    property HintColor: TColor read fHintColor write fHintColor default clInfoBk;
    property HintFormat: TScrollHintFormat read fHintFormat write fHintFormat default shfTopLineOnly;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  end;

  TSynBackgroundRepeatMode=(brmNone, brmVert, brmHori, brmAll);

  TSynEditBackground = class(TPersistent)
  private
    FBackground: TBitmap;
    FVisible: Boolean;
    FRepeatMode: TSynBackgroundRepeatMode;
    fOnChange: TNotifyEvent;
    procedure doChange;
    procedure SetBackground(const Value: TBitmap);
    procedure SetRepeatMode(const Value: TSynBackgroundRepeatMode);
    procedure SetVisible(const Value: Boolean);
  public
    procedure AfterConstruction; override;
    destructor Destroy;override;
    procedure Draw(Canvas : TCanvas; AbsRect, DestRect : TRect; Back: TColor);
    procedure Assign(Source: TPersistent); override;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  published
    property Visible : Boolean read FVisible write SetVisible;
    property RepeatMode : TSynBackgroundRepeatMode read FRepeatMode write SetRepeatMode;
    property Background : TBitmap read FBackground write SetBackground;
  end;

{$IFNDEF SYN_CLX}
  {$IFNDEF SYN_COMPILER_4_UP}
  TBetterRegistry = class(TRegistry)
    function OpenKeyReadOnly(const Key: string): Boolean;
  end;
  {$ELSE}
  TBetterRegistry = TRegistry;
  {$ENDIF}
{$ENDIF}


  TSynEditMark = class
  protected
    fOnChange: TNotifyEvent;
    fLine, fChar, fImage: Integer;
    fVisible: boolean;
    fInternalImage: boolean;
    fBookmarkNum: integer;
    procedure SetChar(const Value: Integer); virtual;
    procedure SetImage(const Value: Integer); virtual;
    procedure SetLine(const Value: Integer); virtual;
    procedure SetVisible(const Value: boolean);
    procedure SetInternalImage(const Value: boolean);
    function GetIsBookmark: boolean;
  public
    constructor Create();
    property Line: integer read fLine write SetLine;
    property Char: integer read fChar write SetChar;
    property ImageIndex: integer read fImage write SetImage;
    property BookmarkNumber: integer read fBookmarkNum write fBookmarkNum;
    property Visible: boolean read fVisible write SetVisible;
    property InternalImage: boolean read fInternalImage write SetInternalImage;
    property IsBookmark: boolean read GetIsBookmark;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  end;

  TSynEditLineMarks = array[0..16] of TSynEditMark;

  { A list of mark objects. Each object cause a litle picture to be drawn in the
    gutter. }

  { TSynEditMarkList }

  TSynEditMarkList = class(TObject)
  private
    fItems: TList;
    fOnChange: TNotifyEvent;
    procedure DoChange;
    function GetItem(Index: Integer): TSynEditMark;
    function GetCount: Integer;
    procedure InternalDelete(Index: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    function Add(Item: TSynEditMark): Integer;
    function Remove(Item: TSynEditMark): Integer;
    procedure ClearLine(line: integer);
    procedure Clear;
    procedure GetMarksForLine(line: integer; out Marks: TSynEditLineMarks);
  public
    property Items[Index: Integer]: TSynEditMark read GetItem; default;
    property Count: Integer read GetCount;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  end;

implementation

uses
{$IFDEF SYN_CLX}
  QSynEditMiscProcs;
{$ELSE}
  SynEditMiscProcs;
{$ENDIF}

{ TSynSelectedColor }

constructor TSynSelectedColor.Create;
begin
  inherited Create;
  fBG := clHighLight;
  fFG := clHighLightText;
end;

procedure TSynSelectedColor.Assign(Source: TPersistent);
var
  Src: TSynSelectedColor;
begin
  if (Source <> nil) and (Source is TSynSelectedColor) then begin
    Src := TSynSelectedColor(Source);
    fBG := Src.fBG;
    fFG := Src.fFG;
    if Assigned(fOnChange) then fOnChange(Self);
  end else
    inherited Assign(Source);
end;

procedure TSynSelectedColor.SetBG(Value: TColor);
begin
  if (fBG <> Value) then begin
    fBG := Value;
    if Assigned(fOnChange) then fOnChange(Self);
  end;
end;

procedure TSynSelectedColor.SetFG(Value: TColor);
begin
  if (fFG <> Value) then begin
    fFG := Value;
    if Assigned(fOnChange) then fOnChange(Self);
  end;
end;

{ TSynGutter }

constructor TSynGutter.Create;
begin
  inherited Create;
  FIntens := False;
  
  fFont := TFont.Create;
  fFont.Name := 'Courier New';
  fFont.Size := 8;
  fFont.Style := [];
  fUseFontStyle := True;
  fFont.OnChange := OnFontChange;

  fColor := clBtnFace;
  fVisible := TRUE;
  fWidth := 30;
  fLeftOffset := 16;
  fDigitCount := 4;
  fAutoSizeDigitCount := fDigitCount;
  fRightOffset := 2;
  fBorderStyle := gbsMiddle;
  fBorderColor := clWindow;
  fShowLineNumbers := False;
  fLineNumberStart := 1;
  fZeroStart := False;
  fGradient := False;
  fGradientStartColor := clWindow;
  fGradientEndColor := clBtnFace;
  fGradientSteps := 48;

  fLeftOffsetColor := clNone;
  fRightOffsetColor := clNone;

  fShowLineModified := False;
  fLineModifiedColor := clYellow;
  fLineNormalColor := clLime;
end;

destructor TSynGutter.Destroy;
begin
  fFont.Free;
  inherited Destroy;
end;

procedure TSynGutter.Assign(Source: TPersistent);
var
  Src: TSynGutter;
begin
  if Assigned(Source) and (Source is TSynGutter) then begin
    Src := TSynGutter(Source);
    fFont.Assign(src.Font);
    fUseFontStyle := src.fUseFontStyle;
    FIntens := src.FIntens;
    fColor := Src.fColor;
    fVisible := Src.fVisible;
    fWidth := Src.fWidth;
    fShowLineNumbers := Src.fShowLineNumbers;
    fLeadingZeros := Src.fLeadingZeros;
    fZeroStart := Src.fZeroStart;
    fLeftOffset := Src.fLeftOffset;
    fDigitCount := Src.fDigitCount;
    fRightOffset := Src.fRightOffset;
    fAutoSize := Src.fAutoSize;
    fAutoSizeDigitCount := Src.fAutoSizeDigitCount;
    fLineNumberStart := Src.fLineNumberStart;
    fBorderColor := Src.fBorderColor;
    fBorderStyle := Src.fBorderStyle;
    fGradient := Src.fGradient;
    fGradientStartColor := Src.fGradientStartColor;
    fGradientEndColor := Src.fGradientEndColor;
    fGradientSteps := Src.fGradientSteps;
    fLineModifiedColor := Src.fLineModifiedColor;
    fLineNormalColor := Src.fLineNormalColor;
    fShowLineModified := Src.fShowLineModified;
    if Assigned(fOnChange) then fOnChange(Self);
  end else
    inherited;
end;

procedure TSynGutter.AutoSizeDigitCount(LinesCount: integer);
var
  nDigits: integer;
begin
  if fVisible and fAutoSize and fShowLineNumbers then
  begin
    if fZeroStart then
      Dec(LinesCount)
    else if fLineNumberStart > 1 then
      Inc(LinesCount, fLineNumberStart - 1);

    nDigits := Max(Length(IntToStr(LinesCount)), fDigitCount);
    if fAutoSizeDigitCount <> nDigits then begin
      fAutoSizeDigitCount := nDigits;
      if Assigned(fOnChange) then fOnChange(Self);
    end;
  end else
    fAutoSizeDigitCount := fDigitCount;
end;

function TSynGutter.FormatLineNumber(Line: integer): string;
var
  i: integer;
begin
  if fZeroStart then
    Dec(Line)
  else if fLineNumberStart > 1 then
    Inc(Line, fLineNumberStart - 1);
  Str(Line : fAutoSizeDigitCount, Result);
  if fLeadingZeros then
    for i := 1 to fAutoSizeDigitCount - 1 do begin
      if (Result[i] <> ' ') then break;
      Result[i] := '0';
    end;
end;

function TSynGutter.RealGutterWidth(CharWidth: integer): integer;
begin
  if not fVisible then
    Result := 0
  else if fShowLineNumbers then
    Result := fLeftOffset + fRightOffset + fAutoSizeDigitCount * CharWidth + 4
  else
    Result := fWidth;
end;

procedure TSynGutter.SetAutoSize(const Value: boolean);
begin
  if fAutoSize <> Value then begin
    fAutoSize := Value;
    if Assigned(fOnChange) then fOnChange(Self);
  end;
end;

procedure TSynGutter.SetColor(const Value: TColor);
begin
  if fColor <> Value then begin
    fColor := Value;
    if Assigned(fOnChange) then fOnChange(Self);
  end;
end;

procedure TSynGutter.SetFont(Value: TFont);
begin
  fFont.Assign(Value);
end;

procedure TSynGutter.OnFontChange(Sender: TObject);
begin
  if Assigned(fOnChange) then fOnChange(Self);
end;

procedure TSynGutter.SetDigitCount(Value: integer);