syneditmiscclasses.pas

SynEditStudio delphi 代码编辑器

{-------------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: SynEditMiscClasses.pas, released 2000-04-07.
The Original Code is based on the mwSupportClasses.pas file from the
mwEdit component suite by Martin Waldenburg and other developers, the Initial
Author of this file is Michael Hieke.
All Rights Reserved.

Contributors to the SynEdit and mwEdit projects are listed in the
Contributors.txt file.

Alternatively, the contents of this file may be used under the terms of the
GNU General Public License Version 2 or later (the "GPL"), in which case
the provisions of the GPL are applicable instead of those above.
If you wish to allow use of your version of this file only under the terms
of the GPL and not to allow others to use your version of this file
under the MPL, indicate your decision by deleting the provisions above and
replace them with the notice and other provisions required by the GPL.
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.

$Id: SynEditMiscClasses.pas,v 1.35 2004/07/31 15:31:41 markonjezic Exp $

You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net

Known Issues:
-------------------------------------------------------------------------------}

{$IFNDEF QSYNEDITMISCCLASSES}
unit SynEditMiscClasses;
{$ENDIF}

{$I SynEdit.inc}

interface

uses
{$IFDEF SYN_CLX}
  {$IFDEF LINUX}
  Xlib,
  {$ENDIF}
  Types,
  Qt,
  QConsts,
  QGraphics,
  QControls,
  QImgList,
  QStdCtrls,
  QMenus,
  kTextDrawer,
  QSynEditTypes,
  QSynEditKeyConst,
{$ELSE}
  Consts,
  Windows,
  Messages,
  Graphics,
  Controls,
  Forms,
  StdCtrls,
  Menus,
  Registry,
  SynEditTypes,
  SynEditKeyConst,
{$ENDIF}
{$IFDEF SYN_COMPILER_4_UP}
  Math,
{$ENDIF}

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

  Classes,
  SysUtils;

type
  TSynSelectedColor = class(TPersistent)
  private
    fBG: TColor;
    fFG: TColor;
    fOnChange: TNotifyEvent;
    procedure SetBG(Value: TColor);
    procedure SetFG(Value: TColor);
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
  published
    property Background: TColor read fBG write SetBG default clHighLight;
    property Foreground: TColor read fFG write SetFG default clHighLightText;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  end;

  TSynGutterBorderStyle = (gbsNone, gbsMiddle, gbsRight);

  TSynGutter = class(TPersistent)
  private
    fFont: TFont;
    fColor: TColor;
    fBorderColor: TColor;
    fWidth: integer;
    fShowLineNumbers: boolean;
    fDigitCount: integer;
    fLeadingZeros: boolean;
    fZeroStart: boolean;
    fLeftOffset: integer;
    fRightOffset: integer;
    fOnChange: TNotifyEvent;
    fCursor: TCursor;
    fVisible: boolean;
    fUseFontStyle: boolean;
    fAutoSize: boolean;
    fAutoSizeDigitCount: integer;
    fBorderStyle: TSynGutterBorderStyle;
    fLineNumberStart: Integer;
    fGradient: Boolean;
    fGradientStartColor: TColor;
    fGradientEndColor: TColor;
    fGradientSteps: Integer;
    FIntens: boolean;
    fLeftOffsetColor: TColor;
    fRightOffsetColor: TColor;
    fLineModifiedColor: TColor;
    fShowLineModified: Boolean;
    fLineNormalColor: TColor;
    procedure SetIntens(const Value: boolean);
    procedure SetAutoSize(const Value: boolean);
    procedure SetColor(const Value: TColor);
    procedure SetDigitCount(Value: integer);
    procedure SetLeadingZeros(const Value: boolean);
    procedure SetLeftOffset(Value: integer);
    procedure SetRightOffset(Value: integer);
    procedure SetShowLineNumbers(const Value: boolean);
    procedure SetUseFontStyle(Value: boolean);
    procedure SetVisible(Value: boolean);
    procedure SetWidth(Value: integer);
    procedure SetZeroStart(const Value: boolean);
    procedure SetFont(Value: TFont);
    procedure OnFontChange(Sender: TObject);
    procedure SetBorderStyle(const Value: TSynGutterBorderStyle);
    procedure SetLineNumberStart(const Value: Integer);
    procedure SetBorderColor(const Value: TColor);
    procedure SetGradient(const Value: Boolean);
    procedure SetGradientEndColor(const Value: TColor);
    procedure SetGradientStartColor(const Value: TColor);
    procedure SetGradientSteps(const Value: Integer);
    procedure SetLeftOffsetColor(const Value: TColor);
    procedure SetRightOffsetColor(const Value: TColor);
    procedure setLineModifiedColor(const Value: TColor);
    procedure setLineNormalColor(const Value: TColor);
    procedure setShowLineModified(const Value: Boolean);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure AutoSizeDigitCount(LinesCount: integer);
    function FormatLineNumber(Line: integer): string;
    function RealGutterWidth(CharWidth: integer): integer;
  published
    property ShowLineModified : Boolean read fShowLineModified write setShowLineModified;
    property LineModifiedColor : TColor read fLineModifiedColor write setLineModifiedColor;
    property LineNormalColor : TColor read fLineNormalColor write setLineNormalColor;
    property Intens : boolean read FIntens write SetIntens default False;
    property AutoSize: boolean read fAutoSize write SetAutoSize default FALSE;
    property BorderStyle: TSynGutterBorderStyle read fBorderStyle
      write SetBorderStyle default gbsMiddle;
    property Color: TColor read fColor write SetColor default clBtnFace;
    property Cursor: TCursor read fCursor write fCursor default crDefault;
    property DigitCount: integer read fDigitCount write SetDigitCount
      default 4;
    property Font: TFont read fFont write SetFont;
    property LeadingZeros: boolean read fLeadingZeros write SetLeadingZeros
      default FALSE;
    property LeftOffset: integer read fLeftOffset write SetLeftOffset
      default 16;
    property LeftOffsetColor: TColor read fLeftOffsetColor
      write SetLeftOffsetColor;
    property RightOffset: integer read fRightOffset write SetRightOffset
      default 2;
    property RightOffsetColor: TColor read fRightOffsetColor
      write SetRightOffsetColor;
    property ShowLineNumbers: boolean read fShowLineNumbers
      write SetShowLineNumbers default FALSE;
    property UseFontStyle: boolean read fUseFontStyle write SetUseFontStyle
      default TRUE;
    property Visible: boolean read fVisible write SetVisible default TRUE;
    property Width: integer read fWidth write SetWidth default 30;
    property ZeroStart: boolean read fZeroStart write SetZeroStart
      default False;
    property BorderColor: TColor read fBorderColor write SetBorderColor default clWindow;
    property LineNumberStart : Integer read fLineNumberStart
      write SetLineNumberStart default 1;
    property Gradient: Boolean read fGradient write SetGradient default False;
    property GradientStartColor: TColor read fGradientStartColor write SetGradientStartColor default clWindow;
    property GradientEndColor: TColor read fGradientEndColor write SetGradientEndColor default clBtnFace;
    property GradientSteps: Integer read fGradientSteps write SetGradientSteps default 48;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  end;

  {$IFDEF CODEFOLDING}
	//### Code Folding ###
  TSynCollapsingMarkStyle = (msSquare, msEllipse);
  TSynCodeFoldingChanges = (fcEnabled, fcRefresh, fcRescan);

  TCodeFoldingChangeEvent = procedure(Event: TSynCodeFoldingChanges) of object;

  TSynCodeFolding = class(TPersistent)
  private
    fHighlighterFoldRegions: Boolean;
    fCollapsedCodeHint: Boolean;
    fIndentGuides: Boolean;
    fShowCollapsedLine: Boolean;
    fCollapsedLineColor: TColor;
    fEnabled: Boolean;
    fHighlightIndentGuides: Boolean;
    fFolderBarColor: TColor;
    fFolderBarLinesColor: TColor;
    fCollapsingMarkStyle: TSynCollapsingMarkStyle;
    fFoldRegions: TFoldRegions;
    fCaseSensitive: Boolean;
    fOnChange: TCodeFoldingChangeEvent;
    
    procedure SetFolderBarColor(const Value: TColor);
    procedure SetFolderBarLinesColor(const Value: TColor);
    procedure SetEnabled(const Value: Boolean);
    procedure SetCollapsedCodeHint(const Value: Boolean);
    procedure SetCollapsedLineColor(const Value: TColor);
    procedure SetCollapsingMarkStyle(const Value: TSynCollapsingMarkStyle);
    procedure SetHighlighterFoldRegions(const Value: Boolean);
    procedure SetHighlightIndentGuides(const Value: Boolean);
    procedure SetIndentGuides(const Value: Boolean);
    procedure SetShowCollapsedLine(const Value: Boolean);
    procedure SetCaseSensitive(const Value: Boolean);
  public
    constructor Create;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
  published //###mod formeditor
    property CaseSensitive: Boolean read fCaseSensitive write SetCaseSensitive;
    property CollapsedCodeHint: Boolean read fCollapsedCodeHint
    	write SetCollapsedCodeHint default True;
    property CollapsedLineColor: TColor read fCollapsedLineColor
    	write SetCollapsedLineColor default clDefault;
    property CollapsingMarkStyle: TSynCollapsingMarkStyle
    	read fCollapsingMarkStyle write SetCollapsingMarkStyle default msSquare;
    property Enabled: Boolean read fEnabled write SetEnabled default False;
    property FoldRegions: TFoldRegions read fFoldRegions;
    property FolderBarColor: TColor read fFolderBarColor
    	write SetFolderBarColor default clDefault;
    property FolderBarLinesColor: TColor read fFolderBarLinesColor
    	write SetFolderBarLinesColor default clDefault;
    property HighlighterFoldRegions: Boolean read fHighlighterFoldRegions
    	write SetHighlighterFoldRegions default True;
    property HighlightIndentGuides: Boolean read fHighlightIndentGuides
    	write SetHighlightIndentGuides default True;
    property IndentGuides: Boolean read fIndentGuides write SetIndentGuides
    	default True;
    property ShowCollapsedLine: Boolean read fShowCollapsedLine
    	write SetShowCollapsedLine default True;
    property OnChange: TCodeFoldingChangeEvent read fOnChange write fOnChange;
  end;
  //### End Code Folding ###
  {$ENDIF}

  TSynBookMarkOpt = class(TPersistent)
  private
    fBookmarkImages: TImageList;
    fDrawBookmarksFirst: boolean;
    fEnableKeys: Boolean;
    fGlyphsVisible: Boolean;
    fLeftMargin: Integer;
    fOwner: TComponent;
    fXoffset: integer;
    fOnChange: TNotifyEvent;
    procedure SetBookmarkImages(const Value: TImageList);
    procedure SetDrawBookmarksFirst(Value: boolean);
    procedure SetGlyphsVisible(Value: Boolean);
    procedure SetLeftMargin(Value: Integer);
    procedure SetXOffset(Value: integer);
  public
    constructor Create(AOwner: TComponent);
    procedure Assign(Source: TPersistent); override;
  published
    property BookmarkImages: TImageList
      read fBookmarkImages write SetBookmarkImages;
    property DrawBookmarksFirst: boolean read fDrawBookmarksFirst
      write SetDrawBookmarksFirst default True;
    property EnableKeys: Boolean
      read fEnableKeys write fEnableKeys default True;
    property GlyphsVisible: Boolean
      read fGlyphsVisible write SetGlyphsVisible default True;
    property LeftMargin: Integer read fLeftMargin write SetLeftMargin default 2;
    property Xoffset: integer read fXoffset write SetXOffset default 12;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  end;

  TSynGlyph = class(TPersistent)
  private
    fVisible: boolean;
    fInternalGlyph, fGlyph: TBitmap;
    fInternalMaskColor, fMaskColor: TColor;
    fOnChange: TNotifyEvent;
    procedure SetGlyph(Value: TBitmap);
    procedure GlyphChange(Sender: TObject);
    procedure SetMaskColor(Value: TColor);
    procedure SetVisible(Value: boolean);
    function GetWidth : integer;
    function GetHeight : integer;
  public
    constructor Create(aModule: THandle; const aName: string; aMaskColor: TColor);
    destructor Destroy; override;
    procedure Assign(aSource: TPersistent); override;
    procedure Draw(aCanvas: TCanvas; aX, aY, aLineHeight: integer);
    property Width : integer read GetWidth;
    property Height : integer read GetHeight;
  published
    property Glyph: TBitmap read fGlyph write SetGlyph;
    property MaskColor: TColor read fMaskColor write SetMaskColor default clNone;
    property Visible: boolean read fVisible write SetVisible default True;
    property OnChange: TNotifyEvent read fOnChange write fOnChange;
  end;

  { TSynMethodChain }

  ESynMethodChain = class(Exception);
  TSynExceptionEvent = procedure (Sender: TObject; E: Exception;
    var DoContinue: Boolean) of object;

  TSynMethodChain = class(TObject)
  private
    FNotifyProcs: TList;
    FExceptionHandler: TSynExceptionEvent;
  protected
    procedure DoFire(const AEvent: TMethod); virtual; abstract;
    function DoHandleException(E: Exception): Boolean; virtual;
    property ExceptionHandler: TSynExceptionEvent read FExceptionHandler
      write FExceptionHandler;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Add(AEvent: TMethod);
    procedure Remove(AEvent: TMethod);
    procedure Fire;
  end;

  { TSynNotifyEventChain }

  TSynNotifyEventChain = class(TSynMethodChain)
  private
    FSender: TObject;
  protected
    procedure DoFire(const AEvent: TMethod); override;
  public
    constructor CreateEx(ASender: TObject);
    procedure Add(AEvent: TNotifyEvent);
    procedure Remove(AEvent: TNotifyEvent);
    property ExceptionHandler;
    property Sender: TObject read FSender write FSender;
  end;

  { TSynInternalImage }
  
  TSynInternalImage = class(TObject)
  private
    fImages : TBitmap;
    fWidth  : Integer;
    fHeight : Integer;
    fCount  : Integer;

    function CreateBitmapFromInternalList(aModule: THandle; const Name: string): TBitmap;
    procedure FreeBitmapFromInternalList;
  public
    constructor Create(aModule: THandle; const Name: string; Count: integer);
    destructor Destroy; override;
    procedure Draw(ACanvas: TCanvas; Number, X, Y, LineHeight: integer);
    procedure DrawTransparent(ACanvas: TCanvas; Number, X, Y,
      LineHeight: integer; TransparentColor: TColor);
  end;

{ TSynHotKey }

const
  {$IFDEF SYN_CLX}
  BorderWidth = 2;
  {$ELSE}
  BorderWidth = 0;
  {$ENDIF}

type
  {$IFDEF SYN_CLX}
  TSynBorderStyle = bsNone..bsSingle;
  {$ELSE}
  TSynBorderStyle = TBorderStyle;
  {$ENDIF}

  THKModifier = (hkShift, hkCtrl, hkAlt);
  THKModifiers = set of THKModifier;
  THKInvalidKey = (hcNone, hcShift, hcCtrl, hcAlt, hcShiftCtrl,
    hcShiftAlt, hcCtrlAlt, hcShiftCtrlAlt);
  THKInvalidKeys = set of THKInvalidKey;

  TSynHotKey = class(TCustomControl)
  private
    FBorderStyle: TSynBorderStyle;
    FHotKey: TShortCut;
    FInvalidKeys: THKInvalidKeys;
    FModifiers: THKModifiers;
    FPressedOnlyModifiers: Boolean;
    procedure SetBorderStyle(const Value: TSynBorderStyle);
    procedure SetHotKey(const Value: TShortCut);
    procedure SetInvalidKeys(const Value: THKInvalidKeys);
    procedure SetModifiers(const Value: THKModifiers);
    {$IFNDEF SYN_CLX}
    procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
     procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
    {$ENDIF}
  protected
    {$IFNDEF SYN_CLX}
    procedure CreateParams(var Params: TCreateParams); override;
    {$ENDIF}
    {$IFDEF SYN_CLX}
    function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; override;
    {$ENDIF}
    procedure DoExit; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
    {$IFDEF SYN_CLX}
    function WidgetFlags: Integer; override;
    {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
  published
    property BorderStyle: TSynBorderStyle read FBorderStyle write SetBorderStyle
      default bsSingle;
    property HotKey: TShortCut read FHotKey write SetHotKey default $0041; { Alt+A }
    property InvalidKeys: THKInvalidKeys read FInvalidKeys write SetInvalidKeys default [hcNone, hcShift];
    property Modifiers: THKModifiers read FModifiers write SetModifiers default [hkAlt];
  end;

  TSynEditSearchCustom = class(TComponent)
  protected