2144 lines
50 KiB
ObjectPascal
2144 lines
50 KiB
ObjectPascal
|
||
{******************************************}
|
||
{ }
|
||
{ FastReport v4.0 }
|
||
{ Syntax memo control }
|
||
{ }
|
||
{ Copyright (c) 1998-2008 }
|
||
{ by Alexander Tzyganenko, }
|
||
{ Fast Reports Inc. }
|
||
{ }
|
||
{******************************************}
|
||
|
||
unit frxSynMemo;
|
||
|
||
interface
|
||
|
||
{$I frx.inc}
|
||
|
||
uses
|
||
Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls,
|
||
Forms, frxCtrls, fs_iparser, frxPopupForm, Imm
|
||
{$IFDEF DELPHI19}
|
||
, FMX.Graphics
|
||
{$ENDIF};
|
||
|
||
type
|
||
TCharAttr = (caNo, caText, caBlock, caComment, caKeyword, caString,
|
||
caNumber);
|
||
TCharAttributes = set of TCharAttr;
|
||
|
||
TfrxCodeCompletionEvent = procedure(const Name: String; List: TStrings) of object;
|
||
|
||
TfrxSyntaxMemo = class(TfrxScrollWin)
|
||
private
|
||
FActiveLine: Integer;
|
||
FAllowLinesChange: Boolean;
|
||
FBlockColor: TColor;
|
||
FBlockFontColor: TColor;
|
||
FBookmarks: array[0..9] of Integer;
|
||
FCharHeight: Integer;
|
||
FCharWidth: Integer;
|
||
FCommentAttr: TFont;
|
||
FCompletionForm: TfrxPopupForm;
|
||
FCompletionLB: TListBox;
|
||
FDoubleClicked: Boolean;
|
||
FDown: Boolean;
|
||
FToggleBreakPointDown: Boolean;
|
||
FGutterWidth: Integer;
|
||
FIsMonoType: Boolean;
|
||
FKeywordAttr: TFont;
|
||
FMaxLength: Integer;
|
||
FMessage: String;
|
||
FModified: Boolean;
|
||
FMoved: Boolean;
|
||
FNumberAttr: TFont;
|
||
FOffset: TPoint;
|
||
FOnChangePos: TNotifyEvent;
|
||
FOnChangeText: TNotifyEvent;
|
||
FOnCodeCompletion: TfrxCodeCompletionEvent;
|
||
FParser: TfsParser;
|
||
FPos: TPoint;
|
||
FStringAttr: TFont;
|
||
FSelEnd: TPoint;
|
||
FSelStart: TPoint;
|
||
FCompSelStart: TPoint;
|
||
FCompSelEnd: TPoint;
|
||
FShowGutter: boolean;
|
||
FSynStrings: TStrings;
|
||
FSyntax: String;
|
||
FTempPos: TPoint;
|
||
FText: TStringList;
|
||
FTextAttr: TFont;
|
||
FUndo: TStringList;
|
||
FUpdatingSyntax: Boolean;
|
||
FWindowSize: TPoint;
|
||
FBreakPoints: TStringList;
|
||
FTmpCanvas: TBitmap;
|
||
{ need for east languages carret correction }
|
||
function GetCharWidth(Str: String): Integer;
|
||
function GetCharAttr(Pos: TPoint): TCharAttributes;
|
||
function GetLineBegin(Index: Integer): Integer;
|
||
function GetPlainTextPos(Pos: TPoint): Integer;
|
||
function GetPosPlainText(Pos: Integer): TPoint;
|
||
function GetRunLine(Index: Integer): Boolean;
|
||
function GetSelText: String;
|
||
function GetText: TStrings;
|
||
function LineAt(Index: Integer): String;
|
||
function LineLength(Index: Integer): Integer;
|
||
function Pad(n: Integer): String;
|
||
procedure AddSel;
|
||
procedure AddUndo;
|
||
procedure ClearSel;
|
||
procedure ClearSyntax(ClearFrom: Integer);
|
||
procedure CompletionLBDblClick(Sender: TObject);
|
||
procedure CompletionLBDrawItem(Control: TWinControl; Index: Integer;
|
||
ARect: TRect; State: TOwnerDrawState);
|
||
procedure CompletionLBKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||
procedure CorrectBookmark(Line, Delta: Integer);
|
||
procedure CorrectBreakPoints(Line, Delta: Integer);
|
||
procedure CreateSynArray(EndLine: Integer);
|
||
procedure DoBackspace;
|
||
procedure DoChange;
|
||
procedure DoChar(Ch: Char);
|
||
procedure DoCodeCompletion;
|
||
procedure DoCtrlI;
|
||
procedure DoCtrlU;
|
||
procedure DoCtrlR;
|
||
procedure DoCtrlL;
|
||
procedure DoDel;
|
||
procedure DoDown;
|
||
procedure DoEnd(Ctrl: Boolean);
|
||
procedure DoHome(Ctrl: Boolean);
|
||
procedure DoLeft;
|
||
procedure DoPgUp;
|
||
procedure DoPgDn;
|
||
procedure DoReturn;
|
||
procedure DoRight;
|
||
procedure DoUp;
|
||
procedure EnterIndent;
|
||
procedure LinesChange(Sender: TObject);
|
||
procedure SetActiveLine(Line: Integer);
|
||
procedure SetCommentAttr(Value: TFont);
|
||
procedure SetKeywordAttr(Value: TFont);
|
||
procedure SetNumberAttr(const Value: TFont);
|
||
procedure SetRunLine(Index: Integer; const Value: Boolean);
|
||
procedure SetSelText(const Value: String);
|
||
procedure SetShowGutter(Value: Boolean);
|
||
procedure SetStringAttr(Value: TFont);
|
||
procedure SetSyntax(const Value: String);
|
||
procedure SetText(Value: TStrings);
|
||
procedure SetTextAttr(Value: TFont);
|
||
procedure ShiftSelected(ShiftRight: Boolean);
|
||
procedure ShowCaretPos;
|
||
procedure TabIndent;
|
||
procedure UnIndent;
|
||
procedure UpdateScrollBar;
|
||
procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
|
||
procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
|
||
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
|
||
{ Inline IME realisation }
|
||
procedure WMIMEStartComp(var Message: TMessage); message WM_IME_STARTCOMPOSITION;
|
||
procedure WMIMEEndComp(var Message: TMessage); message WM_IME_ENDCOMPOSITION;
|
||
procedure WMIMECOMPOSITION (var Message: TMessage); message WM_IME_COMPOSITION ;
|
||
function GetTextSelected: Boolean;
|
||
protected
|
||
procedure DblClick; override;
|
||
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
||
procedure KeyPress(var Key: Char); override;
|
||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||
X, Y: Integer); override;
|
||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
||
X, Y: Integer); override;
|
||
procedure MouseWheelDown(Sender: TObject; Shift: TShiftState;
|
||
MousePos: TPoint; var Handled: Boolean);
|
||
procedure MouseWheelUp(Sender: TObject; Shift: TShiftState;
|
||
MousePos: TPoint; var Handled: Boolean);
|
||
procedure OnHScrollChange(Sender: TObject); override;
|
||
procedure OnVScrollChange(Sender: TObject); override;
|
||
procedure Resize; override;
|
||
public
|
||
constructor Create(AOwner: TComponent); override;
|
||
destructor Destroy; override;
|
||
procedure Paint; override;
|
||
procedure CopyToClipboard;
|
||
procedure CutToClipboard;
|
||
procedure PasteFromClipboard;
|
||
procedure SelectAll;
|
||
procedure SetPos(x, y: Integer);
|
||
procedure ShowMessage(const s: String);
|
||
procedure Undo;
|
||
procedure UpdateView;
|
||
function Find(const SearchText: String; CaseSensitive: Boolean;
|
||
var SearchFrom: Integer): Boolean;
|
||
function GetPlainPos: Integer;
|
||
function GetPos: TPoint;
|
||
function IsBookmark(Line: Integer): Integer;
|
||
procedure AddBookmark(Line, Number: Integer);
|
||
procedure DeleteBookmark(Number: Integer);
|
||
procedure GotoBookmark(Number: Integer);
|
||
procedure AddBreakPoint(Number: Integer; const Condition: String);
|
||
procedure ToggleBreakPoint(Number: Integer; const Condition: String);
|
||
procedure DeleteBreakPoint(Number: Integer);
|
||
procedure DeleteF4BreakPoints;
|
||
function IsBreakPoint(Number: Integer): Boolean;
|
||
function GetBreakPointCondition(Number: Integer): String;
|
||
|
||
property ActiveLine: Integer read FActiveLine write SetActiveLine;
|
||
property BlockColor: TColor read FBlockColor write FBlockColor;
|
||
property BlockFontColor: TColor read FBlockFontColor write FBlockFontColor;
|
||
property BreakPoints: TStringList read FBreakPoints;
|
||
property Color;
|
||
property CommentAttr: TFont read FCommentAttr write SetCommentAttr;
|
||
property Font;
|
||
property ImeMode;
|
||
property ImeName;
|
||
property GutterWidth: Integer read FGutterWidth write FGutterWidth;
|
||
property KeywordAttr: TFont read FKeywordAttr write SetKeywordAttr;
|
||
property Modified: Boolean read FModified write FModified;
|
||
property NumberAttr: TFont read FNumberAttr write SetNumberAttr;
|
||
property RunLine[Index: Integer]: Boolean read GetRunLine write SetRunLine;
|
||
property SelText: String read GetSelText write SetSelText;
|
||
property StringAttr: TFont read FStringAttr write SetStringAttr;
|
||
property TextAttr: TFont read FTextAttr write SetTextAttr;
|
||
property Lines: TStrings read GetText write SetText;
|
||
property Syntax: String read FSyntax write SetSyntax;
|
||
property ShowGutter: boolean read FShowGutter write SetShowGutter;
|
||
property TextSelected: Boolean read GetTextSelected;
|
||
property OnChangePos: TNotifyEvent read FOnChangePos write FOnChangePos;
|
||
property OnChangeText: TNotifyEvent read FOnChangeText write FOnChangeText;
|
||
property OnCodeCompletion: TfrxCodeCompletionEvent read FOnCodeCompletion
|
||
write FOnCodeCompletion;
|
||
property OnDragDrop;
|
||
property OnDragOver;
|
||
property OnKeyDown;
|
||
end;
|
||
|
||
|
||
implementation
|
||
|
||
|
||
uses Clipbrd, fs_itools, frxXML;
|
||
|
||
const
|
||
SQLKeywords =
|
||
'active,after,all,alter,and,any,as,asc,ascending,at,auto,' +
|
||
'base_name,before,begin,between,by,cache,call,cast,check,column,commit,' +
|
||
'committed,computed,conditional,constraint,containing,count,create,' +
|
||
'current,cursor,database,debug,declare,default,delete,desc,descending,' +
|
||
'distinct,do,domain,drop,else,end,entry_point,escape,exception,execute,' +
|
||
'exists,exit,external,extract,filter,for,foreign,from,full,function,' +
|
||
'generator,grant,group,having,if,in,inactive,index,inner,insert,into,is,' +
|
||
'isolation,join,key,left,level,like,merge,names,no,not,null,of,on,only,' +
|
||
'or,order,outer,parameter,password,plan,position,primary,privileges,' +
|
||
'procedure,protected,read,retain,returns,revoke,right,rollback,schema,' +
|
||
'select,set,shadow,shared,snapshot,some,suspend,table,then,to,' +
|
||
'transaction,trigger,uncommitted,union,unique,update,user,using,values,' +
|
||
'view,wait,when,where,while,with,work';
|
||
|
||
WordChars = ['a'..'z', 'A'..'Z', '<27>'..'<27>', '<27>'..'<27>', '0'..'9', '_'];
|
||
|
||
|
||
function IsUnicodeChar(Chr: Char): Boolean;
|
||
begin
|
||
Result := ((Chr >= Char($007F)) and (Chr <= Char($FFFF)));
|
||
end;
|
||
|
||
{ TfrxSyntaxMemo }
|
||
|
||
constructor TfrxSyntaxMemo.Create(AOwner: TComponent);
|
||
var
|
||
i: Integer;
|
||
begin
|
||
inherited;
|
||
FTmpCanvas := TBitmap.Create;
|
||
DoubleBuffered := True;
|
||
TabStop := True;
|
||
Cursor := crIBeam;
|
||
Color := clWindow;
|
||
|
||
FBreakPoints := TStringList.Create;
|
||
|
||
FBlockColor := clHighlight;
|
||
FBlockFontColor := clHighlightText;
|
||
|
||
FCommentAttr := TFont.Create;
|
||
FCommentAttr.Color := clNavy;
|
||
FCommentAttr.Style := [fsItalic];
|
||
|
||
FKeywordAttr := TFont.Create;
|
||
FKeywordAttr.Color := clWindowText;
|
||
FKeywordAttr.Style := [fsBold];
|
||
|
||
FNumberAttr := TFont.Create;
|
||
FNumberAttr.Color := clGreen;
|
||
FNumberAttr.Style := [];
|
||
|
||
FStringAttr := TFont.Create;
|
||
FStringAttr.Color := clNavy;
|
||
FStringAttr.Style := [];
|
||
|
||
FTextAttr := TFont.Create;
|
||
FTextAttr.Color := clWindowText;
|
||
FTextAttr.Style := [];
|
||
|
||
Font.Size := 10;
|
||
Font.Name := 'Courier New';
|
||
|
||
FText := TStringList.Create;
|
||
FParser := TfsParser.Create;
|
||
FParser.SkipSpace := False;
|
||
FParser.UseY := False;
|
||
FSynStrings := TStringList.Create;
|
||
FUndo := TStringList.Create;
|
||
FText.Add('');
|
||
FText.OnChange := LinesChange;
|
||
FMaxLength := 1024;
|
||
FMoved := True;
|
||
SetPos(1, 1);
|
||
|
||
ShowGutter := True;
|
||
OnMouseWheelUp := MouseWheelUp;
|
||
OnMouseWheelDown := MouseWheelDown;
|
||
|
||
FActiveLine := -1;
|
||
for i := 0 to 9 do
|
||
FBookmarks[i] := -1;
|
||
end;
|
||
|
||
destructor TfrxSyntaxMemo.Destroy;
|
||
begin
|
||
FTmpCanvas.Free;
|
||
FBreakPoints.Free;
|
||
FCommentAttr.Free;
|
||
FKeywordAttr.Free;
|
||
FNumberAttr.Free;
|
||
FStringAttr.Free;
|
||
FTextAttr.Free;
|
||
FText.Free;
|
||
FUndo.Free;
|
||
FSynStrings.Free;
|
||
FParser.Free;
|
||
inherited;
|
||
end;
|
||
|
||
{ updating IME string and carret pos }
|
||
procedure TfrxSyntaxMemo.WMIMECOMPOSITION(var Message: TMessage);
|
||
var
|
||
h: HIMC;
|
||
nLen, nPos: Integer;
|
||
StrBuf: String;
|
||
begin
|
||
if Message.LParam = $1E00 then
|
||
ResetImeComposition(CPS_CANCEL)
|
||
else
|
||
begin
|
||
h := Imm32GetContext(Handle);
|
||
if h <> 0 then
|
||
begin
|
||
nPos := Imm32GetCompositionString(h, GCS_CURSORPOS, nil, 0);
|
||
nLen := Imm32GetCompositionString(h, GCS_COMPSTR, nil, 0);
|
||
if nLen <> 0 then
|
||
begin
|
||
SetLength(StrBuf, nLen div 2);
|
||
Imm32GetCompositionString(h, GCS_COMPSTR, @StrBuf[1], nLen);
|
||
if (nLen div 2) > FCompSelEnd.X - FCompSelStart.X then
|
||
FCompSelEnd.X := FCompSelStart.X + (nLen div 2) - 1;
|
||
FSelStart.Y := FCompSelStart.Y;
|
||
FSelStart.X := FCompSelStart.X;
|
||
FSelEnd.Y := FCompSelEnd.Y;
|
||
FSelEnd.X := FCompSelEnd.X;
|
||
SelText := StrBuf;
|
||
FPos.X := FCompSelStart.X + nPos;
|
||
SetPos(FPos.X, FPos.Y);
|
||
FCompSelEnd.X := FCompSelStart.X + (nLen div 2);
|
||
Invalidate;
|
||
end;
|
||
Imm32ReleaseContext(Handle, h);
|
||
end;
|
||
Inherited;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.WMIMEEndComp(var Message: TMessage);
|
||
begin
|
||
FInImeComposition := False;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.WMIMEStartComp(var Message: TMessage);
|
||
begin
|
||
FCompSelStart.Y := FPos.Y;
|
||
FCompSelStart.X := FPos.X;
|
||
FCompSelEnd.Y := FPos.Y;
|
||
FCompSelEnd.X := FPos.X;
|
||
FInImeComposition := True;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.WMKillFocus(var Msg: TWMKillFocus);
|
||
begin
|
||
inherited;
|
||
HideCaret(Handle);
|
||
DestroyCaret;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.WMSetFocus(var Msg: TWMSetFocus);
|
||
begin
|
||
inherited;
|
||
CreateCaret(Handle, 0, 2, FCharHeight);
|
||
ShowCaretPos;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.ShowCaretPos;
|
||
var
|
||
cWidth: Integer;
|
||
begin
|
||
if FPos.X > FOffset.X then
|
||
begin
|
||
if Length(Lines[FPos.Y - 1]) > FPos.X then
|
||
cWidth := GetCharWidth(Copy(Lines[FPos.Y - 1], 1, FPos.X - 1 - FOffset.X))
|
||
else
|
||
cWidth := FCharWidth * (FPos.X - 1 - FOffset.X);
|
||
SetCaretPos(cWidth + FGutterWidth,
|
||
FCharHeight * (FPos.Y - 1 - FOffset.Y));
|
||
ShowCaret(Handle);
|
||
end
|
||
else
|
||
SetCaretPos(-100, -100);
|
||
if Assigned(FOnChangePos) then
|
||
FOnChangePos(Self);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.CMFontChanged(var Message: TMessage);
|
||
var
|
||
b: TBitmap;
|
||
begin
|
||
FCommentAttr.Size := Font.Size;
|
||
FCommentAttr.Name := Font.Name;
|
||
FKeywordAttr.Size := Font.Size;
|
||
FKeywordAttr.Name := Font.Name;
|
||
FNumberAttr.Size := Font.Size;
|
||
FNumberAttr.Name := Font.Name;
|
||
FStringAttr.Size := Font.Size;
|
||
FStringAttr.Name := Font.Name;
|
||
FTextAttr.Size := Font.Size;
|
||
FTextAttr.Name := Font.Name;
|
||
|
||
b := TBitmap.Create;
|
||
with b.Canvas do
|
||
begin
|
||
Font.Assign(Self.Font);
|
||
Font.Style := [fsBold];
|
||
FCharHeight := TextHeight('Wg') + 1;
|
||
FCharWidth := TextWidth('W');
|
||
FIsMonoType := Pos('COURIER NEW', AnsiUppercase(Self.Font.Name)) <> 0;
|
||
end;
|
||
b.Free;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.Resize;
|
||
begin
|
||
inherited;
|
||
if FCharWidth = 0 then Exit;
|
||
FWindowSize := Point((ClientWidth - FGutterWidth) div FCharWidth,
|
||
ClientHeight div FCharHeight);
|
||
HorzPage := FWindowSize.X;
|
||
VertPage := FWindowSize.Y;
|
||
UpdateScrollBar;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.UpdateScrollBar;
|
||
begin
|
||
VertRange := FText.Count;
|
||
HorzRange := FMaxLength;
|
||
LargeChange := FWindowSize.Y;
|
||
VertPosition := FOffset.Y;
|
||
HorzPosition := FOffset.X;
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.GetText: TStrings;
|
||
//var
|
||
// i: Integer;
|
||
begin
|
||
// FAllowLinesChange := False;
|
||
// for i := 0 to FText.Count - 1 do
|
||
// FText[i] := LineAt(i);
|
||
Result := FText;
|
||
FAllowLinesChange := True;
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.GetPlainPos: Integer;
|
||
begin
|
||
Result := GetPlainTextPos(FPos);
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.GetPos: TPoint;
|
||
begin
|
||
Result := FPos;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.SetText(Value: TStrings);
|
||
begin
|
||
FAllowLinesChange := True;
|
||
FText.Assign(Value);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.SetSyntax(const Value: String);
|
||
var
|
||
sl: TStringList;
|
||
|
||
procedure GetGrammar;
|
||
var
|
||
Grammar: TfrxXMLDocument;
|
||
ss: TStringStream;
|
||
ParserRoot, xi: TfrxXMLItem;
|
||
i: Integer;
|
||
Name, PropText: String;
|
||
begin
|
||
Grammar := TfrxXMLDocument.Create;
|
||
ss := TStringStream.Create(fsGetLanguage(Value), TEncoding.UTF8);
|
||
Grammar.LoadFromStream(ss);
|
||
ss.Free;
|
||
|
||
ParserRoot := Grammar.Root.FindItem('parser');
|
||
xi := ParserRoot.FindItem('keywords');
|
||
for i := 0 to xi.Count - 1 do
|
||
FParser.Keywords.Add(xi[i].Name);
|
||
|
||
for i := 0 to ParserRoot.Count - 1 do
|
||
begin
|
||
Name := LowerCase(ParserRoot[i].Name);
|
||
PropText := ParserRoot[i].Prop['text'];
|
||
if Name = 'identchars' then
|
||
FParser.ConstructCharset(PropText)
|
||
else if Name = 'commentline1' then
|
||
FParser.CommentLine1 := PropText
|
||
else if Name = 'commentline2' then
|
||
FParser.CommentLine2 := PropText
|
||
else if Name = 'commentblock1' then
|
||
FParser.CommentBlock1 := PropText
|
||
else if Name = 'commentblock2' then
|
||
FParser.CommentBlock2 := PropText
|
||
else if Name = 'stringquotes' then
|
||
FParser.StringQuotes := PropText
|
||
else if Name = 'hexsequence' then
|
||
FParser.HexSequence := PropText
|
||
end;
|
||
|
||
Grammar.Free;
|
||
end;
|
||
|
||
begin
|
||
FSyntax := Value;
|
||
FParser.Keywords.Clear;
|
||
sl := TStringList.Create;
|
||
if AnsiCompareText(Value, 'SQL') = 0 then
|
||
begin
|
||
sl.CommaText := SQLKeywords;
|
||
FParser.Keywords.Assign(sl);
|
||
FParser.CommentLine1 := '--';
|
||
FParser.CommentLine2 := '';
|
||
FParser.CommentBlock1 := '/*,*/';
|
||
FParser.CommentBlock2 := '';
|
||
FParser.StringQuotes := '"';
|
||
FParser.HexSequence := '0x';
|
||
end
|
||
else
|
||
begin
|
||
fsGetLanguageList(sl);
|
||
if sl.IndexOf(Value) <> -1 then
|
||
GetGrammar;
|
||
end;
|
||
|
||
ClearSyntax(1);
|
||
sl.Free;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.SetCommentAttr(Value: TFont);
|
||
begin
|
||
FCommentAttr.Assign(Value);
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.SetKeywordAttr(Value: TFont);
|
||
begin
|
||
FKeywordAttr.Assign(Value);
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.SetNumberAttr(const Value: TFont);
|
||
begin
|
||
FNumberAttr.Assign(Value);
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.SetStringAttr(Value: TFont);
|
||
begin
|
||
FStringAttr.Assign(Value);
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.SetTextAttr(Value: TFont);
|
||
begin
|
||
FTextAttr.Assign(Value);
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.SetActiveLine(Line: Integer);
|
||
begin
|
||
FActiveLine := Line;
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoChange;
|
||
begin
|
||
FModified := True;
|
||
if Assigned(FOnChangeText) then
|
||
FOnChangeText(Self);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.LinesChange(Sender: TObject);
|
||
begin
|
||
if FAllowLinesChange then
|
||
begin
|
||
FAllowLinesChange := False;
|
||
if FText.Count = 0 then
|
||
FText.Add('');
|
||
ClearSyntax(1);
|
||
FMoved := True;
|
||
FUndo.Clear;
|
||
FPos := Point(1, 1);
|
||
FOffset := Point(0, 0);
|
||
ClearSel;
|
||
ShowCaretPos;
|
||
UpdateScrollBar;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.ShowMessage(const s: String);
|
||
begin
|
||
FMessage := s;
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.CopyToClipboard;
|
||
begin
|
||
if FSelStart.X <> 0 then
|
||
Clipboard.AsText := SelText;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.CutToClipboard;
|
||
begin
|
||
if FSelStart.X <> 0 then
|
||
begin
|
||
Clipboard.AsText := SelText;
|
||
SelText := '';
|
||
end;
|
||
CorrectBookmark(FSelStart.Y, FSelStart.Y - FSelEnd.Y);
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.PasteFromClipboard;
|
||
begin
|
||
SelText := Clipboard.AsText;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.SelectAll;
|
||
begin
|
||
SetPos(0, 0);
|
||
FSelStart := FPos;
|
||
SetPos(LineLength(FText.Count - 1) + 1, FText.Count);
|
||
FSelEnd := FPos;
|
||
Repaint;
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.LineAt(Index: Integer): String;
|
||
begin
|
||
if Index < FText.Count then
|
||
Result := TrimRight(FText[Index])
|
||
else
|
||
Result := '';
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.LineLength(Index: Integer): Integer;
|
||
begin
|
||
Result := Length(LineAt(Index));
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.Pad(n: Integer): String;
|
||
begin
|
||
Result := '';
|
||
SetLength(Result, n);
|
||
Result := StringOfChar(Char(' '), n);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.AddUndo;
|
||
begin
|
||
if not FMoved then exit;
|
||
FUndo.Add(Format('%5d%5d', [FPos.X, FPos.Y]) + FText.Text);
|
||
if FUndo.Count > 32 then
|
||
FUndo.Delete(0);
|
||
FMoved := False;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.Undo;
|
||
var
|
||
s: String;
|
||
begin
|
||
FMoved := True;
|
||
if FUndo.Count = 0 then exit;
|
||
s := FUndo[FUndo.Count - 1];
|
||
FPos.X := StrToInt(Copy(s, 1, 5));
|
||
FPos.Y := StrToInt(Copy(s, 6, 5));
|
||
FAllowLinesChange := False;
|
||
FText.Text := Copy(s, 11, Length(s) - 10);
|
||
FAllowLinesChange := True;
|
||
FUndo.Delete(FUndo.Count - 1);
|
||
SetPos(FPos.X, FPos.Y);
|
||
ClearSyntax(1);
|
||
DoChange;
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.GetPlainTextPos(Pos: TPoint): Integer;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := 0;
|
||
for i := 0 to Pos.Y - 2 do
|
||
Result := Result + Length(FText[i]) + 2;
|
||
Result := Result + Pos.X;
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.GetPosPlainText(Pos: Integer): TPoint;
|
||
var
|
||
i: Integer;
|
||
s: String;
|
||
begin
|
||
Result := Point(0, 1);
|
||
s := FText.Text;
|
||
i := 1;
|
||
while i <= Pos do
|
||
if s[i] = #13 then
|
||
begin
|
||
Inc(i, 2);
|
||
if i <= Pos then
|
||
begin
|
||
Inc(Result.Y);
|
||
Result.X := 0;
|
||
end
|
||
else
|
||
Inc(Result.X);
|
||
end
|
||
else
|
||
begin
|
||
Inc(i);
|
||
Inc(Result.X);
|
||
end;
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.GetLineBegin(Index: Integer): Integer;
|
||
var
|
||
s: String;
|
||
begin
|
||
s := FText[Index];
|
||
Result := 1;
|
||
if Trim(s) <> '' then
|
||
for Result := 1 to Length(s) do
|
||
if s[Result] <> ' ' then
|
||
break;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.TabIndent;
|
||
begin
|
||
SelText := Pad((FPos.X div 8 + 1) * 8 - FPos.X);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.EnterIndent;
|
||
var
|
||
res: Integer;
|
||
begin
|
||
if Trim(FText[FPos.Y - 1]) = '' then
|
||
res := FPos.X else
|
||
res := GetLineBegin(FPos.Y - 1);
|
||
|
||
if FPos.X = 1 then
|
||
CorrectBookmark(FPos.Y - 1, 1) else
|
||
CorrectBookmark(FPos.Y, 1);
|
||
|
||
FPos := Point(1, FPos.Y + 1);
|
||
SelText := Pad(res - 1);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.UnIndent;
|
||
var
|
||
i, res: Integer;
|
||
begin
|
||
i := FPos.Y - 2;
|
||
res := FPos.X - 1;
|
||
CorrectBookmark(FPos.Y, -1);
|
||
while i >= 0 do
|
||
begin
|
||
res := GetLineBegin(i);
|
||
if (res < FPos.X) and (Trim(FText[i]) <> '') then
|
||
break else
|
||
Dec(i);
|
||
end;
|
||
FSelStart := FPos;
|
||
FSelEnd := FPos;
|
||
Dec(FSelEnd.X, FPos.X - res);
|
||
SelText := '';
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.ShiftSelected(ShiftRight: Boolean);
|
||
var
|
||
i, ib, ie: Integer;
|
||
s: String;
|
||
Shift: Integer;
|
||
begin
|
||
AddUndo;
|
||
if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
|
||
begin
|
||
ib := FSelStart.Y - 1;
|
||
ie := FSelEnd.Y - 1;
|
||
end
|
||
else
|
||
begin
|
||
ib := FSelEnd.Y - 1;
|
||
ie := FSelStart.Y - 1;
|
||
end;
|
||
if FSelEnd.X = 1 then
|
||
Dec(ie);
|
||
|
||
Shift := 2;
|
||
if not ShiftRight then
|
||
for i := ib to ie do
|
||
begin
|
||
s := FText[i];
|
||
if (Trim(s) <> '') and (GetLineBegin(i) - 1 < Shift) then
|
||
Shift := GetLineBegin(i) - 1;
|
||
end;
|
||
|
||
for i := ib to ie do
|
||
begin
|
||
s := FText[i];
|
||
if ShiftRight then
|
||
s := Pad(Shift) + s
|
||
else if Trim(s) <> '' then
|
||
Delete(s, 1, Shift);
|
||
FText[i] := s;
|
||
end;
|
||
|
||
ClearSyntax(FSelStart.Y);
|
||
DoChange;
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.GetSelText: String;
|
||
var
|
||
p1, p2: TPoint;
|
||
i: Integer;
|
||
begin
|
||
if FSelStart.X = 0 then
|
||
begin
|
||
Result := '';
|
||
Exit;
|
||
end;
|
||
|
||
if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
|
||
begin
|
||
p1 := FSelStart;
|
||
p2 := FSelEnd;
|
||
Dec(p2.X);
|
||
end
|
||
else
|
||
begin
|
||
p1 := FSelEnd;
|
||
p2 := FSelStart;
|
||
Dec(p2.X);
|
||
end;
|
||
|
||
if LineLength(p1.Y - 1) < p1.X then
|
||
begin
|
||
Inc(p1.Y);
|
||
p1.X := 1;
|
||
end;
|
||
if LineLength(p2.Y - 1) < p2.X then
|
||
p2.X := LineLength(p2.Y - 1);
|
||
|
||
i := GetPlainTextPos(p1);
|
||
Result := Copy(FText.Text, i, GetPlainTextPos(p2) - i + 1);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.SetSelText(const Value: String);
|
||
var
|
||
p1, p2, p3: TPoint;
|
||
i: Integer;
|
||
s: String;
|
||
begin
|
||
AddUndo;
|
||
if FSelStart.X = 0 then
|
||
begin
|
||
p1 := FPos;
|
||
p2 := p1;
|
||
Dec(p2.X);
|
||
end
|
||
else if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
|
||
begin
|
||
p1 := FSelStart;
|
||
p2 := FSelEnd;
|
||
Dec(p2.X);
|
||
end
|
||
else
|
||
begin
|
||
p1 := FSelEnd;
|
||
p2 := FSelStart;
|
||
Dec(p2.X);
|
||
end;
|
||
FAllowLinesChange := False;
|
||
if LineLength(p1.Y - 1) < p1.X then
|
||
FText[p1.Y - 1] := FText[p1.Y - 1] + Pad(p1.X - LineLength(p1.Y - 1) + 1);
|
||
if LineLength(p2.Y - 1) < p2.X then
|
||
p2.X := LineLength(p2.Y - 1);
|
||
|
||
i := GetPlainTextPos(p1);
|
||
s := FText.Text;
|
||
Delete(s, i, GetPlainTextPos(p2) - i + 1);
|
||
Insert(Value, s, i);
|
||
FText.Text := s;
|
||
p3 := GetPosPlainText(i + Length(Value));
|
||
FAllowLinesChange := True;
|
||
CorrectBookmark(FPos.Y, p3.y - FPos.Y);
|
||
|
||
SetPos(p3.X, p3.Y);
|
||
FSelStart.X := 0;
|
||
DoChange;
|
||
i := p3.Y;
|
||
if p2.Y < i then
|
||
i := p2.Y;
|
||
if p1.Y < i then
|
||
i := p1.Y;
|
||
ClearSyntax(i);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.ClearSel;
|
||
begin
|
||
if FSelStart.X <> 0 then
|
||
begin
|
||
FSelStart := Point(0, 0);
|
||
Repaint;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.AddSel;
|
||
begin
|
||
if FSelStart.X = 0 then
|
||
FSelStart := FTempPos;
|
||
FSelEnd := FPos;
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.SetPos(x, y: Integer);
|
||
begin
|
||
if FMessage <> '' then
|
||
begin
|
||
FMessage := '';
|
||
Repaint;
|
||
end;
|
||
|
||
if x > FMaxLength then x := FMaxLength;
|
||
if x < 1 then x := 1;
|
||
if y > FText.Count then y := FText.Count;
|
||
if y < 1 then y := 1;
|
||
|
||
FPos := Point(x, y);
|
||
if (FWindowSize.X = 0) or (FWindowSize.Y = 0) then exit;
|
||
|
||
if FOffset.Y >= FText.Count then
|
||
FOffset.Y := FText.Count - 1;
|
||
|
||
if FPos.X > FOffset.X + FWindowSize.X then
|
||
begin
|
||
Inc(FOffset.X, FPos.X - (FOffset.X + FWindowSize.X));
|
||
Repaint;
|
||
end
|
||
else if FPos.X <= FOffset.X then
|
||
begin
|
||
Dec(FOffset.X, FOffset.X - FPos.X + 1);
|
||
Repaint;
|
||
end
|
||
else if FPos.Y > FOffset.Y + FWindowSize.Y then
|
||
begin
|
||
Inc(FOffset.Y, FPos.Y - (FOffset.Y + FWindowSize.Y));
|
||
Repaint;
|
||
end
|
||
else if FPos.Y <= FOffset.Y then
|
||
begin
|
||
Dec(FOffset.Y, FOffset.Y - FPos.Y + 1);
|
||
Repaint;
|
||
end;
|
||
|
||
ShowCaretPos;
|
||
UpdateScrollBar;
|
||
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.OnHScrollChange(Sender: TObject);
|
||
begin
|
||
FOffset.X := HorzPosition;
|
||
if FOffset.X > 1024 then
|
||
FOffset.X := 1024;
|
||
ShowCaretPos;
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.OnVScrollChange(Sender: TObject);
|
||
begin
|
||
FOffset.Y := VertPosition;
|
||
if FOffset.Y > FText.Count then
|
||
FOffset.Y := FText.Count;
|
||
ShowCaretPos;
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DblClick;
|
||
var
|
||
s: String;
|
||
begin
|
||
FDoubleClicked := True;
|
||
DoCtrlL;
|
||
FSelStart := FPos;
|
||
s := LineAt(FPos.Y - 1);
|
||
if s <> '' then
|
||
while CharInSet(s[FPos.X], WordChars)
|
||
or IsUnicodeChar(s[FPos.X]) do
|
||
Inc(FPos.X);
|
||
FSelEnd := FPos;
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||
X, Y: Integer);
|
||
begin
|
||
if FDoubleClicked then
|
||
begin
|
||
FDoubleClicked := False;
|
||
Exit;
|
||
end;
|
||
|
||
FMoved := True;
|
||
if not Focused then
|
||
SetFocus;
|
||
FDown := True;
|
||
if X < FGutterWidth then
|
||
FToggleBreakPointDown := True;
|
||
X := (X - FGutterWidth) div FCharWidth + 1 + FOffset.X;
|
||
Y := Y div FCharHeight + 1 + FOffset.Y;
|
||
FTempPos := FPos;
|
||
SetPos(X, Y);
|
||
if ssShift in Shift then
|
||
AddSel
|
||
else
|
||
ClearSel;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||
begin
|
||
if FDown then
|
||
begin
|
||
FTempPos := FPos;
|
||
FPos.X := (X - FGutterWidth) div FCharWidth + 1 + FOffset.X;
|
||
FPos.Y := Y div FCharHeight + 1 + FOffset.Y;
|
||
if (FPos.X <> FTempPos.X) or (FPos.Y <> FTempPos.Y) then
|
||
begin
|
||
SetPos(FPos.X, FPos.Y);
|
||
AddSel;
|
||
end;
|
||
end;
|
||
|
||
if X < FGutterWidth then
|
||
Cursor := crArrow
|
||
else
|
||
Cursor := crIBeam;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
||
X, Y: Integer);
|
||
begin
|
||
FDown := False;
|
||
if (X < FGutterWidth) and (FToggleBreakPointDown) then
|
||
ToggleBreakPoint(FPos.Y, '');
|
||
FToggleBreakPointDown := False;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.KeyDown(var Key: Word; Shift: TShiftState);
|
||
var
|
||
MyKey: Boolean;
|
||
TempPos: Tpoint;
|
||
begin
|
||
inherited;
|
||
FAllowLinesChange := False;
|
||
|
||
FTempPos := FPos;
|
||
MyKey := True;
|
||
case Key of
|
||
vk_Left:
|
||
if ssCtrl in Shift then
|
||
DoCtrlL else
|
||
DoLeft;
|
||
|
||
vk_Right:
|
||
if ssCtrl in Shift then
|
||
DoCtrlR else
|
||
DoRight;
|
||
|
||
vk_Up:
|
||
DoUp;
|
||
|
||
vk_Down:
|
||
DoDown;
|
||
|
||
vk_Home:
|
||
DoHome(ssCtrl in Shift);
|
||
|
||
vk_End:
|
||
DoEnd(ssCtrl in Shift);
|
||
|
||
vk_Prior:
|
||
DoPgUp;
|
||
|
||
vk_Next:
|
||
DoPgDn;
|
||
|
||
vk_Return:
|
||
if Shift = [] then
|
||
DoReturn;
|
||
|
||
vk_Delete:
|
||
begin
|
||
if ssCtrl in Shift then // Ctrl+Del delete word before cursor
|
||
begin
|
||
TempPos := FPos;
|
||
Inc(FPos.X);
|
||
DblClick;
|
||
FDoubleClicked := False;
|
||
if FSelEnd.X <= TempPos.X then
|
||
begin
|
||
FSelStart := TempPos;
|
||
FSelEnd := TempPos;
|
||
dec(FSelStart.X);
|
||
end;
|
||
end;
|
||
if ssShift in Shift then
|
||
CutToClipboard else
|
||
DoDel;
|
||
end;
|
||
|
||
vk_Back:
|
||
begin
|
||
if ssCtrl in Shift then // Ctrl+BackSpace delete word after cursor
|
||
begin
|
||
DblClick;
|
||
FDoubleClicked := False;
|
||
end;
|
||
DoBackspace;
|
||
end;
|
||
|
||
vk_Insert:
|
||
if ssCtrl in Shift then
|
||
CopyToClipboard
|
||
else if ssShift in Shift then
|
||
PasteFromClipboard;
|
||
|
||
vk_Tab:
|
||
TabIndent;
|
||
|
||
else
|
||
MyKey := False;
|
||
end;
|
||
|
||
if Shift = [ssCtrl] then
|
||
if Key = 65 then // Ctrl+A Select all
|
||
begin
|
||
SelectAll;
|
||
end
|
||
else if Key = 89 then // Ctrl+Y Delete line
|
||
begin
|
||
if FText.Count > FPos.Y then
|
||
begin
|
||
FMoved := True;
|
||
AddUndo;
|
||
FText.Delete(FPos.Y - 1);
|
||
CorrectBookmark(FPos.Y, -1);
|
||
DoChange;
|
||
end
|
||
else if FText.Count = FPos.Y then
|
||
begin
|
||
FMoved := True;
|
||
AddUndo;
|
||
FText[FPos.Y - 1] := '';
|
||
FPos.X := 1;
|
||
SetPos(FPos.X, FPos.Y);
|
||
DoChange;
|
||
end;
|
||
ClearSyntax(FPos.Y);
|
||
end
|
||
else if Key in [48..57] then
|
||
GotoBookmark(Key - 48)
|
||
else if Key = 32 then // Ctrl+Space code completion
|
||
begin
|
||
if Assigned(FOnCodeCompletion) then
|
||
DoCodeCompletion;
|
||
MyKey := True;
|
||
end
|
||
else if Key = Ord('C') then
|
||
begin
|
||
CopyToClipboard;
|
||
MyKey := True;
|
||
end
|
||
else if Key = Ord('V') then
|
||
begin
|
||
PasteFromClipboard;
|
||
MyKey := True;
|
||
end
|
||
else if Key = Ord('X') then
|
||
begin
|
||
CutToClipboard;
|
||
MyKey := True;
|
||
end
|
||
else if Key = Ord('I') then
|
||
begin
|
||
DoCtrlI;
|
||
MyKey := True;
|
||
end
|
||
else if Key = Ord('U') then
|
||
begin
|
||
DoCtrlU;
|
||
MyKey := True;
|
||
end
|
||
else if Key = Ord('Z') then
|
||
begin
|
||
Undo;
|
||
MyKey := True;
|
||
end;
|
||
|
||
if Shift = [ssCtrl, ssShift] then
|
||
if Key in [48..57] then
|
||
if IsBookmark(FPos.Y - 1) < 0 then
|
||
AddBookmark(FPos.Y - 1, Key - 48)
|
||
else if IsBookmark(FPos.Y - 1) = (Key - 48) then
|
||
DeleteBookmark(Key - 48);
|
||
|
||
if Key in [vk_Left, vk_Right, vk_Up, vk_Down, vk_Home, vk_End, vk_Prior, vk_Next] then
|
||
begin
|
||
FMoved := True;
|
||
if ssShift in Shift then
|
||
AddSel else
|
||
ClearSel;
|
||
end
|
||
else if Key in [vk_Return, vk_Delete, vk_Back, vk_Insert, vk_Tab] then
|
||
FMoved := True;
|
||
|
||
if MyKey then
|
||
Key := 0;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.KeyPress(var Key: Char);
|
||
var
|
||
MyKey, ControlKeyDown: Boolean;
|
||
begin
|
||
inherited;
|
||
|
||
ControlKeyDown := (((GetKeyState(VK_LCONTROL) and not $7FFF) <> 0) or
|
||
((GetKeyState(VK_RCONTROL) and not $7FFF) <> 0)) and
|
||
(GetKeyState(VK_RMENU) >= 0);
|
||
MyKey := True;
|
||
|
||
if ((Key = #32) and not ControlKeyDown) or (CharInSet(Key, [#33..#255]))
|
||
or IsUnicodeChar(Key) and not((Key = #127) and ControlKeyDown) then
|
||
begin
|
||
DoChar(Key);
|
||
FMoved := False;
|
||
end
|
||
else
|
||
MyKey := False;
|
||
|
||
if MyKey then
|
||
Key := #0;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoCodeCompletion;
|
||
var
|
||
p: TPoint;
|
||
|
||
function GetCompletionString: String;
|
||
var
|
||
i: Integer;
|
||
s: String;
|
||
fl1, fl2: Boolean;
|
||
fl3, fl4: Integer;
|
||
begin
|
||
Result := '';
|
||
s := LineAt(FPos.Y - 1);
|
||
s := Trim(Copy(s, 1, FPos.X));
|
||
|
||
fl1 := False;
|
||
fl2 := False;
|
||
fl3 := 0;
|
||
fl4 := 0;
|
||
|
||
i := Length(s);
|
||
while i > 1 do
|
||
begin
|
||
Dec(i);
|
||
if (s[i] = '''') and not fl2 then
|
||
fl1 := not fl1
|
||
else if (s[i] = '"') and not fl1 then
|
||
fl2 := not fl2
|
||
else if not fl1 and not fl2 and (s[i] = ')') then
|
||
Inc(fl3)
|
||
else if not fl1 and not fl2 and (s[i] = '(') and (fl3 > 0) then
|
||
Dec(fl3)
|
||
else if not fl1 and not fl2 and (s[i] = ']') then
|
||
Inc(fl4)
|
||
else if not fl1 and not fl2 and (s[i] = '[') and (fl4 > 0) then
|
||
Dec(fl4)
|
||
else if not fl1 and not fl2 and (fl3 = 0) and (fl4 = 0) then
|
||
if CharInSet(s[i], ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', ' '])
|
||
or IsUnicodeChar(s[i]) then
|
||
Result := s[i] + Result
|
||
else
|
||
break;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
FCompletionForm := TfrxPopupForm.Create(Self);
|
||
FCompletionLB := TListBox.Create(FCompletionForm);
|
||
with FCompletionLB do
|
||
begin
|
||
Parent := FCompletionForm;
|
||
Ctl3D := False;
|
||
Align := alClient;
|
||
ItemHeight := ItemHeight + 2;
|
||
Style := lbOwnerDrawFixed;
|
||
Sorted := True;
|
||
OnDblClick := CompletionLBDblClick;
|
||
OnKeyDown := CompletionLBKeyDown;
|
||
OnDrawItem := CompletionLBDrawItem;
|
||
if Assigned(FOnCodeCompletion) then
|
||
FOnCodeCompletion(GetCompletionString, Items);
|
||
|
||
p := Self.ClientToScreen(
|
||
Point(FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth,
|
||
FCharHeight * (FPos.Y - FOffset.Y)));
|
||
FCompletionForm.SetBounds(p.X, p.Y, 300, 100);
|
||
FCompletionForm.Show;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.CompletionLBDblClick(Sender: TObject);
|
||
var
|
||
s, s1: String;
|
||
i: Integer;
|
||
stepBack: Boolean;
|
||
begin
|
||
if FCompletionLB.ItemIndex <> -1 then
|
||
begin
|
||
s := FCompletionLB.Items[FCompletionLB.ItemIndex];
|
||
i := 2;
|
||
while (i <= Length(s)) and ((CharInSet(s[i], WordChars) or IsUnicodeChar(s[i]))) do
|
||
Inc(i);
|
||
s1 := Copy(s, 1, i - 1);
|
||
stepBack := (i <= Length(s)) and (s[i] = '(');
|
||
if stepBack then
|
||
s1 := s1 + '()';
|
||
SelText := s1;
|
||
if stepBack then
|
||
DoLeft;
|
||
end;
|
||
FCompletionForm.Close;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.CompletionLBKeyDown(Sender: TObject; var Key: Word;
|
||
Shift: TShiftState);
|
||
begin
|
||
if Key = VK_ESCAPE then
|
||
FCompletionForm.Close;
|
||
if Key = VK_RETURN then
|
||
CompletionLBDblClick(nil);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.CompletionLBDrawItem(Control: TWinControl; Index: Integer;
|
||
ARect: TRect; State: TOwnerDrawState);
|
||
var
|
||
i, w: Integer;
|
||
s: String;
|
||
begin
|
||
with FCompletionLB.Canvas do
|
||
begin
|
||
FillRect(ARect);
|
||
if Index <> -1 then
|
||
begin
|
||
i := Integer(FCompletionLB.Items.Objects[Index]);
|
||
s := '';
|
||
Font.Color := clFuchsia;
|
||
if Pos('Constructor', FCompletionLB.Items[Index]) <> 0 then
|
||
s := 'constructor'
|
||
else
|
||
case i of
|
||
0: begin s := 'var'; Font.Color := clBlue; end;
|
||
1: begin s := 'property'; Font.Color := clBlue; end;
|
||
2: s := 'procedure';
|
||
3: s := 'function';
|
||
end;
|
||
|
||
if odSelected in State then
|
||
Font.Color := clWhite;
|
||
Font.Style := [];
|
||
TextOut(ARect.Left + 2, ARect.Top + 2, s);
|
||
w := TextWidth('constructor');
|
||
Font.Color := clBlack;
|
||
if odSelected in State then
|
||
Font.Color := clWhite;
|
||
Font.Style := [fsBold];
|
||
s := FCompletionLB.Items[Index];
|
||
i := 1;
|
||
while (i <= Length(s)) and ((CharInSet(s[i], WordChars))
|
||
or IsUnicodeChar(s[i])) do
|
||
Inc(i);
|
||
s := Copy(s, 1, i - 1);
|
||
TextOut(ARect.Left + w + 6, ARect.Top + 2, s);
|
||
w := w + TextWidth(s);
|
||
Font.Style := [];
|
||
s := Copy(FCompletionLB.Items[Index], i, 255);
|
||
if Pos(': Constructor', s) <> 0 then
|
||
s := Copy(s, 1, Pos(': Constructor', s) - 1);
|
||
TextOut(ARect.Left + w + 6, ARect.Top + 2, s);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoLeft;
|
||
begin
|
||
Dec(FPos.X);
|
||
if FPos.X < 1 then
|
||
FPos.X := 1;
|
||
SetPos(FPos.X, FPos.Y);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoRight;
|
||
begin
|
||
Inc(FPos.X);
|
||
if FPos.X > FMaxLength then
|
||
FPos.X := FMaxLength;
|
||
SetPos(FPos.X, FPos.Y);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoUp;
|
||
begin
|
||
Dec(FPos.Y);
|
||
if FPos.Y < 1 then
|
||
FPos.Y := 1;
|
||
SetPos(FPos.X, FPos.Y);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoDown;
|
||
begin
|
||
Inc(FPos.Y);
|
||
if FPos.Y > FText.Count then
|
||
FPos.Y := FText.Count;
|
||
SetPos(FPos.X, FPos.Y);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoHome(Ctrl: Boolean);
|
||
begin
|
||
if Ctrl then
|
||
SetPos(1, 1) else
|
||
SetPos(1, FPos.Y);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoEnd(Ctrl: Boolean);
|
||
begin
|
||
if Ctrl then
|
||
SetPos(LineLength(FText.Count - 1) + 1, FText.Count) else
|
||
SetPos(LineLength(FPos.Y - 1) + 1, FPos.Y);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoPgUp;
|
||
begin
|
||
if FOffset.Y > FWindowSize.Y then
|
||
begin
|
||
Dec(FOffset.Y, FWindowSize.Y - 1);
|
||
Dec(FPos.Y, FWindowSize.Y - 1);
|
||
end
|
||
else
|
||
begin
|
||
if FOffset.Y > 0 then
|
||
begin
|
||
Dec(FPos.Y, FOffset.Y);
|
||
FOffset.Y := 0;
|
||
end
|
||
else
|
||
FPos.Y := 1;
|
||
end;
|
||
SetPos(FPos.X, FPos.Y);
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoPgDn;
|
||
begin
|
||
if FOffset.Y + FWindowSize.Y < FText.Count then
|
||
begin
|
||
Inc(FOffset.Y, FWindowSize.Y - 1);
|
||
Inc(FPos.Y, FWindowSize.Y - 1);
|
||
end
|
||
else
|
||
begin
|
||
FOffset.Y := FText.Count;
|
||
FPos.Y := FText.Count;
|
||
end;
|
||
SetPos(FPos.X, FPos.Y);
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoReturn;
|
||
var
|
||
s: String;
|
||
begin
|
||
s := LineAt(FPos.Y - 1);
|
||
FText[FPos.Y - 1] := Copy(s, 1, FPos.X - 1);
|
||
FText.Insert(FPos.Y, Copy(s, FPos.X, FMaxLength));
|
||
EnterIndent;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoDel;
|
||
var
|
||
s: String;
|
||
begin
|
||
FMessage := '';
|
||
if FSelStart.X <> 0 then
|
||
SelText := ''
|
||
else
|
||
begin
|
||
s := FText[FPos.Y - 1];
|
||
AddUndo;
|
||
if FPos.X <= LineLength(FPos.Y - 1) then
|
||
begin
|
||
Delete(s, FPos.X, 1);
|
||
FText[FPos.Y - 1] := s;
|
||
end
|
||
else if FPos.Y < FText.Count then
|
||
begin
|
||
s := s + Pad(FPos.X - Length(s) - 1) + LineAt(FPos.Y);
|
||
FText[FPos.Y - 1] := s;
|
||
FText.Delete(FPos.Y);
|
||
CorrectBookmark(FPos.Y, -1);
|
||
end;
|
||
UpdateScrollBar;
|
||
ClearSyntax(FPos.Y);
|
||
DoChange;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoBackspace;
|
||
var
|
||
s: String;
|
||
begin
|
||
FMessage := '';
|
||
if FSelStart.X <> 0 then
|
||
SelText := ''
|
||
else
|
||
begin
|
||
s := FText[FPos.Y - 1];
|
||
if FPos.X > 1 then
|
||
begin
|
||
if (GetLineBegin(FPos.Y - 1) = FPos.X) or (Trim(s) = '') then
|
||
UnIndent
|
||
else
|
||
begin
|
||
AddUndo;
|
||
if Trim(s) <> '' then
|
||
begin
|
||
Delete(s, FPos.X - 1, 1);
|
||
FText[FPos.Y - 1] := s;
|
||
DoLeft;
|
||
end
|
||
else
|
||
DoHome(False);
|
||
ClearSyntax(FPos.Y);
|
||
DoChange;
|
||
end;
|
||
end
|
||
else if FPos.Y > 1 then
|
||
begin
|
||
AddUndo;
|
||
CorrectBookmark(FPos.Y, -1);
|
||
s := LineAt(FPos.Y - 2);
|
||
FText[FPos.Y - 2] := s + FText[FPos.Y - 1];
|
||
FText.Delete(FPos.Y - 1);
|
||
SetPos(Length(s) + 1, FPos.Y - 1);
|
||
ClearSyntax(FPos.Y);
|
||
DoChange;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoCtrlI;
|
||
begin
|
||
if FSelStart.X <> 0 then
|
||
ShiftSelected(True);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoCtrlU;
|
||
begin
|
||
if FSelStart.X <> 0 then
|
||
ShiftSelected(False);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoCtrlL;
|
||
var
|
||
i: Integer;
|
||
s: String;
|
||
begin
|
||
s := FText.Text;
|
||
i := Length(LineAt(FPos.Y - 1));
|
||
if FPos.X > i then
|
||
FPos.X := i;
|
||
|
||
i := GetPlainTextPos(FPos);
|
||
|
||
Dec(i);
|
||
while (i > 0) and not ((CharInSet(s[i], WordChars))
|
||
or IsUnicodeChar(s[i])) do
|
||
if s[i] = #13 then
|
||
break else
|
||
Dec(i);
|
||
while (i > 0) and ((CharInSet(s[i], WordChars))
|
||
or IsUnicodeChar(s[i])) do
|
||
Dec(i);
|
||
Inc(i);
|
||
|
||
FPos := GetPosPlainText(i);
|
||
SetPos(FPos.X, FPos.Y);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoCtrlR;
|
||
var
|
||
i: Integer;
|
||
s: String;
|
||
begin
|
||
s := FText.Text;
|
||
i := Length(LineAt(FPos.Y - 1));
|
||
if FPos.X > i then
|
||
begin
|
||
DoDown;
|
||
DoHome(False);
|
||
FPos.X := 0;
|
||
end;
|
||
|
||
i := GetPlainTextPos(FPos);
|
||
|
||
while (i < Length(s)) and ((CharInSet(s[i], WordChars))
|
||
or IsUnicodeChar(s[i])) do
|
||
Inc(i);
|
||
while (i < Length(s)) and not ((CharInSet(s[i], WordChars))
|
||
or IsUnicodeChar(s[i])) do
|
||
if s[i] = #13 then
|
||
begin
|
||
while (i > 1) and (s[i - 1] = ' ') do
|
||
Dec(i);
|
||
break;
|
||
end
|
||
else
|
||
Inc(i);
|
||
|
||
FPos := GetPosPlainText(i);
|
||
SetPos(FPos.X, FPos.Y);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DoChar(Ch: Char);
|
||
begin
|
||
SelText := Ch;
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.GetCharAttr(Pos: TPoint): TCharAttributes;
|
||
|
||
function IsBlock: Boolean;
|
||
var
|
||
p1, p2, p3: Integer;
|
||
begin
|
||
Result := False;
|
||
if FSelStart.X = 0 then Exit;
|
||
|
||
p1 := FSelStart.X + FSelStart.Y * FMaxLength;
|
||
p2 := FSelEnd.X + FSelEnd.Y * FMaxLength;
|
||
if p1 > p2 then
|
||
begin
|
||
p3 := p1;
|
||
p1 := p2;
|
||
p2 := p3;
|
||
end;
|
||
p3 := Pos.X + Pos.Y * FMaxLength;
|
||
Result := (p3 >= p1) and (p3 < p2);
|
||
end;
|
||
|
||
function CharAttr: TCharAttr;
|
||
var
|
||
s: String;
|
||
begin
|
||
if Pos.Y - 1 < FSynStrings.Count then
|
||
begin
|
||
s := FSynStrings[Pos.Y - 1];
|
||
if Pos.X <= Length(s) then
|
||
Result := TCharAttr(Ord(s[Pos.X])) else
|
||
Result := caText;
|
||
end
|
||
else
|
||
Result := caText;
|
||
end;
|
||
|
||
begin
|
||
Result := [CharAttr];
|
||
if IsBlock then
|
||
Result := Result + [caBlock];
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.GetCharWidth(Str: String): Integer;
|
||
begin
|
||
with FTmpCanvas.Canvas do
|
||
begin
|
||
Font.Assign(Self.Font);
|
||
Result := TextWidth(Str);
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.Paint;
|
||
var
|
||
i, j, j1: Integer;
|
||
a, a1: TCharAttributes;
|
||
s: String;
|
||
|
||
procedure SetAttr(a: TCharAttributes; Line: Integer);
|
||
begin
|
||
with Canvas do
|
||
begin
|
||
Brush.Color := Color;
|
||
|
||
if caText in a then
|
||
Font.Assign(FTextAttr);
|
||
|
||
if caComment in a then
|
||
Font.Assign(FCommentAttr);
|
||
|
||
if caKeyword in a then
|
||
Font.Assign(FKeywordAttr);
|
||
|
||
if caNumber in a then
|
||
Font.Assign(FNumberAttr);
|
||
|
||
if caString in a then
|
||
Font.Assign(FStringAttr);
|
||
|
||
if (caBlock in a) or (Line = FActiveLine - 1) then
|
||
begin
|
||
Brush.Color := FBlockColor;
|
||
Font.Color := FBlockFontColor;
|
||
end;
|
||
|
||
Font.Charset := Self.Font.Charset;
|
||
end;
|
||
end;
|
||
|
||
procedure MyTextOut(x, y: Integer; const s: String);
|
||
var
|
||
i: Integer;
|
||
begin
|
||
if FIsMonoType then
|
||
begin
|
||
Canvas.FillRect(Rect(x, y, x + Length(s) * FCharWidth, y + FCharHeight));
|
||
Canvas.TextOut(x, y, s)
|
||
end
|
||
else
|
||
with Canvas do
|
||
begin
|
||
FillRect(Rect(x, y, x + Length(s) * FCharWidth, y + FCharHeight));
|
||
for i := 1 to Length(s) do
|
||
TextOut(x + (i - 1) * FCharWidth, y, s[i]);
|
||
MoveTo(x + Length(s) * FCharWidth, y);
|
||
end;
|
||
end;
|
||
|
||
procedure DrawLineMarks(Line, Y: Integer);
|
||
begin
|
||
if not FShowGutter then Exit;
|
||
if IsBookmark(Line) >= 0 then
|
||
with Canvas do
|
||
begin
|
||
Brush.Color := clBlack;
|
||
FillRect(Rect(13, Y + 3, 23, Y + 14));
|
||
Brush.Color := clGreen;
|
||
FillRect(Rect(12, Y + 4, 22, Y + 15));
|
||
Font.Name := 'Tahoma';
|
||
Font.Color := clWhite;
|
||
Font.Style := [fsBold];
|
||
Font.Size := 7;
|
||
TextOut(14, Y + 4, IntToStr(IsBookmark(Line)));
|
||
end;
|
||
if RunLine[Line + 1] then
|
||
with Canvas do
|
||
begin
|
||
Brush.Color := clBlue;
|
||
Pen.Color := clBlack;
|
||
Ellipse(4, Y + 7, 8, Y + 11);
|
||
Pixels[5, Y + 7] := clAqua;
|
||
Pixels[4, Y + 8] := clAqua;
|
||
end;
|
||
if IsBreakPoint(Line + 1) then
|
||
with Canvas do
|
||
begin
|
||
Brush.Color := clRed;
|
||
Pen.Color := clRed;
|
||
Ellipse(2, Y + 4, 13, Y + 15);
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
inherited;
|
||
|
||
with Canvas do
|
||
begin
|
||
Brush.Color := clBtnFace;
|
||
FillRect(Rect(0, 0, FGutterWidth - 2, Height));
|
||
Pen.Color := clBtnHighlight;
|
||
MoveTo(FGutterWidth - 4, 0);
|
||
LineTo(FGutterWidth - 4, Height + 1);
|
||
|
||
if FUpdatingSyntax then Exit;
|
||
CreateSynArray(FOffset.Y + FWindowSize.Y - 1);
|
||
|
||
for i := FOffset.Y to FOffset.Y + FWindowSize.Y - 1 do
|
||
begin
|
||
if i >= FText.Count then break;
|
||
|
||
s := FText[i];
|
||
PenPos := Point(FGutterWidth, (i - FOffset.Y) * FCharHeight);
|
||
j1 := FOffset.X + 1;
|
||
a := GetCharAttr(Point(j1, i + 1));
|
||
a1 := a;
|
||
|
||
for j := j1 to FOffset.X + FWindowSize.X do
|
||
begin
|
||
if j > Length(s) then break;
|
||
|
||
a1 := GetCharAttr(Point(j, i + 1));
|
||
if a1 <> a then
|
||
begin
|
||
SetAttr(a, i);
|
||
MyTextOut(PenPos.X, PenPos.Y, Copy(FText[i], j1, j - j1));
|
||
a := a1;
|
||
j1 := j;
|
||
end;
|
||
end;
|
||
|
||
SetAttr(a, i);
|
||
MyTextOut(PenPos.X, PenPos.Y, Copy(s, j1, FMaxLength));
|
||
if (caBlock in GetCharAttr(Point(1, i + 1))) or (i = FActiveLine - 1) then
|
||
MyTextOut(PenPos.X, PenPos.Y, Pad(FWindowSize.X - Length(s) - FOffset.X + 3));
|
||
|
||
DrawLineMarks(i, PenPos.Y);
|
||
end;
|
||
|
||
if FMessage <> '' then
|
||
begin
|
||
Font.Name := 'Tahoma';
|
||
Font.Color := clWhite;
|
||
Font.Style := [fsBold];
|
||
Font.Size := 8;
|
||
Brush.Color := clMaroon;
|
||
FillRect(Rect(0, ClientHeight - TextHeight('|') - 6, ClientWidth, ClientHeight));
|
||
TextOut(6, ClientHeight - TextHeight('|') - 5, FMessage);
|
||
end
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.ClearSyntax(ClearFrom: Integer);
|
||
begin
|
||
Dec(ClearFrom);
|
||
if ClearFrom < 1 then
|
||
ClearFrom := 1;
|
||
FUpdatingSyntax := True;
|
||
while FSynStrings.Count > ClearFrom - 1 do
|
||
FSynStrings.Delete(FSynStrings.Count - 1);
|
||
FUpdatingSyntax := False;
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.CreateSynArray(EndLine: Integer);
|
||
var
|
||
i, j, n, Max: Integer;
|
||
FSyn, s: String;
|
||
attr: TCharAttr;
|
||
begin
|
||
if EndLine >= FText.Count then
|
||
EndLine := FText.Count - 1;
|
||
if EndLine <= FSynStrings.Count - 1 then Exit;
|
||
|
||
FUpdatingSyntax := True;
|
||
FAllowLinesChange := False;
|
||
|
||
for i := FSynStrings.Count to EndLine do
|
||
FSynStrings.Add(FText[i]);
|
||
FSyn := FSynStrings.Text;
|
||
FParser.Text := FText.Text;
|
||
Max := Length(FSyn);
|
||
|
||
for i := Length(FSyn) downto 1 do
|
||
if FSyn[i] = Chr(Ord(caText)) then
|
||
begin
|
||
j := i;
|
||
while (j > 1) and (FSyn[j] = Chr(Ord(caText))) do
|
||
Dec(j);
|
||
FParser.Position := j + 1;
|
||
break;
|
||
end;
|
||
|
||
while FParser.Position < Max do
|
||
begin
|
||
n := FParser.Position;
|
||
FParser.SkipSpaces;
|
||
for i := n to FParser.Position - 1 do
|
||
if i <= Max then
|
||
if FSyn[i] > #31 then
|
||
FSyn[i] := Chr(Ord(caComment));
|
||
|
||
attr := caText;
|
||
n := FParser.Position;
|
||
s := FParser.GetWord;
|
||
if s <> '' then
|
||
begin
|
||
if FParser.IsKeyword(s) then
|
||
attr := caKeyword;
|
||
end
|
||
else
|
||
begin
|
||
s := FParser.GetNumber;
|
||
if s <> '' then
|
||
attr := caNumber
|
||
else
|
||
begin
|
||
s := FParser.GetString;
|
||
if s <> '' then
|
||
attr := caString else
|
||
FParser.Position := FParser.Position + 1
|
||
end
|
||
end;
|
||
|
||
for i := n to FParser.Position - 1 do
|
||
if i <= Max then
|
||
if FSyn[i] > #31 then
|
||
FSyn[i] := Chr(Ord(attr));
|
||
end;
|
||
|
||
FSynStrings.Text := FSyn;
|
||
FUpdatingSyntax := False;
|
||
FAllowLinesChange := True;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.UpdateView;
|
||
begin
|
||
Invalidate;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.MouseWheelUp(Sender: TObject;
|
||
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
||
begin
|
||
VertPosition := VertPosition - SmallChange;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.MouseWheelDown(Sender: TObject;
|
||
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
||
begin
|
||
VertPosition := VertPosition + SmallChange;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.SetShowGutter(Value: Boolean);
|
||
begin
|
||
FShowGutter := Value;
|
||
if Value then
|
||
FGutterWidth := 30 else
|
||
FGutterWidth := 0;
|
||
Repaint;
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.IsBookmark(Line: Integer): Integer;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := -1;
|
||
for i := 0 to 9 do
|
||
if FBookmarks[i] = Line then
|
||
begin
|
||
Result := i;
|
||
break;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.AddBookmark(Line, Number: Integer);
|
||
begin
|
||
if Number < Length(FBookmarks) then
|
||
begin
|
||
FBookmarks[Number] := Line;
|
||
Repaint;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DeleteBookmark(Number: Integer);
|
||
begin
|
||
if Number < Length(FBookmarks) then
|
||
begin
|
||
FBookmarks[Number] := -1;
|
||
Repaint;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.CorrectBookmark(Line, Delta: Integer);
|
||
var
|
||
i: Integer;
|
||
begin
|
||
if Delta = 0 then exit;
|
||
CorrectBreakPoints(Line, Delta);
|
||
for i := 0 to Length(FBookmarks) - 1 do
|
||
if FBookmarks[i] >= Line then
|
||
Inc(FBookmarks[i], Delta);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.GotoBookmark(Number : Integer);
|
||
begin
|
||
if Number < Length(FBookmarks) then
|
||
if FBookmarks[Number] >= 0 then
|
||
SetPos(0, FBookmarks[Number] + 1);
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.GetRunLine(Index: Integer): Boolean;
|
||
begin
|
||
if (Index < 1) or (Index > FText.Count) then
|
||
Result := False else
|
||
Result := FText.Objects[Index - 1] = Pointer(1);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.SetRunLine(Index: Integer; const Value: Boolean);
|
||
begin
|
||
if (Index < 1) or (Index > FText.Count) then Exit;
|
||
if Value then
|
||
FText.Objects[Index - 1] := Pointer(1) else
|
||
FText.Objects[Index - 1] := Pointer(0);
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.Find(const SearchText: String;
|
||
CaseSensitive: Boolean; var SearchFrom: Integer): Boolean;
|
||
var
|
||
i: Integer;
|
||
s: String;
|
||
begin
|
||
i := 0;
|
||
Result := False;
|
||
if FText.Count > 1 then
|
||
begin
|
||
s := FText.Text;
|
||
if SearchFrom = 0 then
|
||
SearchFrom := 1;
|
||
s := Copy(s, SearchFrom, Length(s) - SearchFrom + 1);
|
||
if CaseSensitive then
|
||
begin
|
||
i := Pos(SearchText, s);
|
||
if i <> 0 then
|
||
Result := True;
|
||
end
|
||
else
|
||
begin
|
||
i := Pos(AnsiUpperCase(SearchText), AnsiUpperCase(s));
|
||
if i <> 0 then
|
||
Result := True;
|
||
end;
|
||
end;
|
||
|
||
if Result then
|
||
begin
|
||
Inc(SearchFrom, i);
|
||
FSelStart := GetPosPlainText(SearchFrom - 1);
|
||
FSelEnd := Point(FSelStart.X + Length(SearchText), FSelStart.Y);
|
||
Inc(SearchFrom, Length(SearchText));
|
||
SetPos(FSelStart.X, FSelStart.Y);
|
||
Repaint;
|
||
end;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.AddBreakPoint(Number: Integer; const Condition: String);
|
||
begin
|
||
FBreakPoints.AddObject(Condition, TObject(Number));
|
||
Repaint;
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.ToggleBreakPoint(Number: Integer; const Condition: String);
|
||
begin
|
||
if IsBreakPoint(Number) then
|
||
DeleteBreakPoint(Number)
|
||
else
|
||
AddBreakPoint(Number, Condition);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DeleteBreakPoint(Number: Integer);
|
||
begin
|
||
if IsBreakPoint(Number) then
|
||
FBreakPoints.Delete(FBreakPoints.IndexOfObject(TObject(Number)));
|
||
Repaint;
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.IsBreakPoint(Number: Integer): Boolean;
|
||
begin
|
||
Result := FBreakPoints.IndexOfObject(TObject(Number)) <> -1;
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.GetBreakPointCondition(Number: Integer): String;
|
||
begin
|
||
Result := '';
|
||
if IsBreakPoint(Number) then
|
||
Result := FBreakPoints[FBreakPoints.IndexOfObject(TObject(Number))];
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.DeleteF4BreakPoints;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
i := 0;
|
||
while i < FBreakPoints.Count do
|
||
if FBreakPoints[i] = 'F4' then
|
||
FBreakPoints.Delete(i)
|
||
else
|
||
Inc(i);
|
||
end;
|
||
|
||
procedure TfrxSyntaxMemo.CorrectBreakPoints(Line, Delta: Integer);
|
||
var
|
||
i, bPos: Integer;
|
||
begin
|
||
// FBreakPoints[FBreakPoints.IndexOfObject(TObject(Number))]
|
||
for i := 0 to FBreakPoints.Count - 1 do
|
||
begin
|
||
bPos := Integer(FBreakPoints.Objects[i]);
|
||
if bPos >= Line then
|
||
begin
|
||
Inc(bPos, Delta);
|
||
FBreakPoints.Objects[i] := TObject(bPos);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TfrxSyntaxMemo.GetTextSelected: Boolean;
|
||
begin
|
||
//
|
||
Result := True;// FSelStart
|
||
|
||
end;
|
||
|
||
end.
|