frxsynmemo.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{******************************************}
{ }
{ FastReport v3.0 }
{ Syntax memo control }
{ }
{ Copyright (c) 1998-2005 }
{ by Alexander Tzyganenko, }
{ Fast Reports Inc. }
{ }
{******************************************}

unit frxSynMemo;

interface

{$I frx.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls,
  Forms, frxCtrls, fs_iparser;

type
  TCharAttr = (caNo, caText, caBlock, caComment, caKeyword, caString,
    caNumber);
  TCharAttributes = set of TCharAttr;

  TfrxSyntaxMemo = class(TfrxScrollWin)
  private
    FActiveLine:Integer;
    FAllowLinesChange:Boolean;
    FBlockColor:TColor;
    FBlockFontColor:TColor;
    FBookmarks:array[0..9] of Integer;
    FCharHeight:Integer;
    FCharWidth:Integer;
    FCommentAttr:TFont;
    FDoubleClicked:Boolean;
    FDown:Boolean;
    FGutterWidth:Integer;
    FIsMonoType:Boolean;
    FKeywordAttr:TFont;
    FMaxLength:Integer;
    FMessage:String;
    FModified:Boolean;
    FMoved:Boolean;
    FNumberAttr:TFont;
    FOffset:TPoint;
    FOnChangePos:TNotifyEvent;
    FOnChangeText:TNotifyEvent;
    FParser:TfsParser;
    FPos:TPoint;
    FStringAttr:TFont;
    FSelEnd:TPoint;
    FSelStart:TPoint;
    FShowGutter:boolean;
    FSynStrings:TStrings;
    FSyntax:String;
    FTempPos:TPoint;
    FText:TStringList;
    FTextAttr:TFont;
    FUndo:TStringList;
    FUpdatingSyntax:Boolean;
    FWindowSize:TPoint;
    FBreakPoint:Integer;
    function GetCharAttr(Pos:TPoint):TCharAttributes;
    function GetLineBegin(Index:Integer):Integer;
    function GetPlainTextPos(Pos:TPoint):Integer;
    function GetPosPlainText(Pos:Integer):TPoint;
    function GetRunLine(Index:Integer):Boolean;
    function GetSelText:String;
    function GetText:TStrings;
    function LineAt(Index:Integer):String;
    function LineLength(Index:Integer):Integer;
    function Pad(n:Integer):String;
    procedure AddSel;
    procedure AddUndo;
    procedure ClearSel;
    procedure CorrectBookmark(Line, Delta:Integer);
    procedure CreateSynArray;
    procedure DoBackspace;
    procedure DoChange;
    procedure DoChar(Ch:Char);
    procedure DoCtrlI;
    procedure DoCtrlU;
    procedure DoCtrlR;
    procedure DoCtrlL;
    procedure DoDel;
    procedure DoDown;
    procedure DoEnd(Ctrl:Boolean);
    procedure DoHome(Ctrl:Boolean);
    procedure DoLeft;
    procedure DoPgUp;
    procedure DoPgDn;
    procedure DoReturn;
    procedure DoRight;
    procedure DoUp;
    procedure EnterIndent;
    procedure LinesChange(Sender:TObject);
    procedure SetActiveLine(Line:Integer);
    procedure SetCommentAttr(Value:TFont);
    procedure SetKeywordAttr(Value:TFont);
    procedure SetNumberAttr(const Value:TFont);
    procedure SetRunLine(Index:Integer; const Value:Boolean);
    procedure SetSelText(const Value:String);
    procedure SetShowGutter(Value:Boolean);
    procedure SetStringAttr(Value:TFont);
    procedure SetSyntax(const Value:String);
    procedure SetText(Value:TStrings);
    procedure SetTextAttr(Value:TFont);
    procedure ShiftSelected(ShiftRight:Boolean);
    procedure ShowCaretPos;
    procedure TabIndent;
    procedure UnIndent;
    procedure UpdateScrollBar;
    procedure UpdateSyntax;
    procedure WMKillFocus(var Msg:TWMKillFocus); message WM_KILLFOCUS;
    procedure WMSetFocus(var Msg:TWMSetFocus); message WM_SETFOCUS;
    procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED;
    procedure SetBreakPoint(const Value:Integer);
  protected
    procedure DblClick; override;
    procedure KeyDown(var Key:Word; Shift:TShiftState); override;
    procedure KeyPress(var Key:Char); override;
    procedure MouseDown(Button:TMouseButton; Shift:TShiftState;
      X, Y:Integer); override;
    procedure MouseMove(Shift:TShiftState; X, Y:Integer); override;
    procedure MouseUp(Button:TMouseButton; Shift:TShiftState;
      X, Y:Integer); override;
    procedure MouseWheelDown(Sender:TObject; Shift:TShiftState;
      MousePos:TPoint; var Handled:Boolean);
    procedure MouseWheelUp(Sender:TObject; Shift:TShiftState;
      MousePos:TPoint; var Handled:Boolean);
    procedure OnHScrollChange(Sender:TObject); override;
    procedure OnVScrollChange(Sender:TObject); override;
    procedure Resize; override;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    procedure CopyToClipboard;
    procedure CutToClipboard;
    procedure PasteFromClipboard;
    procedure SetPos(x, y:Integer);
    procedure ShowMessage(const s:String);
    procedure Undo;
    procedure UpdateView;
    function Find(const SearchText:String; CaseSensitive:Boolean;
      var SearchFrom:Integer):Boolean;
    function GetPlainPos:Integer;
    function GetPos:TPoint;
    function IsBookmark(Line:Integer):Integer;
    procedure AddBookmark(Line, Number:Integer);
    procedure DeleteBookmark(Number:Integer);
    procedure GotoBookmark(Number:Integer);

    property ActiveLine:Integer read FActiveLine write SetActiveLine;
    property BlockColor:TColor read FBlockColor write FBlockColor;
    property BlockFontColor:TColor read FBlockFontColor write FBlockFontColor;
    property BreakPoint:Integer read FBreakPoint write SetBreakPoint;
    property Color;
    property CommentAttr:TFont read FCommentAttr write SetCommentAttr;
    property Font;
    property KeywordAttr:TFont read FKeywordAttr write SetKeywordAttr;
    property Modified:Boolean read FModified write FModified;
    property NumberAttr:TFont read FNumberAttr write SetNumberAttr;
    property RunLine[Index:Integer]:Boolean read GetRunLine write SetRunLine;
    property SelText:String read GetSelText write SetSelText;
    property StringAttr:TFont read FStringAttr write SetStringAttr;
    property TextAttr:TFont read FTextAttr write SetTextAttr;
    property Lines:TStrings read GetText write SetText;
    property Syntax:String read FSyntax write SetSyntax;
    property ShowGutter:boolean read FShowGutter write SetShowGutter;
    property OnChangePos:TNotifyEvent read FOnChangePos write FOnChangePos;
    property OnChangeText:TNotifyEvent read FOnChangeText write FOnChangeText;
    property OnDragDrop;
    property OnDragOver;
  end;

implementation

uses Clipbrd, fs_itools, frxXML;

const
  SQLKeywords =
    'active,after,all,alter,and,any,as,asc,ascending,at,auto,'+
    'base_name,before,begin,between,by,cache,call,cast,check,column,commit,'+
    'committed,computed,conditional,constraint,containing,count,create,'+
    'current,cursor,database,debug,declare,default,delete,desc,descending,'+
    'distinct,do,domain,drop,else,end,entry_point,escape,exception,execute,'+
    'exists,exit,external,extract,filter,for,foreign,from,full,function,'+
    'generator,grant,group,having,if,in,inactive,index,inner,insert,into,is,'+
    'isolation,join,key,left,level,like,merge,names,no,not,null,of,on,only,'+
    'or,order,outer,parameter,password,plan,position,primary,privileges,'+
    'procedure,protected,read,retain,returns,revoke,right,rollback,schema,'+
    'select,set,shadow,shared,snapshot,some,suspend,table,then,to,'+
    'transaction,trigger,uncommitted,union,unique,update,user,using,values,'+
    'view,wait,when,where,while,with,work';

  WordChars = ['a'..'z', 'A'..'Z', '