|
|
@@ -1,5462 +1,5461 @@
|
|
|
-//
|
|
|
-// This unit is part of the GLScene Engine, http://glscene.org
|
|
|
-//
|
|
|
-{
|
|
|
- Memo for GLScene
|
|
|
-}
|
|
|
-
|
|
|
-unit GLSMemo;
|
|
|
-
|
|
|
-interface
|
|
|
-
|
|
|
-{$I GLScene.inc}
|
|
|
-
|
|
|
-uses
|
|
|
- WinApi.Windows,
|
|
|
- WinApi.Messages,
|
|
|
- System.SysUtils,
|
|
|
- System.Classes,
|
|
|
- System.UITypes,
|
|
|
- VCL.Graphics,
|
|
|
- VCL.Controls,
|
|
|
- VCL.Forms,
|
|
|
- VCL.Dialogs,
|
|
|
- VCL.ClipBrd,
|
|
|
- VCL.StdCtrls,
|
|
|
- VCL.ExtCtrls;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-type
|
|
|
- TBorderType = (btRaised, btLowered, btFlatRaised, btFlatLowered);
|
|
|
- TCommand = Integer;
|
|
|
-
|
|
|
- TCellSize = record
|
|
|
- W, H: integer;
|
|
|
- end;
|
|
|
-
|
|
|
- TCellPos = record
|
|
|
- X, Y: integer;
|
|
|
- end;
|
|
|
-
|
|
|
- TFullPos = record
|
|
|
- LineNo, Pos: integer;
|
|
|
- end;
|
|
|
-
|
|
|
- TLineProp = class
|
|
|
- FObject: TObject;
|
|
|
- FStyleNo: integer;
|
|
|
- FInComment: Boolean;
|
|
|
- FInBrackets: integer;
|
|
|
- FValidAttrs: Boolean;
|
|
|
- FCharAttrs: string;
|
|
|
- end;
|
|
|
-
|
|
|
- TCharStyle = class(TPersistent)
|
|
|
- private
|
|
|
- FTextColor, FBkColor: TColor;
|
|
|
- FStyle: TFontStyles;
|
|
|
- published
|
|
|
-
|
|
|
- property TextColor: TColor read FTextColor write FTextColor;
|
|
|
- property BkColor: TColor read FBkColor write FBkColor;
|
|
|
- property Style: TFontStyles read FStyle write FStyle;
|
|
|
- end;
|
|
|
-
|
|
|
- TStyleList = class(TList)
|
|
|
- private
|
|
|
- procedure CheckRange(Index: integer);
|
|
|
- function GetTextColor(Index: Integer): TColor;
|
|
|
- procedure SetTextColor(Index: Integer; Value: TColor);
|
|
|
- function GetBkColor(Index: Integer): TColor;
|
|
|
- procedure SetBkColor(Index: Integer; Value: TColor);
|
|
|
- function GetStyle(Index: Integer): TFontStyles;
|
|
|
- procedure SetStyle(Index: Integer; Value: TFontStyles);
|
|
|
- protected
|
|
|
-
|
|
|
- property TextColor[Index: Integer]: TColor read GetTextColor write
|
|
|
- SetTextColor;
|
|
|
- property BkColor[Index: Integer]: TColor read GetBkColor write SetBkColor;
|
|
|
- property Style[Index: Integer]: TFontStyles read GetStyle write SetStyle;
|
|
|
- public
|
|
|
-
|
|
|
- destructor Destroy; override;
|
|
|
- procedure Clear; override;
|
|
|
- procedure Delete(Index: Integer);
|
|
|
- function Add(ATextColor, ABkCOlor: TColor; AStyle: TFontStyles): Integer;
|
|
|
- procedure Change(Index: integer; ATextColor, ABkColor: TColor; AStyle:
|
|
|
- TFontStyles);
|
|
|
- end;
|
|
|
-
|
|
|
- TGLAbstractMemoObject = class(TObject)
|
|
|
- public
|
|
|
- function MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
|
|
|
- Boolean; virtual; abstract;
|
|
|
- function MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
|
|
|
- Boolean; virtual; abstract;
|
|
|
- function MouseMove(Shift: TShiftState; X, Y: Integer):
|
|
|
- Boolean; virtual; abstract;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMemoScrollBar = class;
|
|
|
-
|
|
|
- TGLSMemoAbstractScrollableObject = class(TCustomControl)
|
|
|
- protected
|
|
|
- procedure DoScroll(Sender: TGLSMemoScrollBar; ByValue: integer);
|
|
|
- virtual; abstract;
|
|
|
- procedure DoScrollPage(Sender: TGLSMemoScrollBar; ByValue: integer);
|
|
|
- virtual; abstract;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSCustomMemo = class;
|
|
|
-
|
|
|
- TsbState =
|
|
|
- (
|
|
|
- sbsWait,
|
|
|
- sbsBack,
|
|
|
- sbsForward,
|
|
|
- sbsPageBack,
|
|
|
- sbsPageForward,
|
|
|
- sbsDragging
|
|
|
- );
|
|
|
-
|
|
|
- TGLSMemoScrollBar = class(TGLAbstractMemoObject)
|
|
|
- private
|
|
|
- FKind: TScrollBarKind;
|
|
|
- FParent: TGLSMemoAbstractScrollableObject;
|
|
|
- FLeft, FTop, FWidth, FHeight: integer;
|
|
|
- FTotal, FMaxPosition, FPosition: integer;
|
|
|
- FButtonLength: integer;
|
|
|
- FState: TsbState;
|
|
|
- FXOffset, FYOffset: integer;
|
|
|
- procedure SetParams(Index: integer; Value: integer);
|
|
|
- procedure SetState(Value: TsbState);
|
|
|
- function GetRect: TRect;
|
|
|
- function GetThumbRect: TRect;
|
|
|
- function GetBackRect: TRect;
|
|
|
- function GetMiddleRect: TRect;
|
|
|
- function GetForwardRect: TRect;
|
|
|
- function GetPgBackRect: TRect;
|
|
|
- function GetPgForwardRect: TRect;
|
|
|
- public
|
|
|
- constructor Create(AParent: TGLSMemoAbstractScrollableObject;
|
|
|
- AKind: TScrollBarKind);
|
|
|
- procedure PaintTo(ACanvas: TCanvas);
|
|
|
- function MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
|
|
|
- Boolean; override;
|
|
|
- function MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
|
|
|
- Boolean; override;
|
|
|
- function MouseMove(Shift: TShiftState; X, Y: Integer):
|
|
|
- Boolean; override;
|
|
|
- function MoveThumbTo(X, Y: Integer): integer;
|
|
|
- property Parent: TGLSMemoAbstractScrollableObject read FParent;
|
|
|
- property Kind: TScrollBarKind read FKind write FKind;
|
|
|
- property State: TsbState read FState write SetState;
|
|
|
- property Left: integer index 0 read FLeft write SetParams;
|
|
|
- property Top: integer index 1 read FTop write SetParams;
|
|
|
- property Width: integer index 2 read FWidth write SetParams;
|
|
|
- property Height: integer index 3 read FHeight write SetParams;
|
|
|
- property Total: integer index 4 read FTotal write SetParams;
|
|
|
- property MaxPosition: integer index 5 read FMaxPosition write SetParams;
|
|
|
- property Position: integer index 6 read FPosition write SetParams;
|
|
|
- property FullRect: TRect read GetRect;
|
|
|
- property ThumbRect: TRect read GetThumbRect;
|
|
|
- property BackRect: TRect read GetBackRect;
|
|
|
- property MiddleRect: TRect read GetMiddleRect;
|
|
|
- property ForwardRect: TRect read GetForwardRect;
|
|
|
- property PageForwardRect: TRect read GetPgForwardRect;
|
|
|
- property PageBackRect: TRect read GetPgBackRect;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMemoStrings = class(TStringList)
|
|
|
- private
|
|
|
- FMemo: TGLSCustomMemo;
|
|
|
- FLockCount: integer;
|
|
|
- FDeleting: Boolean;
|
|
|
- procedure CheckRange(Index: integer);
|
|
|
- function GetLineProp(Index: integer): TLineProp;
|
|
|
- procedure SetLineStyle(Index: integer; Value: integer);
|
|
|
- function GetLineStyle(Index: integer): integer;
|
|
|
- function GetInComment(Index: Integer): Boolean;
|
|
|
- procedure SetInComment(Index: Integer; Value: Boolean);
|
|
|
- function GetInBrackets(Index: Integer): integer;
|
|
|
- procedure SetInBrackets(Index: Integer; Value: integer);
|
|
|
- function GetValidAttrs(Index: Integer): Boolean;
|
|
|
- procedure SetValidAttrs(Index: Integer; Value: Boolean);
|
|
|
- function GetCharAttrs(Index: Integer): string;
|
|
|
- procedure SetCharAttrs(Index: Integer; const Value: string);
|
|
|
- protected
|
|
|
- function GetObject(Index: Integer): TObject; override;
|
|
|
- procedure PutObject(Index: Integer; AObject: TObject); override;
|
|
|
- procedure SetUpdateState(Updating: Boolean); override;
|
|
|
- function CreateProp(Index: integer): TLineProp;
|
|
|
- property LineProp[Index: integer]: TLineProp read GetLineProp; //PALOFF
|
|
|
- property Style[Index: integer]: integer read GetLineStyle write
|
|
|
- SetLineStyle;
|
|
|
- property InComment[Index: integer]: Boolean read GetInComment write
|
|
|
- SetInComment;
|
|
|
- property InBrackets[Index: integer]: integer read GetInBrackets write
|
|
|
- SetInBrackets;
|
|
|
- property ValidAttrs[Index: integer]: Boolean read GetValidAttrs write
|
|
|
- SetValidAttrs;
|
|
|
- property CharAttrs[Index: integer]: string read GetCharAttrs write
|
|
|
- SetCharAttrs;
|
|
|
- public
|
|
|
- destructor Destroy; override;
|
|
|
- procedure Clear; override;
|
|
|
- function DoAdd(const S: string): Integer;
|
|
|
- function Add(const S: string): Integer; override;
|
|
|
- function AddObject(const S: string; AObject: TObject): Integer; override;
|
|
|
- procedure Assign(Source: TPersistent); override;
|
|
|
- procedure Insert(Index: Integer; const S: string); override;
|
|
|
- procedure DoInsert(Index: Integer; const S: string);
|
|
|
- procedure InsertObject(Index: Integer; const S: string; AObject: TObject);
|
|
|
- override;
|
|
|
- procedure Delete(Index: Integer); override;
|
|
|
- procedure LoadFromFile(const FileName: string); override;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMemoGutter = class(TObject)
|
|
|
- private
|
|
|
- FMemo: TGLSCustomMemo;
|
|
|
- FLeft, FTop, FWidth, FHeight: integer;
|
|
|
- FColor: TColor;
|
|
|
- procedure SetParams(Index: integer; Value: integer);
|
|
|
- function GetRect: TRect;
|
|
|
- protected
|
|
|
- procedure PaintTo(ACanvas: TCanvas);
|
|
|
- procedure Invalidate;
|
|
|
- public
|
|
|
- property Left: integer index 0 read FLeft write SetParams;
|
|
|
- property Top: integer index 1 read FTop write SetParams;
|
|
|
- property Width: integer index 2 read FWidth write SetParams;
|
|
|
- property Height: integer index 3 read FHeight write SetParams;
|
|
|
- property FullRect: TRect read GetRect;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMemoUndo = class
|
|
|
- private
|
|
|
- FMemo: TGLSCustomMemo;
|
|
|
- FUndoCurX0, FUndoCurY0: integer;
|
|
|
- FUndoCurX, FUndoCurY: integer;
|
|
|
- FUndoText: string;
|
|
|
- public
|
|
|
- constructor Create(ACurX0, ACurY0, ACurX, ACurY: integer; const AText: string);
|
|
|
- function Append(NewUndo: TGLSMemoUndo): Boolean; virtual;
|
|
|
- procedure Undo;
|
|
|
- procedure Redo;
|
|
|
- procedure PerformUndo; virtual; abstract;
|
|
|
- procedure PerformRedo; virtual; abstract;
|
|
|
- property UndoCurX0: integer read FUndoCurX0 write FUndoCurX0;
|
|
|
- property UndoCurY0: integer read FUndoCurY0 write FUndoCurY0;
|
|
|
- property UndoCurX: integer read FUndoCurX write FUndoCurX;
|
|
|
- property UndoCurY: integer read FUndoCurY write FUndoCurY;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMemoInsCharUndo = class(TGLSMemoUndo)
|
|
|
- public
|
|
|
- function Append(NewUndo: TGLSMemoUndo): Boolean; override;
|
|
|
- procedure PerformUndo; override;
|
|
|
- procedure PerformRedo; override;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMemoDelCharUndo = class(TGLSMemoUndo)
|
|
|
- private
|
|
|
- FIsBackspace: Boolean;
|
|
|
- public
|
|
|
- function Append(NewUndo: TGLSMemoUndo): Boolean; override;
|
|
|
- procedure PerformUndo; override;
|
|
|
- procedure PerformRedo; override;
|
|
|
- property IsBackspace: Boolean read FIsBackspace write FIsBackspace;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMEmoDelLineUndo = class(TGLSMemoUndo)
|
|
|
- private
|
|
|
- FIndex: integer;
|
|
|
- public
|
|
|
- constructor Create(AIndex, ACurX0, ACurY0, ACurX, ACurY: integer; const AText:
|
|
|
- string);
|
|
|
- procedure PerformUndo; override;
|
|
|
- procedure PerformRedo; override;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMemoSelUndo = class(TGLSMemoUndo)
|
|
|
- private
|
|
|
- FUndoSelStartX, FUndoSelStartY,
|
|
|
- FUndoSelEndX, FUndoSelEndY: integer;
|
|
|
- public
|
|
|
- property UndoSelStartX: integer read FUndoSelStartX write FUndoSelStartX;
|
|
|
- property UndoSelStartY: integer read FUndoSelStartY write FUndoSelStartY;
|
|
|
- property UndoSelEndX: integer read FUndoSelEndX write FUndoSelEndX;
|
|
|
- property UndoSelEndY: integer read FUndoSelEndY write FUndoSelEndY;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMemoDeleteBufUndo = class(TGLSMemoSelUndo)
|
|
|
- public
|
|
|
- procedure PerformUndo; override;
|
|
|
- procedure PerformRedo; override;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMemoPasteUndo = class(TGLSMemoUndo)
|
|
|
- public
|
|
|
- procedure PerformUndo; override;
|
|
|
- procedure PerformRedo; override;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMemoUndoList = class(TList)
|
|
|
- private
|
|
|
- FPos: integer;
|
|
|
- FMemo: TGLSCustomMemo;
|
|
|
- FIsPerforming: Boolean;
|
|
|
- FLimit: integer;
|
|
|
- protected
|
|
|
- function Get(Index: Integer): TGLSMemoUndo;
|
|
|
- procedure SetLimit(Value: integer);
|
|
|
- public
|
|
|
- constructor Create;
|
|
|
- destructor Destroy; override;
|
|
|
- function Add(Item: Pointer): Integer;
|
|
|
- procedure Clear; override;
|
|
|
- procedure Delete(Index: Integer);
|
|
|
- procedure Undo;
|
|
|
- procedure Redo;
|
|
|
- property Items[Index: Integer]: TGLSMemoUndo read Get; default;
|
|
|
- property IsPerforming: Boolean read FIsPerforming write FIsPerforming;
|
|
|
- property Memo: TGLSCustomMemo read FMemo write FMemo;
|
|
|
- property Pos: integer read FPos write FPos;
|
|
|
- property Limit: integer read FLimit write SetLimit;
|
|
|
- end;
|
|
|
-
|
|
|
- //--------------------------------------------------------------
|
|
|
-
|
|
|
- TGutterClickEvent = procedure(Sender: TObject; LineNo: integer) of object;
|
|
|
- TGutterDrawEvent = procedure(Sender: TObject; ACanvas: TCanvas;
|
|
|
- LineNo: integer; rct: TRect) of object;
|
|
|
- TGetLineAttrsEvent = procedure(Sender: TObject; LineNo: integer;
|
|
|
- var Attrs: string) of object;
|
|
|
- TUndoChangeEvent = procedure(Sender: TObject;
|
|
|
- CanUndo, CanRedo: Boolean) of object;
|
|
|
- TScrollMode = (smAuto, smStrict);
|
|
|
-
|
|
|
- TGLSCustomMemo = class(TGLSMemoAbstractScrollableObject)
|
|
|
- private
|
|
|
- FAutoIndent: Boolean;
|
|
|
- FMargin: integer;
|
|
|
- FHiddenCaret, FCaretVisible: Boolean;
|
|
|
- FCellSize: TCellSize;
|
|
|
- FCurX, FCurY: integer;
|
|
|
- FLeftCol, FTopLine: integer;
|
|
|
- FTabSize: integer;
|
|
|
- FFont: TFont;
|
|
|
- FBkColor: TColor;
|
|
|
- FSelColor: TColor;
|
|
|
- FSelBkColor: TColor;
|
|
|
- FReadOnly: Boolean;
|
|
|
- FDelErase: Boolean;
|
|
|
- FLines: TStrings;
|
|
|
- FSelStartX, FSelStartY,
|
|
|
- FSelEndX, FSelEndY,
|
|
|
- FPrevSelX, FPrevSelY: integer;
|
|
|
- FScrollBars: System.UITypes.TScrollStyle;
|
|
|
- FScrollBarWidth: integer;
|
|
|
- FGutter: TGLSMemoGutter;
|
|
|
- FGutterWidth: integer;
|
|
|
- sbVert, sbHorz: TGLSMemoScrollBar;
|
|
|
- FStyles: TStyleList;
|
|
|
- FLineBitmap: TBitmap;
|
|
|
- FSelCharPos: TFullPos;
|
|
|
- FSelCharStyle: integer;
|
|
|
- FLeftButtonDown: Boolean;
|
|
|
- FScrollMode: TScrollMode;
|
|
|
- FUndoList: TGLSMemoUndoList;
|
|
|
- FFirstUndoList: TGLSMemoUndoList;
|
|
|
- FUndoLimit: integer;
|
|
|
- FLastMouseUpX,
|
|
|
- FLastMouseUpY: integer;
|
|
|
- FAfterDoubleClick: Boolean;
|
|
|
- {events}
|
|
|
- FOnMoveCursor: TNotifyEvent;
|
|
|
- FOnChange: TNotifyEvent;
|
|
|
- FOnAttrChange: TNotifyEvent;
|
|
|
- FOnStatusChange: TNotifyEvent;
|
|
|
- FOnSelectionChange: TNotifyEvent;
|
|
|
- FOnGutterDraw: TGutterDrawEvent;
|
|
|
- FOnGutterClick: TGutterClickEvent;
|
|
|
- FOnGetLineAttrs: TGetLineAttrsEvent;
|
|
|
- FOnUndoChange: TUndoChangeEvent;
|
|
|
- FHideCursor: Boolean;
|
|
|
- procedure SetHiddenCaret(Value: Boolean);
|
|
|
- procedure SetScrollBars(Value: System.UITypes.TScrollStyle);
|
|
|
- procedure SetGutterWidth(Value: integer);
|
|
|
- procedure SetGutterColor(Value: TColor);
|
|
|
- function GetGutterColor: TColor;
|
|
|
- procedure SetCurX(Value: integer);
|
|
|
- procedure SetCurY(Value: integer);
|
|
|
- procedure SetFont(Value: TFont);
|
|
|
- procedure SetColor(Index: integer; Value: TColor);
|
|
|
- function GetSelStart: TPoint;
|
|
|
- function GetSelEnd: TPoint;
|
|
|
- procedure SetLines(ALines: TStrings);
|
|
|
- procedure SetLineStyle(Index: integer; Value: integer);
|
|
|
- function GetLineStyle(Index: integer): integer;
|
|
|
- function GetInComment(Index: integer): Boolean;
|
|
|
- procedure SetInComment(Index: integer; Value: Boolean);
|
|
|
- function GetInBrackets(Index: Integer): integer;
|
|
|
- procedure SetInBrackets(Index: Integer; Value: integer);
|
|
|
- function GetValidAttrs(Index: integer): Boolean;
|
|
|
- procedure SetValidAttrs(Index: integer; Value: Boolean);
|
|
|
- function GetCharAttrs(Index: integer): string;
|
|
|
- procedure SetCharAttrs(Index: integer; const Value: string);
|
|
|
- procedure ExpandSelection;
|
|
|
- function GetSelText: string;
|
|
|
- procedure SetSelText(const AValue: string);
|
|
|
- function GetSelLength: integer;
|
|
|
- procedure MovePage(dP: integer; Shift: TShiftState);
|
|
|
- procedure ShowCaret(State: Boolean);
|
|
|
- procedure MakeVisible;
|
|
|
- function GetVisible(Index: integer): integer;
|
|
|
- function MaxLength: integer;
|
|
|
- procedure WMSize(var Msg: TWMSize); message WM_SIZE;
|
|
|
- procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
|
|
|
- procedure WMEraseBkgnd(var Msg: TWmEraseBkgnd); message WM_ERASEBKGND;
|
|
|
- procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
|
|
|
- procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
|
|
|
- procedure WMKillFocus(var Msg: TWMSetFocus); message WM_KILLFOCUS;
|
|
|
- procedure WMMouseWheel(var Message: TMessage); message WM_MOUSEWHEEL;
|
|
|
- procedure MoveCursor(dX, dY: integer; Shift: TShiftState);
|
|
|
- procedure ResizeEditor;
|
|
|
- procedure ResizeScrollBars;
|
|
|
- procedure ResizeGutter;
|
|
|
- procedure DoCommand(cmd: TCommand; const AShift: TShiftState);
|
|
|
- procedure DrawLine(LineNo: integer);
|
|
|
- function IsLineVisible(LineNo: integer): Boolean;
|
|
|
- procedure FreshLineBitmap;
|
|
|
- procedure SetUndoLimit(Value: integer);
|
|
|
- protected
|
|
|
- procedure WndProc(var Message: TMessage); override;
|
|
|
- function EditorRect: TRect;
|
|
|
- function LineRangeRect(FromLine, ToLine: integer): TRect;
|
|
|
- function ColRangeRect(FromCol, ToCol: integer): TRect;
|
|
|
- procedure InvalidateLineRange(FromLine, ToLine: integer);
|
|
|
- function AddString(const S: string): integer;
|
|
|
- procedure InsertString(Index: integer; S: string);
|
|
|
- procedure GoHome(Shift: TShiftState);
|
|
|
- procedure GoEnd(Shift: TShiftState);
|
|
|
- procedure InsertChar(C: Char);
|
|
|
- procedure DeleteChar(OldX, OldY: integer);
|
|
|
- procedure DeleteLine(Index, OldX, OldY, NewX, NewY: integer; FixUndo: Boolean);
|
|
|
- procedure BackSpace;
|
|
|
- procedure BackSpaceWord;
|
|
|
- function IndentCurrLine: string;
|
|
|
- procedure NewLine;
|
|
|
- procedure CreateParams(var Params: TCreateParams); override;
|
|
|
- procedure Paint; override;
|
|
|
- procedure DrawMargin;
|
|
|
- procedure DrawGutter;
|
|
|
- procedure DrawScrollBars;
|
|
|
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
|
- procedure KeyPress(var Key: Char); override;
|
|
|
- procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
|
- procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
|
- procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
|
- procedure DblClick; override;
|
|
|
- procedure DoScroll(Sender: TGLSMemoScrollBar; ByValue: integer); override;
|
|
|
- procedure DoScrollPage(Sender: TGLSMemoScrollBar; ByValue: integer); override;
|
|
|
- property VisiblePosCount: integer index 0 read GetVisible;
|
|
|
- property VisibleLineCount: integer index 1 read GetVisible;
|
|
|
- property LastVisiblePos: integer index 2 read GetVisible;
|
|
|
- property LastVisibleLine: integer index 3 read GetVisible;
|
|
|
- procedure DeleteSelection(bRepaint: Boolean);
|
|
|
- procedure Changed(FromLine, ToLine: integer); virtual;
|
|
|
- procedure AttrChanged(LineNo: integer); virtual;
|
|
|
- procedure SelectionChanged; virtual;
|
|
|
- procedure StatusChanged; virtual;
|
|
|
- procedure ClearUndoList;
|
|
|
- procedure UndoChange;
|
|
|
- property AutoIndent: Boolean read FAutoIndent write FAutoIndent;
|
|
|
- property GutterWidth: integer read FGutterWidth write SetGutterWidth;
|
|
|
- property GutterColor: TColor read GetGutterColor write SetGutterColor;
|
|
|
- property ScrollBars: System.UITypes.TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
|
|
|
- property Font: TFont read FFont write SetFont;
|
|
|
- property ReadOnly: Boolean read FReadOnly write FReadOnly;
|
|
|
- property Lines: TStrings read FLines write SetLines;
|
|
|
- property BkColor: TColor index 0 read FBkColor write SetColor;
|
|
|
- property SelColor: TColor index 1 read FSelColor write SetColor;
|
|
|
- property SelBkColor: TColor index 2 read FSelBkColor write SetColor;
|
|
|
- property HiddenCaret: Boolean read FHiddenCaret write SetHiddenCaret;
|
|
|
- property TabSize: integer read FTabSize write FTabSize;
|
|
|
- property ScrollMode: TScrollMode read FScrollMode write FScrollMode default smAuto;
|
|
|
- property UndoLimit: integer read FUndoLimit write SetUndoLimit;
|
|
|
- property HideCursor: Boolean read FHideCursor write FHideCursor;
|
|
|
- property InComment[Index: integer]: Boolean read GetInComment write SetInComment;
|
|
|
- property InBrackets[Index: integer]: integer read GetInBrackets write SetInBrackets;
|
|
|
- property ValidAttrs[Index: integer]: Boolean read GetValidAttrs write SetValidAttrs;
|
|
|
- property CharAttrs[Index: integer]: string read GetCharAttrs write SetCharAttrs;
|
|
|
- {events}
|
|
|
- property OnGutterClick: TGutterClickEvent read FOnGutterClick write FOnGutterClick;
|
|
|
- property OnGutterDraw: TGutterDrawEvent read FOnGutterDraw write FOnGutterDraw;
|
|
|
- property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
|
- property OnMoveCursor: TNotifyEvent read FOnMoveCursor write FOnMoveCursor;
|
|
|
- property OnAttrChange: TNotifyEvent read FOnAttrChange write FOnAttrChange;
|
|
|
- property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
|
|
|
- property OnStatusChange: TNotifyEvent read FOnStatusChange write FOnStatusChange;
|
|
|
- property OnGetLineAttrs: TGetLineAttrsEvent read FOnGetLineAttrs write FOnGetLineAttrs;
|
|
|
- property OnUndoChange: TUndoChangeEvent read FOnUndoChange write FOnUndoChange;
|
|
|
- public
|
|
|
- constructor Create(AOwner: TComponent); override;
|
|
|
- destructor Destroy; override;
|
|
|
- procedure CopyToClipBoard;
|
|
|
- procedure PasteFromClipBoard;
|
|
|
- procedure CutToClipBoard;
|
|
|
- procedure SelectLines(StartLine, EndLine: Integer);
|
|
|
- procedure SelectAll;
|
|
|
- property SelStart: TPoint read GetSelStart;
|
|
|
- property SelEnd: TPoint read GetSelEnd;
|
|
|
- property Selection: string read GetSelText write SetSelText;
|
|
|
- property SelLength: integer read GetSelLength;
|
|
|
- procedure ClearSelection;
|
|
|
- procedure Clear;
|
|
|
- procedure SetCursor(ACurX, ACurY: Integer);
|
|
|
- function SelectLine(LineNo, StyleNo: Integer): integer;
|
|
|
- procedure SelectChar(LineNo, Pos, StyleNo: Integer);
|
|
|
- function CellFromPos(X, Y: integer): TCellPos;
|
|
|
- function CharFromPos(X, Y: integer): TFullPos;
|
|
|
- function CellRect(ACol, ARow: integer): TRect;
|
|
|
- function LineRect(ARow: integer): TRect;
|
|
|
- function ColRect(ACol: integer): TRect;
|
|
|
- function CharStyleNo(LineNo, Pos: integer): integer;
|
|
|
- procedure InsertTemplate(AText: string);
|
|
|
- procedure UnSelectChar;
|
|
|
- procedure Undo;
|
|
|
- procedure Redo;
|
|
|
- function CanUndo: Boolean;
|
|
|
- function CanRedo: Boolean;
|
|
|
- function FindText(Text: string; Options: TFindOptions; Select: Boolean): Boolean;
|
|
|
- property CurX: integer read FCurX write SetCurX;
|
|
|
- property CurY: integer read FCurY write SetCurY;
|
|
|
- property DelErase: Boolean read FDelErase write FDelErase;
|
|
|
- property LineStyle[Index: integer]: integer read GetLineStyle write
|
|
|
- SetLineStyle;
|
|
|
- property Styles: TStyleList read FStyles;
|
|
|
- property UndoList: TGLSMemoUndoList read FUndoList write FUndoList;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMemo = class(TGLSCustomMemo)
|
|
|
- published
|
|
|
- {TControl }
|
|
|
- property PopupMenu;
|
|
|
- {TCustomControl }
|
|
|
- property Align;
|
|
|
- property Enabled;
|
|
|
- property ShowHint;
|
|
|
- property TabOrder;
|
|
|
- property TabStop;
|
|
|
- property Visible;
|
|
|
- property ReadOnly;
|
|
|
- {TGLSCustomMemo }
|
|
|
- property AutoIndent;
|
|
|
- property GutterColor;
|
|
|
- property GutterWidth;
|
|
|
- property ScrollBars;
|
|
|
- property Font;
|
|
|
- property BkColor;
|
|
|
- property Selection;
|
|
|
- property SelColor;
|
|
|
- property SelBkColor;
|
|
|
- property Lines;
|
|
|
- property HiddenCaret;
|
|
|
- property TabSize;
|
|
|
- property ScrollMode;
|
|
|
- property UndoLimit;
|
|
|
- property DelErase;
|
|
|
- {Inherited events }
|
|
|
- property OnClick;
|
|
|
- property OnDblClick;
|
|
|
- property OnDragDrop;
|
|
|
- property OnDragOver;
|
|
|
- property OnEndDrag;
|
|
|
- property OnMouseDown;
|
|
|
- property OnMouseMove;
|
|
|
- property OnMouseUp;
|
|
|
- property OnStartDrag;
|
|
|
- property OnEnter;
|
|
|
- property OnExit;
|
|
|
- property OnKeyDown;
|
|
|
- property OnKeyPress;
|
|
|
- property OnKeyUp;
|
|
|
- {Events }
|
|
|
- property OnGutterDraw;
|
|
|
- property OnGutterClick;
|
|
|
- property OnChange;
|
|
|
- property OnMoveCursor;
|
|
|
- property OnAttrChange;
|
|
|
- property OnSelectionChange;
|
|
|
- property OnStatusChange;
|
|
|
- property OnGetLineAttrs;
|
|
|
- property OnUndoChange;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMemoStringList = class(TStringList)
|
|
|
- private
|
|
|
- procedure ReadStrings(Reader: TReader);
|
|
|
- procedure WriteStrings(Writer: TWriter);
|
|
|
- protected
|
|
|
- procedure DefineProperties(Filer: TFiler); override;
|
|
|
- end;
|
|
|
-
|
|
|
- TDelimiters = TSysCharSet;
|
|
|
- TTokenType =
|
|
|
- (
|
|
|
- ttWord,
|
|
|
- ttBracket,
|
|
|
- ttSpecial,
|
|
|
- ttDelimiter,
|
|
|
- ttSpace,
|
|
|
- ttEOL,
|
|
|
- ttInteger,
|
|
|
- ttFloat,
|
|
|
- ttComment,
|
|
|
- ttOther,
|
|
|
- ttWrongNumber);
|
|
|
-
|
|
|
- //--------------------------------------------------------------
|
|
|
- // SYNTAX MEMO - declaration
|
|
|
- //--------------------------------------------------------------
|
|
|
- TGLSSynHiMemo = class(TGLSCustomMemo)
|
|
|
- private
|
|
|
-
|
|
|
- FIsPainting: Boolean;
|
|
|
- FInComment: Boolean;
|
|
|
-
|
|
|
- FWordList: TGLSMemoStringList;
|
|
|
- FSpecialList: TGLSMemoStringList;
|
|
|
- FBracketList: TGLSMemoStringList;
|
|
|
- FDelimiters: TDelimiters;
|
|
|
- FInBrackets: integer;
|
|
|
- FLineComment: string;
|
|
|
- FMultiCommentLeft: string;
|
|
|
- FMultiCommentRight: string;
|
|
|
- FDelimiterStyle: TCharStyle;
|
|
|
- FCommentStyle: TCharStyle;
|
|
|
- FNumberStyle: TCharStyle;
|
|
|
- FDelimiterStyleNo,
|
|
|
- FCommentStyleNo,
|
|
|
- FNumberStyleNo: integer;
|
|
|
- FCaseSensitive: Boolean;
|
|
|
- function GetToken(const S: string; var From: integer;
|
|
|
- out TokenType: TTokenType; out StyleNo: integer): string;
|
|
|
- procedure SetWordList(Value: TGLSMemoStringList);
|
|
|
- procedure SetSpecialList(Value: TGLSMemoStringList);
|
|
|
- procedure SetBracketList(Value: TGLSMemoStringList);
|
|
|
- procedure FindLineAttrs(Sender: TObject; LineNo: integer; var Attrs:
|
|
|
- string);
|
|
|
- procedure SetStyle(Index: integer; Value: TCharStyle);
|
|
|
- procedure SetCaseSensitive(Value: Boolean);
|
|
|
- protected
|
|
|
- procedure Paint; override;
|
|
|
- public
|
|
|
- constructor Create(AOwner: TComponent); override;
|
|
|
- destructor Destroy; override;
|
|
|
- procedure AddWord(StyleNo: integer; const ArrS: array of string);
|
|
|
- procedure AddSpecial(StyleNo: integer; const ArrS: array of string);
|
|
|
- procedure AddBrackets(StyleNo: integer; const ArrS: array of string);
|
|
|
- property Delimiters: TDelimiters read FDelimiters write FDelimiters;
|
|
|
- published
|
|
|
- {TControl}
|
|
|
- property PopupMenu;
|
|
|
- {TCustomControl}
|
|
|
- property Align;
|
|
|
- property Enabled;
|
|
|
- property ShowHint;
|
|
|
- property TabOrder;
|
|
|
- property TabStop;
|
|
|
- property Visible;
|
|
|
- property ReadOnly;
|
|
|
- {TGLSCustomMemo}
|
|
|
- property AutoIndent;
|
|
|
- property GutterColor;
|
|
|
- property GutterWidth;
|
|
|
- property ScrollBars;
|
|
|
- property Font;
|
|
|
- property BkColor;
|
|
|
- property SelColor;
|
|
|
- property SelBkColor;
|
|
|
- property Lines;
|
|
|
- property HiddenCaret;
|
|
|
- property TabSize;
|
|
|
- property ScrollMode;
|
|
|
- property UndoLimit;
|
|
|
- property DelErase;
|
|
|
- {Inherited events }
|
|
|
- property OnClick;
|
|
|
- property OnDblClick;
|
|
|
- property OnDragDrop;
|
|
|
- property OnDragOver;
|
|
|
- property OnEndDrag;
|
|
|
- property OnMouseDown;
|
|
|
- property OnMouseMove;
|
|
|
- property OnMouseUp;
|
|
|
- property OnStartDrag;
|
|
|
- property OnEnter;
|
|
|
- property OnExit;
|
|
|
- property OnKeyDown;
|
|
|
- property OnKeyPress;
|
|
|
- property OnKeyUp;
|
|
|
- {Events }
|
|
|
- property OnGutterClick;
|
|
|
- property OnGutterDraw;
|
|
|
- property OnChange;
|
|
|
- property OnMoveCursor;
|
|
|
- property OnSelectionChange;
|
|
|
- property OnStatusChange;
|
|
|
- property OnUndoChange;
|
|
|
- {TGLSSyntaxMemo }
|
|
|
- property LineComment: string read FLineComment write FLineComment;
|
|
|
- property MultiCommentLeft: string read FMultiCommentLeft write FMultiCommentLeft;
|
|
|
- property MultiCommentRight: string read FMultiCommentRight write FMultiCommentRight;
|
|
|
- property WordList: TGLSMemoStringList read FWordList write SetWordList;
|
|
|
- property SpecialList: TGLSMemoStringList read FSpecialList write SetSpecialList;
|
|
|
- property BracketList: TGLSMemoStringList read FBracketList write SetBracketList;
|
|
|
- property DelimiterStyle: TCharStyle index 0 read FDelimiterStyle write SetStyle;
|
|
|
- property CommentStyle: TCharStyle index 1 read FCommentStyle write SetStyle;
|
|
|
- property NumberStyle: TCharStyle index 2 read FNumberStyle write SetStyle;
|
|
|
- property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
|
|
|
- end;
|
|
|
-
|
|
|
-procedure Border(Canvas: TCanvas; const rct: TRect; BorderType: TBorderType);
|
|
|
-
|
|
|
-//==========================================================
|
|
|
-implementation
|
|
|
-//==========================================================
|
|
|
-
|
|
|
-const
|
|
|
- cmDelete = VK_DELETE;
|
|
|
- cmBackSpace = VK_BACK;
|
|
|
- cmWordBackSpace = 127; // Ctrl-BackSpace
|
|
|
- cmNewLine = VK_RETURN;
|
|
|
- cmHome = VK_HOME;
|
|
|
- cmEnd = VK_END;
|
|
|
- cmPageUp = VK_PRIOR;
|
|
|
- cmPageDown = VK_NEXT;
|
|
|
- cmInsert = VK_INSERT;
|
|
|
- cmDelLine = 25; // Ctrl-Y
|
|
|
- cmCopy = 3; // Ctrl-C
|
|
|
- cmCut = 24; // Ctrl-X
|
|
|
- cmPaste = 22; // Ctrl-V
|
|
|
-
|
|
|
-resourcestring
|
|
|
- SObjectsNotSupported = 'Linked object not supported';
|
|
|
-
|
|
|
-var
|
|
|
- bmScrollBarFill: TBitmap;
|
|
|
- bmScrollBarUp: TBitmap;
|
|
|
- bmScrollBarDown: TBitmap;
|
|
|
- bmScrollBarLeft: TBitmap;
|
|
|
- bmScrollBarRight: TBitmap;
|
|
|
-
|
|
|
- fIntelliWheelSupport: Boolean; // True if IntelliMouse + wheel enabled
|
|
|
- fIntelliMessage: UINT; // message sent from mouse on wheel roll
|
|
|
- fIntelliScrollLines: Integer; // number of lines to scroll per wheel roll
|
|
|
-
|
|
|
-// ---------------------Helper functions
|
|
|
-
|
|
|
-function PointInRect(const P: TPoint; const rct: TRect): Boolean; inline;
|
|
|
-begin
|
|
|
- with rct do
|
|
|
- Result := (Left <= P.X) and (Top <= P.Y) and
|
|
|
- (Right >= P.X) and (Bottom >= P.Y);
|
|
|
-end;
|
|
|
-
|
|
|
-procedure Swap(var I1, I2: integer); inline;
|
|
|
-var
|
|
|
- temp: integer;
|
|
|
-begin
|
|
|
- temp := I1;
|
|
|
- I1 := I2;
|
|
|
- I2 := temp;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure OrderPos(var StartX, StartY, EndX, EndY: integer); inline;
|
|
|
-begin
|
|
|
- if (EndY < StartY) or
|
|
|
- ((EndY = StartY) and (EndX < StartX)) then
|
|
|
- begin
|
|
|
- Swap(StartX, EndX);
|
|
|
- Swap(StartY, EndY);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TotalRect(const rct1, rct2: TRect): TRect; inline;
|
|
|
-begin
|
|
|
- Result := rct1;
|
|
|
- with Result do
|
|
|
- begin
|
|
|
- if rct2.Left < Left then
|
|
|
- Left := rct2.Left;
|
|
|
- if rct2.Top < Top then
|
|
|
- Top := rct2.Top;
|
|
|
- if rct2.Right > Right then
|
|
|
- Right := rct2.Right;
|
|
|
- if rct2.Bottom > Bottom then
|
|
|
- Bottom := rct2.Bottom;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-// ---------------------TGLSCustomMemo functions
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.WndProc(var Message: TMessage);
|
|
|
- function GetShiftState: Integer;
|
|
|
- begin
|
|
|
- Result := 0;
|
|
|
- if GetAsyncKeyState(vk_Shift) < 0 then
|
|
|
- Result := Result or mk_Shift;
|
|
|
- if GetAsyncKeyState(vk_Control) < 0 then
|
|
|
- Result := Result or mk_Control;
|
|
|
- if GetAsyncKeyState(vk_LButton) < 0 then
|
|
|
- Result := Result or mk_LButton;
|
|
|
- if GetAsyncKeyState(vk_RButton) < 0 then
|
|
|
- Result := Result or mk_RButton;
|
|
|
- if GetAsyncKeyState(vk_MButton) < 0 then
|
|
|
- Result := Result or mk_MButton;
|
|
|
- end;
|
|
|
- //---------------------------------------------------
|
|
|
-begin
|
|
|
- if (Message.Msg = fIntelliMessage) and (fIntelliMessage <> wm_MouseWheel) then
|
|
|
- begin
|
|
|
- PostMessage(Handle, wm_MouseWheel, MakeLong(GetShiftState, Message.wParam),
|
|
|
- Message.lParam);
|
|
|
- end
|
|
|
- else
|
|
|
- inherited;
|
|
|
-end;
|
|
|
-
|
|
|
-//------------------------------------------------
|
|
|
-// INTELLIMOUSE INIT
|
|
|
-//------------------------------------------------
|
|
|
-
|
|
|
-procedure IntelliMouseInit;
|
|
|
-var
|
|
|
- hWndMouse: hWnd;
|
|
|
- mQueryScrollLines: UINT;
|
|
|
- //--------------------------------------------
|
|
|
- function NativeMouseWheelSupport: Boolean;
|
|
|
- var
|
|
|
- ver: TOSVersionInfo;
|
|
|
- begin
|
|
|
- Result := False;
|
|
|
- ver.dwOSVersionInfoSize := sizeof(ver);
|
|
|
- // For Windows 98, assume dwMajorVersion = 5 (It's 4 for W95)
|
|
|
- // For NT, we need 4.0 or better.
|
|
|
- if GetVersionEx(ver) then
|
|
|
- case ver.dwPlatformID of
|
|
|
- ver_Platform_Win32_Windows: Result := ver.dwMajorVersion >= 5;
|
|
|
- ver_Platform_Win32_NT: Result := ver.dwMajorVersion >= 4;
|
|
|
- end;
|
|
|
- { Quick and dirty temporary hack for Windows 98 beta 3 }
|
|
|
- if (not Result) and (ver.szCSDVersion = ' Beta 3') then
|
|
|
- Result := True;
|
|
|
- end;
|
|
|
- //--------------------------------------------
|
|
|
-begin
|
|
|
- if NativeMouseWheelSupport then
|
|
|
- begin
|
|
|
- fIntelliWheelSupport := Boolean(GetSystemMetrics(sm_MouseWheelPresent));
|
|
|
- SystemParametersInfo(spi_GetWheelScrollLines, 0, @fIntelliScrollLines, 0);
|
|
|
- fIntelliMessage := wm_MouseWheel;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { Look for hidden mouse window }
|
|
|
- hWndMouse := FindWindow('MouseZ', 'Magellan MSWHEEL');
|
|
|
- if hWndMouse <> 0 then
|
|
|
- begin
|
|
|
- { We're in business - get the scroll line info }
|
|
|
- fIntelliWheelSupport := True;
|
|
|
- mQueryScrollLines := RegisterWindowMessage('MSH_SCROLL_LINES_MSG');
|
|
|
- fIntelliScrollLines := SendMessage(hWndMouse, mQueryScrollLines, 0, 0);
|
|
|
- { Finally, get the custom mouse message as well }
|
|
|
- fIntelliMessage := RegisterWindowMessage('MSWHEEL_ROLLMSG');
|
|
|
- end;
|
|
|
- end;
|
|
|
- if (fIntelliScrollLines < 0) or (fIntelliScrollLines > 100) then
|
|
|
- fIntelliScrollLines := 3;
|
|
|
-end;
|
|
|
-
|
|
|
-//------------------------------------------------
|
|
|
-// WM MOUSE WHEEL
|
|
|
-//------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.WMMouseWheel(var Message: TMessage);
|
|
|
-{$J+}
|
|
|
-{$IFOPT R+} {$DEFINE StoreRangeCheck} {$ENDIF} {$R-}
|
|
|
-const
|
|
|
- Delta: SmallInt = 0;
|
|
|
-begin
|
|
|
- Delta := Delta + SmallInt(HiWord(Message.wParam));
|
|
|
- while Abs(Delta) >= 120 do
|
|
|
- begin
|
|
|
- if Delta < 0 then
|
|
|
- begin
|
|
|
- DoScroll(sbVert, fIntelliScrollLines);
|
|
|
- Delta := Delta + 120;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- DoScroll(sbVert, -fIntelliScrollLines);
|
|
|
- Delta := Delta - 120;
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-{$J-}
|
|
|
-{$IFDEF StoreRangeCheck} {$R+} {$UNDEF StoreRangeCheck} {$ENDIF}
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SET CURSOR
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetCursor(ACurX, ACurY: Integer);
|
|
|
-begin
|
|
|
- ClearSelection;
|
|
|
- CurX := 0;
|
|
|
- CurY := ACurY;
|
|
|
- CurX := ACurX;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SELECT LINE, CHAR
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.SelectLine(LineNo, StyleNo: Integer): integer;
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
-begin
|
|
|
- Result := LineStyle[LineNo];
|
|
|
- LineStyle[LineNo] := StyleNo;
|
|
|
- rct := LineRect(LineNo);
|
|
|
- InvalidateRect(Handle, @rct, True);
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SelectLines(StartLine, EndLine: Integer);
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
-begin
|
|
|
- FSelStartX := 0;
|
|
|
- FSelStartY := StartLine;
|
|
|
- FSelEndX := Length(Lines[EndLine]);
|
|
|
- FSelEndY := EndLine;
|
|
|
- rct := LineRangeRect(FSelStartY, FSelEndY);
|
|
|
- SelectionChanged;
|
|
|
- InvalidateRect(Handle, @rct, true);
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SelectChar(LineNo, Pos, StyleNo: Integer);
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
-begin
|
|
|
- UnselectChar;
|
|
|
- FSelCharPos.LineNo := LineNo;
|
|
|
- FSelCharPos.Pos := Pos;
|
|
|
- FSelCharStyle := StyleNo;
|
|
|
- rct := LineRect(LineNo);
|
|
|
- InvalidateRect(Handle, @rct, True);
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.UnSelectChar;
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
-begin
|
|
|
- with FSelCharPos do
|
|
|
- begin
|
|
|
- if LineNo < 0 then
|
|
|
- Exit;
|
|
|
- rct := LineRect(LineNo);
|
|
|
- LineNo := -1;
|
|
|
- Pos := -1;
|
|
|
- end;
|
|
|
- FSelCharStyle := -1;
|
|
|
- InvalidateRect(Handle, @rct, True);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// CLEAR
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.Clear;
|
|
|
-begin
|
|
|
- CurY := 0;
|
|
|
- CurX := 0;
|
|
|
- FLeftCol := 0;
|
|
|
- FTopLine := 0;
|
|
|
- Lines.Clear;
|
|
|
- TGLSMemoStrings(Lines).DoAdd('');
|
|
|
- ClearUndoList;
|
|
|
- Invalidate;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SELECT ALL
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SelectAll;
|
|
|
-begin
|
|
|
- FSelStartY := 0;
|
|
|
- FSelStartX := 0;
|
|
|
- FSelEndY := Lines.Count - 1;
|
|
|
- FSelEndX := Length(Lines[Lines.Count - 1]);
|
|
|
- Invalidate;
|
|
|
-end;
|
|
|
-
|
|
|
-//-----------------------------------------------------------
|
|
|
-// SET CLIPBOARD CODE PAGE
|
|
|
-//-----------------------------------------------------------
|
|
|
-
|
|
|
-procedure SetClipboardCodePage(const CodePage: longint);
|
|
|
-var
|
|
|
- Data: THandle;
|
|
|
- DataPtr: Pointer;
|
|
|
-begin
|
|
|
- // Define new code page for clipboard
|
|
|
- Data := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, 4);
|
|
|
- try
|
|
|
- DataPtr := GlobalLock(Data);
|
|
|
- try
|
|
|
- Move(CodePage, DataPtr^, 4);
|
|
|
- SetClipboardData(CF_LOCALE, Data);
|
|
|
- finally
|
|
|
- GlobalUnlock(Data);
|
|
|
- end;
|
|
|
- except
|
|
|
- GlobalFree(Data);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// COPY TO CLIPBOARD
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure CopyStringToClipboard(const Value: string);
|
|
|
-const
|
|
|
- RusLocale = (SUBLANG_DEFAULT shl $A) or LANG_RUSSIAN;
|
|
|
-begin
|
|
|
- Clipboard.Open;
|
|
|
- SetClipboardCodePage(RusLocale);
|
|
|
- try
|
|
|
- Clipboard.AsText := Value;
|
|
|
- finally
|
|
|
- SetClipboardCodePage(RusLocale);
|
|
|
- Clipboard.Close;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.CopyToClipBoard;
|
|
|
-begin
|
|
|
- CopyStringToClipboard(GetSelText);
|
|
|
-end;
|
|
|
-//--------------------------------------------------------------
|
|
|
-// PASTE FROM CLIPBOARD
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.PasteFromClipBoard;
|
|
|
-var
|
|
|
- H, len: integer;
|
|
|
- Buff: string;
|
|
|
-begin
|
|
|
- H := ClipBoard.GetAsHandle(CF_TEXT);
|
|
|
- len := GlobalSize(H);
|
|
|
- if len = 0 then
|
|
|
- Exit;
|
|
|
-
|
|
|
- SetLength(Buff, len);
|
|
|
- SetLength(Buff, ClipBoard.GetTextBuf(PChar(Buff), len));
|
|
|
- AdjustLineBreaks(Buff);
|
|
|
-
|
|
|
- SetSelText(Buff);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// DELETE SELECTION
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.DeleteSelection(bRepaint: Boolean);
|
|
|
-var
|
|
|
- xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
|
|
|
- i, len: integer;
|
|
|
- OldX, OldY: integer;
|
|
|
- S1, S2, S, AddSpaces: string;
|
|
|
- Undo: TGLSMemoDeleteBufUndo;
|
|
|
-begin
|
|
|
- if (FSelStartY = FSelEndY) and (FSelStartX = FSelEndX) then
|
|
|
- Exit;
|
|
|
-
|
|
|
- OldX := CurX;
|
|
|
- OldY := CurY;
|
|
|
- xSelStartX := FSelStartX;
|
|
|
- xSelStartY := FSelStartY;
|
|
|
- xSelEndX := FSelEndX;
|
|
|
- xSelEndY := FSelEndY;
|
|
|
- OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
|
|
|
-
|
|
|
- if xSelStartY = xSelEndY then
|
|
|
- begin
|
|
|
- S1 := Copy(Lines[xSelStartY], xSelStartX + 1, xSelEndX - xSelStartX);
|
|
|
- S2 := '';
|
|
|
- AddSpaces := '';
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- len := Length(Lines[xSelStartY]);
|
|
|
- S1 := Copy(Lines[xSelStartY], xSelStartX + 1, len);
|
|
|
- AddSpaces := StringOfChar(' ', xSelStartX - len);
|
|
|
- S2 := Copy(Lines[xSelEndY], 1, xSelEndX);
|
|
|
- end;
|
|
|
- Lines[xSelStartY] := Copy(Lines[xSelStartY], 1, xSelStartX) + AddSpaces +
|
|
|
- Copy(Lines[xSelEndY], xSelEndX + 1, Length(Lines[xSelEndY]));
|
|
|
- S := S1;
|
|
|
- for i := xSelStartY + 1 to xSelEndY do
|
|
|
- begin
|
|
|
- S := S + #13#10;
|
|
|
- if i <> xSelEndY then
|
|
|
- S := S + Lines[xSelStartY + 1];
|
|
|
- DeleteLine(xSelStartY + 1, -1, -1, -1, -1, False);
|
|
|
- end;
|
|
|
- S := S + S2;
|
|
|
-
|
|
|
- CurY := xSelStartY;
|
|
|
- CurX := xSelStartX;
|
|
|
- ClearSelection;
|
|
|
-
|
|
|
- Changed(xSelStartY, -1);
|
|
|
- SelectionChanged;
|
|
|
- if bRepaint then
|
|
|
- Invalidate;
|
|
|
-
|
|
|
- Undo := TGLSMemoDeleteBufUndo.Create(OldX, OldY, CurX, CurY, S);
|
|
|
- Undo.UndoSelStartX := xSelStartX;
|
|
|
- Undo.UndoSelStartY := xSelStartY;
|
|
|
- Undo.UndoSelEndX := xSelEndX;
|
|
|
- Undo.UndoSelEndY := xSelEndY;
|
|
|
- if Assigned(FUndoList) then
|
|
|
- FUndoList.Add(Undo);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// CUT TO CLIPBOARD
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.CutToClipBoard;
|
|
|
-begin
|
|
|
- ClipBoard.SetTextBuf(PChar(GetSelText));
|
|
|
- DeleteSelection(True);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// GET SEL TEXT
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.GetSelText: string;
|
|
|
-var
|
|
|
- i: integer;
|
|
|
- xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
|
|
|
-begin
|
|
|
- Result := '';
|
|
|
- if (FSelStartY = FSelEndY) and (FSelStartX = FSelEndX) then
|
|
|
- Exit;
|
|
|
-
|
|
|
- xSelStartX := FSelStartX;
|
|
|
- xSelStartY := FSelStartY;
|
|
|
- xSelEndX := FSelEndX;
|
|
|
- xSelEndY := FSelEndY;
|
|
|
- OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
|
|
|
-
|
|
|
- if xSelStartY = xSelEndY then
|
|
|
- Result := Copy(Lines[xSelStartY], xSelStartX + 1, xSelEndX - xSelStartX)
|
|
|
- else
|
|
|
- begin
|
|
|
- Result := Copy(Lines[xSelStartY], xSelStartX + 1,
|
|
|
- Length(Lines[xSelStartY]));
|
|
|
- for i := xSelStartY + 1 to xSelEndY - 1 do
|
|
|
- Result := Result + #13#10 + Lines[i];
|
|
|
- Result := Result + #13#10 + Copy(Lines[xSelEndY], 1, xSelEndX);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// GET SEL START
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.GetSelStart: TPoint;
|
|
|
-var
|
|
|
- xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
|
|
|
-begin
|
|
|
- xSelStartX := FSelStartX;
|
|
|
- xSelStartY := FSelStartY;
|
|
|
- xSelEndX := FSelEndX;
|
|
|
- xSelEndY := FSelEndY;
|
|
|
- OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
|
|
|
- Result := Point(xSelStartX, xSelStartY);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// GET SEL END
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.GetSelEnd: TPoint;
|
|
|
-var
|
|
|
- xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
|
|
|
-begin
|
|
|
- xSelStartX := FSelStartX;
|
|
|
- xSelStartY := FSelStartY;
|
|
|
- xSelEndX := FSelEndX;
|
|
|
- xSelEndY := FSelEndY;
|
|
|
- OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
|
|
|
- Result := Point(xSelEndX, xSelEndY);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SET SEL TEXT
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetSelText(const AValue: string);
|
|
|
-var
|
|
|
- i, k: integer;
|
|
|
- xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
|
|
|
- Buff, S: string;
|
|
|
- OldX, OldY: integer;
|
|
|
-begin
|
|
|
- Buff := AValue;
|
|
|
- xSelStartX := FSelStartX;
|
|
|
- xSelStartY := FSelStartY;
|
|
|
- xSelEndX := FSelEndX;
|
|
|
- xSelEndY := FSelEndY;
|
|
|
- OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
|
|
|
-
|
|
|
- DeleteSelection(False);
|
|
|
-
|
|
|
- OldX := CurX;
|
|
|
- OldY := CurY;
|
|
|
- i := Pos(#13#10, Buff);
|
|
|
- S := Lines[xSelStartY];
|
|
|
- if i = 0 then
|
|
|
- begin
|
|
|
- Lines[xSelStartY] := Copy(S, 1, xSelStartX) + Buff
|
|
|
- + Copy(S, xSelStartX + 1, Length(S));
|
|
|
- CurX := xSelStartX;
|
|
|
- if Buff <> '' then
|
|
|
- CurX := CurX + Length(Buff);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- k := xSelStartY;
|
|
|
- Lines[k] := Copy(S, 1, xSelStartX) + Copy(Buff, 1, i - 1);
|
|
|
- TGLSMemoStrings(Lines).DoInsert(k + 1, Copy(S, xSelStartX + 1, Length(S)));
|
|
|
- while True do
|
|
|
- begin
|
|
|
- Buff := Copy(Buff, i + 2, Length(Buff));
|
|
|
- i := Pos(#13#10, Buff);
|
|
|
- k := k + 1;
|
|
|
- if i = 0 then
|
|
|
- break;
|
|
|
- TGLSMemoStrings(Lines).DoInsert(k, Copy(Buff, 1, i - 1));
|
|
|
- end;
|
|
|
- Lines[k] := Buff + Lines[k];
|
|
|
- CurY := k;
|
|
|
- CurX := Length(Buff);
|
|
|
- end;
|
|
|
-
|
|
|
- ClearSelection;
|
|
|
- Changed(xSelStartY, -1);
|
|
|
- if Assigned(FUndoList) then
|
|
|
- FUndoList.Add(TGLSMemoPasteUndo.Create(OldX, OldY, CurX, CurY, AValue));
|
|
|
- Invalidate;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// GET SEL LENGTH
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.GetSelLength: integer;
|
|
|
-begin
|
|
|
- Result := Length(GetSelText);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// CHANGED
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.Changed(FromLine, ToLine: integer);
|
|
|
-var
|
|
|
- i: integer;
|
|
|
-begin
|
|
|
- if ToLine < FromLine then
|
|
|
- ToLine := Lines.Count - 1;
|
|
|
- for i := FromLine to ToLine do
|
|
|
- ValidAttrs[i] := False;
|
|
|
- InvalidateLineRange(FromLine, ToLine);
|
|
|
- if Assigned(FOnChange) then
|
|
|
- FOnChange(Self);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// ATTR CHANGED
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.AttrChanged(LineNo: integer);
|
|
|
-begin
|
|
|
- ValidAttrs[LineNo] := False;
|
|
|
- InvalidateLineRange(LineNo, LineNo);
|
|
|
- if Assigned(FOnAttrChange) then
|
|
|
- FOnAttrChange(Self);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SELECTION CHANGED
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SelectionChanged;
|
|
|
-begin
|
|
|
- if Assigned(FOnSelectionChange) then
|
|
|
- FOnSelectionChange(Self);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// STATUS CHANGED
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.StatusChanged;
|
|
|
-begin
|
|
|
- if Assigned(FOnStatusChange) then
|
|
|
- FOnStatusChange(Self);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// CLEAR SELECTION
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.ClearSelection;
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
- Changed: Boolean;
|
|
|
-begin
|
|
|
- Changed := not ((FSelStartX = FSelEndX) and (FSelStartY = FSelEndY));
|
|
|
- rct := LineRangeRect(FSelStartY, FSelEndY);
|
|
|
- FSelStartX := CurX;
|
|
|
- FSelStartY := CurY;
|
|
|
- FSelEndX := CurX;
|
|
|
- FSelEndY := CurY;
|
|
|
- FPrevSelX := CurX;
|
|
|
- FPrevSelY := CurY;
|
|
|
- if Changed then
|
|
|
- begin
|
|
|
- SelectionChanged;
|
|
|
- InvalidateRect(Handle, @rct, true);
|
|
|
- end;
|
|
|
- if Assigned(FOnMoveCursor) then
|
|
|
- FOnMoveCursor(Self);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// EXPAND SELECTION
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.ExpandSelection;
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
-begin
|
|
|
- rct := LineRangeRect(FPrevSelY, CurY);
|
|
|
- FSelEndX := CurX;
|
|
|
- FSelEndY := CurY;
|
|
|
- FPrevSelX := CurX;
|
|
|
- FPrevSelY := CurY;
|
|
|
- SelectionChanged;
|
|
|
- InvalidateRect(Handle, @rct, true);
|
|
|
- if Assigned(FOnMoveCursor) then
|
|
|
- FOnMoveCursor(Self);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// MAX LENGTH
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.MaxLength: integer;
|
|
|
-var
|
|
|
- i, len: integer;
|
|
|
-begin
|
|
|
- Result := 0;
|
|
|
- for i := 0 to Lines.Count - 1 do
|
|
|
- begin
|
|
|
- len := Length(Lines[i]);
|
|
|
- if len > Result then
|
|
|
- Result := len;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// DO SCROLL
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.DoScroll(Sender: TGLSMemoScrollBar; ByValue: integer);
|
|
|
-var
|
|
|
- eRect, scrRect, sbRect: TRect;
|
|
|
- Old: integer;
|
|
|
-begin
|
|
|
- eRect := EditorRect;
|
|
|
- case Sender.Kind of
|
|
|
- sbVertical:
|
|
|
- begin
|
|
|
- Old := FTopLine;
|
|
|
- FTopLine := FTopLine + ByValue;
|
|
|
- if FTopLine > Sender.MaxPosition then
|
|
|
- FTopLine := Sender.MaxPosition;
|
|
|
- if FTopLine < 0 then
|
|
|
- FTopLine := 0;
|
|
|
- if Old <> FTopLine then
|
|
|
- begin
|
|
|
- ShowCaret(False);
|
|
|
- if CurY < FTopLine then
|
|
|
- CurY := FTopLine;
|
|
|
- if CurY > LastVisibleLine then
|
|
|
- CurY := LastVisibleLine;
|
|
|
-
|
|
|
- ScrollDC(Canvas.Handle, 0, (Old - FTopLine) * FCellSize.H,
|
|
|
- eRect, eRect, 0, @scrRect);
|
|
|
- InvalidateRect(Handle, @scrRect, True);
|
|
|
- sbRect := Sender.FullRect;
|
|
|
- InvalidateRect(Handle, @sbRect, True);
|
|
|
- FGutter.Invalidate;
|
|
|
- ShowCaret(True);
|
|
|
- end;
|
|
|
- end;
|
|
|
- sbHorizontal:
|
|
|
- begin
|
|
|
- Old := FLeftCol;
|
|
|
- FLeftCol := FLeftCol + ByValue;
|
|
|
- if FLeftCol > Sender.MaxPosition then
|
|
|
- FLeftCol := Sender.MaxPosition;
|
|
|
- if FLeftCol < 0 then
|
|
|
- FLeftCol := 0;
|
|
|
- if Old <> FLeftCol then
|
|
|
- begin
|
|
|
- ShowCaret(False);
|
|
|
- if CurX < FLeftCol then
|
|
|
- CurX := FLeftCol;
|
|
|
- if CurX > LastVisiblePos then
|
|
|
- CurX := LastVisiblePos;
|
|
|
- ScrollDC(Canvas.Handle, (Old - FLeftCol) * FCellSize.W, 0,
|
|
|
- eRect, eRect, 0, @scrRect);
|
|
|
- InvalidateRect(Handle, @scrRect, True);
|
|
|
- sbRect := Sender.FullRect;
|
|
|
- InvalidateRect(Handle, @sbRect, True);
|
|
|
- ShowCaret(True);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// DO SCROLL PAGE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.DoScrollPage(Sender: TGLSMemoScrollBar; ByValue:
|
|
|
- integer);
|
|
|
-begin
|
|
|
- case Sender.Kind of
|
|
|
- sbVertical: DoScroll(Sender, ByValue * VisibleLineCount);
|
|
|
- sbHorizontal: DoScroll(Sender, ByValue * VisiblePosCount);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SET LINES
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetLines(ALines: TStrings);
|
|
|
-begin
|
|
|
- if ALines <> nil then
|
|
|
- begin
|
|
|
- FLines.Assign(ALines);
|
|
|
- Changed(0, -1);
|
|
|
- SelectionChanged;
|
|
|
- Invalidate;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SET/GET LINE STYLE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetLineStyle(Index: integer; Value: integer);
|
|
|
-begin
|
|
|
- TGLSMemoStrings(FLines).Style[Index] := Value;
|
|
|
- if IsLineVisible(Index) then
|
|
|
- AttrChanged(Index);
|
|
|
-end;
|
|
|
-
|
|
|
-function TGLSCustomMemo.GetLineStyle(Index: integer): integer;
|
|
|
-begin
|
|
|
- Result := TGLSMemoStrings(FLines).Style[Index];
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// GET/SET IN COMMENT
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.GetInComment(Index: integer): Boolean;
|
|
|
-begin
|
|
|
- Result := TGLSMemoStrings(FLines).InComment[Index];
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetInComment(Index: integer; Value: Boolean);
|
|
|
-begin
|
|
|
- TGLSMemoStrings(FLines).InComment[Index] := Value;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// GET/SET IN BRACKETS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.GetInBrackets(Index: integer): integer;
|
|
|
-begin
|
|
|
- Result := TGLSMemoStrings(FLines).InBrackets[Index];
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetInBrackets(Index: integer; Value: integer);
|
|
|
-begin
|
|
|
- TGLSMemoStrings(FLines).InBrackets[Index] := Value;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// GET/SET VALID ATTRS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.GetValidAttrs(Index: integer): Boolean;
|
|
|
-begin
|
|
|
- Result := TGLSMemoStrings(FLines).ValidAttrs[Index];
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetValidAttrs(Index: integer; Value: Boolean);
|
|
|
-begin
|
|
|
- TGLSMemoStrings(FLines).ValidAttrs[Index] := Value;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// GET/SET CHAR ATTRS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.GetCharAttrs(Index: integer): string;
|
|
|
-begin
|
|
|
- Result := TGLSMemoStrings(FLines).CharAttrs[Index];
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetCharAttrs(Index: integer; const Value: string);
|
|
|
-begin
|
|
|
- TGLSMemoStrings(FLines).CharAttrs[Index] := Value;
|
|
|
- if IsLineVisible(Index) then
|
|
|
- AttrChanged(Index);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SET CUR X
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetCurX(Value: integer);
|
|
|
-var
|
|
|
- len: integer;
|
|
|
- WasVisible: Boolean;
|
|
|
-begin
|
|
|
- if Value < 0 then
|
|
|
- if CurY = 0 then
|
|
|
- Value := 0
|
|
|
- else
|
|
|
- begin
|
|
|
- CurY := CurY - 1;
|
|
|
- Value := Length(Lines[CurY]);
|
|
|
- end;
|
|
|
-
|
|
|
- if (CurY >= 0) and (CurY < Lines.Count) then
|
|
|
- begin
|
|
|
- len := Length(Lines[CurY]);
|
|
|
- if Value > len then
|
|
|
- begin
|
|
|
- Lines[CurY] := Lines[CurY] + StringOfChar(' ', Value - len);
|
|
|
- // Value := len;
|
|
|
- ValidAttrs[CurY] := False;
|
|
|
- InvalidateLineRange(CurY, CurY);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- FCurX := Value;
|
|
|
-
|
|
|
- WasVisible := FCaretVisible;
|
|
|
- if WasVisible then
|
|
|
- ShowCaret(False);
|
|
|
- MakeVisible;
|
|
|
- ResizeScrollBars;
|
|
|
- StatusChanged;
|
|
|
- if WasVisible then
|
|
|
- ShowCaret(True);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SET CUR Y
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetCurY(Value: integer);
|
|
|
-var
|
|
|
- Old: integer;
|
|
|
- WasVisible: Boolean;
|
|
|
-begin
|
|
|
- WasVisible := FCaretVisible;
|
|
|
- if WasVisible then
|
|
|
- ShowCaret(False);
|
|
|
- Old := CurY;
|
|
|
-
|
|
|
- if Value < 0 then
|
|
|
- Value := 0;
|
|
|
- if Value >= Lines.Count then
|
|
|
- Value := Lines.Count - 1;
|
|
|
-
|
|
|
- FCurY := Value;
|
|
|
- if (CurY <> Old) and (Old >= 0) and (Old < Lines.Count) then
|
|
|
- Lines[Old] := TrimRight(Lines[Old]);
|
|
|
- CurX := CurX;
|
|
|
-
|
|
|
- MakeVisible;
|
|
|
- ResizeScrollBars;
|
|
|
- StatusChanged;
|
|
|
- if WasVisible then
|
|
|
- ShowCaret(True);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// MOVE CURSOR
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.MoveCursor(dX, dY: integer; Shift: TShiftState);
|
|
|
-var
|
|
|
- Selecting: Boolean;
|
|
|
- //------------------------------------------------------------
|
|
|
- function IsDelimiter(c: char): Boolean;
|
|
|
- begin
|
|
|
- Result := Pos(c, ' .,;:/?!@#$%^&*(){}[]<>-+=|\') > 0;
|
|
|
- end;
|
|
|
- //------------------------------------------------------------
|
|
|
- function IsStopChar(c, cThis: char): Boolean;
|
|
|
- begin
|
|
|
- Result := IsDelimiter(c) <> IsDelimiter(cThis);
|
|
|
- end;
|
|
|
- //------------------------------------------------------------
|
|
|
- procedure MoveWordLeft;
|
|
|
- var
|
|
|
- S: string;
|
|
|
- begin
|
|
|
- CurX := CurX - 1;
|
|
|
- S := TrimRight(Lines[CurY]);
|
|
|
- while CurX > 0 do
|
|
|
- begin
|
|
|
- if IsStopChar(S[CurX], S[CurX + 1]) then
|
|
|
- break;
|
|
|
- CurX := CurX - 1;
|
|
|
- end;
|
|
|
- if (CurX < 0) then
|
|
|
- if CurY > 0 then
|
|
|
- begin
|
|
|
- CurY := CurY - 1;
|
|
|
- CurX := Length(Lines[CurY]);
|
|
|
- end;
|
|
|
- end;
|
|
|
- //------------------------------------------------------------
|
|
|
- procedure MoveWordRight;
|
|
|
- var
|
|
|
- Len: integer;
|
|
|
- S: string;
|
|
|
- begin
|
|
|
- S := TrimRight(Lines[CurY]);
|
|
|
- Len := Length(S);
|
|
|
- CurX := CurX + 1;
|
|
|
- while CurX < Len do
|
|
|
- begin
|
|
|
- if IsStopChar(S[CurX + 1], S[CurX]) then
|
|
|
- break;
|
|
|
- CurX := CurX + 1;
|
|
|
- end;
|
|
|
- if CurX > Len then
|
|
|
- if CurY < Lines.Count - 1 then
|
|
|
- begin
|
|
|
- CurY := CurY + 1;
|
|
|
- CurX := 0;
|
|
|
- end;
|
|
|
- end;
|
|
|
- //------------------------------------------------------------
|
|
|
-begin
|
|
|
- Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
|
|
|
- and (CurY = FPrevSelY);
|
|
|
- if ssCtrl in Shift then
|
|
|
- begin
|
|
|
- if dX > 0 then
|
|
|
- MoveWordRight;
|
|
|
- if dX < 0 then
|
|
|
- MoveWordLeft;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- CurY := CurY + dY;
|
|
|
- CurX := CurX + dX;
|
|
|
- end;
|
|
|
- if Selecting then
|
|
|
- ExpandSelection
|
|
|
- else
|
|
|
- ClearSelection;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// MOVE PAGE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.MovePage(dP: integer; Shift: TShiftState);
|
|
|
-var
|
|
|
- eRect: TRect;
|
|
|
- LinesPerPage: integer;
|
|
|
- Selecting: Boolean;
|
|
|
-begin
|
|
|
- if FCellSize.H = 0 then
|
|
|
- Exit;
|
|
|
- Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
|
|
|
- and (CurY = FPrevSelY);
|
|
|
- eRect := EditorRect;
|
|
|
- LinesPerPage := (eRect.Bottom - eRect.Top) div FCellSize.H - 1;
|
|
|
- CurY := CurY + dP * LinesPerPage;
|
|
|
- if ssCtrl in Shift then
|
|
|
- if dP > 0 then
|
|
|
- begin
|
|
|
- CurY := Lines.Count - 1;
|
|
|
- CurX := Length(Lines[Lines.Count - 1]);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- CurY := 0;
|
|
|
- CurX := 0;
|
|
|
- end;
|
|
|
- if Selecting then
|
|
|
- ExpandSelection
|
|
|
- else
|
|
|
- ClearSelection;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// GO HOME
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.GoHome(Shift: TShiftState);
|
|
|
-var
|
|
|
- Selecting: Boolean;
|
|
|
-begin
|
|
|
- Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
|
|
|
- and (CurY = FPrevSelY);
|
|
|
- CurX := 0;
|
|
|
- FLeftCol := 0;
|
|
|
- if Selecting then
|
|
|
- ExpandSelection
|
|
|
- else
|
|
|
- ClearSelection;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// GO END
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.GoEnd(Shift: TShiftState);
|
|
|
-var
|
|
|
- Selecting: Boolean;
|
|
|
- S, S1: string;
|
|
|
-begin
|
|
|
- Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
|
|
|
- and (CurY = FPrevSelY);
|
|
|
-
|
|
|
- S := Lines[CurY];
|
|
|
- if not Selecting then
|
|
|
- S := TrimRight(S);
|
|
|
- S1 := TrimRight(Copy(S, CurX + 1, Length(S)));
|
|
|
- S := Copy(S, 1, CurX);
|
|
|
- Lines[CurY] := S + S1;
|
|
|
-
|
|
|
- CurX := Length(Lines[CurY]);
|
|
|
- if Selecting then
|
|
|
- ExpandSelection
|
|
|
- else
|
|
|
- ClearSelection;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// INSERT CHAR
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.InsertChar(C: Char);
|
|
|
-var
|
|
|
- S, S1: string;
|
|
|
- NewPlace: integer;
|
|
|
- rct: TRect;
|
|
|
- CurX0, CurY0: integer;
|
|
|
-begin
|
|
|
- CurX0 := CurX;
|
|
|
- CurY0 := CurY;
|
|
|
- S := Lines[CurY];
|
|
|
- NewPlace := CurX + 1;
|
|
|
- if C = #9 then
|
|
|
- begin
|
|
|
- while (NewPlace mod TabSize) <> 0 do
|
|
|
- Inc(NewPlace);
|
|
|
- S1 := StringOfChar(' ', NewPlace - CurX);
|
|
|
- end
|
|
|
- else
|
|
|
- S1 := C;
|
|
|
- Insert(S1, S, CurX + 1);
|
|
|
- Lines[CurY] := S;
|
|
|
- CurX := NewPlace;
|
|
|
- ClearSelection;
|
|
|
- rct := LineRect(CurY);
|
|
|
- Changed(CurY, CurY);
|
|
|
-
|
|
|
- if Assigned(FUndoList) then
|
|
|
- FUndoList.Add(TGLSMemoInsCharUndo.Create(CurX0, CurY0, CurX, CurY, S1));
|
|
|
-
|
|
|
- InvalidateRect(Handle, @rct, True);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// INSERT TEMPLATE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.InsertTemplate(AText: string);
|
|
|
-var
|
|
|
- i, NewCurX, NewCurY: integer;
|
|
|
- Indent: string;
|
|
|
- FoundCursor: Boolean;
|
|
|
-begin
|
|
|
- Indent := IndentCurrLine;
|
|
|
-
|
|
|
- DeleteSelection(False);
|
|
|
- ClearSelection;
|
|
|
-
|
|
|
- NewCurX := CurX;
|
|
|
- NewCurY := CurY;
|
|
|
- FoundCursor := False;
|
|
|
- i := 1;
|
|
|
- while i <= Length(AText) do
|
|
|
- begin
|
|
|
- if AText[i] = #13 then
|
|
|
- begin
|
|
|
- if (i = Length(AText)) or (AText[i + 1] <> #10) then
|
|
|
- Insert(#10 + Indent, AText, i + 1);
|
|
|
- if not FoundCursor then
|
|
|
- begin
|
|
|
- Inc(NewCurY);
|
|
|
- NewCurX := Length(Indent);
|
|
|
- end;
|
|
|
- Inc(i, 1 + Length(Indent));
|
|
|
- end
|
|
|
- else if AText[i] = #7 then
|
|
|
- begin
|
|
|
- FoundCursor := True;
|
|
|
- Delete(AText, i, 1);
|
|
|
- Dec(i);
|
|
|
- end
|
|
|
- else if Ord(AText[i]) < Ord(' ') then
|
|
|
- begin
|
|
|
- Delete(AText, i, 1);
|
|
|
- Dec(i);
|
|
|
- end
|
|
|
- else if not FoundCursor then
|
|
|
- Inc(NewCurX);
|
|
|
- Inc(i);
|
|
|
- end;
|
|
|
-
|
|
|
- SetSelText(AText);
|
|
|
- SetCursor(NewCurX, NewCurY);
|
|
|
- ClearSelection;
|
|
|
- try
|
|
|
- SetFocus;
|
|
|
- except
|
|
|
- end;
|
|
|
-
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// DELETE CHAR
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.DeleteChar(OldX, OldY: integer);
|
|
|
-var
|
|
|
- S, S1: string;
|
|
|
- rct: TRect;
|
|
|
- C: char;
|
|
|
- Undo: TGLSMemoDelCharUndo;
|
|
|
- IsBackspace: Boolean;
|
|
|
-begin
|
|
|
- if FReadOnly then
|
|
|
- Exit;
|
|
|
- if OldX < 0 then
|
|
|
- begin
|
|
|
- OldX := CurX;
|
|
|
- OldY := CurY;
|
|
|
- IsBackspace := False;
|
|
|
- end
|
|
|
- else
|
|
|
- IsBackspace := True;
|
|
|
-
|
|
|
- ClearSelection;
|
|
|
-
|
|
|
- S := Lines[CurY];
|
|
|
- S1 := Copy(S, CurX + 1, Length(S));
|
|
|
- if not IsBackspace then
|
|
|
- S1 := TrimRight(S1);
|
|
|
- S := Copy(S, 1, CurX);
|
|
|
- Lines[CurY] := S + S1;
|
|
|
-
|
|
|
- if CurX < Length(Lines[CurY]) then
|
|
|
- begin
|
|
|
- S := Lines[CurY];
|
|
|
- C := S[CurX + 1];
|
|
|
- Delete(S, CurX + 1, 1);
|
|
|
- Lines[CurY] := S;
|
|
|
- Changed(CurY, CurY);
|
|
|
- rct := LineRect(CurY);
|
|
|
- Undo := TGLSMemoDelCharUndo.Create(OldX, OldY, CurX, CurY, C);
|
|
|
- Undo.IsBackSpace := IsBackSpace;
|
|
|
- if Assigned(FUndoList) then
|
|
|
- FUndoList.Add(Undo);
|
|
|
- end
|
|
|
- else if CurY < Lines.Count - 1 then
|
|
|
- begin
|
|
|
- S := Lines[CurY] + Lines[CurY + 1];
|
|
|
- Lines[CurY] := S;
|
|
|
- DeleteLine(CurY + 1, OldX, OldY, CurX, CurY, False);
|
|
|
- Changed(CurY, -1);
|
|
|
- rct := EditorRect;
|
|
|
- Undo := TGLSMemoDelCharUndo.Create(OldX, OldY, CurX, CurY, #13);
|
|
|
- Undo.IsBackSpace := IsBackSpace;
|
|
|
- if Assigned(FUndoList) then
|
|
|
- FUndoList.Add(Undo);
|
|
|
- end;
|
|
|
- ClearSelection;
|
|
|
- InvalidateRect(Handle, @rct, True);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// DELETE LINE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.DeleteLine(Index, OldX, OldY, NewX, NewY: integer;
|
|
|
- FixUndo: Boolean);
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
- s: string;
|
|
|
-begin
|
|
|
- if Index < 0 then
|
|
|
- Index := CurY;
|
|
|
- if OldX < 0 then
|
|
|
- begin
|
|
|
- OldX := CurX;
|
|
|
- OldY := CurY;
|
|
|
- end;
|
|
|
-
|
|
|
- s := Lines[Index];
|
|
|
-
|
|
|
- TGLSMemoStrings(Lines).FDeleting := True;
|
|
|
- if Lines.Count = 1 then
|
|
|
- TGLSMemoStrings(Lines)[0] := ''
|
|
|
- else
|
|
|
- Lines.Delete(Index);
|
|
|
- TGLSMemoStrings(Lines).FDeleting := False;
|
|
|
-
|
|
|
- ClearSelection;
|
|
|
- if Index >= Lines.Count then
|
|
|
- Changed(Index - 1, -1)
|
|
|
- else
|
|
|
- Changed(Index, -1);
|
|
|
- rct := EditorRect;
|
|
|
- InvalidateRect(Handle, @rct, True);
|
|
|
-
|
|
|
- if NewX < 0 then
|
|
|
- begin
|
|
|
- if Length(Lines[0]) < CurX then
|
|
|
- CurX := Length(Lines[0]);
|
|
|
- if Index >= Lines.Count then
|
|
|
- CurY := Index - 1
|
|
|
- else
|
|
|
- CurY := Index;
|
|
|
- NewX := CurX;
|
|
|
- NewY := CurY;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- CurX := NewX;
|
|
|
- CurY := NewY;
|
|
|
- end;
|
|
|
- if Assigned(FUndoList) and FixUndo then
|
|
|
- FUndoList.Add(TGLSMEmoDelLineUndo.Create(Index, OldX, OldY, NewX, NewY, s));
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// BACK SPACE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.BackSpace;
|
|
|
-var
|
|
|
- OldX, OldY: integer;
|
|
|
-begin
|
|
|
- OldX := CurX;
|
|
|
- OldY := CurY;
|
|
|
- MoveCursor(-1, 0, []);
|
|
|
- if (OldX = CurX) and (OldY = CurY) then
|
|
|
- Exit;
|
|
|
- DeleteChar(OldX, OldY);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// BACK SPACE WORD
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.BackSpaceWord;
|
|
|
-begin
|
|
|
- ClearSelection;
|
|
|
- MoveCursor(-1, 0, [ssShift, ssCtrl]);
|
|
|
- DeleteSelection(True);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// INDENT CURR LINE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.IndentCurrLine: string;
|
|
|
-var
|
|
|
- Len, Count: integer;
|
|
|
- CurS: string;
|
|
|
-begin
|
|
|
- Result := '';
|
|
|
- if not AutoIndent then
|
|
|
- Exit;
|
|
|
- CurS := Lines[CurY];
|
|
|
- Len := Length(CurS);
|
|
|
- Count := 0;
|
|
|
- while (Count < CurX) and (Count < Len) do
|
|
|
- begin
|
|
|
- if CurS[Count + 1] <> ' ' then
|
|
|
- break;
|
|
|
- Inc(Count);
|
|
|
- end;
|
|
|
- Result := StringOfChar(' ', Count);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// NEW LINE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.NewLine;
|
|
|
-var
|
|
|
- S, sIndent: string;
|
|
|
- OldX, OldY: integer;
|
|
|
-begin
|
|
|
- OldX := CurX;
|
|
|
- OldY := CurY;
|
|
|
- S := Lines[CurY];
|
|
|
- sIndent := IndentCurrLine;
|
|
|
- Lines[CurY] := Copy(S, 1, CurX);
|
|
|
-
|
|
|
- S := TrimRight(Copy(S, CurX + 1, Length(S)));
|
|
|
- if AutoIndent then
|
|
|
- while (Length(S) > 0) and (S[1] = ' ') do
|
|
|
- Delete(S, 1, 1);
|
|
|
-
|
|
|
- TGLSMemoStrings(Lines).DoInsert(CurY + 1, sIndent + S);
|
|
|
- GoHome([]);
|
|
|
- MoveCursor(0, 1, []);
|
|
|
- CurX := Length(sIndent);
|
|
|
- ClearSelection;
|
|
|
- if Assigned(FUndoList) then
|
|
|
- FUndoList.Add(TGLSMemoInsCharUndo.Create(OldX, OldY, CurX, CurY, #13 +
|
|
|
- sIndent));
|
|
|
- Invalidate;
|
|
|
- Changed(CurY - 1, -1);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// ADD STRING
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.AddString(const S: string): integer;
|
|
|
-begin
|
|
|
- if Lines.Count = 0 then
|
|
|
- TGLSMemoStrings(Lines).DoAdd('');
|
|
|
- MovePage(1, [ssCtrl]); // end of text
|
|
|
- if not ((Lines.Count = 1) and (Lines[0] = '')) then
|
|
|
- begin
|
|
|
- TGLSMemoStrings(Lines).DoAdd('');
|
|
|
- CurX := 0;
|
|
|
- CurY := Lines.Count;
|
|
|
- ClearSelection;
|
|
|
- // S := #13#10 + S;
|
|
|
- end;
|
|
|
- SetSelText(S);
|
|
|
- Result := Lines.Count - 1;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// INSERT STRING
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.InsertString(Index: integer; S: string);
|
|
|
-begin
|
|
|
- CurY := Index;
|
|
|
- CurX := 0;
|
|
|
- ClearSelection;
|
|
|
- if not ((Lines.Count = 1) and (Lines[0] = '')) then
|
|
|
- S := S + #13#10;
|
|
|
- SetSelText(S);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// DO COMMAND
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.DoCommand(cmd: TCommand; const AShift: TShiftState);
|
|
|
-begin
|
|
|
- case cmd of
|
|
|
- cmDelete: if not FReadOnly then
|
|
|
- begin
|
|
|
- if ssShift in AShift then
|
|
|
- CutToClipboard
|
|
|
- else if FDelErase and
|
|
|
- (not ((FSelStartX = FSelEndX) and (FSelStartY = FSelEndY))) then
|
|
|
- DeleteSelection(True)
|
|
|
- else
|
|
|
- DeleteChar(-1, -1);
|
|
|
- end;
|
|
|
- cmBackSpace: BackSpace;
|
|
|
- cmWordBackSpace: BackSpaceWord;
|
|
|
- cmNewLine: NewLine;
|
|
|
- cmDelLine: DeleteLine(-1, -1, -1, -1, -1, True);
|
|
|
- cmCopy: CopyToClipboard;
|
|
|
- cmCut: CutToClipboard;
|
|
|
- cmPaste: PasteFromClipboard;
|
|
|
- cmHome: GoHome(AShift);
|
|
|
- cmEnd: GoEnd(AShift);
|
|
|
- cmPageDown: MovePage(1, AShift);
|
|
|
- cmPageUp: MovePage(-1, AShift);
|
|
|
- cmInsert:
|
|
|
- begin
|
|
|
- if ssShift in AShift then
|
|
|
- PasteFromClipboard;
|
|
|
- if ssCtrl in AShift then
|
|
|
- CopyToClipboard;
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// KEY DOWN
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.KeyDown(var Key: Word; Shift: TShiftState);
|
|
|
-begin
|
|
|
- ShowCaret(False);
|
|
|
- inherited;
|
|
|
- case Key of
|
|
|
- VK_LEFT: MoveCursor(-1, 0, Shift);
|
|
|
- VK_RIGHT: MoveCursor(1, 0, Shift);
|
|
|
- VK_UP: MoveCursor(0, -1, Shift);
|
|
|
- VK_DOWN: MoveCursor(0, 1, Shift);
|
|
|
- VK_HOME, VK_END,
|
|
|
- VK_DELETE: DoCommand(Key, Shift);
|
|
|
- VK_PRIOR, VK_NEXT:
|
|
|
- DoCommand(Key, Shift);
|
|
|
- VK_INSERT: DoCommand(Key, Shift);
|
|
|
- end;
|
|
|
- ShowCaret(True);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// KEY PRESS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.KeyPress(var Key: Char);
|
|
|
-begin
|
|
|
- if FReadOnly then
|
|
|
- Exit;
|
|
|
- ShowCaret(False);
|
|
|
- inherited;
|
|
|
- if (ord(Key) in [9, 32..255]) and (ord(Key) <> 127) then
|
|
|
- begin
|
|
|
- if FDelErase and (not ((FSelStartX = FSelEndX) and (FSelStartY = FSelEndY)))
|
|
|
- then
|
|
|
- DeleteSelection(True);
|
|
|
- InsertChar(Key);
|
|
|
- end
|
|
|
- else
|
|
|
- DoCommand(Ord(Key), []);
|
|
|
- ShowCaret(True);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// MOUSE DOWN
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
|
- X, Y: Integer);
|
|
|
-var
|
|
|
- newPos: TCellPos;
|
|
|
- charPos: TFullPos;
|
|
|
- Selecting: Boolean;
|
|
|
-begin
|
|
|
- inherited;
|
|
|
- if not Focused then
|
|
|
- begin
|
|
|
- SetFocus;
|
|
|
- // Exit;
|
|
|
- end;
|
|
|
-
|
|
|
- if FAfterDoubleClick then
|
|
|
- begin
|
|
|
- FAfterDoubleClick := False;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
-
|
|
|
- if Button <>mbLeft then
|
|
|
- Exit;
|
|
|
-
|
|
|
-
|
|
|
- if sbVert.MouseDown(Button, Shift, X, Y) then
|
|
|
- Exit;
|
|
|
- if sbHorz.MouseDown(Button, Shift, X, Y) then
|
|
|
- Exit;
|
|
|
-
|
|
|
- if PointInRect(Point(X, Y), EditorRect) then
|
|
|
- begin
|
|
|
- ShowCaret(False);
|
|
|
- newPos := CellFromPos(X, Y);
|
|
|
- CurY := newPos.Y + FTopLine;
|
|
|
- CurX := newPos.X + FLeftCol;
|
|
|
- if Assigned(FOnMoveCursor) then
|
|
|
- FOnMoveCursor(Self);
|
|
|
-
|
|
|
- Selecting := ssShift in Shift;
|
|
|
- if Button = mbLeft then
|
|
|
- begin
|
|
|
- if Selecting then
|
|
|
- ExpandSelection
|
|
|
- else
|
|
|
- ClearSelection;
|
|
|
- FLeftButtonDown := True;
|
|
|
- end
|
|
|
- else
|
|
|
- ShowCaret(True);
|
|
|
- end;
|
|
|
-
|
|
|
- if Assigned(FOnGutterClick) then
|
|
|
- if PointInRect(Point(X, Y), FGutter.FullRect) then
|
|
|
- begin
|
|
|
- charPos := CharFromPos(X, Y);
|
|
|
- if charPos.LineNo < Lines.Count then
|
|
|
- FOnGutterClick(Self, charPos.LineNo);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// MOUSE MOVE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
|
-var
|
|
|
- newPos: TCellPos;
|
|
|
-begin
|
|
|
- inherited;
|
|
|
- if sbVert.MouseMove(Shift, X, Y) then
|
|
|
- Exit;
|
|
|
- if sbHorz.MouseMove(Shift, X, Y) then
|
|
|
- Exit;
|
|
|
- if PointInRect(Point(X, Y), EditorRect) then
|
|
|
- begin
|
|
|
- if (ssLeft in Shift) and FLeftButtonDown then
|
|
|
- begin
|
|
|
- newPos := CellFromPos(X, Y);
|
|
|
- CurY := newPos.Y + FTopLine;
|
|
|
- CurX := newPos.X + FLeftCol;
|
|
|
- ExpandSelection;
|
|
|
- end;
|
|
|
- end
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// MOUSE UP
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
|
|
|
- Integer);
|
|
|
-begin
|
|
|
- inherited;
|
|
|
- if sbVert.MouseUp(Button, Shift, X, Y) then
|
|
|
- Exit;
|
|
|
- if sbHorz.MouseUp(Button, Shift, X, Y) then
|
|
|
- Exit;
|
|
|
- if Button = mbLeft then
|
|
|
- ShowCaret(True);
|
|
|
- FLeftButtonDown := False;
|
|
|
- FLastMouseUpX := X;
|
|
|
- FLastMouseUpY := Y;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// DBL CLICK
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.DblClick;
|
|
|
-var
|
|
|
- clickPos: TCellPos;
|
|
|
- clickX, clickY: integer;
|
|
|
- //------------------------------------------------------------
|
|
|
- // SELECT WORD
|
|
|
- //------------------------------------------------------------
|
|
|
- procedure SelectWord;
|
|
|
- const
|
|
|
- stopChars: TSysCharSet = [' ', ';', '.', ',', ':', '?', '!', '''', '"',
|
|
|
- '<', '>', '/', '*', '+', '-', '=', '(', ')',
|
|
|
- '[', ']', '{', '}', '@', '#', '$', '%', '^',
|
|
|
- '&', '|', '\'];
|
|
|
- var
|
|
|
- s: string;
|
|
|
- i: integer;
|
|
|
- rct: TRect;
|
|
|
- begin
|
|
|
- CurX := clickX;
|
|
|
- CurY := clickY;
|
|
|
- if (CurX = clickX) and (CurY = clickY) then
|
|
|
- begin
|
|
|
- s := Lines[clickY];
|
|
|
- if s[clickX + 1] = ' ' then
|
|
|
- Exit;
|
|
|
-
|
|
|
- i := clickX;
|
|
|
- while (i >= 0) and not CharInSet(s[i + 1], stopChars) do
|
|
|
- Dec(i);
|
|
|
- FSelStartY := clickY;
|
|
|
- FSelStartX := i + 1;
|
|
|
-
|
|
|
- i := clickX;
|
|
|
- while (i < Length(s)) and not CharInSet(s[i + 1], stopChars) do
|
|
|
- Inc(i);
|
|
|
- FSelEndY := clickY;
|
|
|
- FSelEndX := i;
|
|
|
-
|
|
|
- if FSelEndX <> FSelStartX then
|
|
|
- begin
|
|
|
- FAfterDoubleClick := True;
|
|
|
- rct := LineRangeRect(CurY, CurY);
|
|
|
- SelectionChanged;
|
|
|
- InvalidateRect(Handle, @rct, true);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- //------------------------------------------------------------
|
|
|
-begin
|
|
|
-
|
|
|
- if PointInRect(Point(FLastMouseUpX, FLastMouseUpY), EditorRect) then
|
|
|
- begin
|
|
|
- clickPos := CellFromPos(FLastMouseUpX, FLastMouseUpY);
|
|
|
- clickX := clickPos.X + FLeftCol;
|
|
|
- clickY := clickPos.Y + FTopLine;
|
|
|
- SelectWord;
|
|
|
- end;
|
|
|
- inherited;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// WM_GETDLGCODE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.WMGetDlgCode(var Msg: TWMGetDlgCode);
|
|
|
-begin
|
|
|
- Msg.Result := DLGC_WANTARROWS or DLGC_WANTTAB;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// WM_ERASEBKGND
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.WMEraseBkgnd(var Msg: TWmEraseBkgnd);
|
|
|
-begin
|
|
|
- Msg.Result := 1;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// WM_SIZE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.WMSize(var Msg: TWMSize);
|
|
|
-begin
|
|
|
- if not (csLoading in ComponentState) then
|
|
|
- try
|
|
|
- ResizeEditor;
|
|
|
- except
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// WM_SETCURSOR
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.WMSetCursor(var Msg: TWMSetCursor);
|
|
|
-var
|
|
|
- P: TPoint;
|
|
|
-begin
|
|
|
- Msg.Result := 1;
|
|
|
- GetCursorPos(P);
|
|
|
- P := ScreenToClient(P);
|
|
|
- if PointInRect(P, EditorRect) then
|
|
|
- Winapi.Windows.SetCursor(Screen.Cursors[crIBeam])
|
|
|
- else
|
|
|
- Winapi.Windows.SetCursor(Screen.Cursors[crArrow]);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// WM_SETFOCUS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.WMSetFocus(var Msg: TWMSetFocus);
|
|
|
-begin
|
|
|
- if FCellSize.H = 0 then
|
|
|
- SetFont(FFont);
|
|
|
- CreateCaret(Handle, HBITMAP(0), 2, FCellSize.H - 2);
|
|
|
- ShowCaret(true);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// WM_KILLFOCUS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.WMKillFocus(var Msg: TWMSetFocus);
|
|
|
-begin
|
|
|
- DestroyCaret;
|
|
|
- FCaretVisible := False;
|
|
|
- inherited;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SHOW CARET
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.ShowCaret(State: Boolean);
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
-begin
|
|
|
- FCaretVisible := False;
|
|
|
- if not State then
|
|
|
- HideCaret(Handle)
|
|
|
- else if Focused and not HiddenCaret then
|
|
|
- begin
|
|
|
- rct := CellRect(CurX - FLeftCol, CurY - FTopLine);
|
|
|
- SetCaretPos(rct.Left, rct.Top + 1);
|
|
|
- Winapi.Windows.ShowCaret(Handle);
|
|
|
- FCaretVisible := True;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// CELL RECT
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.CellRect(ACol, ARow: integer): TRect;
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
-begin
|
|
|
- rct := EditorRect;
|
|
|
- with FCellSize do
|
|
|
- Result := Rect(rct.Left + W * ACol, rct.Top + H * ARow,
|
|
|
- rct.Left + W * (ACol + 1), rct.Top + H * (ARow + 1));
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// LINE RECT
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.LineRect(ARow: integer): TRect;
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
-begin
|
|
|
- rct := EditorRect;
|
|
|
- ARow := ARow - FTopLine;
|
|
|
- with FCellSize do
|
|
|
- Result := Rect(rct.Left, rct.Top + H * ARow, rct.Right, rct.Top + H * (ARow
|
|
|
- + 1));
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// COL RECT
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.ColRect(ACol: integer): TRect;
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
-begin
|
|
|
- rct := EditorRect;
|
|
|
- ACol := ACol - FLeftCol;
|
|
|
- with FCellSize do
|
|
|
- Result := Rect(rct.Left + W * ACol, rct.Top, rct.Left + W * (ACol + 1),
|
|
|
- rct.Bottom);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// LINE RANGE RECT
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.LineRangeRect(FromLine, ToLine: integer): TRect;
|
|
|
-var
|
|
|
- rct1, rct2: TRect;
|
|
|
-begin
|
|
|
- rct1 := LineRect(FromLine);
|
|
|
- rct2 := LineRect(ToLine);
|
|
|
- Result := TotalRect(rct1, rct2);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// INVALIDATE LINE RANGE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.InvalidateLineRange(FromLine, ToLine: integer);
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
-begin
|
|
|
- if ToLine < FromLine then
|
|
|
- ToLine := Lines.Count - 1;
|
|
|
- rct := LineRangeRect(FromLine, ToLine);
|
|
|
- if GutterWidth > 2 then
|
|
|
- rct.Left := FGutter.Left;
|
|
|
- InvalidateRect(Handle, @rct, True);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// COL RANGE RECT
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.ColRangeRect(FromCol, ToCol: integer): TRect;
|
|
|
-var
|
|
|
- rct1, rct2: TRect;
|
|
|
-begin
|
|
|
- rct1 := ColRect(FromCol);
|
|
|
- rct2 := ColRect(ToCol);
|
|
|
- Result := TotalRect(rct1, rct2);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// CELL and CHAR FROM POS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.CellFromPos(X, Y: integer): TCellPos;
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
-begin
|
|
|
- rct := EditorRect;
|
|
|
- if (FCellSize.H = 0) and Assigned(FFont) then
|
|
|
- SetFont(FFont);
|
|
|
- if (FCellSize.W <> 0) and (FCellSize.H <> 0) then
|
|
|
- begin
|
|
|
- Result.X := (X - rct.Left) div FCellSize.W;
|
|
|
- Result.Y := (Y - rct.Top) div FCellSize.H;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- Result.X := 0;
|
|
|
- Result.Y := 0;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TGLSCustomMemo.CharFromPos(X, Y: integer): TFullPos;
|
|
|
-var
|
|
|
- rct: TRect;
|
|
|
-begin
|
|
|
- rct := EditorRect;
|
|
|
- if (FCellSize.H = 0) and Assigned(FFont) then
|
|
|
- SetFont(FFont);
|
|
|
- if (FCellSize.W <> 0) and (FCellSize.H <> 0) then
|
|
|
- begin
|
|
|
- Result.Pos := (X - rct.Left) div FCellSize.W + FLeftCol;
|
|
|
- Result.LineNo := (Y - rct.Top) div FCellSize.H + FTopLine;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- Result.Pos := 1;
|
|
|
- Result.LineNo := 1;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SET COLOR
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetColor(Index: integer; Value: TColor);
|
|
|
-var
|
|
|
- eRect: TRect;
|
|
|
- Changed: Boolean;
|
|
|
-begin
|
|
|
- Changed := False;
|
|
|
- case Index of
|
|
|
- 0: if FBkColor <> Value then
|
|
|
- begin
|
|
|
- FBkColor := Value;
|
|
|
- FStyles.BkColor[0] := Value;
|
|
|
- Changed := True;
|
|
|
- end;
|
|
|
- 1: if FSelColor <> Value then
|
|
|
- begin
|
|
|
- FSelColor := Value;
|
|
|
- Changed := True;
|
|
|
- end;
|
|
|
- 2: if FSelBkColor <> Value then
|
|
|
- begin
|
|
|
- FSelBkColor := Value;
|
|
|
- Changed := True;
|
|
|
- end;
|
|
|
- end;
|
|
|
- if Changed then
|
|
|
- begin
|
|
|
- eRect := EditorRect;
|
|
|
- InvalidateRect(Handle, @eRect, True);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SET FONT
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetFont(Value: TFont);
|
|
|
-var
|
|
|
- wW, wi: integer;
|
|
|
- OldFontName: string;
|
|
|
- eRect: TRect;
|
|
|
-begin
|
|
|
- OldFontName := Canvas.Font.Name;
|
|
|
- Canvas.Font.Name := Value.Name;
|
|
|
- wW := Canvas.TextWidth('W');
|
|
|
- wi := Canvas.TextWidth('i');
|
|
|
- Canvas.Font.Name := OldFontName;
|
|
|
-
|
|
|
- if wW <> wi then
|
|
|
- raise EAbort.Create('Monospace font required');
|
|
|
-
|
|
|
- FFont.Assign(Value);
|
|
|
- Canvas.Font.Assign(Value);
|
|
|
- FCellSize.W := Canvas.TextWidth('W');
|
|
|
- FCellSize.H := Canvas.TextHeight('W') + 1;
|
|
|
-
|
|
|
- if FCaretVisible then
|
|
|
- begin
|
|
|
- ShowCaret(False);
|
|
|
- DestroyCaret;
|
|
|
- CreateCaret(Handle, HBITMAP(0), 2, FCellSize.H - 2);
|
|
|
- ShowCaret(true);
|
|
|
- end;
|
|
|
-
|
|
|
- FStyles.TextColor[0] := FFont.Color;
|
|
|
- FStyles.Style[0] := FFont.Style;
|
|
|
-
|
|
|
- eRect := EditorRect;
|
|
|
- InvalidateRect(Handle, @eRect, True);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SET GUTTER WIDTH
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetGutterWidth(Value: integer);
|
|
|
-begin
|
|
|
- FGutterWidth := Value;
|
|
|
- FGutter.FWidth := Value;
|
|
|
- if not (csLoading in ComponentState) then
|
|
|
- ResizeEditor;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SET GUTTER COLOR
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetGutterColor(Value: TColor);
|
|
|
-begin
|
|
|
- if FGutter.FColor <> Value then
|
|
|
- begin
|
|
|
- FGutter.FColor := Value;
|
|
|
- FGutter.Invalidate;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// GET GUTTER COLOR
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.GetGutterColor: TColor;
|
|
|
-begin
|
|
|
- Result := FGutter.FColor;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// CHAR STYLE NO
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.CharStyleNo(LineNo, Pos: integer): integer;
|
|
|
-var
|
|
|
- ChStyle: string;
|
|
|
-begin
|
|
|
- Result := 0;
|
|
|
- if (LineNo < 0) or (LineNo >= Lines.Count) then
|
|
|
- Exit;
|
|
|
-
|
|
|
- ChStyle := CharAttrs[LineNo];
|
|
|
- if (Pos <= 0) or (Pos > Length(ChStyle)) then
|
|
|
- Exit;
|
|
|
-
|
|
|
- Result := integer(ChStyle[Pos]);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// DRAW LINE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.DrawLine(LineNo: integer);
|
|
|
-var
|
|
|
- eRect, rct0, rct1, rct, lineRct: TRect;
|
|
|
- LineSelStart, LineSelEnd, LineStyleNo, pos: integer;
|
|
|
- S, S1, S2, S3, ChStyle: string;
|
|
|
- //--------- FIND LINE SELECTION -------------
|
|
|
- procedure FindLineSelection;
|
|
|
- var
|
|
|
- len: integer;
|
|
|
- xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
|
|
|
- begin
|
|
|
- xSelStartX := FSelStartX;
|
|
|
- xSelStartY := FSelStartY;
|
|
|
- xSelEndX := FSelEndX;
|
|
|
- xSelEndY := FSelEndY;
|
|
|
- OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
|
|
|
- len := Length(Lines[LineNo]);
|
|
|
- LineSelStart := 0;
|
|
|
- LineSelEnd := 0;
|
|
|
- if xSelStartY = Lineno then
|
|
|
- begin
|
|
|
- LineSelStart := xSelStartX - FLeftCol;
|
|
|
- LineSelEnd := len - FLeftCol;
|
|
|
- end
|
|
|
- else if (xSelStartY < LineNo) and (LineNo < xSelEndY) then
|
|
|
- begin
|
|
|
- LineSelStart := 0;
|
|
|
- LineSelEnd := len - FLeftCol;
|
|
|
- end;
|
|
|
-
|
|
|
- if xSelEndY = LineNo then
|
|
|
- LineSelEnd := xSelEndX - FLeftCol;
|
|
|
-
|
|
|
- if LineSelEnd < LineSelStart then
|
|
|
- Swap(LineSelEnd, LineSelStart);
|
|
|
-
|
|
|
- if LineSelStart < 0 then
|
|
|
- LineSelStart := 0;
|
|
|
- S := Copy(Lines[LineNo], FLeftCol + 1, len);
|
|
|
- S1 := Copy(S, 1, LineSelStart);
|
|
|
- S2 := Copy(S, LineSelStart + 1, LineSelEnd - LineSelStart);
|
|
|
- S3 := Copy(S, LineSelEnd + 1, len);
|
|
|
- end;
|
|
|
- //------------- DRAW PART ---------------------
|
|
|
- procedure DrawPart(const Part: string; PartStyle, StartPos: integer;
|
|
|
- var rct: TRect; IsSelection: Boolean);
|
|
|
- var
|
|
|
- len, w: integer;
|
|
|
- rctInternal: TRect;
|
|
|
- begin
|
|
|
- len := Length(Part);
|
|
|
- if len > 0 then
|
|
|
- with FLineBitmap.Canvas do
|
|
|
- begin
|
|
|
- w := FCellSize.W * len;
|
|
|
- Font.Style := FStyles.Style[PartStyle];
|
|
|
- if IsSelection then
|
|
|
- begin
|
|
|
- Font.Color := SelColor;
|
|
|
- Brush.Color := SelBkColor;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if LineStyleNo = 0 then
|
|
|
- begin
|
|
|
- Font.Color := FStyles.TextColor[PartStyle];
|
|
|
- Brush.Color := FStyles.BkColor[PartStyle];
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if (LineNo = FSelCharPos.LineNo) and
|
|
|
- (StartPos = FSelCharPos.Pos + 1) and (Length(Part) = 1) then
|
|
|
- begin
|
|
|
- Font.Color := FStyles.TextColor[PartStyle];
|
|
|
- Brush.Color := FStyles.BkColor[PartStyle];
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- Font.Color := FStyles.TextColor[LineStyleNo];
|
|
|
- Brush.Color := FStyles.BkColor[LineStyleNo];
|
|
|
- Font.Style := FStyles.Style[LineStyleNo];
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- rct.Right := rct.Left + w;
|
|
|
- rctInternal := rct;
|
|
|
- rctInternal.Left := rctInternal.Left - eRect.Left;
|
|
|
- rctInternal.Right := rctInternal.Right - eRect.Left;
|
|
|
- rctInternal.Top := rctInternal.Top - rct.Top;
|
|
|
- rctInternal.Bottom := rctInternal.Bottom - rct.Top;
|
|
|
- FillRect(rctInternal);
|
|
|
- DrawText(Handle, PChar(Part), len, rctInternal, DT_LEFT
|
|
|
- or DT_SINGLELINE or DT_NOPREFIX);
|
|
|
- rct0.Left := rct.Left + w;
|
|
|
- rct := rct0;
|
|
|
- end;
|
|
|
- end;
|
|
|
- //------------- DRAW SEGMENTS ---------------------
|
|
|
- procedure DrawSegments(S: string; WorkPos: integer;
|
|
|
- var rct: TRect; IsSelection: Boolean);
|
|
|
- var
|
|
|
- i, len, ThisStyle: integer;
|
|
|
- begin
|
|
|
- while True do
|
|
|
- begin
|
|
|
- Len := Length(S);
|
|
|
- if Len = 0 then
|
|
|
- Exit;
|
|
|
- ThisStyle := Ord(ChStyle[WorkPos]);
|
|
|
- i := 1;
|
|
|
- while (i <= Len) and
|
|
|
- (ThisStyle = Ord(ChStyle[WorkPos + i - 1])) do
|
|
|
- Inc(i);
|
|
|
- DrawPart(Copy(S, 1, i - 1), ThisStyle, WorkPos, rct, IsSelection);
|
|
|
- Inc(WorkPos, i - 1);
|
|
|
- s := Copy(s, i, Len);
|
|
|
- end;
|
|
|
- end;
|
|
|
- //---------------------------------------------
|
|
|
-begin
|
|
|
- eRect := EditorRect;
|
|
|
- rct := CellRect(0, LineNo - FTopLine);
|
|
|
- rct0 := Rect(eRect.Left, rct.Top, eRect.Right, rct.Bottom);
|
|
|
- lineRct := rct0;
|
|
|
-
|
|
|
- if LineNo < Lines.Count then
|
|
|
- begin
|
|
|
-
|
|
|
- rct := rct0;
|
|
|
- S := Lines[LineNo];
|
|
|
- LineStyleNo := LineStyle[LineNo];
|
|
|
- ChStyle := CharAttrs[LineNo];
|
|
|
- FindLineSelection;
|
|
|
-
|
|
|
- if not Assigned(FOnGetLineAttrs) then
|
|
|
- ChStyle := StringOfChar(#0, Length(Lines[LineNo]));
|
|
|
-
|
|
|
- if Length(S) > 0 then
|
|
|
- if (FSelCharStyle >= 0) and (LineNo = FSelCharPos.LineNo) then
|
|
|
- ChStyle[FSelCharPos.Pos + 1] := Char(FSelCharStyle);
|
|
|
-
|
|
|
- pos := FLeftCol + 1; // 1
|
|
|
- DrawSegments(S1, pos, rct, False);
|
|
|
- Inc(pos, Length(S1));
|
|
|
- DrawSegments(S2, pos, rct, True);
|
|
|
- Inc(pos, Length(S2));
|
|
|
- DrawSegments(S3, pos, rct, False);
|
|
|
-
|
|
|
- // else begin
|
|
|
- // DrawPart(S1,StyleNo,rct,False);
|
|
|
- // DrawPart(S2,StyleNo,rct,True);
|
|
|
- // DrawPart(S3,StyleNo,rct,False);
|
|
|
- // end;
|
|
|
-
|
|
|
- rct1 := rct;
|
|
|
- rct1.Left := rct1.Left - eRect.Left;
|
|
|
- rct1.Right := rct1.Right - eRect.Left;
|
|
|
- rct1.Top := rct1.Top - rct.Top;
|
|
|
- rct1.Bottom := rct1.Bottom - rct.Top;
|
|
|
- with FLineBitmap.Canvas do
|
|
|
- begin
|
|
|
- Brush.Color := FStyles.BkColor[LineStyleNo];
|
|
|
- FillRect(rct1);
|
|
|
- end;
|
|
|
-
|
|
|
- with LineRct do
|
|
|
- BitBlt(Canvas.Handle, Left, Top, Right - Left, Bottom - Top,
|
|
|
- FLineBitmap.Canvas.Handle, 0, 0, SRCCOPY);
|
|
|
- end
|
|
|
- else
|
|
|
- with Canvas do
|
|
|
- begin
|
|
|
- Brush.Color := BkColor;
|
|
|
- FillRect(rct0);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SET HIDDEN CARET
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetHiddenCaret(Value: Boolean);
|
|
|
-begin
|
|
|
- if Value <> FHiddenCaret then
|
|
|
- begin
|
|
|
- FHiddenCaret := Value;
|
|
|
- if Focused then
|
|
|
- if FHiddenCaret = FCaretVisible then
|
|
|
- ShowCaret(not FHiddenCaret);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// BORDER
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure Border(Canvas: TCanvas; const rct: TRect; BorderType: TBorderType);
|
|
|
-const
|
|
|
- Colors: array[TBorderType] of array[1..4] of TColor
|
|
|
- = (($D0D0D0, clWhite, clGray, clBlack),
|
|
|
- (clGray, clBlack, $D0D0D0, clWhite),
|
|
|
- (clWhite, clWhite, clWhite, clGray),
|
|
|
- (clGray, clWhite, clWhite, clGray));
|
|
|
-begin
|
|
|
- with Canvas do
|
|
|
- begin
|
|
|
- Pen.Color := Colors[BorderType][1];
|
|
|
- MoveTo(rct.Left, rct.Bottom - 1);
|
|
|
- LineTo(rct.Left, rct.Top);
|
|
|
- LineTo(rct.Right, rct.Top);
|
|
|
- if BorderType in [btRaised, btLowered] then
|
|
|
- begin
|
|
|
- Pen.Color := Colors[BorderType][2];
|
|
|
- MoveTo(rct.Left + 1, rct.Bottom);
|
|
|
- LineTo(rct.Left + 1, rct.Top + 1);
|
|
|
- LineTo(rct.Right, rct.Top + 1);
|
|
|
- Pen.Color := Colors[BorderType][3];
|
|
|
- MoveTo(rct.Left + 1, rct.Bottom - 2);
|
|
|
- LineTo(rct.Right - 2, rct.Bottom - 2);
|
|
|
- LineTo(rct.Right - 2, rct.Top + 1);
|
|
|
- end;
|
|
|
- Pen.Color := Colors[BorderType][4];
|
|
|
- MoveTo(rct.Left, rct.Bottom - 1);
|
|
|
- LineTo(rct.Right - 1, rct.Bottom - 1);
|
|
|
- LineTo(rct.Right - 1, rct.Top);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// EDITOR RECT
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.EditorRect: TRect;
|
|
|
-var
|
|
|
- l, t, r, b: integer;
|
|
|
-begin
|
|
|
- l := 2;
|
|
|
- r := Width - 2;
|
|
|
- t := 2;
|
|
|
- b := Height - 2;
|
|
|
- if GutterWidth > 2 then
|
|
|
- l := l + GutterWidth;
|
|
|
- if FScrollBars in [ssBoth, ssVertical] then
|
|
|
- r := r - FScrollBarWidth;
|
|
|
- if FScrollBars in [ssBoth, ssHorizontal] then
|
|
|
- b := b - FScrollBarWidth;
|
|
|
- Result := Rect(l + FMargin, t, r, b);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// DRAW MARGIN
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.DrawMargin;
|
|
|
-var
|
|
|
- eRect: TRect;
|
|
|
- i: integer;
|
|
|
-begin
|
|
|
- eRect := EditorRect;
|
|
|
- with Canvas do
|
|
|
- begin
|
|
|
- Pen.Color := clWhite;
|
|
|
- for i := 1 to FMargin do
|
|
|
- begin
|
|
|
- MoveTo(eRect.Left - i, eRect.Top);
|
|
|
- LineTo(eRect.Left - i, eRect.Bottom + 1);
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// DRAW GUTTER
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.DrawGutter;
|
|
|
-begin
|
|
|
- if GutterWidth < 2 then
|
|
|
- Exit;
|
|
|
- ResizeGutter;
|
|
|
- FGutter.PaintTo(Canvas);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// DRAW SCROLLBARS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.DrawScrollBars;
|
|
|
-begin
|
|
|
- ResizeScrollBars;
|
|
|
- if FScrollBars in [ssBoth, ssVertical] then
|
|
|
- sbVert.PaintTo(Canvas);
|
|
|
- if FScrollBars in [ssBoth, ssHorizontal] then
|
|
|
- sbHorz.PaintTo(Canvas);
|
|
|
- if FScrollBars = ssBoth then
|
|
|
- with Canvas do
|
|
|
- begin
|
|
|
- Brush.Color := clSilver;
|
|
|
- FillRect(Rect(sbVert.Left, sbHorz.Top + 1,
|
|
|
- sbVert.Left + sbVert.Width, sbHorz.Top + sbHorz.Height));
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// FRESH LINE BITMAP
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.FreshLineBitmap;
|
|
|
-var
|
|
|
- eRect: TRect;
|
|
|
-begin
|
|
|
- eRect := EditorRect;
|
|
|
- with FLineBitmap do
|
|
|
- begin
|
|
|
- Width := eRect.Right - eRect.Left;
|
|
|
- Height := FCellSize.H;
|
|
|
- FLineBitmap.Canvas.Font.Assign(Self.Canvas.Font);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// PAINT
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.Paint;
|
|
|
-var
|
|
|
- pTop, pBottom: TFullPos;
|
|
|
- rct, eRect: TRect;
|
|
|
- i: integer;
|
|
|
- clipRgn: HRGN;
|
|
|
- Attrs: string;
|
|
|
-begin
|
|
|
- if TGLSMemoStrings(Lines).FLockCount > 0 then
|
|
|
- Exit;
|
|
|
- with Canvas do
|
|
|
- begin
|
|
|
- if FCellSize.H = 0 then
|
|
|
- SetFont(FFont);
|
|
|
- FreshLineBitmap;
|
|
|
-
|
|
|
- Border(Canvas, Rect(0, 0, Width, Height), btLowered);
|
|
|
- DrawMargin;
|
|
|
- DrawGutter;
|
|
|
- DrawScrollBars;
|
|
|
-
|
|
|
- eRect := EditorRect;
|
|
|
- clipRgn := CreateRectRgn(eRect.Left, eRect.Top, eRect.Right, eRect.Bottom);
|
|
|
- ExtSelectClipRgn(Canvas.Handle, clipRgn, RGN_AND);
|
|
|
- DeleteObject(clipRgn);
|
|
|
-
|
|
|
- rct := Canvas.ClipRect;
|
|
|
- pTop := CharFromPos(rct.Left, rct.Top);
|
|
|
- pBottom := CharFromPos(rct.Left, rct.Bottom);
|
|
|
-
|
|
|
- if Assigned(FOnGetLineAttrs) then
|
|
|
- for i := 0 to Lines.Count - 1 do
|
|
|
- if not ValidAttrs[i] then
|
|
|
- begin
|
|
|
- FOnGetLineAttrs(Self, i, Attrs);
|
|
|
- CharAttrs[i] := Attrs;
|
|
|
- ValidAttrs[i] := True;
|
|
|
- end;
|
|
|
-
|
|
|
- for i := pTop.LineNo to pBottom.LineNo do
|
|
|
- DrawLine(i);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// GET VISIBLE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.GetVisible(Index: integer): integer;
|
|
|
-var
|
|
|
- Coord: TFullPos;
|
|
|
- Cell: TCellPos;
|
|
|
- eRect: TRect;
|
|
|
-begin
|
|
|
- eRect := EditorRect;
|
|
|
- Coord := CharFromPos(eRect.Right - 1, eRect.Bottom - 1);
|
|
|
- Cell := CellFromPos(eRect.Right - 1, eRect.Bottom - 1);
|
|
|
- case Index of
|
|
|
- 0: Result := Cell.X;
|
|
|
- 1: Result := Cell.Y;
|
|
|
- 2: Result := Coord.Pos - 1;
|
|
|
- 3: Result := Coord.LineNo - 1;
|
|
|
- else
|
|
|
- Result := 0;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// IS LINE VISIBLE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.IsLineVisible(LineNo: integer): Boolean;
|
|
|
-begin
|
|
|
- if FCellSize.H = 0 then
|
|
|
- SetFont(FFont);
|
|
|
- Result := (FTopLine <= LineNo) and (LineNo <= LastVisibleLine + 1);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// MAKE VISIBLE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.MakeVisible;
|
|
|
-var
|
|
|
- Modified: Boolean;
|
|
|
-begin
|
|
|
- Modified := False;
|
|
|
- if CurX < FLeftCol then
|
|
|
- begin
|
|
|
- FLeftCol := CurX - 2;
|
|
|
- if FLeftCol < 0 then
|
|
|
- FLeftCol := 0;
|
|
|
- Modified := True;
|
|
|
- end;
|
|
|
- if CurX > LastVisiblePos then
|
|
|
- begin
|
|
|
- if (FScrollBars in [ssBoth, ssHorizontal]) or
|
|
|
- (ScrollMode = smAuto) then
|
|
|
- begin
|
|
|
- FLeftCol := FLeftCol + CurX - LastVisiblePos + 2;
|
|
|
- end
|
|
|
- else
|
|
|
- CurX := LastVisiblePos;
|
|
|
- Modified := True;
|
|
|
- end;
|
|
|
- if CurY < FTopLine then
|
|
|
- begin
|
|
|
- FTopLine := CurY;
|
|
|
- if FTopLine < 0 then
|
|
|
- FTopLine := 0;
|
|
|
- Modified := True;
|
|
|
- end;
|
|
|
- if CurY > LastVisibleLine then
|
|
|
- begin
|
|
|
- if (FScrollBars in [ssBoth, ssVertical]) or
|
|
|
- (ScrollMode = smAuto) then
|
|
|
- begin
|
|
|
- FTopLine := FTopLine + CurY - LastVisibleLine;
|
|
|
- end
|
|
|
- else
|
|
|
- CurY := LastVisibleLine;
|
|
|
- Modified := True;
|
|
|
- end;
|
|
|
- if Modified then
|
|
|
- Invalidate;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// RESIZE EDITOR
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.ResizeEditor;
|
|
|
-begin
|
|
|
- ResizeScrollBars;
|
|
|
- ResizeGutter;
|
|
|
- MakeVisible;
|
|
|
- Invalidate;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// FIND TEXT
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.FindText(Text: string; Options: TFindOptions; Select:
|
|
|
- Boolean): Boolean;
|
|
|
-var
|
|
|
- i, p: integer;
|
|
|
- s1, s0, s: string;
|
|
|
- //-----------------------------------------------------------
|
|
|
- function LastPos(const Substr, s: string): integer;
|
|
|
- var
|
|
|
- i, j, lenSub: integer;
|
|
|
- begin
|
|
|
- Result := 0;
|
|
|
- lenSub := Length(Substr);
|
|
|
- i := Length(s) - lenSub + 1;
|
|
|
- while i > 0 do
|
|
|
- begin
|
|
|
- if s[i] = Substr[1] then
|
|
|
- begin
|
|
|
- Result := i;
|
|
|
- for j := i + 1 to i + lenSub - 1 do
|
|
|
- if s[j] <> Substr[j - i + 1] then
|
|
|
- begin
|
|
|
- Result := 0;
|
|
|
- break;
|
|
|
- end;
|
|
|
- end;
|
|
|
- if Result <> 0 then
|
|
|
- break;
|
|
|
- Dec(i);
|
|
|
- end;
|
|
|
- end;
|
|
|
- //-----------------------------------------------------------
|
|
|
-begin
|
|
|
- Result := False;
|
|
|
- if not (frMatchCase in Options) then
|
|
|
- Text := AnsiLowerCase(Text);
|
|
|
-
|
|
|
- if SelLength > 0 then
|
|
|
- ClearSelection;
|
|
|
- s := Lines[CurY];
|
|
|
- s0 := Copy(s, 1, CurX);
|
|
|
- s1 := Copy(s, CurX + 1, Length(s));
|
|
|
- i := CurY;
|
|
|
-
|
|
|
- while True do
|
|
|
- begin
|
|
|
-
|
|
|
- if not (frMatchCase in Options) then
|
|
|
- begin
|
|
|
- s0 := AnsiLowerCase(s0);
|
|
|
- s1 := AnsiLowerCase(s1);
|
|
|
- end;
|
|
|
-
|
|
|
- if frDown in Options then
|
|
|
- p := Pos(Text, s1)
|
|
|
- else
|
|
|
- p := LastPos(Text, s0);
|
|
|
-
|
|
|
- if p > 0 then
|
|
|
- begin
|
|
|
- Result := True;
|
|
|
- CurY := i;
|
|
|
- if frDown in Options then
|
|
|
- CurX := Length(s0) + p - 1
|
|
|
- else
|
|
|
- CurX := p - 1;
|
|
|
- if Select then
|
|
|
- begin
|
|
|
- if not (frDown in Options) then
|
|
|
- CurX := CurX + Length(Text);
|
|
|
- ClearSelection;
|
|
|
- if frDown in Options then
|
|
|
- CurX := CurX + Length(Text)
|
|
|
- else
|
|
|
- CurX := CurX - Length(Text);
|
|
|
- ExpandSelection;
|
|
|
- end;
|
|
|
- break;
|
|
|
- end;
|
|
|
-
|
|
|
- if frDown in Options then
|
|
|
- Inc(i)
|
|
|
- else
|
|
|
- Dec(i);
|
|
|
- if (i < 0) or (i > Lines.Count - 1) then
|
|
|
- break;
|
|
|
- if frDown in Options then
|
|
|
- begin
|
|
|
- s0 := '';
|
|
|
- s1 := Lines[i];
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- s0 := Lines[i];
|
|
|
- s1 := '';
|
|
|
- end;
|
|
|
-
|
|
|
- end;
|
|
|
-
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// RESIZE SCROLLBARS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.ResizeScrollBars;
|
|
|
-var
|
|
|
- eRect, sbRect: TRect;
|
|
|
- MaxLen, OldMax, NewTop, Margin: integer;
|
|
|
-begin
|
|
|
- eRect := EditorRect;
|
|
|
- if FScrollBars in [ssBoth, ssVertical] then
|
|
|
- begin
|
|
|
- with sbVert do
|
|
|
- begin
|
|
|
- Width := 16;
|
|
|
- Height := eRect.Bottom - eRect.Top + 1;
|
|
|
- Left := eRect.Right;
|
|
|
- Top := eRect.Top;
|
|
|
- OldMax := MaxPosition;
|
|
|
- MaxPosition := (Lines.Count - 1) - (LastVisibleLine - FTopLine);
|
|
|
- NewTop := FTopLine;
|
|
|
- if (FTopLine > 0) and (LastVisibleLine > Lines.Count - 1) then
|
|
|
- begin
|
|
|
- Dec(NewTop, LastVisibleLine - (Lines.Count - 1));
|
|
|
- if NewTop < 0 then
|
|
|
- NewTop := 0;
|
|
|
- MaxPosition := NewTop;
|
|
|
- end;
|
|
|
- if MaxPosition < 0 then
|
|
|
- MaxPosition := 0;
|
|
|
- Position := NewTop;
|
|
|
- Total := Lines.Count;
|
|
|
- if OldMax <> MaxPosition then
|
|
|
- begin
|
|
|
- if NewTop <> FTopLine then
|
|
|
- begin
|
|
|
- DoScroll(sbVert, NewTop - FTopLine);
|
|
|
- FGutter.Invalidate;
|
|
|
- end;
|
|
|
- sbRect := sbVert.FullRect;
|
|
|
- InvalidateRect(Handle, @sbRect, True);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- if FScrollBars in [ssBoth, ssHorizontal] then
|
|
|
- begin
|
|
|
- MaxLen := MaxLength;
|
|
|
- with sbHorz do
|
|
|
- begin
|
|
|
- Width := Self.Width - 4;
|
|
|
- if FScrollBars = ssBoth then
|
|
|
- Width := Width - sbVert.Width;
|
|
|
- Height := 16;
|
|
|
- Left := 2;
|
|
|
- Top := eRect.Bottom;
|
|
|
- OldMax := MaxPosition;
|
|
|
-
|
|
|
- Margin := LastVisiblePos - MaxLen;
|
|
|
- if Margin < 2 then
|
|
|
- Margin := 2;
|
|
|
- MaxPosition := MaxLen - (LastVisiblePos - FLeftCol) + Margin;
|
|
|
-
|
|
|
- if MaxPosition < 0 then
|
|
|
- MaxPosition := 0;
|
|
|
- Position := FLeftCol;
|
|
|
- Total := MaxLen;
|
|
|
- if OldMax <> MaxPosition then
|
|
|
- begin
|
|
|
- if MaxPosition = 0 then
|
|
|
- begin
|
|
|
- FLeftCol := 0;
|
|
|
- InvalidateRect(Handle, @eRect, True);
|
|
|
- ;
|
|
|
- FGutter.Invalidate;
|
|
|
- end;
|
|
|
- sbRect := sbHorz.FullRect;
|
|
|
- InvalidateRect(Handle, @sbRect, True);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// RESIZE GUTTER
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.ResizeGutter;
|
|
|
-var
|
|
|
- eRect: TRect;
|
|
|
-begin
|
|
|
- eRect := EditorRect;
|
|
|
- with FGutter do
|
|
|
- begin
|
|
|
- Height := eRect.Bottom - eRect.Top;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// CREATE PARAMS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.CreateParams(var Params: TCreateParams);
|
|
|
-begin
|
|
|
- inherited;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// UNDO, REDO
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.Undo;
|
|
|
-begin
|
|
|
- FUndoList.Undo;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.Redo;
|
|
|
-begin
|
|
|
- FUndoList.Redo;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SET UNDO LIMIT
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetUndoLimit(Value: integer);
|
|
|
-begin
|
|
|
- if (FUndoLimit <> Value) then
|
|
|
- begin
|
|
|
- if Value <= 0 then
|
|
|
- Value := 1;
|
|
|
- if Value > 100 then
|
|
|
- Value := 100;
|
|
|
- FUndoLimit := Value;
|
|
|
- FUndoList.Limit := Value;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// UNDO (REDO) CHANGE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.UndoChange;
|
|
|
-begin
|
|
|
- if Assigned(FOnUndoChange) then
|
|
|
- FOnUndoChange(Self, FUndoList.Pos < FUndoList.Count,
|
|
|
- FUndoList.Pos > 0);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// CAN UNDO
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.CanUndo: boolean;
|
|
|
-begin
|
|
|
- Result := FUndoList.FPos < FUndoList.Count;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// CAN REDO
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSCustomMemo.CanRedo: Boolean;
|
|
|
-begin
|
|
|
- Result := FUndoList.FPos > 0;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// CLEAR UNDO LIST
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.ClearUndoList;
|
|
|
-begin
|
|
|
- if Assigned(FUndoList) then
|
|
|
- FUndoList.Clear;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SET SCROLL BARS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSCustomMemo.SetScrollBars(Value: System.UITypes.TScrollStyle);
|
|
|
-begin
|
|
|
- if FScrollBars <> Value then
|
|
|
- begin
|
|
|
- FScrollBars := Value;
|
|
|
- if not (csLoading in ComponentState) then
|
|
|
- ResizeEditor;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// CREATE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-constructor TGLSCustomMemo.Create(AOwner: TComponent);
|
|
|
-begin
|
|
|
- inherited;
|
|
|
-
|
|
|
- ControlStyle := [csCaptureMouse, csClickEvents,
|
|
|
- csDoubleClicks, csReplicatable];
|
|
|
- Width := 100;
|
|
|
- Height := 40;
|
|
|
- TabStop := True;
|
|
|
- Cursor := crIBeam;
|
|
|
-
|
|
|
- FFont := TFont.Create;
|
|
|
- FFont.Name := 'Courier New';
|
|
|
- FFont.Size := 10;
|
|
|
- Canvas.Font.Assign(FFont);
|
|
|
-
|
|
|
- FHiddenCaret := False;
|
|
|
- FCaretVisible := False;
|
|
|
-
|
|
|
- FCurX := 0;
|
|
|
- FCurY := 0;
|
|
|
- FLeftCol := 0;
|
|
|
- FTopLine := 0;
|
|
|
- FTabSize := 4;
|
|
|
- FMargin := 2;
|
|
|
- FAutoIndent := True;
|
|
|
- FLines := TGLSMemoStrings.Create;
|
|
|
- TGLSMemoStrings(FLines).FMemo := Self;
|
|
|
-
|
|
|
- FScrollBars := ssBoth;
|
|
|
- FScrollBarWidth := 16;
|
|
|
- sbVert := TGLSMemoScrollBar.Create(Self, sbVertical);
|
|
|
- sbVert.Width := FScrollBarWidth;
|
|
|
- sbHorz := TGLSMemoScrollBar.Create(Self, sbHorizontal);
|
|
|
- sbHorz.Height := FScrollBarWidth;
|
|
|
-
|
|
|
- FGutter := TGLSMemoGutter.Create;
|
|
|
- with FGutter do
|
|
|
- begin
|
|
|
- FLeft := 2;
|
|
|
- FTop := 2;
|
|
|
- FWidth := 0;
|
|
|
- FHeight := 0;
|
|
|
- FColor := clBtnFace;
|
|
|
- FMemo := Self;
|
|
|
- end;
|
|
|
-
|
|
|
- FSelStartX := 0;
|
|
|
- FSelStartY := 0;
|
|
|
- FSelEndX := 0;
|
|
|
- FSelEndY := 0;
|
|
|
-
|
|
|
- FBkColor := clWhite;
|
|
|
- FSelColor := clWhite;
|
|
|
- FSelBkColor := clNavy;
|
|
|
-
|
|
|
- FStyles := TStyleList.Create;
|
|
|
- FStyles.Add(clBlack, clWhite, []);
|
|
|
-
|
|
|
- FSelCharPos.LineNo := -1;
|
|
|
- FSelCharPos.Pos := -1;
|
|
|
- FSelCharStyle := -1;
|
|
|
-
|
|
|
- FLineBitmap := TBitmap.Create;
|
|
|
-
|
|
|
- FLeftButtonDown := False;
|
|
|
- FScrollMode := smAuto;
|
|
|
-
|
|
|
- FUndoList := TGLSMemoUndoList.Create;
|
|
|
- FFirstUndoList := FUndoList;
|
|
|
- FUndoList.Memo := Self;
|
|
|
-
|
|
|
- FUndoLimit := 100;
|
|
|
-
|
|
|
- TGLSMemoStrings(FLines).DoAdd('');
|
|
|
-
|
|
|
- FAfterDoubleClick := False;
|
|
|
-
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// DESTROY
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-destructor TGLSCustomMemo.Destroy;
|
|
|
-begin
|
|
|
- FFont.Free;
|
|
|
- FLines.Free;
|
|
|
- FGutter.Free;
|
|
|
- sbVert.Free;
|
|
|
- sbHorz.Free;
|
|
|
- FStyles.Free;
|
|
|
- FLineBitmap.Free;
|
|
|
- FFirstUndoList.Free;
|
|
|
- inherited;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-// ---------------------TGLSMemoScrollBar functions
|
|
|
-
|
|
|
-procedure TGLSMemoScrollBar.SetParams(Index: integer; Value: integer);
|
|
|
-begin
|
|
|
- case Index of
|
|
|
- 0: if Left <> Value then
|
|
|
- FLeft := Value;
|
|
|
- 1: if Top <> Value then
|
|
|
- FTop := Value;
|
|
|
- 2: if Width <> Value then
|
|
|
- FWidth := Value;
|
|
|
- 3: if Height <> Value then
|
|
|
- FHeight := Value;
|
|
|
- 4: if Total <> Value then
|
|
|
- FTotal := Value;
|
|
|
- 5: if MaxPosition <> Value then
|
|
|
- FMaxPosition := Value;
|
|
|
- 6: if Position <> Value then
|
|
|
- FPosition := Value;
|
|
|
- end;
|
|
|
-end;
|
|
|
-//-------------------- CREATE ------------------------------
|
|
|
-
|
|
|
-constructor TGLSMemoScrollBar.Create(AParent: TGLSMemoAbstractScrollableObject;
|
|
|
- AKind: TScrollBarKind);
|
|
|
-begin
|
|
|
- FParent := AParent;
|
|
|
- FButtonLength := 16;
|
|
|
- FKind := AKind;
|
|
|
- FState := sbsWait;
|
|
|
-end;
|
|
|
-//-------------------- RECT -----------------------
|
|
|
-
|
|
|
-function TGLSMemoScrollBar.GetRect: TRect;
|
|
|
-begin
|
|
|
- Result := Rect(Left, Top, Left + Width, Top + Height);
|
|
|
-end;
|
|
|
-//-------------------- GET THUMB RECT -----------------------
|
|
|
-
|
|
|
-function TGLSMemoScrollBar.GetThumbRect: TRect;
|
|
|
-var
|
|
|
- TotalLen, FreeLen, ThumbLen, ThumbOffset, ThumbCoord: integer;
|
|
|
- K: double;
|
|
|
-begin
|
|
|
- if MaxPosition <= 0 then
|
|
|
- begin
|
|
|
- Result := Rect(0, 0, 0, 0);
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- if Kind = sbVertical then
|
|
|
- TotalLen := Height
|
|
|
- else
|
|
|
- TotalLen := Width;
|
|
|
- FreeLen := TotalLen - 2 * FButtonLength;
|
|
|
-
|
|
|
- K := (Total - MaxPosition) / MaxPosition;
|
|
|
- if K > 0 then
|
|
|
- begin
|
|
|
- ThumbLen := round(FreeLen * K / (1 + K));
|
|
|
- if ThumbLen < 8 then
|
|
|
- ThumbLen := 8;
|
|
|
- end
|
|
|
- else
|
|
|
- ThumbLen := 8;
|
|
|
-
|
|
|
- if ThumbLen >= FreeLen then
|
|
|
- Result := Rect(0, 0, 0, 0)
|
|
|
- else
|
|
|
- begin
|
|
|
- ThumbOffset := round((FreeLen - ThumbLen) * Position / MaxPosition);
|
|
|
- ThumbCoord := FButtonLength + ThumbOffset;
|
|
|
- if Kind = sbVertical then
|
|
|
- Result := Rect(Left + 1, Top + ThumbCoord, Left + Width, Top + ThumbCoord
|
|
|
- + ThumbLen)
|
|
|
- else
|
|
|
- Result := Rect(Left + ThumbCoord, Top + 1, Left + ThumbCoord + ThumbLen,
|
|
|
- Top + Height);
|
|
|
- end;
|
|
|
-end;
|
|
|
-//-------------------- GET Back RECT -----------------------
|
|
|
-
|
|
|
-function TGLSMemoScrollBar.GetBackRect: TRect;
|
|
|
-begin
|
|
|
- if Kind = sbVertical then
|
|
|
- Result := Rect(Left + 1, Top, Left + Width, Top + FButtonLength)
|
|
|
- else
|
|
|
- Result := Rect(Left, Top + 1, Left + FButtonLength, Top + Height);
|
|
|
-end;
|
|
|
-//-------------------- GET MIDDLE RECT -----------------------
|
|
|
-
|
|
|
-function TGLSMemoScrollBar.GetMiddleRect: TRect;
|
|
|
-var
|
|
|
- bRect, fRect: TRect;
|
|
|
-begin
|
|
|
- bRect := BackRect;
|
|
|
- fRect := ForwardRect;
|
|
|
- if Kind = sbVertical then
|
|
|
- Result := Rect(Left + 1, bRect.Bottom, Left + Width, fRect.Top)
|
|
|
- else
|
|
|
- Result := Rect(bRect.Right, Top + 1, fRect.Left, Top + Height);
|
|
|
-end;
|
|
|
-//-------------------- GET Forward RECT -----------------------
|
|
|
-
|
|
|
-function TGLSMemoScrollBar.GetForwardRect: TRect;
|
|
|
-begin
|
|
|
- if Kind = sbVertical then
|
|
|
- Result := Rect(Left + 1, Top + Height - FButtonLength, Left + Width, Top +
|
|
|
- Height)
|
|
|
- else
|
|
|
- Result := Rect(Left + Width - FButtonLength, Top + 1, Left + Width, Top +
|
|
|
- Height);
|
|
|
-end;
|
|
|
-//-------------------- GET PAGE BACK RECT -----------------------
|
|
|
-
|
|
|
-function TGLSMemoScrollBar.GetPgBackRect: TRect;
|
|
|
-var
|
|
|
- thRect: TRect;
|
|
|
-begin
|
|
|
- thRect := GetThumbRect;
|
|
|
- if thRect.Bottom = 0 then
|
|
|
- begin
|
|
|
- Result := Rect(0, 0, 0, 0);
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- if Kind = sbVertical then
|
|
|
- Result := Rect(Left + 1, Top + FButtonLength, Left + Width, thRect.Top - 1)
|
|
|
- else
|
|
|
- Result := Rect(Left + FButtonLength, Top + 1, thRect.Left - 1, Top +
|
|
|
- Height);
|
|
|
-end;
|
|
|
-//-------------------- GET PG FORWARD RECT -----------------------
|
|
|
-
|
|
|
-function TGLSMemoScrollBar.GetPgForwardRect: TRect;
|
|
|
-var
|
|
|
- thRect: TRect;
|
|
|
-begin
|
|
|
- thRect := GetThumbRect;
|
|
|
- if thRect.Bottom = 0 then
|
|
|
- begin
|
|
|
- Result := Rect(0, 0, 0, 0);
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- if Kind = sbVertical then
|
|
|
- Result := Rect(Left + 1, thRect.Bottom, Left + Width, Top + Height -
|
|
|
- FButtonLength)
|
|
|
- else
|
|
|
- Result := Rect(thRect.Right, Top + 1, Left + Width - FButtonLength, Top +
|
|
|
- Height);
|
|
|
-end;
|
|
|
-//-------------------- PAINT TO -----------------------
|
|
|
-
|
|
|
-procedure TGLSMemoScrollBar.PaintTo(ACanvas: TCanvas);
|
|
|
-var
|
|
|
- sRect, mRect, gRect, thRect: TRect;
|
|
|
- iconX, iconY, shift: integer;
|
|
|
-begin
|
|
|
- with ACanvas do
|
|
|
- begin
|
|
|
- if Kind = sbVertical then
|
|
|
- begin
|
|
|
- Pen.Color := clSilver;
|
|
|
- MoveTo(Left, Top);
|
|
|
- LineTo(Left, Top + Height);
|
|
|
-
|
|
|
- sRect := BackRect;
|
|
|
- Brush.Color := clSilver;
|
|
|
- FillRect(sRect);
|
|
|
- if State = sbsBack then
|
|
|
- begin
|
|
|
- shift := 1;
|
|
|
- Pen.Color := clGray;
|
|
|
- with sRect do
|
|
|
- Rectangle(Left, Top, Right, Bottom);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- shift := 0;
|
|
|
- Border(ACanvas, sRect, btFlatRaised);
|
|
|
- end;
|
|
|
- iconX := sRect.Left + (Width - 1 - 7) div 2;
|
|
|
- iconY := sRect.Top + (FButtonLength - 8) div 2;
|
|
|
- Draw(iconX + shift, iconY + shift, bmScrollBarUp);
|
|
|
-
|
|
|
- gRect := ForwardRect;
|
|
|
- Brush.Color := clSilver;
|
|
|
- FillRect(gRect);
|
|
|
- if State = sbsForward then
|
|
|
- begin
|
|
|
- shift := 1;
|
|
|
- Pen.Color := clGray;
|
|
|
- with gRect do
|
|
|
- Rectangle(Left, Top, Right, Bottom);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- shift := 0;
|
|
|
- Border(ACanvas, gRect, btFlatRaised);
|
|
|
- end;
|
|
|
- iconX := gRect.Left + (Width - 1 - 7) div 2;
|
|
|
- iconY := gRect.Top + (FButtonLength - 8) div 2;
|
|
|
- Draw(iconX + shift, iconY + shift, bmScrollBarDown);
|
|
|
-
|
|
|
- mRect := Rect(sRect.Left, sRect.Bottom, gRect.Right, gRect.Top);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- Pen.Color := clSilver;
|
|
|
- MoveTo(Left, Top);
|
|
|
- LineTo(Left + Width, Top);
|
|
|
-
|
|
|
- sRect := BackRect;
|
|
|
- Brush.Color := clSilver;
|
|
|
- FillRect(sRect);
|
|
|
- if State = sbsBack then
|
|
|
- begin
|
|
|
- shift := 1;
|
|
|
- Pen.Color := clGray;
|
|
|
- with sRect do
|
|
|
- Rectangle(Left, Top, Right, Bottom);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- shift := 0;
|
|
|
- Border(ACanvas, sRect, btFlatRaised);
|
|
|
- end;
|
|
|
- iconX := sRect.Left + shift + (FButtonLength - 8) div 2;
|
|
|
- iconY := sRect.Top + shift + (Height - 1 - 7) div 2;
|
|
|
- Draw(iconX + shift, iconY + shift, bmScrollBarLeft);
|
|
|
-
|
|
|
- gRect := ForwardRect;
|
|
|
- Brush.Color := clSilver;
|
|
|
- FillRect(gRect);
|
|
|
- if State = sbsForward then
|
|
|
- begin
|
|
|
- shift := 1;
|
|
|
- Pen.Color := clGray;
|
|
|
- with gRect do
|
|
|
- Rectangle(Left, Top, Right, Bottom);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- shift := 0;
|
|
|
- Border(ACanvas, gRect, btFlatRaised);
|
|
|
- end;
|
|
|
- iconX := gRect.Left + (FButtonLength - 8) div 2;
|
|
|
- iconY := gRect.Top + (Height - 1 - 7) div 2;
|
|
|
- Draw(iconX + shift, iconY + shift, bmScrollBarRight);
|
|
|
-
|
|
|
- mRect := Rect(sRect.Right, sRect.Top, gRect.Left, gRect.Bottom);
|
|
|
- end;
|
|
|
-
|
|
|
- Brush.Bitmap := bmScrollBarFill;
|
|
|
- FillRect(mRect);
|
|
|
- Brush.Bitmap := nil;
|
|
|
- if State = sbsPageBack then
|
|
|
- begin
|
|
|
- Brush.Color := clGray;
|
|
|
- FillRect(PageBackRect);
|
|
|
- end;
|
|
|
- if State = sbsPageForward then
|
|
|
- begin
|
|
|
- Brush.Color := clGray;
|
|
|
- FillRect(PageForwardRect);
|
|
|
- end;
|
|
|
-
|
|
|
- thRect := ThumbRect;
|
|
|
- Brush.Color := clSilver;
|
|
|
- FillRect(thRect);
|
|
|
- Border(ACanvas, thRect, btFlatRaised);
|
|
|
- end;
|
|
|
-end;
|
|
|
-//-------------------- SET STATE ----------
|
|
|
-
|
|
|
-procedure TGLSMemoScrollBar.SetState(Value: TsbState);
|
|
|
-begin
|
|
|
- if FState <> Value then
|
|
|
- begin
|
|
|
- FState := Value;
|
|
|
- end;
|
|
|
-end;
|
|
|
-//-------------------- MOUSE DOWN ------------
|
|
|
-
|
|
|
-function TGLSMemoScrollBar.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
|
- X,
|
|
|
- Y: Integer):
|
|
|
- Boolean;
|
|
|
-var
|
|
|
- sRect, gRect, thRect, pbRect, pfRect: TRect;
|
|
|
-begin
|
|
|
- Result := False;
|
|
|
- if (Width = 0) or (Height = 0) then
|
|
|
- Exit;
|
|
|
- sRect := BackRect;
|
|
|
- gRect := ForwardRect;
|
|
|
- pbRect := PageBackRect;
|
|
|
- pfRect := PageForwardRect;
|
|
|
- thRect := ThumbRect;
|
|
|
- if PointInRect(Point(X, Y), sRect) then
|
|
|
- begin
|
|
|
- State := sbsBack;
|
|
|
- InvalidateRect(Parent.Handle, @sRect, True);
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- if PointInRect(Point(X, Y), gRect) then
|
|
|
- begin
|
|
|
- State := sbsForward;
|
|
|
- InvalidateRect(Parent.Handle, @gRect, True);
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- if PointInRect(Point(X, Y), pbRect) then
|
|
|
- begin
|
|
|
- State := sbsPageBack;
|
|
|
- InvalidateRect(Parent.Handle, @pbRect, True);
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- if PointInRect(Point(X, Y), pfRect) then
|
|
|
- begin
|
|
|
- State := sbsPageForward;
|
|
|
- InvalidateRect(Parent.Handle, @pfRect, True);
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- if PointInRect(Point(X, Y), thRect) then
|
|
|
- begin
|
|
|
- State := sbsDragging;
|
|
|
- FXOffset := X - thRect.Left;
|
|
|
- FYOffset := Y - thRect.Top;
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
-
|
|
|
-end;
|
|
|
-//-------------------- MOUSE UP ----------
|
|
|
-
|
|
|
-function TGLSMemoScrollBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
|
|
|
- Y:
|
|
|
- Integer):
|
|
|
- Boolean;
|
|
|
-var
|
|
|
- sRect, gRect, thRect, pbRect, pfRect: TRect;
|
|
|
-begin
|
|
|
- Result := False;
|
|
|
- if (Width = 0) or (Height = 0) then
|
|
|
- Exit;
|
|
|
- sRect := BackRect;
|
|
|
- gRect := ForwardRect;
|
|
|
- pbRect := PageBackRect;
|
|
|
- pfRect := PageForwardRect;
|
|
|
- thRect := ThumbRect;
|
|
|
- case State of
|
|
|
- sbsBack:
|
|
|
- begin
|
|
|
- State := sbsWait;
|
|
|
- InvalidateRect(Parent.Handle, @sRect, True);
|
|
|
- FParent.DoScroll(Self, -1);
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- sbsForward:
|
|
|
- begin
|
|
|
- State := sbsWait;
|
|
|
- InvalidateRect(Parent.Handle, @gRect, True);
|
|
|
- FParent.DoScroll(Self, 1);
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- sbsPageBack:
|
|
|
- begin
|
|
|
- State := sbsWait;
|
|
|
- InvalidateRect(Parent.Handle, @pbRect, True);
|
|
|
- FParent.DoScrollPage(Self, -1);
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- sbsPageForward:
|
|
|
- begin
|
|
|
- State := sbsWait;
|
|
|
- InvalidateRect(Parent.Handle, @pfRect, True);
|
|
|
- FParent.DoScrollPage(Self, 1);
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- sbsDragging:
|
|
|
- begin
|
|
|
- State := sbsWait;
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-//-------------------- MOUSE MOVE -----------
|
|
|
-
|
|
|
-function TGLSMemoScrollBar.MouseMove(Shift: TShiftState; X, Y: Integer):
|
|
|
- Boolean;
|
|
|
-var
|
|
|
- sRect, gRect, thRect, pbRect, pfRect: TRect;
|
|
|
-begin
|
|
|
- Result := False;
|
|
|
- if (Width = 0) or (Height = 0) then
|
|
|
- Exit;
|
|
|
- sRect := BackRect;
|
|
|
- gRect := ForwardRect;
|
|
|
- pbRect := PageBackRect;
|
|
|
- pfRect := PageForwardRect;
|
|
|
- thRect := ThumbRect;
|
|
|
- case State of
|
|
|
- sbsBack:
|
|
|
- if not PointInRect(Point(X, Y), sRect) then
|
|
|
- begin
|
|
|
- State := sbsWait;
|
|
|
- InvalidateRect(Parent.Handle, @sRect, True);
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- sbsForward:
|
|
|
- if not PointInRect(Point(X, Y), gRect) then
|
|
|
- begin
|
|
|
- State := sbsWait;
|
|
|
- InvalidateRect(Parent.Handle, @gRect, True);
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- sbsPageBack:
|
|
|
- if not PointInRect(Point(X, Y), pbRect) then
|
|
|
- begin
|
|
|
- State := sbsWait;
|
|
|
- InvalidateRect(Parent.Handle, @pbRect, True);
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- sbsPageForward:
|
|
|
- if not PointInRect(Point(X, Y), pfRect) then
|
|
|
- begin
|
|
|
- State := sbsWait;
|
|
|
- InvalidateRect(Parent.Handle, @pfRect, True);
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- sbsDragging:
|
|
|
- begin
|
|
|
- MoveThumbTo(X, Y);
|
|
|
- Result := True;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-//-------------------- MOVE THUMB TO ------------
|
|
|
-
|
|
|
-function TGLSMemoScrollBar.MoveThumbTo(X, Y: Integer): integer;
|
|
|
-var
|
|
|
- thRect, mRect: TRect;
|
|
|
- FreeLen, ThumbLen, NewPosition, NewOffset: integer;
|
|
|
-begin
|
|
|
- thRect := ThumbRect;
|
|
|
- mRect := MiddleRect;
|
|
|
- NewOffset := 0;
|
|
|
- FreeLen := 0;
|
|
|
- ThumbLen := 0;
|
|
|
- case Kind of
|
|
|
- sbVertical:
|
|
|
- begin
|
|
|
- FreeLen := mRect.Bottom - mRect.Top;
|
|
|
- ThumbLen := thRect.Bottom - thRect.Top;
|
|
|
- NewOffset := Y - FYOffset - (Top + FButtonLength);
|
|
|
- end;
|
|
|
- sbHorizontal:
|
|
|
- begin
|
|
|
- FreeLen := mRect.Right - mRect.Left;
|
|
|
- ThumbLen := thRect.Right - thRect.Left;
|
|
|
- NewOffset := X - FXOffset - (Left + FButtonLength);
|
|
|
- end
|
|
|
- end;
|
|
|
- NewPosition := round(NewOffset * MaxPosition / (FreeLen - ThumbLen));
|
|
|
- Result := NewPosition - Position;
|
|
|
- if NewPosition <> Position then
|
|
|
- begin
|
|
|
- Parent.DoScroll(Self, NewPosition - Position);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// GUTTER
|
|
|
-//--------------------------------------------------------------
|
|
|
-//-------------------- SET PARAMS -----------------------
|
|
|
-
|
|
|
-procedure TGLSMemoGutter.SetParams(Index: integer; Value: integer);
|
|
|
-begin
|
|
|
- case Index of
|
|
|
- 0: FLeft := Value;
|
|
|
- 1: FTop := Value;
|
|
|
- 2: FWidth := Value;
|
|
|
- 3: FHeight := Value;
|
|
|
- end;
|
|
|
-end;
|
|
|
-//-------------------- PAINT TO -----------------------
|
|
|
-
|
|
|
-procedure TGLSMemoGutter.PaintTo(ACanvas: TCanvas);
|
|
|
-var
|
|
|
- LineNo, T, H: integer;
|
|
|
-begin
|
|
|
- with ACanvas do
|
|
|
- begin
|
|
|
- Pen.Color := clGray;
|
|
|
- MoveTo(Left + Width - 1, Top);
|
|
|
- LineTo(Left + Width - 1, Top + Height);
|
|
|
- Pen.Color := clWhite;
|
|
|
- MoveTo(Left + Width - 2, Top);
|
|
|
- LineTo(Left + Width - 2, Top + Height);
|
|
|
- Brush.Color := Self.FColor;
|
|
|
- FillRect(Rect(Left, Top, Left + Width - 2, Top + Height));
|
|
|
- if Assigned(FMemo.OnGutterDraw) then
|
|
|
- begin
|
|
|
- T := Top;
|
|
|
- H := FMemo.FCellSize.H;
|
|
|
- LineNo := FMemo.FTopLine;
|
|
|
- while T < Top + Height do
|
|
|
- begin
|
|
|
- FMemo.OnGutterDraw(FMemo, ACanvas, LineNo,
|
|
|
- Rect(Left, T, Left + Width - 2, T + H));
|
|
|
- T := T + H;
|
|
|
- Inc(LineNo);
|
|
|
- if LineNo >= FMemo.Lines.Count then
|
|
|
- break;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//-------------------- INVALIDATE -----------------------
|
|
|
-
|
|
|
-procedure TGLSMemoGutter.Invalidate;
|
|
|
-var
|
|
|
- gRect: TRect;
|
|
|
-begin
|
|
|
- gRect := Rect(Left, Top, Left + Width, Top + Height);
|
|
|
- InvalidateRect(FMemo.Handle, @gRect, True);
|
|
|
-end;
|
|
|
-
|
|
|
-//-------------------- GET RECT -----------------------
|
|
|
-
|
|
|
-function TGLSMemoGutter.GetRect: TRect;
|
|
|
-begin
|
|
|
- Result := Rect(Left, Top, Left + Width, Top + Height);
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-// ---------------------TStyleList
|
|
|
-
|
|
|
-procedure TStyleList.CheckRange(Index: integer);
|
|
|
-begin
|
|
|
- if (Index < 0) or (Index >= Count) then
|
|
|
- raise EListError.Create('Incorrect list item index ' + IntToStr(Index));
|
|
|
-end;
|
|
|
-//-------------------- DESTROY ---------------------------
|
|
|
-
|
|
|
-destructor TStyleList.Destroy;
|
|
|
-begin
|
|
|
- Clear;
|
|
|
- inherited;
|
|
|
-end;
|
|
|
-//-------------------- CHANGE ---------------------------
|
|
|
-
|
|
|
-procedure TStyleList.Change(Index: integer; ATextColor, ABkCOlor: TColor;
|
|
|
- AStyle: TFontStyles);
|
|
|
-var
|
|
|
- P: TCharStyle;
|
|
|
-begin
|
|
|
- CheckRange(Index);
|
|
|
- P := TCharStyle(Items[Index]);
|
|
|
- P.TextColor := ATextColor;
|
|
|
- P.BkColor := ABkColor;
|
|
|
- P.Style := AStyle;
|
|
|
-end;
|
|
|
-//-------------------- ADD ---------------------------
|
|
|
-
|
|
|
-function TStyleList.Add(ATextColor, ABkColor: TColor; AStyle: TFontStyles):
|
|
|
- Integer;
|
|
|
-var
|
|
|
- P: TCharStyle;
|
|
|
-begin
|
|
|
- P := TCharStyle.Create;
|
|
|
- with P do
|
|
|
- begin
|
|
|
- TextColor := ATextColor;
|
|
|
- BkColor := ABkColor;
|
|
|
- Style := AStyle;
|
|
|
- end;
|
|
|
- Result := inherited Add(P);
|
|
|
-end;
|
|
|
-//-------------------- CLEAR ---------------------------
|
|
|
-
|
|
|
-procedure TStyleList.Clear;
|
|
|
-begin
|
|
|
- while Count > 0 do
|
|
|
- Delete(0);
|
|
|
-end;
|
|
|
-//-------------------- DELETE ---------------------------
|
|
|
-
|
|
|
-procedure TStyleList.Delete(Index: Integer);
|
|
|
-var
|
|
|
- P: TCharStyle;
|
|
|
-begin
|
|
|
- CheckRange(Index);
|
|
|
- P := TCharStyle(Items[Index]);
|
|
|
- P.Free;
|
|
|
- inherited;
|
|
|
-end;
|
|
|
-//-------------------- GET/SET TEXT COLOR ---------------------------
|
|
|
-
|
|
|
-function TStyleList.GetTextColor(Index: Integer): TColor;
|
|
|
-begin
|
|
|
- CheckRange(Index);
|
|
|
- Result := TCharStyle(Items[Index]).TextColor;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TStyleList.SetTextColor(Index: Integer; Value: TColor);
|
|
|
-begin
|
|
|
- CheckRange(Index);
|
|
|
- TCharStyle(Items[Index]).TextColor := Value;
|
|
|
-end;
|
|
|
-//-------------------- GET/SET BK COLOR ---------------------------
|
|
|
-
|
|
|
-function TStyleList.GetBkColor(Index: Integer): TColor;
|
|
|
-begin
|
|
|
- CheckRange(Index);
|
|
|
- Result := TCharStyle(Items[Index]).BkColor;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TStyleList.SetBkColor(Index: Integer; Value: TColor);
|
|
|
-begin
|
|
|
- CheckRange(Index);
|
|
|
- TCharStyle(Items[Index]).BkColor := Value;
|
|
|
-end;
|
|
|
-//-------------------- GET/SET STYLE ---------------------------
|
|
|
-
|
|
|
-function TStyleList.GetStyle(Index: Integer): TFontStyles;
|
|
|
-begin
|
|
|
- CheckRange(Index);
|
|
|
- Result := TCharStyle(Items[Index]).Style;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TStyleList.SetStyle(Index: Integer; Value: TFontStyles);
|
|
|
-begin
|
|
|
- CheckRange(Index);
|
|
|
- TCharStyle(Items[Index]).Style := Value;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-// ---------------------TGLSMemoStrings
|
|
|
-
|
|
|
-destructor TGLSMemoStrings.Destroy;
|
|
|
-var
|
|
|
- P: TObject;
|
|
|
-begin
|
|
|
- while Count > 0 do
|
|
|
- begin
|
|
|
- P := inherited GetObject(0);
|
|
|
- P.Free;
|
|
|
- inherited Delete(0);
|
|
|
- end;
|
|
|
- inherited;
|
|
|
-end;
|
|
|
-//-------------------- CLEAR ----------------------
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.Clear;
|
|
|
-begin
|
|
|
- while Count > 0 do
|
|
|
- begin
|
|
|
- Delete(0);
|
|
|
- if (Count = 1) and (Strings[0] = '') then
|
|
|
- break;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//-------------------- ASSIGN ----------------------
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.Assign(Source: TPersistent);
|
|
|
-var
|
|
|
- P: TObject;
|
|
|
-begin
|
|
|
- if Source is TStrings then
|
|
|
- begin
|
|
|
- BeginUpdate;
|
|
|
- try
|
|
|
- while Count > 0 do
|
|
|
- begin
|
|
|
- P := inherited GetObject(0);
|
|
|
- P.Free;
|
|
|
- inherited Delete(0);
|
|
|
- end;
|
|
|
- // inherited Clear;
|
|
|
- AddStrings(TStrings(Source));
|
|
|
- finally
|
|
|
- EndUpdate;
|
|
|
- end;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- inherited Assign(Source);
|
|
|
-end;
|
|
|
-
|
|
|
-//-------------------- ADD ----------------------
|
|
|
-
|
|
|
-function TGLSMemoStrings.DoAdd(const S: string): Integer;
|
|
|
-begin
|
|
|
- Result := inherited AddObject(S, nil);
|
|
|
-end;
|
|
|
-//-------------------- ADD ----------------------
|
|
|
-
|
|
|
-function TGLSMemoStrings.Add(const S: string): Integer;
|
|
|
-begin
|
|
|
- if Assigned(FMemo.Parent) then
|
|
|
- Result := FMemo.AddString(S)
|
|
|
- else
|
|
|
- Result := DoAdd(S);
|
|
|
-end;
|
|
|
-//-------------------- OBJECT ----------------------
|
|
|
-
|
|
|
-function TGLSMemoStrings.AddObject(const S: string; AObject: TObject): Integer;
|
|
|
-begin
|
|
|
- if AObject <> nil then
|
|
|
- raise EInvalidOp.Create(SObjectsNotSupported);
|
|
|
- Result := DoAdd(S);
|
|
|
-end;
|
|
|
-//-------------------- INSERT ----------------------
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.InsertObject(Index: Integer;
|
|
|
- const S: string; AObject: TObject);
|
|
|
-begin
|
|
|
- if AObject <> nil then
|
|
|
- raise EInvalidOp.Create(SObjectsNotSupported);
|
|
|
- DoInsert(Index, S);
|
|
|
-end;
|
|
|
-//-------------------- DO INSERT ----------------------
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.DoInsert(Index: Integer; const S: string);
|
|
|
-begin
|
|
|
- InsertItem(Index, S, nil);
|
|
|
-end;
|
|
|
-//-------------------- INSERT ----------------------
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.Insert(Index: Integer; const S: string);
|
|
|
-begin
|
|
|
- if Assigned(FMemo) then
|
|
|
- FMemo.InsertString(Index, S)
|
|
|
- else
|
|
|
- DoInsert(Index, S);
|
|
|
-end;
|
|
|
-//-------------------- DELETE ----------------------
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.Delete(Index: Integer);
|
|
|
-var
|
|
|
- P: TObject;
|
|
|
-begin
|
|
|
- if (Index < 0) or (Index > Count - 1) then
|
|
|
- Exit;
|
|
|
- if FDeleting or (not Assigned(FMemo)) then
|
|
|
- begin
|
|
|
- P := inherited GetObject(Index);
|
|
|
- P.Free;
|
|
|
- inherited;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- FMemo.DeleteLine(Index, -1, -1, -1, -1, True);
|
|
|
- end;
|
|
|
-end;
|
|
|
-//-------------------- LOAD FROM FILE ----------------------
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.LoadFromFile(const FileName: string);
|
|
|
-begin
|
|
|
- with FMemo do
|
|
|
- begin
|
|
|
- ClearSelection;
|
|
|
- ClearUndoList;
|
|
|
- CurX := 0;
|
|
|
- CurY := 0;
|
|
|
- end;
|
|
|
- Clear;
|
|
|
- inherited;
|
|
|
- FMemo.Invalidate;
|
|
|
-end;
|
|
|
-//-------------------- SET UPDATE STATE ----------------------
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.SetUpdateState(Updating: Boolean);
|
|
|
-begin
|
|
|
- if Updating then
|
|
|
- Inc(FLockCount)
|
|
|
- else if FLockCount > 0 then
|
|
|
- Dec(FLockCount);
|
|
|
-end;
|
|
|
-//-------------------- CHECK RANGE ---------------------------
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.CheckRange(Index: integer);
|
|
|
-begin
|
|
|
- if (Index < 0) or (Index >= Count) then
|
|
|
- raise EListError('Incorrect index of list item ' + IntToStr(Index));
|
|
|
-end;
|
|
|
-//-------------------- GET OBJECT ---------------------------
|
|
|
-
|
|
|
-function TGLSMemoStrings.GetObject(Index: Integer): TObject;
|
|
|
-begin
|
|
|
- CheckRange(Index);
|
|
|
- Result := inherited GetObject(Index);
|
|
|
- if Assigned(Result) and (Result is TLineProp) then
|
|
|
- Result := TLineProp(Result).FObject;
|
|
|
-end;
|
|
|
-//-------------------- PUT OBJECT ---------------------------
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.PutObject(Index: Integer; AObject: TObject);
|
|
|
-var
|
|
|
- P: TObject;
|
|
|
-begin
|
|
|
- CheckRange(Index);
|
|
|
- P := Objects[Index];
|
|
|
- if Assigned(P) and (P is TLineProp) then
|
|
|
- TLineProp(P).FObject := AObject
|
|
|
- else
|
|
|
- inherited PutObject(Index, AObject);
|
|
|
-end;
|
|
|
-//-------------------- GET LINE PROP ---------------------------
|
|
|
-
|
|
|
-function TGLSMemoStrings.GetLineProp(Index: integer): TLineProp;
|
|
|
-var
|
|
|
- P: TObject;
|
|
|
-begin
|
|
|
- CheckRange(Index);
|
|
|
- Result := nil;
|
|
|
- P := inherited GetObject(Index);
|
|
|
- if Assigned(P) and (P is TLineProp) then
|
|
|
- Result := TLineProp(P);
|
|
|
-end;
|
|
|
-
|
|
|
-//-------------------- CREATE PROP --------------------------
|
|
|
-
|
|
|
-function TGLSMemoStrings.CreateProp(Index: integer): TLineProp;
|
|
|
-begin
|
|
|
- Result := TLineProp.Create;
|
|
|
- with Result do
|
|
|
- begin
|
|
|
- FStyleNo := 0;
|
|
|
- FInComment := False;
|
|
|
- FInBrackets := -1;
|
|
|
- FValidAttrs := False;
|
|
|
- FCharAttrs := '';
|
|
|
- FObject := Objects[Index];
|
|
|
- end;
|
|
|
- inherited PutObject(Index, Result);
|
|
|
-end;
|
|
|
-
|
|
|
-//-------------------- GET LINE STYLE --------------------------
|
|
|
-
|
|
|
-function TGLSMemoStrings.GetLineStyle(Index: integer): integer;
|
|
|
-var
|
|
|
- P: TLineProp;
|
|
|
-begin
|
|
|
- P := LineProp[Index];
|
|
|
- if P = nil then
|
|
|
- Result := 0
|
|
|
- else
|
|
|
- Result := P.FStyleNo;
|
|
|
-end;
|
|
|
-
|
|
|
-//-------------------- SET LINE STYLE --------------------------
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.SetLineStyle(Index: integer; Value: integer);
|
|
|
-var
|
|
|
- P: TLineProp;
|
|
|
-begin
|
|
|
- P := LineProp[Index];
|
|
|
- if P = nil then
|
|
|
- P := CreateProp(Index);
|
|
|
- P.FStyleNo := Value;
|
|
|
-end;
|
|
|
-
|
|
|
-//-------------------- GET/SET IN COMMENT ---------------------------
|
|
|
-
|
|
|
-function TGLSMemoStrings.GetInComment(Index: Integer): Boolean;
|
|
|
-var
|
|
|
- P: TLineProp;
|
|
|
-begin
|
|
|
- P := LineProp[Index];
|
|
|
- if P = nil then
|
|
|
- Result := False
|
|
|
- else
|
|
|
- Result := P.FInComment;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.SetInComment(Index: Integer; Value: Boolean);
|
|
|
-var
|
|
|
- P: TLineProp;
|
|
|
-begin
|
|
|
- P := LineProp[Index];
|
|
|
- if P = nil then
|
|
|
- P := CreateProp(Index);
|
|
|
- P.FInComment := Value;
|
|
|
-end;
|
|
|
-
|
|
|
-//-------------------- GET/SET IN BRACKETS ---------------------------
|
|
|
-
|
|
|
-function TGLSMemoStrings.GetInBrackets(Index: Integer): integer;
|
|
|
-var
|
|
|
- P: TLineProp;
|
|
|
-begin
|
|
|
- P := LineProp[Index];
|
|
|
- if P = nil then
|
|
|
- Result := -1
|
|
|
- else
|
|
|
- Result := P.FInBrackets;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.SetInBrackets(Index: Integer; Value: integer);
|
|
|
-var
|
|
|
- P: TLineProp;
|
|
|
-begin
|
|
|
- P := LineProp[Index];
|
|
|
- if P = nil then
|
|
|
- P := CreateProp(Index);
|
|
|
- P.FInBrackets := Value;
|
|
|
-end;
|
|
|
-
|
|
|
-//-------------------- GET/SET VALID ATTRS ---------------------------
|
|
|
-
|
|
|
-function TGLSMemoStrings.GetValidAttrs(Index: Integer): Boolean;
|
|
|
-var
|
|
|
- P: TLineProp;
|
|
|
-begin
|
|
|
- P := LineProp[Index];
|
|
|
- if P = nil then
|
|
|
- Result := False
|
|
|
- else
|
|
|
- Result := P.FValidAttrs;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.SetValidAttrs(Index: Integer; Value: Boolean);
|
|
|
-var
|
|
|
- P: TLineProp;
|
|
|
-begin
|
|
|
- P := LineProp[Index];
|
|
|
- if P = nil then
|
|
|
- P := CreateProp(Index);
|
|
|
- P.FValidAttrs := Value;
|
|
|
-end;
|
|
|
-//-------------------- GET/SET CHAR ATTRS ---------------------------
|
|
|
-
|
|
|
-function TGLSMemoStrings.GetCharAttrs(Index: Integer): string;
|
|
|
-var
|
|
|
- P: TLineProp;
|
|
|
-begin
|
|
|
- P := LineProp[Index];
|
|
|
- if P = nil then
|
|
|
- Result := ''
|
|
|
- else
|
|
|
- Result := P.FCharAttrs;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoStrings.SetCharAttrs(Index: Integer; const Value: string);
|
|
|
-var
|
|
|
- P: TLineProp;
|
|
|
-begin
|
|
|
- P := LineProp[Index];
|
|
|
- if P = nil then
|
|
|
- P := CreateProp(Index);
|
|
|
- P.FCharAttrs := Value;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-// ---------------------TGLSMemoUndo
|
|
|
-
|
|
|
-constructor TGLSMemoUndo.Create(ACurX0, ACurY0, ACurX, ACurY: integer; const AText:
|
|
|
- string);
|
|
|
-begin
|
|
|
- inherited Create;
|
|
|
- FUndoCurX0 := ACurX0;
|
|
|
- FUndoCurY0 := ACurY0;
|
|
|
- FUndoCurX := ACurX;
|
|
|
- FUndoCurY := ACurY;
|
|
|
- FUndoText := AText;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoUndo.Undo;
|
|
|
-begin
|
|
|
- if Assigned(FMemo) then
|
|
|
- with FMemo do
|
|
|
- begin
|
|
|
- CurY := FUndoCurY;
|
|
|
- CurX := FUndoCurX;
|
|
|
- PerformUndo;
|
|
|
- CurY := FUndoCurY0;
|
|
|
- CurX := FUndoCurX0;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoUndo.Redo;
|
|
|
-begin
|
|
|
- if Assigned(FMemo) then
|
|
|
- with FMemo do
|
|
|
- begin
|
|
|
- CurY := FUndoCurY0;
|
|
|
- CurX := FUndoCurX0;
|
|
|
- PerformRedo;
|
|
|
- CurY := FUndoCurY;
|
|
|
- CurX := FUndoCurX;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-function TGLSMemoUndo.Append(NewUndo: TGLSMemoUndo): Boolean;
|
|
|
-begin
|
|
|
- Result := False;
|
|
|
-end;
|
|
|
-
|
|
|
-//---------------- TINSERT CHAR UNDO --------------------------
|
|
|
-
|
|
|
-procedure TGLSMemoInsCharUndo.PerformUndo;
|
|
|
-var
|
|
|
- i: integer;
|
|
|
- CurrLine: string;
|
|
|
-begin
|
|
|
- for i := Length(FUndoText) downto 1 do
|
|
|
- begin
|
|
|
- CurrLine := FMemo.Lines[FMemo.CurY];
|
|
|
- if ((FUndoText[i] = #13) and (FMemo.CurX = 0)) or
|
|
|
- (FUndoText[i] = CurrLine[FMemo.CurX]) then
|
|
|
- FMemo.BackSpace;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoInsCharUndo.PerformRedo;
|
|
|
-var
|
|
|
- i: integer;
|
|
|
-begin
|
|
|
- with FMemo do
|
|
|
- for i := 1 to Length(FUndoText) do
|
|
|
- if FUndoText[i] = #13 then
|
|
|
- NewLine
|
|
|
- else
|
|
|
- InsertChar(FUndoText[i]);
|
|
|
-end;
|
|
|
-
|
|
|
-function TGLSMemoInsCharUndo.Append(NewUndo: TGLSMemoUndo): Boolean;
|
|
|
-begin
|
|
|
- Result := False;
|
|
|
- if not ((NewUndo is TGLSMemoInsCharUndo) and
|
|
|
- (NewUndo.UndoCurX0 = FUndoCurX) and
|
|
|
- (NewUndo.UndoCurY0 = FUndoCurY)) then
|
|
|
- Exit;
|
|
|
- FUndoText := FUndoText + NewUndo.FUndoText;
|
|
|
- FUndoCurX := NewUndo.UndoCurX;
|
|
|
- FUndoCurY := NewUndo.UndoCurY;
|
|
|
- Result := True;
|
|
|
-end;
|
|
|
-
|
|
|
-//---------------- TDELETE CHAR UNDO --------------------------
|
|
|
-
|
|
|
-procedure TGLSMemoDelCharUndo.PerformUndo;
|
|
|
-var
|
|
|
- i: integer;
|
|
|
-begin
|
|
|
- with FMemo do
|
|
|
- for i := 1 to Length(FUndoText) do
|
|
|
- begin
|
|
|
- if not FIsBackspace then
|
|
|
- begin
|
|
|
- CurY := FUndoCurY0;
|
|
|
- CurX := FUndoCurX0;
|
|
|
- end;
|
|
|
- if FUndoText[i] = #13 then
|
|
|
- NewLine
|
|
|
- else
|
|
|
- InsertChar(FUndoText[i]);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoDelCharUndo.PerformRedo;
|
|
|
-var
|
|
|
- i: integer;
|
|
|
-begin
|
|
|
- with FMemo do
|
|
|
- for i := 1 to Length(FUndoText) do
|
|
|
- if FIsBackspace then
|
|
|
- BackSpace
|
|
|
- else
|
|
|
- DeleteChar(-1, -1);
|
|
|
-end;
|
|
|
-
|
|
|
-function TGLSMemoDelCharUndo.Append(NewUndo: TGLSMemoUndo): Boolean;
|
|
|
-begin
|
|
|
- Result := False;
|
|
|
- if not ((NewUndo is TGLSMemoDelCharUndo) and
|
|
|
- (NewUndo.UndoCurX0 = FUndoCurX) and
|
|
|
- (NewUndo.UndoCurY0 = FUndoCurY)) then
|
|
|
- Exit;
|
|
|
- if TGLSMemoDelCharUndo(NewUndo).FIsBackspace <> FIsBackspace then
|
|
|
- Exit;
|
|
|
- FUndoText := NewUndo.FUndoText + FUndoText;
|
|
|
- FUndoCurX := NewUndo.UndoCurX;
|
|
|
- FUndoCurY := NewUndo.UndoCurY;
|
|
|
- Result := True;
|
|
|
-end;
|
|
|
-
|
|
|
-//---------------- TDELETE BUF, LINE UNDO --------------------------
|
|
|
-
|
|
|
-constructor TGLSMemoDelLineUndo.Create(AIndex, ACurX0, ACurY0, ACurX, ACurY:
|
|
|
- integer; const AText: string);
|
|
|
-begin
|
|
|
- inherited Create(ACurX0, ACurY0, ACurX, ACurY, AText);
|
|
|
- FIndex := AIndex;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoDelLineUndo.PerformUndo;
|
|
|
-var
|
|
|
- SaveCurX: integer;
|
|
|
-begin
|
|
|
- with FMemo do
|
|
|
- begin
|
|
|
- SaveCurX := CurX;
|
|
|
- CurX := 0;
|
|
|
- ClearSelection;
|
|
|
- SetSelText(PChar(FUndoText + #13#10));
|
|
|
- CurX := SaveCurX;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoDelLineUndo.PerformRedo;
|
|
|
-begin
|
|
|
- FMemo.DeleteLine(FIndex, FUndoCurX0, FUndoCurY0, FUndoCurX, FUndoCurY, True);
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoDeleteBufUndo.PerformUndo;
|
|
|
-begin
|
|
|
- with FMemo do
|
|
|
- begin
|
|
|
- ClearSelection;
|
|
|
- SetSelText(PChar(FUndoText));
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoDeleteBufUndo.PerformRedo;
|
|
|
-begin
|
|
|
- with FMemo do
|
|
|
- begin
|
|
|
- FSelStartX := FUndoSelStartX;
|
|
|
- FSelStartY := FUndoSelStartY;
|
|
|
- FSelEndX := FUndoSelEndX;
|
|
|
- FSelEndY := FUndoSelEndY;
|
|
|
- DeleteSelection(True);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//---------------- TPASTE UNDO --------------------------
|
|
|
-
|
|
|
-procedure TGLSMemoPasteUndo.PerformUndo;
|
|
|
-begin
|
|
|
- with FMemo do
|
|
|
- begin
|
|
|
- FSelStartX := FUndoCurX0;
|
|
|
- FSelStartY := FUndoCurY0;
|
|
|
- FSelEndX := FUndoCurX;
|
|
|
- FSelEndY := FUndoCurY;
|
|
|
- DeleteSelection(True);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoPasteUndo.PerformRedo;
|
|
|
-begin
|
|
|
- with FMemo do
|
|
|
- begin
|
|
|
- ClearSelection;
|
|
|
- SetSelText(PChar(FUndoText));
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//---------------- TUNDO LIST --------------------------
|
|
|
-
|
|
|
-constructor TGLSMemoUndoList.Create;
|
|
|
-begin
|
|
|
- inherited;
|
|
|
- FPos := 0;
|
|
|
- FIsPerforming := False;
|
|
|
- FLimit := 100;
|
|
|
-end;
|
|
|
-
|
|
|
-destructor TGLSMemoUndoList.Destroy;
|
|
|
-begin
|
|
|
- Clear;
|
|
|
- inherited;
|
|
|
-end;
|
|
|
-
|
|
|
-function TGLSMemoUndoList.Get(Index: Integer): TGLSMemoUndo;
|
|
|
-begin
|
|
|
- Result := TGLSMemoUndo(inherited Get(Index));
|
|
|
-end;
|
|
|
-
|
|
|
-function TGLSMemoUndoList.Add(Item: Pointer): Integer;
|
|
|
-begin
|
|
|
- Result := -1;
|
|
|
- if FIsPerforming then
|
|
|
- begin
|
|
|
- TGLSMemoUndo(Item).Free;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
-
|
|
|
- if (Count > 0) and
|
|
|
- Items[0].Append(TGLSMemoUndo(Item)) then
|
|
|
- begin
|
|
|
- TGLSMemoUndo(Item).Free;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
-
|
|
|
- TGLSMemoUndo(Item).FMemo := Self.FMemo;
|
|
|
- if FPos > 0 then
|
|
|
- while FPos > 0 do
|
|
|
- begin
|
|
|
- Delete(0);
|
|
|
- Dec(FPos);
|
|
|
- end;
|
|
|
- Insert(0, Item);
|
|
|
- if Count > FLimit then
|
|
|
- Delete(Count - 1);
|
|
|
- Memo.UndoChange;
|
|
|
- Result := 0;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoUndoList.Clear;
|
|
|
-begin
|
|
|
- while Count > 0 do
|
|
|
- Delete(0);
|
|
|
- FPos := 0;
|
|
|
- with Memo do
|
|
|
- if not (csDestroying in ComponentState) then
|
|
|
- UndoChange;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoUndoList.Delete(Index: Integer);
|
|
|
-begin
|
|
|
- TGLSMemoUndo(Items[Index]).Free;
|
|
|
- inherited;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoUndoList.Undo;
|
|
|
-var
|
|
|
- OldAutoIndent: Boolean;
|
|
|
-begin
|
|
|
- if FPos < Count then
|
|
|
- begin
|
|
|
- OldAutoIndent := Memo.AutoIndent;
|
|
|
- Memo.AutoIndent := False;
|
|
|
- FIsPerforming := True;
|
|
|
- Items[FPos].Undo;
|
|
|
- Inc(FPos);
|
|
|
- FIsPerforming := False;
|
|
|
- Memo.AutoIndent := OldAutoIndent;
|
|
|
- Memo.UndoChange;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoUndoList.Redo;
|
|
|
-var
|
|
|
- OldAutoIndent: Boolean;
|
|
|
-begin
|
|
|
- if FPos > 0 then
|
|
|
- begin
|
|
|
- OldAutoIndent := Memo.AutoIndent;
|
|
|
- Memo.AutoIndent := False;
|
|
|
- FIsPerforming := True;
|
|
|
- Dec(FPos);
|
|
|
- Items[FPos].Redo;
|
|
|
- FIsPerforming := False;
|
|
|
- Memo.AutoIndent := OldAutoIndent;
|
|
|
- Memo.UndoChange;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSMemoUndoList.SetLimit(Value: integer);
|
|
|
-begin
|
|
|
- if FLimit <> Value then
|
|
|
- begin
|
|
|
- if Value <= 0 then
|
|
|
- Value := 10;
|
|
|
- if Value > 0 then
|
|
|
- Value := 100;
|
|
|
- FLimit := Value;
|
|
|
- Clear;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSSynHiMemo.Paint;
|
|
|
-begin
|
|
|
- FIsPainting := True;
|
|
|
- try
|
|
|
- DelimiterStyle := FDelimiterStyle;
|
|
|
- CommentStyle := FCommentStyle;
|
|
|
- NumberStyle := FNumberStyle;
|
|
|
- inherited;
|
|
|
- finally
|
|
|
- FIsPainting := False;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-// ---------------------TGLSSynHiMemo
|
|
|
-
|
|
|
-procedure TGLSSynHiMemo.SetStyle(Index: integer; Value: TCharStyle);
|
|
|
-var
|
|
|
- No: integer;
|
|
|
- eRect: TRect;
|
|
|
-begin
|
|
|
- No := -1;
|
|
|
- case Index of
|
|
|
- 0: No := FDelimiterStyleNo;
|
|
|
- 1: No := FCommentStyleNo;
|
|
|
- 2: No := FNumberStyleNo;
|
|
|
- end;
|
|
|
- with Value do
|
|
|
- Styles.Change(No, TextColor, BkColor, Style);
|
|
|
- if not FIsPainting then
|
|
|
- begin
|
|
|
- eRect := EditorRect;
|
|
|
- InvalidateRect(Handle, @eRect, True);
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SYNTAX MEMO - SET WORD LIST
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSSynHiMemo.SetWordList(Value: TGLSMemoStringList);
|
|
|
-begin
|
|
|
- FWordList.Assign(Value);
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSSynHiMemo.SetSpecialList(Value: TGLSMemoStringList);
|
|
|
-begin
|
|
|
- FSpecialList.Assign(Value);
|
|
|
-end;
|
|
|
-
|
|
|
-procedure TGLSSynHiMemo.SetBracketList(Value: TGLSMemoStringList);
|
|
|
-begin
|
|
|
- FBracketList.Assign(Value);
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SYNTAX MEMO - SET CASE SENSITIVE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSSynHiMemo.SetCaseSensitive(Value: Boolean);
|
|
|
-var
|
|
|
- LineNo: integer;
|
|
|
-begin
|
|
|
- if Value <> FCaseSensitive then
|
|
|
- begin
|
|
|
- FCaseSensitive := Value;
|
|
|
- for LineNo := 0 to Lines.Count - 1 do
|
|
|
- ValidAttrs[LineNo] := False;
|
|
|
- Invalidate;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SYNTAX MEMO - GET TOKEN
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-function TGLSSynHiMemo.GetToken(const S: string; var From: integer;
|
|
|
- out TokenType: TTokenType; out StyleNo: integer): string;
|
|
|
-var
|
|
|
- i, toStart, toEnd, Len, LenSpec: integer;
|
|
|
- Done: Boolean;
|
|
|
- Brackets: string;
|
|
|
- IntPart: integer;
|
|
|
- WasPoint: Boolean;
|
|
|
- //-------------------------------------------------------------
|
|
|
- function StartsFrom(const S: string; Pos: integer; const S0: string): Boolean;
|
|
|
- begin
|
|
|
- Result := (StrLComp(PChar(S) + Pos - 1, PChar(S0), Length(S0)) = 0);
|
|
|
- end;
|
|
|
- //-------------------------------------------------------------
|
|
|
- function Equal(const s1, s2: string): Boolean;
|
|
|
- begin
|
|
|
- if FCaseSensitive then
|
|
|
- Result := s1 = s2
|
|
|
- else
|
|
|
- Result := AnsiLowerCase(s1) = AnsiLowerCase(s2);
|
|
|
- end;
|
|
|
-begin
|
|
|
- toStart := From;
|
|
|
- toEnd := From;
|
|
|
- TokenType := ttOther;
|
|
|
- StyleNo := 0;
|
|
|
- Len := Length(S);
|
|
|
- // End of line
|
|
|
- if From > Len then
|
|
|
- begin
|
|
|
- From := -1;
|
|
|
- Result := '';
|
|
|
- TokenType := ttEOL;
|
|
|
- StyleNo := 0;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- // Begin of multiline comment
|
|
|
- if (MultiCommentLeft <> '') and (MultiCommentRight <> '') and
|
|
|
- StartsFrom(S, From, MultiCommentLeft) then
|
|
|
- begin
|
|
|
- Result := MultiCommentLeft;
|
|
|
- FInComment := True;
|
|
|
- TokenType := ttComment;
|
|
|
- StyleNo := FCommentStyleNo;
|
|
|
- Inc(From, Length(MultiCommentLeft));
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- // Inside multiline comment
|
|
|
- if FInComment then
|
|
|
- begin
|
|
|
- toEnd := toStart;
|
|
|
- while (toEnd <= Len) and (not StartsFrom(S, toEnd, MultiCommentRight)) do
|
|
|
- Inc(toEnd);
|
|
|
- if toEnd > Len then
|
|
|
- begin
|
|
|
- Result := Copy(S, From, toEnd - From);
|
|
|
- From := toEnd;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- FInComment := False;
|
|
|
- toEnd := toEnd + Length(MultiCommentRight);
|
|
|
- Result := Copy(S, From, toEnd - From);
|
|
|
- From := toEnd;
|
|
|
- end;
|
|
|
- TokenType := ttComment;
|
|
|
- StyleNo := FCommentStyleNo;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
-
|
|
|
- // Inside brikets
|
|
|
- if FInBrackets >= 0 then
|
|
|
- begin
|
|
|
- Brackets := FBracketList[FInBrackets];
|
|
|
- toEnd := toStart + 1;
|
|
|
- while (toEnd <= Len) and (S[toEnd] <> Brackets[2]) do
|
|
|
- Inc(toEnd);
|
|
|
- StyleNo := integer(FBracketList.Objects[FInBrackets]);
|
|
|
- if toEnd <= Len then
|
|
|
- begin
|
|
|
- FInBrackets := -1;
|
|
|
- From := toEnd + 1;
|
|
|
- end
|
|
|
- else
|
|
|
- From := toEnd;
|
|
|
- Result := Copy(S, toStart, toEnd - toStart + 1);
|
|
|
- TokenType := ttBracket;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- // Spaces
|
|
|
- while (toStart <= Len) and (S[toStart] = ' ') do
|
|
|
- Inc(toStart);
|
|
|
- if toStart > From then
|
|
|
- begin
|
|
|
- Result := Copy(S, From, toStart - From);
|
|
|
- From := toStart;
|
|
|
- TokenType := ttSpace;
|
|
|
- StyleNo := 0;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
- // Comment
|
|
|
- if (FLineComment <> '') and StartsFrom(S, From, FLineComment) then
|
|
|
- begin
|
|
|
- Result := Copy(S, From, Len);
|
|
|
- From := Len + 1;
|
|
|
- TokenType := ttComment;
|
|
|
- StyleNo := FCommentStyleNo;
|
|
|
- Exit;
|
|
|
- end;
|
|
|
-
|
|
|
- // Special keyword
|
|
|
- Done := False;
|
|
|
- for i := 0 to FSpecialList.Count - 1 do
|
|
|
- begin
|
|
|
- LenSpec := Length(FSpecialList[i]);
|
|
|
- if StrLComp(PChar(S) + toStart - 1,
|
|
|
- PChar(FSpecialList[i]), LenSpec) = 0 then
|
|
|
- begin
|
|
|
- toEnd := toStart + LenSpec - 1;
|
|
|
- StyleNo := integer(FSpecialList.Objects[i]);
|
|
|
- TokenType := ttSpecial;
|
|
|
- From := toEnd + 1;
|
|
|
- Done := True;
|
|
|
- break;
|
|
|
- end;
|
|
|
- end;
|
|
|
- // Brickets
|
|
|
- if not Done then
|
|
|
- begin
|
|
|
- for i := 0 to FBracketList.Count - 1 do
|
|
|
- begin
|
|
|
- Brackets := FBracketList[i];
|
|
|
- if S[toStart] = Brackets[1] then
|
|
|
- begin
|
|
|
- FInBrackets := i;
|
|
|
- toEnd := toStart + 1;
|
|
|
- while (toEnd <= Len) and (S[toEnd] <> Brackets[2]) do
|
|
|
- Inc(toEnd);
|
|
|
- if toEnd <= Len then
|
|
|
- FInBrackets := -1
|
|
|
- else
|
|
|
- Dec(toEnd);
|
|
|
- StyleNo := integer(FBracketList.Objects[i]);
|
|
|
- TokenType := ttBracket;
|
|
|
- Done := True;
|
|
|
- break;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- // Delimeters
|
|
|
- if not Done and CharInSet(S[toStart], Delimiters) then
|
|
|
- begin
|
|
|
- toEnd := toStart;
|
|
|
- StyleNo := FDelimiterStyleNo;
|
|
|
- TokenType := ttDelimiter;
|
|
|
- Done := True;
|
|
|
- end;
|
|
|
- // --- Integer or float type
|
|
|
- if not Done and CharInSet(S[toStart], ['0'..'9', '.']) then
|
|
|
- begin
|
|
|
- IntPart := 0;
|
|
|
- WasPoint := False;
|
|
|
- toEnd := toStart;
|
|
|
- Done := True;
|
|
|
- TokenType := ttInteger;
|
|
|
- StyleNo := FNumberStyleNo;
|
|
|
- while (toEnd <= Len) and CharInSet(S[toEnd], ['0'..'9', '.']) do
|
|
|
- begin
|
|
|
- if S[toEnd] = '.' then
|
|
|
- begin
|
|
|
- if not WasPoint then
|
|
|
- begin
|
|
|
- WasPoint := True;
|
|
|
- TokenType := ttFloat;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- TokenType := ttWrongNumber;
|
|
|
- Color := clRed;
|
|
|
- end;
|
|
|
- end
|
|
|
- else if not WasPoint then
|
|
|
- try
|
|
|
- IntPart := IntPart * 10 + Ord(S[toEnd]) - Ord('0');
|
|
|
- except
|
|
|
- IntPart := MaxInt;
|
|
|
- end;
|
|
|
- Inc(toEnd);
|
|
|
- end;
|
|
|
- Dec(toEnd);
|
|
|
- end;
|
|
|
- // Select word
|
|
|
- if not Done then
|
|
|
- begin
|
|
|
- toEnd := toStart;
|
|
|
- while (toEnd <= Len) and not CharInSet(S[toEnd], Delimiters) do
|
|
|
- Inc(toEnd);
|
|
|
- Dec(toEnd);
|
|
|
- end;
|
|
|
- // Find in dictionary
|
|
|
- Result := Copy(S, toStart, toEnd - toStart + 1);
|
|
|
- for i := 0 to FWordList.Count - 1 do
|
|
|
- if Equal(Result, FWordList[i]) then
|
|
|
- begin
|
|
|
- StyleNo := integer(FWordList.Objects[i]);
|
|
|
- TokenType := ttWord;
|
|
|
- break;
|
|
|
- end;
|
|
|
- From := toEnd + 1;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SYNTAX MEMO - FIND LINE ATTRS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSSynHiMemo.FindLineAttrs(Sender: TObject; LineNo: integer;
|
|
|
- var Attrs: string);
|
|
|
-var
|
|
|
- i, From, TokenLen: integer;
|
|
|
- S, Token: string;
|
|
|
- TokenType: TTokenType;
|
|
|
- StyleNo, OldInBrackets: integer;
|
|
|
- OldInComment: Boolean;
|
|
|
-begin
|
|
|
- S := Lines[LineNo];
|
|
|
- SetLength(Attrs, Length(S));
|
|
|
- FInComment := InComment[LineNo];
|
|
|
- FInBrackets := InBrackets[LineNo];
|
|
|
- From := 1;
|
|
|
- while True do
|
|
|
- begin
|
|
|
- Token := GetToken(S, From, TokenType, StyleNo);
|
|
|
- if TokenType = ttEOL then
|
|
|
- break;
|
|
|
- TokenLen := Length(Token);
|
|
|
- for i := From - TokenLen to From - 1 do
|
|
|
- Attrs[i] := Char(StyleNo);
|
|
|
- end;
|
|
|
- if LineNo < Lines.Count - 1 then
|
|
|
- begin
|
|
|
- OldInComment := InComment[LineNo + 1];
|
|
|
- OldInBrackets := InBrackets[LineNo + 1];
|
|
|
- if OldInComment <> FInComment then
|
|
|
- begin
|
|
|
- InComment[LineNo + 1] := FInComment;
|
|
|
- ValidAttrs[LineNo + 1] := False;
|
|
|
- end;
|
|
|
- if OldInBrackets <> FInBrackets then
|
|
|
- begin
|
|
|
- InBrackets[LineNo + 1] := FInBrackets;
|
|
|
- ValidAttrs[LineNo + 1] := False;
|
|
|
- end;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SYNTAX MEMO - ADD WORD
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSSynHiMemo.AddWord(StyleNo: integer; const ArrS: array of string);
|
|
|
-var
|
|
|
- i: integer;
|
|
|
-begin
|
|
|
- for i := Low(ArrS) to high(ArrS) do
|
|
|
- FWordList.AddObject(ArrS[i], TObject(StyleNo));
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SYNTAX MEMO - ADD SPECIAL
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSSynHiMemo.AddSpecial(StyleNo: integer; const ArrS: array of string);
|
|
|
-var
|
|
|
- i: integer;
|
|
|
-begin
|
|
|
- for i := Low(ArrS) to high(ArrS) do
|
|
|
- FSpecialList.AddObject(ArrS[i], TObject(StyleNo));
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SYNTAX MEMO - ADD BRACKETS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSSynHiMemo.AddBrackets(StyleNo: integer; const ArrS: array of string);
|
|
|
-var
|
|
|
- i: integer;
|
|
|
-begin
|
|
|
- for i := Low(ArrS) to high(ArrS) do
|
|
|
- FBracketList.AddObject(ArrS[i], TObject(StyleNo));
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SYNTAX MEMO - CREATE
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-constructor TGLSSynHiMemo.Create(AOwner: TComponent);
|
|
|
-begin
|
|
|
- inherited;
|
|
|
- FInBrackets := -1;
|
|
|
- FIsPainting := False;
|
|
|
- FInComment := False;
|
|
|
- FWordList := TGLSMemoStringList.Create;
|
|
|
- FSpecialList := TGLSMemoStringList.Create;
|
|
|
- FBracketList := TGLSMemoStringList.Create;
|
|
|
-
|
|
|
- FDelimiterStyle := TCharStyle.Create;
|
|
|
- with FDelimiterStyle do
|
|
|
- begin
|
|
|
- TextColor := clBlue;
|
|
|
- BkColor := clWhite;
|
|
|
- Style := [];
|
|
|
- end;
|
|
|
-
|
|
|
- FCommentStyle := TCharStyle.Create;
|
|
|
- with FCommentStyle do
|
|
|
- begin
|
|
|
- TextColor := clYellow;
|
|
|
- BkColor := clSkyBlue;
|
|
|
- Style := [fsItalic];
|
|
|
- end;
|
|
|
-
|
|
|
- FNumberStyle := TCharStyle.Create;
|
|
|
- with FNumberStyle do
|
|
|
- begin
|
|
|
- TextColor := clNavy;
|
|
|
- BkColor := clWhite;
|
|
|
- Style := [fsBold];
|
|
|
- end;
|
|
|
-
|
|
|
- FDelimiterStyleNo := Styles.Add(clBlue, clWhite, []);
|
|
|
- FCommentStyleNo := Styles.Add(clSilver, clWhite, [fsItalic]);
|
|
|
- FNumberStyleNo := Styles.Add(clNavy, clWhite, [fsBold]);
|
|
|
-
|
|
|
- OnGetLineAttrs := FindLineAttrs;
|
|
|
- Delimiters := [' ', ',', ';', ':', '.', '(', ')', '{', '}', '[', ']',
|
|
|
- '=', '+', '-', '*', '/', '^', '%', '<', '>',
|
|
|
- '"', '''', #13, #10];
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// SYNTAX MEMO - DESTROY
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-destructor TGLSSynHiMemo.Destroy;
|
|
|
-begin
|
|
|
- FWordList.Free;
|
|
|
- FSpecialList.Free;
|
|
|
- FBracketList.Free;
|
|
|
- FDelimiterStyle.Free;
|
|
|
- FCommentStyle.Free;
|
|
|
- FNumberStyle.Free;
|
|
|
- inherited;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-// ---------------------TGLSMemoStringList
|
|
|
-
|
|
|
-procedure TGLSMemoStringList.ReadStrings(Reader: TReader);
|
|
|
-var
|
|
|
- i: Integer;
|
|
|
-begin
|
|
|
- try
|
|
|
- Reader.ReadListBegin;
|
|
|
- Clear;
|
|
|
- while not Reader.EndOfList do
|
|
|
- begin
|
|
|
- i := Add(Reader.ReadString);
|
|
|
- Objects[i] := TObject(Reader.ReadInteger);
|
|
|
- end;
|
|
|
- Reader.ReadListEnd;
|
|
|
- finally
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// STRING LIST - WRITE STRINGS
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSMemoStringList.WriteStrings(Writer: TWriter);
|
|
|
-var
|
|
|
- i: Integer;
|
|
|
-begin
|
|
|
- with Writer do
|
|
|
- begin
|
|
|
- WriteListBegin;
|
|
|
- for i := 0 to Count - 1 do
|
|
|
- begin
|
|
|
- WriteString(Strings[i]);
|
|
|
- WriteInteger(Integer(Objects[i]));
|
|
|
- end;
|
|
|
- WriteListEnd;
|
|
|
- end;
|
|
|
-end;
|
|
|
-
|
|
|
-//--------------------------------------------------------------
|
|
|
-// STRING LIST - DEFINE PROPERTIES
|
|
|
-//--------------------------------------------------------------
|
|
|
-
|
|
|
-procedure TGLSMemoStringList.DefineProperties(Filer: TFiler);
|
|
|
-begin
|
|
|
- Filer.DefineProperty('Strings', ReadStrings, WriteStrings, Count > 0);
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-// ---------------------ScrollBar bitmaps
|
|
|
-
|
|
|
-procedure CreateScrollBarBitmaps;
|
|
|
-var
|
|
|
- i, j: integer;
|
|
|
-begin
|
|
|
- bmScrollBarFill := TBitmap.Create;
|
|
|
- with bmScrollBarFill, Canvas do
|
|
|
- begin
|
|
|
- Width := 8;
|
|
|
- Height := 8;
|
|
|
- Transparent := False;
|
|
|
- for i := 0 to 7 do
|
|
|
- for j := 0 to 7 do
|
|
|
- if Odd(i + j) then
|
|
|
- Pixels[i, j] := clSilver;
|
|
|
- end;
|
|
|
-
|
|
|
- bmScrollBarUp := TBitmap.Create;
|
|
|
- with bmScrollBarUp, Canvas do
|
|
|
- begin
|
|
|
- Width := 7;
|
|
|
- Height := 8;
|
|
|
- Brush.Color := clSilver;
|
|
|
- FillRect(Rect(0, 0, Width, Height));
|
|
|
- Pixels[3, 2] := clBlack;
|
|
|
- MoveTo(2, 3);
|
|
|
- LineTo(5, 3);
|
|
|
- MoveTo(1, 4);
|
|
|
- LineTo(6, 4);
|
|
|
- MoveTo(0, 5);
|
|
|
- LineTo(7, 5);
|
|
|
- end;
|
|
|
-
|
|
|
- bmScrollBarDown := TBitmap.Create;
|
|
|
- with bmScrollBarDown, Canvas do
|
|
|
- begin
|
|
|
- Width := 7;
|
|
|
- Height := 8;
|
|
|
- Brush.Color := clSilver;
|
|
|
- FillRect(Rect(0, 0, Width, Height));
|
|
|
- MoveTo(0, 2);
|
|
|
- LineTo(7, 2);
|
|
|
- MoveTo(1, 3);
|
|
|
- LineTo(6, 3);
|
|
|
- MoveTo(2, 4);
|
|
|
- LineTo(5, 4);
|
|
|
- Pixels[3, 5] := clBlack;
|
|
|
- end;
|
|
|
-
|
|
|
- bmScrollBarLeft := TBitmap.Create;
|
|
|
- with bmScrollBarLeft, Canvas do
|
|
|
- begin
|
|
|
- Width := 8;
|
|
|
- Height := 7;
|
|
|
- Brush.Color := clSilver;
|
|
|
- FillRect(Rect(0, 0, Width, Height));
|
|
|
- Pixels[2, 3] := clBlack;
|
|
|
- MoveTo(3, 2);
|
|
|
- LineTo(3, 5);
|
|
|
- MoveTo(4, 1);
|
|
|
- LineTo(4, 6);
|
|
|
- MoveTo(5, 0);
|
|
|
- LineTo(5, 7);
|
|
|
- end;
|
|
|
-
|
|
|
- bmScrollBarRight := TBitmap.Create;
|
|
|
- with bmScrollBarRight, Canvas do
|
|
|
- begin
|
|
|
- Width := 8;
|
|
|
- Height := 7;
|
|
|
- Brush.Color := clSilver;
|
|
|
- FillRect(Rect(0, 0, Width, Height));
|
|
|
- MoveTo(2, 0);
|
|
|
- LineTo(2, 7);
|
|
|
- MoveTo(3, 1);
|
|
|
- LineTo(3, 6);
|
|
|
- MoveTo(4, 2);
|
|
|
- LineTo(4, 5);
|
|
|
- Pixels[5, 3] := clBlack;
|
|
|
- end;
|
|
|
-
|
|
|
-end;
|
|
|
-//------------------ FREE SCROLL BAR BITMAPs -------------------
|
|
|
-
|
|
|
-procedure FreeScrollBarBitmaps;
|
|
|
-begin
|
|
|
- bmScrollBarFill.Free;
|
|
|
- bmScrollBarUp.Free;
|
|
|
- bmScrollBarDown.Free;
|
|
|
- bmScrollBarLeft.Free;
|
|
|
- bmScrollBarRight.Free;
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-initialization
|
|
|
-
|
|
|
- RegisterClasses([TGLSSynHiMemo]);
|
|
|
- CreateScrollBarBitmaps;
|
|
|
- IntelliMouseInit;
|
|
|
-
|
|
|
-finalization
|
|
|
- FreeScrollBarBitmaps;
|
|
|
-
|
|
|
-end.
|
|
|
-
|
|
|
+//
|
|
|
+// This unit is part of the GLScene Engine, http://glscene.org
|
|
|
+//
|
|
|
+
|
|
|
+unit GLS.Memo;
|
|
|
+
|
|
|
+(* Memo for GLScene *)
|
|
|
+
|
|
|
+interface
|
|
|
+
|
|
|
+{$I GLScene.inc}
|
|
|
+
|
|
|
+uses
|
|
|
+ WinApi.Windows,
|
|
|
+ WinApi.Messages,
|
|
|
+ System.SysUtils,
|
|
|
+ System.Classes,
|
|
|
+ System.UITypes,
|
|
|
+ VCL.Graphics,
|
|
|
+ VCL.Controls,
|
|
|
+ VCL.Forms,
|
|
|
+ VCL.Dialogs,
|
|
|
+ VCL.ClipBrd,
|
|
|
+ VCL.StdCtrls,
|
|
|
+ VCL.ExtCtrls;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+type
|
|
|
+ TBorderType = (btRaised, btLowered, btFlatRaised, btFlatLowered);
|
|
|
+ TCommand = Integer;
|
|
|
+
|
|
|
+ TCellSize = record
|
|
|
+ W, H: integer;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TCellPos = record
|
|
|
+ X, Y: integer;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TFullPos = record
|
|
|
+ LineNo, Pos: integer;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TLineProp = class
|
|
|
+ FObject: TObject;
|
|
|
+ FStyleNo: integer;
|
|
|
+ FInComment: Boolean;
|
|
|
+ FInBrackets: integer;
|
|
|
+ FValidAttrs: Boolean;
|
|
|
+ FCharAttrs: string;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TCharStyle = class(TPersistent)
|
|
|
+ private
|
|
|
+ FTextColor, FBkColor: TColor;
|
|
|
+ FStyle: TFontStyles;
|
|
|
+ published
|
|
|
+
|
|
|
+ property TextColor: TColor read FTextColor write FTextColor;
|
|
|
+ property BkColor: TColor read FBkColor write FBkColor;
|
|
|
+ property Style: TFontStyles read FStyle write FStyle;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TStyleList = class(TList)
|
|
|
+ private
|
|
|
+ procedure CheckRange(Index: integer);
|
|
|
+ function GetTextColor(Index: Integer): TColor;
|
|
|
+ procedure SetTextColor(Index: Integer; Value: TColor);
|
|
|
+ function GetBkColor(Index: Integer): TColor;
|
|
|
+ procedure SetBkColor(Index: Integer; Value: TColor);
|
|
|
+ function GetStyle(Index: Integer): TFontStyles;
|
|
|
+ procedure SetStyle(Index: Integer; Value: TFontStyles);
|
|
|
+ protected
|
|
|
+
|
|
|
+ property TextColor[Index: Integer]: TColor read GetTextColor write
|
|
|
+ SetTextColor;
|
|
|
+ property BkColor[Index: Integer]: TColor read GetBkColor write SetBkColor;
|
|
|
+ property Style[Index: Integer]: TFontStyles read GetStyle write SetStyle;
|
|
|
+ public
|
|
|
+
|
|
|
+ destructor Destroy; override;
|
|
|
+ procedure Clear; override;
|
|
|
+ procedure Delete(Index: Integer);
|
|
|
+ function Add(ATextColor, ABkCOlor: TColor; AStyle: TFontStyles): Integer;
|
|
|
+ procedure Change(Index: integer; ATextColor, ABkColor: TColor; AStyle:
|
|
|
+ TFontStyles);
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLAbstractMemoObject = class(TObject)
|
|
|
+ public
|
|
|
+ function MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
|
|
|
+ Boolean; virtual; abstract;
|
|
|
+ function MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
|
|
|
+ Boolean; virtual; abstract;
|
|
|
+ function MouseMove(Shift: TShiftState; X, Y: Integer):
|
|
|
+ Boolean; virtual; abstract;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMemoScrollBar = class;
|
|
|
+
|
|
|
+ TGLSMemoAbstractScrollableObject = class(TCustomControl)
|
|
|
+ protected
|
|
|
+ procedure DoScroll(Sender: TGLSMemoScrollBar; ByValue: integer);
|
|
|
+ virtual; abstract;
|
|
|
+ procedure DoScrollPage(Sender: TGLSMemoScrollBar; ByValue: integer);
|
|
|
+ virtual; abstract;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSCustomMemo = class;
|
|
|
+
|
|
|
+ TsbState =
|
|
|
+ (
|
|
|
+ sbsWait,
|
|
|
+ sbsBack,
|
|
|
+ sbsForward,
|
|
|
+ sbsPageBack,
|
|
|
+ sbsPageForward,
|
|
|
+ sbsDragging
|
|
|
+ );
|
|
|
+
|
|
|
+ TGLSMemoScrollBar = class(TGLAbstractMemoObject)
|
|
|
+ private
|
|
|
+ FKind: TScrollBarKind;
|
|
|
+ FParent: TGLSMemoAbstractScrollableObject;
|
|
|
+ FLeft, FTop, FWidth, FHeight: integer;
|
|
|
+ FTotal, FMaxPosition, FPosition: integer;
|
|
|
+ FButtonLength: integer;
|
|
|
+ FState: TsbState;
|
|
|
+ FXOffset, FYOffset: integer;
|
|
|
+ procedure SetParams(Index: integer; Value: integer);
|
|
|
+ procedure SetState(Value: TsbState);
|
|
|
+ function GetRect: TRect;
|
|
|
+ function GetThumbRect: TRect;
|
|
|
+ function GetBackRect: TRect;
|
|
|
+ function GetMiddleRect: TRect;
|
|
|
+ function GetForwardRect: TRect;
|
|
|
+ function GetPgBackRect: TRect;
|
|
|
+ function GetPgForwardRect: TRect;
|
|
|
+ public
|
|
|
+ constructor Create(AParent: TGLSMemoAbstractScrollableObject;
|
|
|
+ AKind: TScrollBarKind);
|
|
|
+ procedure PaintTo(ACanvas: TCanvas);
|
|
|
+ function MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
|
|
|
+ Boolean; override;
|
|
|
+ function MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer):
|
|
|
+ Boolean; override;
|
|
|
+ function MouseMove(Shift: TShiftState; X, Y: Integer):
|
|
|
+ Boolean; override;
|
|
|
+ function MoveThumbTo(X, Y: Integer): integer;
|
|
|
+ property Parent: TGLSMemoAbstractScrollableObject read FParent;
|
|
|
+ property Kind: TScrollBarKind read FKind write FKind;
|
|
|
+ property State: TsbState read FState write SetState;
|
|
|
+ property Left: integer index 0 read FLeft write SetParams;
|
|
|
+ property Top: integer index 1 read FTop write SetParams;
|
|
|
+ property Width: integer index 2 read FWidth write SetParams;
|
|
|
+ property Height: integer index 3 read FHeight write SetParams;
|
|
|
+ property Total: integer index 4 read FTotal write SetParams;
|
|
|
+ property MaxPosition: integer index 5 read FMaxPosition write SetParams;
|
|
|
+ property Position: integer index 6 read FPosition write SetParams;
|
|
|
+ property FullRect: TRect read GetRect;
|
|
|
+ property ThumbRect: TRect read GetThumbRect;
|
|
|
+ property BackRect: TRect read GetBackRect;
|
|
|
+ property MiddleRect: TRect read GetMiddleRect;
|
|
|
+ property ForwardRect: TRect read GetForwardRect;
|
|
|
+ property PageForwardRect: TRect read GetPgForwardRect;
|
|
|
+ property PageBackRect: TRect read GetPgBackRect;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMemoStrings = class(TStringList)
|
|
|
+ private
|
|
|
+ FMemo: TGLSCustomMemo;
|
|
|
+ FLockCount: integer;
|
|
|
+ FDeleting: Boolean;
|
|
|
+ procedure CheckRange(Index: integer);
|
|
|
+ function GetLineProp(Index: integer): TLineProp;
|
|
|
+ procedure SetLineStyle(Index: integer; Value: integer);
|
|
|
+ function GetLineStyle(Index: integer): integer;
|
|
|
+ function GetInComment(Index: Integer): Boolean;
|
|
|
+ procedure SetInComment(Index: Integer; Value: Boolean);
|
|
|
+ function GetInBrackets(Index: Integer): integer;
|
|
|
+ procedure SetInBrackets(Index: Integer; Value: integer);
|
|
|
+ function GetValidAttrs(Index: Integer): Boolean;
|
|
|
+ procedure SetValidAttrs(Index: Integer; Value: Boolean);
|
|
|
+ function GetCharAttrs(Index: Integer): string;
|
|
|
+ procedure SetCharAttrs(Index: Integer; const Value: string);
|
|
|
+ protected
|
|
|
+ function GetObject(Index: Integer): TObject; override;
|
|
|
+ procedure PutObject(Index: Integer; AObject: TObject); override;
|
|
|
+ procedure SetUpdateState(Updating: Boolean); override;
|
|
|
+ function CreateProp(Index: integer): TLineProp;
|
|
|
+ property LineProp[Index: integer]: TLineProp read GetLineProp; //PALOFF
|
|
|
+ property Style[Index: integer]: integer read GetLineStyle write
|
|
|
+ SetLineStyle;
|
|
|
+ property InComment[Index: integer]: Boolean read GetInComment write
|
|
|
+ SetInComment;
|
|
|
+ property InBrackets[Index: integer]: integer read GetInBrackets write
|
|
|
+ SetInBrackets;
|
|
|
+ property ValidAttrs[Index: integer]: Boolean read GetValidAttrs write
|
|
|
+ SetValidAttrs;
|
|
|
+ property CharAttrs[Index: integer]: string read GetCharAttrs write
|
|
|
+ SetCharAttrs;
|
|
|
+ public
|
|
|
+ destructor Destroy; override;
|
|
|
+ procedure Clear; override;
|
|
|
+ function DoAdd(const S: string): Integer;
|
|
|
+ function Add(const S: string): Integer; override;
|
|
|
+ function AddObject(const S: string; AObject: TObject): Integer; override;
|
|
|
+ procedure Assign(Source: TPersistent); override;
|
|
|
+ procedure Insert(Index: Integer; const S: string); override;
|
|
|
+ procedure DoInsert(Index: Integer; const S: string);
|
|
|
+ procedure InsertObject(Index: Integer; const S: string; AObject: TObject);
|
|
|
+ override;
|
|
|
+ procedure Delete(Index: Integer); override;
|
|
|
+ procedure LoadFromFile(const FileName: string); override;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMemoGutter = class(TObject)
|
|
|
+ private
|
|
|
+ FMemo: TGLSCustomMemo;
|
|
|
+ FLeft, FTop, FWidth, FHeight: integer;
|
|
|
+ FColor: TColor;
|
|
|
+ procedure SetParams(Index: integer; Value: integer);
|
|
|
+ function GetRect: TRect;
|
|
|
+ protected
|
|
|
+ procedure PaintTo(ACanvas: TCanvas);
|
|
|
+ procedure Invalidate;
|
|
|
+ public
|
|
|
+ property Left: integer index 0 read FLeft write SetParams;
|
|
|
+ property Top: integer index 1 read FTop write SetParams;
|
|
|
+ property Width: integer index 2 read FWidth write SetParams;
|
|
|
+ property Height: integer index 3 read FHeight write SetParams;
|
|
|
+ property FullRect: TRect read GetRect;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMemoUndo = class
|
|
|
+ private
|
|
|
+ FMemo: TGLSCustomMemo;
|
|
|
+ FUndoCurX0, FUndoCurY0: integer;
|
|
|
+ FUndoCurX, FUndoCurY: integer;
|
|
|
+ FUndoText: string;
|
|
|
+ public
|
|
|
+ constructor Create(ACurX0, ACurY0, ACurX, ACurY: integer; const AText: string);
|
|
|
+ function Append(NewUndo: TGLSMemoUndo): Boolean; virtual;
|
|
|
+ procedure Undo;
|
|
|
+ procedure Redo;
|
|
|
+ procedure PerformUndo; virtual; abstract;
|
|
|
+ procedure PerformRedo; virtual; abstract;
|
|
|
+ property UndoCurX0: integer read FUndoCurX0 write FUndoCurX0;
|
|
|
+ property UndoCurY0: integer read FUndoCurY0 write FUndoCurY0;
|
|
|
+ property UndoCurX: integer read FUndoCurX write FUndoCurX;
|
|
|
+ property UndoCurY: integer read FUndoCurY write FUndoCurY;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMemoInsCharUndo = class(TGLSMemoUndo)
|
|
|
+ public
|
|
|
+ function Append(NewUndo: TGLSMemoUndo): Boolean; override;
|
|
|
+ procedure PerformUndo; override;
|
|
|
+ procedure PerformRedo; override;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMemoDelCharUndo = class(TGLSMemoUndo)
|
|
|
+ private
|
|
|
+ FIsBackspace: Boolean;
|
|
|
+ public
|
|
|
+ function Append(NewUndo: TGLSMemoUndo): Boolean; override;
|
|
|
+ procedure PerformUndo; override;
|
|
|
+ procedure PerformRedo; override;
|
|
|
+ property IsBackspace: Boolean read FIsBackspace write FIsBackspace;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMEmoDelLineUndo = class(TGLSMemoUndo)
|
|
|
+ private
|
|
|
+ FIndex: integer;
|
|
|
+ public
|
|
|
+ constructor Create(AIndex, ACurX0, ACurY0, ACurX, ACurY: integer; const AText:
|
|
|
+ string);
|
|
|
+ procedure PerformUndo; override;
|
|
|
+ procedure PerformRedo; override;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMemoSelUndo = class(TGLSMemoUndo)
|
|
|
+ private
|
|
|
+ FUndoSelStartX, FUndoSelStartY,
|
|
|
+ FUndoSelEndX, FUndoSelEndY: integer;
|
|
|
+ public
|
|
|
+ property UndoSelStartX: integer read FUndoSelStartX write FUndoSelStartX;
|
|
|
+ property UndoSelStartY: integer read FUndoSelStartY write FUndoSelStartY;
|
|
|
+ property UndoSelEndX: integer read FUndoSelEndX write FUndoSelEndX;
|
|
|
+ property UndoSelEndY: integer read FUndoSelEndY write FUndoSelEndY;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMemoDeleteBufUndo = class(TGLSMemoSelUndo)
|
|
|
+ public
|
|
|
+ procedure PerformUndo; override;
|
|
|
+ procedure PerformRedo; override;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMemoPasteUndo = class(TGLSMemoUndo)
|
|
|
+ public
|
|
|
+ procedure PerformUndo; override;
|
|
|
+ procedure PerformRedo; override;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMemoUndoList = class(TList)
|
|
|
+ private
|
|
|
+ FPos: integer;
|
|
|
+ FMemo: TGLSCustomMemo;
|
|
|
+ FIsPerforming: Boolean;
|
|
|
+ FLimit: integer;
|
|
|
+ protected
|
|
|
+ function Get(Index: Integer): TGLSMemoUndo;
|
|
|
+ procedure SetLimit(Value: integer);
|
|
|
+ public
|
|
|
+ constructor Create;
|
|
|
+ destructor Destroy; override;
|
|
|
+ function Add(Item: Pointer): Integer;
|
|
|
+ procedure Clear; override;
|
|
|
+ procedure Delete(Index: Integer);
|
|
|
+ procedure Undo;
|
|
|
+ procedure Redo;
|
|
|
+ property Items[Index: Integer]: TGLSMemoUndo read Get; default;
|
|
|
+ property IsPerforming: Boolean read FIsPerforming write FIsPerforming;
|
|
|
+ property Memo: TGLSCustomMemo read FMemo write FMemo;
|
|
|
+ property Pos: integer read FPos write FPos;
|
|
|
+ property Limit: integer read FLimit write SetLimit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ //--------------------------------------------------------------
|
|
|
+
|
|
|
+ TGutterClickEvent = procedure(Sender: TObject; LineNo: integer) of object;
|
|
|
+ TGutterDrawEvent = procedure(Sender: TObject; ACanvas: TCanvas;
|
|
|
+ LineNo: integer; rct: TRect) of object;
|
|
|
+ TGetLineAttrsEvent = procedure(Sender: TObject; LineNo: integer;
|
|
|
+ var Attrs: string) of object;
|
|
|
+ TUndoChangeEvent = procedure(Sender: TObject;
|
|
|
+ CanUndo, CanRedo: Boolean) of object;
|
|
|
+ TScrollMode = (smAuto, smStrict);
|
|
|
+
|
|
|
+ TGLSCustomMemo = class(TGLSMemoAbstractScrollableObject)
|
|
|
+ private
|
|
|
+ FAutoIndent: Boolean;
|
|
|
+ FMargin: integer;
|
|
|
+ FHiddenCaret, FCaretVisible: Boolean;
|
|
|
+ FCellSize: TCellSize;
|
|
|
+ FCurX, FCurY: integer;
|
|
|
+ FLeftCol, FTopLine: integer;
|
|
|
+ FTabSize: integer;
|
|
|
+ FFont: TFont;
|
|
|
+ FBkColor: TColor;
|
|
|
+ FSelColor: TColor;
|
|
|
+ FSelBkColor: TColor;
|
|
|
+ FReadOnly: Boolean;
|
|
|
+ FDelErase: Boolean;
|
|
|
+ FLines: TStrings;
|
|
|
+ FSelStartX, FSelStartY,
|
|
|
+ FSelEndX, FSelEndY,
|
|
|
+ FPrevSelX, FPrevSelY: integer;
|
|
|
+ FScrollBars: System.UITypes.TScrollStyle;
|
|
|
+ FScrollBarWidth: integer;
|
|
|
+ FGutter: TGLSMemoGutter;
|
|
|
+ FGutterWidth: integer;
|
|
|
+ sbVert, sbHorz: TGLSMemoScrollBar;
|
|
|
+ FStyles: TStyleList;
|
|
|
+ FLineBitmap: TBitmap;
|
|
|
+ FSelCharPos: TFullPos;
|
|
|
+ FSelCharStyle: integer;
|
|
|
+ FLeftButtonDown: Boolean;
|
|
|
+ FScrollMode: TScrollMode;
|
|
|
+ FUndoList: TGLSMemoUndoList;
|
|
|
+ FFirstUndoList: TGLSMemoUndoList;
|
|
|
+ FUndoLimit: integer;
|
|
|
+ FLastMouseUpX,
|
|
|
+ FLastMouseUpY: integer;
|
|
|
+ FAfterDoubleClick: Boolean;
|
|
|
+ // events
|
|
|
+ FOnMoveCursor: TNotifyEvent;
|
|
|
+ FOnChange: TNotifyEvent;
|
|
|
+ FOnAttrChange: TNotifyEvent;
|
|
|
+ FOnStatusChange: TNotifyEvent;
|
|
|
+ FOnSelectionChange: TNotifyEvent;
|
|
|
+ FOnGutterDraw: TGutterDrawEvent;
|
|
|
+ FOnGutterClick: TGutterClickEvent;
|
|
|
+ FOnGetLineAttrs: TGetLineAttrsEvent;
|
|
|
+ FOnUndoChange: TUndoChangeEvent;
|
|
|
+ FHideCursor: Boolean;
|
|
|
+ procedure SetHiddenCaret(Value: Boolean);
|
|
|
+ procedure SetScrollBars(Value: System.UITypes.TScrollStyle);
|
|
|
+ procedure SetGutterWidth(Value: integer);
|
|
|
+ procedure SetGutterColor(Value: TColor);
|
|
|
+ function GetGutterColor: TColor;
|
|
|
+ procedure SetCurX(Value: integer);
|
|
|
+ procedure SetCurY(Value: integer);
|
|
|
+ procedure SetFont(Value: TFont);
|
|
|
+ procedure SetColor(Index: integer; Value: TColor);
|
|
|
+ function GetSelStart: TPoint;
|
|
|
+ function GetSelEnd: TPoint;
|
|
|
+ procedure SetLines(ALines: TStrings);
|
|
|
+ procedure SetLineStyle(Index: integer; Value: integer);
|
|
|
+ function GetLineStyle(Index: integer): integer;
|
|
|
+ function GetInComment(Index: integer): Boolean;
|
|
|
+ procedure SetInComment(Index: integer; Value: Boolean);
|
|
|
+ function GetInBrackets(Index: Integer): integer;
|
|
|
+ procedure SetInBrackets(Index: Integer; Value: integer);
|
|
|
+ function GetValidAttrs(Index: integer): Boolean;
|
|
|
+ procedure SetValidAttrs(Index: integer; Value: Boolean);
|
|
|
+ function GetCharAttrs(Index: integer): string;
|
|
|
+ procedure SetCharAttrs(Index: integer; const Value: string);
|
|
|
+ procedure ExpandSelection;
|
|
|
+ function GetSelText: string;
|
|
|
+ procedure SetSelText(const AValue: string);
|
|
|
+ function GetSelLength: integer;
|
|
|
+ procedure MovePage(dP: integer; Shift: TShiftState);
|
|
|
+ procedure ShowCaret(State: Boolean);
|
|
|
+ procedure MakeVisible;
|
|
|
+ function GetVisible(Index: integer): integer;
|
|
|
+ function MaxLength: integer;
|
|
|
+ procedure WMSize(var Msg: TWMSize); message WM_SIZE;
|
|
|
+ procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
|
|
|
+ procedure WMEraseBkgnd(var Msg: TWmEraseBkgnd); message WM_ERASEBKGND;
|
|
|
+ procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
|
|
|
+ procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
|
|
|
+ procedure WMKillFocus(var Msg: TWMSetFocus); message WM_KILLFOCUS;
|
|
|
+ procedure WMMouseWheel(var Message: TMessage); message WM_MOUSEWHEEL;
|
|
|
+ procedure MoveCursor(dX, dY: integer; Shift: TShiftState);
|
|
|
+ procedure ResizeEditor;
|
|
|
+ procedure ResizeScrollBars;
|
|
|
+ procedure ResizeGutter;
|
|
|
+ procedure DoCommand(cmd: TCommand; const AShift: TShiftState);
|
|
|
+ procedure DrawLine(LineNo: integer);
|
|
|
+ function IsLineVisible(LineNo: integer): Boolean;
|
|
|
+ procedure FreshLineBitmap;
|
|
|
+ procedure SetUndoLimit(Value: integer);
|
|
|
+ protected
|
|
|
+ procedure WndProc(var Message: TMessage); override;
|
|
|
+ function EditorRect: TRect;
|
|
|
+ function LineRangeRect(FromLine, ToLine: integer): TRect;
|
|
|
+ function ColRangeRect(FromCol, ToCol: integer): TRect;
|
|
|
+ procedure InvalidateLineRange(FromLine, ToLine: integer);
|
|
|
+ function AddString(const S: string): integer;
|
|
|
+ procedure InsertString(Index: integer; S: string);
|
|
|
+ procedure GoHome(Shift: TShiftState);
|
|
|
+ procedure GoEnd(Shift: TShiftState);
|
|
|
+ procedure InsertChar(C: Char);
|
|
|
+ procedure DeleteChar(OldX, OldY: integer);
|
|
|
+ procedure DeleteLine(Index, OldX, OldY, NewX, NewY: integer; FixUndo: Boolean);
|
|
|
+ procedure BackSpace;
|
|
|
+ procedure BackSpaceWord;
|
|
|
+ function IndentCurrLine: string;
|
|
|
+ procedure NewLine;
|
|
|
+ procedure CreateParams(var Params: TCreateParams); override;
|
|
|
+ procedure Paint; override;
|
|
|
+ procedure DrawMargin;
|
|
|
+ procedure DrawGutter;
|
|
|
+ procedure DrawScrollBars;
|
|
|
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
|
+ procedure KeyPress(var Key: Char); override;
|
|
|
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
|
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
|
|
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
|
+ procedure DblClick; override;
|
|
|
+ procedure DoScroll(Sender: TGLSMemoScrollBar; ByValue: integer); override;
|
|
|
+ procedure DoScrollPage(Sender: TGLSMemoScrollBar; ByValue: integer); override;
|
|
|
+ property VisiblePosCount: integer index 0 read GetVisible;
|
|
|
+ property VisibleLineCount: integer index 1 read GetVisible;
|
|
|
+ property LastVisiblePos: integer index 2 read GetVisible;
|
|
|
+ property LastVisibleLine: integer index 3 read GetVisible;
|
|
|
+ procedure DeleteSelection(bRepaint: Boolean);
|
|
|
+ procedure Changed(FromLine, ToLine: integer); virtual;
|
|
|
+ procedure AttrChanged(LineNo: integer); virtual;
|
|
|
+ procedure SelectionChanged; virtual;
|
|
|
+ procedure StatusChanged; virtual;
|
|
|
+ procedure ClearUndoList;
|
|
|
+ procedure UndoChange;
|
|
|
+ property AutoIndent: Boolean read FAutoIndent write FAutoIndent;
|
|
|
+ property GutterWidth: integer read FGutterWidth write SetGutterWidth;
|
|
|
+ property GutterColor: TColor read GetGutterColor write SetGutterColor;
|
|
|
+ property ScrollBars: System.UITypes.TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
|
|
|
+ property Font: TFont read FFont write SetFont;
|
|
|
+ property ReadOnly: Boolean read FReadOnly write FReadOnly;
|
|
|
+ property Lines: TStrings read FLines write SetLines;
|
|
|
+ property BkColor: TColor index 0 read FBkColor write SetColor;
|
|
|
+ property SelColor: TColor index 1 read FSelColor write SetColor;
|
|
|
+ property SelBkColor: TColor index 2 read FSelBkColor write SetColor;
|
|
|
+ property HiddenCaret: Boolean read FHiddenCaret write SetHiddenCaret;
|
|
|
+ property TabSize: integer read FTabSize write FTabSize;
|
|
|
+ property ScrollMode: TScrollMode read FScrollMode write FScrollMode default smAuto;
|
|
|
+ property UndoLimit: integer read FUndoLimit write SetUndoLimit;
|
|
|
+ property HideCursor: Boolean read FHideCursor write FHideCursor;
|
|
|
+ property InComment[Index: integer]: Boolean read GetInComment write SetInComment;
|
|
|
+ property InBrackets[Index: integer]: integer read GetInBrackets write SetInBrackets;
|
|
|
+ property ValidAttrs[Index: integer]: Boolean read GetValidAttrs write SetValidAttrs;
|
|
|
+ property CharAttrs[Index: integer]: string read GetCharAttrs write SetCharAttrs;
|
|
|
+ {events}
|
|
|
+ property OnGutterClick: TGutterClickEvent read FOnGutterClick write FOnGutterClick;
|
|
|
+ property OnGutterDraw: TGutterDrawEvent read FOnGutterDraw write FOnGutterDraw;
|
|
|
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
|
+ property OnMoveCursor: TNotifyEvent read FOnMoveCursor write FOnMoveCursor;
|
|
|
+ property OnAttrChange: TNotifyEvent read FOnAttrChange write FOnAttrChange;
|
|
|
+ property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
|
|
|
+ property OnStatusChange: TNotifyEvent read FOnStatusChange write FOnStatusChange;
|
|
|
+ property OnGetLineAttrs: TGetLineAttrsEvent read FOnGetLineAttrs write FOnGetLineAttrs;
|
|
|
+ property OnUndoChange: TUndoChangeEvent read FOnUndoChange write FOnUndoChange;
|
|
|
+ public
|
|
|
+ constructor Create(AOwner: TComponent); override;
|
|
|
+ destructor Destroy; override;
|
|
|
+ procedure CopyToClipBoard;
|
|
|
+ procedure PasteFromClipBoard;
|
|
|
+ procedure CutToClipBoard;
|
|
|
+ procedure SelectLines(StartLine, EndLine: Integer);
|
|
|
+ procedure SelectAll;
|
|
|
+ property SelStart: TPoint read GetSelStart;
|
|
|
+ property SelEnd: TPoint read GetSelEnd;
|
|
|
+ property Selection: string read GetSelText write SetSelText;
|
|
|
+ property SelLength: integer read GetSelLength;
|
|
|
+ procedure ClearSelection;
|
|
|
+ procedure Clear;
|
|
|
+ procedure SetCursor(ACurX, ACurY: Integer);
|
|
|
+ function SelectLine(LineNo, StyleNo: Integer): integer;
|
|
|
+ procedure SelectChar(LineNo, Pos, StyleNo: Integer);
|
|
|
+ function CellFromPos(X, Y: integer): TCellPos;
|
|
|
+ function CharFromPos(X, Y: integer): TFullPos;
|
|
|
+ function CellRect(ACol, ARow: integer): TRect;
|
|
|
+ function LineRect(ARow: integer): TRect;
|
|
|
+ function ColRect(ACol: integer): TRect;
|
|
|
+ function CharStyleNo(LineNo, Pos: integer): integer;
|
|
|
+ procedure InsertTemplate(AText: string);
|
|
|
+ procedure UnSelectChar;
|
|
|
+ procedure Undo;
|
|
|
+ procedure Redo;
|
|
|
+ function CanUndo: Boolean;
|
|
|
+ function CanRedo: Boolean;
|
|
|
+ function FindText(Text: string; Options: TFindOptions; Select: Boolean): Boolean;
|
|
|
+ property CurX: integer read FCurX write SetCurX;
|
|
|
+ property CurY: integer read FCurY write SetCurY;
|
|
|
+ property DelErase: Boolean read FDelErase write FDelErase;
|
|
|
+ property LineStyle[Index: integer]: integer read GetLineStyle write
|
|
|
+ SetLineStyle;
|
|
|
+ property Styles: TStyleList read FStyles;
|
|
|
+ property UndoList: TGLSMemoUndoList read FUndoList write FUndoList;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMemo = class(TGLSCustomMemo)
|
|
|
+ published
|
|
|
+ {TControl }
|
|
|
+ property PopupMenu;
|
|
|
+ {TCustomControl }
|
|
|
+ property Align;
|
|
|
+ property Enabled;
|
|
|
+ property ShowHint;
|
|
|
+ property TabOrder;
|
|
|
+ property TabStop;
|
|
|
+ property Visible;
|
|
|
+ property ReadOnly;
|
|
|
+ {TGLSCustomMemo }
|
|
|
+ property AutoIndent;
|
|
|
+ property GutterColor;
|
|
|
+ property GutterWidth;
|
|
|
+ property ScrollBars;
|
|
|
+ property Font;
|
|
|
+ property BkColor;
|
|
|
+ property Selection;
|
|
|
+ property SelColor;
|
|
|
+ property SelBkColor;
|
|
|
+ property Lines;
|
|
|
+ property HiddenCaret;
|
|
|
+ property TabSize;
|
|
|
+ property ScrollMode;
|
|
|
+ property UndoLimit;
|
|
|
+ property DelErase;
|
|
|
+ {Inherited events }
|
|
|
+ property OnClick;
|
|
|
+ property OnDblClick;
|
|
|
+ property OnDragDrop;
|
|
|
+ property OnDragOver;
|
|
|
+ property OnEndDrag;
|
|
|
+ property OnMouseDown;
|
|
|
+ property OnMouseMove;
|
|
|
+ property OnMouseUp;
|
|
|
+ property OnStartDrag;
|
|
|
+ property OnEnter;
|
|
|
+ property OnExit;
|
|
|
+ property OnKeyDown;
|
|
|
+ property OnKeyPress;
|
|
|
+ property OnKeyUp;
|
|
|
+ {Events }
|
|
|
+ property OnGutterDraw;
|
|
|
+ property OnGutterClick;
|
|
|
+ property OnChange;
|
|
|
+ property OnMoveCursor;
|
|
|
+ property OnAttrChange;
|
|
|
+ property OnSelectionChange;
|
|
|
+ property OnStatusChange;
|
|
|
+ property OnGetLineAttrs;
|
|
|
+ property OnUndoChange;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMemoStringList = class(TStringList)
|
|
|
+ private
|
|
|
+ procedure ReadStrings(Reader: TReader);
|
|
|
+ procedure WriteStrings(Writer: TWriter);
|
|
|
+ protected
|
|
|
+ procedure DefineProperties(Filer: TFiler); override;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TDelimiters = TSysCharSet;
|
|
|
+ TTokenType =
|
|
|
+ (
|
|
|
+ ttWord,
|
|
|
+ ttBracket,
|
|
|
+ ttSpecial,
|
|
|
+ ttDelimiter,
|
|
|
+ ttSpace,
|
|
|
+ ttEOL,
|
|
|
+ ttInteger,
|
|
|
+ ttFloat,
|
|
|
+ ttComment,
|
|
|
+ ttOther,
|
|
|
+ ttWrongNumber);
|
|
|
+
|
|
|
+ //--------------------------------------------------------------
|
|
|
+ // SYNTAX MEMO - declaration
|
|
|
+ //--------------------------------------------------------------
|
|
|
+ TGLSSynHiMemo = class(TGLSCustomMemo)
|
|
|
+ private
|
|
|
+
|
|
|
+ FIsPainting: Boolean;
|
|
|
+ FInComment: Boolean;
|
|
|
+
|
|
|
+ FWordList: TGLSMemoStringList;
|
|
|
+ FSpecialList: TGLSMemoStringList;
|
|
|
+ FBracketList: TGLSMemoStringList;
|
|
|
+ FDelimiters: TDelimiters;
|
|
|
+ FInBrackets: integer;
|
|
|
+ FLineComment: string;
|
|
|
+ FMultiCommentLeft: string;
|
|
|
+ FMultiCommentRight: string;
|
|
|
+ FDelimiterStyle: TCharStyle;
|
|
|
+ FCommentStyle: TCharStyle;
|
|
|
+ FNumberStyle: TCharStyle;
|
|
|
+ FDelimiterStyleNo,
|
|
|
+ FCommentStyleNo,
|
|
|
+ FNumberStyleNo: integer;
|
|
|
+ FCaseSensitive: Boolean;
|
|
|
+ function GetToken(const S: string; var From: integer;
|
|
|
+ out TokenType: TTokenType; out StyleNo: integer): string;
|
|
|
+ procedure SetWordList(Value: TGLSMemoStringList);
|
|
|
+ procedure SetSpecialList(Value: TGLSMemoStringList);
|
|
|
+ procedure SetBracketList(Value: TGLSMemoStringList);
|
|
|
+ procedure FindLineAttrs(Sender: TObject; LineNo: integer; var Attrs:
|
|
|
+ string);
|
|
|
+ procedure SetStyle(Index: integer; Value: TCharStyle);
|
|
|
+ procedure SetCaseSensitive(Value: Boolean);
|
|
|
+ protected
|
|
|
+ procedure Paint; override;
|
|
|
+ public
|
|
|
+ constructor Create(AOwner: TComponent); override;
|
|
|
+ destructor Destroy; override;
|
|
|
+ procedure AddWord(StyleNo: integer; const ArrS: array of string);
|
|
|
+ procedure AddSpecial(StyleNo: integer; const ArrS: array of string);
|
|
|
+ procedure AddBrackets(StyleNo: integer; const ArrS: array of string);
|
|
|
+ property Delimiters: TDelimiters read FDelimiters write FDelimiters;
|
|
|
+ published
|
|
|
+ {TControl}
|
|
|
+ property PopupMenu;
|
|
|
+ {TCustomControl}
|
|
|
+ property Align;
|
|
|
+ property Enabled;
|
|
|
+ property ShowHint;
|
|
|
+ property TabOrder;
|
|
|
+ property TabStop;
|
|
|
+ property Visible;
|
|
|
+ property ReadOnly;
|
|
|
+ {TGLSCustomMemo}
|
|
|
+ property AutoIndent;
|
|
|
+ property GutterColor;
|
|
|
+ property GutterWidth;
|
|
|
+ property ScrollBars;
|
|
|
+ property Font;
|
|
|
+ property BkColor;
|
|
|
+ property SelColor;
|
|
|
+ property SelBkColor;
|
|
|
+ property Lines;
|
|
|
+ property HiddenCaret;
|
|
|
+ property TabSize;
|
|
|
+ property ScrollMode;
|
|
|
+ property UndoLimit;
|
|
|
+ property DelErase;
|
|
|
+ {Inherited events }
|
|
|
+ property OnClick;
|
|
|
+ property OnDblClick;
|
|
|
+ property OnDragDrop;
|
|
|
+ property OnDragOver;
|
|
|
+ property OnEndDrag;
|
|
|
+ property OnMouseDown;
|
|
|
+ property OnMouseMove;
|
|
|
+ property OnMouseUp;
|
|
|
+ property OnStartDrag;
|
|
|
+ property OnEnter;
|
|
|
+ property OnExit;
|
|
|
+ property OnKeyDown;
|
|
|
+ property OnKeyPress;
|
|
|
+ property OnKeyUp;
|
|
|
+ {Events }
|
|
|
+ property OnGutterClick;
|
|
|
+ property OnGutterDraw;
|
|
|
+ property OnChange;
|
|
|
+ property OnMoveCursor;
|
|
|
+ property OnSelectionChange;
|
|
|
+ property OnStatusChange;
|
|
|
+ property OnUndoChange;
|
|
|
+ {TGLSSyntaxMemo }
|
|
|
+ property LineComment: string read FLineComment write FLineComment;
|
|
|
+ property MultiCommentLeft: string read FMultiCommentLeft write FMultiCommentLeft;
|
|
|
+ property MultiCommentRight: string read FMultiCommentRight write FMultiCommentRight;
|
|
|
+ property WordList: TGLSMemoStringList read FWordList write SetWordList;
|
|
|
+ property SpecialList: TGLSMemoStringList read FSpecialList write SetSpecialList;
|
|
|
+ property BracketList: TGLSMemoStringList read FBracketList write SetBracketList;
|
|
|
+ property DelimiterStyle: TCharStyle index 0 read FDelimiterStyle write SetStyle;
|
|
|
+ property CommentStyle: TCharStyle index 1 read FCommentStyle write SetStyle;
|
|
|
+ property NumberStyle: TCharStyle index 2 read FNumberStyle write SetStyle;
|
|
|
+ property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
|
|
|
+ end;
|
|
|
+
|
|
|
+procedure Border(Canvas: TCanvas; const rct: TRect; BorderType: TBorderType);
|
|
|
+
|
|
|
+//==========================================================
|
|
|
+implementation
|
|
|
+//==========================================================
|
|
|
+
|
|
|
+const
|
|
|
+ cmDelete = VK_DELETE;
|
|
|
+ cmBackSpace = VK_BACK;
|
|
|
+ cmWordBackSpace = 127; // Ctrl-BackSpace
|
|
|
+ cmNewLine = VK_RETURN;
|
|
|
+ cmHome = VK_HOME;
|
|
|
+ cmEnd = VK_END;
|
|
|
+ cmPageUp = VK_PRIOR;
|
|
|
+ cmPageDown = VK_NEXT;
|
|
|
+ cmInsert = VK_INSERT;
|
|
|
+ cmDelLine = 25; // Ctrl-Y
|
|
|
+ cmCopy = 3; // Ctrl-C
|
|
|
+ cmCut = 24; // Ctrl-X
|
|
|
+ cmPaste = 22; // Ctrl-V
|
|
|
+
|
|
|
+resourcestring
|
|
|
+ SObjectsNotSupported = 'Linked object not supported';
|
|
|
+
|
|
|
+var
|
|
|
+ bmScrollBarFill: TBitmap;
|
|
|
+ bmScrollBarUp: TBitmap;
|
|
|
+ bmScrollBarDown: TBitmap;
|
|
|
+ bmScrollBarLeft: TBitmap;
|
|
|
+ bmScrollBarRight: TBitmap;
|
|
|
+
|
|
|
+ fIntelliWheelSupport: Boolean; // True if IntelliMouse + wheel enabled
|
|
|
+ fIntelliMessage: UINT; // message sent from mouse on wheel roll
|
|
|
+ fIntelliScrollLines: Integer; // number of lines to scroll per wheel roll
|
|
|
+
|
|
|
+// ---------------------Helper functions
|
|
|
+
|
|
|
+function PointInRect(const P: TPoint; const rct: TRect): Boolean; inline;
|
|
|
+begin
|
|
|
+ with rct do
|
|
|
+ Result := (Left <= P.X) and (Top <= P.Y) and
|
|
|
+ (Right >= P.X) and (Bottom >= P.Y);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure Swap(var I1, I2: integer); inline;
|
|
|
+var
|
|
|
+ temp: integer;
|
|
|
+begin
|
|
|
+ temp := I1;
|
|
|
+ I1 := I2;
|
|
|
+ I2 := temp;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure OrderPos(var StartX, StartY, EndX, EndY: integer); inline;
|
|
|
+begin
|
|
|
+ if (EndY < StartY) or
|
|
|
+ ((EndY = StartY) and (EndX < StartX)) then
|
|
|
+ begin
|
|
|
+ Swap(StartX, EndX);
|
|
|
+ Swap(StartY, EndY);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TotalRect(const rct1, rct2: TRect): TRect; inline;
|
|
|
+begin
|
|
|
+ Result := rct1;
|
|
|
+ with Result do
|
|
|
+ begin
|
|
|
+ if rct2.Left < Left then
|
|
|
+ Left := rct2.Left;
|
|
|
+ if rct2.Top < Top then
|
|
|
+ Top := rct2.Top;
|
|
|
+ if rct2.Right > Right then
|
|
|
+ Right := rct2.Right;
|
|
|
+ if rct2.Bottom > Bottom then
|
|
|
+ Bottom := rct2.Bottom;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+// ---------------------TGLSCustomMemo functions
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.WndProc(var Message: TMessage);
|
|
|
+ function GetShiftState: Integer;
|
|
|
+ begin
|
|
|
+ Result := 0;
|
|
|
+ if GetAsyncKeyState(vk_Shift) < 0 then
|
|
|
+ Result := Result or mk_Shift;
|
|
|
+ if GetAsyncKeyState(vk_Control) < 0 then
|
|
|
+ Result := Result or mk_Control;
|
|
|
+ if GetAsyncKeyState(vk_LButton) < 0 then
|
|
|
+ Result := Result or mk_LButton;
|
|
|
+ if GetAsyncKeyState(vk_RButton) < 0 then
|
|
|
+ Result := Result or mk_RButton;
|
|
|
+ if GetAsyncKeyState(vk_MButton) < 0 then
|
|
|
+ Result := Result or mk_MButton;
|
|
|
+ end;
|
|
|
+ //---------------------------------------------------
|
|
|
+begin
|
|
|
+ if (Message.Msg = fIntelliMessage) and (fIntelliMessage <> wm_MouseWheel) then
|
|
|
+ begin
|
|
|
+ PostMessage(Handle, wm_MouseWheel, MakeLong(GetShiftState, Message.wParam),
|
|
|
+ Message.lParam);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+
|
|
|
+//------------------------------------------------
|
|
|
+// INTELLIMOUSE INIT
|
|
|
+//------------------------------------------------
|
|
|
+
|
|
|
+procedure IntelliMouseInit;
|
|
|
+var
|
|
|
+ hWndMouse: hWnd;
|
|
|
+ mQueryScrollLines: UINT;
|
|
|
+ //--------------------------------------------
|
|
|
+ function NativeMouseWheelSupport: Boolean;
|
|
|
+ var
|
|
|
+ ver: TOSVersionInfo;
|
|
|
+ begin
|
|
|
+ Result := False;
|
|
|
+ ver.dwOSVersionInfoSize := sizeof(ver);
|
|
|
+ // For Windows 98, assume dwMajorVersion = 5 (It's 4 for W95)
|
|
|
+ // For NT, we need 4.0 or better.
|
|
|
+ if GetVersionEx(ver) then
|
|
|
+ case ver.dwPlatformID of
|
|
|
+ ver_Platform_Win32_Windows: Result := ver.dwMajorVersion >= 5;
|
|
|
+ ver_Platform_Win32_NT: Result := ver.dwMajorVersion >= 4;
|
|
|
+ end;
|
|
|
+ { Quick and dirty temporary hack for Windows 98 beta 3 }
|
|
|
+ if (not Result) and (ver.szCSDVersion = ' Beta 3') then
|
|
|
+ Result := True;
|
|
|
+ end;
|
|
|
+ //--------------------------------------------
|
|
|
+begin
|
|
|
+ if NativeMouseWheelSupport then
|
|
|
+ begin
|
|
|
+ fIntelliWheelSupport := Boolean(GetSystemMetrics(sm_MouseWheelPresent));
|
|
|
+ SystemParametersInfo(spi_GetWheelScrollLines, 0, @fIntelliScrollLines, 0);
|
|
|
+ fIntelliMessage := wm_MouseWheel;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ { Look for hidden mouse window }
|
|
|
+ hWndMouse := FindWindow('MouseZ', 'Magellan MSWHEEL');
|
|
|
+ if hWndMouse <> 0 then
|
|
|
+ begin
|
|
|
+ { We're in business - get the scroll line info }
|
|
|
+ fIntelliWheelSupport := True;
|
|
|
+ mQueryScrollLines := RegisterWindowMessage('MSH_SCROLL_LINES_MSG');
|
|
|
+ fIntelliScrollLines := SendMessage(hWndMouse, mQueryScrollLines, 0, 0);
|
|
|
+ { Finally, get the custom mouse message as well }
|
|
|
+ fIntelliMessage := RegisterWindowMessage('MSWHEEL_ROLLMSG');
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if (fIntelliScrollLines < 0) or (fIntelliScrollLines > 100) then
|
|
|
+ fIntelliScrollLines := 3;
|
|
|
+end;
|
|
|
+
|
|
|
+//------------------------------------------------
|
|
|
+// WM MOUSE WHEEL
|
|
|
+//------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.WMMouseWheel(var Message: TMessage);
|
|
|
+{$J+}
|
|
|
+{$IFOPT R+} {$DEFINE StoreRangeCheck} {$ENDIF} {$R-}
|
|
|
+const
|
|
|
+ Delta: SmallInt = 0;
|
|
|
+begin
|
|
|
+ Delta := Delta + SmallInt(HiWord(Message.wParam));
|
|
|
+ while Abs(Delta) >= 120 do
|
|
|
+ begin
|
|
|
+ if Delta < 0 then
|
|
|
+ begin
|
|
|
+ DoScroll(sbVert, fIntelliScrollLines);
|
|
|
+ Delta := Delta + 120;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ DoScroll(sbVert, -fIntelliScrollLines);
|
|
|
+ Delta := Delta - 120;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+{$J-}
|
|
|
+{$IFDEF StoreRangeCheck} {$R+} {$UNDEF StoreRangeCheck} {$ENDIF}
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SET CURSOR
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetCursor(ACurX, ACurY: Integer);
|
|
|
+begin
|
|
|
+ ClearSelection;
|
|
|
+ CurX := 0;
|
|
|
+ CurY := ACurY;
|
|
|
+ CurX := ACurX;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SELECT LINE, CHAR
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.SelectLine(LineNo, StyleNo: Integer): integer;
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+begin
|
|
|
+ Result := LineStyle[LineNo];
|
|
|
+ LineStyle[LineNo] := StyleNo;
|
|
|
+ rct := LineRect(LineNo);
|
|
|
+ InvalidateRect(Handle, @rct, True);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SelectLines(StartLine, EndLine: Integer);
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+begin
|
|
|
+ FSelStartX := 0;
|
|
|
+ FSelStartY := StartLine;
|
|
|
+ FSelEndX := Length(Lines[EndLine]);
|
|
|
+ FSelEndY := EndLine;
|
|
|
+ rct := LineRangeRect(FSelStartY, FSelEndY);
|
|
|
+ SelectionChanged;
|
|
|
+ InvalidateRect(Handle, @rct, true);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SelectChar(LineNo, Pos, StyleNo: Integer);
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+begin
|
|
|
+ UnselectChar;
|
|
|
+ FSelCharPos.LineNo := LineNo;
|
|
|
+ FSelCharPos.Pos := Pos;
|
|
|
+ FSelCharStyle := StyleNo;
|
|
|
+ rct := LineRect(LineNo);
|
|
|
+ InvalidateRect(Handle, @rct, True);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.UnSelectChar;
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+begin
|
|
|
+ with FSelCharPos do
|
|
|
+ begin
|
|
|
+ if LineNo < 0 then
|
|
|
+ Exit;
|
|
|
+ rct := LineRect(LineNo);
|
|
|
+ LineNo := -1;
|
|
|
+ Pos := -1;
|
|
|
+ end;
|
|
|
+ FSelCharStyle := -1;
|
|
|
+ InvalidateRect(Handle, @rct, True);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// CLEAR
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.Clear;
|
|
|
+begin
|
|
|
+ CurY := 0;
|
|
|
+ CurX := 0;
|
|
|
+ FLeftCol := 0;
|
|
|
+ FTopLine := 0;
|
|
|
+ Lines.Clear;
|
|
|
+ TGLSMemoStrings(Lines).DoAdd('');
|
|
|
+ ClearUndoList;
|
|
|
+ Invalidate;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SELECT ALL
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SelectAll;
|
|
|
+begin
|
|
|
+ FSelStartY := 0;
|
|
|
+ FSelStartX := 0;
|
|
|
+ FSelEndY := Lines.Count - 1;
|
|
|
+ FSelEndX := Length(Lines[Lines.Count - 1]);
|
|
|
+ Invalidate;
|
|
|
+end;
|
|
|
+
|
|
|
+//-----------------------------------------------------------
|
|
|
+// SET CLIPBOARD CODE PAGE
|
|
|
+//-----------------------------------------------------------
|
|
|
+
|
|
|
+procedure SetClipboardCodePage(const CodePage: longint);
|
|
|
+var
|
|
|
+ Data: THandle;
|
|
|
+ DataPtr: Pointer;
|
|
|
+begin
|
|
|
+ // Define new code page for clipboard
|
|
|
+ Data := GlobalAlloc(GMEM_MOVEABLE + GMEM_DDESHARE, 4);
|
|
|
+ try
|
|
|
+ DataPtr := GlobalLock(Data);
|
|
|
+ try
|
|
|
+ Move(CodePage, DataPtr^, 4);
|
|
|
+ SetClipboardData(CF_LOCALE, Data);
|
|
|
+ finally
|
|
|
+ GlobalUnlock(Data);
|
|
|
+ end;
|
|
|
+ except
|
|
|
+ GlobalFree(Data);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// COPY TO CLIPBOARD
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure CopyStringToClipboard(const Value: string);
|
|
|
+const
|
|
|
+ RusLocale = (SUBLANG_DEFAULT shl $A) or LANG_RUSSIAN;
|
|
|
+begin
|
|
|
+ Clipboard.Open;
|
|
|
+ SetClipboardCodePage(RusLocale);
|
|
|
+ try
|
|
|
+ Clipboard.AsText := Value;
|
|
|
+ finally
|
|
|
+ SetClipboardCodePage(RusLocale);
|
|
|
+ Clipboard.Close;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.CopyToClipBoard;
|
|
|
+begin
|
|
|
+ CopyStringToClipboard(GetSelText);
|
|
|
+end;
|
|
|
+//--------------------------------------------------------------
|
|
|
+// PASTE FROM CLIPBOARD
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.PasteFromClipBoard;
|
|
|
+var
|
|
|
+ H, len: integer;
|
|
|
+ Buff: string;
|
|
|
+begin
|
|
|
+ H := ClipBoard.GetAsHandle(CF_TEXT);
|
|
|
+ len := GlobalSize(H);
|
|
|
+ if len = 0 then
|
|
|
+ Exit;
|
|
|
+
|
|
|
+ SetLength(Buff, len);
|
|
|
+ SetLength(Buff, ClipBoard.GetTextBuf(PChar(Buff), len));
|
|
|
+ AdjustLineBreaks(Buff);
|
|
|
+
|
|
|
+ SetSelText(Buff);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// DELETE SELECTION
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.DeleteSelection(bRepaint: Boolean);
|
|
|
+var
|
|
|
+ xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
|
|
|
+ i, len: integer;
|
|
|
+ OldX, OldY: integer;
|
|
|
+ S1, S2, S, AddSpaces: string;
|
|
|
+ Undo: TGLSMemoDeleteBufUndo;
|
|
|
+begin
|
|
|
+ if (FSelStartY = FSelEndY) and (FSelStartX = FSelEndX) then
|
|
|
+ Exit;
|
|
|
+
|
|
|
+ OldX := CurX;
|
|
|
+ OldY := CurY;
|
|
|
+ xSelStartX := FSelStartX;
|
|
|
+ xSelStartY := FSelStartY;
|
|
|
+ xSelEndX := FSelEndX;
|
|
|
+ xSelEndY := FSelEndY;
|
|
|
+ OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
|
|
|
+
|
|
|
+ if xSelStartY = xSelEndY then
|
|
|
+ begin
|
|
|
+ S1 := Copy(Lines[xSelStartY], xSelStartX + 1, xSelEndX - xSelStartX);
|
|
|
+ S2 := '';
|
|
|
+ AddSpaces := '';
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ len := Length(Lines[xSelStartY]);
|
|
|
+ S1 := Copy(Lines[xSelStartY], xSelStartX + 1, len);
|
|
|
+ AddSpaces := StringOfChar(' ', xSelStartX - len);
|
|
|
+ S2 := Copy(Lines[xSelEndY], 1, xSelEndX);
|
|
|
+ end;
|
|
|
+ Lines[xSelStartY] := Copy(Lines[xSelStartY], 1, xSelStartX) + AddSpaces +
|
|
|
+ Copy(Lines[xSelEndY], xSelEndX + 1, Length(Lines[xSelEndY]));
|
|
|
+ S := S1;
|
|
|
+ for i := xSelStartY + 1 to xSelEndY do
|
|
|
+ begin
|
|
|
+ S := S + #13#10;
|
|
|
+ if i <> xSelEndY then
|
|
|
+ S := S + Lines[xSelStartY + 1];
|
|
|
+ DeleteLine(xSelStartY + 1, -1, -1, -1, -1, False);
|
|
|
+ end;
|
|
|
+ S := S + S2;
|
|
|
+
|
|
|
+ CurY := xSelStartY;
|
|
|
+ CurX := xSelStartX;
|
|
|
+ ClearSelection;
|
|
|
+
|
|
|
+ Changed(xSelStartY, -1);
|
|
|
+ SelectionChanged;
|
|
|
+ if bRepaint then
|
|
|
+ Invalidate;
|
|
|
+
|
|
|
+ Undo := TGLSMemoDeleteBufUndo.Create(OldX, OldY, CurX, CurY, S);
|
|
|
+ Undo.UndoSelStartX := xSelStartX;
|
|
|
+ Undo.UndoSelStartY := xSelStartY;
|
|
|
+ Undo.UndoSelEndX := xSelEndX;
|
|
|
+ Undo.UndoSelEndY := xSelEndY;
|
|
|
+ if Assigned(FUndoList) then
|
|
|
+ FUndoList.Add(Undo);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// CUT TO CLIPBOARD
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.CutToClipBoard;
|
|
|
+begin
|
|
|
+ ClipBoard.SetTextBuf(PChar(GetSelText));
|
|
|
+ DeleteSelection(True);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// GET SEL TEXT
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.GetSelText: string;
|
|
|
+var
|
|
|
+ i: integer;
|
|
|
+ xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
|
|
|
+begin
|
|
|
+ Result := '';
|
|
|
+ if (FSelStartY = FSelEndY) and (FSelStartX = FSelEndX) then
|
|
|
+ Exit;
|
|
|
+
|
|
|
+ xSelStartX := FSelStartX;
|
|
|
+ xSelStartY := FSelStartY;
|
|
|
+ xSelEndX := FSelEndX;
|
|
|
+ xSelEndY := FSelEndY;
|
|
|
+ OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
|
|
|
+
|
|
|
+ if xSelStartY = xSelEndY then
|
|
|
+ Result := Copy(Lines[xSelStartY], xSelStartX + 1, xSelEndX - xSelStartX)
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ Result := Copy(Lines[xSelStartY], xSelStartX + 1,
|
|
|
+ Length(Lines[xSelStartY]));
|
|
|
+ for i := xSelStartY + 1 to xSelEndY - 1 do
|
|
|
+ Result := Result + #13#10 + Lines[i];
|
|
|
+ Result := Result + #13#10 + Copy(Lines[xSelEndY], 1, xSelEndX);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// GET SEL START
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.GetSelStart: TPoint;
|
|
|
+var
|
|
|
+ xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
|
|
|
+begin
|
|
|
+ xSelStartX := FSelStartX;
|
|
|
+ xSelStartY := FSelStartY;
|
|
|
+ xSelEndX := FSelEndX;
|
|
|
+ xSelEndY := FSelEndY;
|
|
|
+ OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
|
|
|
+ Result := Point(xSelStartX, xSelStartY);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// GET SEL END
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.GetSelEnd: TPoint;
|
|
|
+var
|
|
|
+ xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
|
|
|
+begin
|
|
|
+ xSelStartX := FSelStartX;
|
|
|
+ xSelStartY := FSelStartY;
|
|
|
+ xSelEndX := FSelEndX;
|
|
|
+ xSelEndY := FSelEndY;
|
|
|
+ OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
|
|
|
+ Result := Point(xSelEndX, xSelEndY);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SET SEL TEXT
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetSelText(const AValue: string);
|
|
|
+var
|
|
|
+ i, k: integer;
|
|
|
+ xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
|
|
|
+ Buff, S: string;
|
|
|
+ OldX, OldY: integer;
|
|
|
+begin
|
|
|
+ Buff := AValue;
|
|
|
+ xSelStartX := FSelStartX;
|
|
|
+ xSelStartY := FSelStartY;
|
|
|
+ xSelEndX := FSelEndX;
|
|
|
+ xSelEndY := FSelEndY;
|
|
|
+ OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
|
|
|
+
|
|
|
+ DeleteSelection(False);
|
|
|
+
|
|
|
+ OldX := CurX;
|
|
|
+ OldY := CurY;
|
|
|
+ i := Pos(#13#10, Buff);
|
|
|
+ S := Lines[xSelStartY];
|
|
|
+ if i = 0 then
|
|
|
+ begin
|
|
|
+ Lines[xSelStartY] := Copy(S, 1, xSelStartX) + Buff
|
|
|
+ + Copy(S, xSelStartX + 1, Length(S));
|
|
|
+ CurX := xSelStartX;
|
|
|
+ if Buff <> '' then
|
|
|
+ CurX := CurX + Length(Buff);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ k := xSelStartY;
|
|
|
+ Lines[k] := Copy(S, 1, xSelStartX) + Copy(Buff, 1, i - 1);
|
|
|
+ TGLSMemoStrings(Lines).DoInsert(k + 1, Copy(S, xSelStartX + 1, Length(S)));
|
|
|
+ while True do
|
|
|
+ begin
|
|
|
+ Buff := Copy(Buff, i + 2, Length(Buff));
|
|
|
+ i := Pos(#13#10, Buff);
|
|
|
+ k := k + 1;
|
|
|
+ if i = 0 then
|
|
|
+ break;
|
|
|
+ TGLSMemoStrings(Lines).DoInsert(k, Copy(Buff, 1, i - 1));
|
|
|
+ end;
|
|
|
+ Lines[k] := Buff + Lines[k];
|
|
|
+ CurY := k;
|
|
|
+ CurX := Length(Buff);
|
|
|
+ end;
|
|
|
+
|
|
|
+ ClearSelection;
|
|
|
+ Changed(xSelStartY, -1);
|
|
|
+ if Assigned(FUndoList) then
|
|
|
+ FUndoList.Add(TGLSMemoPasteUndo.Create(OldX, OldY, CurX, CurY, AValue));
|
|
|
+ Invalidate;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// GET SEL LENGTH
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.GetSelLength: integer;
|
|
|
+begin
|
|
|
+ Result := Length(GetSelText);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// CHANGED
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.Changed(FromLine, ToLine: integer);
|
|
|
+var
|
|
|
+ i: integer;
|
|
|
+begin
|
|
|
+ if ToLine < FromLine then
|
|
|
+ ToLine := Lines.Count - 1;
|
|
|
+ for i := FromLine to ToLine do
|
|
|
+ ValidAttrs[i] := False;
|
|
|
+ InvalidateLineRange(FromLine, ToLine);
|
|
|
+ if Assigned(FOnChange) then
|
|
|
+ FOnChange(Self);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// ATTR CHANGED
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.AttrChanged(LineNo: integer);
|
|
|
+begin
|
|
|
+ ValidAttrs[LineNo] := False;
|
|
|
+ InvalidateLineRange(LineNo, LineNo);
|
|
|
+ if Assigned(FOnAttrChange) then
|
|
|
+ FOnAttrChange(Self);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SELECTION CHANGED
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SelectionChanged;
|
|
|
+begin
|
|
|
+ if Assigned(FOnSelectionChange) then
|
|
|
+ FOnSelectionChange(Self);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// STATUS CHANGED
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.StatusChanged;
|
|
|
+begin
|
|
|
+ if Assigned(FOnStatusChange) then
|
|
|
+ FOnStatusChange(Self);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// CLEAR SELECTION
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.ClearSelection;
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+ Changed: Boolean;
|
|
|
+begin
|
|
|
+ Changed := not ((FSelStartX = FSelEndX) and (FSelStartY = FSelEndY));
|
|
|
+ rct := LineRangeRect(FSelStartY, FSelEndY);
|
|
|
+ FSelStartX := CurX;
|
|
|
+ FSelStartY := CurY;
|
|
|
+ FSelEndX := CurX;
|
|
|
+ FSelEndY := CurY;
|
|
|
+ FPrevSelX := CurX;
|
|
|
+ FPrevSelY := CurY;
|
|
|
+ if Changed then
|
|
|
+ begin
|
|
|
+ SelectionChanged;
|
|
|
+ InvalidateRect(Handle, @rct, true);
|
|
|
+ end;
|
|
|
+ if Assigned(FOnMoveCursor) then
|
|
|
+ FOnMoveCursor(Self);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// EXPAND SELECTION
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.ExpandSelection;
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+begin
|
|
|
+ rct := LineRangeRect(FPrevSelY, CurY);
|
|
|
+ FSelEndX := CurX;
|
|
|
+ FSelEndY := CurY;
|
|
|
+ FPrevSelX := CurX;
|
|
|
+ FPrevSelY := CurY;
|
|
|
+ SelectionChanged;
|
|
|
+ InvalidateRect(Handle, @rct, true);
|
|
|
+ if Assigned(FOnMoveCursor) then
|
|
|
+ FOnMoveCursor(Self);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// MAX LENGTH
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.MaxLength: integer;
|
|
|
+var
|
|
|
+ i, len: integer;
|
|
|
+begin
|
|
|
+ Result := 0;
|
|
|
+ for i := 0 to Lines.Count - 1 do
|
|
|
+ begin
|
|
|
+ len := Length(Lines[i]);
|
|
|
+ if len > Result then
|
|
|
+ Result := len;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// DO SCROLL
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.DoScroll(Sender: TGLSMemoScrollBar; ByValue: integer);
|
|
|
+var
|
|
|
+ eRect, scrRect, sbRect: TRect;
|
|
|
+ Old: integer;
|
|
|
+begin
|
|
|
+ eRect := EditorRect;
|
|
|
+ case Sender.Kind of
|
|
|
+ sbVertical:
|
|
|
+ begin
|
|
|
+ Old := FTopLine;
|
|
|
+ FTopLine := FTopLine + ByValue;
|
|
|
+ if FTopLine > Sender.MaxPosition then
|
|
|
+ FTopLine := Sender.MaxPosition;
|
|
|
+ if FTopLine < 0 then
|
|
|
+ FTopLine := 0;
|
|
|
+ if Old <> FTopLine then
|
|
|
+ begin
|
|
|
+ ShowCaret(False);
|
|
|
+ if CurY < FTopLine then
|
|
|
+ CurY := FTopLine;
|
|
|
+ if CurY > LastVisibleLine then
|
|
|
+ CurY := LastVisibleLine;
|
|
|
+
|
|
|
+ ScrollDC(Canvas.Handle, 0, (Old - FTopLine) * FCellSize.H,
|
|
|
+ eRect, eRect, 0, @scrRect);
|
|
|
+ InvalidateRect(Handle, @scrRect, True);
|
|
|
+ sbRect := Sender.FullRect;
|
|
|
+ InvalidateRect(Handle, @sbRect, True);
|
|
|
+ FGutter.Invalidate;
|
|
|
+ ShowCaret(True);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ sbHorizontal:
|
|
|
+ begin
|
|
|
+ Old := FLeftCol;
|
|
|
+ FLeftCol := FLeftCol + ByValue;
|
|
|
+ if FLeftCol > Sender.MaxPosition then
|
|
|
+ FLeftCol := Sender.MaxPosition;
|
|
|
+ if FLeftCol < 0 then
|
|
|
+ FLeftCol := 0;
|
|
|
+ if Old <> FLeftCol then
|
|
|
+ begin
|
|
|
+ ShowCaret(False);
|
|
|
+ if CurX < FLeftCol then
|
|
|
+ CurX := FLeftCol;
|
|
|
+ if CurX > LastVisiblePos then
|
|
|
+ CurX := LastVisiblePos;
|
|
|
+ ScrollDC(Canvas.Handle, (Old - FLeftCol) * FCellSize.W, 0,
|
|
|
+ eRect, eRect, 0, @scrRect);
|
|
|
+ InvalidateRect(Handle, @scrRect, True);
|
|
|
+ sbRect := Sender.FullRect;
|
|
|
+ InvalidateRect(Handle, @sbRect, True);
|
|
|
+ ShowCaret(True);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// DO SCROLL PAGE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.DoScrollPage(Sender: TGLSMemoScrollBar; ByValue:
|
|
|
+ integer);
|
|
|
+begin
|
|
|
+ case Sender.Kind of
|
|
|
+ sbVertical: DoScroll(Sender, ByValue * VisibleLineCount);
|
|
|
+ sbHorizontal: DoScroll(Sender, ByValue * VisiblePosCount);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SET LINES
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetLines(ALines: TStrings);
|
|
|
+begin
|
|
|
+ if ALines <> nil then
|
|
|
+ begin
|
|
|
+ FLines.Assign(ALines);
|
|
|
+ Changed(0, -1);
|
|
|
+ SelectionChanged;
|
|
|
+ Invalidate;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SET/GET LINE STYLE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetLineStyle(Index: integer; Value: integer);
|
|
|
+begin
|
|
|
+ TGLSMemoStrings(FLines).Style[Index] := Value;
|
|
|
+ if IsLineVisible(Index) then
|
|
|
+ AttrChanged(Index);
|
|
|
+end;
|
|
|
+
|
|
|
+function TGLSCustomMemo.GetLineStyle(Index: integer): integer;
|
|
|
+begin
|
|
|
+ Result := TGLSMemoStrings(FLines).Style[Index];
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// GET/SET IN COMMENT
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.GetInComment(Index: integer): Boolean;
|
|
|
+begin
|
|
|
+ Result := TGLSMemoStrings(FLines).InComment[Index];
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetInComment(Index: integer; Value: Boolean);
|
|
|
+begin
|
|
|
+ TGLSMemoStrings(FLines).InComment[Index] := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// GET/SET IN BRACKETS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.GetInBrackets(Index: integer): integer;
|
|
|
+begin
|
|
|
+ Result := TGLSMemoStrings(FLines).InBrackets[Index];
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetInBrackets(Index: integer; Value: integer);
|
|
|
+begin
|
|
|
+ TGLSMemoStrings(FLines).InBrackets[Index] := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// GET/SET VALID ATTRS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.GetValidAttrs(Index: integer): Boolean;
|
|
|
+begin
|
|
|
+ Result := TGLSMemoStrings(FLines).ValidAttrs[Index];
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetValidAttrs(Index: integer; Value: Boolean);
|
|
|
+begin
|
|
|
+ TGLSMemoStrings(FLines).ValidAttrs[Index] := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// GET/SET CHAR ATTRS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.GetCharAttrs(Index: integer): string;
|
|
|
+begin
|
|
|
+ Result := TGLSMemoStrings(FLines).CharAttrs[Index];
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetCharAttrs(Index: integer; const Value: string);
|
|
|
+begin
|
|
|
+ TGLSMemoStrings(FLines).CharAttrs[Index] := Value;
|
|
|
+ if IsLineVisible(Index) then
|
|
|
+ AttrChanged(Index);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SET CUR X
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetCurX(Value: integer);
|
|
|
+var
|
|
|
+ len: integer;
|
|
|
+ WasVisible: Boolean;
|
|
|
+begin
|
|
|
+ if Value < 0 then
|
|
|
+ if CurY = 0 then
|
|
|
+ Value := 0
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ CurY := CurY - 1;
|
|
|
+ Value := Length(Lines[CurY]);
|
|
|
+ end;
|
|
|
+
|
|
|
+ if (CurY >= 0) and (CurY < Lines.Count) then
|
|
|
+ begin
|
|
|
+ len := Length(Lines[CurY]);
|
|
|
+ if Value > len then
|
|
|
+ begin
|
|
|
+ Lines[CurY] := Lines[CurY] + StringOfChar(' ', Value - len);
|
|
|
+ // Value := len;
|
|
|
+ ValidAttrs[CurY] := False;
|
|
|
+ InvalidateLineRange(CurY, CurY);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ FCurX := Value;
|
|
|
+
|
|
|
+ WasVisible := FCaretVisible;
|
|
|
+ if WasVisible then
|
|
|
+ ShowCaret(False);
|
|
|
+ MakeVisible;
|
|
|
+ ResizeScrollBars;
|
|
|
+ StatusChanged;
|
|
|
+ if WasVisible then
|
|
|
+ ShowCaret(True);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SET CUR Y
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetCurY(Value: integer);
|
|
|
+var
|
|
|
+ Old: integer;
|
|
|
+ WasVisible: Boolean;
|
|
|
+begin
|
|
|
+ WasVisible := FCaretVisible;
|
|
|
+ if WasVisible then
|
|
|
+ ShowCaret(False);
|
|
|
+ Old := CurY;
|
|
|
+
|
|
|
+ if Value < 0 then
|
|
|
+ Value := 0;
|
|
|
+ if Value >= Lines.Count then
|
|
|
+ Value := Lines.Count - 1;
|
|
|
+
|
|
|
+ FCurY := Value;
|
|
|
+ if (CurY <> Old) and (Old >= 0) and (Old < Lines.Count) then
|
|
|
+ Lines[Old] := TrimRight(Lines[Old]);
|
|
|
+ CurX := CurX;
|
|
|
+
|
|
|
+ MakeVisible;
|
|
|
+ ResizeScrollBars;
|
|
|
+ StatusChanged;
|
|
|
+ if WasVisible then
|
|
|
+ ShowCaret(True);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// MOVE CURSOR
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.MoveCursor(dX, dY: integer; Shift: TShiftState);
|
|
|
+var
|
|
|
+ Selecting: Boolean;
|
|
|
+ //------------------------------------------------------------
|
|
|
+ function IsDelimiter(c: char): Boolean;
|
|
|
+ begin
|
|
|
+ Result := Pos(c, ' .,;:/?!@#$%^&*(){}[]<>-+=|\') > 0;
|
|
|
+ end;
|
|
|
+ //------------------------------------------------------------
|
|
|
+ function IsStopChar(c, cThis: char): Boolean;
|
|
|
+ begin
|
|
|
+ Result := IsDelimiter(c) <> IsDelimiter(cThis);
|
|
|
+ end;
|
|
|
+ //------------------------------------------------------------
|
|
|
+ procedure MoveWordLeft;
|
|
|
+ var
|
|
|
+ S: string;
|
|
|
+ begin
|
|
|
+ CurX := CurX - 1;
|
|
|
+ S := TrimRight(Lines[CurY]);
|
|
|
+ while CurX > 0 do
|
|
|
+ begin
|
|
|
+ if IsStopChar(S[CurX], S[CurX + 1]) then
|
|
|
+ break;
|
|
|
+ CurX := CurX - 1;
|
|
|
+ end;
|
|
|
+ if (CurX < 0) then
|
|
|
+ if CurY > 0 then
|
|
|
+ begin
|
|
|
+ CurY := CurY - 1;
|
|
|
+ CurX := Length(Lines[CurY]);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ //------------------------------------------------------------
|
|
|
+ procedure MoveWordRight;
|
|
|
+ var
|
|
|
+ Len: integer;
|
|
|
+ S: string;
|
|
|
+ begin
|
|
|
+ S := TrimRight(Lines[CurY]);
|
|
|
+ Len := Length(S);
|
|
|
+ CurX := CurX + 1;
|
|
|
+ while CurX < Len do
|
|
|
+ begin
|
|
|
+ if IsStopChar(S[CurX + 1], S[CurX]) then
|
|
|
+ break;
|
|
|
+ CurX := CurX + 1;
|
|
|
+ end;
|
|
|
+ if CurX > Len then
|
|
|
+ if CurY < Lines.Count - 1 then
|
|
|
+ begin
|
|
|
+ CurY := CurY + 1;
|
|
|
+ CurX := 0;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ //------------------------------------------------------------
|
|
|
+begin
|
|
|
+ Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
|
|
|
+ and (CurY = FPrevSelY);
|
|
|
+ if ssCtrl in Shift then
|
|
|
+ begin
|
|
|
+ if dX > 0 then
|
|
|
+ MoveWordRight;
|
|
|
+ if dX < 0 then
|
|
|
+ MoveWordLeft;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ CurY := CurY + dY;
|
|
|
+ CurX := CurX + dX;
|
|
|
+ end;
|
|
|
+ if Selecting then
|
|
|
+ ExpandSelection
|
|
|
+ else
|
|
|
+ ClearSelection;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// MOVE PAGE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.MovePage(dP: integer; Shift: TShiftState);
|
|
|
+var
|
|
|
+ eRect: TRect;
|
|
|
+ LinesPerPage: integer;
|
|
|
+ Selecting: Boolean;
|
|
|
+begin
|
|
|
+ if FCellSize.H = 0 then
|
|
|
+ Exit;
|
|
|
+ Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
|
|
|
+ and (CurY = FPrevSelY);
|
|
|
+ eRect := EditorRect;
|
|
|
+ LinesPerPage := (eRect.Bottom - eRect.Top) div FCellSize.H - 1;
|
|
|
+ CurY := CurY + dP * LinesPerPage;
|
|
|
+ if ssCtrl in Shift then
|
|
|
+ if dP > 0 then
|
|
|
+ begin
|
|
|
+ CurY := Lines.Count - 1;
|
|
|
+ CurX := Length(Lines[Lines.Count - 1]);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ CurY := 0;
|
|
|
+ CurX := 0;
|
|
|
+ end;
|
|
|
+ if Selecting then
|
|
|
+ ExpandSelection
|
|
|
+ else
|
|
|
+ ClearSelection;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// GO HOME
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.GoHome(Shift: TShiftState);
|
|
|
+var
|
|
|
+ Selecting: Boolean;
|
|
|
+begin
|
|
|
+ Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
|
|
|
+ and (CurY = FPrevSelY);
|
|
|
+ CurX := 0;
|
|
|
+ FLeftCol := 0;
|
|
|
+ if Selecting then
|
|
|
+ ExpandSelection
|
|
|
+ else
|
|
|
+ ClearSelection;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// GO END
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.GoEnd(Shift: TShiftState);
|
|
|
+var
|
|
|
+ Selecting: Boolean;
|
|
|
+ S, S1: string;
|
|
|
+begin
|
|
|
+ Selecting := (ssShift in Shift) and (CurX = FPrevSelX)
|
|
|
+ and (CurY = FPrevSelY);
|
|
|
+
|
|
|
+ S := Lines[CurY];
|
|
|
+ if not Selecting then
|
|
|
+ S := TrimRight(S);
|
|
|
+ S1 := TrimRight(Copy(S, CurX + 1, Length(S)));
|
|
|
+ S := Copy(S, 1, CurX);
|
|
|
+ Lines[CurY] := S + S1;
|
|
|
+
|
|
|
+ CurX := Length(Lines[CurY]);
|
|
|
+ if Selecting then
|
|
|
+ ExpandSelection
|
|
|
+ else
|
|
|
+ ClearSelection;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// INSERT CHAR
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.InsertChar(C: Char);
|
|
|
+var
|
|
|
+ S, S1: string;
|
|
|
+ NewPlace: integer;
|
|
|
+ rct: TRect;
|
|
|
+ CurX0, CurY0: integer;
|
|
|
+begin
|
|
|
+ CurX0 := CurX;
|
|
|
+ CurY0 := CurY;
|
|
|
+ S := Lines[CurY];
|
|
|
+ NewPlace := CurX + 1;
|
|
|
+ if C = #9 then
|
|
|
+ begin
|
|
|
+ while (NewPlace mod TabSize) <> 0 do
|
|
|
+ Inc(NewPlace);
|
|
|
+ S1 := StringOfChar(' ', NewPlace - CurX);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ S1 := C;
|
|
|
+ Insert(S1, S, CurX + 1);
|
|
|
+ Lines[CurY] := S;
|
|
|
+ CurX := NewPlace;
|
|
|
+ ClearSelection;
|
|
|
+ rct := LineRect(CurY);
|
|
|
+ Changed(CurY, CurY);
|
|
|
+
|
|
|
+ if Assigned(FUndoList) then
|
|
|
+ FUndoList.Add(TGLSMemoInsCharUndo.Create(CurX0, CurY0, CurX, CurY, S1));
|
|
|
+
|
|
|
+ InvalidateRect(Handle, @rct, True);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// INSERT TEMPLATE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.InsertTemplate(AText: string);
|
|
|
+var
|
|
|
+ i, NewCurX, NewCurY: integer;
|
|
|
+ Indent: string;
|
|
|
+ FoundCursor: Boolean;
|
|
|
+begin
|
|
|
+ Indent := IndentCurrLine;
|
|
|
+
|
|
|
+ DeleteSelection(False);
|
|
|
+ ClearSelection;
|
|
|
+
|
|
|
+ NewCurX := CurX;
|
|
|
+ NewCurY := CurY;
|
|
|
+ FoundCursor := False;
|
|
|
+ i := 1;
|
|
|
+ while i <= Length(AText) do
|
|
|
+ begin
|
|
|
+ if AText[i] = #13 then
|
|
|
+ begin
|
|
|
+ if (i = Length(AText)) or (AText[i + 1] <> #10) then
|
|
|
+ Insert(#10 + Indent, AText, i + 1);
|
|
|
+ if not FoundCursor then
|
|
|
+ begin
|
|
|
+ Inc(NewCurY);
|
|
|
+ NewCurX := Length(Indent);
|
|
|
+ end;
|
|
|
+ Inc(i, 1 + Length(Indent));
|
|
|
+ end
|
|
|
+ else if AText[i] = #7 then
|
|
|
+ begin
|
|
|
+ FoundCursor := True;
|
|
|
+ Delete(AText, i, 1);
|
|
|
+ Dec(i);
|
|
|
+ end
|
|
|
+ else if Ord(AText[i]) < Ord(' ') then
|
|
|
+ begin
|
|
|
+ Delete(AText, i, 1);
|
|
|
+ Dec(i);
|
|
|
+ end
|
|
|
+ else if not FoundCursor then
|
|
|
+ Inc(NewCurX);
|
|
|
+ Inc(i);
|
|
|
+ end;
|
|
|
+
|
|
|
+ SetSelText(AText);
|
|
|
+ SetCursor(NewCurX, NewCurY);
|
|
|
+ ClearSelection;
|
|
|
+ try
|
|
|
+ SetFocus;
|
|
|
+ except
|
|
|
+ end;
|
|
|
+
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// DELETE CHAR
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.DeleteChar(OldX, OldY: integer);
|
|
|
+var
|
|
|
+ S, S1: string;
|
|
|
+ rct: TRect;
|
|
|
+ C: char;
|
|
|
+ Undo: TGLSMemoDelCharUndo;
|
|
|
+ IsBackspace: Boolean;
|
|
|
+begin
|
|
|
+ if FReadOnly then
|
|
|
+ Exit;
|
|
|
+ if OldX < 0 then
|
|
|
+ begin
|
|
|
+ OldX := CurX;
|
|
|
+ OldY := CurY;
|
|
|
+ IsBackspace := False;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ IsBackspace := True;
|
|
|
+
|
|
|
+ ClearSelection;
|
|
|
+
|
|
|
+ S := Lines[CurY];
|
|
|
+ S1 := Copy(S, CurX + 1, Length(S));
|
|
|
+ if not IsBackspace then
|
|
|
+ S1 := TrimRight(S1);
|
|
|
+ S := Copy(S, 1, CurX);
|
|
|
+ Lines[CurY] := S + S1;
|
|
|
+
|
|
|
+ if CurX < Length(Lines[CurY]) then
|
|
|
+ begin
|
|
|
+ S := Lines[CurY];
|
|
|
+ C := S[CurX + 1];
|
|
|
+ Delete(S, CurX + 1, 1);
|
|
|
+ Lines[CurY] := S;
|
|
|
+ Changed(CurY, CurY);
|
|
|
+ rct := LineRect(CurY);
|
|
|
+ Undo := TGLSMemoDelCharUndo.Create(OldX, OldY, CurX, CurY, C);
|
|
|
+ Undo.IsBackSpace := IsBackSpace;
|
|
|
+ if Assigned(FUndoList) then
|
|
|
+ FUndoList.Add(Undo);
|
|
|
+ end
|
|
|
+ else if CurY < Lines.Count - 1 then
|
|
|
+ begin
|
|
|
+ S := Lines[CurY] + Lines[CurY + 1];
|
|
|
+ Lines[CurY] := S;
|
|
|
+ DeleteLine(CurY + 1, OldX, OldY, CurX, CurY, False);
|
|
|
+ Changed(CurY, -1);
|
|
|
+ rct := EditorRect;
|
|
|
+ Undo := TGLSMemoDelCharUndo.Create(OldX, OldY, CurX, CurY, #13);
|
|
|
+ Undo.IsBackSpace := IsBackSpace;
|
|
|
+ if Assigned(FUndoList) then
|
|
|
+ FUndoList.Add(Undo);
|
|
|
+ end;
|
|
|
+ ClearSelection;
|
|
|
+ InvalidateRect(Handle, @rct, True);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// DELETE LINE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.DeleteLine(Index, OldX, OldY, NewX, NewY: integer;
|
|
|
+ FixUndo: Boolean);
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+ s: string;
|
|
|
+begin
|
|
|
+ if Index < 0 then
|
|
|
+ Index := CurY;
|
|
|
+ if OldX < 0 then
|
|
|
+ begin
|
|
|
+ OldX := CurX;
|
|
|
+ OldY := CurY;
|
|
|
+ end;
|
|
|
+
|
|
|
+ s := Lines[Index];
|
|
|
+
|
|
|
+ TGLSMemoStrings(Lines).FDeleting := True;
|
|
|
+ if Lines.Count = 1 then
|
|
|
+ TGLSMemoStrings(Lines)[0] := ''
|
|
|
+ else
|
|
|
+ Lines.Delete(Index);
|
|
|
+ TGLSMemoStrings(Lines).FDeleting := False;
|
|
|
+
|
|
|
+ ClearSelection;
|
|
|
+ if Index >= Lines.Count then
|
|
|
+ Changed(Index - 1, -1)
|
|
|
+ else
|
|
|
+ Changed(Index, -1);
|
|
|
+ rct := EditorRect;
|
|
|
+ InvalidateRect(Handle, @rct, True);
|
|
|
+
|
|
|
+ if NewX < 0 then
|
|
|
+ begin
|
|
|
+ if Length(Lines[0]) < CurX then
|
|
|
+ CurX := Length(Lines[0]);
|
|
|
+ if Index >= Lines.Count then
|
|
|
+ CurY := Index - 1
|
|
|
+ else
|
|
|
+ CurY := Index;
|
|
|
+ NewX := CurX;
|
|
|
+ NewY := CurY;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ CurX := NewX;
|
|
|
+ CurY := NewY;
|
|
|
+ end;
|
|
|
+ if Assigned(FUndoList) and FixUndo then
|
|
|
+ FUndoList.Add(TGLSMEmoDelLineUndo.Create(Index, OldX, OldY, NewX, NewY, s));
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// BACK SPACE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.BackSpace;
|
|
|
+var
|
|
|
+ OldX, OldY: integer;
|
|
|
+begin
|
|
|
+ OldX := CurX;
|
|
|
+ OldY := CurY;
|
|
|
+ MoveCursor(-1, 0, []);
|
|
|
+ if (OldX = CurX) and (OldY = CurY) then
|
|
|
+ Exit;
|
|
|
+ DeleteChar(OldX, OldY);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// BACK SPACE WORD
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.BackSpaceWord;
|
|
|
+begin
|
|
|
+ ClearSelection;
|
|
|
+ MoveCursor(-1, 0, [ssShift, ssCtrl]);
|
|
|
+ DeleteSelection(True);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// INDENT CURR LINE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.IndentCurrLine: string;
|
|
|
+var
|
|
|
+ Len, Count: integer;
|
|
|
+ CurS: string;
|
|
|
+begin
|
|
|
+ Result := '';
|
|
|
+ if not AutoIndent then
|
|
|
+ Exit;
|
|
|
+ CurS := Lines[CurY];
|
|
|
+ Len := Length(CurS);
|
|
|
+ Count := 0;
|
|
|
+ while (Count < CurX) and (Count < Len) do
|
|
|
+ begin
|
|
|
+ if CurS[Count + 1] <> ' ' then
|
|
|
+ break;
|
|
|
+ Inc(Count);
|
|
|
+ end;
|
|
|
+ Result := StringOfChar(' ', Count);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// NEW LINE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.NewLine;
|
|
|
+var
|
|
|
+ S, sIndent: string;
|
|
|
+ OldX, OldY: integer;
|
|
|
+begin
|
|
|
+ OldX := CurX;
|
|
|
+ OldY := CurY;
|
|
|
+ S := Lines[CurY];
|
|
|
+ sIndent := IndentCurrLine;
|
|
|
+ Lines[CurY] := Copy(S, 1, CurX);
|
|
|
+
|
|
|
+ S := TrimRight(Copy(S, CurX + 1, Length(S)));
|
|
|
+ if AutoIndent then
|
|
|
+ while (Length(S) > 0) and (S[1] = ' ') do
|
|
|
+ Delete(S, 1, 1);
|
|
|
+
|
|
|
+ TGLSMemoStrings(Lines).DoInsert(CurY + 1, sIndent + S);
|
|
|
+ GoHome([]);
|
|
|
+ MoveCursor(0, 1, []);
|
|
|
+ CurX := Length(sIndent);
|
|
|
+ ClearSelection;
|
|
|
+ if Assigned(FUndoList) then
|
|
|
+ FUndoList.Add(TGLSMemoInsCharUndo.Create(OldX, OldY, CurX, CurY, #13 +
|
|
|
+ sIndent));
|
|
|
+ Invalidate;
|
|
|
+ Changed(CurY - 1, -1);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// ADD STRING
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.AddString(const S: string): integer;
|
|
|
+begin
|
|
|
+ if Lines.Count = 0 then
|
|
|
+ TGLSMemoStrings(Lines).DoAdd('');
|
|
|
+ MovePage(1, [ssCtrl]); // end of text
|
|
|
+ if not ((Lines.Count = 1) and (Lines[0] = '')) then
|
|
|
+ begin
|
|
|
+ TGLSMemoStrings(Lines).DoAdd('');
|
|
|
+ CurX := 0;
|
|
|
+ CurY := Lines.Count;
|
|
|
+ ClearSelection;
|
|
|
+ // S := #13#10 + S;
|
|
|
+ end;
|
|
|
+ SetSelText(S);
|
|
|
+ Result := Lines.Count - 1;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// INSERT STRING
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.InsertString(Index: integer; S: string);
|
|
|
+begin
|
|
|
+ CurY := Index;
|
|
|
+ CurX := 0;
|
|
|
+ ClearSelection;
|
|
|
+ if not ((Lines.Count = 1) and (Lines[0] = '')) then
|
|
|
+ S := S + #13#10;
|
|
|
+ SetSelText(S);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// DO COMMAND
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.DoCommand(cmd: TCommand; const AShift: TShiftState);
|
|
|
+begin
|
|
|
+ case cmd of
|
|
|
+ cmDelete: if not FReadOnly then
|
|
|
+ begin
|
|
|
+ if ssShift in AShift then
|
|
|
+ CutToClipboard
|
|
|
+ else if FDelErase and
|
|
|
+ (not ((FSelStartX = FSelEndX) and (FSelStartY = FSelEndY))) then
|
|
|
+ DeleteSelection(True)
|
|
|
+ else
|
|
|
+ DeleteChar(-1, -1);
|
|
|
+ end;
|
|
|
+ cmBackSpace: BackSpace;
|
|
|
+ cmWordBackSpace: BackSpaceWord;
|
|
|
+ cmNewLine: NewLine;
|
|
|
+ cmDelLine: DeleteLine(-1, -1, -1, -1, -1, True);
|
|
|
+ cmCopy: CopyToClipboard;
|
|
|
+ cmCut: CutToClipboard;
|
|
|
+ cmPaste: PasteFromClipboard;
|
|
|
+ cmHome: GoHome(AShift);
|
|
|
+ cmEnd: GoEnd(AShift);
|
|
|
+ cmPageDown: MovePage(1, AShift);
|
|
|
+ cmPageUp: MovePage(-1, AShift);
|
|
|
+ cmInsert:
|
|
|
+ begin
|
|
|
+ if ssShift in AShift then
|
|
|
+ PasteFromClipboard;
|
|
|
+ if ssCtrl in AShift then
|
|
|
+ CopyToClipboard;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// KEY DOWN
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.KeyDown(var Key: Word; Shift: TShiftState);
|
|
|
+begin
|
|
|
+ ShowCaret(False);
|
|
|
+ inherited;
|
|
|
+ case Key of
|
|
|
+ VK_LEFT: MoveCursor(-1, 0, Shift);
|
|
|
+ VK_RIGHT: MoveCursor(1, 0, Shift);
|
|
|
+ VK_UP: MoveCursor(0, -1, Shift);
|
|
|
+ VK_DOWN: MoveCursor(0, 1, Shift);
|
|
|
+ VK_HOME, VK_END,
|
|
|
+ VK_DELETE: DoCommand(Key, Shift);
|
|
|
+ VK_PRIOR, VK_NEXT:
|
|
|
+ DoCommand(Key, Shift);
|
|
|
+ VK_INSERT: DoCommand(Key, Shift);
|
|
|
+ end;
|
|
|
+ ShowCaret(True);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// KEY PRESS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.KeyPress(var Key: Char);
|
|
|
+begin
|
|
|
+ if FReadOnly then
|
|
|
+ Exit;
|
|
|
+ ShowCaret(False);
|
|
|
+ inherited;
|
|
|
+ if (ord(Key) in [9, 32..255]) and (ord(Key) <> 127) then
|
|
|
+ begin
|
|
|
+ if FDelErase and (not ((FSelStartX = FSelEndX) and (FSelStartY = FSelEndY)))
|
|
|
+ then
|
|
|
+ DeleteSelection(True);
|
|
|
+ InsertChar(Key);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ DoCommand(Ord(Key), []);
|
|
|
+ ShowCaret(True);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// MOUSE DOWN
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
|
+ X, Y: Integer);
|
|
|
+var
|
|
|
+ newPos: TCellPos;
|
|
|
+ charPos: TFullPos;
|
|
|
+ Selecting: Boolean;
|
|
|
+begin
|
|
|
+ inherited;
|
|
|
+ if not Focused then
|
|
|
+ begin
|
|
|
+ SetFocus;
|
|
|
+ // Exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if FAfterDoubleClick then
|
|
|
+ begin
|
|
|
+ FAfterDoubleClick := False;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if Button <>mbLeft then
|
|
|
+ Exit;
|
|
|
+
|
|
|
+
|
|
|
+ if sbVert.MouseDown(Button, Shift, X, Y) then
|
|
|
+ Exit;
|
|
|
+ if sbHorz.MouseDown(Button, Shift, X, Y) then
|
|
|
+ Exit;
|
|
|
+
|
|
|
+ if PointInRect(Point(X, Y), EditorRect) then
|
|
|
+ begin
|
|
|
+ ShowCaret(False);
|
|
|
+ newPos := CellFromPos(X, Y);
|
|
|
+ CurY := newPos.Y + FTopLine;
|
|
|
+ CurX := newPos.X + FLeftCol;
|
|
|
+ if Assigned(FOnMoveCursor) then
|
|
|
+ FOnMoveCursor(Self);
|
|
|
+
|
|
|
+ Selecting := ssShift in Shift;
|
|
|
+ if Button = mbLeft then
|
|
|
+ begin
|
|
|
+ if Selecting then
|
|
|
+ ExpandSelection
|
|
|
+ else
|
|
|
+ ClearSelection;
|
|
|
+ FLeftButtonDown := True;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ ShowCaret(True);
|
|
|
+ end;
|
|
|
+
|
|
|
+ if Assigned(FOnGutterClick) then
|
|
|
+ if PointInRect(Point(X, Y), FGutter.FullRect) then
|
|
|
+ begin
|
|
|
+ charPos := CharFromPos(X, Y);
|
|
|
+ if charPos.LineNo < Lines.Count then
|
|
|
+ FOnGutterClick(Self, charPos.LineNo);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// MOUSE MOVE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.MouseMove(Shift: TShiftState; X, Y: Integer);
|
|
|
+var
|
|
|
+ newPos: TCellPos;
|
|
|
+begin
|
|
|
+ inherited;
|
|
|
+ if sbVert.MouseMove(Shift, X, Y) then
|
|
|
+ Exit;
|
|
|
+ if sbHorz.MouseMove(Shift, X, Y) then
|
|
|
+ Exit;
|
|
|
+ if PointInRect(Point(X, Y), EditorRect) then
|
|
|
+ begin
|
|
|
+ if (ssLeft in Shift) and FLeftButtonDown then
|
|
|
+ begin
|
|
|
+ newPos := CellFromPos(X, Y);
|
|
|
+ CurY := newPos.Y + FTopLine;
|
|
|
+ CurX := newPos.X + FLeftCol;
|
|
|
+ ExpandSelection;
|
|
|
+ end;
|
|
|
+ end
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// MOUSE UP
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
|
|
|
+ Integer);
|
|
|
+begin
|
|
|
+ inherited;
|
|
|
+ if sbVert.MouseUp(Button, Shift, X, Y) then
|
|
|
+ Exit;
|
|
|
+ if sbHorz.MouseUp(Button, Shift, X, Y) then
|
|
|
+ Exit;
|
|
|
+ if Button = mbLeft then
|
|
|
+ ShowCaret(True);
|
|
|
+ FLeftButtonDown := False;
|
|
|
+ FLastMouseUpX := X;
|
|
|
+ FLastMouseUpY := Y;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// DBL CLICK
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.DblClick;
|
|
|
+var
|
|
|
+ clickPos: TCellPos;
|
|
|
+ clickX, clickY: integer;
|
|
|
+ //------------------------------------------------------------
|
|
|
+ // SELECT WORD
|
|
|
+ //------------------------------------------------------------
|
|
|
+ procedure SelectWord;
|
|
|
+ const
|
|
|
+ stopChars: TSysCharSet = [' ', ';', '.', ',', ':', '?', '!', '''', '"',
|
|
|
+ '<', '>', '/', '*', '+', '-', '=', '(', ')',
|
|
|
+ '[', ']', '{', '}', '@', '#', '$', '%', '^',
|
|
|
+ '&', '|', '\'];
|
|
|
+ var
|
|
|
+ s: string;
|
|
|
+ i: integer;
|
|
|
+ rct: TRect;
|
|
|
+ begin
|
|
|
+ CurX := clickX;
|
|
|
+ CurY := clickY;
|
|
|
+ if (CurX = clickX) and (CurY = clickY) then
|
|
|
+ begin
|
|
|
+ s := Lines[clickY];
|
|
|
+ if s[clickX + 1] = ' ' then
|
|
|
+ Exit;
|
|
|
+
|
|
|
+ i := clickX;
|
|
|
+ while (i >= 0) and not CharInSet(s[i + 1], stopChars) do
|
|
|
+ Dec(i);
|
|
|
+ FSelStartY := clickY;
|
|
|
+ FSelStartX := i + 1;
|
|
|
+
|
|
|
+ i := clickX;
|
|
|
+ while (i < Length(s)) and not CharInSet(s[i + 1], stopChars) do
|
|
|
+ Inc(i);
|
|
|
+ FSelEndY := clickY;
|
|
|
+ FSelEndX := i;
|
|
|
+
|
|
|
+ if FSelEndX <> FSelStartX then
|
|
|
+ begin
|
|
|
+ FAfterDoubleClick := True;
|
|
|
+ rct := LineRangeRect(CurY, CurY);
|
|
|
+ SelectionChanged;
|
|
|
+ InvalidateRect(Handle, @rct, true);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ //------------------------------------------------------------
|
|
|
+begin
|
|
|
+
|
|
|
+ if PointInRect(Point(FLastMouseUpX, FLastMouseUpY), EditorRect) then
|
|
|
+ begin
|
|
|
+ clickPos := CellFromPos(FLastMouseUpX, FLastMouseUpY);
|
|
|
+ clickX := clickPos.X + FLeftCol;
|
|
|
+ clickY := clickPos.Y + FTopLine;
|
|
|
+ SelectWord;
|
|
|
+ end;
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// WM_GETDLGCODE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.WMGetDlgCode(var Msg: TWMGetDlgCode);
|
|
|
+begin
|
|
|
+ Msg.Result := DLGC_WANTARROWS or DLGC_WANTTAB;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// WM_ERASEBKGND
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.WMEraseBkgnd(var Msg: TWmEraseBkgnd);
|
|
|
+begin
|
|
|
+ Msg.Result := 1;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// WM_SIZE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.WMSize(var Msg: TWMSize);
|
|
|
+begin
|
|
|
+ if not (csLoading in ComponentState) then
|
|
|
+ try
|
|
|
+ ResizeEditor;
|
|
|
+ except
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// WM_SETCURSOR
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.WMSetCursor(var Msg: TWMSetCursor);
|
|
|
+var
|
|
|
+ P: TPoint;
|
|
|
+begin
|
|
|
+ Msg.Result := 1;
|
|
|
+ GetCursorPos(P);
|
|
|
+ P := ScreenToClient(P);
|
|
|
+ if PointInRect(P, EditorRect) then
|
|
|
+ Winapi.Windows.SetCursor(Screen.Cursors[crIBeam])
|
|
|
+ else
|
|
|
+ Winapi.Windows.SetCursor(Screen.Cursors[crArrow]);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// WM_SETFOCUS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.WMSetFocus(var Msg: TWMSetFocus);
|
|
|
+begin
|
|
|
+ if FCellSize.H = 0 then
|
|
|
+ SetFont(FFont);
|
|
|
+ CreateCaret(Handle, HBITMAP(0), 2, FCellSize.H - 2);
|
|
|
+ ShowCaret(true);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// WM_KILLFOCUS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.WMKillFocus(var Msg: TWMSetFocus);
|
|
|
+begin
|
|
|
+ DestroyCaret;
|
|
|
+ FCaretVisible := False;
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SHOW CARET
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.ShowCaret(State: Boolean);
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+begin
|
|
|
+ FCaretVisible := False;
|
|
|
+ if not State then
|
|
|
+ HideCaret(Handle)
|
|
|
+ else if Focused and not HiddenCaret then
|
|
|
+ begin
|
|
|
+ rct := CellRect(CurX - FLeftCol, CurY - FTopLine);
|
|
|
+ SetCaretPos(rct.Left, rct.Top + 1);
|
|
|
+ Winapi.Windows.ShowCaret(Handle);
|
|
|
+ FCaretVisible := True;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// CELL RECT
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.CellRect(ACol, ARow: integer): TRect;
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+begin
|
|
|
+ rct := EditorRect;
|
|
|
+ with FCellSize do
|
|
|
+ Result := Rect(rct.Left + W * ACol, rct.Top + H * ARow,
|
|
|
+ rct.Left + W * (ACol + 1), rct.Top + H * (ARow + 1));
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// LINE RECT
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.LineRect(ARow: integer): TRect;
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+begin
|
|
|
+ rct := EditorRect;
|
|
|
+ ARow := ARow - FTopLine;
|
|
|
+ with FCellSize do
|
|
|
+ Result := Rect(rct.Left, rct.Top + H * ARow, rct.Right, rct.Top + H * (ARow
|
|
|
+ + 1));
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// COL RECT
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.ColRect(ACol: integer): TRect;
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+begin
|
|
|
+ rct := EditorRect;
|
|
|
+ ACol := ACol - FLeftCol;
|
|
|
+ with FCellSize do
|
|
|
+ Result := Rect(rct.Left + W * ACol, rct.Top, rct.Left + W * (ACol + 1),
|
|
|
+ rct.Bottom);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// LINE RANGE RECT
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.LineRangeRect(FromLine, ToLine: integer): TRect;
|
|
|
+var
|
|
|
+ rct1, rct2: TRect;
|
|
|
+begin
|
|
|
+ rct1 := LineRect(FromLine);
|
|
|
+ rct2 := LineRect(ToLine);
|
|
|
+ Result := TotalRect(rct1, rct2);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// INVALIDATE LINE RANGE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.InvalidateLineRange(FromLine, ToLine: integer);
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+begin
|
|
|
+ if ToLine < FromLine then
|
|
|
+ ToLine := Lines.Count - 1;
|
|
|
+ rct := LineRangeRect(FromLine, ToLine);
|
|
|
+ if GutterWidth > 2 then
|
|
|
+ rct.Left := FGutter.Left;
|
|
|
+ InvalidateRect(Handle, @rct, True);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// COL RANGE RECT
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.ColRangeRect(FromCol, ToCol: integer): TRect;
|
|
|
+var
|
|
|
+ rct1, rct2: TRect;
|
|
|
+begin
|
|
|
+ rct1 := ColRect(FromCol);
|
|
|
+ rct2 := ColRect(ToCol);
|
|
|
+ Result := TotalRect(rct1, rct2);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// CELL and CHAR FROM POS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.CellFromPos(X, Y: integer): TCellPos;
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+begin
|
|
|
+ rct := EditorRect;
|
|
|
+ if (FCellSize.H = 0) and Assigned(FFont) then
|
|
|
+ SetFont(FFont);
|
|
|
+ if (FCellSize.W <> 0) and (FCellSize.H <> 0) then
|
|
|
+ begin
|
|
|
+ Result.X := (X - rct.Left) div FCellSize.W;
|
|
|
+ Result.Y := (Y - rct.Top) div FCellSize.H;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ Result.X := 0;
|
|
|
+ Result.Y := 0;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TGLSCustomMemo.CharFromPos(X, Y: integer): TFullPos;
|
|
|
+var
|
|
|
+ rct: TRect;
|
|
|
+begin
|
|
|
+ rct := EditorRect;
|
|
|
+ if (FCellSize.H = 0) and Assigned(FFont) then
|
|
|
+ SetFont(FFont);
|
|
|
+ if (FCellSize.W <> 0) and (FCellSize.H <> 0) then
|
|
|
+ begin
|
|
|
+ Result.Pos := (X - rct.Left) div FCellSize.W + FLeftCol;
|
|
|
+ Result.LineNo := (Y - rct.Top) div FCellSize.H + FTopLine;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ Result.Pos := 1;
|
|
|
+ Result.LineNo := 1;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SET COLOR
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetColor(Index: integer; Value: TColor);
|
|
|
+var
|
|
|
+ eRect: TRect;
|
|
|
+ Changed: Boolean;
|
|
|
+begin
|
|
|
+ Changed := False;
|
|
|
+ case Index of
|
|
|
+ 0: if FBkColor <> Value then
|
|
|
+ begin
|
|
|
+ FBkColor := Value;
|
|
|
+ FStyles.BkColor[0] := Value;
|
|
|
+ Changed := True;
|
|
|
+ end;
|
|
|
+ 1: if FSelColor <> Value then
|
|
|
+ begin
|
|
|
+ FSelColor := Value;
|
|
|
+ Changed := True;
|
|
|
+ end;
|
|
|
+ 2: if FSelBkColor <> Value then
|
|
|
+ begin
|
|
|
+ FSelBkColor := Value;
|
|
|
+ Changed := True;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if Changed then
|
|
|
+ begin
|
|
|
+ eRect := EditorRect;
|
|
|
+ InvalidateRect(Handle, @eRect, True);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SET FONT
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetFont(Value: TFont);
|
|
|
+var
|
|
|
+ wW, wi: integer;
|
|
|
+ OldFontName: string;
|
|
|
+ eRect: TRect;
|
|
|
+begin
|
|
|
+ OldFontName := Canvas.Font.Name;
|
|
|
+ Canvas.Font.Name := Value.Name;
|
|
|
+ wW := Canvas.TextWidth('W');
|
|
|
+ wi := Canvas.TextWidth('i');
|
|
|
+ Canvas.Font.Name := OldFontName;
|
|
|
+
|
|
|
+ if wW <> wi then
|
|
|
+ raise EAbort.Create('Monospace font required');
|
|
|
+
|
|
|
+ FFont.Assign(Value);
|
|
|
+ Canvas.Font.Assign(Value);
|
|
|
+ FCellSize.W := Canvas.TextWidth('W');
|
|
|
+ FCellSize.H := Canvas.TextHeight('W') + 1;
|
|
|
+
|
|
|
+ if FCaretVisible then
|
|
|
+ begin
|
|
|
+ ShowCaret(False);
|
|
|
+ DestroyCaret;
|
|
|
+ CreateCaret(Handle, HBITMAP(0), 2, FCellSize.H - 2);
|
|
|
+ ShowCaret(true);
|
|
|
+ end;
|
|
|
+
|
|
|
+ FStyles.TextColor[0] := FFont.Color;
|
|
|
+ FStyles.Style[0] := FFont.Style;
|
|
|
+
|
|
|
+ eRect := EditorRect;
|
|
|
+ InvalidateRect(Handle, @eRect, True);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SET GUTTER WIDTH
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetGutterWidth(Value: integer);
|
|
|
+begin
|
|
|
+ FGutterWidth := Value;
|
|
|
+ FGutter.FWidth := Value;
|
|
|
+ if not (csLoading in ComponentState) then
|
|
|
+ ResizeEditor;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SET GUTTER COLOR
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetGutterColor(Value: TColor);
|
|
|
+begin
|
|
|
+ if FGutter.FColor <> Value then
|
|
|
+ begin
|
|
|
+ FGutter.FColor := Value;
|
|
|
+ FGutter.Invalidate;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// GET GUTTER COLOR
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.GetGutterColor: TColor;
|
|
|
+begin
|
|
|
+ Result := FGutter.FColor;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// CHAR STYLE NO
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.CharStyleNo(LineNo, Pos: integer): integer;
|
|
|
+var
|
|
|
+ ChStyle: string;
|
|
|
+begin
|
|
|
+ Result := 0;
|
|
|
+ if (LineNo < 0) or (LineNo >= Lines.Count) then
|
|
|
+ Exit;
|
|
|
+
|
|
|
+ ChStyle := CharAttrs[LineNo];
|
|
|
+ if (Pos <= 0) or (Pos > Length(ChStyle)) then
|
|
|
+ Exit;
|
|
|
+
|
|
|
+ Result := integer(ChStyle[Pos]);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// DRAW LINE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.DrawLine(LineNo: integer);
|
|
|
+var
|
|
|
+ eRect, rct0, rct1, rct, lineRct: TRect;
|
|
|
+ LineSelStart, LineSelEnd, LineStyleNo, pos: integer;
|
|
|
+ S, S1, S2, S3, ChStyle: string;
|
|
|
+ //--------- FIND LINE SELECTION -------------
|
|
|
+ procedure FindLineSelection;
|
|
|
+ var
|
|
|
+ len: integer;
|
|
|
+ xSelStartX, xSelStartY, xSelEndX, xSelEndY: integer;
|
|
|
+ begin
|
|
|
+ xSelStartX := FSelStartX;
|
|
|
+ xSelStartY := FSelStartY;
|
|
|
+ xSelEndX := FSelEndX;
|
|
|
+ xSelEndY := FSelEndY;
|
|
|
+ OrderPos(xSelStartX, xSelStartY, xSelEndX, xSelEndY);
|
|
|
+ len := Length(Lines[LineNo]);
|
|
|
+ LineSelStart := 0;
|
|
|
+ LineSelEnd := 0;
|
|
|
+ if xSelStartY = Lineno then
|
|
|
+ begin
|
|
|
+ LineSelStart := xSelStartX - FLeftCol;
|
|
|
+ LineSelEnd := len - FLeftCol;
|
|
|
+ end
|
|
|
+ else if (xSelStartY < LineNo) and (LineNo < xSelEndY) then
|
|
|
+ begin
|
|
|
+ LineSelStart := 0;
|
|
|
+ LineSelEnd := len - FLeftCol;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if xSelEndY = LineNo then
|
|
|
+ LineSelEnd := xSelEndX - FLeftCol;
|
|
|
+
|
|
|
+ if LineSelEnd < LineSelStart then
|
|
|
+ Swap(LineSelEnd, LineSelStart);
|
|
|
+
|
|
|
+ if LineSelStart < 0 then
|
|
|
+ LineSelStart := 0;
|
|
|
+ S := Copy(Lines[LineNo], FLeftCol + 1, len);
|
|
|
+ S1 := Copy(S, 1, LineSelStart);
|
|
|
+ S2 := Copy(S, LineSelStart + 1, LineSelEnd - LineSelStart);
|
|
|
+ S3 := Copy(S, LineSelEnd + 1, len);
|
|
|
+ end;
|
|
|
+ //------------- DRAW PART ---------------------
|
|
|
+ procedure DrawPart(const Part: string; PartStyle, StartPos: integer;
|
|
|
+ var rct: TRect; IsSelection: Boolean);
|
|
|
+ var
|
|
|
+ len, w: integer;
|
|
|
+ rctInternal: TRect;
|
|
|
+ begin
|
|
|
+ len := Length(Part);
|
|
|
+ if len > 0 then
|
|
|
+ with FLineBitmap.Canvas do
|
|
|
+ begin
|
|
|
+ w := FCellSize.W * len;
|
|
|
+ Font.Style := FStyles.Style[PartStyle];
|
|
|
+ if IsSelection then
|
|
|
+ begin
|
|
|
+ Font.Color := SelColor;
|
|
|
+ Brush.Color := SelBkColor;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ if LineStyleNo = 0 then
|
|
|
+ begin
|
|
|
+ Font.Color := FStyles.TextColor[PartStyle];
|
|
|
+ Brush.Color := FStyles.BkColor[PartStyle];
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ if (LineNo = FSelCharPos.LineNo) and
|
|
|
+ (StartPos = FSelCharPos.Pos + 1) and (Length(Part) = 1) then
|
|
|
+ begin
|
|
|
+ Font.Color := FStyles.TextColor[PartStyle];
|
|
|
+ Brush.Color := FStyles.BkColor[PartStyle];
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ Font.Color := FStyles.TextColor[LineStyleNo];
|
|
|
+ Brush.Color := FStyles.BkColor[LineStyleNo];
|
|
|
+ Font.Style := FStyles.Style[LineStyleNo];
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ rct.Right := rct.Left + w;
|
|
|
+ rctInternal := rct;
|
|
|
+ rctInternal.Left := rctInternal.Left - eRect.Left;
|
|
|
+ rctInternal.Right := rctInternal.Right - eRect.Left;
|
|
|
+ rctInternal.Top := rctInternal.Top - rct.Top;
|
|
|
+ rctInternal.Bottom := rctInternal.Bottom - rct.Top;
|
|
|
+ FillRect(rctInternal);
|
|
|
+ DrawText(Handle, PChar(Part), len, rctInternal, DT_LEFT
|
|
|
+ or DT_SINGLELINE or DT_NOPREFIX);
|
|
|
+ rct0.Left := rct.Left + w;
|
|
|
+ rct := rct0;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ //------------- DRAW SEGMENTS ---------------------
|
|
|
+ procedure DrawSegments(S: string; WorkPos: integer;
|
|
|
+ var rct: TRect; IsSelection: Boolean);
|
|
|
+ var
|
|
|
+ i, len, ThisStyle: integer;
|
|
|
+ begin
|
|
|
+ while True do
|
|
|
+ begin
|
|
|
+ Len := Length(S);
|
|
|
+ if Len = 0 then
|
|
|
+ Exit;
|
|
|
+ ThisStyle := Ord(ChStyle[WorkPos]);
|
|
|
+ i := 1;
|
|
|
+ while (i <= Len) and
|
|
|
+ (ThisStyle = Ord(ChStyle[WorkPos + i - 1])) do
|
|
|
+ Inc(i);
|
|
|
+ DrawPart(Copy(S, 1, i - 1), ThisStyle, WorkPos, rct, IsSelection);
|
|
|
+ Inc(WorkPos, i - 1);
|
|
|
+ s := Copy(s, i, Len);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ //---------------------------------------------
|
|
|
+begin
|
|
|
+ eRect := EditorRect;
|
|
|
+ rct := CellRect(0, LineNo - FTopLine);
|
|
|
+ rct0 := Rect(eRect.Left, rct.Top, eRect.Right, rct.Bottom);
|
|
|
+ lineRct := rct0;
|
|
|
+
|
|
|
+ if LineNo < Lines.Count then
|
|
|
+ begin
|
|
|
+
|
|
|
+ rct := rct0;
|
|
|
+ S := Lines[LineNo];
|
|
|
+ LineStyleNo := LineStyle[LineNo];
|
|
|
+ ChStyle := CharAttrs[LineNo];
|
|
|
+ FindLineSelection;
|
|
|
+
|
|
|
+ if not Assigned(FOnGetLineAttrs) then
|
|
|
+ ChStyle := StringOfChar(#0, Length(Lines[LineNo]));
|
|
|
+
|
|
|
+ if Length(S) > 0 then
|
|
|
+ if (FSelCharStyle >= 0) and (LineNo = FSelCharPos.LineNo) then
|
|
|
+ ChStyle[FSelCharPos.Pos + 1] := Char(FSelCharStyle);
|
|
|
+
|
|
|
+ pos := FLeftCol + 1; // 1
|
|
|
+ DrawSegments(S1, pos, rct, False);
|
|
|
+ Inc(pos, Length(S1));
|
|
|
+ DrawSegments(S2, pos, rct, True);
|
|
|
+ Inc(pos, Length(S2));
|
|
|
+ DrawSegments(S3, pos, rct, False);
|
|
|
+
|
|
|
+ // else begin
|
|
|
+ // DrawPart(S1,StyleNo,rct,False);
|
|
|
+ // DrawPart(S2,StyleNo,rct,True);
|
|
|
+ // DrawPart(S3,StyleNo,rct,False);
|
|
|
+ // end;
|
|
|
+
|
|
|
+ rct1 := rct;
|
|
|
+ rct1.Left := rct1.Left - eRect.Left;
|
|
|
+ rct1.Right := rct1.Right - eRect.Left;
|
|
|
+ rct1.Top := rct1.Top - rct.Top;
|
|
|
+ rct1.Bottom := rct1.Bottom - rct.Top;
|
|
|
+ with FLineBitmap.Canvas do
|
|
|
+ begin
|
|
|
+ Brush.Color := FStyles.BkColor[LineStyleNo];
|
|
|
+ FillRect(rct1);
|
|
|
+ end;
|
|
|
+
|
|
|
+ with LineRct do
|
|
|
+ BitBlt(Canvas.Handle, Left, Top, Right - Left, Bottom - Top,
|
|
|
+ FLineBitmap.Canvas.Handle, 0, 0, SRCCOPY);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ with Canvas do
|
|
|
+ begin
|
|
|
+ Brush.Color := BkColor;
|
|
|
+ FillRect(rct0);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SET HIDDEN CARET
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetHiddenCaret(Value: Boolean);
|
|
|
+begin
|
|
|
+ if Value <> FHiddenCaret then
|
|
|
+ begin
|
|
|
+ FHiddenCaret := Value;
|
|
|
+ if Focused then
|
|
|
+ if FHiddenCaret = FCaretVisible then
|
|
|
+ ShowCaret(not FHiddenCaret);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// BORDER
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure Border(Canvas: TCanvas; const rct: TRect; BorderType: TBorderType);
|
|
|
+const
|
|
|
+ Colors: array[TBorderType] of array[1..4] of TColor
|
|
|
+ = (($D0D0D0, clWhite, clGray, clBlack),
|
|
|
+ (clGray, clBlack, $D0D0D0, clWhite),
|
|
|
+ (clWhite, clWhite, clWhite, clGray),
|
|
|
+ (clGray, clWhite, clWhite, clGray));
|
|
|
+begin
|
|
|
+ with Canvas do
|
|
|
+ begin
|
|
|
+ Pen.Color := Colors[BorderType][1];
|
|
|
+ MoveTo(rct.Left, rct.Bottom - 1);
|
|
|
+ LineTo(rct.Left, rct.Top);
|
|
|
+ LineTo(rct.Right, rct.Top);
|
|
|
+ if BorderType in [btRaised, btLowered] then
|
|
|
+ begin
|
|
|
+ Pen.Color := Colors[BorderType][2];
|
|
|
+ MoveTo(rct.Left + 1, rct.Bottom);
|
|
|
+ LineTo(rct.Left + 1, rct.Top + 1);
|
|
|
+ LineTo(rct.Right, rct.Top + 1);
|
|
|
+ Pen.Color := Colors[BorderType][3];
|
|
|
+ MoveTo(rct.Left + 1, rct.Bottom - 2);
|
|
|
+ LineTo(rct.Right - 2, rct.Bottom - 2);
|
|
|
+ LineTo(rct.Right - 2, rct.Top + 1);
|
|
|
+ end;
|
|
|
+ Pen.Color := Colors[BorderType][4];
|
|
|
+ MoveTo(rct.Left, rct.Bottom - 1);
|
|
|
+ LineTo(rct.Right - 1, rct.Bottom - 1);
|
|
|
+ LineTo(rct.Right - 1, rct.Top);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// EDITOR RECT
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.EditorRect: TRect;
|
|
|
+var
|
|
|
+ l, t, r, b: integer;
|
|
|
+begin
|
|
|
+ l := 2;
|
|
|
+ r := Width - 2;
|
|
|
+ t := 2;
|
|
|
+ b := Height - 2;
|
|
|
+ if GutterWidth > 2 then
|
|
|
+ l := l + GutterWidth;
|
|
|
+ if FScrollBars in [ssBoth, ssVertical] then
|
|
|
+ r := r - FScrollBarWidth;
|
|
|
+ if FScrollBars in [ssBoth, ssHorizontal] then
|
|
|
+ b := b - FScrollBarWidth;
|
|
|
+ Result := Rect(l + FMargin, t, r, b);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// DRAW MARGIN
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.DrawMargin;
|
|
|
+var
|
|
|
+ eRect: TRect;
|
|
|
+ i: integer;
|
|
|
+begin
|
|
|
+ eRect := EditorRect;
|
|
|
+ with Canvas do
|
|
|
+ begin
|
|
|
+ Pen.Color := clWhite;
|
|
|
+ for i := 1 to FMargin do
|
|
|
+ begin
|
|
|
+ MoveTo(eRect.Left - i, eRect.Top);
|
|
|
+ LineTo(eRect.Left - i, eRect.Bottom + 1);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// DRAW GUTTER
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.DrawGutter;
|
|
|
+begin
|
|
|
+ if GutterWidth < 2 then
|
|
|
+ Exit;
|
|
|
+ ResizeGutter;
|
|
|
+ FGutter.PaintTo(Canvas);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// DRAW SCROLLBARS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.DrawScrollBars;
|
|
|
+begin
|
|
|
+ ResizeScrollBars;
|
|
|
+ if FScrollBars in [ssBoth, ssVertical] then
|
|
|
+ sbVert.PaintTo(Canvas);
|
|
|
+ if FScrollBars in [ssBoth, ssHorizontal] then
|
|
|
+ sbHorz.PaintTo(Canvas);
|
|
|
+ if FScrollBars = ssBoth then
|
|
|
+ with Canvas do
|
|
|
+ begin
|
|
|
+ Brush.Color := clSilver;
|
|
|
+ FillRect(Rect(sbVert.Left, sbHorz.Top + 1,
|
|
|
+ sbVert.Left + sbVert.Width, sbHorz.Top + sbHorz.Height));
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// FRESH LINE BITMAP
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.FreshLineBitmap;
|
|
|
+var
|
|
|
+ eRect: TRect;
|
|
|
+begin
|
|
|
+ eRect := EditorRect;
|
|
|
+ with FLineBitmap do
|
|
|
+ begin
|
|
|
+ Width := eRect.Right - eRect.Left;
|
|
|
+ Height := FCellSize.H;
|
|
|
+ FLineBitmap.Canvas.Font.Assign(Self.Canvas.Font);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// PAINT
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.Paint;
|
|
|
+var
|
|
|
+ pTop, pBottom: TFullPos;
|
|
|
+ rct, eRect: TRect;
|
|
|
+ i: integer;
|
|
|
+ clipRgn: HRGN;
|
|
|
+ Attrs: string;
|
|
|
+begin
|
|
|
+ if TGLSMemoStrings(Lines).FLockCount > 0 then
|
|
|
+ Exit;
|
|
|
+ with Canvas do
|
|
|
+ begin
|
|
|
+ if FCellSize.H = 0 then
|
|
|
+ SetFont(FFont);
|
|
|
+ FreshLineBitmap;
|
|
|
+
|
|
|
+ Border(Canvas, Rect(0, 0, Width, Height), btLowered);
|
|
|
+ DrawMargin;
|
|
|
+ DrawGutter;
|
|
|
+ DrawScrollBars;
|
|
|
+
|
|
|
+ eRect := EditorRect;
|
|
|
+ clipRgn := CreateRectRgn(eRect.Left, eRect.Top, eRect.Right, eRect.Bottom);
|
|
|
+ ExtSelectClipRgn(Canvas.Handle, clipRgn, RGN_AND);
|
|
|
+ DeleteObject(clipRgn);
|
|
|
+
|
|
|
+ rct := Canvas.ClipRect;
|
|
|
+ pTop := CharFromPos(rct.Left, rct.Top);
|
|
|
+ pBottom := CharFromPos(rct.Left, rct.Bottom);
|
|
|
+
|
|
|
+ if Assigned(FOnGetLineAttrs) then
|
|
|
+ for i := 0 to Lines.Count - 1 do
|
|
|
+ if not ValidAttrs[i] then
|
|
|
+ begin
|
|
|
+ FOnGetLineAttrs(Self, i, Attrs);
|
|
|
+ CharAttrs[i] := Attrs;
|
|
|
+ ValidAttrs[i] := True;
|
|
|
+ end;
|
|
|
+
|
|
|
+ for i := pTop.LineNo to pBottom.LineNo do
|
|
|
+ DrawLine(i);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// GET VISIBLE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.GetVisible(Index: integer): integer;
|
|
|
+var
|
|
|
+ Coord: TFullPos;
|
|
|
+ Cell: TCellPos;
|
|
|
+ eRect: TRect;
|
|
|
+begin
|
|
|
+ eRect := EditorRect;
|
|
|
+ Coord := CharFromPos(eRect.Right - 1, eRect.Bottom - 1);
|
|
|
+ Cell := CellFromPos(eRect.Right - 1, eRect.Bottom - 1);
|
|
|
+ case Index of
|
|
|
+ 0: Result := Cell.X;
|
|
|
+ 1: Result := Cell.Y;
|
|
|
+ 2: Result := Coord.Pos - 1;
|
|
|
+ 3: Result := Coord.LineNo - 1;
|
|
|
+ else
|
|
|
+ Result := 0;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// IS LINE VISIBLE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.IsLineVisible(LineNo: integer): Boolean;
|
|
|
+begin
|
|
|
+ if FCellSize.H = 0 then
|
|
|
+ SetFont(FFont);
|
|
|
+ Result := (FTopLine <= LineNo) and (LineNo <= LastVisibleLine + 1);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// MAKE VISIBLE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.MakeVisible;
|
|
|
+var
|
|
|
+ Modified: Boolean;
|
|
|
+begin
|
|
|
+ Modified := False;
|
|
|
+ if CurX < FLeftCol then
|
|
|
+ begin
|
|
|
+ FLeftCol := CurX - 2;
|
|
|
+ if FLeftCol < 0 then
|
|
|
+ FLeftCol := 0;
|
|
|
+ Modified := True;
|
|
|
+ end;
|
|
|
+ if CurX > LastVisiblePos then
|
|
|
+ begin
|
|
|
+ if (FScrollBars in [ssBoth, ssHorizontal]) or
|
|
|
+ (ScrollMode = smAuto) then
|
|
|
+ begin
|
|
|
+ FLeftCol := FLeftCol + CurX - LastVisiblePos + 2;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ CurX := LastVisiblePos;
|
|
|
+ Modified := True;
|
|
|
+ end;
|
|
|
+ if CurY < FTopLine then
|
|
|
+ begin
|
|
|
+ FTopLine := CurY;
|
|
|
+ if FTopLine < 0 then
|
|
|
+ FTopLine := 0;
|
|
|
+ Modified := True;
|
|
|
+ end;
|
|
|
+ if CurY > LastVisibleLine then
|
|
|
+ begin
|
|
|
+ if (FScrollBars in [ssBoth, ssVertical]) or
|
|
|
+ (ScrollMode = smAuto) then
|
|
|
+ begin
|
|
|
+ FTopLine := FTopLine + CurY - LastVisibleLine;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ CurY := LastVisibleLine;
|
|
|
+ Modified := True;
|
|
|
+ end;
|
|
|
+ if Modified then
|
|
|
+ Invalidate;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// RESIZE EDITOR
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.ResizeEditor;
|
|
|
+begin
|
|
|
+ ResizeScrollBars;
|
|
|
+ ResizeGutter;
|
|
|
+ MakeVisible;
|
|
|
+ Invalidate;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// FIND TEXT
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.FindText(Text: string; Options: TFindOptions; Select:
|
|
|
+ Boolean): Boolean;
|
|
|
+var
|
|
|
+ i, p: integer;
|
|
|
+ s1, s0, s: string;
|
|
|
+ //-----------------------------------------------------------
|
|
|
+ function LastPos(const Substr, s: string): integer;
|
|
|
+ var
|
|
|
+ i, j, lenSub: integer;
|
|
|
+ begin
|
|
|
+ Result := 0;
|
|
|
+ lenSub := Length(Substr);
|
|
|
+ i := Length(s) - lenSub + 1;
|
|
|
+ while i > 0 do
|
|
|
+ begin
|
|
|
+ if s[i] = Substr[1] then
|
|
|
+ begin
|
|
|
+ Result := i;
|
|
|
+ for j := i + 1 to i + lenSub - 1 do
|
|
|
+ if s[j] <> Substr[j - i + 1] then
|
|
|
+ begin
|
|
|
+ Result := 0;
|
|
|
+ break;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if Result <> 0 then
|
|
|
+ break;
|
|
|
+ Dec(i);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ //-----------------------------------------------------------
|
|
|
+begin
|
|
|
+ Result := False;
|
|
|
+ if not (frMatchCase in Options) then
|
|
|
+ Text := AnsiLowerCase(Text);
|
|
|
+
|
|
|
+ if SelLength > 0 then
|
|
|
+ ClearSelection;
|
|
|
+ s := Lines[CurY];
|
|
|
+ s0 := Copy(s, 1, CurX);
|
|
|
+ s1 := Copy(s, CurX + 1, Length(s));
|
|
|
+ i := CurY;
|
|
|
+
|
|
|
+ while True do
|
|
|
+ begin
|
|
|
+
|
|
|
+ if not (frMatchCase in Options) then
|
|
|
+ begin
|
|
|
+ s0 := AnsiLowerCase(s0);
|
|
|
+ s1 := AnsiLowerCase(s1);
|
|
|
+ end;
|
|
|
+
|
|
|
+ if frDown in Options then
|
|
|
+ p := Pos(Text, s1)
|
|
|
+ else
|
|
|
+ p := LastPos(Text, s0);
|
|
|
+
|
|
|
+ if p > 0 then
|
|
|
+ begin
|
|
|
+ Result := True;
|
|
|
+ CurY := i;
|
|
|
+ if frDown in Options then
|
|
|
+ CurX := Length(s0) + p - 1
|
|
|
+ else
|
|
|
+ CurX := p - 1;
|
|
|
+ if Select then
|
|
|
+ begin
|
|
|
+ if not (frDown in Options) then
|
|
|
+ CurX := CurX + Length(Text);
|
|
|
+ ClearSelection;
|
|
|
+ if frDown in Options then
|
|
|
+ CurX := CurX + Length(Text)
|
|
|
+ else
|
|
|
+ CurX := CurX - Length(Text);
|
|
|
+ ExpandSelection;
|
|
|
+ end;
|
|
|
+ break;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if frDown in Options then
|
|
|
+ Inc(i)
|
|
|
+ else
|
|
|
+ Dec(i);
|
|
|
+ if (i < 0) or (i > Lines.Count - 1) then
|
|
|
+ break;
|
|
|
+ if frDown in Options then
|
|
|
+ begin
|
|
|
+ s0 := '';
|
|
|
+ s1 := Lines[i];
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ s0 := Lines[i];
|
|
|
+ s1 := '';
|
|
|
+ end;
|
|
|
+
|
|
|
+ end;
|
|
|
+
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// RESIZE SCROLLBARS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.ResizeScrollBars;
|
|
|
+var
|
|
|
+ eRect, sbRect: TRect;
|
|
|
+ MaxLen, OldMax, NewTop, Margin: integer;
|
|
|
+begin
|
|
|
+ eRect := EditorRect;
|
|
|
+ if FScrollBars in [ssBoth, ssVertical] then
|
|
|
+ begin
|
|
|
+ with sbVert do
|
|
|
+ begin
|
|
|
+ Width := 16;
|
|
|
+ Height := eRect.Bottom - eRect.Top + 1;
|
|
|
+ Left := eRect.Right;
|
|
|
+ Top := eRect.Top;
|
|
|
+ OldMax := MaxPosition;
|
|
|
+ MaxPosition := (Lines.Count - 1) - (LastVisibleLine - FTopLine);
|
|
|
+ NewTop := FTopLine;
|
|
|
+ if (FTopLine > 0) and (LastVisibleLine > Lines.Count - 1) then
|
|
|
+ begin
|
|
|
+ Dec(NewTop, LastVisibleLine - (Lines.Count - 1));
|
|
|
+ if NewTop < 0 then
|
|
|
+ NewTop := 0;
|
|
|
+ MaxPosition := NewTop;
|
|
|
+ end;
|
|
|
+ if MaxPosition < 0 then
|
|
|
+ MaxPosition := 0;
|
|
|
+ Position := NewTop;
|
|
|
+ Total := Lines.Count;
|
|
|
+ if OldMax <> MaxPosition then
|
|
|
+ begin
|
|
|
+ if NewTop <> FTopLine then
|
|
|
+ begin
|
|
|
+ DoScroll(sbVert, NewTop - FTopLine);
|
|
|
+ FGutter.Invalidate;
|
|
|
+ end;
|
|
|
+ sbRect := sbVert.FullRect;
|
|
|
+ InvalidateRect(Handle, @sbRect, True);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if FScrollBars in [ssBoth, ssHorizontal] then
|
|
|
+ begin
|
|
|
+ MaxLen := MaxLength;
|
|
|
+ with sbHorz do
|
|
|
+ begin
|
|
|
+ Width := Self.Width - 4;
|
|
|
+ if FScrollBars = ssBoth then
|
|
|
+ Width := Width - sbVert.Width;
|
|
|
+ Height := 16;
|
|
|
+ Left := 2;
|
|
|
+ Top := eRect.Bottom;
|
|
|
+ OldMax := MaxPosition;
|
|
|
+
|
|
|
+ Margin := LastVisiblePos - MaxLen;
|
|
|
+ if Margin < 2 then
|
|
|
+ Margin := 2;
|
|
|
+ MaxPosition := MaxLen - (LastVisiblePos - FLeftCol) + Margin;
|
|
|
+
|
|
|
+ if MaxPosition < 0 then
|
|
|
+ MaxPosition := 0;
|
|
|
+ Position := FLeftCol;
|
|
|
+ Total := MaxLen;
|
|
|
+ if OldMax <> MaxPosition then
|
|
|
+ begin
|
|
|
+ if MaxPosition = 0 then
|
|
|
+ begin
|
|
|
+ FLeftCol := 0;
|
|
|
+ InvalidateRect(Handle, @eRect, True);
|
|
|
+ ;
|
|
|
+ FGutter.Invalidate;
|
|
|
+ end;
|
|
|
+ sbRect := sbHorz.FullRect;
|
|
|
+ InvalidateRect(Handle, @sbRect, True);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// RESIZE GUTTER
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.ResizeGutter;
|
|
|
+var
|
|
|
+ eRect: TRect;
|
|
|
+begin
|
|
|
+ eRect := EditorRect;
|
|
|
+ with FGutter do
|
|
|
+ begin
|
|
|
+ Height := eRect.Bottom - eRect.Top;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// CREATE PARAMS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.CreateParams(var Params: TCreateParams);
|
|
|
+begin
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// UNDO, REDO
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.Undo;
|
|
|
+begin
|
|
|
+ FUndoList.Undo;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.Redo;
|
|
|
+begin
|
|
|
+ FUndoList.Redo;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SET UNDO LIMIT
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetUndoLimit(Value: integer);
|
|
|
+begin
|
|
|
+ if (FUndoLimit <> Value) then
|
|
|
+ begin
|
|
|
+ if Value <= 0 then
|
|
|
+ Value := 1;
|
|
|
+ if Value > 100 then
|
|
|
+ Value := 100;
|
|
|
+ FUndoLimit := Value;
|
|
|
+ FUndoList.Limit := Value;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// UNDO (REDO) CHANGE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.UndoChange;
|
|
|
+begin
|
|
|
+ if Assigned(FOnUndoChange) then
|
|
|
+ FOnUndoChange(Self, FUndoList.Pos < FUndoList.Count,
|
|
|
+ FUndoList.Pos > 0);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// CAN UNDO
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.CanUndo: boolean;
|
|
|
+begin
|
|
|
+ Result := FUndoList.FPos < FUndoList.Count;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// CAN REDO
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSCustomMemo.CanRedo: Boolean;
|
|
|
+begin
|
|
|
+ Result := FUndoList.FPos > 0;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// CLEAR UNDO LIST
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.ClearUndoList;
|
|
|
+begin
|
|
|
+ if Assigned(FUndoList) then
|
|
|
+ FUndoList.Clear;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SET SCROLL BARS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSCustomMemo.SetScrollBars(Value: System.UITypes.TScrollStyle);
|
|
|
+begin
|
|
|
+ if FScrollBars <> Value then
|
|
|
+ begin
|
|
|
+ FScrollBars := Value;
|
|
|
+ if not (csLoading in ComponentState) then
|
|
|
+ ResizeEditor;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// CREATE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+constructor TGLSCustomMemo.Create(AOwner: TComponent);
|
|
|
+begin
|
|
|
+ inherited;
|
|
|
+
|
|
|
+ ControlStyle := [csCaptureMouse, csClickEvents,
|
|
|
+ csDoubleClicks, csReplicatable];
|
|
|
+ Width := 100;
|
|
|
+ Height := 40;
|
|
|
+ TabStop := True;
|
|
|
+ Cursor := crIBeam;
|
|
|
+
|
|
|
+ FFont := TFont.Create;
|
|
|
+ FFont.Name := 'Courier New';
|
|
|
+ FFont.Size := 10;
|
|
|
+ Canvas.Font.Assign(FFont);
|
|
|
+
|
|
|
+ FHiddenCaret := False;
|
|
|
+ FCaretVisible := False;
|
|
|
+
|
|
|
+ FCurX := 0;
|
|
|
+ FCurY := 0;
|
|
|
+ FLeftCol := 0;
|
|
|
+ FTopLine := 0;
|
|
|
+ FTabSize := 4;
|
|
|
+ FMargin := 2;
|
|
|
+ FAutoIndent := True;
|
|
|
+ FLines := TGLSMemoStrings.Create;
|
|
|
+ TGLSMemoStrings(FLines).FMemo := Self;
|
|
|
+
|
|
|
+ FScrollBars := ssBoth;
|
|
|
+ FScrollBarWidth := 16;
|
|
|
+ sbVert := TGLSMemoScrollBar.Create(Self, sbVertical);
|
|
|
+ sbVert.Width := FScrollBarWidth;
|
|
|
+ sbHorz := TGLSMemoScrollBar.Create(Self, sbHorizontal);
|
|
|
+ sbHorz.Height := FScrollBarWidth;
|
|
|
+
|
|
|
+ FGutter := TGLSMemoGutter.Create;
|
|
|
+ with FGutter do
|
|
|
+ begin
|
|
|
+ FLeft := 2;
|
|
|
+ FTop := 2;
|
|
|
+ FWidth := 0;
|
|
|
+ FHeight := 0;
|
|
|
+ FColor := clBtnFace;
|
|
|
+ FMemo := Self;
|
|
|
+ end;
|
|
|
+
|
|
|
+ FSelStartX := 0;
|
|
|
+ FSelStartY := 0;
|
|
|
+ FSelEndX := 0;
|
|
|
+ FSelEndY := 0;
|
|
|
+
|
|
|
+ FBkColor := clWhite;
|
|
|
+ FSelColor := clWhite;
|
|
|
+ FSelBkColor := clNavy;
|
|
|
+
|
|
|
+ FStyles := TStyleList.Create;
|
|
|
+ FStyles.Add(clBlack, clWhite, []);
|
|
|
+
|
|
|
+ FSelCharPos.LineNo := -1;
|
|
|
+ FSelCharPos.Pos := -1;
|
|
|
+ FSelCharStyle := -1;
|
|
|
+
|
|
|
+ FLineBitmap := TBitmap.Create;
|
|
|
+
|
|
|
+ FLeftButtonDown := False;
|
|
|
+ FScrollMode := smAuto;
|
|
|
+
|
|
|
+ FUndoList := TGLSMemoUndoList.Create;
|
|
|
+ FFirstUndoList := FUndoList;
|
|
|
+ FUndoList.Memo := Self;
|
|
|
+
|
|
|
+ FUndoLimit := 100;
|
|
|
+
|
|
|
+ TGLSMemoStrings(FLines).DoAdd('');
|
|
|
+
|
|
|
+ FAfterDoubleClick := False;
|
|
|
+
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// DESTROY
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+destructor TGLSCustomMemo.Destroy;
|
|
|
+begin
|
|
|
+ FFont.Free;
|
|
|
+ FLines.Free;
|
|
|
+ FGutter.Free;
|
|
|
+ sbVert.Free;
|
|
|
+ sbHorz.Free;
|
|
|
+ FStyles.Free;
|
|
|
+ FLineBitmap.Free;
|
|
|
+ FFirstUndoList.Free;
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+// ---------------------TGLSMemoScrollBar functions
|
|
|
+
|
|
|
+procedure TGLSMemoScrollBar.SetParams(Index: integer; Value: integer);
|
|
|
+begin
|
|
|
+ case Index of
|
|
|
+ 0: if Left <> Value then
|
|
|
+ FLeft := Value;
|
|
|
+ 1: if Top <> Value then
|
|
|
+ FTop := Value;
|
|
|
+ 2: if Width <> Value then
|
|
|
+ FWidth := Value;
|
|
|
+ 3: if Height <> Value then
|
|
|
+ FHeight := Value;
|
|
|
+ 4: if Total <> Value then
|
|
|
+ FTotal := Value;
|
|
|
+ 5: if MaxPosition <> Value then
|
|
|
+ FMaxPosition := Value;
|
|
|
+ 6: if Position <> Value then
|
|
|
+ FPosition := Value;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+//-------------------- CREATE ------------------------------
|
|
|
+
|
|
|
+constructor TGLSMemoScrollBar.Create(AParent: TGLSMemoAbstractScrollableObject;
|
|
|
+ AKind: TScrollBarKind);
|
|
|
+begin
|
|
|
+ FParent := AParent;
|
|
|
+ FButtonLength := 16;
|
|
|
+ FKind := AKind;
|
|
|
+ FState := sbsWait;
|
|
|
+end;
|
|
|
+//-------------------- RECT -----------------------
|
|
|
+
|
|
|
+function TGLSMemoScrollBar.GetRect: TRect;
|
|
|
+begin
|
|
|
+ Result := Rect(Left, Top, Left + Width, Top + Height);
|
|
|
+end;
|
|
|
+//-------------------- GET THUMB RECT -----------------------
|
|
|
+
|
|
|
+function TGLSMemoScrollBar.GetThumbRect: TRect;
|
|
|
+var
|
|
|
+ TotalLen, FreeLen, ThumbLen, ThumbOffset, ThumbCoord: integer;
|
|
|
+ K: double;
|
|
|
+begin
|
|
|
+ if MaxPosition <= 0 then
|
|
|
+ begin
|
|
|
+ Result := Rect(0, 0, 0, 0);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ if Kind = sbVertical then
|
|
|
+ TotalLen := Height
|
|
|
+ else
|
|
|
+ TotalLen := Width;
|
|
|
+ FreeLen := TotalLen - 2 * FButtonLength;
|
|
|
+
|
|
|
+ K := (Total - MaxPosition) / MaxPosition;
|
|
|
+ if K > 0 then
|
|
|
+ begin
|
|
|
+ ThumbLen := round(FreeLen * K / (1 + K));
|
|
|
+ if ThumbLen < 8 then
|
|
|
+ ThumbLen := 8;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ ThumbLen := 8;
|
|
|
+
|
|
|
+ if ThumbLen >= FreeLen then
|
|
|
+ Result := Rect(0, 0, 0, 0)
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ ThumbOffset := round((FreeLen - ThumbLen) * Position / MaxPosition);
|
|
|
+ ThumbCoord := FButtonLength + ThumbOffset;
|
|
|
+ if Kind = sbVertical then
|
|
|
+ Result := Rect(Left + 1, Top + ThumbCoord, Left + Width, Top + ThumbCoord
|
|
|
+ + ThumbLen)
|
|
|
+ else
|
|
|
+ Result := Rect(Left + ThumbCoord, Top + 1, Left + ThumbCoord + ThumbLen,
|
|
|
+ Top + Height);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+//-------------------- GET Back RECT -----------------------
|
|
|
+
|
|
|
+function TGLSMemoScrollBar.GetBackRect: TRect;
|
|
|
+begin
|
|
|
+ if Kind = sbVertical then
|
|
|
+ Result := Rect(Left + 1, Top, Left + Width, Top + FButtonLength)
|
|
|
+ else
|
|
|
+ Result := Rect(Left, Top + 1, Left + FButtonLength, Top + Height);
|
|
|
+end;
|
|
|
+//-------------------- GET MIDDLE RECT -----------------------
|
|
|
+
|
|
|
+function TGLSMemoScrollBar.GetMiddleRect: TRect;
|
|
|
+var
|
|
|
+ bRect, fRect: TRect;
|
|
|
+begin
|
|
|
+ bRect := BackRect;
|
|
|
+ fRect := ForwardRect;
|
|
|
+ if Kind = sbVertical then
|
|
|
+ Result := Rect(Left + 1, bRect.Bottom, Left + Width, fRect.Top)
|
|
|
+ else
|
|
|
+ Result := Rect(bRect.Right, Top + 1, fRect.Left, Top + Height);
|
|
|
+end;
|
|
|
+//-------------------- GET Forward RECT -----------------------
|
|
|
+
|
|
|
+function TGLSMemoScrollBar.GetForwardRect: TRect;
|
|
|
+begin
|
|
|
+ if Kind = sbVertical then
|
|
|
+ Result := Rect(Left + 1, Top + Height - FButtonLength, Left + Width, Top +
|
|
|
+ Height)
|
|
|
+ else
|
|
|
+ Result := Rect(Left + Width - FButtonLength, Top + 1, Left + Width, Top +
|
|
|
+ Height);
|
|
|
+end;
|
|
|
+//-------------------- GET PAGE BACK RECT -----------------------
|
|
|
+
|
|
|
+function TGLSMemoScrollBar.GetPgBackRect: TRect;
|
|
|
+var
|
|
|
+ thRect: TRect;
|
|
|
+begin
|
|
|
+ thRect := GetThumbRect;
|
|
|
+ if thRect.Bottom = 0 then
|
|
|
+ begin
|
|
|
+ Result := Rect(0, 0, 0, 0);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ if Kind = sbVertical then
|
|
|
+ Result := Rect(Left + 1, Top + FButtonLength, Left + Width, thRect.Top - 1)
|
|
|
+ else
|
|
|
+ Result := Rect(Left + FButtonLength, Top + 1, thRect.Left - 1, Top +
|
|
|
+ Height);
|
|
|
+end;
|
|
|
+//-------------------- GET PG FORWARD RECT -----------------------
|
|
|
+
|
|
|
+function TGLSMemoScrollBar.GetPgForwardRect: TRect;
|
|
|
+var
|
|
|
+ thRect: TRect;
|
|
|
+begin
|
|
|
+ thRect := GetThumbRect;
|
|
|
+ if thRect.Bottom = 0 then
|
|
|
+ begin
|
|
|
+ Result := Rect(0, 0, 0, 0);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ if Kind = sbVertical then
|
|
|
+ Result := Rect(Left + 1, thRect.Bottom, Left + Width, Top + Height -
|
|
|
+ FButtonLength)
|
|
|
+ else
|
|
|
+ Result := Rect(thRect.Right, Top + 1, Left + Width - FButtonLength, Top +
|
|
|
+ Height);
|
|
|
+end;
|
|
|
+//-------------------- PAINT TO -----------------------
|
|
|
+
|
|
|
+procedure TGLSMemoScrollBar.PaintTo(ACanvas: TCanvas);
|
|
|
+var
|
|
|
+ sRect, mRect, gRect, thRect: TRect;
|
|
|
+ iconX, iconY, shift: integer;
|
|
|
+begin
|
|
|
+ with ACanvas do
|
|
|
+ begin
|
|
|
+ if Kind = sbVertical then
|
|
|
+ begin
|
|
|
+ Pen.Color := clSilver;
|
|
|
+ MoveTo(Left, Top);
|
|
|
+ LineTo(Left, Top + Height);
|
|
|
+
|
|
|
+ sRect := BackRect;
|
|
|
+ Brush.Color := clSilver;
|
|
|
+ FillRect(sRect);
|
|
|
+ if State = sbsBack then
|
|
|
+ begin
|
|
|
+ shift := 1;
|
|
|
+ Pen.Color := clGray;
|
|
|
+ with sRect do
|
|
|
+ Rectangle(Left, Top, Right, Bottom);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ shift := 0;
|
|
|
+ Border(ACanvas, sRect, btFlatRaised);
|
|
|
+ end;
|
|
|
+ iconX := sRect.Left + (Width - 1 - 7) div 2;
|
|
|
+ iconY := sRect.Top + (FButtonLength - 8) div 2;
|
|
|
+ Draw(iconX + shift, iconY + shift, bmScrollBarUp);
|
|
|
+
|
|
|
+ gRect := ForwardRect;
|
|
|
+ Brush.Color := clSilver;
|
|
|
+ FillRect(gRect);
|
|
|
+ if State = sbsForward then
|
|
|
+ begin
|
|
|
+ shift := 1;
|
|
|
+ Pen.Color := clGray;
|
|
|
+ with gRect do
|
|
|
+ Rectangle(Left, Top, Right, Bottom);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ shift := 0;
|
|
|
+ Border(ACanvas, gRect, btFlatRaised);
|
|
|
+ end;
|
|
|
+ iconX := gRect.Left + (Width - 1 - 7) div 2;
|
|
|
+ iconY := gRect.Top + (FButtonLength - 8) div 2;
|
|
|
+ Draw(iconX + shift, iconY + shift, bmScrollBarDown);
|
|
|
+
|
|
|
+ mRect := Rect(sRect.Left, sRect.Bottom, gRect.Right, gRect.Top);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ Pen.Color := clSilver;
|
|
|
+ MoveTo(Left, Top);
|
|
|
+ LineTo(Left + Width, Top);
|
|
|
+
|
|
|
+ sRect := BackRect;
|
|
|
+ Brush.Color := clSilver;
|
|
|
+ FillRect(sRect);
|
|
|
+ if State = sbsBack then
|
|
|
+ begin
|
|
|
+ shift := 1;
|
|
|
+ Pen.Color := clGray;
|
|
|
+ with sRect do
|
|
|
+ Rectangle(Left, Top, Right, Bottom);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ shift := 0;
|
|
|
+ Border(ACanvas, sRect, btFlatRaised);
|
|
|
+ end;
|
|
|
+ iconX := sRect.Left + shift + (FButtonLength - 8) div 2;
|
|
|
+ iconY := sRect.Top + shift + (Height - 1 - 7) div 2;
|
|
|
+ Draw(iconX + shift, iconY + shift, bmScrollBarLeft);
|
|
|
+
|
|
|
+ gRect := ForwardRect;
|
|
|
+ Brush.Color := clSilver;
|
|
|
+ FillRect(gRect);
|
|
|
+ if State = sbsForward then
|
|
|
+ begin
|
|
|
+ shift := 1;
|
|
|
+ Pen.Color := clGray;
|
|
|
+ with gRect do
|
|
|
+ Rectangle(Left, Top, Right, Bottom);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ shift := 0;
|
|
|
+ Border(ACanvas, gRect, btFlatRaised);
|
|
|
+ end;
|
|
|
+ iconX := gRect.Left + (FButtonLength - 8) div 2;
|
|
|
+ iconY := gRect.Top + (Height - 1 - 7) div 2;
|
|
|
+ Draw(iconX + shift, iconY + shift, bmScrollBarRight);
|
|
|
+
|
|
|
+ mRect := Rect(sRect.Right, sRect.Top, gRect.Left, gRect.Bottom);
|
|
|
+ end;
|
|
|
+
|
|
|
+ Brush.Bitmap := bmScrollBarFill;
|
|
|
+ FillRect(mRect);
|
|
|
+ Brush.Bitmap := nil;
|
|
|
+ if State = sbsPageBack then
|
|
|
+ begin
|
|
|
+ Brush.Color := clGray;
|
|
|
+ FillRect(PageBackRect);
|
|
|
+ end;
|
|
|
+ if State = sbsPageForward then
|
|
|
+ begin
|
|
|
+ Brush.Color := clGray;
|
|
|
+ FillRect(PageForwardRect);
|
|
|
+ end;
|
|
|
+
|
|
|
+ thRect := ThumbRect;
|
|
|
+ Brush.Color := clSilver;
|
|
|
+ FillRect(thRect);
|
|
|
+ Border(ACanvas, thRect, btFlatRaised);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+//-------------------- SET STATE ----------
|
|
|
+
|
|
|
+procedure TGLSMemoScrollBar.SetState(Value: TsbState);
|
|
|
+begin
|
|
|
+ if FState <> Value then
|
|
|
+ begin
|
|
|
+ FState := Value;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+//-------------------- MOUSE DOWN ------------
|
|
|
+
|
|
|
+function TGLSMemoScrollBar.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
|
+ X,
|
|
|
+ Y: Integer):
|
|
|
+ Boolean;
|
|
|
+var
|
|
|
+ sRect, gRect, thRect, pbRect, pfRect: TRect;
|
|
|
+begin
|
|
|
+ Result := False;
|
|
|
+ if (Width = 0) or (Height = 0) then
|
|
|
+ Exit;
|
|
|
+ sRect := BackRect;
|
|
|
+ gRect := ForwardRect;
|
|
|
+ pbRect := PageBackRect;
|
|
|
+ pfRect := PageForwardRect;
|
|
|
+ thRect := ThumbRect;
|
|
|
+ if PointInRect(Point(X, Y), sRect) then
|
|
|
+ begin
|
|
|
+ State := sbsBack;
|
|
|
+ InvalidateRect(Parent.Handle, @sRect, True);
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ if PointInRect(Point(X, Y), gRect) then
|
|
|
+ begin
|
|
|
+ State := sbsForward;
|
|
|
+ InvalidateRect(Parent.Handle, @gRect, True);
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ if PointInRect(Point(X, Y), pbRect) then
|
|
|
+ begin
|
|
|
+ State := sbsPageBack;
|
|
|
+ InvalidateRect(Parent.Handle, @pbRect, True);
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ if PointInRect(Point(X, Y), pfRect) then
|
|
|
+ begin
|
|
|
+ State := sbsPageForward;
|
|
|
+ InvalidateRect(Parent.Handle, @pfRect, True);
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ if PointInRect(Point(X, Y), thRect) then
|
|
|
+ begin
|
|
|
+ State := sbsDragging;
|
|
|
+ FXOffset := X - thRect.Left;
|
|
|
+ FYOffset := Y - thRect.Top;
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+end;
|
|
|
+//-------------------- MOUSE UP ----------
|
|
|
+
|
|
|
+function TGLSMemoScrollBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
|
|
|
+ Y:
|
|
|
+ Integer):
|
|
|
+ Boolean;
|
|
|
+var
|
|
|
+ sRect, gRect, thRect, pbRect, pfRect: TRect;
|
|
|
+begin
|
|
|
+ Result := False;
|
|
|
+ if (Width = 0) or (Height = 0) then
|
|
|
+ Exit;
|
|
|
+ sRect := BackRect;
|
|
|
+ gRect := ForwardRect;
|
|
|
+ pbRect := PageBackRect;
|
|
|
+ pfRect := PageForwardRect;
|
|
|
+ thRect := ThumbRect;
|
|
|
+ case State of
|
|
|
+ sbsBack:
|
|
|
+ begin
|
|
|
+ State := sbsWait;
|
|
|
+ InvalidateRect(Parent.Handle, @sRect, True);
|
|
|
+ FParent.DoScroll(Self, -1);
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ sbsForward:
|
|
|
+ begin
|
|
|
+ State := sbsWait;
|
|
|
+ InvalidateRect(Parent.Handle, @gRect, True);
|
|
|
+ FParent.DoScroll(Self, 1);
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ sbsPageBack:
|
|
|
+ begin
|
|
|
+ State := sbsWait;
|
|
|
+ InvalidateRect(Parent.Handle, @pbRect, True);
|
|
|
+ FParent.DoScrollPage(Self, -1);
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ sbsPageForward:
|
|
|
+ begin
|
|
|
+ State := sbsWait;
|
|
|
+ InvalidateRect(Parent.Handle, @pfRect, True);
|
|
|
+ FParent.DoScrollPage(Self, 1);
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ sbsDragging:
|
|
|
+ begin
|
|
|
+ State := sbsWait;
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+//-------------------- MOUSE MOVE -----------
|
|
|
+
|
|
|
+function TGLSMemoScrollBar.MouseMove(Shift: TShiftState; X, Y: Integer):
|
|
|
+ Boolean;
|
|
|
+var
|
|
|
+ sRect, gRect, thRect, pbRect, pfRect: TRect;
|
|
|
+begin
|
|
|
+ Result := False;
|
|
|
+ if (Width = 0) or (Height = 0) then
|
|
|
+ Exit;
|
|
|
+ sRect := BackRect;
|
|
|
+ gRect := ForwardRect;
|
|
|
+ pbRect := PageBackRect;
|
|
|
+ pfRect := PageForwardRect;
|
|
|
+ thRect := ThumbRect;
|
|
|
+ case State of
|
|
|
+ sbsBack:
|
|
|
+ if not PointInRect(Point(X, Y), sRect) then
|
|
|
+ begin
|
|
|
+ State := sbsWait;
|
|
|
+ InvalidateRect(Parent.Handle, @sRect, True);
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ sbsForward:
|
|
|
+ if not PointInRect(Point(X, Y), gRect) then
|
|
|
+ begin
|
|
|
+ State := sbsWait;
|
|
|
+ InvalidateRect(Parent.Handle, @gRect, True);
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ sbsPageBack:
|
|
|
+ if not PointInRect(Point(X, Y), pbRect) then
|
|
|
+ begin
|
|
|
+ State := sbsWait;
|
|
|
+ InvalidateRect(Parent.Handle, @pbRect, True);
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ sbsPageForward:
|
|
|
+ if not PointInRect(Point(X, Y), pfRect) then
|
|
|
+ begin
|
|
|
+ State := sbsWait;
|
|
|
+ InvalidateRect(Parent.Handle, @pfRect, True);
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ sbsDragging:
|
|
|
+ begin
|
|
|
+ MoveThumbTo(X, Y);
|
|
|
+ Result := True;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+//-------------------- MOVE THUMB TO ------------
|
|
|
+
|
|
|
+function TGLSMemoScrollBar.MoveThumbTo(X, Y: Integer): integer;
|
|
|
+var
|
|
|
+ thRect, mRect: TRect;
|
|
|
+ FreeLen, ThumbLen, NewPosition, NewOffset: integer;
|
|
|
+begin
|
|
|
+ thRect := ThumbRect;
|
|
|
+ mRect := MiddleRect;
|
|
|
+ NewOffset := 0;
|
|
|
+ FreeLen := 0;
|
|
|
+ ThumbLen := 0;
|
|
|
+ case Kind of
|
|
|
+ sbVertical:
|
|
|
+ begin
|
|
|
+ FreeLen := mRect.Bottom - mRect.Top;
|
|
|
+ ThumbLen := thRect.Bottom - thRect.Top;
|
|
|
+ NewOffset := Y - FYOffset - (Top + FButtonLength);
|
|
|
+ end;
|
|
|
+ sbHorizontal:
|
|
|
+ begin
|
|
|
+ FreeLen := mRect.Right - mRect.Left;
|
|
|
+ ThumbLen := thRect.Right - thRect.Left;
|
|
|
+ NewOffset := X - FXOffset - (Left + FButtonLength);
|
|
|
+ end
|
|
|
+ end;
|
|
|
+ NewPosition := round(NewOffset * MaxPosition / (FreeLen - ThumbLen));
|
|
|
+ Result := NewPosition - Position;
|
|
|
+ if NewPosition <> Position then
|
|
|
+ begin
|
|
|
+ Parent.DoScroll(Self, NewPosition - Position);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// GUTTER
|
|
|
+//--------------------------------------------------------------
|
|
|
+//-------------------- SET PARAMS -----------------------
|
|
|
+
|
|
|
+procedure TGLSMemoGutter.SetParams(Index: integer; Value: integer);
|
|
|
+begin
|
|
|
+ case Index of
|
|
|
+ 0: FLeft := Value;
|
|
|
+ 1: FTop := Value;
|
|
|
+ 2: FWidth := Value;
|
|
|
+ 3: FHeight := Value;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+//-------------------- PAINT TO -----------------------
|
|
|
+
|
|
|
+procedure TGLSMemoGutter.PaintTo(ACanvas: TCanvas);
|
|
|
+var
|
|
|
+ LineNo, T, H: integer;
|
|
|
+begin
|
|
|
+ with ACanvas do
|
|
|
+ begin
|
|
|
+ Pen.Color := clGray;
|
|
|
+ MoveTo(Left + Width - 1, Top);
|
|
|
+ LineTo(Left + Width - 1, Top + Height);
|
|
|
+ Pen.Color := clWhite;
|
|
|
+ MoveTo(Left + Width - 2, Top);
|
|
|
+ LineTo(Left + Width - 2, Top + Height);
|
|
|
+ Brush.Color := Self.FColor;
|
|
|
+ FillRect(Rect(Left, Top, Left + Width - 2, Top + Height));
|
|
|
+ if Assigned(FMemo.OnGutterDraw) then
|
|
|
+ begin
|
|
|
+ T := Top;
|
|
|
+ H := FMemo.FCellSize.H;
|
|
|
+ LineNo := FMemo.FTopLine;
|
|
|
+ while T < Top + Height do
|
|
|
+ begin
|
|
|
+ FMemo.OnGutterDraw(FMemo, ACanvas, LineNo,
|
|
|
+ Rect(Left, T, Left + Width - 2, T + H));
|
|
|
+ T := T + H;
|
|
|
+ Inc(LineNo);
|
|
|
+ if LineNo >= FMemo.Lines.Count then
|
|
|
+ break;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//-------------------- INVALIDATE -----------------------
|
|
|
+
|
|
|
+procedure TGLSMemoGutter.Invalidate;
|
|
|
+var
|
|
|
+ gRect: TRect;
|
|
|
+begin
|
|
|
+ gRect := Rect(Left, Top, Left + Width, Top + Height);
|
|
|
+ InvalidateRect(FMemo.Handle, @gRect, True);
|
|
|
+end;
|
|
|
+
|
|
|
+//-------------------- GET RECT -----------------------
|
|
|
+
|
|
|
+function TGLSMemoGutter.GetRect: TRect;
|
|
|
+begin
|
|
|
+ Result := Rect(Left, Top, Left + Width, Top + Height);
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+// ---------------------TStyleList
|
|
|
+
|
|
|
+procedure TStyleList.CheckRange(Index: integer);
|
|
|
+begin
|
|
|
+ if (Index < 0) or (Index >= Count) then
|
|
|
+ raise EListError.Create('Incorrect list item index ' + IntToStr(Index));
|
|
|
+end;
|
|
|
+//-------------------- DESTROY ---------------------------
|
|
|
+
|
|
|
+destructor TStyleList.Destroy;
|
|
|
+begin
|
|
|
+ Clear;
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+//-------------------- CHANGE ---------------------------
|
|
|
+
|
|
|
+procedure TStyleList.Change(Index: integer; ATextColor, ABkCOlor: TColor;
|
|
|
+ AStyle: TFontStyles);
|
|
|
+var
|
|
|
+ P: TCharStyle;
|
|
|
+begin
|
|
|
+ CheckRange(Index);
|
|
|
+ P := TCharStyle(Items[Index]);
|
|
|
+ P.TextColor := ATextColor;
|
|
|
+ P.BkColor := ABkColor;
|
|
|
+ P.Style := AStyle;
|
|
|
+end;
|
|
|
+//-------------------- ADD ---------------------------
|
|
|
+
|
|
|
+function TStyleList.Add(ATextColor, ABkColor: TColor; AStyle: TFontStyles):
|
|
|
+ Integer;
|
|
|
+var
|
|
|
+ P: TCharStyle;
|
|
|
+begin
|
|
|
+ P := TCharStyle.Create;
|
|
|
+ with P do
|
|
|
+ begin
|
|
|
+ TextColor := ATextColor;
|
|
|
+ BkColor := ABkColor;
|
|
|
+ Style := AStyle;
|
|
|
+ end;
|
|
|
+ Result := inherited Add(P);
|
|
|
+end;
|
|
|
+//-------------------- CLEAR ---------------------------
|
|
|
+
|
|
|
+procedure TStyleList.Clear;
|
|
|
+begin
|
|
|
+ while Count > 0 do
|
|
|
+ Delete(0);
|
|
|
+end;
|
|
|
+//-------------------- DELETE ---------------------------
|
|
|
+
|
|
|
+procedure TStyleList.Delete(Index: Integer);
|
|
|
+var
|
|
|
+ P: TCharStyle;
|
|
|
+begin
|
|
|
+ CheckRange(Index);
|
|
|
+ P := TCharStyle(Items[Index]);
|
|
|
+ P.Free;
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+//-------------------- GET/SET TEXT COLOR ---------------------------
|
|
|
+
|
|
|
+function TStyleList.GetTextColor(Index: Integer): TColor;
|
|
|
+begin
|
|
|
+ CheckRange(Index);
|
|
|
+ Result := TCharStyle(Items[Index]).TextColor;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TStyleList.SetTextColor(Index: Integer; Value: TColor);
|
|
|
+begin
|
|
|
+ CheckRange(Index);
|
|
|
+ TCharStyle(Items[Index]).TextColor := Value;
|
|
|
+end;
|
|
|
+//-------------------- GET/SET BK COLOR ---------------------------
|
|
|
+
|
|
|
+function TStyleList.GetBkColor(Index: Integer): TColor;
|
|
|
+begin
|
|
|
+ CheckRange(Index);
|
|
|
+ Result := TCharStyle(Items[Index]).BkColor;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TStyleList.SetBkColor(Index: Integer; Value: TColor);
|
|
|
+begin
|
|
|
+ CheckRange(Index);
|
|
|
+ TCharStyle(Items[Index]).BkColor := Value;
|
|
|
+end;
|
|
|
+//-------------------- GET/SET STYLE ---------------------------
|
|
|
+
|
|
|
+function TStyleList.GetStyle(Index: Integer): TFontStyles;
|
|
|
+begin
|
|
|
+ CheckRange(Index);
|
|
|
+ Result := TCharStyle(Items[Index]).Style;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TStyleList.SetStyle(Index: Integer; Value: TFontStyles);
|
|
|
+begin
|
|
|
+ CheckRange(Index);
|
|
|
+ TCharStyle(Items[Index]).Style := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+// ---------------------TGLSMemoStrings
|
|
|
+
|
|
|
+destructor TGLSMemoStrings.Destroy;
|
|
|
+var
|
|
|
+ P: TObject;
|
|
|
+begin
|
|
|
+ while Count > 0 do
|
|
|
+ begin
|
|
|
+ P := inherited GetObject(0);
|
|
|
+ P.Free;
|
|
|
+ inherited Delete(0);
|
|
|
+ end;
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+//-------------------- CLEAR ----------------------
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.Clear;
|
|
|
+begin
|
|
|
+ while Count > 0 do
|
|
|
+ begin
|
|
|
+ Delete(0);
|
|
|
+ if (Count = 1) and (Strings[0] = '') then
|
|
|
+ break;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//-------------------- ASSIGN ----------------------
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.Assign(Source: TPersistent);
|
|
|
+var
|
|
|
+ P: TObject;
|
|
|
+begin
|
|
|
+ if Source is TStrings then
|
|
|
+ begin
|
|
|
+ BeginUpdate;
|
|
|
+ try
|
|
|
+ while Count > 0 do
|
|
|
+ begin
|
|
|
+ P := inherited GetObject(0);
|
|
|
+ P.Free;
|
|
|
+ inherited Delete(0);
|
|
|
+ end;
|
|
|
+ // inherited Clear;
|
|
|
+ AddStrings(TStrings(Source));
|
|
|
+ finally
|
|
|
+ EndUpdate;
|
|
|
+ end;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ inherited Assign(Source);
|
|
|
+end;
|
|
|
+
|
|
|
+//-------------------- ADD ----------------------
|
|
|
+
|
|
|
+function TGLSMemoStrings.DoAdd(const S: string): Integer;
|
|
|
+begin
|
|
|
+ Result := inherited AddObject(S, nil);
|
|
|
+end;
|
|
|
+//-------------------- ADD ----------------------
|
|
|
+
|
|
|
+function TGLSMemoStrings.Add(const S: string): Integer;
|
|
|
+begin
|
|
|
+ if Assigned(FMemo.Parent) then
|
|
|
+ Result := FMemo.AddString(S)
|
|
|
+ else
|
|
|
+ Result := DoAdd(S);
|
|
|
+end;
|
|
|
+//-------------------- OBJECT ----------------------
|
|
|
+
|
|
|
+function TGLSMemoStrings.AddObject(const S: string; AObject: TObject): Integer;
|
|
|
+begin
|
|
|
+ if AObject <> nil then
|
|
|
+ raise EInvalidOp.Create(SObjectsNotSupported);
|
|
|
+ Result := DoAdd(S);
|
|
|
+end;
|
|
|
+//-------------------- INSERT ----------------------
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.InsertObject(Index: Integer;
|
|
|
+ const S: string; AObject: TObject);
|
|
|
+begin
|
|
|
+ if AObject <> nil then
|
|
|
+ raise EInvalidOp.Create(SObjectsNotSupported);
|
|
|
+ DoInsert(Index, S);
|
|
|
+end;
|
|
|
+//-------------------- DO INSERT ----------------------
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.DoInsert(Index: Integer; const S: string);
|
|
|
+begin
|
|
|
+ InsertItem(Index, S, nil);
|
|
|
+end;
|
|
|
+//-------------------- INSERT ----------------------
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.Insert(Index: Integer; const S: string);
|
|
|
+begin
|
|
|
+ if Assigned(FMemo) then
|
|
|
+ FMemo.InsertString(Index, S)
|
|
|
+ else
|
|
|
+ DoInsert(Index, S);
|
|
|
+end;
|
|
|
+//-------------------- DELETE ----------------------
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.Delete(Index: Integer);
|
|
|
+var
|
|
|
+ P: TObject;
|
|
|
+begin
|
|
|
+ if (Index < 0) or (Index > Count - 1) then
|
|
|
+ Exit;
|
|
|
+ if FDeleting or (not Assigned(FMemo)) then
|
|
|
+ begin
|
|
|
+ P := inherited GetObject(Index);
|
|
|
+ P.Free;
|
|
|
+ inherited;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ FMemo.DeleteLine(Index, -1, -1, -1, -1, True);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+//-------------------- LOAD FROM FILE ----------------------
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.LoadFromFile(const FileName: string);
|
|
|
+begin
|
|
|
+ with FMemo do
|
|
|
+ begin
|
|
|
+ ClearSelection;
|
|
|
+ ClearUndoList;
|
|
|
+ CurX := 0;
|
|
|
+ CurY := 0;
|
|
|
+ end;
|
|
|
+ Clear;
|
|
|
+ inherited;
|
|
|
+ FMemo.Invalidate;
|
|
|
+end;
|
|
|
+//-------------------- SET UPDATE STATE ----------------------
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.SetUpdateState(Updating: Boolean);
|
|
|
+begin
|
|
|
+ if Updating then
|
|
|
+ Inc(FLockCount)
|
|
|
+ else if FLockCount > 0 then
|
|
|
+ Dec(FLockCount);
|
|
|
+end;
|
|
|
+//-------------------- CHECK RANGE ---------------------------
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.CheckRange(Index: integer);
|
|
|
+begin
|
|
|
+ if (Index < 0) or (Index >= Count) then
|
|
|
+ raise EListError('Incorrect index of list item ' + IntToStr(Index));
|
|
|
+end;
|
|
|
+//-------------------- GET OBJECT ---------------------------
|
|
|
+
|
|
|
+function TGLSMemoStrings.GetObject(Index: Integer): TObject;
|
|
|
+begin
|
|
|
+ CheckRange(Index);
|
|
|
+ Result := inherited GetObject(Index);
|
|
|
+ if Assigned(Result) and (Result is TLineProp) then
|
|
|
+ Result := TLineProp(Result).FObject;
|
|
|
+end;
|
|
|
+//-------------------- PUT OBJECT ---------------------------
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.PutObject(Index: Integer; AObject: TObject);
|
|
|
+var
|
|
|
+ P: TObject;
|
|
|
+begin
|
|
|
+ CheckRange(Index);
|
|
|
+ P := Objects[Index];
|
|
|
+ if Assigned(P) and (P is TLineProp) then
|
|
|
+ TLineProp(P).FObject := AObject
|
|
|
+ else
|
|
|
+ inherited PutObject(Index, AObject);
|
|
|
+end;
|
|
|
+//-------------------- GET LINE PROP ---------------------------
|
|
|
+
|
|
|
+function TGLSMemoStrings.GetLineProp(Index: integer): TLineProp;
|
|
|
+var
|
|
|
+ P: TObject;
|
|
|
+begin
|
|
|
+ CheckRange(Index);
|
|
|
+ Result := nil;
|
|
|
+ P := inherited GetObject(Index);
|
|
|
+ if Assigned(P) and (P is TLineProp) then
|
|
|
+ Result := TLineProp(P);
|
|
|
+end;
|
|
|
+
|
|
|
+//-------------------- CREATE PROP --------------------------
|
|
|
+
|
|
|
+function TGLSMemoStrings.CreateProp(Index: integer): TLineProp;
|
|
|
+begin
|
|
|
+ Result := TLineProp.Create;
|
|
|
+ with Result do
|
|
|
+ begin
|
|
|
+ FStyleNo := 0;
|
|
|
+ FInComment := False;
|
|
|
+ FInBrackets := -1;
|
|
|
+ FValidAttrs := False;
|
|
|
+ FCharAttrs := '';
|
|
|
+ FObject := Objects[Index];
|
|
|
+ end;
|
|
|
+ inherited PutObject(Index, Result);
|
|
|
+end;
|
|
|
+
|
|
|
+//-------------------- GET LINE STYLE --------------------------
|
|
|
+
|
|
|
+function TGLSMemoStrings.GetLineStyle(Index: integer): integer;
|
|
|
+var
|
|
|
+ P: TLineProp;
|
|
|
+begin
|
|
|
+ P := LineProp[Index];
|
|
|
+ if P = nil then
|
|
|
+ Result := 0
|
|
|
+ else
|
|
|
+ Result := P.FStyleNo;
|
|
|
+end;
|
|
|
+
|
|
|
+//-------------------- SET LINE STYLE --------------------------
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.SetLineStyle(Index: integer; Value: integer);
|
|
|
+var
|
|
|
+ P: TLineProp;
|
|
|
+begin
|
|
|
+ P := LineProp[Index];
|
|
|
+ if P = nil then
|
|
|
+ P := CreateProp(Index);
|
|
|
+ P.FStyleNo := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+//-------------------- GET/SET IN COMMENT ---------------------------
|
|
|
+
|
|
|
+function TGLSMemoStrings.GetInComment(Index: Integer): Boolean;
|
|
|
+var
|
|
|
+ P: TLineProp;
|
|
|
+begin
|
|
|
+ P := LineProp[Index];
|
|
|
+ if P = nil then
|
|
|
+ Result := False
|
|
|
+ else
|
|
|
+ Result := P.FInComment;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.SetInComment(Index: Integer; Value: Boolean);
|
|
|
+var
|
|
|
+ P: TLineProp;
|
|
|
+begin
|
|
|
+ P := LineProp[Index];
|
|
|
+ if P = nil then
|
|
|
+ P := CreateProp(Index);
|
|
|
+ P.FInComment := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+//-------------------- GET/SET IN BRACKETS ---------------------------
|
|
|
+
|
|
|
+function TGLSMemoStrings.GetInBrackets(Index: Integer): integer;
|
|
|
+var
|
|
|
+ P: TLineProp;
|
|
|
+begin
|
|
|
+ P := LineProp[Index];
|
|
|
+ if P = nil then
|
|
|
+ Result := -1
|
|
|
+ else
|
|
|
+ Result := P.FInBrackets;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.SetInBrackets(Index: Integer; Value: integer);
|
|
|
+var
|
|
|
+ P: TLineProp;
|
|
|
+begin
|
|
|
+ P := LineProp[Index];
|
|
|
+ if P = nil then
|
|
|
+ P := CreateProp(Index);
|
|
|
+ P.FInBrackets := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+//-------------------- GET/SET VALID ATTRS ---------------------------
|
|
|
+
|
|
|
+function TGLSMemoStrings.GetValidAttrs(Index: Integer): Boolean;
|
|
|
+var
|
|
|
+ P: TLineProp;
|
|
|
+begin
|
|
|
+ P := LineProp[Index];
|
|
|
+ if P = nil then
|
|
|
+ Result := False
|
|
|
+ else
|
|
|
+ Result := P.FValidAttrs;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.SetValidAttrs(Index: Integer; Value: Boolean);
|
|
|
+var
|
|
|
+ P: TLineProp;
|
|
|
+begin
|
|
|
+ P := LineProp[Index];
|
|
|
+ if P = nil then
|
|
|
+ P := CreateProp(Index);
|
|
|
+ P.FValidAttrs := Value;
|
|
|
+end;
|
|
|
+//-------------------- GET/SET CHAR ATTRS ---------------------------
|
|
|
+
|
|
|
+function TGLSMemoStrings.GetCharAttrs(Index: Integer): string;
|
|
|
+var
|
|
|
+ P: TLineProp;
|
|
|
+begin
|
|
|
+ P := LineProp[Index];
|
|
|
+ if P = nil then
|
|
|
+ Result := ''
|
|
|
+ else
|
|
|
+ Result := P.FCharAttrs;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoStrings.SetCharAttrs(Index: Integer; const Value: string);
|
|
|
+var
|
|
|
+ P: TLineProp;
|
|
|
+begin
|
|
|
+ P := LineProp[Index];
|
|
|
+ if P = nil then
|
|
|
+ P := CreateProp(Index);
|
|
|
+ P.FCharAttrs := Value;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+// ---------------------TGLSMemoUndo
|
|
|
+
|
|
|
+constructor TGLSMemoUndo.Create(ACurX0, ACurY0, ACurX, ACurY: integer; const AText:
|
|
|
+ string);
|
|
|
+begin
|
|
|
+ inherited Create;
|
|
|
+ FUndoCurX0 := ACurX0;
|
|
|
+ FUndoCurY0 := ACurY0;
|
|
|
+ FUndoCurX := ACurX;
|
|
|
+ FUndoCurY := ACurY;
|
|
|
+ FUndoText := AText;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoUndo.Undo;
|
|
|
+begin
|
|
|
+ if Assigned(FMemo) then
|
|
|
+ with FMemo do
|
|
|
+ begin
|
|
|
+ CurY := FUndoCurY;
|
|
|
+ CurX := FUndoCurX;
|
|
|
+ PerformUndo;
|
|
|
+ CurY := FUndoCurY0;
|
|
|
+ CurX := FUndoCurX0;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoUndo.Redo;
|
|
|
+begin
|
|
|
+ if Assigned(FMemo) then
|
|
|
+ with FMemo do
|
|
|
+ begin
|
|
|
+ CurY := FUndoCurY0;
|
|
|
+ CurX := FUndoCurX0;
|
|
|
+ PerformRedo;
|
|
|
+ CurY := FUndoCurY;
|
|
|
+ CurX := FUndoCurX;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+function TGLSMemoUndo.Append(NewUndo: TGLSMemoUndo): Boolean;
|
|
|
+begin
|
|
|
+ Result := False;
|
|
|
+end;
|
|
|
+
|
|
|
+//---------------- TINSERT CHAR UNDO --------------------------
|
|
|
+
|
|
|
+procedure TGLSMemoInsCharUndo.PerformUndo;
|
|
|
+var
|
|
|
+ i: integer;
|
|
|
+ CurrLine: string;
|
|
|
+begin
|
|
|
+ for i := Length(FUndoText) downto 1 do
|
|
|
+ begin
|
|
|
+ CurrLine := FMemo.Lines[FMemo.CurY];
|
|
|
+ if ((FUndoText[i] = #13) and (FMemo.CurX = 0)) or
|
|
|
+ (FUndoText[i] = CurrLine[FMemo.CurX]) then
|
|
|
+ FMemo.BackSpace;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoInsCharUndo.PerformRedo;
|
|
|
+var
|
|
|
+ i: integer;
|
|
|
+begin
|
|
|
+ with FMemo do
|
|
|
+ for i := 1 to Length(FUndoText) do
|
|
|
+ if FUndoText[i] = #13 then
|
|
|
+ NewLine
|
|
|
+ else
|
|
|
+ InsertChar(FUndoText[i]);
|
|
|
+end;
|
|
|
+
|
|
|
+function TGLSMemoInsCharUndo.Append(NewUndo: TGLSMemoUndo): Boolean;
|
|
|
+begin
|
|
|
+ Result := False;
|
|
|
+ if not ((NewUndo is TGLSMemoInsCharUndo) and
|
|
|
+ (NewUndo.UndoCurX0 = FUndoCurX) and
|
|
|
+ (NewUndo.UndoCurY0 = FUndoCurY)) then
|
|
|
+ Exit;
|
|
|
+ FUndoText := FUndoText + NewUndo.FUndoText;
|
|
|
+ FUndoCurX := NewUndo.UndoCurX;
|
|
|
+ FUndoCurY := NewUndo.UndoCurY;
|
|
|
+ Result := True;
|
|
|
+end;
|
|
|
+
|
|
|
+//---------------- TDELETE CHAR UNDO --------------------------
|
|
|
+
|
|
|
+procedure TGLSMemoDelCharUndo.PerformUndo;
|
|
|
+var
|
|
|
+ i: integer;
|
|
|
+begin
|
|
|
+ with FMemo do
|
|
|
+ for i := 1 to Length(FUndoText) do
|
|
|
+ begin
|
|
|
+ if not FIsBackspace then
|
|
|
+ begin
|
|
|
+ CurY := FUndoCurY0;
|
|
|
+ CurX := FUndoCurX0;
|
|
|
+ end;
|
|
|
+ if FUndoText[i] = #13 then
|
|
|
+ NewLine
|
|
|
+ else
|
|
|
+ InsertChar(FUndoText[i]);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoDelCharUndo.PerformRedo;
|
|
|
+var
|
|
|
+ i: integer;
|
|
|
+begin
|
|
|
+ with FMemo do
|
|
|
+ for i := 1 to Length(FUndoText) do
|
|
|
+ if FIsBackspace then
|
|
|
+ BackSpace
|
|
|
+ else
|
|
|
+ DeleteChar(-1, -1);
|
|
|
+end;
|
|
|
+
|
|
|
+function TGLSMemoDelCharUndo.Append(NewUndo: TGLSMemoUndo): Boolean;
|
|
|
+begin
|
|
|
+ Result := False;
|
|
|
+ if not ((NewUndo is TGLSMemoDelCharUndo) and
|
|
|
+ (NewUndo.UndoCurX0 = FUndoCurX) and
|
|
|
+ (NewUndo.UndoCurY0 = FUndoCurY)) then
|
|
|
+ Exit;
|
|
|
+ if TGLSMemoDelCharUndo(NewUndo).FIsBackspace <> FIsBackspace then
|
|
|
+ Exit;
|
|
|
+ FUndoText := NewUndo.FUndoText + FUndoText;
|
|
|
+ FUndoCurX := NewUndo.UndoCurX;
|
|
|
+ FUndoCurY := NewUndo.UndoCurY;
|
|
|
+ Result := True;
|
|
|
+end;
|
|
|
+
|
|
|
+//---------------- TDELETE BUF, LINE UNDO --------------------------
|
|
|
+
|
|
|
+constructor TGLSMemoDelLineUndo.Create(AIndex, ACurX0, ACurY0, ACurX, ACurY:
|
|
|
+ integer; const AText: string);
|
|
|
+begin
|
|
|
+ inherited Create(ACurX0, ACurY0, ACurX, ACurY, AText);
|
|
|
+ FIndex := AIndex;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoDelLineUndo.PerformUndo;
|
|
|
+var
|
|
|
+ SaveCurX: integer;
|
|
|
+begin
|
|
|
+ with FMemo do
|
|
|
+ begin
|
|
|
+ SaveCurX := CurX;
|
|
|
+ CurX := 0;
|
|
|
+ ClearSelection;
|
|
|
+ SetSelText(PChar(FUndoText + #13#10));
|
|
|
+ CurX := SaveCurX;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoDelLineUndo.PerformRedo;
|
|
|
+begin
|
|
|
+ FMemo.DeleteLine(FIndex, FUndoCurX0, FUndoCurY0, FUndoCurX, FUndoCurY, True);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoDeleteBufUndo.PerformUndo;
|
|
|
+begin
|
|
|
+ with FMemo do
|
|
|
+ begin
|
|
|
+ ClearSelection;
|
|
|
+ SetSelText(PChar(FUndoText));
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoDeleteBufUndo.PerformRedo;
|
|
|
+begin
|
|
|
+ with FMemo do
|
|
|
+ begin
|
|
|
+ FSelStartX := FUndoSelStartX;
|
|
|
+ FSelStartY := FUndoSelStartY;
|
|
|
+ FSelEndX := FUndoSelEndX;
|
|
|
+ FSelEndY := FUndoSelEndY;
|
|
|
+ DeleteSelection(True);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//---------------- TPASTE UNDO --------------------------
|
|
|
+
|
|
|
+procedure TGLSMemoPasteUndo.PerformUndo;
|
|
|
+begin
|
|
|
+ with FMemo do
|
|
|
+ begin
|
|
|
+ FSelStartX := FUndoCurX0;
|
|
|
+ FSelStartY := FUndoCurY0;
|
|
|
+ FSelEndX := FUndoCurX;
|
|
|
+ FSelEndY := FUndoCurY;
|
|
|
+ DeleteSelection(True);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoPasteUndo.PerformRedo;
|
|
|
+begin
|
|
|
+ with FMemo do
|
|
|
+ begin
|
|
|
+ ClearSelection;
|
|
|
+ SetSelText(PChar(FUndoText));
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//---------------- TUNDO LIST --------------------------
|
|
|
+
|
|
|
+constructor TGLSMemoUndoList.Create;
|
|
|
+begin
|
|
|
+ inherited;
|
|
|
+ FPos := 0;
|
|
|
+ FIsPerforming := False;
|
|
|
+ FLimit := 100;
|
|
|
+end;
|
|
|
+
|
|
|
+destructor TGLSMemoUndoList.Destroy;
|
|
|
+begin
|
|
|
+ Clear;
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+
|
|
|
+function TGLSMemoUndoList.Get(Index: Integer): TGLSMemoUndo;
|
|
|
+begin
|
|
|
+ Result := TGLSMemoUndo(inherited Get(Index));
|
|
|
+end;
|
|
|
+
|
|
|
+function TGLSMemoUndoList.Add(Item: Pointer): Integer;
|
|
|
+begin
|
|
|
+ Result := -1;
|
|
|
+ if FIsPerforming then
|
|
|
+ begin
|
|
|
+ TGLSMemoUndo(Item).Free;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if (Count > 0) and
|
|
|
+ Items[0].Append(TGLSMemoUndo(Item)) then
|
|
|
+ begin
|
|
|
+ TGLSMemoUndo(Item).Free;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ TGLSMemoUndo(Item).FMemo := Self.FMemo;
|
|
|
+ if FPos > 0 then
|
|
|
+ while FPos > 0 do
|
|
|
+ begin
|
|
|
+ Delete(0);
|
|
|
+ Dec(FPos);
|
|
|
+ end;
|
|
|
+ Insert(0, Item);
|
|
|
+ if Count > FLimit then
|
|
|
+ Delete(Count - 1);
|
|
|
+ Memo.UndoChange;
|
|
|
+ Result := 0;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoUndoList.Clear;
|
|
|
+begin
|
|
|
+ while Count > 0 do
|
|
|
+ Delete(0);
|
|
|
+ FPos := 0;
|
|
|
+ with Memo do
|
|
|
+ if not (csDestroying in ComponentState) then
|
|
|
+ UndoChange;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoUndoList.Delete(Index: Integer);
|
|
|
+begin
|
|
|
+ TGLSMemoUndo(Items[Index]).Free;
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoUndoList.Undo;
|
|
|
+var
|
|
|
+ OldAutoIndent: Boolean;
|
|
|
+begin
|
|
|
+ if FPos < Count then
|
|
|
+ begin
|
|
|
+ OldAutoIndent := Memo.AutoIndent;
|
|
|
+ Memo.AutoIndent := False;
|
|
|
+ FIsPerforming := True;
|
|
|
+ Items[FPos].Undo;
|
|
|
+ Inc(FPos);
|
|
|
+ FIsPerforming := False;
|
|
|
+ Memo.AutoIndent := OldAutoIndent;
|
|
|
+ Memo.UndoChange;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoUndoList.Redo;
|
|
|
+var
|
|
|
+ OldAutoIndent: Boolean;
|
|
|
+begin
|
|
|
+ if FPos > 0 then
|
|
|
+ begin
|
|
|
+ OldAutoIndent := Memo.AutoIndent;
|
|
|
+ Memo.AutoIndent := False;
|
|
|
+ FIsPerforming := True;
|
|
|
+ Dec(FPos);
|
|
|
+ Items[FPos].Redo;
|
|
|
+ FIsPerforming := False;
|
|
|
+ Memo.AutoIndent := OldAutoIndent;
|
|
|
+ Memo.UndoChange;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSMemoUndoList.SetLimit(Value: integer);
|
|
|
+begin
|
|
|
+ if FLimit <> Value then
|
|
|
+ begin
|
|
|
+ if Value <= 0 then
|
|
|
+ Value := 10;
|
|
|
+ if Value > 0 then
|
|
|
+ Value := 100;
|
|
|
+ FLimit := Value;
|
|
|
+ Clear;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSSynHiMemo.Paint;
|
|
|
+begin
|
|
|
+ FIsPainting := True;
|
|
|
+ try
|
|
|
+ DelimiterStyle := FDelimiterStyle;
|
|
|
+ CommentStyle := FCommentStyle;
|
|
|
+ NumberStyle := FNumberStyle;
|
|
|
+ inherited;
|
|
|
+ finally
|
|
|
+ FIsPainting := False;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+// ---------------------TGLSSynHiMemo
|
|
|
+
|
|
|
+procedure TGLSSynHiMemo.SetStyle(Index: integer; Value: TCharStyle);
|
|
|
+var
|
|
|
+ No: integer;
|
|
|
+ eRect: TRect;
|
|
|
+begin
|
|
|
+ No := -1;
|
|
|
+ case Index of
|
|
|
+ 0: No := FDelimiterStyleNo;
|
|
|
+ 1: No := FCommentStyleNo;
|
|
|
+ 2: No := FNumberStyleNo;
|
|
|
+ end;
|
|
|
+ with Value do
|
|
|
+ Styles.Change(No, TextColor, BkColor, Style);
|
|
|
+ if not FIsPainting then
|
|
|
+ begin
|
|
|
+ eRect := EditorRect;
|
|
|
+ InvalidateRect(Handle, @eRect, True);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SYNTAX MEMO - SET WORD LIST
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSSynHiMemo.SetWordList(Value: TGLSMemoStringList);
|
|
|
+begin
|
|
|
+ FWordList.Assign(Value);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSSynHiMemo.SetSpecialList(Value: TGLSMemoStringList);
|
|
|
+begin
|
|
|
+ FSpecialList.Assign(Value);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TGLSSynHiMemo.SetBracketList(Value: TGLSMemoStringList);
|
|
|
+begin
|
|
|
+ FBracketList.Assign(Value);
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SYNTAX MEMO - SET CASE SENSITIVE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSSynHiMemo.SetCaseSensitive(Value: Boolean);
|
|
|
+var
|
|
|
+ LineNo: integer;
|
|
|
+begin
|
|
|
+ if Value <> FCaseSensitive then
|
|
|
+ begin
|
|
|
+ FCaseSensitive := Value;
|
|
|
+ for LineNo := 0 to Lines.Count - 1 do
|
|
|
+ ValidAttrs[LineNo] := False;
|
|
|
+ Invalidate;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SYNTAX MEMO - GET TOKEN
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+function TGLSSynHiMemo.GetToken(const S: string; var From: integer;
|
|
|
+ out TokenType: TTokenType; out StyleNo: integer): string;
|
|
|
+var
|
|
|
+ i, toStart, toEnd, Len, LenSpec: integer;
|
|
|
+ Done: Boolean;
|
|
|
+ Brackets: string;
|
|
|
+ IntPart: integer;
|
|
|
+ WasPoint: Boolean;
|
|
|
+ //-------------------------------------------------------------
|
|
|
+ function StartsFrom(const S: string; Pos: integer; const S0: string): Boolean;
|
|
|
+ begin
|
|
|
+ Result := (StrLComp(PChar(S) + Pos - 1, PChar(S0), Length(S0)) = 0);
|
|
|
+ end;
|
|
|
+ //-------------------------------------------------------------
|
|
|
+ function Equal(const s1, s2: string): Boolean;
|
|
|
+ begin
|
|
|
+ if FCaseSensitive then
|
|
|
+ Result := s1 = s2
|
|
|
+ else
|
|
|
+ Result := AnsiLowerCase(s1) = AnsiLowerCase(s2);
|
|
|
+ end;
|
|
|
+begin
|
|
|
+ toStart := From;
|
|
|
+ toEnd := From;
|
|
|
+ TokenType := ttOther;
|
|
|
+ StyleNo := 0;
|
|
|
+ Len := Length(S);
|
|
|
+ // End of line
|
|
|
+ if From > Len then
|
|
|
+ begin
|
|
|
+ From := -1;
|
|
|
+ Result := '';
|
|
|
+ TokenType := ttEOL;
|
|
|
+ StyleNo := 0;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ // Begin of multiline comment
|
|
|
+ if (MultiCommentLeft <> '') and (MultiCommentRight <> '') and
|
|
|
+ StartsFrom(S, From, MultiCommentLeft) then
|
|
|
+ begin
|
|
|
+ Result := MultiCommentLeft;
|
|
|
+ FInComment := True;
|
|
|
+ TokenType := ttComment;
|
|
|
+ StyleNo := FCommentStyleNo;
|
|
|
+ Inc(From, Length(MultiCommentLeft));
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ // Inside multiline comment
|
|
|
+ if FInComment then
|
|
|
+ begin
|
|
|
+ toEnd := toStart;
|
|
|
+ while (toEnd <= Len) and (not StartsFrom(S, toEnd, MultiCommentRight)) do
|
|
|
+ Inc(toEnd);
|
|
|
+ if toEnd > Len then
|
|
|
+ begin
|
|
|
+ Result := Copy(S, From, toEnd - From);
|
|
|
+ From := toEnd;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ FInComment := False;
|
|
|
+ toEnd := toEnd + Length(MultiCommentRight);
|
|
|
+ Result := Copy(S, From, toEnd - From);
|
|
|
+ From := toEnd;
|
|
|
+ end;
|
|
|
+ TokenType := ttComment;
|
|
|
+ StyleNo := FCommentStyleNo;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ // Inside brikets
|
|
|
+ if FInBrackets >= 0 then
|
|
|
+ begin
|
|
|
+ Brackets := FBracketList[FInBrackets];
|
|
|
+ toEnd := toStart + 1;
|
|
|
+ while (toEnd <= Len) and (S[toEnd] <> Brackets[2]) do
|
|
|
+ Inc(toEnd);
|
|
|
+ StyleNo := integer(FBracketList.Objects[FInBrackets]);
|
|
|
+ if toEnd <= Len then
|
|
|
+ begin
|
|
|
+ FInBrackets := -1;
|
|
|
+ From := toEnd + 1;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ From := toEnd;
|
|
|
+ Result := Copy(S, toStart, toEnd - toStart + 1);
|
|
|
+ TokenType := ttBracket;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ // Spaces
|
|
|
+ while (toStart <= Len) and (S[toStart] = ' ') do
|
|
|
+ Inc(toStart);
|
|
|
+ if toStart > From then
|
|
|
+ begin
|
|
|
+ Result := Copy(S, From, toStart - From);
|
|
|
+ From := toStart;
|
|
|
+ TokenType := ttSpace;
|
|
|
+ StyleNo := 0;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ // Comment
|
|
|
+ if (FLineComment <> '') and StartsFrom(S, From, FLineComment) then
|
|
|
+ begin
|
|
|
+ Result := Copy(S, From, Len);
|
|
|
+ From := Len + 1;
|
|
|
+ TokenType := ttComment;
|
|
|
+ StyleNo := FCommentStyleNo;
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+
|
|
|
+ // Special keyword
|
|
|
+ Done := False;
|
|
|
+ for i := 0 to FSpecialList.Count - 1 do
|
|
|
+ begin
|
|
|
+ LenSpec := Length(FSpecialList[i]);
|
|
|
+ if StrLComp(PChar(S) + toStart - 1,
|
|
|
+ PChar(FSpecialList[i]), LenSpec) = 0 then
|
|
|
+ begin
|
|
|
+ toEnd := toStart + LenSpec - 1;
|
|
|
+ StyleNo := integer(FSpecialList.Objects[i]);
|
|
|
+ TokenType := ttSpecial;
|
|
|
+ From := toEnd + 1;
|
|
|
+ Done := True;
|
|
|
+ break;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ // Brickets
|
|
|
+ if not Done then
|
|
|
+ begin
|
|
|
+ for i := 0 to FBracketList.Count - 1 do
|
|
|
+ begin
|
|
|
+ Brackets := FBracketList[i];
|
|
|
+ if S[toStart] = Brackets[1] then
|
|
|
+ begin
|
|
|
+ FInBrackets := i;
|
|
|
+ toEnd := toStart + 1;
|
|
|
+ while (toEnd <= Len) and (S[toEnd] <> Brackets[2]) do
|
|
|
+ Inc(toEnd);
|
|
|
+ if toEnd <= Len then
|
|
|
+ FInBrackets := -1
|
|
|
+ else
|
|
|
+ Dec(toEnd);
|
|
|
+ StyleNo := integer(FBracketList.Objects[i]);
|
|
|
+ TokenType := ttBracket;
|
|
|
+ Done := True;
|
|
|
+ break;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ // Delimeters
|
|
|
+ if not Done and CharInSet(S[toStart], Delimiters) then
|
|
|
+ begin
|
|
|
+ toEnd := toStart;
|
|
|
+ StyleNo := FDelimiterStyleNo;
|
|
|
+ TokenType := ttDelimiter;
|
|
|
+ Done := True;
|
|
|
+ end;
|
|
|
+ // --- Integer or float type
|
|
|
+ if not Done and CharInSet(S[toStart], ['0'..'9', '.']) then
|
|
|
+ begin
|
|
|
+ IntPart := 0;
|
|
|
+ WasPoint := False;
|
|
|
+ toEnd := toStart;
|
|
|
+ Done := True;
|
|
|
+ TokenType := ttInteger;
|
|
|
+ StyleNo := FNumberStyleNo;
|
|
|
+ while (toEnd <= Len) and CharInSet(S[toEnd], ['0'..'9', '.']) do
|
|
|
+ begin
|
|
|
+ if S[toEnd] = '.' then
|
|
|
+ begin
|
|
|
+ if not WasPoint then
|
|
|
+ begin
|
|
|
+ WasPoint := True;
|
|
|
+ TokenType := ttFloat;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ TokenType := ttWrongNumber;
|
|
|
+ Color := clRed;
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ else if not WasPoint then
|
|
|
+ try
|
|
|
+ IntPart := IntPart * 10 + Ord(S[toEnd]) - Ord('0');
|
|
|
+ except
|
|
|
+ IntPart := MaxInt;
|
|
|
+ end;
|
|
|
+ Inc(toEnd);
|
|
|
+ end;
|
|
|
+ Dec(toEnd);
|
|
|
+ end;
|
|
|
+ // Select word
|
|
|
+ if not Done then
|
|
|
+ begin
|
|
|
+ toEnd := toStart;
|
|
|
+ while (toEnd <= Len) and not CharInSet(S[toEnd], Delimiters) do
|
|
|
+ Inc(toEnd);
|
|
|
+ Dec(toEnd);
|
|
|
+ end;
|
|
|
+ // Find in dictionary
|
|
|
+ Result := Copy(S, toStart, toEnd - toStart + 1);
|
|
|
+ for i := 0 to FWordList.Count - 1 do
|
|
|
+ if Equal(Result, FWordList[i]) then
|
|
|
+ begin
|
|
|
+ StyleNo := integer(FWordList.Objects[i]);
|
|
|
+ TokenType := ttWord;
|
|
|
+ break;
|
|
|
+ end;
|
|
|
+ From := toEnd + 1;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SYNTAX MEMO - FIND LINE ATTRS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSSynHiMemo.FindLineAttrs(Sender: TObject; LineNo: integer;
|
|
|
+ var Attrs: string);
|
|
|
+var
|
|
|
+ i, From, TokenLen: integer;
|
|
|
+ S, Token: string;
|
|
|
+ TokenType: TTokenType;
|
|
|
+ StyleNo, OldInBrackets: integer;
|
|
|
+ OldInComment: Boolean;
|
|
|
+begin
|
|
|
+ S := Lines[LineNo];
|
|
|
+ SetLength(Attrs, Length(S));
|
|
|
+ FInComment := InComment[LineNo];
|
|
|
+ FInBrackets := InBrackets[LineNo];
|
|
|
+ From := 1;
|
|
|
+ while True do
|
|
|
+ begin
|
|
|
+ Token := GetToken(S, From, TokenType, StyleNo);
|
|
|
+ if TokenType = ttEOL then
|
|
|
+ break;
|
|
|
+ TokenLen := Length(Token);
|
|
|
+ for i := From - TokenLen to From - 1 do
|
|
|
+ Attrs[i] := Char(StyleNo);
|
|
|
+ end;
|
|
|
+ if LineNo < Lines.Count - 1 then
|
|
|
+ begin
|
|
|
+ OldInComment := InComment[LineNo + 1];
|
|
|
+ OldInBrackets := InBrackets[LineNo + 1];
|
|
|
+ if OldInComment <> FInComment then
|
|
|
+ begin
|
|
|
+ InComment[LineNo + 1] := FInComment;
|
|
|
+ ValidAttrs[LineNo + 1] := False;
|
|
|
+ end;
|
|
|
+ if OldInBrackets <> FInBrackets then
|
|
|
+ begin
|
|
|
+ InBrackets[LineNo + 1] := FInBrackets;
|
|
|
+ ValidAttrs[LineNo + 1] := False;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SYNTAX MEMO - ADD WORD
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSSynHiMemo.AddWord(StyleNo: integer; const ArrS: array of string);
|
|
|
+var
|
|
|
+ i: integer;
|
|
|
+begin
|
|
|
+ for i := Low(ArrS) to high(ArrS) do
|
|
|
+ FWordList.AddObject(ArrS[i], TObject(StyleNo));
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SYNTAX MEMO - ADD SPECIAL
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSSynHiMemo.AddSpecial(StyleNo: integer; const ArrS: array of string);
|
|
|
+var
|
|
|
+ i: integer;
|
|
|
+begin
|
|
|
+ for i := Low(ArrS) to high(ArrS) do
|
|
|
+ FSpecialList.AddObject(ArrS[i], TObject(StyleNo));
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SYNTAX MEMO - ADD BRACKETS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSSynHiMemo.AddBrackets(StyleNo: integer; const ArrS: array of string);
|
|
|
+var
|
|
|
+ i: integer;
|
|
|
+begin
|
|
|
+ for i := Low(ArrS) to high(ArrS) do
|
|
|
+ FBracketList.AddObject(ArrS[i], TObject(StyleNo));
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SYNTAX MEMO - CREATE
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+constructor TGLSSynHiMemo.Create(AOwner: TComponent);
|
|
|
+begin
|
|
|
+ inherited;
|
|
|
+ FInBrackets := -1;
|
|
|
+ FIsPainting := False;
|
|
|
+ FInComment := False;
|
|
|
+ FWordList := TGLSMemoStringList.Create;
|
|
|
+ FSpecialList := TGLSMemoStringList.Create;
|
|
|
+ FBracketList := TGLSMemoStringList.Create;
|
|
|
+
|
|
|
+ FDelimiterStyle := TCharStyle.Create;
|
|
|
+ with FDelimiterStyle do
|
|
|
+ begin
|
|
|
+ TextColor := clBlue;
|
|
|
+ BkColor := clWhite;
|
|
|
+ Style := [];
|
|
|
+ end;
|
|
|
+
|
|
|
+ FCommentStyle := TCharStyle.Create;
|
|
|
+ with FCommentStyle do
|
|
|
+ begin
|
|
|
+ TextColor := clYellow;
|
|
|
+ BkColor := clSkyBlue;
|
|
|
+ Style := [fsItalic];
|
|
|
+ end;
|
|
|
+
|
|
|
+ FNumberStyle := TCharStyle.Create;
|
|
|
+ with FNumberStyle do
|
|
|
+ begin
|
|
|
+ TextColor := clNavy;
|
|
|
+ BkColor := clWhite;
|
|
|
+ Style := [fsBold];
|
|
|
+ end;
|
|
|
+
|
|
|
+ FDelimiterStyleNo := Styles.Add(clBlue, clWhite, []);
|
|
|
+ FCommentStyleNo := Styles.Add(clSilver, clWhite, [fsItalic]);
|
|
|
+ FNumberStyleNo := Styles.Add(clNavy, clWhite, [fsBold]);
|
|
|
+ OnGetLineAttrs := FindLineAttrs;
|
|
|
+ Delimiters := [' ', ',', ';', ':', '.', '(', ')', '{', '}', '[', ']',
|
|
|
+ '=', '+', '-', '*', '/', '^', '%', '<', '>',
|
|
|
+ '"', '''', #13, #10];
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// SYNTAX MEMO - DESTROY
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+destructor TGLSSynHiMemo.Destroy;
|
|
|
+begin
|
|
|
+ FWordList.Free;
|
|
|
+ FSpecialList.Free;
|
|
|
+ FBracketList.Free;
|
|
|
+ FDelimiterStyle.Free;
|
|
|
+ FCommentStyle.Free;
|
|
|
+ FNumberStyle.Free;
|
|
|
+ inherited;
|
|
|
+end;
|
|
|
+
|
|
|
+// ---------------------TGLSMemoStringList
|
|
|
+
|
|
|
+procedure TGLSMemoStringList.ReadStrings(Reader: TReader);
|
|
|
+var
|
|
|
+ i: Integer;
|
|
|
+begin
|
|
|
+ try
|
|
|
+ Reader.ReadListBegin;
|
|
|
+ Clear;
|
|
|
+ while not Reader.EndOfList do
|
|
|
+ begin
|
|
|
+ i := Add(Reader.ReadString);
|
|
|
+ Objects[i] := TObject(Reader.ReadInteger);
|
|
|
+ end;
|
|
|
+ Reader.ReadListEnd;
|
|
|
+ finally
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// STRING LIST - WRITE STRINGS
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSMemoStringList.WriteStrings(Writer: TWriter);
|
|
|
+var
|
|
|
+ i: Integer;
|
|
|
+begin
|
|
|
+ with Writer do
|
|
|
+ begin
|
|
|
+ WriteListBegin;
|
|
|
+ for i := 0 to Count - 1 do
|
|
|
+ begin
|
|
|
+ WriteString(Strings[i]);
|
|
|
+ WriteInteger(Integer(Objects[i]));
|
|
|
+ end;
|
|
|
+ WriteListEnd;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//--------------------------------------------------------------
|
|
|
+// STRING LIST - DEFINE PROPERTIES
|
|
|
+//--------------------------------------------------------------
|
|
|
+
|
|
|
+procedure TGLSMemoStringList.DefineProperties(Filer: TFiler);
|
|
|
+begin
|
|
|
+ Filer.DefineProperty('Strings', ReadStrings, WriteStrings, Count > 0);
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+// ---------------------ScrollBar bitmaps
|
|
|
+
|
|
|
+procedure CreateScrollBarBitmaps;
|
|
|
+var
|
|
|
+ i, j: integer;
|
|
|
+begin
|
|
|
+ bmScrollBarFill := TBitmap.Create;
|
|
|
+ with bmScrollBarFill, Canvas do
|
|
|
+ begin
|
|
|
+ Width := 8;
|
|
|
+ Height := 8;
|
|
|
+ Transparent := False;
|
|
|
+ for i := 0 to 7 do
|
|
|
+ for j := 0 to 7 do
|
|
|
+ if Odd(i + j) then
|
|
|
+ Pixels[i, j] := clSilver;
|
|
|
+ end;
|
|
|
+
|
|
|
+ bmScrollBarUp := TBitmap.Create;
|
|
|
+ with bmScrollBarUp, Canvas do
|
|
|
+ begin
|
|
|
+ Width := 7;
|
|
|
+ Height := 8;
|
|
|
+ Brush.Color := clSilver;
|
|
|
+ FillRect(Rect(0, 0, Width, Height));
|
|
|
+ Pixels[3, 2] := clBlack;
|
|
|
+ MoveTo(2, 3);
|
|
|
+ LineTo(5, 3);
|
|
|
+ MoveTo(1, 4);
|
|
|
+ LineTo(6, 4);
|
|
|
+ MoveTo(0, 5);
|
|
|
+ LineTo(7, 5);
|
|
|
+ end;
|
|
|
+
|
|
|
+ bmScrollBarDown := TBitmap.Create;
|
|
|
+ with bmScrollBarDown, Canvas do
|
|
|
+ begin
|
|
|
+ Width := 7;
|
|
|
+ Height := 8;
|
|
|
+ Brush.Color := clSilver;
|
|
|
+ FillRect(Rect(0, 0, Width, Height));
|
|
|
+ MoveTo(0, 2);
|
|
|
+ LineTo(7, 2);
|
|
|
+ MoveTo(1, 3);
|
|
|
+ LineTo(6, 3);
|
|
|
+ MoveTo(2, 4);
|
|
|
+ LineTo(5, 4);
|
|
|
+ Pixels[3, 5] := clBlack;
|
|
|
+ end;
|
|
|
+
|
|
|
+ bmScrollBarLeft := TBitmap.Create;
|
|
|
+ with bmScrollBarLeft, Canvas do
|
|
|
+ begin
|
|
|
+ Width := 8;
|
|
|
+ Height := 7;
|
|
|
+ Brush.Color := clSilver;
|
|
|
+ FillRect(Rect(0, 0, Width, Height));
|
|
|
+ Pixels[2, 3] := clBlack;
|
|
|
+ MoveTo(3, 2);
|
|
|
+ LineTo(3, 5);
|
|
|
+ MoveTo(4, 1);
|
|
|
+ LineTo(4, 6);
|
|
|
+ MoveTo(5, 0);
|
|
|
+ LineTo(5, 7);
|
|
|
+ end;
|
|
|
+ bmScrollBarRight := TBitmap.Create;
|
|
|
+ with bmScrollBarRight, Canvas do
|
|
|
+ begin
|
|
|
+ Width := 8;
|
|
|
+ Height := 7;
|
|
|
+ Brush.Color := clSilver;
|
|
|
+ FillRect(Rect(0, 0, Width, Height));
|
|
|
+ MoveTo(2, 0);
|
|
|
+ LineTo(2, 7);
|
|
|
+ MoveTo(3, 1);
|
|
|
+ LineTo(3, 6);
|
|
|
+ MoveTo(4, 2);
|
|
|
+ LineTo(4, 5);
|
|
|
+ Pixels[5, 3] := clBlack;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+//------------------ FREE SCROLL BAR BITMAPs -------------------
|
|
|
+
|
|
|
+procedure FreeScrollBarBitmaps;
|
|
|
+begin
|
|
|
+ bmScrollBarFill.Free;
|
|
|
+ bmScrollBarUp.Free;
|
|
|
+ bmScrollBarDown.Free;
|
|
|
+ bmScrollBarLeft.Free;
|
|
|
+ bmScrollBarRight.Free;
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+//----------------------------------
|
|
|
+initialization
|
|
|
+//----------------------------------
|
|
|
+
|
|
|
+ RegisterClasses([TGLSSynHiMemo]);
|
|
|
+ CreateScrollBarBitmaps;
|
|
|
+ IntelliMouseInit;
|
|
|
+
|
|
|
+//----------------------------------
|
|
|
+finalization
|
|
|
+//----------------------------------
|
|
|
+
|
|
|
+ FreeScrollBarBitmaps;
|
|
|
+
|
|
|
+end.
|
|
|
+
|
GLScene