diff options
| -rw-r--r-- | prototypes/textedit/demo_textedit.lpr | 99 | ||||
| -rw-r--r-- | prototypes/textedit/fpg_textedit.pas | 15 |
2 files changed, 106 insertions, 8 deletions
diff --git a/prototypes/textedit/demo_textedit.lpr b/prototypes/textedit/demo_textedit.lpr index ac9f7e7a..da961ce5 100644 --- a/prototypes/textedit/demo_textedit.lpr +++ b/prototypes/textedit/demo_textedit.lpr @@ -7,7 +7,7 @@ uses typinfo, Sysutils, fpg_base, fpg_main, fpg_form, fpg_button, fpg_label, - fpg_memo, fpg_dialogs, fpg_utils, fpg_radiobutton, + fpg_memo, fpg_dialogs, fpg_utils, fpg_stringutils, fpg_radiobutton, fpg_textedit, fpg_checkbox, fpg_panel; type @@ -40,6 +40,7 @@ type procedure HandleResize(awidth, aheight: TfpgCoord); override; procedure btnLoadClicked(Sender: TObject); procedure ChangeFontClicked(Sender: TObject); + procedure TextEditDrawLine(Sender: TObject; ALineText: TfpgString; ALineIndex: Integer; ACanvas: TfpgCanvas; ATextRect: TfpgRect; var AllowSelfDraw: Boolean); public constructor Create(AOwner: TComponent); override; procedure AfterCreate; override; @@ -48,6 +49,86 @@ type { TMainForm } +const + cReservedWords: array[1..44] of string = + ('begin', 'end', 'program', 'procedure', 'var', + 'uses', 'type', 'const', 'if', 'then', + 'for', 'do', 'unit', 'interface', 'implementation', + 'initialization', 'finalization', 'with', 'case', 'private', + 'protected', 'public', 'published', 'override', 'virtual', + 'class', 'record', 'function', 'property', 'to', + 'else', 'finally', 'while', 'except', 'try', + 'constructor', 'destructor', 'read', 'write', 'out', + 'default', 'not', 'and', 'in'); + +procedure TMainForm.TextEditDrawLine(Sender: TObject; ALineText: TfpgString; + ALineIndex: Integer; ACanvas: TfpgCanvas; ATextRect: TfpgRect; + var AllowSelfDraw: Boolean); +var + oldfont, newfont: TfpgFont; + s: TfpgString; // copy of ALineText we work with + i, j, c: integer; // i = position of reserved word; c = last character pos + iLength: integer; // length of reserved word + w: integer; // reserved word loop variable + r: TfpgRect; // string rectangle to draw in + edt: TfpgTextEdit; + + procedure TestFurther(var AIndex: integer); + begin + if AIndex = 0 then + begin + AIndex := UTF8Pos(cReservedWords[w], s); + if (AIndex > 0) then + begin +// writeln('>> ', s); +// writeln(AIndex+iLength-1, ' ---- ', Length(s)); + if (AIndex+iLength-1 <> Length(s)) and not (s[AIndex+iLength] in [';', '.', '(', #10, #13]) then + AIndex := 0; + end; + end; + end; + +begin + edt := TfpgTextEdit(Sender); + AllowSelfDraw := False; + ACanvas.TextColor := clBlack; + ACanvas.DrawText(ATextRect, ALineText); // draw plain text first + oldfont := TfpgFont(ACanvas.Font); + newfont := fpgGetFont(edt.FontDesc + ':bold'); // 'Bitstream Vera Sans Mono-10' + ACanvas.Font := newfont; +// PrintRect(ATextRect); + + for w := Low(cReservedWords) to High(cReservedWords) do + begin + s := ALineText; + i := UTF8Pos(cReservedWords[w]+' ', s); + iLength := UTF8Length(cReservedWords[w]); + TestFurther(i); + j := 0; + while i > 0 do + begin +// writeln('DEBUG: TMainForm.TextEditDrawLine - s = <' + s + '>'); +// writeln('DEBUG: TMainForm.TextEditDrawLine - found keyword: ' + cReservedWords[w]); + j := j + i; + s := UTF8Copy(ALineText, j, iLength+1); + UTF8Delete(s, 1, i + iLength); + r.SetRect(ATextRect.Left + edt.FontWidth * (j - 1), ATextRect.Top, + edt.FontWidth * (j + iLength), ATextRect.Height); +// PrintRect(r); +// ACanvas.Color := clWhite; +// ACanvas.FillRectangle(r); // clear area of previous text + ACanvas.DrawText(r, cReservedWords[w]); // draw bold text + i := UTF8Pos(cReservedWords[w]+' ', s); + TestFurther(i); + j := j + iLength; + end; { while } + end; { for w } + + ACanvas.Font := oldfont; + newfont.Free; +// writeln('------'); +end; + procedure TMainForm.ShowGutterChanged(Sender: TObject); begin TextEdit.GutterVisible := chkShowGutter.Checked; @@ -194,15 +275,21 @@ begin Name := 'TextEdit'; SetPosition(300, 172, 280, 235); Anchors := [anLeft,anRight,anTop,anBottom]; - Lines.Add('Memo Test0'); - Lines.Add('Memo Test1'); - Lines.Add('Memo Test2'); - Lines.Add('Memo Test3'); - Lines.Add('Memo Test4'); + Lines.Add('program Test1;'); + Lines.Add('{$mode objfpc}{$H+}'); + Lines.Add('uses'); + Lines.Add(' classes;'); + Lines.Add('var'); + Lines.Add(' i: integer;'); + Lines.Add('begin'); + Lines.Add(' writeln(i);'); + Lines.Add('end.'); + Lines.Add(''); // FontDesc := '#Edit1'; FontDesc := 'Bitstream Vera Sans Mono-10'; // Lines.Insert(1,'0 Beforje 1 after'); ParentShowHint := True; + OnDrawLine := @TextEditDrawLine; end; btnLoad := TfpgButton.Create(self); diff --git a/prototypes/textedit/fpg_textedit.pas b/prototypes/textedit/fpg_textedit.pas index 62d6d644..ebe66222 100644 --- a/prototypes/textedit/fpg_textedit.pas +++ b/prototypes/textedit/fpg_textedit.pas @@ -62,12 +62,18 @@ type end; + TfpgDrawLineEvent = procedure(Sender: TObject; ALineText: TfpgString; + ALineIndex: Integer; ACanvas: TfpgCanvas; ATextRect: TfpgRect; + var AllowSelfDraw: Boolean) of object; + + TfpgBaseTextEdit = class(TfpgWidget) private FFont: TfpgFont; FFullRedraw: Boolean; FLines: TStrings; CaretPos: TPoint; + FOnDrawLine: TfpgDrawLineEvent; FScrollBarStyle: TfpgScrollStyle; MousePos: TPoint; FChrW: Integer; @@ -142,6 +148,7 @@ type property ScrollBarStyle: TfpgScrollStyle read FScrollBarStyle write SetScrollBarStyle default ssAutoBoth; property TabWidth: Integer read FTabWidth write SetTabWidth default 8; property Tracking: Boolean read FTracking write FTracking default True; + property OnDrawLine: TfpgDrawLineEvent read FOnDrawLine write FOnDrawLine; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -153,6 +160,8 @@ type procedure DeleteSelection; procedure SaveToFile(const AFileName: TfpgString); procedure LoadFromFile(const AFileName: TfpgString); + property FontHeight: Integer read FChrH; + property FontWidth: Integer read FChrW; property ScrollPos_H: Integer read GetHScrollPos write SetHScrollPos; property ScrollPos_V: Integer read GetVScrollPos write SetVScrollPos; property TopLine: Integer read FTopLine; @@ -172,6 +181,7 @@ type property ScrollBarStyle; property TabWidth; property Tracking; + property OnDrawLine; end; @@ -1295,11 +1305,12 @@ begin { start drawing formatted text } R.SetRect(X, Y, UTF8Length(S) * FChrW, FChrH); AllowDraw := True; -// if Assigned(FOnDrawLine) then FOnDrawLine(Self, S, I, LGliph, R, AllowDraw); + { end-user can hook in here to do syntax highlighting and other custom drawing } + if Assigned(FOnDrawLine) then + FOnDrawLine(self, S, I, Canvas, R, AllowDraw); { Draw simple text line... } if AllowDraw then Canvas.DrawText(R, S); -// DrawText(LGliph.Canvas.Handle, PChar(S), Length(S), R, DT_DRAWLINE); { todo: Do other formatting here. } { todo: Do selection painting here. } |