frxsynmemo.pas

这个是功能强大的报表软件

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

unit frxSynMemo;

interface

{$I frx.inc}

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

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

  TfrxCodeCompletionEvent = procedure(const Name: String; List: TStrings) of object;

  TfrxSyntaxMemo = class(TfrxScrollWin)
  private
    FActiveLine: Integer;
    FAllowLinesChange: Boolean;
    FBlockColor: TColor;
    FBlockFontColor: TColor;
    FBookmarks: array[0..9] of Integer;
    FCharHeight: Integer;
    FCharWidth: Integer;
    FCommentAttr: TFont;
    FCompletionForm: TfrxPopupForm;
    FCompletionLB: TListBox;
    FDoubleClicked: Boolean;
    FDown: Boolean;
    FToggleBreakPointDown: Boolean;
    FGutterWidth: Integer;
    FIsMonoType: Boolean;
    FKeywordAttr: TFont;
    FMaxLength: Integer;
    FMessage: String;
    FModified: Boolean;
    FMoved: Boolean;
    FNumberAttr: TFont;
    FOffset: TPoint;
    FOnChangePos: TNotifyEvent;
    FOnChangeText: TNotifyEvent;
    FOnCodeCompletion: TfrxCodeCompletionEvent;
    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;
    FBreakPoints: TStringList;
    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 ClearSyntax(ClearFrom: Integer);
    procedure CompletionLBDblClick(Sender: TObject);
    procedure CompletionLBDrawItem(Control: TWinControl; Index: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure CompletionLBKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure CorrectBookmark(Line, Delta: Integer);
    procedure CorrectBreakPoints(Line, Delta: Integer);
    procedure CreateSynArray(EndLine: Integer);
    procedure DoBackspace;
    procedure DoChange;
    procedure DoChar(Ch: Char);
    procedure DoCodeCompletion;
    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 WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    function GetTextSelected: Boolean;
  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 SelectAll;
    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);
    procedure AddBreakPoint(Number: Integer; const Condition: String);
    procedure ToggleBreakPoint(Number: Integer; const Condition: String);
    procedure DeleteBreakPoint(Number: Integer);
    procedure DeleteF4BreakPoints;
    function IsBreakPoint(Number: Integer): Boolean;
    function GetBreakPointCondition(Number: Integer): String;

    property ActiveLine: Integer read FActiveLine write SetActiveLine;
    property BlockColor: TColor read FBlockColor write FBlockColor;
    property BlockFontColor: TColor read FBlockFontColor write FBlockFontColor;
    property BreakPoints: TStringList read FBreakPoints;
    property Color;
    property CommentAttr: TFont read FCommentAttr write SetCommentAttr;
    property Font;
    property GutterWidth: Integer read FGutterWidth write FGutterWidth;
    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 TextSelected: Boolean read GetTextSelected; 
    property OnChangePos: TNotifyEvent read FOnChangePos write FOnChangePos;
    property OnChangeText: TNotifyEvent read FOnChangeText write FOnChangeText;
    property OnCodeCompletion: TfrxCodeCompletionEvent read FOnCodeCompletion
      write FOnCodeCompletion;
    property OnDragDrop;
    property OnDragOver;
    property OnKeyDown;
  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', '