home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d456 / DCSLIB25.ZIP / DCSyntaxMemo.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-28  |  98KB  |  3,548 lines
  1. {
  2.  BUSINESS CONSULTING
  3.  s a i n t - p e t e r s b u r g
  4.  
  5.          Components Library for Borland Delphi 4.x, 5.x
  6.          Copyright (c) 1998-2000 Alex'EM
  7.  
  8.  Special thanks to Vladimir Pudovkin
  9. }
  10.  
  11. unit DCSyntaxMemo;
  12. {$I DCConst.inc}
  13.  
  14. interface
  15. uses
  16.   Windows, SysUtils, Messages, Classes, Controls, Consts, Graphics, Forms,
  17.   Clipbrd, DCSyntaxData, Dialogs, StdCtrls
  18.  {$IFDEF DELPHI_V5UP}, RTLConsts {$ENDIF};
  19.  
  20. const
  21.     CM_MEMO_BASE       = WM_USER + $300;
  22.     CM_ROW_CHANGED     = CM_MEMO_BASE + $00;
  23.     CM_ROW_INSERTED    = CM_MEMO_BASE + $01;
  24.     CM_ROW_DELETED     = CM_MEMO_BASE + $02;
  25.     CM_UPDATE_STARTED  = CM_MEMO_BASE + $03;
  26.     CM_UPDATE_FINISHED = CM_MEMO_BASE + $04;
  27.     CM_INVALIDATE_ALL  = CM_MEMO_BASE + $05;
  28.  
  29.     MEMOSCROLL_IDEVENT = CM_MEMO_BASE + $01;
  30.     
  31.     HTGUTTER           = CM_MEMO_BASE + $01;
  32.     HTSELECTED         = CM_MEMO_BASE + $02;
  33.  
  34.     ngsBreakStop      = 0;
  35.     ngsBreakInvalid   = 1;
  36.     ngsBreakSet       = 2;
  37.     ngsArrow          = 3;
  38.     ngsEllipse        = 4;
  39.     ngsBookmark_0     = 5;
  40.     ngsBookmark_1     = 6;
  41.     ngsBookmark_2     = 7;
  42.     ngsBookmark_3     = 8;
  43.     ngsBookmark_4     = 9;
  44.     ngsBookmark_5     = 10;
  45.     ngsBookmark_6     = 11;
  46.     ngsBookmark_7     = 12;
  47.     ngsBookmark_8     = 13;
  48.     ngsBookmark_9     = 14;
  49.  
  50. type
  51.   TTextSelectMode  = (smLines, smColumns);
  52.   TMemoState       = (msSelecting, msMoving);
  53.   TMemoStates      = set of TMemoState;
  54.   TBlockUndoStyle  = (buInsert, buDelete);
  55.   TDeleteUndoStyle = (duDelete, duBackspace);
  56.  
  57.   TDCMemoStrings = class(TStrings)
  58.   private
  59.     FCount: Integer;
  60.     FCapacity: Integer;
  61.     FUpdating: Boolean;
  62.     FControl: TCustomControl;
  63.     FList: PLineDataItems;
  64.     FMessages: boolean;
  65.     FDestroing: boolean;
  66.     procedure SendControlMessage(AMessage: Cardinal);
  67.     procedure Grow;
  68.     procedure InsertItem(Index: Integer; const S: string);
  69.     function GetLineInfo(Index: Integer): PLineDataItem;
  70.   protected
  71.     function Get(Index: Integer): string; override;
  72.     function GetCapacity: Integer; override;
  73.     function GetCount: Integer; override;
  74.     procedure Put(Index: Integer; const S: string); override;
  75.     procedure SetCapacity(NewCapacity: Integer); override;
  76.     procedure SetUpdateState(Updating: Boolean); override;
  77.   public
  78.     constructor Create(AControl: TCustomControl);
  79.     destructor Destroy; override;
  80.     function Add(const Value: string): Integer; override;
  81.     procedure Clear; override;
  82.     procedure Delete(Index: Integer); override;
  83.     procedure DeleteLines(Index, ACount: Integer);
  84.     procedure InsertLines(Index, ACount: Integer);
  85.     procedure GrowTo(ANewCount: Integer);
  86.     procedure Insert(Index: Integer; const S: string); override;
  87.     property LineInfo[Index: Integer]: PLineDataItem read GetLineInfo;
  88.     property Messages: boolean read FMessages write FMessages;
  89.   end;
  90.  
  91.   TDCTextArea = class(TObject)
  92.   private
  93.     function GetRect: TRect;
  94.   public
  95.     Empty: boolean;
  96.     StartPos: TPoint;
  97.     EndPos: TPoint;
  98.     Mode: TTextSelectMode;
  99.     constructor Create;
  100.     procedure Add(AStartPos, AEndPos: TPoint);
  101.     procedure AddSelection(ANewPos, AOldPos: TPoint);
  102.     function WordSelected(ACol, ARow, ALength: integer;
  103.       var SelStart, SelEnd: integer): boolean;
  104.     procedure Clear;
  105.     property Rect: TRect read GetRect;
  106.   end;
  107.  
  108.   TDCMemoCoord = record
  109.     X: integer;
  110.     Y: integer;
  111.   end;
  112.  
  113.   TDCMemoPos = packed record
  114.     TopLeft: TDCMemoCoord;
  115.     Col: integer;
  116.     Row: integer;
  117.     SelectRect: TRect;
  118.   end;
  119.  
  120.   TGutterState = record
  121.     HitTest: integer;
  122.     MLDown: boolean;
  123.     MDPos: TPoint;
  124.     MUPos: TPoint;
  125.   end;
  126.  
  127.   TBlockType = record
  128.     Block: string;
  129.     SelectRect: TRect;
  130.     DefaultCursor: TCursor;
  131.   end;
  132.  
  133.   TDCCustomSyntaxMemo = class;
  134.  
  135.   TDCMemoScroll = class(TPersistent)
  136.   private
  137.     FControl: TDCCustomSyntaxMemo;
  138.     FKind: TScrollBarKind;
  139.     FPosition: integer;
  140.     FRange: integer;
  141.     FIncrement: TScrollBarInc;
  142.     FPageSize: integer;
  143.     FMax: integer;
  144.   public
  145.     constructor Create(AControl: TDCCustomSyntaxMemo; AKind: TScrollBarKind);
  146.     procedure ScrollMessage(var Message: TWMScroll);
  147.     procedure SetPosition(Value: integer);
  148.     procedure SetRange(Value: integer);
  149.     procedure Update;
  150.   end;
  151.  
  152.   TBookmarkNum  = 0..9;
  153.   TMemoBookmark = packed record
  154.     TopLeft: TDCMemoCoord;
  155.     Col: integer;
  156.     Row: integer;
  157.     Toggle: boolean;
  158.   end;
  159.   TMemoBookmarks = array[TBookmarkNum] of TMemoBookmark;
  160.  
  161.   TCustomUndoAction = class
  162.   private
  163.     Memo: TDCCustomSyntaxMemo;
  164.     CurPos: TDCMemoPos;
  165.     NewPos: TDCMemoPos;
  166.   public
  167.     constructor Create(AMemo: TDCCustomSyntaxMemo; ACurPos, ANewPos: TDCMemoPos);
  168.     procedure Undo; dynamic; abstract;
  169.     procedure Redo; dynamic; abstract;
  170.   end;
  171.  
  172.   TUndoActionList = class(TList)
  173.   private
  174.     FMemo: TDCCustomSyntaxMemo;
  175.     FPosition: integer;
  176.     FUpdated: boolean;
  177.     function GetCanRedo: boolean;
  178.     function GetCanUndo: boolean;
  179.   public
  180.     constructor Create(AMemo: TDCCustomSyntaxMemo);
  181.     procedure AddUndoAction(AUndo: TCustomUndoAction);
  182.     procedure Clear; override;
  183.     procedure Undo;
  184.     procedure Redo;
  185.     property CanUndo: boolean read GetCanUndo;
  186.     property CanRego: boolean read GetCanRedo;
  187.   end;
  188.  
  189.   TColRowChanged = procedure (Sender: TObject; Col, Row: integer) of object;
  190.   TGutterClick   = procedure (Sender: TObject; MouseDownPos, MouseUpPos: TPoint) of object;
  191.  
  192.   TEditorOptions = (eoDoubleClickLine, eoCursorBeyondEOF, eoAutoIndentMode,
  193.     eoPersistentBlocks, eoSmartTab, eoBackspaceUnindents, eoKeepTrailingBlanks);
  194.   TEditorOptionsSet = set of TEditorOptions;
  195.  
  196.   TDCCustomSyntaxMemo = class(TCustomControl)
  197.   private
  198.     FSyntaxDataClass: TSyntaxDataClass;
  199.     FLines: TDCMemoStrings;
  200.     FSyntaxData: TDCCustomSyntaxData;
  201.     FCurrent: TDCMemoCoord;
  202.     FColCount: Longint;
  203.     FRowCount: Longint;
  204.     FHalf: TPoint;
  205.     FTopLeft: TDCMemoCoord;
  206.     FRowHeight: integer;
  207.     FColWidth: integer;
  208.     FSelectedArea: TDCTextArea;
  209.     FUpdateArea: TDCTextArea;
  210.     FChangedArea: TDCTextArea;
  211.     FMemoState: TMemoStates;
  212.     FInsertMode: Boolean;
  213.     FTabSize: integer;
  214.     FKeepTrailingBlanks: boolean;
  215.     FOnChange: TNotifyEvent;
  216.     FScrollTimerHandle: THandle;
  217.     FScrollInc: TPoint;
  218.     FReadOnly: boolean;
  219.     FVScroll: TDCMemoScroll;
  220.     FHScroll: TDCMemoScroll;
  221.     FUpdateVScroll: boolean;
  222.     FGutterWidth: integer;
  223.     FRightMargin: integer;
  224.     FVisibleGutter: boolean;
  225.     FVisibleRightMargin: boolean;
  226.     FIndicators: TImageList;
  227.     FBookmarks: TMemoBookmarks;
  228.     FUpdateCount: integer;
  229.     FOnColRowChanged: TColRowChanged;
  230.     FOnSetInsertMode: TNotifyEvent;
  231.     FUndoList: TUndoActionList;
  232.     FGroupUndo: boolean;
  233.     FCurPos: TDCMemoPos;
  234.     FGutterState: TGutterState;
  235.     FMouseMoving: boolean;
  236.     FOnGutterClick: TGutterClick;
  237.     FMovingBlock: TBlockType;
  238.     FLockPaint: integer;
  239.     FModified: boolean;
  240.     FUndoCount: integer;
  241.     FOnModifiedChanged: TNotifyEvent;
  242.     FEditorOptions: TEditorOptionsSet;
  243.     procedure UpdateMetrics;
  244.     procedure UpdateCRCount;
  245.     function GetText: string;
  246.     procedure SetText(const Value: string);
  247.     procedure ResetValues; virtual;
  248.     procedure SetCol(Value: integer);
  249.     procedure SetRow(Value: integer);
  250.     procedure ClearSelection;
  251.     procedure DeselectArea;
  252.     procedure Backspace;
  253.     procedure DeleteChars;
  254.     procedure GoEnd;
  255.     procedure WordLeft;
  256.     procedure WordRight;
  257.     procedure TabLeft;
  258.     procedure TabRight;
  259.     procedure AddSelection(ANewPos, AOldPos: TPoint);
  260.     procedure SetTabSize(const Value: integer);
  261.     procedure SetLeftCol(const Value: integer);
  262.     procedure SetTopRow(const Value: integer);
  263.     function GetIndentValue(ACol, ARow: integer): integer;
  264.     procedure SetLines(const Value: TDCMemoStrings);
  265.     procedure DoChangeText;
  266.     procedure StartScrollTimer;
  267.     procedure StopScrollTimer;
  268.     procedure SetReadOnly(const Value: boolean);
  269.     procedure UpdateScrollBars;
  270.     procedure DoScroll(X, Y: integer);
  271.     procedure DrawRightMargin(ARow: integer);
  272.     procedure InvalidateGutter;
  273.     procedure BeginUpdate;
  274.     procedure EndUpdate(AScroll: boolean = False);
  275.     function GetBookmarkState(Index: TBookmarkNum): boolean;
  276.     procedure CreateCaretUndo;
  277.     procedure SaveCurPos;
  278.     procedure MouseSelection(XPos, YPos: integer);
  279.     procedure SetMovingParam;
  280.     procedure LockPaint;
  281.     function UnlockPaint: boolean;
  282.     procedure SetModified(Value: boolean);
  283.     procedure UpdateModifiedStatus(Value: integer = -1);
  284.     function GetSyntaxColors: TDCSyntaxMemoColors;
  285.   protected
  286.     procedure Paint; override;
  287.     procedure CreateParams(var Params: TCreateParams); override;
  288.     procedure CreateWnd; override;
  289.     procedure WndProc(var Message: TMessage); override;
  290.     procedure AdjustClientRect(var Rect: TRect); override;
  291.     function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
  292.       MousePos: TPoint): Boolean; override;
  293.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  294.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  295.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  296.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  297.     procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
  298.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  299.     procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  300.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  301.     procedure WMNCLButtonDown(var Message: TWMLButtonDown); message WM_NCLBUTTONDOWN;
  302.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  303.     procedure WMSize(var Message: TWMSize ); message WM_SIZE;
  304.     procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
  305.     procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
  306.     procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  307.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  308.     procedure CMRowChanged(var Message: TMessage); message CM_ROW_CHANGED;
  309.     procedure CMRowInserted(var Message: TMessage); message CM_ROW_INSERTED;
  310.     procedure CMRowDeleted(var Message: TMessage); message CM_ROW_DELETED;
  311.     procedure CMUpdateFinished(var Message: TMessage); message CM_UPDATE_FINISHED;
  312.     procedure CMInvalidateAll(var Message: TMessage); message CM_INVALIDATE_ALL;
  313.     procedure SetInsertMode(const Value: boolean); virtual;
  314.     procedure DrawRow(ARow: integer; AScroll: boolean = False); virtual;
  315.     procedure DrawLexem(ACol, ARow: integer; AText: string; Item: TLexemType); virtual;
  316.     procedure DrawLexemItem(ACol, ARow: integer; AText: string; BGColor, FGColor: TColor); virtual;
  317.     procedure DrawGutter(ARow: integer); virtual;
  318.     procedure UpdateGutter(AMode, ARow, ACount: integer); virtual;
  319.     function GetBlock(ARect: TRect; SelectMode: TTextSelectMode; AddCR: boolean = True): string;
  320.     procedure DeleteBlock(ARect: TRect; SelectMode: TTextSelectMode);
  321.     function InsertBlock(ACol, ARow: integer; SelectMode: TTextSelectMode; pBlock: PChar): integer;
  322.     procedure InsertChar(ACol, ARow: integer; ASymbol: Char);
  323.     procedure SetRowColor(ARow: integer; var BGColor, FGColor: TColor); virtual;
  324.     procedure ColRowChanged(ACol, ARow: integer);
  325.     property Text: string read GetText write SetText;
  326.     property Col: integer read FCurrent.X write SetCol;
  327.     property Row: integer read FCurrent.Y write SetRow;
  328.     property ReadOnly: boolean read FReadOnly write SetReadOnly;
  329.     property OnColRowChanged: TColRowChanged read FOnColRowChanged write FOnColRowChanged;
  330.     property OnSetInsertMode: TNotifyEvent read FOnSetInsertMode write FOnSetInsertMode;
  331.     property OnGutterClick: TGutterClick read FOnGutterClick write FOnGutterClick;
  332.     property Modified: boolean read FModified write SetModified;
  333.     property OnModifiedChanged: TNotifyEvent read FOnModifiedChanged write FOnModifiedChanged;
  334.   public
  335.     constructor Create(AOwner: TComponent;
  336.       ASyntaxDataClass: TSyntaxDataClass = nil); reintroduce; overload;
  337.     destructor Destroy; override;
  338.     procedure Clear;
  339.     procedure ClearUndoList;
  340.     function CopyToClipboard: string;
  341.     function CutToClipboard: string;
  342.     procedure DoGutterClick(MouseDownPos, MouseUpPos: TPoint); virtual;
  343.     procedure DrawGutterState(AState, ARow, AIndexPos: integer);
  344.     function GetCursorPos(ACol, ARow: integer; ACarret: boolean = False): TPoint;
  345.     function GetMemoCoord(PosX, PosY: integer): TDCMemoCoord;
  346.     procedure GotoBookmark(ABookmark: TBookmarkNum);
  347.     procedure InvalidateRect(ARect: TRect);
  348.     procedure KeyPress(var Key: Char); override;
  349.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  350.     procedure KeyUp(var Key: Word; Shift: TShiftState); override;
  351.     procedure MoveTopLeft(ALeft, ATop: integer);
  352.     procedure RedrawCaret;
  353.     procedure PaintText(AScroll: boolean = False);
  354.     procedure PasteFromClipboard;
  355.     procedure ToggleBookmark(ABookmark: TBookmarkNum);
  356.     procedure SelectRect(ARect: TRect);
  357.     procedure SetDataClass(Value: TSyntaxDataClass);
  358.     procedure UpdateSyntaxData;
  359.     function WordAt(ACol, ARow: integer; var APoint: TPoint): boolean;
  360.     property Bookmarks[Index: TBookmarkNum]: boolean read GetBookmarkState;
  361.     property ColCount: longint read FColCount;
  362.     property EditorOptions: TEditorOptionsSet read FEditorOptions write FEditorOptions;
  363.     property GroupUndo: boolean read FGroupUndo write FGroupUndo;
  364.     property InsertMode: boolean read FInsertMode write SetInsertMode;
  365.     property LeftCol: integer read FTopLeft.X write SetLeftCol;
  366.     property Lines: TDCMemoStrings read FLines write SetLines;
  367.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  368.     property OnKeyPress;
  369.     property RowCount: longint read FRowCount;
  370.     property SyntaxColors: TDCSyntaxMemoColors read GetSyntaxColors;
  371.     property TabSize: integer read FTabSize write SetTabSize;
  372.     property TopRow: integer read FTopLeft.Y write SetTopRow;
  373.     property OnClick;
  374.     property OnDblClick;
  375.     property OnDragDrop;
  376.     property OnDragOver;
  377.     property OnEnter;
  378.     property OnExit;
  379.     property OnEndDrag;
  380.     property OnEndDock;
  381.     property OnKeyDown;
  382.     property OnKeyUp;
  383.     property OnMouseDown;
  384.     property OnMouseMove;
  385.     property OnMouseUp;
  386.     property OnStartDrag;
  387.     property OnStartDock;
  388.   end;
  389.  
  390.   TDCSyntaxMemo = class(TDCCustomSyntaxMemo)
  391.   published
  392.     property Text;
  393.     property Col;
  394.     property Row;
  395.     property OnChange;
  396.     property ReadOnly;
  397.     property PopupMenu;
  398.     property OnColRowChanged;
  399.     property OnSetInsertMode;
  400.     property OnGutterClick;
  401.     property Modified;
  402.     property OnModifiedChanged;
  403.   end;
  404.  
  405. implementation
  406.  
  407. {$R *.RES}
  408.  
  409. const
  410.     gsBreakStop      = 'GS_BREAK_STOP';
  411.     gsBreakInvalid   = 'GS_BREAK_INVALID';
  412.     gsBreakSet       = 'GS_BREAK_SET';
  413.     gsArrow          = 'GS_ARROW';
  414.     gsEllipse        = 'GS_ELLIPSE';
  415.     gsBookmark_0     = 'GS_BOOKMARK_0';
  416.     gsBookmark_1     = 'GS_BOOKMARK_1';
  417.     gsBookmark_2     = 'GS_BOOKMARK_2';
  418.     gsBookmark_3     = 'GS_BOOKMARK_3';
  419.     gsBookmark_4     = 'GS_BOOKMARK_4';
  420.     gsBookmark_5     = 'GS_BOOKMARK_5';
  421.     gsBookmark_6     = 'GS_BOOKMARK_6';
  422.     gsBookmark_7     = 'GS_BOOKMARK_7';
  423.     gsBookmark_8     = 'GS_BOOKMARK_8';
  424.     gsBookmark_9     = 'GS_BOOKMARK_9';
  425.  
  426. type
  427.  
  428.   TCaretUndo = class(TCustomUndoAction)
  429.   public
  430.     procedure Undo; override;
  431.     procedure Redo; override;
  432.   end;
  433.  
  434.   TCharUndo  = class(TCaretUndo)
  435.   private
  436.     Value: Char;
  437.     BreakCount: integer;
  438.   public
  439.     constructor Create(AMemo: TDCCustomSyntaxMemo; ACurPos, ANewPos: TDCMemoPos;
  440.       AValue: Char; ABreakCount: integer);
  441.     procedure Undo; override;
  442.     procedure Redo; override;
  443.   end;
  444.  
  445.   TBlockUndo = class(TCaretUndo)
  446.   private
  447.     Style: TBlockUndoStyle;
  448.     InsValue: string;
  449.     DelValue: string;
  450.     SelectMode: TTextSelectMode;
  451.     PersistentBlocks: boolean;
  452.     BreakCount: integer;
  453.     procedure InsertBlock;
  454.     function GetTextRect(Left, Top: integer; pSource: PChar): TRect;
  455.   public
  456.     constructor Create(AMemo: TDCCustomSyntaxMemo; ACurPos, ANewPos: TDCMemoPos;
  457.       AStyle: TBlockUndoStyle; AInsValue, ADelValue: string;
  458.       ASelectMode: TTextSelectMode; APersistentBlocks: boolean; ABreakCount: integer);
  459.     procedure Undo; override;
  460.     procedure Redo; override;
  461.   end;
  462.  
  463.   TDeleteUndo = class(TCaretUndo)
  464.   private
  465.     Style: TDeleteUndoStyle;
  466.     Value: string;
  467.   public
  468.     constructor Create(AMemo: TDCCustomSyntaxMemo; ACurPos, ANewPos: TDCMemoPos;
  469.       AValue: string; AStyle: TDeleteUndoStyle);
  470.     procedure Undo; override;
  471.     procedure Redo; override;
  472.   end;
  473.  
  474. function ComparePoints(const P1, P2: TPoint): Integer;
  475. begin
  476.   if (P1.Y < P2.Y) or (P1.Y = P2.Y) and (P1.X < P2.X) then
  477.     Result := -1
  478.   else if (P1.Y = P2.Y) and (P1.X = P2.X) then
  479.     Result := 0
  480.   else
  481.     Result := 1;
  482. end;
  483.  
  484. function SortPoints(var P1: TPoint; var P2: TPoint): Boolean;
  485.  var
  486.   P: TPoint;
  487. begin
  488.   Result := ComparePoints(P1, P2) = 1;
  489.   if Result then
  490.   begin
  491.     P := P1; P1:= P2; P2:= P;
  492.   end
  493. end;
  494.  
  495. function MemoPos(ATopLeft: TDCMemoCoord; ACol, ARow: integer; ASelectRect: TRect): TDCMemoPos;
  496. begin
  497.   with Result do
  498.   begin
  499.     TopLeft := ATopLeft;
  500.     Col := ACol;
  501.     Row := ARow;
  502.     SelectRect := ASelectRect;
  503.   end;
  504. end;
  505.  
  506. { TDCMemoStrings }
  507.  
  508. function TDCMemoStrings.Add(const Value: string): Integer;
  509. var
  510.   P, Start: PChar;
  511.   S: string;
  512. begin
  513.   BeginUpdate;
  514.   try
  515.     Result := GetCount;
  516.     P := Pointer(Value);
  517.     if P <> nil then
  518.     begin
  519.       while P^ <> #0 do
  520.       begin
  521.         Start := P;
  522.         while not (P^ in [#0, #10, #13]) do Inc(P);
  523.         SetString(S, Start, P - Start);
  524.         inherited Add(S);
  525.         if P^ = #13 then Inc(P);
  526.         if P^ = #10 then Inc(P);
  527.       end
  528.     end  
  529.     else
  530.     if Value = '' then inherited Add('');
  531.   finally
  532.     EndUpdate;
  533.   end;
  534. end;
  535.  
  536. procedure TDCMemoStrings.Clear;
  537.  var
  538.   i: integer;
  539. begin
  540.   if FCount <> 0 then
  541.   begin
  542.     if not FDestroing then SendControlMessage(CM_UPDATE_STARTED);
  543.     for i := 0 to FCount - 1 do
  544.       ReallocMem(FList^[I].Lexems, 0);
  545.     Finalize(FList^[0], FCount);
  546.     FCount := 0;
  547.     SetCapacity(0);
  548.     if not FDestroing then FControl.Perform(CM_INVALIDATE_ALL, 0, 0);
  549.     if not FDestroing then SendControlMessage(CM_UPDATE_FINISHED);
  550.   end;
  551. end;
  552.  
  553. constructor TDCMemoStrings.Create(AControl: TCustomControl);
  554. begin
  555.   inherited Create;
  556.   FControl  := AControl;
  557.   FMessages := True;
  558.   FDestroing:= False;
  559. end;
  560.  
  561. procedure TDCMemoStrings.Delete(Index: Integer);
  562. begin
  563.    if (Index < 0) or (Index >= FCount) then Error(SListIndexError, Index);
  564.    SendControlMessage(CM_UPDATE_STARTED);
  565.    ReallocMem(FList^[Index].Lexems, 0);
  566.    Finalize(FList^[Index]);
  567.    Dec(FCount);
  568.    if Index < FCount then
  569.     System.Move(FList^[Index + 1], FList^[Index], (FCount - Index)*SizeOf(TLineDataItem));
  570.    FControl.Perform(CM_ROW_DELETED, Index, Index);
  571.    SendControlMessage(CM_UPDATE_FINISHED);
  572. end;
  573.  
  574. procedure TDCMemoStrings.DeleteLines(Index, ACount: Integer);
  575.  var
  576.   i: integer;
  577. begin
  578.    if Index < 0 then
  579.      Inc(ACount, Index)
  580.    else
  581.      if Index >= FCount then Exit;
  582.  
  583.    if ACount <= 0 then Exit;
  584.  
  585.    SendControlMessage(CM_UPDATE_STARTED);
  586.    i := Index;
  587.    while (ACount > 0) and (i < FCount) do
  588.    begin
  589.      ReallocMem(FList^[I].Lexems,0);
  590.      Finalize(FList^[i]);
  591.      Inc(i);
  592.      Dec(ACount);
  593.    end;
  594.    if (i < FCount) and (i <> Index) then
  595.      System.Move(FList^[i], FList^[Index], (FCount - i)*SizeOf(TLineDataItem));
  596.    Dec(FCount, i - Index);
  597.    FControl.Perform(CM_ROW_DELETED, Index, i - 1);
  598.    SendControlMessage(CM_UPDATE_FINISHED);
  599. end;
  600.  
  601. destructor TDCMemoStrings.Destroy;
  602. begin
  603.   FDestroing := True;
  604.   Clear;
  605.   inherited;
  606. end;
  607.  
  608. function TDCMemoStrings.Get(Index: Integer): string;
  609. begin
  610.   if (Index < 0) or (Index >= FCount) then Error(SListIndexError, Index);
  611.   Result := FList^[Index].FString;
  612. end;
  613.  
  614. function TDCMemoStrings.GetCapacity: Integer;
  615. begin
  616.   Result := FCapacity;
  617. end;
  618.  
  619. function TDCMemoStrings.GetCount: Integer;
  620. begin
  621.   Result := FCount;
  622. end;
  623.  
  624. function TDCMemoStrings.GetLineInfo(Index: Integer): PLineDataItem;
  625. begin
  626.   Result := @(FList^[Index]);
  627. end;
  628.  
  629. procedure TDCMemoStrings.Grow;
  630.  var
  631.   Delta: integer;
  632. begin
  633.   if FCapacity > 64 then
  634.     Delta := FCapacity div 4
  635.   else
  636.     if FCapacity > 8 then
  637.       Delta := 16
  638.     else
  639.       Delta := 4;
  640.   SetCapacity(FCapacity + Delta);
  641. end;
  642.  
  643. procedure TDCMemoStrings.GrowTo(ANewCount: Integer);
  644. begin
  645.   InsertLines(FCount, ANewCount - FCount);
  646. end;
  647.  
  648. procedure TDCMemoStrings.Insert(Index: Integer; const S: string);
  649. begin
  650.   if (Index < 0) or (Index > FCount) then Error(SListIndexError, Index);
  651.   InsertItem(Index, S);
  652. end;
  653.  
  654. procedure TDCMemoStrings.InsertItem(Index: Integer; const S: string);
  655. begin
  656.   SendControlMessage(CM_UPDATE_STARTED);
  657.   if FCount = FCapacity then Grow;
  658.   if Index < FCount then
  659.     System.Move(FList^[Index], FList^[Index + 1], (FCount - Index)*SizeOf(TLineDataItem));
  660.   FillChar(FList^[Index], SizeOf(TLineDataItem), 0);
  661.   FList^[Index].FString := S;
  662.   Inc(FCount);
  663.   FControl.Perform(CM_ROW_INSERTED, Index, Index);
  664.   SendControlMessage(CM_UPDATE_FINISHED);
  665. end;
  666.  
  667. procedure TDCMemoStrings.InsertLines(Index, ACount: Integer);
  668.  var
  669.   NewCapacity, i: integer;
  670. begin
  671.   if (Index < 0) or (Index > FCount) then Error(SListIndexError, Index);
  672.   if ACount <= 0 then Exit;
  673.  
  674.   SendControlMessage(CM_UPDATE_STARTED);
  675.   NewCapacity := FCount + ACount;
  676.   if NewCapacity > FCapacity then SetCapacity(NewCapacity);
  677.   if Index < FCount then
  678.     System.Move(FList^[Index], FList^[Index + ACount], (FCount - Index)*SizeOf(TLineDataItem));
  679.   for i := 0 to ACount-1 do with FList^[Index+i] do
  680.   begin
  681.     Pointer(FString) := nil;
  682.     FObject := nil;
  683.   end;
  684.   FillChar(FList^[Index], ACount*SizeOf(TLineDataItem), 0);
  685.   Inc(FCount, ACount);
  686.   FControl.Perform(CM_ROW_INSERTED, Index, Index + ACount - 1);
  687.   SendControlMessage(CM_UPDATE_FINISHED);
  688. end;
  689.  
  690. procedure TDCMemoStrings.Put(Index: Integer; const S: string);
  691. begin
  692.   if (Index < 0) or (Index >= FCount) then Error(SListIndexError, Index);
  693.   SendControlMessage(CM_UPDATE_STARTED);
  694.   FList^[Index].FString := S;
  695.   FControl.Perform(CM_ROW_CHANGED, Index, Index);
  696.   SendControlMessage(CM_UPDATE_FINISHED);
  697. end;
  698.  
  699. procedure TDCMemoStrings.SendControlMessage(AMessage: Cardinal);
  700. begin
  701.   if not FUpdating and FMessages then FControl.Perform(AMessage, 0, 0);
  702. end;
  703.  
  704. procedure TDCMemoStrings.SetCapacity(NewCapacity: Integer);
  705. begin
  706.   if FCapacity <> NewCapacity
  707.   then begin
  708.     FCapacity := NewCapacity;
  709.     ReallocMem(FList, FCapacity * SizeOf(TLineDataItem));
  710.   end;
  711. end;
  712.  
  713. procedure TDCMemoStrings.SetUpdateState(Updating: Boolean);
  714. begin
  715.   if FUpdating <> Updating
  716.   then begin
  717.     if FMessages then
  718.     begin
  719.       if Updating then
  720.         FControl.Perform(CM_UPDATE_STARTED, 0, 0)
  721.       else
  722.         FControl.Perform(CM_UPDATE_FINISHED, 0, 0);
  723.     end;
  724.     FUpdating := Updating;
  725.   end;
  726. end;
  727.  
  728. { TDCTextArea }
  729.  
  730. procedure TDCTextArea.Add(AStartPos, AEndPos: TPoint);
  731. begin
  732.   SortPoints(AStartPos, AEndPos);
  733.   if Empty then
  734.   begin
  735.     StartPos := AStartPos;
  736.     EndPos   := AEndPos;
  737.   end
  738.   else begin
  739.     SortPoints(StartPos, AStartPos);
  740.     SortPoints(AEndPos, EndPos);
  741.   end;
  742.   Empty := ComparePoints(StartPos, EndPos) = 0;
  743. end;
  744.  
  745. procedure TDCTextArea.AddSelection(ANewPos, AOldPos: TPoint);
  746. begin
  747.   if Empty then
  748.     Add(ANewPos, AOldPos)
  749.   else begin
  750.     if ComparePoints(ANewPos, AOldPos) > 0 then
  751.     begin
  752.       if ComparePoints(AOldPos, EndPos) >= 0  then
  753.         EndPos := ANewPos
  754.       else
  755.         StartPos := ANewPos;
  756.     end
  757.     else begin
  758.       if ComparePoints(AOldPos, StartPos) <= 0  then
  759.         StartPos := ANewPos
  760.       else
  761.         EndPos := ANewPos;
  762.     end;
  763.     SortPoints(StartPos, EndPos);
  764.  
  765.     Empty := ComparePoints(StartPos, EndPos) = 0;
  766.   end;
  767. end;
  768.  
  769. procedure TDCTextArea.Clear;
  770. begin
  771.   Empty := True;
  772.   Mode  := smLines;
  773.   StartPos := Point(0, 0);
  774.   EndPos   := Point(0, 0);
  775. end;
  776.  
  777. constructor TDCTextArea.Create;
  778. begin
  779.   Clear;
  780. end;
  781.  
  782. function TDCTextArea.GetRect: TRect;
  783. begin
  784.   Result.TopLeft := StartPos;
  785.   Result.BottomRight := EndPos;
  786. end;
  787.  
  788. function TDCTextArea.WordSelected(ACol, ARow, ALength: integer;
  789.   var SelStart, SelEnd: integer): boolean;
  790.  var
  791.   AEndPos: integer;
  792. begin
  793.   Result := False;
  794.   if Empty or (ARow < StartPos.Y) or (ARow > EndPos.Y) or (ACol < 0) then Exit;
  795.   AEndPos := ACol + ALength;
  796.   case Mode of
  797.     smLines:
  798.       begin
  799.         if (ARow = StartPos.Y) then
  800.         begin
  801.           if AEndPos < StartPos.X then Exit;
  802.           if ACol > StartPos.X then
  803.             SelStart := ACol
  804.           else
  805.             SelStart := StartPos.X;
  806.         end
  807.         else
  808.           SelStart := ACol;
  809.  
  810.         if (ARow = EndPos.Y) then
  811.         begin
  812.           if ACol > EndPos.X then Exit;
  813.           if AEndPos < EndPos.X then
  814.             SelEnd := AEndPos
  815.           else
  816.             SelEnd := EndPos.X;
  817.         end
  818.         else
  819.           SelEnd := AEndPos;
  820.  
  821.         Result := True;
  822.       end;
  823.     smColumns:
  824.       begin
  825.         if (AEndPos < StartPos.X) or (ACol > EndPos.Y) then Exit;
  826.         if ACol > StartPos.X then
  827.           SelStart := ACol
  828.         else
  829.           SelStart := StartPos.X;
  830.         if AEndPos < EndPos.X then
  831.           SelEnd := AEndPos
  832.         else
  833.           SelEnd := AEndPos;
  834.         Result := True;
  835.       end;
  836.   end;
  837. end;
  838.  
  839. { TDCCustomSyntaxMemo }
  840.  
  841. procedure TDCCustomSyntaxMemo.CMFontChanged(var Message: TMessage);
  842. begin
  843.   inherited;
  844.   Canvas.Font := Font;
  845.   UpdateMetrics;
  846.   UpdateCRCount;
  847.   Invalidate;
  848.   RedrawCaret;
  849. end;
  850.  
  851. constructor TDCCustomSyntaxMemo.Create(AOwner: TComponent;
  852.   ASyntaxDataClass: TSyntaxDataClass = nil);
  853.  var
  854.   ABitmap: TBitmap;
  855. begin
  856.   inherited Create(AOwner);
  857.   ControlStyle := ControlStyle + [csFramed];
  858.   Font.Name := 'Courier New';
  859.   Font.Size := 10;
  860.   Font.Charset := RUSSIAN_CHARSET;
  861.  
  862.   FLines :=  TDCMemoStrings.Create(Self);
  863.  
  864.   FSyntaxDataClass := ASyntaxDataClass;
  865.   if FSyntaxDataClass = nil then FSyntaxDataClass := TDCDelphiSyntaxData;
  866.  
  867.   FSyntaxData   := FSyntaxDataClass.Create;
  868.   FSelectedArea := TDCTextArea.Create;
  869.   FUpdateArea   := TDCTextArea.Create;
  870.   FChangedArea  := TDCTextArea.Create;
  871.  
  872.   InsertMode    := True;
  873.   FTabSize      := 8;
  874.   FMemoState    := [];
  875.  
  876.   FEditorOptions := [{eoDoubleClickLine, }eoCursorBeyondEOF, eoAutoIndentMode,
  877.     {eoPersistentBlocks,} eoSmartTab, eoBackspaceUnindents{, eoKeepTrailingBlanks}];
  878.  
  879.   FHScroll := TDCMemoScroll.Create(Self, sbHorizontal);
  880.   FVScroll := TDCMemoScroll.Create(Self, sbVertical);
  881.  
  882.   FHScroll.FRange := 924;
  883.   FHScroll.FMax   := MaxInt;
  884.   FUpdateVScroll  := True;
  885.   FRightMargin    := 80;
  886.   FGutterWidth    := 42;
  887.   FVisibleGutter  := True;
  888.   FUpdateCount    := 0;
  889.  
  890.   FVisibleRightMargin := True;
  891.  
  892.   FGroupUndo := True;
  893.   FUndoList  := TUndoActionList.Create(Self);
  894.   FLockPaint := 0;
  895.   Modified   := False;
  896.  
  897.   ResetValues;
  898.  
  899.   ABitmap := TBitmap.Create;
  900.   try
  901.     ABitmap.LoadFromResourceName(HInstance, gsBreakStop);
  902.     FIndicators := TImageList.CreateSize(ABitmap.Width, ABitmap.Height);
  903.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  904.     ABitmap.LoadFromResourceName(HInstance, gsBreakInvalid);
  905.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  906.     ABitmap.LoadFromResourceName(HInstance, gsBreakSet);
  907.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  908.     ABitmap.LoadFromResourceName(HInstance, gsArrow);
  909.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  910.     ABitmap.LoadFromResourceName(HInstance, gsEllipse);
  911.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  912.     ABitmap.LoadFromResourceName(HInstance, gsBookmark_0);
  913.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  914.     ABitmap.LoadFromResourceName(HInstance, gsBookmark_1);
  915.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  916.     ABitmap.LoadFromResourceName(HInstance, gsBookmark_2);
  917.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  918.     ABitmap.LoadFromResourceName(HInstance, gsBookmark_3);
  919.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  920.     ABitmap.LoadFromResourceName(HInstance, gsBookmark_4);
  921.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  922.     ABitmap.LoadFromResourceName(HInstance, gsBookmark_5);
  923.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  924.     ABitmap.LoadFromResourceName(HInstance, gsBookmark_6);
  925.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  926.     ABitmap.LoadFromResourceName(HInstance, gsBookmark_7);
  927.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  928.     ABitmap.LoadFromResourceName(HInstance, gsBookmark_8);
  929.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  930.     ABitmap.LoadFromResourceName(HInstance, gsBookmark_9);
  931.     FIndicators.AddMasked(ABitmap, ABitmap.Canvas.Pixels[0,0]);
  932.   finally
  933.     ABitmap.Free;
  934.   end;
  935.  
  936. end;
  937.  
  938. function TDCCustomSyntaxMemo.GetMemoCoord(PosX,
  939.   PosY: integer): TDCMemoCoord;
  940.  var
  941.   AColCount, ARowCount: integer;
  942. begin
  943.   with Result do
  944.   begin
  945.     if FVisibleGutter then Dec(PosX, FGutterWidth);
  946.     X := MulDiv(PosX, 1, FColWidth);
  947.     Y := Trunc(PosY * 1.0 / FRowHeight);
  948.     AColCount := FColCount - FHalf.X;
  949.     ARowCount := FRowCount - FHalf.Y;
  950.     if X > AColCount then X := AColCount;
  951.     if Y > ARowCount then Y := ARowCount;
  952.     Inc(X, LeftCol);
  953.     Inc(Y, TopRow);
  954.   end;
  955.  
  956. end;
  957.  
  958. function TDCCustomSyntaxMemo.GetCursorPos(ACol, ARow: integer; ACarret: boolean = False): TPoint;
  959. begin
  960.   with Result do
  961.   begin
  962.     X := (ACol - FTopLeft.X) * FColWidth;
  963.     Y := (ARow - FTopLeft.Y) * FRowHeight;
  964.     if ACarret and (X < 0) then Exit;
  965.     if FVisibleGutter then Inc(X, FGutterWidth);
  966.   end;
  967. end;
  968.  
  969. procedure TDCCustomSyntaxMemo.RedrawCaret;
  970.  var
  971.   AWidth, AHeight: integer;
  972.   P: TPoint;
  973. begin
  974.   if HandleAllocated then
  975.   begin
  976.     AWidth  := 2;
  977.     AHeight := FRowHeight;
  978.  
  979.     if Focused then
  980.     begin
  981.       HideCaret(Handle);
  982.       CreateCaret(Handle, 0, AWidth, AHeight);
  983.       P := GetCursorPos(FCurrent.X, FCurrent.Y, True);
  984.       if P.X > 0 then Dec(P.X);
  985.       SetCaretPos(P.X, P.Y);
  986.       ShowCaret(Handle);
  987.     end
  988.     else
  989.       HideCaret(Handle);
  990.   end;
  991. end;
  992.  
  993. procedure TDCCustomSyntaxMemo.UpdateCRCount;
  994.  var
  995.   AClientWidth, AClientHeight: integer;
  996. begin
  997.   if HandleAllocated then
  998.   begin
  999.     if FVisibleGutter then
  1000.       AClientWidth := ClientWidth - FGutterWidth
  1001.     else
  1002.       AClientWidth := ClientWidth;
  1003.     AClientHeight := ClientHeight;
  1004.  
  1005.     FColCount := AClientWidth div FColWidth;
  1006.     FRowCount := AClientHeight div FRowHeight;
  1007.     FHalf.X   := 0;
  1008.     FHalf.Y   := 0;
  1009.     if AClientWidth mod FColWidth <> 0 then Inc(FHalf.X);
  1010.     if AClientHeight mod FRowHeight <> 0 then Inc(FHalf.Y);
  1011.   end;
  1012. end;
  1013.  
  1014. procedure TDCCustomSyntaxMemo.UpdateMetrics;
  1015.  var
  1016.   TextMetric: TTextMetric;
  1017. begin
  1018.   if HandleAllocated then
  1019.   begin
  1020.     if GetTextMetrics(Canvas.Handle, TextMetric) then
  1021.     begin
  1022.       FColWidth  := TextMetric.tmAveCharWidth;
  1023.       FRowHeight := TextMetric.tmHeight;
  1024.     end;
  1025.   end;
  1026. end;
  1027.  
  1028. procedure TDCCustomSyntaxMemo.WMSize(var Message: TWMSize);
  1029. begin
  1030.   inherited;
  1031.   UpdateMetrics;
  1032.   UpdateCRCount;
  1033.  
  1034.   with FVScroll do
  1035.   begin
  1036.     FPageSize := FRowCount;
  1037.     if FLines.Count > 1 then
  1038.       FRange := FLines.Count + FRowCount - 2
  1039.     else
  1040.       FRange := FRowCount;
  1041.     FMax      := FRange;
  1042.   end;
  1043.   with FHScroll do
  1044.   begin
  1045.     FPageSize := FColCount;
  1046.   end;
  1047.  
  1048.   UpdateScrollBars;
  1049. end;
  1050.  
  1051. procedure TDCCustomSyntaxMemo.WMNCCalcSize(var Message: TWMNCCalcSize);
  1052. begin
  1053.   inherited;
  1054. end;
  1055.  
  1056. procedure TDCCustomSyntaxMemo.WMGetDlgCode(var Message: TWMGetDlgCode);
  1057. begin
  1058.   with Message do
  1059.     Result := Result or DLGC_WANTARROWS or DLGC_WANTTAB or DLGC_WANTALLKEYS;
  1060. end;
  1061.  
  1062. procedure TDCCustomSyntaxMemo.WMSetCursor(var Message: TWMSetCursor);
  1063. begin
  1064.   with Message do
  1065.   begin
  1066.     case FGutterState.HitTest of
  1067.       HTCLIENT:
  1068.         SetCursor(Screen.Cursors[crIBeam]);
  1069.       HTGUTTER:
  1070.         inherited;
  1071.       HTSELECTED:
  1072.         begin
  1073.           if msMoving in FMemoState then
  1074.             SetCursor(Screen.Cursors[crDrag])
  1075.           else
  1076.             inherited;
  1077.         end;
  1078.       else
  1079.         inherited;
  1080.     end;
  1081.   end;
  1082. end;
  1083.  
  1084. procedure TDCCustomSyntaxMemo.WndProc(var Message: TMessage);
  1085. begin
  1086.   with Message do
  1087.   begin
  1088.     case Msg of
  1089.       WM_SETFOCUS:
  1090.         RedrawCaret;
  1091.       WM_KILLFOCUS:
  1092.         RedrawCaret;
  1093.       WM_ERASEBKGND:
  1094.         Exit;
  1095.       WM_MOUSEACTIVATE:
  1096.         SetFocus;
  1097.     end;
  1098.   end;
  1099.   inherited;
  1100. end;
  1101.  
  1102. procedure TDCCustomSyntaxMemo.WMNCHitTest(var Message: TWMNCHitTest);
  1103.  var
  1104.   APoint: TPoint;
  1105.   SelStart, SelEnd: integer;
  1106.   MemoCoord: TDCMemoCoord;
  1107. begin
  1108.   inherited;
  1109.   with Message do
  1110.   begin
  1111.     APoint := ScreenToClient(Point(XPos, YPos));
  1112.     if FVisibleGutter then
  1113.     begin
  1114.       if (APoint.X < FGutterWidth) and (Result = HTCLIENT) then Result := HTGUTTER;
  1115.       if not FSelectedArea.Empty then
  1116.       begin
  1117.         with FSelectedArea, APoint do
  1118.         begin
  1119.           MemoCoord := GetMemoCoord(X, Y);
  1120.           if WordSelected(MemoCoord.X, MemoCoord.Y, 0, SelStart, SelEnd) then
  1121.           begin
  1122.             FGutterState.HitTest := HTSELECTED;
  1123.             Exit;
  1124.           end;
  1125.         end;
  1126.       end;
  1127.     end;
  1128.     FGutterState.HitTest := Result;
  1129.   end;
  1130. end;
  1131.  
  1132. procedure TDCCustomSyntaxMemo.Paint;
  1133. begin
  1134.   FUpdateArea.Add(Point(LeftCol, TopRow),
  1135.     Point(LeftCol + FColCount + FHalf.X, TopRow + FRowCount + FHalf.Y));
  1136.   PaintText;
  1137. end;
  1138.  
  1139. procedure TDCCustomSyntaxMemo.PaintText(AScroll: boolean = False);
  1140.  var
  1141.   i: integer;
  1142. begin
  1143.   if FLockPaint = 0 then
  1144.   begin
  1145.     if not FUpdateArea.Empty then with FUpdateArea do
  1146.     begin
  1147.       if StartPos.Y < FTopLeft.Y then StartPos.Y := FTopLeft.Y;
  1148.       HideCaret(Handle);
  1149.       for i := StartPos.Y to EndPos.Y do DrawRow(i, AScroll);
  1150.       Clear;
  1151.     end;
  1152.     RedrawCaret;
  1153.     FUpdateArea.Clear;
  1154.   end;
  1155. end;
  1156.  
  1157. procedure TDCCustomSyntaxMemo.DrawRow(ARow: integer; AScroll: boolean = False);
  1158.  var
  1159.   AText, AValue: String;
  1160.   LineItem: PLineDataItem;
  1161.   LexemItem: TLexemItem;
  1162.   i, AColPos, ADrawing: integer;
  1163. begin
  1164.   if (ARow < FTopLeft.Y) or (ARow > FTopLeft.Y + FRowCount + FHalf.Y) then Exit;
  1165.  
  1166.   if (FLines.Count = 0) or (ARow >= FLines.Count) then
  1167.   begin
  1168.      AText  := ' ';
  1169.      for i := 1 to FColCount +FHalf.X - 1 do AText := AText + ' ';
  1170.      DrawLexem(FTopLeft.X, ARow, AText, lxWhitespace);
  1171.   end
  1172.   else begin
  1173.      LineItem := FLines.LineInfo[ARow];
  1174.      AText := LineItem.FString;
  1175.      AColPos := 0;
  1176.      i := 0;
  1177.      while (i < LineItem.Count) and (AColPos < FTopLeft.X + FColCount + FHalf.X) do
  1178.      begin
  1179.        LexemItem := LineItem.Lexems[i];
  1180.        ADrawing  := AColPos;
  1181.        if AColPos + LexemItem.Length >= FTopLeft.X then
  1182.        begin
  1183.          if AColPos >= FTopLeft.X then
  1184.            AValue := Copy(AText, AColPos+1, LexemItem.Length)
  1185.          else begin
  1186.            AValue := Copy(AText, FTopLeft.X+1, LexemItem.Length);
  1187.            ADrawing := FTopLeft.X;
  1188.          end;
  1189.  
  1190.          DrawLexem(ADrawing, ARow, AValue, LexemItem.Item);
  1191.        end;
  1192.  
  1193.        AColPos := AColPos + LexemItem.Length;
  1194.        Inc(i);
  1195.      end;
  1196.  
  1197.      if AColPos < FTopLeft.X + FColCount + FHalf.X
  1198.      then begin
  1199.        AText  := ' ';
  1200.        if AColPos > FTopLeft.X then
  1201.          ADrawing  := AColPos
  1202.        else
  1203.          ADrawing  := FTopLeft.X;
  1204.        for i := ADrawing to FTopLeft.X + FColCount + FHalf.X - 1 do AText := AText + ' ';
  1205.        DrawLexem(ADrawing, ARow, AText, lxWhitespace);
  1206.      end;
  1207.   end;
  1208.  
  1209.   if FVisibleRightMargin and (LeftCol <= FRightMargin) then DrawRightMargin(ARow);
  1210.   if FVisibleGutter and not AScroll then DrawGutter(ARow);
  1211. end;
  1212.  
  1213. procedure TDCCustomSyntaxMemo.DrawLexem(ACol, ARow: integer; AText: string;
  1214.   Item: TLexemType);
  1215. var
  1216.   ALength, SelStart, SelEnd: Integer;
  1217.   Selected: Boolean;
  1218. begin
  1219.   Canvas.Font.Style := SyntaxColors.Items[Item].FontStyle;
  1220.   ALength := Length(AText);
  1221.   Selected := FSelectedArea.WordSelected(ACol, ARow, ALength, SelStart, SelEnd);
  1222.  
  1223.   with SyntaxColors.Items[Item] do
  1224.   begin
  1225.     if not Selected then
  1226.       DrawLexemItem(ACol, ARow, AText, BGColor, FGColor)
  1227.     else begin
  1228.       DrawLexemItem(ACol, ARow, Copy(AText, 1 , SelStart - ACol), BGColor, FGColor);
  1229.       DrawLexemItem(SelStart, ARow,
  1230.         Copy(AText, SelStart - ACol + 1 , SelEnd - SelStart), clHighlight, clHighlightText);
  1231.       if ACol + ALength > SelEnd then
  1232.         DrawLexemItem(SelEnd, ARow,
  1233.           Copy(AText, SelEnd - ACol + 1, ACol + ALength - SelEnd), BGColor, FGColor);
  1234.     end;
  1235.   end;
  1236. end;
  1237.  
  1238. procedure TDCCustomSyntaxMemo.DrawLexemItem(ACol, ARow: integer;
  1239.   AText: string; BGColor, FGColor: TColor);
  1240.  var
  1241.   APoint: TPoint;
  1242. begin
  1243.   with Canvas do
  1244.   begin
  1245.    SetRowColor(ARow, BGColor, FGColor);
  1246.    Font.Color  := FGColor;
  1247.    Brush.Color := BGColor;
  1248.    APoint := GetCursorPos(ACol, ARow);
  1249.    TextOut(APoint.X, APoint.Y, AText);
  1250.   end;
  1251. end;
  1252.  
  1253. destructor TDCCustomSyntaxMemo.Destroy;
  1254. begin
  1255.   FUndoList.Free;
  1256.  
  1257.   FIndicators.Free;
  1258.   FHScroll.Free;
  1259.   FVScroll.Free;
  1260.  
  1261.   FSyntaxData.Free;
  1262.  
  1263.   FSelectedArea.Free;
  1264.   FUpdateArea.Free;
  1265.   FChangedArea.Free;
  1266.  
  1267.   FLines.Free;
  1268.   inherited;
  1269. end;
  1270.  
  1271. procedure TDCCustomSyntaxMemo.CMInvalidateAll(var Message: TMessage);
  1272. begin
  1273.   FChangedArea.Clear;
  1274.   FChangedArea.Add(Point(0, 0), Point(0, TopRow + FRowCount + FHalf.Y));
  1275. end;
  1276.  
  1277. procedure TDCCustomSyntaxMemo.CMRowChanged(var Message: TMessage);
  1278. begin
  1279.   with Message do
  1280.     FChangedArea.Add(Point(0, WParam),Point(0, LParam + 1));
  1281.   if not FUndoList.FUpdated then Modified := True;
  1282.   DoChangeText;
  1283. end;
  1284.  
  1285. procedure TDCCustomSyntaxMemo.CMRowDeleted(var Message: TMessage);
  1286. begin
  1287.   with Message do
  1288.   begin
  1289.     FChangedArea.Add(Point(0, WParam), Point(0, LParam + 1));
  1290.     FUpdateArea.Add(Point(0, WParam), Point(0, TopRow + FRowCount + FHalf.X));
  1291.     UpdateGutter(CM_ROW_DELETED, WParam, LParam + 1 - WParam);
  1292.  end;
  1293.  if not FUndoList.FUpdated then Modified := True;
  1294.  DoChangeText;
  1295. end;
  1296.  
  1297. procedure TDCCustomSyntaxMemo.CMRowInserted(var Message: TMessage);
  1298. begin
  1299.   with Message do
  1300.   begin
  1301.     FChangedArea.Add(Point(0, WParam), Point(0, LParam + 1));
  1302.     FUpdateArea.Add(Point(0, WParam), Point(0, TopRow + FRowCount + FHalf.X));
  1303.     UpdateGutter(CM_ROW_INSERTED, WParam, LParam + 1 - WParam);
  1304.   end;
  1305.   if not FUndoList.FUpdated then Modified := True;
  1306.   DoChangeText;
  1307. end;
  1308.  
  1309. procedure TDCCustomSyntaxMemo.CMUpdateFinished(var Message: TMessage);
  1310.  var
  1311.   i: Integer;
  1312.   APrevComment, AComment: DWORD;
  1313.   pLineItem: PLineDataItem;
  1314.   sLine: string;
  1315. begin
  1316.   if FChangedArea.Empty then Exit;
  1317.  
  1318.   FLines.Messages := False;
  1319.   i := FChangedArea.StartPos.Y;
  1320.  
  1321.   if i < FLines.Count then
  1322.   begin
  1323.     if i > 0 then
  1324.     begin
  1325.       pLineItem := FLines.LineInfo[i-1];
  1326.       APrevComment  := pLineItem.Comment;
  1327.     end
  1328.     else
  1329.       APrevComment  := 0;
  1330.  
  1331.     while i < FLines.Count do
  1332.     begin
  1333.       pLineItem := FLines.LineInfo[i];
  1334.       AComment  := pLineItem.Comment;
  1335.       pLineItem.PrevComment := APrevComment;
  1336.  
  1337.       if not FKeepTrailingBlanks then
  1338.       begin
  1339.         sLine := TrimRight(FLines[i]);
  1340.         if AnsiCompareStr(sLine, FLines[i]) <> 0 then FLines[i] := sLine;
  1341.       end;
  1342.  
  1343.       FSyntaxData.ParseLine(pLineItem);
  1344.       Inc(i);
  1345.  
  1346.       if (pLineItem.Comment <> APrevComment) or (pLineItem.Comment <> AComment)then
  1347.          FChangedArea.Add(Point(0, i + 1), Point(0, i + 1));
  1348.  
  1349.       APrevComment := pLineItem.Comment;
  1350.  
  1351.       if i >= FChangedArea.EndPos.Y then break;
  1352.     end;
  1353.   end;
  1354.  
  1355.   FLines.Messages := True;
  1356.   FUpdateArea.Add(FChangedArea.StartPos, FChangedArea.EndPos);
  1357.   PaintText;
  1358.   FChangedArea.Clear;
  1359.  
  1360.   with FVScroll do
  1361.   begin
  1362.     if FLines.Count > 1 then
  1363.       FRange := FLines.Count + FRowCount - 2
  1364.     else
  1365.       FRange := FRowCount;
  1366.     FMax   := FRange;
  1367.     if FUpdateVScroll then Update;
  1368.   end;
  1369. end;
  1370.  
  1371. function TDCCustomSyntaxMemo.GetText: string;
  1372. begin
  1373.   Result := FLines.Text;
  1374. end;
  1375.  
  1376. procedure TDCCustomSyntaxMemo.SetText(const Value: string);
  1377. begin
  1378.   FLines.Text := Value;
  1379.   FUndoList.Clear;
  1380.   ResetValues;
  1381. end;
  1382.  
  1383. procedure TDCCustomSyntaxMemo.ResetValues;
  1384. begin
  1385.   FUndoList.FUpdated := True;
  1386.   BeginUpdate;
  1387.   FCurrent.X := 0;
  1388.   FCurrent.Y := 0;
  1389.   FTopLeft.X := 0;
  1390.   FTopLeft.Y := 0;
  1391.   EndUpdate;
  1392.   FUndoList.FUpdated := False;
  1393. end;
  1394.  
  1395. function TDCCustomSyntaxMemo.InsertBlock(ACol, ARow: integer;
  1396.   SelectMode: TTextSelectMode; pBlock: PChar): integer;
  1397.  var
  1398.   BreakCount, CurRow, CurCol, i, nCount: integer;
  1399.   pValue: PChar;
  1400.   Break: boolean;
  1401.   AText, ABuf, ABuf1, ABuf2, AEndText: string;
  1402. begin
  1403.   Result := 0;
  1404.   if pBlock^ = #0 then Exit;
  1405.  
  1406.   FLines.BeginUpdate;
  1407.   BeginUpdate;
  1408.  
  1409.   nCount := 0;
  1410.   if SelectMode = smLines then
  1411.   begin
  1412.     if ARow > FLines.Count then  nCount := ARow - FLines.Count;
  1413.     FLines.GrowTo(ARow + 1);
  1414.     BreakCount := 0;
  1415.     pValue := pBlock;
  1416.     while (pValue^ <> #0) do
  1417.     begin
  1418.       if (pValue^ = #13) or (pValue^ = #10) then
  1419.       begin
  1420.         Inc(BreakCount);
  1421.         Inc(pValue);
  1422.         if pValue^ = #10 then Inc(pValue);
  1423.       end
  1424.       else
  1425.         Inc(pValue);
  1426.     end;
  1427.  
  1428.     if BreakCount > 0 then
  1429.       FLines.InsertLines(ARow +1, BreakCount);
  1430.  
  1431.     pValue := pBlock;
  1432.     CurRow := ARow;
  1433.     CurCol := ACol;
  1434.     while pValue^ <> #0 do
  1435.     begin
  1436.       while not ((pValue^ = #0) or (pValue^ = #13) or (pValue^ = #10)) do
  1437.         Inc(pValue);
  1438.  
  1439.       Break := pValue^ <> #0;
  1440.  
  1441.       SetString(AText,  pBlock, pValue - pBlock);
  1442.       if CurRow = ARow then
  1443.       begin
  1444.         ABuf := FLines[CurRow];
  1445.         if (ACol > 0) and (ACol <= Length(ABuf)) then
  1446.         begin
  1447.           ABuf1 := Copy(ABuf, 1, ACol);
  1448.           ABuf2 := Copy(ABuf, ACol+1, Length(ABuf));
  1449.         end
  1450.         else begin
  1451.           if (ACol > Length(ABuf)) and (ACol > 0) then
  1452.           begin
  1453.             ABuf1 := ABuf;
  1454.             for i := Length(ABuf) to ACol - 1 do ABuf1 := ABuf1 + ' ';
  1455.             ABuf2 := '';
  1456.           end
  1457.           else begin
  1458.             ABuf1 := '';
  1459.             ABuf2 := ABuf;
  1460.           end;
  1461.         end;
  1462.  
  1463.         if Break then
  1464.         begin
  1465.           AEndText := ABuf2;
  1466.           FLines[CurRow] := ABuf1 + AText;
  1467.           CurCol := 0;
  1468.         end
  1469.         else begin
  1470.           FLines[CurRow] := ABuf1 + AText + ABuf2;
  1471.           CurCol := ACol + Length(AText);
  1472.         end;
  1473.       end
  1474.       else begin
  1475.         FLines[CurRow] := AText;
  1476.         CurCol := Length(AText);
  1477.       end;
  1478.  
  1479.       if Break then
  1480.       begin
  1481.         Inc(CurRow);
  1482.         Inc(pValue);
  1483.         CurCol := 0;
  1484.         if pValue^ = #10 then Inc(pValue);
  1485.       end;
  1486.       pBlock := pValue;
  1487.  
  1488.     end;
  1489.     if (CurRow <> ARow) and (AEndText <> '') then
  1490.     begin
  1491.       CurCol := Length(FLines[CurRow]);
  1492.       FLines[CurRow] := FLines[CurRow] + AEndText;
  1493.     end;
  1494.  
  1495.     Col := CurCol;
  1496.     Row := CurRow;
  1497.   end
  1498.   else begin
  1499.     {}
  1500.   end;
  1501.   EndUpdate;
  1502.   FLines.EndUpdate;
  1503.   Result := nCount;
  1504. end;
  1505.  
  1506. procedure TDCCustomSyntaxMemo.SetCol(Value: integer);
  1507. begin
  1508.   if FCurrent.X <> Value then
  1509.   begin
  1510.     BeginUpdate;
  1511.     if Value < 0 then Value := 0;
  1512.     FCurrent.X := Value;
  1513.     if FCurrent.X < LeftCol then LeftCol := FCurrent.X;
  1514.     if FCurrent.X >= (LeftCol + FColCount -1) then
  1515.       LeftCol := FCurrent.X - FColCount + 1;
  1516.     EndUpdate;
  1517.   end;
  1518. end;
  1519.  
  1520. procedure TDCCustomSyntaxMemo.SetRow(Value: integer);
  1521. begin
  1522.   if FCurrent.Y <> Value then
  1523.   begin
  1524.     BeginUpdate;
  1525.     try
  1526.       if Value < 0 then Value := 0;
  1527.       FCurrent.Y := Value;
  1528.       if FCurrent.Y < TopRow then TopRow := FCurrent.Y;
  1529.       if FCurrent.Y > (TopRow + FRowCount -1) then TopRow := FCurrent.Y - FRowCount + 1;
  1530.       if FCurrent.Y > FLines.Count - 1 then
  1531.       begin
  1532.         if msSelecting in FMemoState then
  1533.         begin
  1534.           FCurrent.Y := FLines.Count - 1;
  1535.           if FCurrent.Y < 0 then FCurrent.Y := 0;
  1536.           GoEnd;
  1537.           Exit;
  1538.         end;
  1539.         if not(eoCursorBeyondEOF in EditorOptions) then
  1540.         begin
  1541.           FCurrent.Y := FLines.Count - 1;
  1542.           if FCurrent.Y < 0 then FCurrent.Y := 0;
  1543.          end;
  1544.       end;
  1545.     finally
  1546.       EndUpdate;
  1547.     end;
  1548.   end;
  1549. end;
  1550.  
  1551. procedure TDCCustomSyntaxMemo.KeyPress(var Key: Char);
  1552. begin
  1553.   inherited;
  1554.   if (Key < #32) then Exit;
  1555.   if not FReadOnly then
  1556.   begin
  1557.     if not( eoPersistentBlocks in EditorOptions) then ClearSelection;
  1558.     InsertChar(Col, Row, Key);
  1559.   end;
  1560. end;
  1561.  
  1562. procedure TDCCustomSyntaxMemo.PasteFromClipboard;
  1563.  var
  1564.   ACol, ARow, BreakCount: integer;
  1565.   DeletedText, AText: string;
  1566. begin
  1567.   if not FReadOnly and Clipboard.HasFormat(CF_TEXT) then
  1568.   begin
  1569.     SaveCurPos;
  1570.     AText := ClipBoard.AsText;
  1571.     BeginUpdate;
  1572.     if not(eoPersistentBlocks in EditorOptions) then
  1573.     begin
  1574.       FUpdateVScroll := False;
  1575.       DeletedText := GetBlock(FSelectedArea.Rect, FSelectedArea.Mode, False);
  1576.       ClearSelection;
  1577.       BreakCount := InsertBlock(Col, Row, FSelectedArea.Mode, PChar(AText));
  1578.       FUpdateVScroll := True;
  1579.       FVScroll.Update;
  1580.     end
  1581.     else begin
  1582.       DeselectArea;
  1583.       ACol := Col;
  1584.       ARow := Row;
  1585.       DeletedText := '';
  1586.       BreakCount := InsertBlock(Col, Row, FSelectedArea.Mode, PChar(AText));
  1587.       FSelectedArea.Add(Point(ACol, ARow), Point(Col, Row));
  1588.       FUpdateArea.Add(Point(ACol, ARow), Point(Col, Row));
  1589.     end;
  1590.     TBlockUndo.Create(Self, FCurPos, MemoPos(FTopLeft, Col, Row, FSelectedArea.Rect),
  1591.       buInsert, AText, DeletedText, FSelectedArea.Mode, eoPersistentBlocks in EditorOptions,
  1592.       BreakCount);
  1593.     EndUpdate;
  1594.   end;
  1595. end;
  1596.  
  1597. procedure TDCCustomSyntaxMemo.ClearSelection;
  1598. begin
  1599.   if not FSelectedArea.Empty then
  1600.   begin
  1601.     DeleteBlock(FSelectedArea.Rect, FSelectedArea.Mode);
  1602.     Col := FSelectedArea.StartPos.X;
  1603.     Row := FSelectedArea.StartPos.Y;
  1604.     DeselectArea;
  1605.   end;
  1606. end;
  1607.  
  1608. procedure TDCCustomSyntaxMemo.DeleteBlock(ARect: TRect;
  1609.   SelectMode: TTextSelectMode);
  1610.  var
  1611.   LinePart1, LinePart2, AText: string;
  1612.   i, j: integer;
  1613. begin
  1614.   if ARect.Top >= FLines.Count then Exit;
  1615.  
  1616.   FLines.BeginUpdate;
  1617.   if SelectMode = smLines then
  1618.   begin
  1619.     LinePart1 := Copy(FLines[ARect.Top], 1, ARect.Left);
  1620.     if ARect.Bottom < FLines.Count  then
  1621.     begin
  1622.       AText := FLines[ARect.Bottom];
  1623.       if ARect.Right > 0 then
  1624.         LinePart2 := Copy(AText, ARect.Right + 1, Length(AText) - ARect.Right)
  1625.       else
  1626.         LinePart2 := AText;
  1627.       if (ARect.Top = ARect.Bottom) and
  1628.          (ARect.Right >= Length(AText) + 1) and
  1629.          (ARect.Top < FLines.Count-1) then
  1630.       begin
  1631.         LinePart2 := FLines[ARect.Top + 1];
  1632.         FLines.Delete(ARect.Top);
  1633.       end
  1634.     end
  1635.     else
  1636.       LinePart2 := '';
  1637.     FLines.DeleteLines(ARect.Top, ARect.Bottom - ARect.Top);
  1638.  
  1639.     if Length(LinePart1) < ARect.Left then
  1640.     begin
  1641.       j := Length(LinePart1);
  1642.       AText := '';
  1643.       for i := j to ARect.Left - 1 do AText := AText + ' ';
  1644.       FLines[ARect.Top] := LinePart1 + AText + LinePart2;
  1645.     end
  1646.     else
  1647.       FLines[ARect.Top] := LinePart1 + LinePart2;
  1648.  
  1649.   end
  1650.   else begin
  1651.   end;
  1652.   FLines.EndUpdate;
  1653. end;
  1654.  
  1655. function TDCCustomSyntaxMemo.GetBlock(ARect: TRect;
  1656.   SelectMode: TTextSelectMode; AddCR: boolean = True): string;
  1657.  var
  1658.   i: Integer;
  1659.   AText: string;
  1660.   ALength, Size: integer;
  1661.   pValue: PChar;
  1662. begin
  1663.   Result := '';
  1664.   if (ARect.Top = ARect.Bottom) and (ARect.Top < FLines.Count) then
  1665.   begin
  1666.     Result := Copy(FLines[ARect.Top], ARect.Left + 1, ARect.Right - ARect.Left);
  1667.     if (Result = '') and AddCR then Result := #13#10;
  1668.     Exit
  1669.   end;
  1670.  
  1671.   if SelectMode = smLines then
  1672.   begin
  1673.     Size := 0;
  1674.  
  1675.     for i := ARect.Top to ARect.Bottom do
  1676.     begin
  1677.       if i < FLines.Count then
  1678.       begin
  1679.         if i = ARect.Top then
  1680.           Inc(Size, Length(FLines[i]) - ARect.Left + 2)
  1681.         else
  1682.           if i = ARect.Bottom then
  1683.             Inc(Size, ARect.Right)
  1684.           else
  1685.             Inc(Size, Length(FLines[i]) + 2);
  1686.       end;
  1687.     end;
  1688.     SetString(Result, nil, Size);
  1689.  
  1690.     pValue := Pointer(Result);
  1691.  
  1692.     for i := ARect.Top to ARect.Bottom do
  1693.     begin
  1694.       if i < FLines.Count then
  1695.         AText := FLines[i]
  1696.       else
  1697.         AText := '';
  1698.  
  1699.       if i = ARect.Top then
  1700.         AText := Copy(AText, ARect.Left + 1, 9000)
  1701.       else
  1702.         if i = ARect.Bottom then AText := Copy(AText, 1, ARect.Right);
  1703.  
  1704.       ALength := Length(AText);
  1705.  
  1706.       if ALength <> 0 then
  1707.       begin
  1708.         System.Move(Pointer(AText)^, pValue^, ALength);
  1709.         Inc(pValue, ALength);
  1710.       end;
  1711.       if i <> ARect.Bottom then
  1712.       begin
  1713.         pValue^ := #13;
  1714.         Inc(pValue);
  1715.         pValue^ := #10;
  1716.         Inc(pValue);
  1717.       end;
  1718.     end;
  1719.   end
  1720.   else begin
  1721.   end;
  1722. end;
  1723.  
  1724. procedure TDCCustomSyntaxMemo.KeyDown(var Key: Word; Shift: TShiftState);
  1725.  var
  1726.   AText: string;
  1727.   ACol, ARow, i, j: integer;
  1728.   MovingKey: boolean;
  1729.   KeyState: TKeyboardState;
  1730. begin
  1731.   inherited;
  1732.   ACol := Col;
  1733.   ARow := Row;
  1734.   SaveCurPos;
  1735.  
  1736.   MovingKey := Key in [VK_DOWN, VK_UP, VK_LEFT, VK_RIGHT, VK_PRIOR, VK_NEXT, VK_END, VK_HOME];
  1737.   BeginUpdate;
  1738.   try
  1739.     if MovingKey then
  1740.     begin
  1741.       if ssShift in Shift then
  1742.       begin
  1743.         if not (msSelecting in FMemoState) and  not FSelectedArea.Empty then
  1744.           with FSelectedArea do
  1745.           begin
  1746.             if not((StartPos.X = Col) and (StartPos.Y = Row) or
  1747.                    (EndPos.X = Col) and (EndPos.Y = Row)) then
  1748.             begin
  1749.               FUpdateArea.Add(StartPos, EndPos);
  1750.               Clear;
  1751.             end;
  1752.           end;
  1753.         FMemoState := FMemoState + [msSelecting]
  1754.       end
  1755.       else begin
  1756.         FMemoState := FMemoState - [msSelecting];
  1757.         with FSelectedArea do
  1758.         begin
  1759.           if not(eoPersistentBlocks in EditorOptions) then
  1760.           begin
  1761.             FUpdateArea.Add(StartPos, EndPos);
  1762.             Clear;
  1763.           end;
  1764.         end
  1765.       end;
  1766.     end;
  1767.  
  1768.     case Key of
  1769.       VK_DOWN:
  1770.         if ssCtrl in Shift then TopRow := TopRow + 1 else Row := Row + 1;
  1771.       VK_UP:
  1772.         if ssCtrl in Shift then TopRow := TopRow - 1 else Row := Row - 1;
  1773.       VK_LEFT:
  1774.         if not ((msSelecting in FMemoState) and (Row > FLines.Count)) then
  1775.         begin
  1776.           if ssCtrl in Shift then WordLeft else Col := Col - 1;
  1777.         end;
  1778.       VK_RIGHT:
  1779.         if not ((msSelecting in FMemoState) and (Row > FLines.Count)) then
  1780.         begin
  1781.           if ssCtrl in Shift then WordRight else Col := Col + 1;
  1782.         end;
  1783.       VK_PRIOR:
  1784.         if ssCtrl in Shift then
  1785.           Row := TopRow
  1786.         else begin
  1787.           if TopRow > 0 then
  1788.           begin
  1789.             if TopRow > FRowCount then
  1790.             begin
  1791.               FCurrent.Y := FCurrent.Y - FRowCount + 1;
  1792.               TopRow := TopRow - FRowCount + 1;
  1793.             end
  1794.             else begin
  1795.               FCurrent.Y := FCurrent.Y - TopRow;
  1796.               TopRow := 0;
  1797.             end;
  1798.           end
  1799.           else
  1800.             Row := 0;
  1801.         end;
  1802.       VK_NEXT:
  1803.         if ssCtrl in Shift then
  1804.           Row := TopRow + FRowCount - 1
  1805.         else begin
  1806.           if TopRow < FLines.Count then
  1807.           begin
  1808.             FCurrent.Y := FCurrent.Y + FRowCount -1;
  1809.             TopRow := TopRow + FRowCount -1;
  1810.           end
  1811.           else
  1812.             Row := Row + FRowCount;
  1813.         end;
  1814.       VK_END:
  1815.         begin
  1816.           if ssCtrl in Shift then Row := FLines.Count - 1;
  1817.           GoEnd;
  1818.         end;
  1819.       VK_HOME:
  1820.         begin
  1821.           if ssCtrl in Shift then
  1822.           begin
  1823.             Col := 0;
  1824.             Row := 0;
  1825.           end
  1826.           else Col := 0;
  1827.         end;
  1828.       VK_BACK:
  1829.         Backspace;
  1830.       VK_DELETE:
  1831.         begin
  1832.           if ssShift in Shift then
  1833.           begin
  1834.             CutToClipboard;
  1835.             FMemoState := FMemoState - [msSelecting];
  1836.           end
  1837.           else
  1838.             DeleteChars;
  1839.         end;
  1840.       VK_INSERT:
  1841.         begin
  1842.           if Shift = [] then
  1843.             InsertMode := not InsertMode
  1844.           else
  1845.             if not FSelectedArea.Empty and (ssCtrl in Shift) then
  1846.               CopyToClipboard
  1847.             else
  1848.               if ssShift in Shift then PasteFromClipboard;
  1849.         end;
  1850.       VK_RETURN:
  1851.         begin
  1852.           if not FReadOnly then
  1853.           begin
  1854.             if not(eoPersistentBlocks in EditorOptions) then ClearSelection;
  1855.             AText := #13#10;
  1856.             if FInsertMode then
  1857.             begin
  1858.               if eoAutoIndentMode in EditorOptions then
  1859.               begin
  1860.                 i := GetIndentValue(Col, Row);
  1861.                 for j := 1 to i do AText := AText + ' ';
  1862.               end;
  1863.               InsertBlock(Col, Row, smLines, PChar(AText))
  1864.             end
  1865.             else
  1866.               if Row < FLines.Count-1 then
  1867.               begin
  1868.                 Row := Row + 1;
  1869.                 Col := GetIndentValue(Col, Row);
  1870.               end
  1871.               else begin
  1872.                 AText := #13#10;
  1873.                 InsertBlock(Col, Row, smLines, PChar(AText))
  1874.               end;
  1875.  
  1876.             TBlockUndo.Create(Self, FCurPos, MemoPos(FTopLeft, Col, Row, FSelectedArea.Rect),
  1877.               buInsert, AText, '', FSelectedArea.Mode, eoPersistentBlocks in EditorOptions, 0);
  1878.           end;
  1879.         end;
  1880.       VK_TAB:
  1881.         begin
  1882.           if not(ssShift in Shift) then
  1883.             TabRight
  1884.           else
  1885.             TabLeft
  1886.         end;
  1887.       VK_ESCAPE:
  1888.         begin
  1889.           GetKeyboardState(KeyState);
  1890.           if KeyState[VK_LBUTTON] and $80 <> 0 then
  1891.           begin
  1892.             FMemoState := FMemoState - [msSelecting, msMoving];
  1893.             with FSelectedArea do
  1894.             begin
  1895.               FUpdateArea.Add(StartPos, EndPos);
  1896.               Clear;
  1897.             end;
  1898.           end;
  1899.         end;
  1900.       $30..$39:
  1901.         begin
  1902.           if [ssCtrl,ssShift] * Shift =  [ssCtrl,ssShift] then
  1903.             ToggleBookmark(Key - $30)
  1904.           else
  1905.           if [ssCtrl,ssShift] * Shift =  [ssCtrl] then GotoBookmark(Key - $30);
  1906.         end;
  1907.       $43: {C}
  1908.         if not FSelectedArea.Empty and (ssCtrl in Shift) then CopyToClipboard;
  1909.       $56: {V}
  1910.         if ssCtrl in Shift then PasteFromClipboard;
  1911.       $58: {X}
  1912.         if ssCtrl in Shift then
  1913.         begin
  1914.           CutToClipboard;
  1915.           FMemoState := FMemoState - [msSelecting];
  1916.          end;
  1917.       $5A: {Z}
  1918.         begin
  1919.           if [ssCtrl,ssShift] * Shift = [ssCtrl,ssShift] then
  1920.             FUndoList.Redo
  1921.           else
  1922.             if [ssCtrl,ssShift] * Shift = [ssCtrl] then FUndoList.Undo;
  1923.         end;
  1924.  
  1925.     end;
  1926.   finally
  1927.     if MovingKey then
  1928.     begin
  1929.       if msSelecting in FMemoState then AddSelection(Point(Col, Row), Point(ACol, ARow));
  1930.       CreateCaretUndo;
  1931.     end;
  1932.     EndUpdate;
  1933.   end;
  1934. end;
  1935.  
  1936. function TDCCustomSyntaxMemo.CopyToClipboard: string;
  1937. begin
  1938.   Result := GetBlock(FSelectedArea.Rect, FSelectedArea.Mode, False);
  1939.   Clipboard.SetTextBuf(PChar(Result));
  1940. end;
  1941.  
  1942. function TDCCustomSyntaxMemo.CutToClipboard: string;
  1943. begin
  1944.   SaveCurPos;
  1945.   Result := CopyToClipboard;
  1946.   ClearSelection;
  1947.   TBlockUndo.Create(Self, FCurPos, MemoPos(FTopLeft, Col, Row, FSelectedArea.Rect), buDelete, '',
  1948.     Result, FSelectedArea.Mode, eoPersistentBlocks in EditorOptions, 0)
  1949. end;
  1950.  
  1951. procedure TDCCustomSyntaxMemo.DeselectArea;
  1952. begin
  1953.   FUpdateArea.Add(FSelectedArea.StartPos, FSelectedArea.EndPos);
  1954.   FSelectedArea.Clear;
  1955. end;
  1956.  
  1957. procedure TDCCustomSyntaxMemo.AddSelection(ANewPos, AOldPos: TPoint);
  1958.  
  1959.   procedure CheckPosBounds(var APos: TPoint);
  1960.   begin
  1961.     if APos.Y > FLines.Count - 1 then APos.Y := FLines.Count - 1;
  1962.     if APos.X > Length(FLines[APos.Y]) then APos.X := Length(FLines[APos.Y]);
  1963.   end;
  1964.  
  1965. begin
  1966.   if FSelectedArea.Mode = smLines then
  1967.   begin
  1968.     if FLines.Count = 0 then Exit;
  1969.     CheckPosBounds(ANewPos);
  1970.     CheckPosBounds(AOldPos);
  1971.   end;
  1972.   FUpdateArea.Add(FSelectedArea.StartPos, FSelectedArea.EndPos);
  1973.   FUpdateArea.Add(ANewPos, AOldPos);
  1974.   FSelectedArea.AddSelection(ANewPos, AOldPos);
  1975. end;
  1976.  
  1977. procedure TDCCustomSyntaxMemo.InsertChar(ACol, ARow: integer; ASymbol: Char);
  1978.  var
  1979.   i, BreakCount: integer;
  1980.   ABuf, ABuf1, ABuf2: string;
  1981. begin
  1982.   SaveCurPos;
  1983.   FLines.BeginUpdate;
  1984.  
  1985.   if ARow > FLines.Count then
  1986.     BreakCount := ARow - FLines.Count
  1987.   else
  1988.     BreakCount := 0;
  1989.  
  1990.   FLines.GrowTo(ARow + 1);
  1991.  
  1992.   ABuf := FLines[ARow];
  1993.  
  1994.   if (ACol > 0) and (ACol <= Length(ABuf)) then
  1995.   begin
  1996.     ABuf1 := Copy(ABuf, 1, ACol);
  1997.     ABuf2 := Copy(ABuf, ACol+1, Length(ABuf));
  1998.   end
  1999.   else begin
  2000.     if (ACol > Length(ABuf)) and (ACol > 0) then
  2001.     begin
  2002.       ABuf1 := ABuf;
  2003.       for i := Length(ABuf) to ACol - 1 do ABuf1 := ABuf1 + ' ';
  2004.       ABuf2 := '';
  2005.     end
  2006.     else begin
  2007.       ABuf1 := '';
  2008.       ABuf2 := ABuf;
  2009.     end;
  2010.   end;
  2011.  
  2012.   if not InsertMode then ABuf2 := Copy(ABuf2, 2, Length(ABuf2)-1);
  2013.   FLines[ARow] := ABuf1 + ASymbol + ABuf2;
  2014.  
  2015.   Col := Length(ABuf1)+1;
  2016.   Row := ARow;
  2017.  
  2018.   FLines.EndUpdate;
  2019.   if not FUndoList.FUpdated then
  2020.     TCharUndo.Create(Self, FCurPos, MemoPos(FTopLeft, Col, Row, FSelectedArea.Rect),
  2021.       ASymbol, BreakCount);
  2022. end;
  2023.  
  2024. procedure TDCCustomSyntaxMemo.SetInsertMode(const Value: boolean);
  2025. begin
  2026.   FInsertMode := Value;
  2027.   if Assigned(FOnSetInsertMode) then FOnSetInsertMode(Self);
  2028. end;
  2029.  
  2030. procedure TDCCustomSyntaxMemo.SetTabSize(const Value: integer);
  2031. begin
  2032.   FTabSize := Value;
  2033. end;
  2034.  
  2035. procedure TDCCustomSyntaxMemo.Backspace;
  2036.  var
  2037.   AText, DeletedText: string;
  2038.   LineData: PLineDataItem;
  2039.   ARow, ACol: integer;
  2040. begin
  2041.    DeletedText := '';
  2042.    if Row < FLines.Count
  2043.    then begin
  2044.       LineData := FLines.LineInfo[Row];
  2045.       if (eoBackspaceUnindents in EditorOptions) and ((LineData.Count = 0) or
  2046.          (LineData.Count = 1) and (LineData.Lexems[0].Item = lxWhitespace)) then
  2047.       begin
  2048.         if (Row > 0) and (Col > 0)then
  2049.         begin
  2050.           ARow := Row - 1;
  2051.           ACol := -1;
  2052.           while (ACol = -1) and (ARow >= 0) do
  2053.           begin
  2054.             LineData := FLines.LineInfo[ARow];
  2055.             if (LineData.Count = 0) then
  2056.               ACol := -1
  2057.             else begin
  2058.               if (LineData.Lexems[0].Item = lxWhitespace) and (LineData.Lexems[0].Length < Col) then
  2059.                 ACol := LineData.Lexems[0].Length;
  2060.               if (ACol = -1) and (LineData.Lexems[0].Item <> lxWhitespace) then
  2061.                 ACol := 0;
  2062.             end;
  2063.             Dec(ARow);
  2064.           end;
  2065.           if ACol = -1 then Col := 0 else Col := ACol;
  2066.         end
  2067.         else
  2068.           if Col > 0 then
  2069.             Col := 0
  2070.           else begin
  2071.             SaveCurPos;
  2072.             FLines.BeginUpdate;
  2073.             if (Col = 0) and (Row > 0) then
  2074.             begin
  2075.               Row := Row - 1;
  2076.               GoEnd;
  2077.               FLines[Row] := FLines[Row] + FLines[Row + 1];
  2078.               FLines.Delete(Row+1);
  2079.               DeletedText := #13#10;
  2080.             end;
  2081.             FLines.EndUpdate;
  2082.             TDeleteUndo.Create(Self, FCurPos, MemoPos(FTopLeft, Col, Row, FSelectedArea.Rect), DeletedText, duBackspace);
  2083.           end;
  2084.       end
  2085.       else begin
  2086.         SaveCurPos;
  2087.         FLines.BeginUpdate;
  2088.         if (Col = 0) and (Row > 0) then
  2089.         begin
  2090.            Row := Row - 1;
  2091.            GoEnd;
  2092.            FLines[Row] := FLines[Row] + FLines[Row + 1];
  2093.            FLines.Delete(Row+1);
  2094.            DeletedText := #13#10;
  2095.         end
  2096.         else
  2097.           if Col > 0 then
  2098.           begin
  2099.             if Col <= Length(FLines[Row]) then
  2100.             begin
  2101.               AText := FLines[Row];
  2102.               DeletedText := Copy(AText, Col, 1);
  2103.               Delete(AText, Col, 1);
  2104.               FLines[Row] := AText;
  2105.             end;
  2106.             Col := Col - 1;
  2107.           end;
  2108.         FLines.EndUpdate;
  2109.         TDeleteUndo.Create(Self, FCurPos, MemoPos(FTopLeft, Col, Row, FSelectedArea.Rect), DeletedText, duBackspace);
  2110.       end;
  2111.    end
  2112.    else begin
  2113.      if Col = 0 then
  2114.      begin
  2115.        Row := Row - 1;
  2116.        GoEnd;
  2117.      end
  2118.      else
  2119.        Col := Col - 1;
  2120.    end;
  2121. end;
  2122.  
  2123. procedure TDCCustomSyntaxMemo.GoEnd;
  2124. begin
  2125.   if (Row < FLines.Count) and (Row >= 0) then
  2126.     Col := Length(FLines[Row])
  2127.   else
  2128.     Col := 0
  2129. end;
  2130.  
  2131. procedure TDCCustomSyntaxMemo.TabLeft;
  2132. begin
  2133.   FCurrent.X := (Col div FTabSize - 1) * FTabSize;
  2134.   if FCurrent.X < 0 then FCurrent.X := 0;
  2135. end;
  2136.  
  2137. procedure TDCCustomSyntaxMemo.TabRight;
  2138.  var
  2139.   ARow, ACol, i: integer;
  2140.   AText: string;
  2141.  
  2142.   function NextWord(iCol, iRow: integer): integer;
  2143.   var
  2144.     pSource, pValue: PChar;
  2145.   begin
  2146.     pSource := PChar(FLines[iRow]);
  2147.  
  2148.     if integer(StrLen(pSource)) > iCol then
  2149.     begin
  2150.       pValue  := pSource + iCol;
  2151. {
  2152.       while (pValue^ <> #0) and not FSyntaxData.IsDelimiter(pValue^) do Inc(pValue);
  2153.       while (pValue^ <> #0) and FSyntaxData.IsDelimiter(pValue^) do Inc(pValue);
  2154. }
  2155.       while (pValue^ <> #0) and not(pValue^ = #32) do Inc(pValue);
  2156.       while (pValue^ <> #0) and (pValue^ = #32) do Inc(pValue);
  2157.       
  2158.       Result := pValue - pSource;
  2159.     end
  2160.     else begin
  2161.       if iCol < Integer(StrLen(pSource)) then
  2162.         Result := StrLen(pSource)
  2163.       else
  2164.         Result := iCol;
  2165.     end;    
  2166.   end;
  2167.  
  2168. begin
  2169.   if FInsertMode and not FReadOnly and (eoSmartTab in EditorOptions) then
  2170.   begin
  2171.     if Row > 0 then
  2172.     begin
  2173.       ARow := Row;
  2174.       ACol := Col;
  2175.       while (ACol <= Col) and (ARow > 0) do
  2176.       begin
  2177.         ACol := NextWord(ACol, ARow-1);
  2178.         Dec(ARow);
  2179.       end;
  2180.       if ACol > Col then
  2181.       begin
  2182.         SaveCurPos;
  2183.         AText :=  '';
  2184.         for i := Col to ACol-1 do AText := AText + ' ';
  2185.         InsertBlock(Col, Row, smLines, PChar(AText));
  2186.         TBlockUndo.Create(Self, FCurPos, MemoPos(FTopLeft, Col, Row, FSelectedArea.Rect),
  2187.           buInsert, AText, '', FSelectedArea.Mode, eoPersistentBlocks in EditorOptions, 0);
  2188.       end;
  2189.     end;
  2190.   end
  2191.   else begin
  2192.     FCurrent.X := (Col div FTabSize + 1) * FTabSize;
  2193.   end;
  2194. end;
  2195.  
  2196. procedure TDCCustomSyntaxMemo.WordLeft;
  2197.  var
  2198.   pSource, pValue: PChar;
  2199. begin
  2200.   if Row > FLines.Count - 1 then Exit;
  2201.  
  2202.   pSource := PChar(FLines[Row]);
  2203.   pValue  := pSource + Col;
  2204.  
  2205.   if pValue > StrEnd(pSource) then pValue:= StrEnd(pSource);
  2206.  
  2207.   Dec(pValue);
  2208.   while (pValue >= pSource) and FSyntaxData.IsDelimiter(pValue^) do Dec(pValue);
  2209.  
  2210.   if (pValue < pSource) then
  2211.   begin
  2212.     if Row > 0 then
  2213.     begin
  2214.       Row := Row - 1;
  2215.       GoEnd;
  2216.     end
  2217.   end
  2218.   else begin
  2219.     while (pValue >= pSource) and not FSyntaxData.IsDelimiter(pValue^) do Dec(pValue);
  2220.     Col := pValue - pSource + 1;
  2221.   end;
  2222. end;
  2223.  
  2224. procedure TDCCustomSyntaxMemo.WordRight;
  2225.  var
  2226.   pSource, pValue: PChar;
  2227. begin
  2228.   if Row > FLines.Count - 1 then Exit;
  2229.  
  2230.   pSource := PChar(FLines[Row]);
  2231.   pValue  := pSource + Col;
  2232.  
  2233.   if pValue > StrEnd(pSource) then pValue:= StrEnd(pSource);
  2234.  
  2235.   while (pValue^ <> #0) and not FSyntaxData.IsDelimiter(pValue^) do Inc(pValue);
  2236.   while (pValue^ <> #0) and FSyntaxData.IsDelimiter(pValue^) do Inc(pValue);
  2237.  
  2238.   if (pValue^ = #0) then
  2239.   begin
  2240.     if Col < pValue - pSource then
  2241.       GoEnd
  2242.     else
  2243.       if Row < FLines.Count - 1 then
  2244.       begin
  2245.         Row := Row + 1;
  2246.         Col := 0;
  2247.         pSource := PChar(FLines[Row]);
  2248.         if FSyntaxData.IsDelimiter(pSource^) then WordRight;
  2249.       end;
  2250.   end
  2251.   else
  2252.    Col := pValue - pSource;
  2253. end;
  2254.  
  2255. procedure TDCCustomSyntaxMemo.MoveTopLeft(ALeft, ATop: integer);
  2256.  var
  2257.   OffsX, OffsY: integer;
  2258.   R: TRect;
  2259.   ALeftCol, ATopRow: integer;
  2260. begin
  2261.   if (FTopLeft.X <> ALeft) or (FTopLeft.Y <> ATop) then
  2262.   begin
  2263.     BeginUpdate;
  2264.     try
  2265.       if Col < ALeft  then FCurrent.X := ALeft;
  2266.  
  2267.       if ALeft < 0 then ALeft := 0;
  2268.       if Col > ALeft + FColCount then FCurrent.X := ALeft + FColCount;
  2269.  
  2270.       if ATop > FLines.Count - 1 then ATop := FLines.Count -1;
  2271.  
  2272.       if ATop < 0 then ATop := 0;
  2273.       if Row > ATop + FRowCount then FCurrent.Y := ATop + FRowCount;
  2274.  
  2275.       OffsX := FTopLeft.X - ALeft;
  2276.       OffsY := FTopLeft.Y - ATop;
  2277.  
  2278.       FTopLeft.X := ALeft;
  2279.       FTopLeft.Y := ATop;
  2280.  
  2281.       R := Rect(0, 0, ClientWidth, ClientHeight);
  2282.  
  2283.       ALeftCol := LeftCol + FColCount + FHalf.X;
  2284.       ATopRow  := TopRow + FRowCount + FHalf.Y;
  2285.       if OffsX <> 0 then
  2286.       begin
  2287.         if Abs(OffsX) < FColCount shr 2 then
  2288.           //ScrollWindow(Handle, OffsX * FColWidth, 0, @R, @R)
  2289.         else
  2290.           OffsX := FColCount;
  2291.  
  2292.         if OffsX > 0 then
  2293.           FUpdateArea.Add(Point(LeftCol, TopRow), Point(LeftCol + OffsX, ATopRow))
  2294.         else
  2295.           if OffsX < 0 then
  2296.             FUpdateArea.Add(Point(ALeftCol  + OffsX, TopRow), Point(ALeftCol, ATopRow))
  2297.           else
  2298.             FUpdateArea.Add(Point(LeftCol, TopRow),  Point(ALeftCol, ATopRow));
  2299.       end;
  2300.  
  2301.       if OffsY <> 0 then
  2302.       begin
  2303.         if Abs(OffsY) < FRowCount shr 2 then
  2304.           ScrollWindow(Handle, 0, OffsY * FRowHeight, @R, @R)
  2305.         else
  2306.           OffsY := FRowCount;
  2307.  
  2308.         if OffsY > 0 then
  2309.           FUpdateArea.Add(Point(LeftCol, TopRow), Point(ALeftCol, TopRow + OffsY))
  2310.         else
  2311.           if OffsY < 0 then
  2312.             FUpdateArea.Add(Point(LeftCol, ATopRow), Point(ALeftCol, ATopRow + OffsY))
  2313.           else
  2314.             FUpdateArea.Add(Point(LeftCol, TopRow), Point(ALeftCol, ATopRow));
  2315.       end;
  2316.  
  2317.       if FCurrent.X < FTopLeft.X then FCurrent.X := FTopLeft.X;
  2318.       if FCurrent.Y < FTopLeft.Y then FCurrent.Y := FTopLeft.Y;
  2319.       if FCurrent.X > FTopLeft.X + FColCount - 1 then FCurrent.X := FTopLeft.X + FColCount - 1;
  2320.  
  2321.       if not(eoCursorBeyondEOF in EditorOptions) then
  2322.         if FCurrent.Y > FLines.Count - 1 then FCurrent.Y := FLines.Count - 1 else
  2323.       else
  2324.         if FCurrent.Y > FTopLeft.Y + FRowCount - 1 then FCurrent.Y := FTopLeft.Y + FRowCount - 1;
  2325.  
  2326.       FHScroll.FPosition := FTopLeft.X;
  2327.       FVScroll.FPosition := FTopLeft.Y;
  2328.     finally
  2329.       EndUpdate;
  2330.       UpdateScrollBars;
  2331.     end;
  2332.   end;
  2333. end;
  2334.  
  2335. procedure TDCCustomSyntaxMemo.SetLeftCol(const Value: integer);
  2336. begin
  2337.   if LeftCol <> Value then MoveTopLeft(Value, TopRow);
  2338. end;
  2339.  
  2340. procedure TDCCustomSyntaxMemo.SetTopRow(const Value: integer);
  2341. begin
  2342.   if TopRow <> Value then MoveTopLeft(LeftCol, Value);
  2343. end;
  2344.  
  2345. function TDCCustomSyntaxMemo.GetIndentValue(ACol, ARow: integer): integer;
  2346.  var
  2347.   pString, pValue: PChar;
  2348. begin
  2349.   Result := 0;
  2350.   if ARow > FLines.Count-1 then Exit;
  2351.  
  2352.   pString := PChar(FLines[ARow]);
  2353.   pValue := pString;
  2354.   while (pValue^ = #32) and (pValue^ <> #0) do Inc(pValue);
  2355.  
  2356.   Result := pValue - pString;
  2357.   if Result > ACol  then  Result := ACol
  2358. end;
  2359.  
  2360. procedure TDCCustomSyntaxMemo.UpdateSyntaxData;
  2361.  var
  2362.   AText: string;
  2363. begin
  2364.   AText := FLines.Text;
  2365.   FLines.BeginUpdate;
  2366.   FLines.Clear;
  2367.   FLines.Text := AText;
  2368.   FLines.EndUpdate;
  2369. end;
  2370.  
  2371. procedure TDCCustomSyntaxMemo.SetDataClass(Value: TSyntaxDataClass);
  2372.  var
  2373.   AText: string;
  2374. begin
  2375.   if Value <> FSyntaxDataClass then
  2376.   begin
  2377.     AText := FLines.Text;
  2378.     FLines.BeginUpdate;
  2379.     FLines.Clear;
  2380.  
  2381.     FSyntaxData.Free;
  2382.     FSyntaxData := Value.Create;
  2383.  
  2384.     FLines.Text := AText;
  2385.     FLines.EndUpdate;
  2386.   end;
  2387. end;
  2388.  
  2389. procedure TDCCustomSyntaxMemo.WMMouseMove(var Message: TWMMouseMove);
  2390. begin
  2391.   if not FMouseMoving and (msSelecting in FMemoState) then
  2392.   begin
  2393.     with FSelectedArea do
  2394.     begin
  2395.       if not((StartPos.X = Col) and (StartPos.Y = Row) or
  2396.              (EndPos.X = Col) and (EndPos.Y = Row)) then
  2397.       begin
  2398.         FUpdateArea.Add(StartPos, EndPos);
  2399.         Clear;
  2400.       end;
  2401.     end;
  2402.   end;
  2403.   if not FMouseMoving and (msMoving in FMemoState) then
  2404.   begin
  2405.     SetMovingParam;
  2406.   end;
  2407.   FMouseMoving := True;
  2408.   with Message, FGutterState do
  2409.   begin
  2410.     if (HitTest = HTGUTTER) and MLDown then
  2411.     begin
  2412.       if MDPos.Y <> YPos then
  2413.       begin
  2414.         if MDPos.X <> -1 then
  2415.         begin
  2416.           MDPos.X := -1;
  2417.           DeselectArea;
  2418.         end;
  2419.         MouseSelection(FGutterWidth, YPos);
  2420.       end;
  2421.     end
  2422.     else
  2423.       if MK_LBUTTON and Keys = MK_LBUTTON then MouseSelection(XPos, YPos);
  2424.   end;
  2425.   inherited;
  2426. end;
  2427.  
  2428. procedure TDCCustomSyntaxMemo.WMLButtonDown(var Message: TWMLButtonDown);
  2429.  var
  2430.   MemoCoord: TDCMemoCoord;
  2431.   ShiftState: TShiftState;
  2432. begin
  2433.   FMouseMoving := False;
  2434.   with Message do
  2435.   begin
  2436.     MemoCoord  := GetMemoCoord(XPos, YPos);
  2437.     ShiftState := KeysToShiftState(Keys);
  2438.  
  2439.     if FGutterState.HitTest = HTSELECTED then
  2440.       FMemoState := FMemoState + [msMoving]
  2441.     else
  2442.       FMemoState := FMemoState + [msSelecting];
  2443.  
  2444.     if (ssShift in ShiftState)  then
  2445.     begin
  2446.       MouseSelection(XPos, YPos);
  2447.     end
  2448.     else begin
  2449.       if not(eoPersistentBlocks in EditorOptions) and not(msMoving in FMemoState) then DeselectArea;
  2450.       if (MemoCoord.X <> Col) or (MemoCoord.Y <> Row)  then
  2451.       begin
  2452.         SaveCurPos;
  2453.         BeginUpdate;
  2454.         FCurrent := MemoCoord;
  2455.         EndUpdate;
  2456.         CreateCaretUndo;
  2457.       end;
  2458.     end;
  2459.     PaintText;
  2460.   end;
  2461.   inherited;
  2462. end;
  2463.  
  2464. procedure TDCCustomSyntaxMemo.WMLButtonUp(var Message: TWMLButtonUp);
  2465.  var
  2466.   GutterAreaDown: boolean;
  2467. begin
  2468.   StopScrollTimer;
  2469.  
  2470.   if msMoving in FMemoState then
  2471.   begin
  2472.     FMemoState := FMemoState - [msMoving];
  2473.     SetMovingParam;
  2474.   end;
  2475.   FMemoState := FMemoState - [msSelecting];
  2476.  
  2477.   GutterAreaDown := (FGutterState.HitTest = HTGUTTER) and FGutterState.MLDown;
  2478.  
  2479.   if not FMouseMoving {and (eoPersistentBlocks in EditorOptions)} and
  2480.      not GutterAreaDown then
  2481.   begin
  2482.     DeselectArea;
  2483.   end;
  2484.   with Message do
  2485.   begin
  2486.     if GutterAreaDown then
  2487.     begin
  2488.       FGutterState.MUPos  := Point(XPos, YPos);
  2489.       if FGutterState.MDPos.X > -1  then
  2490.       begin
  2491.         DoGutterClick(FGutterState.MDPos, FGutterState.MUPos);
  2492.       end;
  2493.     end;
  2494.     FGutterState.MLDown := False;
  2495.   end;
  2496.   FMouseMoving := False;
  2497.   PaintText;
  2498.   inherited;
  2499. end;
  2500.  
  2501. procedure TDCCustomSyntaxMemo.KeyUp(var Key: Word; Shift: TShiftState);
  2502. begin
  2503.   inherited;
  2504.   if not(ssShift in Shift) then FMemoState := FMemoState - [msSelecting];
  2505. end;
  2506.  
  2507. procedure TDCCustomSyntaxMemo.SetLines(const Value: TDCMemoStrings);
  2508. begin
  2509.   FLines.Assign(Value);
  2510. end;
  2511.  
  2512. procedure TDCCustomSyntaxMemo.DoChangeText;
  2513. begin
  2514.   if (FLines.FUpdating  = False) and Assigned(FOnChange) then FOnChange(Self);
  2515. end;
  2516.  
  2517. procedure TDCCustomSyntaxMemo.WMTimer(var Message: TWMTimer);
  2518.  var
  2519.   ACol, ARow: integer;
  2520. begin
  2521.   inherited;
  2522.   if Message.TimerID = MEMOSCROLL_IDEVENT then
  2523.   begin
  2524.     ACol := Col;
  2525.     ARow := Row;
  2526.     if FScrollInc.Y < 0 then
  2527.       ARow := Row;
  2528.     if (ARow + FScrollInc.Y) < FLines.Count then
  2529.       Row := ARow + FScrollInc.Y
  2530.     else
  2531.       Row := FLines.Count - 1;
  2532.     Col := ACol + FScrollInc.X;
  2533.     if msSelecting in FMemoState then
  2534.       AddSelection(Point(Col, Row), Point(ACol, ARow));
  2535.     PaintText;
  2536.   end;
  2537. end;
  2538.  
  2539. procedure TDCCustomSyntaxMemo.StartScrollTimer;
  2540. begin
  2541.   FScrollTimerHandle := SetTimer(Handle, MEMOSCROLL_IDEVENT, 100, nil);
  2542. end;
  2543.  
  2544. procedure TDCCustomSyntaxMemo.StopScrollTimer;
  2545. begin
  2546.   if FScrollTimerHandle <> 0 then
  2547.   begin
  2548.     KillTimer(Handle, FScrollTimerHandle);
  2549.     FScrollTimerHandle := 0;
  2550.     FScrollInc := Point(0, 0);
  2551.   end;
  2552. end;
  2553.  
  2554. procedure TDCCustomSyntaxMemo.SetReadOnly(const Value: boolean);
  2555. begin
  2556.   FReadOnly := Value;
  2557. end;
  2558.  
  2559. procedure TDCCustomSyntaxMemo.AdjustClientRect(var Rect: TRect);
  2560. begin
  2561.   inherited AdjustClientRect(Rect);
  2562.   with Rect do
  2563.   begin
  2564.     Bottom := Bottom - 15;
  2565.     Right  := Right  - 15;
  2566.   end;
  2567. end;
  2568.  
  2569. procedure TDCCustomSyntaxMemo.CreateParams(var Params: TCreateParams);
  2570. begin
  2571.   inherited CreateParams(Params);
  2572.   with Params do
  2573.   begin
  2574.     Style := Style or WS_HSCROLL or WS_VSCROLL;
  2575.   end;
  2576. end;
  2577.  
  2578. procedure TDCCustomSyntaxMemo.UpdateScrollBars;
  2579. begin
  2580.   if HandleAllocated then
  2581.   begin
  2582.     if FUpdateVScroll then FVScroll.Update;
  2583.     FHScroll.Update;
  2584.   end;
  2585. end;
  2586.  
  2587. procedure TDCCustomSyntaxMemo.WMHScroll(var Message: TWMHScroll);
  2588. begin
  2589.   FHScroll.ScrollMessage(Message);
  2590. end;
  2591.  
  2592. procedure TDCCustomSyntaxMemo.WMVScroll(var Message: TWMVScroll);
  2593. begin
  2594.   FVScroll.ScrollMessage(Message);
  2595. end;
  2596.  
  2597. procedure TDCCustomSyntaxMemo.DoScroll(X, Y: integer);
  2598.  var
  2599.   ACurrent: TDCMemoCoord;
  2600.   ATopRow: integer;
  2601. begin
  2602.   BeginUpdate;
  2603.   ACurrent := FCurrent;
  2604.   ATopRow  := TopRow;
  2605.   MoveTopLeft(LeftCol - X, TopRow - Y);
  2606.   FCurrent := ACurrent;
  2607.   EndUpdate(ATopRow = TopRow);
  2608. end;
  2609.  
  2610. function TDCCustomSyntaxMemo.DoMouseWheel(Shift: TShiftState;
  2611.   WheelDelta: Integer; MousePos: TPoint): Boolean;
  2612.  var
  2613.   ACurrent: TDCMemoCoord;
  2614.   ADelta: integer;
  2615. begin
  2616.   Result := inherited DoMouseWheel(Shift, WheelDelta, MousePos);
  2617.   if not Result then
  2618.   begin
  2619.     BeginUpdate;
  2620.     ADelta := WheelDelta div WHEEL_DELTA;
  2621.     if ssCtrl in Shift then
  2622.     begin
  2623.       ACurrent := FCurrent;
  2624.       TopRow := TopRow - ADelta * FRowCount;
  2625.       FCurrent := ACurrent;
  2626.       Result := True;
  2627.     end
  2628.     else
  2629.       if ssShift in Shift then
  2630.       begin
  2631.         Row := Row - ADelta;
  2632.         Result := True;
  2633.       end
  2634.       else begin
  2635.         ACurrent := FCurrent;
  2636.         TopRow := TopRow - ADelta;
  2637.         FCurrent := ACurrent;
  2638.       end;
  2639.     EndUpdate;
  2640.   end;
  2641. end;
  2642.  
  2643. procedure TDCCustomSyntaxMemo.DrawRightMargin(ARow: integer);
  2644.  var
  2645.   ABegPoint, AEndPoint: TPoint;
  2646. begin
  2647.   with Canvas do
  2648.   begin
  2649.     Pen.Color := clBtnFace;
  2650.     ABegPoint := GetCursorPos(FRightMargin, ARow);
  2651.     AEndPoint := GetCursorPos(FRightMargin, ARow+1);
  2652.     MoveTo(ABegPoint.X, ABegPoint.Y);
  2653.     LineTo(AEndPoint.X, AEndPoint.Y);
  2654.   end;
  2655. end;
  2656.  
  2657. procedure TDCCustomSyntaxMemo.DrawGutter(ARow: integer);
  2658.  var
  2659.   ARect: TRect;
  2660.   ABegPoint, AEndPoint: TPoint;
  2661.   i: integer;
  2662. begin
  2663.   with Canvas do
  2664.   begin
  2665.     ABegPoint := GetCursorPos(0, ARow);
  2666.     AEndPoint := GetCursorPos(0, ARow+1);
  2667.     ARect := Rect(0, ABegPoint.Y, FGutterWidth - 4, AEndPoint.Y);
  2668.     Brush.Color := clBtnFace;
  2669.     FillRect(ARect);
  2670.  
  2671.     MoveTo(FGutterWidth - 4, ABegPoint.Y);
  2672.     Pen.Color := clWhite;
  2673.     LineTo(FGutterWidth - 4, AEndPoint.Y);
  2674.  
  2675.     MoveTo(FGutterWidth - 3, ABegPoint.Y);
  2676.     Pen.Color := clBtnShadow;
  2677.     LineTo(FGutterWidth - 3, AEndPoint.Y);
  2678.  
  2679.     Brush.Color := clWhite;
  2680.     ARect := Rect(FGutterWidth - 2, ABegPoint.Y, FGutterWidth, AEndPoint.Y);
  2681.     FillRect(ARect);
  2682.  
  2683.   end;
  2684.  
  2685.   for i := Low(TBookmarkNum) to High(TBookmarkNum) do
  2686.   begin
  2687.     if (FBookMarks[i].Toggle) and (FBookMarks[i].Row = ARow) then
  2688.     begin
  2689.       DrawGutterState(ngsBookMark_0 + i, ARow, 1);
  2690.       Exit;
  2691.     end;
  2692.   end;
  2693. end;
  2694.  
  2695. procedure TDCCustomSyntaxMemo.DrawGutterState(AState, ARow,
  2696.   AIndexPos: integer);
  2697.  var
  2698.   APoint: TPoint;
  2699. begin                               
  2700.   APoint   := GetCursorPos(0, ARow);
  2701.   APoint.X := 2 + AIndexPos * FIndicators.Width;
  2702.   if APoint.X + FIndicators.Width < FGutterWidth then
  2703.     FIndicators.Draw(Canvas, APoint.X, APoint.Y, AState);
  2704. end;
  2705.  
  2706. procedure TDCCustomSyntaxMemo.SetRowColor(ARow: integer; var BGColor,
  2707.   FGColor: TColor);
  2708. begin
  2709.   {}
  2710. end;
  2711.  
  2712. procedure TDCCustomSyntaxMemo.InvalidateGutter;
  2713.  var
  2714.   i: integer;
  2715. begin
  2716.   if FVisibleGutter then
  2717.   begin
  2718.     HideCaret(Handle);
  2719.     i := TopRow;
  2720.     while i < TopRow + FRowCount do
  2721.     begin
  2722.       DrawGutter(i);
  2723.       inc(i);
  2724.     end;
  2725.     RedrawCaret;
  2726.   end;
  2727. end;
  2728.  
  2729. procedure TDCCustomSyntaxMemo.GotoBookmark(ABookmark: TBookmarkNum);
  2730. begin
  2731.   with FBookmarks[ABookmark] do
  2732.   begin
  2733.     if Toggle then
  2734.     begin
  2735.       if (Col < LeftCol) or (Col > (LeftCol + FColCount)) or
  2736.          (Row < TopRow) or (Row > (TopRow + FRowCount)) then
  2737.         MoveTopLeft(TopLeft.X, TopLeft.Y);
  2738.       Self.Row := Row;
  2739.       Self.Col := Col;
  2740.     end;
  2741.   end;
  2742. end;
  2743.  
  2744. procedure TDCCustomSyntaxMemo.ToggleBookmark(ABookmark: TBookmarkNum);
  2745. begin
  2746.   if Row < FLines.Count then
  2747.   begin
  2748.     with FBookmarks[ABookmark] do
  2749.     begin
  2750.       if not Toggle then
  2751.         Toggle := True
  2752.       else
  2753.         Toggle := not(Row = FCurrent.Y);
  2754.       if Toggle then
  2755.       begin
  2756.         BeginUpdate;
  2757.         TopLeft := FTopLeft;
  2758.         Col     := FCurrent.X;
  2759.         Row     := FCurrent.Y;
  2760.         EndUpdate;
  2761.       end;
  2762.     end;
  2763.     InvalidateGutter;
  2764.   end;
  2765. end;
  2766.  
  2767. procedure TDCCustomSyntaxMemo.UpdateGutter(AMode, ARow, ACount: integer);
  2768.  var
  2769.   i, j: integer;
  2770. begin
  2771.   for i := Low(TBookmarkNum) to High(TBookmarkNum) do
  2772.     if FBookMarks[i].Toggle then
  2773.       case AMode of
  2774.         CM_ROW_DELETED:
  2775.           begin
  2776.             j := FBookMarks[i].Row;
  2777.             if FBookMarks[i].Row > ARow then
  2778.             begin
  2779.               if FBookMarks[i].Row > (ARow + ACount) then
  2780.                 FBookMarks[i].Row := FBookMarks[i].Row - ACount
  2781.               else
  2782.                 FBookMarks[i].Row := ARow;
  2783.               DrawGutter(j);
  2784.             end
  2785.             else if (FBookMarks[i].Row = ARow) and (ARow = FLines.Count) then
  2786.             begin
  2787.               FBookMarks[i].Row := FLines.Count - 1;
  2788.               DrawGutter(j);
  2789.             end;
  2790.           end;
  2791.         CM_ROW_INSERTED:
  2792.           begin
  2793.             j := FBookMarks[i].Row;
  2794.             if ((FBookMarks[i].Row = ARow-1) and (Col = 0)) or
  2795.                (FBookMarks[i].Row > ARow-1) then
  2796.             begin
  2797.               FBookMarks[i].Row := FBookMarks[i].Row + ACount;
  2798.               DrawGutter(j);
  2799.             end;
  2800.           end;
  2801.       end;
  2802. end;
  2803.  
  2804.  
  2805. procedure TDCCustomSyntaxMemo.BeginUpdate;
  2806. begin
  2807.   Inc(FUpdateCount);
  2808.   LockPaint;
  2809. end;
  2810.  
  2811. procedure TDCCustomSyntaxMemo.EndUpdate(AScroll: boolean = False);
  2812. begin
  2813.   Dec(FUpdateCount);
  2814.   if UnlockPaint then PaintText(AScroll);
  2815.   if FUpdateCount = 0 then
  2816.   begin
  2817.     ColRowChanged(Col, Row);
  2818.   end;
  2819. end;
  2820.  
  2821. procedure TDCCustomSyntaxMemo.ColRowChanged(ACol, ARow: integer);
  2822. begin
  2823.   if Assigned(FOnColRowChanged) then FOnColRowChanged(Self, ACol, ARow);
  2824. end;
  2825.  
  2826. function TDCCustomSyntaxMemo.GetBookmarkState(Index: TBookmarkNum): boolean;
  2827. begin
  2828.   Result := FBookmarks[Index].Toggle;
  2829. end;
  2830.  
  2831.  
  2832. procedure TDCCustomSyntaxMemo.CreateCaretUndo;
  2833. begin
  2834.   if ((FCurPos.Col <> Col) or (FCurPos.Row <> Row)) and
  2835.      not FUndoList.FUpdated then
  2836.     TCaretUndo.Create(Self, FCurPos, MemoPos(FTopLeft, Col, Row, FSelectedArea.Rect));
  2837. end;
  2838.  
  2839. procedure TDCCustomSyntaxMemo.SaveCurPos;
  2840. begin
  2841.   FCurPos := MemoPos(FTopLeft, Col, Row, FSelectedArea.Rect)
  2842. end;
  2843.  
  2844. procedure TDCCustomSyntaxMemo.DeleteChars;
  2845.  var
  2846.   ARect: TRect;
  2847.   DeletedText: string;
  2848. begin
  2849.   SaveCurPos;
  2850.   if (eoPersistentBlocks in EditorOptions) or FSelectedArea.Empty then
  2851.   begin
  2852.     ARect := Rect(Col, Row, Col+1, Row);
  2853.     DeletedText := GetBlock(ARect, smLines);
  2854.     DeleteBlock(ARect, smLines);
  2855.     TDeleteUndo.Create(Self, FCurPos, MemoPos(FTopLeft, Col, Row, FSelectedArea.Rect),
  2856.       DeletedText, duDelete);
  2857.   end
  2858.   else begin
  2859.     DeletedText := GetBlock(FSelectedArea.Rect, FSelectedArea.Mode);
  2860.     ClearSelection;
  2861.     TBlockUndo.Create(Self, FCurPos, MemoPos(FTopLeft, Col, Row, FSelectedArea.Rect),
  2862.       buDelete, '',  DeletedText, FSelectedArea.Mode, eoPersistentBlocks in EditorOptions, 0)
  2863.   end;
  2864. end;
  2865.  
  2866. procedure TDCCustomSyntaxMemo.SelectRect(ARect: TRect);
  2867. begin
  2868.   FUpdateArea.Add(FSelectedArea.StartPos, FSelectedArea.EndPos);
  2869.  
  2870.   FSelectedArea.Clear;
  2871.   FSelectedArea.Add(ARect.TopLeft, ARect.BottomRight);
  2872.  
  2873.   FUpdateArea.Add(ARect.TopLeft, ARect.BottomRight);
  2874.   PaintText;
  2875. end;
  2876.  
  2877. procedure TDCCustomSyntaxMemo.InvalidateRect(ARect: TRect);
  2878. begin
  2879.   with FUpdateArea do
  2880.   begin
  2881.     Clear;
  2882.     Add(ARect.TopLeft, ARect.BottomRight);
  2883.     PaintText;
  2884.   end;
  2885. end;
  2886.  
  2887. procedure TDCCustomSyntaxMemo.WMNCLButtonDown(var Message: TWMLButtonDown);
  2888.  var
  2889.   APoint: TPoint;
  2890.   KeyState: TKeyboardState;
  2891.   WParam: Word;
  2892. begin
  2893.   inherited;
  2894.   with Message do
  2895.   begin
  2896.     if (FGutterState.HitTest = HTGUTTER)  then
  2897.     begin
  2898.       APoint := ScreenToClient(Point(XPos, YPos));
  2899.       FGutterState.MLDown := True;
  2900.       FGutterState.MDPos  := APoint;
  2901.       GetKeyboardState(KeyState);
  2902.  
  2903.       WParam := MK_LBUTTON;
  2904.       if KeyState[VK_SHIFT]   and $80 <> 0 then WParam := WParam or MK_SHIFT;
  2905.       if KeyState[VK_CONTROL] and $80 <> 0 then WParam := WParam or MK_CONTROL;
  2906.  
  2907.       Perform(WM_LBUTTONDOWN, WParam, MakeLParam(FGutterWidth, APoint.Y));
  2908.     end
  2909.     else
  2910.       FGutterState.MLDown := False;
  2911.   end;
  2912. end;
  2913.  
  2914. procedure TDCCustomSyntaxMemo.CMCancelMode(var Message: TCMCancelMode);
  2915. begin
  2916.   if Message.Sender <> Self then FGutterState.MLDown := False;
  2917.   inherited;
  2918. end;
  2919.  
  2920. procedure TDCCustomSyntaxMemo.MouseSelection(XPos, YPos: integer);
  2921.  var
  2922.   MemoCoord: TDCMemoCoord;
  2923.   MousePos, BoundsPos: TPoint;
  2924.   BoundsRect: TRect;
  2925.  
  2926.   function SetInc(APos: integer; APoint: TPoint; ADiv: integer): integer;
  2927.   begin
  2928.     if APos < APoint.X then
  2929.       Result := - ((APoint.X - APos - 1) div ADiv + 1)
  2930.     else
  2931.       if APos > APoint.Y then
  2932.         Result := (APos - APoint.Y - 1) div ADiv + 1
  2933.       else
  2934.         Result := 0;
  2935.   end;
  2936. begin
  2937.   BoundsPos  := ClientToScreen(Point(0, 0));
  2938.   BoundsRect := ClientRect;
  2939.   BoundsRect.Right  := BoundsRect.Left + (FColCount - FHalf.X) * FColWidth;
  2940.   BoundsRect.Bottom := BoundsRect.Top  + (FRowCount - FHalf.Y) * FRowHeight;
  2941.   OffsetRect(BoundsRect, BoundsPos.X, BoundsPos.Y);
  2942.   Windows.GetCursorPos(MousePos);
  2943.  
  2944.   MemoCoord := GetMemoCoord(XPos, YPos);
  2945.   SaveCurPos;
  2946.   if PtInRect(BoundsRect, MousePos) then
  2947.   begin
  2948.     StopScrollTimer;
  2949.     BeginUpdate;
  2950.     Row := MemoCoord.Y;
  2951.     Col := MemoCoord.X;
  2952.     if msSelecting in FMemoState then
  2953.       AddSelection(Point(Col, Row), Point(FCurPos.Col, FCurPos.Row));
  2954.     EndUpdate;
  2955.   end
  2956.   else begin
  2957.     with BoundsRect do
  2958.     begin
  2959.       FScrollInc.X := SetInc(MousePos.X, Point(Left, Right), FColWidth);
  2960.       FScrollInc.Y := SetInc(MousePos.Y, Point(Top, Bottom), FRowHeight);
  2961.       if FScrollInc.X = 0 then FCurrent.X := MemoCoord.X;
  2962.       if FScrollInc.Y = 0 then FCurrent.Y := MemoCoord.Y;
  2963.       if msSelecting in FMemoState then
  2964.         AddSelection(Point(Col, Row), Point(FCurPos.Col, FCurPos.Row));
  2965.     end;
  2966.     if FScrollTimerHandle = 0 then StartScrollTimer;
  2967.   end;
  2968.   CreateCaretUndo;
  2969. end;
  2970.  
  2971. procedure TDCCustomSyntaxMemo.WMLButtonDblClk(
  2972.   var Message: TWMLButtonDblClk);
  2973.  var
  2974.   APoint: TPoint;
  2975.  
  2976. begin
  2977.   inherited;
  2978.   if Row < FLines.Count then
  2979.   begin
  2980.     BeginUpdate;
  2981.     SaveCurPos;
  2982.     DeselectArea;
  2983.     if eoDoubleClickLine in EditorOptions then
  2984.     begin
  2985.       FCurPos.Col := 0;
  2986.       if Row < FLines.Count - 1 then
  2987.       begin
  2988.         Row := Row + 1;
  2989.         Col := 0;
  2990.       end
  2991.       else
  2992.         GoEnd;
  2993.       FSelectedArea.Add(Point(FCurPos.Col, FCurPos.Row), Point(Col, Row));
  2994.       FUpdateArea.Add(FSelectedArea.StartPos, FSelectedArea.EndPos);
  2995.     end
  2996.     else begin
  2997.       WordAt(Col, Row, APoint);
  2998.       FSelectedArea.Add(Point(APoint.X, Row), Point(APoint.Y, Row));
  2999.       FUpdateArea.Add(FSelectedArea.StartPos, FSelectedArea.EndPos);
  3000.       Col := APoint.Y;
  3001.     end;
  3002.     EndUpdate;
  3003.   end;
  3004. end;
  3005.  
  3006. procedure TDCCustomSyntaxMemo.DoGutterClick(MouseDownPos,
  3007.   MouseUpPos: TPoint);
  3008. begin
  3009.   if Assigned(FonGutterClick) then FonGutterClick(Self, MouseDownPos, MouseUpPos);
  3010. end;
  3011.  
  3012. procedure TDCCustomSyntaxMemo.SetMovingParam;
  3013. begin
  3014.   with FMovingBlock do
  3015.   begin
  3016.     if msMoving in FMemoState then
  3017.     begin
  3018.       DefaultCursor := Screen.Cursor;
  3019.       SelectRect := FSelectedArea.Rect;
  3020.       Block := GetBlock(SelectRect, FSelectedArea.Mode, False);
  3021.       Screen.Cursor := crDrag;
  3022.     end
  3023.     else begin
  3024.       Screen.Cursor := DefaultCursor;
  3025.       SetLength(Block, 0);
  3026.       SetRectEmpty(SelectRect);
  3027.       DefaultCursor := crDefault;
  3028.     end;
  3029.   end;
  3030. end;
  3031.  
  3032. function TDCCustomSyntaxMemo.WordAt(ACol, ARow: integer;
  3033.   var APoint: TPoint): boolean;
  3034.  var
  3035.   pSource, pValue, pValueEnd: PChar;
  3036.   WordAtLeft: boolean;
  3037. begin
  3038.   pSource := PChar(FLines[ARow]);
  3039.  
  3040.   if integer(StrLen(pSource)) > ACol then
  3041.   begin
  3042.     pValue  := pSource + ACol;
  3043.     Result := True;
  3044.   end
  3045.   else begin
  3046.     pValue  := StrEnd(pSource);
  3047.     Result := False;
  3048.   end;
  3049.  
  3050.   if FSyntaxData.IsDelimiter(pValue^) then
  3051.   begin
  3052.     while (pValue >= pSource) and FSyntaxData.IsDelimiter(pValue^) do
  3053.       Dec(pValue);
  3054.     Result := False;
  3055.   end;
  3056.   if pValue >= pSource then
  3057.     WordAtLeft := True
  3058.   else
  3059.     WordAtLeft := False;
  3060.  
  3061.   while (pValue >= pSource) and not FSyntaxData.IsDelimiter(pValue^) do
  3062.     Dec(pValue);
  3063.  
  3064.   if pValue < pSource then
  3065.   begin
  3066.     pValue := pSource;
  3067.     if not WordAtLeft then
  3068.       while (pValue^ <> #0) and FSyntaxData.IsDelimiter(pValue^) do
  3069.         Inc(pValue);
  3070.   end;
  3071.   if (pValue >= pSource) and (pValue^ <> #0)  then
  3072.   begin
  3073.     if FSyntaxData.IsDelimiter(pValue^) then Inc(pValue);
  3074.     pValueEnd := pValue;
  3075.     while (pValueEnd^ <> #0) and not FSyntaxData.IsDelimiter(pValueEnd^) do
  3076.       Inc(pValueEnd);
  3077.     APoint := Point(pValue - pSource, pValueEnd - pSource);
  3078.   end
  3079.   else begin
  3080.     APoint := Point(0, StrLen(pSource));
  3081.     Result := False;
  3082.   end;
  3083. end;
  3084.  
  3085. procedure TDCCustomSyntaxMemo.LockPaint;
  3086. begin
  3087.   Inc(FLockPaint);
  3088. end;
  3089.  
  3090. function TDCCustomSyntaxMemo.UnlockPaint: boolean;
  3091. begin
  3092.   Dec(FLockPaint);
  3093.   Result := FLockPaint  = 0;
  3094. end;
  3095.  
  3096. procedure TDCCustomSyntaxMemo.SetModified(Value: boolean);
  3097. begin
  3098.   if FModified <> Value then
  3099.   begin
  3100.     FModified := Value;
  3101.     if not FModified then FUndoCount := 0;
  3102.     if Assigned(FOnModifiedChanged) then FOnModifiedChanged(Self)
  3103.   end;
  3104. end;
  3105.  
  3106. procedure TDCCustomSyntaxMemo.ClearUndoList;
  3107. begin
  3108.   FUndoList.Clear;
  3109. end;
  3110.  
  3111. procedure TDCCustomSyntaxMemo.UpdateModifiedStatus(Value: integer = -1);
  3112. begin
  3113.   FUndoCount := FUndoCount + Value;
  3114.   Modified := not (FUndoCount = 0);
  3115. end;
  3116.  
  3117. procedure TDCCustomSyntaxMemo.Clear;
  3118. begin
  3119.   FLines.Clear;
  3120. end;
  3121.  
  3122. procedure TDCCustomSyntaxMemo.CreateWnd;
  3123. begin
  3124.   inherited;
  3125. end;
  3126.  
  3127. function TDCCustomSyntaxMemo.GetSyntaxColors: TDCSyntaxMemoColors;
  3128. begin
  3129.   Result := FSyntaxData.SyntaxColors;
  3130. end;
  3131.  
  3132.  
  3133. { TDCMemoScroll }
  3134.  
  3135. constructor TDCMemoScroll.Create(AControl: TDCCustomSyntaxMemo;
  3136.   AKind: TScrollBarKind);
  3137. begin
  3138.   inherited Create;
  3139.   FControl   := AControl;
  3140.   FIncrement := 1;
  3141.   FPosition  := 0;
  3142.   FKind := AKind;
  3143. end;
  3144.  
  3145. procedure TDCMemoScroll.ScrollMessage(var Message: TWMScroll);
  3146.  var
  3147.   APosition: integer;
  3148. begin
  3149.   APosition :=  FPosition;
  3150.   with Message do
  3151.     case ScrollCode of
  3152.       SB_LINEUP:
  3153.         APosition := FPosition - FIncrement;
  3154.       SB_LINEDOWN:
  3155.         APosition := FPosition + FIncrement;
  3156.       SB_PAGEUP:
  3157.         APosition := FPosition - FPageSize;
  3158.       SB_PAGEDOWN:
  3159.         APosition := FPosition + FPageSize;
  3160.       SB_THUMBPOSITION:
  3161.         APosition := Pos;
  3162.       SB_THUMBTRACK:
  3163.         APosition := Pos;
  3164.       SB_TOP:
  3165.         APosition := 0;
  3166.       SB_BOTTOM:
  3167.         APosition := FMax;
  3168.       SB_ENDSCROLL:
  3169.         ;
  3170.     end;
  3171.     SetPosition(APosition);
  3172. end;
  3173.  
  3174. procedure TDCMemoScroll.SetPosition(Value: integer);
  3175.  var
  3176.   BarCode: Word;
  3177.   Form: TCustomForm;
  3178.   APosition: Integer;
  3179. begin
  3180.   if csReading in FControl.ComponentState then
  3181.     FPosition := Value
  3182.   else begin
  3183.     BarCode := SB_HORZ;
  3184.     if Value < 0 then Value := 0;
  3185.     if Value > FMax then Value := FMax;
  3186.     case FKind of
  3187.       sbHorizontal:
  3188.         BarCode := SB_HORZ;
  3189.       sbVertical:
  3190.         BarCode := SB_VERT;
  3191.     end;
  3192.     if Value <> FPosition then
  3193.     begin
  3194.       APosition := FPosition;
  3195.       FPosition := Value;
  3196.       case FKind of
  3197.         sbHorizontal:
  3198.           FControl.DoScroll(APosition - Value, 0);
  3199.         sbVertical:
  3200.           FControl.DoScroll(0, APosition - Value);
  3201.       end;
  3202.       if csDesigning in FControl.ComponentState then
  3203.       begin
  3204.         Form := GetParentForm(FControl);
  3205.         if (Form <> nil) and (Form.Designer <> nil) then Form.Designer.Modified;
  3206.       end;
  3207.     end;
  3208.     if GetScrollPos(FControl.Handle, BarCode) <> FPosition then
  3209.       SetScrollPos(FControl.Handle, BarCode, FPosition, True);
  3210.   end;
  3211. end;
  3212.  
  3213. procedure TDCMemoScroll.SetRange(Value: integer);
  3214. begin
  3215.   FRange := Value;
  3216.   FControl.UpdateScrollBars;
  3217. end;
  3218.  
  3219. procedure TDCMemoScroll.Update;
  3220.  var
  3221.   BarCode: Word;
  3222.   ScrollInfo: TScrollInfo;
  3223. begin
  3224.   BarCode := SB_HORZ;
  3225.   case FKind of
  3226.     sbHorizontal:
  3227.       BarCode := SB_HORZ;
  3228.     sbVertical:
  3229.       BarCode := SB_VERT;
  3230.   end;
  3231.   ScrollInfo.cbSize := SizeOf(ScrollInfo);
  3232.   ScrollInfo.fMask  := SIF_ALL;
  3233.   ScrollInfo.nMin   := 0;
  3234.   ScrollInfo.nMax   := FRange;
  3235.   ScrollInfo.nPage  := FPageSize;
  3236.  
  3237.   ScrollInfo.nPos      := FPosition;
  3238.   ScrollInfo.nTrackPos := FPosition;
  3239.   SetScrollInfo(FControl.Handle, BarCode, ScrollInfo, True);
  3240. end;
  3241.  
  3242. { TCustomUndoAction }
  3243.  
  3244. constructor TCustomUndoAction.Create(AMemo: TDCCustomSyntaxMemo;
  3245.   ACurPos, ANewPos: TDCMemoPos);
  3246. begin
  3247.   inherited Create;
  3248.   Memo    := AMemo;
  3249.   CurPos  := ACurPos;
  3250.   NewPos  := ANewPos;
  3251.   Memo.FUndoList.AddUndoAction(Self);
  3252. end;
  3253.  
  3254. { TUndoActionList }
  3255.  
  3256. procedure TUndoActionList.AddUndoAction(AUndo: TCustomUndoAction);
  3257. begin
  3258.   while (Count > 0) and (FPosition < Count - 1) do
  3259.   begin
  3260.     TCustomUndoAction(Items[FPosition + 1]).Free;
  3261.     Delete(FPosition + 1);
  3262.   end;
  3263.   Add(AUndo);
  3264.   FPosition := Count - 1;
  3265. end;
  3266.  
  3267. procedure TUndoActionList.Clear;
  3268.  var
  3269.   i: integer;
  3270. begin
  3271.   for i := 0 to Count - 1 do TCustomUndoAction(Items[i]).Free;
  3272.   FPosition := 0;
  3273.   inherited;
  3274. end;
  3275.  
  3276. constructor TUndoActionList.Create(AMemo: TDCCustomSyntaxMemo);
  3277. begin
  3278.   FMemo := AMemo;
  3279.   FPosition := -1;
  3280.   FUpdated  := False;
  3281. end;
  3282.  
  3283. function TUndoActionList.GetCanRedo: boolean;
  3284. begin
  3285.   Result := FPosition < (Count - 1);
  3286. end;
  3287.  
  3288. function TUndoActionList.GetCanUndo: boolean;
  3289. begin
  3290.   Result := FPosition > -1;
  3291. end;
  3292.  
  3293. procedure TUndoActionList.Redo;
  3294. begin
  3295.   FUpdated := True;
  3296.   if (FPosition < Count - 1) then
  3297.   begin
  3298.     Inc(FPosition);
  3299.     TCustomUndoAction(Items[FPosition]).Redo;
  3300.   end;
  3301.   FUpdated := False;
  3302. end;
  3303.  
  3304. procedure TUndoActionList.Undo;
  3305.  var
  3306.   UndoAction: TCustomUndoAction;
  3307.   UndoClassType: TClass;
  3308. begin
  3309.   FUpdated := True;
  3310.   if (FPosition <= Count -1) and (FPosition >= 0) then
  3311.   begin
  3312.     UndoAction := TCustomUndoAction(Items[FPosition]);
  3313.     if FMemo.FGroupUndo then
  3314.     begin
  3315.       UndoClassType := UndoAction.ClassType;
  3316.       while (UndoClassType = UndoAction.ClassType) and
  3317.             ((FPosition > 0) or (UndoAction.ClassType <> TCaretUndo)) do
  3318.       begin
  3319.         UndoAction.Undo;
  3320.         Dec(FPosition);
  3321.         UndoAction := TCustomUndoAction(Items[FPosition]);
  3322.       end;
  3323.     end
  3324.     else begin
  3325.       if (FPosition > 0) or (UndoAction.ClassType <> TCaretUndo) then
  3326.       begin
  3327.         UndoAction.Undo;
  3328.         Dec(FPosition);
  3329.       end;
  3330.     end;
  3331.   end;
  3332.   FUpdated := False;
  3333. end;
  3334.  
  3335. { TCaretUndo }
  3336.  
  3337. procedure TCaretUndo.Redo;
  3338. begin
  3339.   if (NewPos.Col < Memo.LeftCol) or
  3340.      (NewPos.Col > Memo.LeftCol + Memo.FColCount) or
  3341.      (NewPos.Row < Memo.TopRow) or
  3342.      (NewPos.Row > Memo.TopRow + Memo.FRowCount)
  3343.   then
  3344.     Memo.MoveTopLeft(NewPos.TopLeft.X, NewPos.TopLeft.Y);
  3345.   Memo.Row := NewPos.Row;
  3346.   Memo.Col := NewPos.Col;
  3347.   with Memo do
  3348.   begin
  3349.     FUpdateArea.Add(FSelectedArea.StartPos, FSelectedArea.EndPos);
  3350.     FSelectedArea.Clear;
  3351.     FSelectedArea.Add(NewPos.SelectRect.TopLeft, NewPos.SelectRect.BottomRight);
  3352.     FUpdateArea.Add(FSelectedArea.StartPos, FSelectedArea.EndPos);
  3353.   end;
  3354. end;
  3355.  
  3356. procedure TCaretUndo.Undo;
  3357. begin
  3358.   if (CurPos.Col < Memo.LeftCol) or
  3359.      (CurPos.Col > Memo.LeftCol + Memo.FColCount) or
  3360.      (CurPos.Row < Memo.TopRow) or
  3361.      (CurPos.Row > Memo.TopRow + Memo.FRowCount)
  3362.   then
  3363.     Memo.MoveTopLeft(CurPos.TopLeft.X, CurPos.TopLeft.Y);
  3364.   Memo.Row := CurPos.Row;
  3365.   Memo.Col := CurPos.Col;
  3366.   with Memo do
  3367.   begin
  3368.     FUpdateArea.Add(FSelectedArea.StartPos, FSelectedArea.EndPos);
  3369.     FSelectedArea.Clear;
  3370.     FSelectedArea.Add(CurPos.SelectRect.TopLeft, CurPos.SelectRect.BottomRight);
  3371.     FUpdateArea.Add(FSelectedArea.StartPos, FSelectedArea.EndPos);
  3372.   end;
  3373. end;
  3374.  
  3375. { TCharUndo }
  3376.  
  3377. constructor TCharUndo.Create(AMemo: TDCCustomSyntaxMemo;
  3378.   ACurPos, ANewPos: TDCMemoPos; AValue: Char; ABreakCount: integer);
  3379. begin
  3380.   inherited Create(AMemo, ACurPos, ANewPos);
  3381.   Value := AValue;
  3382.   BreakCount := ABreakCount;
  3383.   Inc(Memo.FUndoCount);
  3384. end;
  3385.  
  3386. procedure TCharUndo.Redo;
  3387. begin
  3388.   inherited;
  3389.   Memo.InsertChar(CurPos.Col, CurPos.Row, Value);
  3390.   Memo.UpdateModifiedStatus(1);
  3391. end;
  3392.  
  3393. procedure TCharUndo.Undo;
  3394. begin
  3395.   Memo.FLines.BeginUpdate;
  3396.   Memo.DeleteBlock(Rect(CurPos.Col, CurPos.Row, NewPos.Col, NewPos.Row), smLines);
  3397.   if BreakCount > 0 then
  3398.     Memo.FLines.DeleteLines(CurPos.Row - BreakCount, BreakCount);
  3399.   Memo.FLines.EndUpdate;
  3400.   Memo.UpdateModifiedStatus;
  3401.   inherited;
  3402. end;
  3403.  
  3404. { TBlockUndo }
  3405.  
  3406. constructor TBlockUndo.Create(AMemo: TDCCustomSyntaxMemo; ACurPos, ANewPos: TDCMemoPos;
  3407.   AStyle: TBlockUndoStyle; AInsValue, ADelValue: string;
  3408.   ASelectMode: TTextSelectMode; APersistentBlocks: boolean; ABreakCount: integer);
  3409. begin
  3410.   inherited Create(AMemo, ACurPos, ANewPos);
  3411.   Style    := AStyle;
  3412.   InsValue := AInsValue;
  3413.   DelValue := ADelValue;
  3414.   SelectMode := ASelectMode;
  3415.   PersistentBlocks := APersistentBlocks;
  3416.   BreakCount := ABreakCount;
  3417.   Inc(Memo.FUndoCount);
  3418. end;
  3419.  
  3420. function TBlockUndo.GetTextRect(Left, Top: integer; pSource: PChar): TRect;
  3421. begin
  3422.   Result := Rect(Left, Top , Left, Top);
  3423.   while pSource^ <> #0 do
  3424.   begin
  3425.     Result.Right := Result.Right + 1;
  3426.     if pSource^ = #13 then
  3427.     begin
  3428.       Result.Right  := 0;
  3429.       Result.Bottom := Result.Bottom + 1;
  3430.       Inc(pSource);
  3431.       if pSource^ = #10 then Inc(pSource);
  3432.     end
  3433.     else
  3434.       Inc(pSource);
  3435.   end;
  3436. end;
  3437.  
  3438. procedure TBlockUndo.InsertBlock;
  3439. begin
  3440.   Memo.InsertBlock(CurPos.SelectRect.Left, CurPos.SelectRect.Top, SelectMode, PChar(DelValue));
  3441. end;
  3442.  
  3443. procedure TBlockUndo.Redo;
  3444. begin
  3445.   case Style of
  3446.     buInsert:
  3447.       with CurPos.SelectRect do
  3448.       begin
  3449.         if DelValue <> '' then
  3450.           Memo.DeleteBlock(CurPos.SelectRect, SelectMode);
  3451.         if (TopLeft.X = BottomRight.X) and (TopLeft.Y = BottomRight.Y) or PersistentBlocks then
  3452.           Memo.InsertBlock(CurPos.Col, CurPos.Row, SelectMode, PChar(InsValue))
  3453.         else
  3454.           Memo.InsertBlock(Left, Top, SelectMode, PChar(InsValue))
  3455.       end;
  3456.     buDelete:
  3457.       begin
  3458.         Memo.DeleteBlock(CurPos.SelectRect, SelectMode);
  3459.         Memo.DeselectArea;
  3460.       end;
  3461.   end;
  3462.   Memo.UpdateModifiedStatus(1);
  3463.   inherited;
  3464. end;
  3465.  
  3466. procedure TBlockUndo.Undo;
  3467.  var
  3468.   TextRect: TRect;
  3469.   AText: string;
  3470.   ALeft, ATop: integer;
  3471. begin
  3472.   case Style of
  3473.     buInsert:
  3474.       with CurPos.SelectRect do
  3475.       begin
  3476.         Memo.FLines.BeginUpdate;
  3477.         if (TopLeft.X = BottomRight.X) and (TopLeft.Y = BottomRight.Y) or PersistentBlocks then
  3478.         begin
  3479.           ALeft := CurPos.Col;
  3480.           ATop  := CurPos.Row;
  3481.         end
  3482.         else  begin
  3483.           ALeft := Left;
  3484.           ATop  := Top;
  3485.         end;
  3486.  
  3487.         AText := InsValue;
  3488.         if BreakCount > 0 then
  3489.            Memo.FLines.DeleteLines(ATop - BreakCount, BreakCount);
  3490.         TextRect := GetTextRect(ALeft, ATop - BreakCount, PChar(AText));
  3491.         Memo.DeleteBlock(TextRect, SelectMode);
  3492.  
  3493.         if DelValue <> '' then InsertBlock;
  3494.         Memo.FLines.EndUpdate;
  3495.       end;
  3496.     buDelete:
  3497.       InsertBlock;
  3498.   end;
  3499.   Memo.UpdateModifiedStatus;
  3500.   inherited;
  3501. end;
  3502.  
  3503. { TDeleteUndo }
  3504.  
  3505. constructor TDeleteUndo.Create(AMemo: TDCCustomSyntaxMemo;
  3506.   ACurPos, ANewPos: TDCMemoPos; AValue: string; AStyle: TDeleteUndoStyle);
  3507. begin
  3508.   inherited Create(AMemo, ACurPos, ANewPos);
  3509.   Value := AValue;
  3510.   Style := AStyle;
  3511.   Inc(Memo.FUndoCount);
  3512. end;
  3513.  
  3514. procedure TDeleteUndo.Redo;
  3515. begin
  3516.   case Style of
  3517.     duDelete:
  3518.       begin
  3519.         inherited;
  3520.         with Memo do DeleteBlock(Rect(Col, Row, Col + 1, Row), smLines);
  3521.       end;
  3522.     duBackspace:
  3523.       begin
  3524.         Memo.Backspace;
  3525.       end;
  3526.   end;
  3527.   Memo.UpdateModifiedStatus(1);
  3528. end;
  3529.  
  3530. procedure TDeleteUndo.Undo;
  3531. begin
  3532.   case Style of
  3533.     duDelete:
  3534.       begin
  3535.         Memo.InsertBlock(CurPos.Col, CurPos.Row, smLines, PChar(Value));
  3536.       end;
  3537.     duBackspace:
  3538.       begin
  3539.         Memo.InsertBlock(NewPos.Col, NewPos.Row, smLines, PChar(Value));
  3540.       end;
  3541.   end;
  3542.   Memo.UpdateModifiedStatus;
  3543.   inherited;
  3544. end;
  3545.  
  3546. end.
  3547.  
  3548.