{------------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: SynUniHighlighter.pas, released 2003-01 All Rights Reserved. Alternatively, the contents of this file may be used under the terms of the GNU General Public License Version 2 or later (the "GPL"), in which case the provisions of the GPL are applicable instead of those above. If you wish to allow use of your version of this file only under the terms of the GPL and not to allow others to use your version of this file under the MPL, indicate your decision by deleting the provisions above and replace them with the notice and other provisions required by the GPL. If you do not delete the provisions above, a recipient may use your version of this file under either the MPL or the GPL.} { @abstract(Desginer for TSynUniSyn) @authors(Vit [nevzorov@yahoo.com], Fantasist [walking_in_the_sky@yahoo.com]) @created(2003) @lastmod(2003-02-01) } (****************************************************************************** Authors: Vit (Vitaly Nevzorov nevzorov@yahoo.com); Fantasist (Kirill Burtsev walking_in_the_sky@yahoo.com) Official Site: www.delphist.com With all questions, please visit www.delphist.com/forum Contributors: Tom Lisjac http://theseus.sf.net Initially adapted for use with Lazarus and FPC - 2003-06-12 Changes can be found by searching for: ////TL Issues that need review are flagged with one or more ! suffixes after TL ******************************************************************************) unit SynUniDesigner; {$I SynEdit.inc} interface uses Graphics, Controls, Forms, ExtCtrls, StdCtrls, ComCtrls, Buttons, ////TL Added for TButton Dialogs, Menus, GraphType, ////TL Added for TFontStyles LCLType, ////TL Added for vk_* key declarations Classes, FileUtil, LazUTF8Classes, SysUtils, SynEdit, SynEditHighlighter, SynUniHighlighter; type TNodeText = String; CClass=class of TControl; TSynUniDesigner=class(Tobject) Private F:TForm; pBottom, pTop, pLeft, pAttri, pDef, pNum, pDF, pDB, pNF, pNB, pProp, pMemo:TPanel; Lc, LDef, LNum:TLabel; cDb,cDi,CDu,cDs,cNb,cNi,CNu,cNs, cCaseSensitiveRt, cCaseSensitiveRg, cCloseOnWord, cCloseOnEOL,cAnyStart:TCheckBox; SampleMemo:TSynEdit; ////TL Changed from TPageControl to TNotebook... with fingers crossed! ////TL PageControl:TPageControl; PageControl:TNotebook; ////TL Changed from TTabsheet to TPage... with fingers crossed again! ////TL RootRange,Range,KeyWords:TTabsheet; RootRange,Range,KeyWords:TPage; Memo:TMemo; EFrom, ETo, EDelimitersRg, EDelimitersRt:TEdit; UpdatingControls:boolean; AddRange, AddRangeRt, AddKeyword,AddKeywordRt, bSort, bLowercase, bExchange:TButton; Tree:TTreeView; h:TSynUniSyn; ImageList: TImageList; TreeMenu: TPopupMenu; procedure SetControlAttributes(Node: TTreeNode); procedure SetControlKWAttributes(Node: TTreeNode); procedure KwListChange(Sender: TObject); procedure TotalUpdate; procedure AddingRange(Node: TTreeNode); procedure TreeChange(Sender: TObject; Node: TTreeNode); ////TL replaced out prefix procedure CreateComponent(out Comp: TControl; CName: CClass; Parent: TWinControl; Align: TAlign); procedure CreateComponent(var Comp: TControl; CName: CClass; Parent: TWinControl; Align: TAlign); procedure DoAddRange(Sender: TObject); ////TL replaced out prefix procedure CreateCheckBox(out comp: TCheckBox; Parent: TWinControl; left, top, width, height: integer); procedure CreateCheckBox(var comp: TCheckBox; Parent: TWinControl; left, top, width, height: integer); procedure CreateLabel(Parent: TWinControl; left, top, width, height: integer; Caption: string); ////TL replaced out prefix procedure CreatePanel(out comp: TPanel; Parent: TWinControl; left, top, width, height: integer); procedure CreatePanel(var comp: TPanel; Parent: TWinControl; left, top, width, height: integer); function GetNodeType(Node: TTreeNode): TNodeType; procedure SetDefaultAttributes(Attr: TSynHighlighterAttributes); procedure SetDefaultRangeAttr(R: TSynRange); procedure DoAddKeyword(Sender: TObject); procedure AddingKeyWord(Node: TTreeNode); procedure PanelColorChange(Sender: TObject); procedure SetAttributes(Node: TTreeNode); procedure StatusChanged(Sender: TObject); procedure RangeChange(Sender: TObject); procedure RootRangeChange(Sender: TObject); function GetSample: string; procedure SetSample(const Value: string); procedure TreeEdited(Sender: TObject; Node: TTreeNode; var S: TNodeText); procedure FillTree; ////TL Dupe ID... changed to Range1 procedure TreeAddRange(Node: TTreeNode; Range1: TSynRange); procedure TreeAddSymbol(Node: TTreeNode; kw: TSynSymbolGroup); procedure SampleMemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure TreeKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure TreeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure DeleteNode(Node: TTreeNode); procedure DelimDblClick(Sender: TObject); procedure SampleDblClick(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure SortClick(Sender: TObject); procedure Case2Lower(Sender: TObject); procedure ChangeSpaces(Sender: TObject); procedure TreeMenuPopup(Sender: TObject); procedure LoadFromFileClick(Sender: TObject); procedure SetTitle(const Value: string); function GetTitle: string; Public Constructor Create(highl:TSynUniSyn); Destructor Destroy;override; function Execute: boolean; ////TL Removed default optional parm... will explicitly state in the calls ////TL Changed Title to Title1 to avoid dupe identifier error from fpc ////TL class function EditHighlighter(aHL: TSynUniSyn; Title:string=''): boolean; class function EditHighlighter(aHL: TSynUniSyn; Title1:string): boolean; Property Title:string read GetTitle write SetTitle; property Sample:string read GetSample write SetSample; End; implementation Function GetFontStyle(bold, italic, underline, strikeout:boolean):TFontStyles; begin result:=[]; if bold then result:=result+[fsBold]; if italic then result:=result+[fsitalic]; if underline then result:=result+[fsunderline]; if strikeout then result:=result+[fsStrikeOut]; end; { TSynUniDesigner } Procedure TSynUniDesigner.AddingKeyWord(Node:TTreeNode); var n:TTreeNode; kw:TSynSymbolGroup; begin n:=Tree.Items.AddChild(Node, _NewRange); kw:=TSynSymbolGroup.Create('',TSynHighlighterAttributes.Create('unknown')); kw.Name:=_NewRange; n.Data:=kw; n.ImageIndex:=2; n.SelectedIndex:=2; TSynRange(Node.data).AddSymbolGroup(kw); n.Expand(false); n.Selected:=true; tree.SetFocus; n.EditText; SetDefaultAttributes(kw.Attribs); SetControlKWAttributes(n); end; procedure TSynUniDesigner.Case2Lower(Sender: TObject); begin Memo.text:=Lowercase(memo.text); end; procedure TSynUniDesigner.ChangeSpaces(Sender: TObject); begin Memo.text:=StringReplace(memo.text, ' ',#13#10,[rfReplaceAll]); end; constructor TSynUniDesigner.Create(highl: TSynUniSyn); var b:TBitmap; begin inherited create; h:=highl; F:=TForm.create(nil); F.Position:=poScreenCenter; F.Width:=600; F.Height:=400; F.KeyPreview:=true; ////TL added 2 @ prefixes f.OnKeyPress:=@FormKeyPress; {$WARNING TODO Fix UTF8BIDI issue} f.OnUTF8KeyPress:=nil; f.OnKeyDown:=@FormKeyDown; f.caption:='Unihighlighter Designer (c) Fantasist, Vit (2002)'; // Menu:=TMainMenu.Create(f); // if FFileName<>'' then // f.caption := f.caption+' - '+ExtractFileName(FFileName); CreateComponent(TControl(pTop), TPanel, F, alTop); pTop.Height:=184; CreateComponent(TControl(pLeft), TPanel, pTop, alLeft); pLeft.Width:=200; ImageList:=TImageList.create(F); b:=TBitmap.create; b.Width:=16; b.Height:=16; b.canvas.Font.color:=clRed; b.canvas.Font.Size:=14; b.canvas.TextOut(1,1,#52); ImageList.AddMasked(b, clWhite); b.free; b:=TBitmap.create; b.Width:=16; b.Height:=16; b.canvas.Font.color:=clGreen; b.canvas.Font.Size:=14; b.canvas.TextOut(1,1,#52); ImageList.AddMasked(b, clWhite); b.free; b:=TBitmap.create; b.Width:=16; b.Height:=16; b.canvas.Font.Size:=14; b.canvas.Font.color:=clblue; b.canvas.TextOut(1,1,#104); ImageList.AddMasked(b, clWhite); b.free; Tree:=TTreeView.Create(pLeft); Tree.Align:=alClient; Tree.Parent:=pLeft; Tree.Images:=ImageList; Tree.HideSelection:=false; Tree.RightClickSelect:=True; ////TL added @ prefixes Tree.OnEdited:=@TreeEdited; Tree.OnKeyDown:=@TreeKeyDown; Tree.OnMouseUp:=@TreeMouseUp; CreateComponent(TControl(pAttri), TPanel, pTop, alRight); pAttri.Anchors:=[akRight]; pAttri.Width:=200; pAttri.BevelInner := bvRaised; pAttri.BevelOuter := bvLowered; CreateComponent(TControl(Lc), TLabel, pAttri, alTop); Lc.Alignment := taCenter; Lc.Caption := 'Attributes'; Lc.Color := 16776176; Lc.Font.Color := clGreen; Lc.Font.Style := [fsBold]; CreateLabel(pAttri, 10, 43, 66, 13, 'Foreground'); CreateLabel(pAttri, 10, 66, 66, 13, 'Background'); CreateLabel(pAttri, 10, 90, 66, 13, 'Bold'); CreateLabel(pAttri, 10, 113, 66, 13, 'Italic'); CreateLabel(pAttri, 10, 137, 66, 13, 'Underline'); CreateLabel(pAttri, 10, 160, 66, 13, 'StrikeOut'); CreatePanel(pDef, pAttri, 79, 19, 58, 161); pDef.BevelInner := bvLowered; CreateComponent(TControl(LDef), TLabel, pDef, alTop); LDef.Alignment := taCenter; LDef.Caption := 'Default'; LDef.Font.Color := clMaroon; LDef.Font.Style := [fsBold]; CreatePanel(pDF, pDef, 8, 20, 42, 21); ////TL added @ prefixes to the onclick event assignments pDF.OnClick:=@PanelColorChange; CreatePanel(pDB, pDef, 8, 44, 42, 21); pDB.OnClick:=@PanelColorChange; CreateCheckBox(cDb,pDef, 21, 67, 17, 17); cDb.OnClick:=@StatusChanged; CreateCheckBox(cDi,pDef, 21, 91, 17, 17); cDi.OnClick:=@StatusChanged; CreateCheckBox(CDu,pDef, 21,114, 17, 17); cDu.OnClick:=@StatusChanged; CreateCheckBox(cDs,pDef, 21,138, 17, 17); cDs.OnClick:=@StatusChanged; CreatePanel(pNum, pAttri, 137, 19, 58, 161); pNum.BevelInner := bvLowered; CreateComponent(TControl(LNum), TLabel, pNum, alTop); LNum.Alignment := taCenter; LNum.Caption := 'Numbers'; LNum.Font.Color := clMaroon; LNum.Font.Style := [fsBold]; CreatePanel(pNF, pNum, 8, 20, 42, 21); pNF.OnClick:=@PanelColorChange; CreatePanel(pNB, pNum, 8, 44, 42, 21); pNB.OnClick:=@PanelColorChange; CreateCheckBox(cNb,pNum, 21, 67, 17, 17); cNb.OnClick:=@StatusChanged; CreateCheckBox(cNi,pNum, 21, 91, 17, 17); cNi.OnClick:=@StatusChanged; CreateCheckBox(CNu,pNum, 21,114, 17, 17); cNu.OnClick:=@StatusChanged; CreateCheckBox(cNs,pNum, 21,138, 17, 17); cNs.OnClick:=@StatusChanged; CreateComponent(TControl(pProp), TPanel, pTop, alClient); pProp.BevelOuter:= bvLowered; pProp.BevelInner:= bvLowered; CreateComponent(TControl(PageControl), TNotebook, pProp, alClient); //PageControl.ShowTabs:=false; PageControl.Pages.Add(''); RootRange:=PageControl.Page[0]; CreateCheckBox(cCaseSensitiveRt,RootRange, 10,10, 140, 17); cCaseSensitiveRt.Caption:='Case Sensitive'; cCaseSensitiveRt.OnClick:=@RootRangeChange; CreateLabel(RootRange, 10, 102, 44, 17, 'Delimiters:'); CreateComponent(TControl(EDelimitersRt), TEdit, RootRange, alNone); EDelimitersRt.Top:=98; EDelimitersRt.Left:=60; EDelimitersRt.Width:=115; EDelimitersRt.Anchors:=[akLeft,akRight, akTop]; EDelimitersRt.font.Name:='FixedSys'; EDelimitersRt.OnChange:=@RootRangeChange; ////TL! No OnDblClick available in TEdit... using OnClick instead ////TL! EDelimitersRt.OnDblClick:=DelimDblClick; EDelimitersRt.OnClick:=@DelimDblClick; CreateComponent(TControl(AddRangeRt), TButton, RootRange, alNone); AddRangeRt.Left:=10; AddRangeRt.Top:=130; AddRangeRt.Caption:='Add Range'; AddRangeRt.OnClick:=@DoAddRange; CreateComponent(TControl(AddKeywordRt), TButton, RootRange, alNone); AddKeywordRt.Left:=100; AddKeywordRt.Top:=130; AddKeywordRt.Caption:='Add Keywords'; AddKeywordRt.OnClick:=@DoAddKeyword; PageControl.Pages.Add(''); Range:=PageControl.Page[1]; CreateCheckBox(cCaseSensitiveRg,Range, 10,10, 140, 17); cCaseSensitiveRg.OnClick:=@RangeChange; cCaseSensitiveRg.Caption:='Case Sensitive'; CreateLabel(Range, 10, 33, 44, 17, 'From'); CreateComponent(TControl(EFrom), TEdit, Range, alNone); EFrom.Top:=30; EFrom.Left:=35; EFrom.Width:=60; EFrom.OnChange:=@RangeChange; CreateLabel(Range, 100, 33, 44, 17, 'To'); CreateComponent(TControl(ETo), TEdit, Range, alNone); ETo.Top:=30; ETo.Left:=115; ETo.Width:=60; ETo.OnChange:=@RangeChange; //56 CreateCheckBox(cCloseOnWord,Range, 10,56, 140, 17); cCloseOnWord.OnClick:=@RangeChange; cCloseOnWord.Caption:='Close on delimiter'; CreateCheckBox(cCloseOnEOL,Range, 10,77, 140, 17); cCloseOnEOL.Caption:='Close on end of line'; cCloseOnEOL.OnClick:=@RangeChange; CreateCheckBox(cAnyStart ,Range, 10, 98, 160, 17); cAnyStart.Caption:='Open range tag is part of term'; cAnyStart.OnClick:=@RangeChange; CreateLabel(Range, 10, 120, 44, 17, 'Delimiters:'); CreateComponent(TControl(EDelimitersRg), TEdit, Range, alNone); EDelimitersRg.Top:=116; EDelimitersRg.Left:=60; EDelimitersRg.Width:=115; EDelimitersRg.Anchors:=[akLeft,akRight, akTop]; // EDelimitersRg.font.Charset:=255; EDelimitersRg.OnChange:=@RangeChange; ////TL! No OnDblClick available in TEdit... using OnClick instead ////TL! EDelimitersRg.OnDblClick:=DelimDblClick; EDelimitersRg.OnClick:=@DelimDblClick; CreateComponent(TControl(AddRange), TButton, Range, alNone); AddRange.Left:=10; AddRange.Top:=142; AddRange.Caption:='Add Range'; AddRange.OnClick:=@DoAddRange; CreateComponent(TControl(AddKeyword), TButton, Range, alNone); AddKeyword.Left:=100; AddKeyword.Top:=142; AddKeyword.Caption:='Add Keywords'; AddKeyword.OnClick:=@DoAddKeyword; PageControl.Pages.Add(''); KeyWords:=PageControl.Page[2]; CreateComponent(TControl(pMemo), TPanel, KeyWords, alRight); pMemo.Anchors:=[akRight]; pMemo.Width:=100; pMemo.BevelInner:=bvLowered; CreateComponent(TControl(bSort), TButton, pMemo, alNone); bSort.Left:=3; bSort.Top:=2; bSort.Width:=95; bSort.caption:='Sort'; bSort.OnClick:=@SortClick; CreateComponent(TControl(bLowercase), TButton, pMemo, alNone); bLowercase.Left:=3; bLowercase.Top:=28; bLowercase.Width:=95; bLowercase.caption:='Lower Case'; bLowercase.OnClick:=@Case2Lower; CreateComponent(TControl(bExchange), TButton, pMemo, alNone); bExchange.Left:=3; bExchange.Top:=54; bExchange.Width:=95; bExchange.caption:='Spaces->Breaks'; bExchange.OnClick:=@ChangeSpaces; CreateComponent(TControl(Memo), TMemo, KeyWords, alClient); Memo.ScrollBars:=ssVertical; ////TL! this probably available... later: memo.BorderStyle:=bsNone; pBottom:=TPanel.Create(F); pBottom.Parent:=F; pBottom.Align:=alClient; pBottom.Visible:=true; CreateComponent(TControl(SampleMemo), TSynEdit, pBottom, alClient); SampleMemo.Highlighter:=h; SampleMemo.Lines.Text:=h.Info.Sample.Text; SampleMemo.OnKeyDown:=@SampleMemoKeyDown; SampleMemo.WantTabs:=true; SampleMemo.OnDblClick:=@SampleDblClick; TreeMenu := TPopupMenu.Create( F ); TreeMenu.OnPopup := @TreeMenuPopup; TreeMenu.Items.Add( TMenuItem.Create( F ) ); TreeMenu.Items.Items[0].Caption := 'Load from file ...'; TreeMenu.Items.Items[0].OnClick := @LoadFromFileClick; Tree.PopupMenu := TreeMenu; FillTree; Tree.OnChange:=@TreeChange; ////TL! changed to PageIndex for TNotebook PageControl.ActivePageIndex:=1; PageControl.PageIndex:=1; Tree.Selected:=Tree.items[0]; TreeChange(nil, Tree.Selected); Tree.items[0].Expand(false); end; Procedure TSynUniDesigner.CreateCheckBox(var comp:TCheckBox; Parent:TWinControl; left, top, width, height:integer); begin CreateComponent(TControl(Comp), TCheckBox, Parent, alNone); Comp.Left := Left; Comp.Top := Top; Comp.Width := Width; Comp.Height := Height; end; Procedure TSynUniDesigner.CreateComponent(var Comp:TControl; CName:CClass; Parent:TWinControl; Align:TAlign); begin Comp:=Cname.create(Parent); Comp.Parent:=Parent; Comp.Align:=Align; Comp.Visible:=true; end; Procedure TSynUniDesigner.CreateLabel(Parent:TWinControl; left, top, width, height:integer; Caption:string); var Comp:TLabel; begin CreateComponent(TControl(Comp), TLabel, Parent, alNone); Comp.Left := Left; Comp.Top := Top; Comp.Width := Width; Comp.Height := Height; Comp.Caption := Caption; Comp.Alignment := taRightJustify; end; Procedure TSynUniDesigner.CreatePanel(var comp:TPanel; Parent:TWinControl; left, top, width, height:integer); begin CreateComponent(TControl(Comp), TPanel, Parent, alNone); Comp.Left := Left; Comp.Top := Top; Comp.Width := Width; Comp.Height := Height; end; procedure TSynUniDesigner.DeleteNode(Node:TTreeNode); var i:integer; begin for i:=0 to Node.Count-1 do DeleteNode(Node[i]); if TObject(Tree.Selected.data) is TSynRange then TSynRange(Tree.Selected.Parent.data).DeleteRange(TSynRange(Tree.Selected.data)) else if TObject(Tree.Selected.data) is TSynSymbolGroup then TSynRange(Tree.Selected.Parent.data).DeleteSymbolGroup(TSynSymbolGroup(Tree.Selected.data)); Node.Delete; end; Procedure TSynUniDesigner.DelimDblClick(Sender:TObject); begin (Sender as TEdit).text:=set2string(DefaultTermSymbols); end; destructor TSynUniDesigner.Destroy; begin SampleMemo.Highlighter:=nil; SampleMemo.Free; F.free; inherited; end; procedure TSynUniDesigner.DoAddKeyword(Sender: TObject); begin AddingKeyWord(Tree.selected); end; ////TL dupe identifier Title... changed to Title1 class function TSynUniDesigner.EditHighlighter(aHL: TSynUniSyn; Title1: string): boolean; var d:TSynUniDesigner; iTempSyn: TSynUniSyn; iBuffer: TMemoryStream; begin iBuffer := TMemoryStream.Create; try if aHL.MainRules.RangeCount > 0 then aHL.SaveToStream( iBuffer ); iBuffer.Position := 0; iTempSyn := TSynUniSyn.Create( nil ); try if iBuffer.Size <> 0 then iTempSyn.LoadFromStream( iBuffer ); iBuffer.Clear; d := TSynUniDesigner.Create(iTempSyn); try if Title1<>'' then d.Title:=Title1; d.Sample:= aHL.Info.Sample.Text; Result := d.Execute; if Result and (iTempSyn.MainRules.RangeCount > 0) then begin iTempSyn.SaveToStream( iBuffer ); iBuffer.Position := 0; aHL.LoadFromStream( iBuffer ); aHL.Info.Sample.Text := d.Sample; end; finally d.free; end; finally iTempSyn.Free; end; finally iBuffer.Free; end; end; function TSynUniDesigner.Execute: boolean; begin //Result := F.showmodal = mrOk; F.showmodal; Result := True; end; procedure TSynUniDesigner.FillTree; begin TreeAddRange(nil, h.MainRules); end; procedure TSynUniDesigner.FormKeyPress(Sender: TObject; var Key: Char); begin if (key=#27) and (not Tree.IsEditing) then F.close; end; procedure TSynUniDesigner.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (key=vk_F1) then showmessage('UniHighlighter Component'+#13#10#13#10+'Copyright(c):'+#13#10+'Fantasist (walking_in_the_sky@yahoo.com)'+#13#10+'Vit (nevzorov@yahoo.com)'+#13#10#13#10+'Official Web Site: www.delphist.com'+#13#10#13#10+'New York-Chicago-2002'); end; Function TSynUniDesigner.GetNodeType(Node:TTreeNode):TNodeType; begin Result:=ntNone; if Node<>nil then if (TObject(Node.data) is TSynRange) and (Node.level=0) then Result:=ntRootRange else if TObject(Node.data) is TSynRange then Result:=ntRange else if TObject(Node.data) is TSynSymbolGroup then Result:=ntKeyWords; end; function TSynUniDesigner.GetSample: string; begin Result:=SampleMemo.lines.Text; end; function TSynUniDesigner.GetTitle: string; begin Result:=f.Caption; end; procedure TSynUniDesigner.PanelColorChange(Sender: TObject); begin (Sender as TPanel).BevelOuter := bvLowered; With TColorDialog.Create(nil) do try ////TL!! Not there with TColorDialog: CustomColors.text:='ColorA='+inttohex((Sender as TPanel).color,6)+#13#10+'ColorB=FFFFEE'+#13#10+'ColorC=EEFFFF'+#13#10+'ColorD=EEFFEE'+#13#10+'ColorE=EEEEFF'+#13#10+'ColorF=FFEEEE'+#13#10+'ColorG=EEEEEE'+#13#10+'ColorH=FFEEAA'+#13#10+'ColorJ=FFAAEE'+#13#10+'ColorK=AAFFEE'+#13#10+'ColorI=AAEEFF'+#13#10+'ColorL=EEFFAA'+#13#10+'ColorM=EEAAFF'+#13#10+'ColorN=AAAAAA'+#13#10+'ColorO=DDDDDD'+#13#10+'ColorP=999999'; Color:=(Sender as TPanel).color; ////TL!! Not there with TColorDialog: Options:=[cdFullOpen]; if Execute then begin (Sender as TPanel).color:=color; SetAttributes(Tree.selected); end; finally free; end; (Sender as TPanel).BevelOuter := bvRaised; end; Procedure TSynUniDesigner.RangeChange(Sender: TObject); var i:integer; begin if UpdatingControls then exit; if GetNodeType(Tree.selected) in [ntRange] then begin TSynRange(Tree.selected.data).OpenSymbol.Symbol:=EFrom.text; TSynRange(Tree.selected.data).CloseSymbol.Symbol:=ETo.text; TSynRange(Tree.selected.data).CloseOnTerm:=cCloseOnWord.Checked; TSynRange(Tree.selected.data).CloseOnEol:=cCloseOnEOL.Checked; TSynRange(Tree.selected.data).CaseSensitive:=cCaseSensitiveRg.Checked; TSynRange(Tree.selected.data).TermSymbols:=String2Set(EDelimitersRg.text); { the apparently useless typecast to char is for CLX compatibility } for i:=1 to length(EDelimitersRg.text) do TSynRange(Tree.selected.data).TermSymbols := TSynRange(Tree.selected.data).TermSymbols + [Char(EDelimitersRg.text[i])]; if cAnyStart.Checked then TSynRange(Tree.selected.data).OpenSymbol.BrakeType:=btAny else TSynRange(Tree.selected.data).OpenSymbol.BrakeType:=btTerm; end; TotalUpdate; end; Procedure TSynUniDesigner.RootRangeChange(Sender: TObject); var i:integer; begin if UpdatingControls then exit; if GetNodeType(Tree.selected) in [ntRootRange] then begin TSynRange(Tree.selected.data).CaseSensitive:=cCaseSensitiveRt.Checked; end; TSynRange(Tree.selected.data).TermSymbols:=[]; { the apparently useless typecast to char is for CLX compatibility } for i:=1 to length(EDelimitersRt.text) do TSynRange(Tree.selected.data).TermSymbols:=TSynRange(Tree.selected.data).TermSymbols+[Char(EDelimitersRt.text[i])]; TotalUpdate; end; Procedure TSynUniDesigner.SetAttributes(Node: TTreeNode); begin if UpdatingControls then exit; if (node<>nil) and (TObject(Node.data) is TSynRange) then with TSynRange(Node.data) do begin DefaultAttri.Foreground:=pDF.Color; DefaultAttri.Background:=pDB.Color; DefaultAttri.Style:=GetFontStyle(cDB.checked, cDI.checked, cDU.checked, cDS.checked); NumberAttri.Foreground:=pNF.Color; NumberAttri.Background:=pNB.Color; NumberAttri.Style:=GetFontStyle(cNB.checked, cNI.checked, cNU.checked, cNS.checked); TotalUpdate; end; if (node<>nil) and (TObject(Node.data) is TSynSymbolGroup) then with TSynSymbolGroup(Node.data) do begin Attribs.Foreground:=pDF.Color; Attribs.Background:=pDB.Color; Attribs.Style:=GetFontStyle(cDB.checked, cDI.checked, cDU.checked, cDS.checked); TotalUpdate; end; end; procedure TSynUniDesigner.SampleMemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin ////TL! replaced ActivePage with ActivePageComponent if (key=vk_Return) and (ssCtrl in Shift) and (PageControl.Page[PageControl.PageIndex] = KeyWords) then begin memo.lines.add(samplememo.SelText); TotalUpdate; end; end; procedure TSynUniDesigner.StatusChanged(Sender: TObject); begin SetAttributes(Tree.selected); end; Procedure TSynUniDesigner.TreeAddRange(Node:TTreeNode;Range1:TSynRange); var temp:TTreeNode; i:integer; begin if Node=nil then begin Temp:=Tree.items.add(nil,Range1.name); temp.ImageIndex:=0; temp.SelectedIndex:=0; end else begin Temp:=Tree.items.addChild(Node,Range1.name); temp.ImageIndex:=1; temp.SelectedIndex:=1; end; Temp.Data:=Range1; For i:=0 to Range1.SymbolGroupCount-1 do TreeAddSymbol(Temp, Range1.SymbolGroups[i]); For i:=0 to Range1.RangeCount-1 do TreeAddRange(Temp, Range1.Ranges[i]); end; Procedure TSynUniDesigner.TreeAddSymbol(Node:TTreeNode;kw:TSynSymbolGroup); var temp:TTreeNode; begin temp:=Tree.items.addChild(Node,kw.name); temp.ImageIndex:=2; temp.SelectedIndex:=2; temp.data:=kw; end; procedure TSynUniDesigner.TreeEdited(Sender: TObject; Node: TTreeNode; var S: TNodeText); begin if Node.Data=nil then exit; if TObject(Node.Data) is TSynRange then TSynRange(Node.Data).Name:=s; if TObject(Node.Data) is TSynSymbolGroup then TSynSymbolGroup(Node.Data).Name:=s; end; procedure TSynUniDesigner.TreeKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin ////TL! Added TSynRange typecast to Tree.Selected.Data if (key=vk_Delete) and (h.MainRules<>TSynRange(Tree.Selected.Data)) and (not Tree.IsEditing) then begin if MessageDlg('Are you sure you want to delete '+Tree.Selected.text,mtWarning,[mbYes,MbNo],0)=mrYes then begin DeleteNode(Tree.Selected); TotalUpdate; end; end; if Key=vk_F2 then Tree.Selected.EditText; end; Procedure TSynUniDesigner.SetControlAttributes(Node: TTreeNode); begin UpdatingControls:=true; if TObject(Node.data) is TSynRange then with TSynRange(Node.data) do begin pDF.Color:=DefaultAttri.Foreground; pDB.Color:=DefaultAttri.Background; cDb.checked:=fsBold in DefaultAttri.Style; cDi.checked:=fsItalic in DefaultAttri.Style; CDu.checked:=fsUnderline in DefaultAttri.Style; cDs.checked:=fsStrikeOut in DefaultAttri.Style; pNF.Color:=NumberAttri.Foreground; pNB.Color:=NumberAttri.Background; cNb.checked:=fsBold in NumberAttri.Style; cNi.checked:=fsItalic in NumberAttri.Style; CNu.checked:=fsUnderline in NumberAttri.Style; cNs.checked:=fsStrikeOut in NumberAttri.Style; end; UpdatingControls:=false; end; Procedure TSynUniDesigner.SetControlKWAttributes(Node: TTreeNode); begin UpdatingControls:=true; if TObject(Node.data) is TSynSymbolGroup then with TSynSymbolGroup(Node.data) do begin pDF.Color:=Attribs.Foreground; pDB.Color:=Attribs.Background; cDb.checked:=fsBold in Attribs.Style; cDi.checked:=fsItalic in Attribs.Style; CDu.checked:=fsUnderline in Attribs.Style; cDs.checked:=fsStrikeOut in Attribs.Style; end; UpdatingControls:=false; end; procedure TSynUniDesigner.TotalUpdate; begin h.Reset; h.MainRules.Reset; h.ResetRange; h.Prepare; SampleMemo.Highlighter:=nil; SampleMemo.Highlighter:=h; SampleMemo.Refresh; end; procedure TSynUniDesigner.KwListChange(Sender: TObject); begin TSynSymbolGroup(tree.selected.data).KeywordsList.text:=memo.lines.text; TotalUpdate; end; procedure TSynUniDesigner.TreeChange(Sender: TObject; Node: TTreeNode); begin UpdatingControls:=true; case GetNodeType(Node) of ntRange:begin EFrom.text:=TSynRange(Node.data).OpenSymbol.Symbol; ETo.text:=TSynRange(Node.data).CloseSymbol.Symbol; cCloseOnWord.Checked:=TSynRange(Node.data).CloseOnTerm; cCloseOnEOL.Checked:=TSynRange(Node.data).CloseOnEol; cCaseSensitiveRg.Checked:=TSynRange(Node.data).CaseSensitive; EDelimitersRg.text:=Set2String(TSynRange(Node.data).TermSymbols); cAnyStart.Checked:=TSynRange(Node.data).OpenSymbol.BrakeType=btAny; SetControlAttributes(Node); pNum.visible:=true; ////TL! replaced ActivePage with ActivePageComponent PageControl.PageIndex := PageControl.Pages.IndexOf(Range.Name); end; ntRootRange:begin SetControlAttributes(Node); EDelimitersRt.text:=Set2String(TSynRange(Node.data).TermSymbols); pNum.visible:=true; cCaseSensitiveRt.Checked:=TSynRange(Node.data).CaseSensitive; ////TL! replaced ActivePage with ActivePageComponent PageControl.PageIndex := PageControl.Pages.IndexOf(RootRange.Name); end; ntKeyWords: begin SetControlKWAttributes(node); pNum.visible:=false; Memo.OnChange:=nil; Memo.lines.assign(TSynSymbolGroup(node.Data).KeywordsList); ////TL added @ Memo.OnChange:=@KwListChange; ////TL! replaced ActivePage with ActivePageComponent PageControl.PageIndex := PageControl.Pages.IndexOf(Keywords.Name); end; End; UpdatingControls:=false; end; Procedure TSynUniDesigner.AddingRange(Node:TTreeNode); var n:TTreeNode; r:TSynRange; begin if Node=nil then begin Tree.items.clear; n:=Tree.Items.Add(nil, _Root); h.MainRules.Name:=_Root; n.Data:=h.MainRules; n.ImageIndex:=0; n.SelectedIndex:=0; end else begin n:=Tree.Items.AddChild(Node, _NewRange); ////TL Added explicit parameters to create call r:=TSynRange.create('',''); r.Name:=_NewRange; r.OpenSymbol.BrakeType:=btAny; n.Data:=r; TSynRange(Node.data).AddRange(r); n.Expand(false); n.Selected:=true; tree.SetFocus; n.EditText; n.ImageIndex:=1; n.SelectedIndex:=1; end; SetDefaultRangeAttr(TSynRange(n.Data)); SetControlAttributes(n); end; Procedure TSynUniDesigner.DoAddRange(Sender:TObject); Begin AddingRange(Tree.selected); End; Procedure TSynUniDesigner.SampleDblClick(Sender:TObject); begin ////TL! replaced ActivePage with ActivePageComponent if (PageControl.Page[PageControl.PageIndex]=KeyWords) then memo.Lines.Add(SampleMemo.SelText); end; Procedure TSynUniDesigner.SetDefaultAttributes(Attr:TSynHighlighterAttributes); begin Attr.Background:=clWhite; Attr.Foreground:=clBlack; Attr.Style:=[]; end; Procedure TSynUniDesigner.SetDefaultRangeAttr(R:TSynRange); begin SetDefaultAttributes(R.NumberAttri); SetDefaultAttributes(R.DefaultAttri); end; procedure TSynUniDesigner.SetSample(const Value: string); begin SampleMemo.Text:=Value; end; procedure TSynUniDesigner.SetTitle(const Value: string); begin f.Caption := Value; end; procedure TSynUniDesigner.SortClick(Sender: TObject); var i:integer; begin With TStringList.Create do try Sorted:=true; Duplicates:=dupIgnore; for i:=0 to Memo.Lines.Count-1 do if trim(Memo.lines[i])<>'' then add(trim(Memo.lines[i])); sort; Memo.text:=trim(text); finally free; end; end; ////TL FPC wanted this global... moved from just inside the procedure below resourcestring sUniFileDescription = 'UniHighlighter Syntax'; procedure TSynUniDesigner.LoadFromFileClick(Sender: TObject); ////TL resourcestring ////TL sUniFileDescription = 'UniHighlighter Syntax'; var iDlg: TOpenDialog; iFile: TFileStream; iNode: TTreeNode; iRange: TSynRange; cSub: integer; begin { TreeMenuPopup should handle this } Assert( TObject(Tree.Selected.Data) is TSynRange ); iNode := Tree.Selected; iRange := TSynRange(iNode.Data); iDlg := TOpenDialog.Create( nil ); try iDlg.DefaultExt := '.hgl'; iDlg.Filter := sUniFileDescription + ' (*.hgl)|*.hgl'; if not iDlg.Execute then Exit; iFile := TFileStreamUTF8.Create( iDlg.FileName, fmOpenRead or fmShareDenyWrite ); try if iRange = h.MainRules then begin h.LoadFromStream( iFile ); Tree.Items.Clear; FillTree; Sample := h.SampleSource; iNode := Tree.Items[0]; end else begin iRange.LoadFromStream( iFile ); iNode.DeleteChildren; for cSub := 0 to iRange.SymbolGroupCount -1 do TreeAddSymbol( iNode, iRange.SymbolGroups[cSub] ); for cSub := 0 to iRange.RangeCount -1 do TreeAddRange( iNode, iRange.Ranges[cSub] ); end; iNode.Expand( False ); TotalUpdate; finally iFile.Free; end; finally iDlg.Free; end; end; procedure TSynUniDesigner.TreeMenuPopup(Sender: TObject); begin TreeMenu.Items.Items[0].Visible := (Tree.Selected <> nil) and ( TObject(Tree.Selected.Data) is TSynRange ); end; procedure TSynUniDesigner.TreeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var iNode: TTreeNode; begin if Button <> mbRight then Exit; iNode := Tree.GetNodeAt( X, Y ); if iNode <> nil then iNode.Selected := True; end; end.