liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity
tslediter/designer/utslcodeeditor.tsf

6102 lines
181 KiB
Plaintext
Raw Blame History

unit UtslCodeEditor;
{
编辑器相关的代码20220518整理,
20220520 分离调试器代码
}
interface
uses utslvcldesignerresource,cstructurelib,utslvclauxiliary,utslvclmemstruct,utslvclgdi,utslvclstdctl,
tslvcl,UTslmemo,UTslSynMemo,utslvclsyntaxparser,utslvcldebuger;
{
1. page标签
TPagees; TPageItem
2. TMemoPages ,TMemoPageItem
3. TEchoWnd
4. TFindResultWnd
5. FindStringWnd 查找框
5. TGotoLineWnd 跳转
}
function gettslexe();
function to_ansi_str(s);
type TPageItem=class() //标签项
function Create(AOwner);
begin
FCaption := "";
FOwner := AOwner;
end
function Recycling();virtual;
begin
FBitmapA := nil;
FBitmapB := nil;
Tag := nil;
end
published
property Caption read FCaption write SetCaption; //标题
property BitmapA read FBitmapA write SetBitmapA; //前面的图标
property BitmapB read FBitmapB write SetBitmapB; //后面的关闭图标
[weakref]tag; //绑定变量
Rect; //区域
protected
function SetCaption(s);
begin
if s and ifstring(s)then
begin
FCaption := s;
if FOwner then FOwner.ItemCaptionChenged(self);
end
end
private
function SetBitmapA(Bmp);
begin
if FBitmapA <> Bmp then
begin
FBitmapA := Bmp;
if FOwner then FOwner.ItemBitmapAChenged(self);
end
end
function SetBitmapB(Bmp);
begin
if FBitmapB <> Bmp then
begin
FBitmapB := Bmp;
if FOwner then FOwner.ItemBitmapBChenged(self);
end
end
FBitmapB;
FBitmapA;
FCaption;
[weakref]FOwner;
end
type TPage=class(TCustomControl) //标签
function Create(AOwner)
begin
Inherited;
FCloseBtn := false;
FPageItems := new TMyarrayB();
FMultiLine := 1;
FLineHeight := 16; //font.Height+6;
FLines := 0;
FItemIndex :=-1;
FWill_Drag := true;
font := array("height":16,"width":8,"escapement":0,"orientation":0,"weight":400,"italic":0,"underline":0,"strikeout":0,
"charset":0,"outprecision":0,"clipprecision":0,"quality":1,"pitchandfamily":1,"facename":"Courier New","color":0);
end
function GetPageRect(); //获得标签区域
begin
GetClientRect();
return FPageRect;
end
function PosInCurrentItemSection(xy); //点击部分
begin
if not FCurrentITem then return 0;
rc := FCurrentItem.Rect;
if not rc then return 0;
rc1 := rc;
rc1[2]:= rc1[0]+20;
if PointInrect(xy,rc1)then return 1;
rc1 := rc;
rc1[0]:= rc[2]-20;
if PointInrect(xy,rc1)then return 3;
if PointInRect(xy,rc)then return 2;
end
function DoControlAlign();override;
begin
CalcPageItemRect();
end
function CreateApageItem();virtual;
begin
return new TPageItem(self);
end
function itemcaptionchenged(it); //标签等改变
begin
if GetItemIndex(it)>= 0 then
begin
DoControlAlign();
InValidateRect(nil,false);
end
end
function ItemBitmapAChenged(it); //保存改变
begin
if GetItemIndex(it)>= 0 then InValidateRect(it.Rect,false);
end
function ItemBitmapBChenged(it); //关闭改变
begin
if GetItemIndex(it)>= 0 then InValidateRect(it.Rect,false);
end
function FontChanged();override;//字体改变
begin
FLineHeight := font.Height+6;
DoControlAlign();
end
function IncPaintLock();
begin
BeginUpdate();
end
function DecPaintLock();
begin
EndUpdate();
end
function DoEndUpDate();override;
begin
DoControlAlign();
inherited;
end
function GetClientRect();override; //获得新的区域
begin
r := inherited;
FPageRect := R;
r[1]+= FLineHeight * FLines; //FLabelsheight;
FPageRect[3]:= r[1];
return r;
end
function Paint();override; //绘制
begin
dc := Canvas;
ps := PAINTSTRUCT().rcPaint;
//dc.Pen.Color := rgb(180,180,100);
dc.Pen.Color := rgb(250,250,250);
dc.Pen.Width := 1;
dc.font := font;
for i := 0 to FPageItems.Length()-1 do
begin
it := FPageitems[i];
rc := it.Rect;
if not rc then continue;
if Intersectrect(it.Rect,ps)then
begin
if FItemIndex=i then //选中
begin
dc.Brush.Color := 0xFa901E;
end else
begin
dc.Brush.Color := 0xe4eeee;//rgb(228,228,228);//
end
dc.draw("roundrect",array(rc[0:1],rc[2:3],array(5,5)));
ny := integer(rc[1]+(rc[3]-rc[1]-16)/2);
if it.BitmapB then
begin
{rc1 := rc;
rc1[0]:= rc[2]-20;
rc1[2]-= 2;
rc1[1]+= 4;
rc1[3]-= 4;
dc.Stretchdraw(rc1,it.BitmapB);}
it.BitmapB.draw(dc,rc[2]-18,ny);
end
if it.BitmapA then
begin
it.BitmapA.draw(dc,rc[0]+2,ny);
{rc1 := rc;
rc1[2]:= rc1[0]+20;
rc1[0]+= 2;
rc1[2]-= 2;
rc1[1]+= 2;
rc1[3]-= 2;
dc.Stretchdraw(rc1,it.BitmapA);}
end
rc[0]+= 20;
dc.DrawText(to_ansi_str(it.caption),rc,DT_nOPREFIX .| DT_LEFT .| DT_SINGLELINE .| DT_VCENTER);
end
end
if FCloseBtn and((FPageItems.Length()>0))then
begin
Closebmp();
rc := ClientRect;
FBmpClose.Draw(dc,rc[2]-25,3,SRCAND);
//rc := ClientRect;
//rc := array(rc[2]-25,1,rc[2]-1,19);
//dc.Stretchdraw(rc,FBmpClose);
end
end
function SetSel(it); //选中
begin
idx := GetItemIndex(it);
if idx >= 0 and idx <> FItemIndex then
begin
ItemIndex := idx;
end
end
function CloseAllItem(it); //关闭
begin
FItemINdex :=-1;
FCurrentITem := nil;
saveit := nil;
for i,v in FPageItems.Data do
begin
if v=it then
begin
saveit := it;
continue;
end
end
FPageItems.Splice(0,FPageItems.Length());
if saveit then
begin
FItemINdex := 0;
FCurrentITem := it;
FPageItems.push(it);
end
//InValidateRect(nil,false);
DoControlAlign();
InValidateRect(nil,false);
end
function DeleteItemByIndex(idx);virtual;//删除序号
begin
if idx >= 0 and idx<FPageItems.length()then
begin
if idx=FItemIndex then
begin
if CallSelChanging()then return;
end
FPageItems.Splice(idx,1);
CalcPageItemRect();
if idx=FItemIndex then
begin
FItemIndex :=-1;
FCurrentItem := nil;
ItemIndex := max(min(FPageItems.length()-1,idx),0);
if FItemINdex=-1 then
begin
CallSelChanged();
end
end else
if idx<FItemIndex then
begin
FItemIndex := FItemIndex-1;
FCurrentItem := FPageItems[FItemIndex];
end
InValidateRect(nil,false);
end
end
function MouseDragDo(o,e); //移动拖拉
begin
if FIs_Draging then
begin
if GetItemIndexByPos(e.pos)=itemIndex then
begin
FNot_DragLive := true;
_wapi.ImageList_DragLeave(self.Handle);
end else
begin
nxy := clienttowindow(e.xpos,e.ypos);
if FNot_DragLive then
begin
_wapi.ImageList_DragEnter(self.Handle,nxy[0],nxy[1]);
FNot_DragLive := false;
end
_wapi.ImageList_DragMove(nxy[0],nxy[1]);
end
end
end
function MouseMove(o,e);override;
begin
MouseDragDo(o,e);
inherited;
end
function MouseDrageLeave(); //离开移动
begin
if FIs_Draging then
begin
FNot_DragLive := false;
_wapi.ImageList_DragLeave(self.Handle);
_wapi.ImageList_EndDrag();
FWill_Drag := true;
FIs_Draging := false;
_wapi.clipcursor(0);
end
end
function MouseUp(o,e);override; //鼠标放开
begin
if e.button=mbLeft then
begin
if FIs_Draging then
begin
MouseDrageLeave();
idx := GetItemIndexByPos(e.pos);
IF idx >= 0 and FItemIndex <> idx then
begin
if FItemIndex<idx then
begin
for i := FItemIndex to idx-1 do
begin
FPageITems.SWap(i,i+1);
end
end else
begin
for i := FItemIndex downto idx+1 do
begin
FPageITems.SWap(i,i-1);
end
end
FItemIndex := idx;
DoControlAlign();
end
InvalidateRect(nil,false);
DecPaintLock();
end else
begin
if FCloseBtnClicked then //点击
begin
rc := ClientRect;
rc := array(rc[2]-25,1,rc[2]-1,19);
if PointInRect(e.pos,rc)then
begin
callDatafunction(FOnCloseClick,o,e);
end
end
end
end
return inherited;
end
function MouseDown(o,e);override; //按下
begin
if e.button=mbMiddle then
begin
idx := GetItemIndexByPos(e.pos);
if idx>=0 then
begin
e._Tag := FPageitems[idx];
callDatafunction(fOnbmpbclick,o,e);
idx := GetItemIndex(FCurrentItem);
ItemIndex := idx;
return ;
end
end
if e.shiftdouble() then //处理新建
begin
idx := GetItemIndexByPos(e.pos);
if idx=-1 then
begin
callDatafunction(OnDblClick,o,e);
end
return ;
end
if e.button=mbLeft then
begin
cidx := posinitembmpb(e.pos);
if cidx>=0 then
begin
e._Tag := FPageitems[cidx];
callDatafunction(fOnbmpbclick,o,e);
idx := GetItemIndex(FCurrentItem);
ItemIndex := idx;
return ;
end
end
idx := GetItemIndexByPos(e.pos);
itemindex := idx;
FCloseBtnClicked := false;
if e.button=mbLeft and idx >= 0 then
begin
nxy := clienttowindow(e.xpos,e.ypos);
if FCanDraged and FWill_Drag then
begin
IncPaintLock();
FWill_Drag := false;
FIs_Draging := true;
CreateImageList();
_wapi.ImageList_BeginDrag(FDRageimglist,0,12,12);
FNot_DragLive := true;
//_wapi.ImageList_DragEnter(self.Handle,nxy[0],nxy[1]);
crect := GetPageRect();
ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3]));
_wapi.clipcursor(ps);
end
end else
begin
rc := ClientRect;
rc := array(rc[2]-25,1,rc[2]-1,19);
if PointInRect(e.pos,rc)then
begin
FCloseBtnClicked := true;
end
end
FCanDraged := true;
return inherited;
//if 3=PosInCurrentItemSection(e.pos) then FCurrentITem.Caption := datetimetostr(now());
end
FCanDraged; //修正提示导致修改后提示导致drage 体验问题
function PostInCloseRect(ps); //是否点击关闭
begin
rc := ClientRect;
rc := array(rc[2]-25,1,rc[2]-1,19);
return PointInRect(ps,rc);
end
function GetItemIndexByPos(xy); //根据位置获得点击的item
begin
for i := 0 to FPageItems.Length()-1 do
begin
if PointInrect(xy,FPageItems[I].Rect)then return i;
end
return -1;
end
function posinitembmpb(xy); //点击图标位置
begin
for i := 0 to FPageItems.Length()-1 do
begin
it := FPageItems[I];
if not it.BitmapB then continue ;
ri := it.Rect;
ri[0] := ri[2]-18;
ri[1]+=2;
ri[3]-=2;
ri[2]-=2;
if PointInrect(xy,ri)then return i;
end
return -1;
end
Function GetItemIndex(it); //获得序号
begin
for i := 0 to FPageItems.length()-1 do
begin
if it=FPageitems[i]then
begin
return i;
end
end
return -1;
end
function Recycling();override;
begin
FPageItems.Splice(0,FPageItems.Length());
FOnSelChanged := nil;
FOnSelchanging := nil;
FCurrentItem := nil;
FItemIndex :=-1;
FOnCloseClick := nil;
fOnbmpbclick := nil;
inherited;
end
property CurrentItem read FCurrentItem; //当前的页面
property OnSelChanged read FOnSelChanged write FOnSelChanged; //选择已经改变
property OnSelChanging read FOnSelChanging write FOnSelChanging; //选择正在改变
property OnCloseClick read FOnCloseClick write FOnCloseClick; //关闭
property Onbmpbclick read FOnbmpbclick write fOnbmpbclick;
property MultiLine read FMultiLine write SetMultiLine;
property CloseBtn read FCloseBtn write SetCloseBtn; //是否有关闭按钮
property Lines read FLines; //多少行
property PageItems read FPageItems; //页面集合对象
property pageitemcount read getpageitemcount; //页面数量
property ItemIndex read FItemIndex write SetItemIndex;
protected
function CallSelChanged();virtual;
begin
if not OnSelChanged then return false;
e := new tuieventbase();
callDatafunction(OnSelChanged,self(true),e);
end
function CallSelChanging();virtual;
begin
if not FOnSelchanging then return false;
e := new tuieventbase();
CallDatafunction(FOnSelchanging,self(true),e);
return e.skip;
end
function CalcPageItemRect(); //计算位置
begin
li := 0;
cw := Font.Width;
r := class(TCustomControl).ClientRect;
x := 0;
xct := 0;
for i := 0 to FPageitems.Length()-1 do
begin
it := FPageitems[i];
itwidth := length(it.Caption) * cw+50;
if xct>0 and(r[2]-(FCloseBtn?20:0))<x+itwidth then
begin
li++;
xct := 0;
x := 0;
end
it.Rect := array(x,li * FLineHeight,x+itwidth,(li+1) * FLineHeight);
x += itwidth;
xct++;
end
FLines := li+1;
//FPageRect := array(0,);
end
private
function CreateImageList();
begin
if not FDRageimglist then
begin
FImgs := new TCustomImageList(self);
FImgs.addbmp(MoveFileBmp());
FDRageimglist := FImgs.Handle;
end
end
[weakref]FCloseBtnClicked; //点击
[weakref]fOnbmpbclick;
FPageRect;
FIs_Draging;
FWill_Drag;
FNot_DragLive;
FDRageimglist;
FCloseBtn;
FBmpClose;
FPageItems;
FItemIndex;
FCurrentItem;
FMoveFileBmp;
function MoveFileBmp();
begin
if not FMoveFileBmp then
begin
FMoveFileBmp := new TBitmap();
s := "0502000000060400000074797065000203000000696D670006040000006461746
100022001000089504E470D0A1A0A0000000D4948445200000020000000200806
000000737A7AF4000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA864000000B549444154
5847ED93B10DC3201045D98231E859802D988211682929A1A3652E98E2223B582
1220DC28785C2979E849BFB4F982350851032853A8D404A09952DD0251063BC85
7A669780520A38E7430C0960B096C0E3BFA07E4823D433BB043058EB06F61A62D
025B0D71083B56E60AF21065D027B0D31F82F81631EA514186320840029E57C81
9CF379F6DE9FDF5AEBD2F6CE1481ABDC18539A3E4117B8CAADB5A5E53BE80207C
EB9D2D0A611B89B104299FE2B002F3C83B9B0E26C11600000000049454E44AE42
608200";
FMoveFileBmp.ReadVcon(HexformatStrToTsl(s));
end
return FMoveFileBmp;
end
function Closebmp();
begin
if not FBmpClose then
begin
FBmpClose := new TBitmap();
s := "0502000000060400000074797065000203000000696D670006040000006461746
100025601000089504E470D0A1A0A0000000D494844520000001C000000100806
00000005CF1FEF000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA864000000EB49444154
484B63F88F03FC7DFCF0FFEF3327C9C6B8005E0BDF19A89285BFB637424DC1040
42DFC36B1FBFFD7E61A0C43D1F17B0BDDFF7FAE5DFEFFC1C789320B3F0679FEFF
73E7365E4BDF3B9881D57C9F3E09CCA7C84210865BDA5A0F1783E10F1E7628968
130C5168230CCD26F3D6D08B100370CCB40982A168230DCD2C9BD7036BA65204C
350B411866112ECB40983616DEBE497B0B9183F163A007381BD02C48B1C5D9072
F47AC96526C21CCB26FD326A2180CC21F5CAC302CA5C842B865FD9D7003D1F17B
5B63144B29B2105CB4B537A058800DBF37D7A14ED1460E26DB426CD50EB1183BF
8FF1F00B989BEC710621E4C0000000049454E44AE42608200";
FBmpClose.ReadVcon(HexformatStrToTsl(s));
end
return FBmpClose;
end
function SetCloseBtn(v);
begin
nv := v?true:false;
if nv <> FCloseBtn then
begin
FCloseBtn := nv;
DoControlAlign();
end
end
function getpageitemcount();
begin
return FPageItems.length();
end
function SetItemIndex(idx);
begin
if idx >= 0 and idx<FPageItems.Length()and idx <> FItemIndex then
begin
if CallSelChanging()then return;
FItemIndex := idx;
FCurrentItem := FPageItems[idx];
InValidateRect(nil,false);
CallSelChanged();
end
end
FMultiLine;
FLineHeight;
FLines;
FOnSelChanged;
FOnCloseClick;
FOnSelchanging;
function SetMultiLine();
begin
end
end
type TEditerAuxiliary=class(TPage) //辅助窗口
function Create(AOwner);
begin
inherited;
Caption := "message:";
Ftimer := new TTimer(self);
Ftimer.Interval := 200;
Ftimer.Ontimer := thisfunction(BdownTimeOut);
Ftimer.Enabled := false;
//FEchoItem := CreateApageItem();
//FFileFindeItem := CreateApageItem();
OnSelChanged := thisfunction(OnSelChangedCall);
CloseBtn := true;
onnotification := function(o,e)begin
ms := e.message;
if ifarray(ms) and ms[0] ="font" then
begin
font := ms[1];
InValidateRect(nil,false);
end
end
end
function WMNCLBUTTONDOWN(o,e):WM_NCLBUTTONDOWN;override;
begin
FIgnoreSize := true;
Ftimer.Enabled := true;
end
function BdownTimeOut(o,e); //定时器处理
begin
if(_wapi.GetAsyncKeyState(VK_LBUTTON).& 0xFF00)>0 then
begin
end else
begin
FIgnoreSize := false;
o.Enabled := false;
p := Parent;
if p then p.DoControlAlign();
end
end
function DoControlAlign();override;
begin
if FIgnoreSize then
begin
end
inherited;
rc := ClientRect;
//单独处理linux的情况
{$ifdef linux}
rc[0]+= 2;
rc[2]-= 2;
rc[3]-= 2;
{$endif}
if CurrentItem then wnd := CurrentItem.Tag;
if wnd then wnd.SetBoundsRect(Rc);
end
function ShowPopUp();//弹出
begin
if not WSpOPUp then
begin
WSpOPUp := true;
Parent.DoControlAlign();
end
if not Visible then Visible := true;
end
function MouseDown(o,e);override;//点击处理
begin
if e.shiftdouble()and e.button()=mbLeft then
begin
WSpOPUp := not WSpOPUp;
Parent.DoControlAlign();
if not WSpOPUp then
begin
_wapi.SetWindowPos(self.Handle,0,0,0,0,0,SWP_NOMOVE .| SWP_NOSIZE .| SWP_NOREDRAW .| SWP_NOSENDCHANGING);
end
end else
if GetItemIndexByPos(e.pos)>= 0 then
begin
inherited;
end else
if PostInCloseRect(e.pos)then
begin
//echo "------------\r\n";
inherited;
end else
begin
if WSpOPUp then _send_(WM_SYSCOMMAND,0xF012,0);
end
end
function Recycling();override;
begin
Ftimer := nil;
FEchoWnd := nil;
FFileFindWnd := nil;
FOnCloseClick := nil;
inherited;
end
function ShowByTag(tg); //显示
begin
its := Pageitems;
for i := 0 to its.Length()-1 do
begin
if its[i].tag=tg then
begin
ItemIndex := i;
//visible := true;
return;
end
end
end
function OnSelChangedCall(o,e);
begin
if not CurrentItem then Caption := "--";
rc := ClientRect;
its := PageItems;
for i := 0 to its.Length()-1 do
begin
it := its[i];
if CurrentItem=it then
begin
it.tag.SetboundsRect(rc);
it.tag.Visible := true;
caption := it.Tag.Caption;
end else
it.tag.Visible := false;
end
end
function AddWnd(wnd); //加入窗口
begin
if wnd is class(TWincontrol)then
begin
its := PageItems;
for i := 0 to its.Length()-1 do
begin
it := its[i];
if it.tag=wnd then return;
end
IncPaintLock();
it := CreateApAgeItem();
it.Caption := wnd.Caption;
it.tag := wnd;
wnd.visible := 0;
wnd.Parent := self;
PageItems.Push(it);
if PageItems.Length()=1 then
begin
itemIndex := 0;
end
DecPaintLock();
end
end
FEchoWnd;
FFileFindWnd;
[weakref]FOnCloseClick;
private
Ftimer;
FIgnoreSize;
end
type TExecuteEditer=class(TCustomControl) //执行编辑器
Protected
Type TExecuteMemoComp=class(TSynCompletion) //自动完成对象
function Create(AOwner);
begin
inherited;
IgnoreCase := false;
end
function PrepareCompletion(c);override; //获得数据
begin
//通过SetCompData 设置数据
if Not Memo then return;
d := array();
for i,v in array("FULL_CURRENT_PATH","CURRENT_DIRECTORY","SEARCH_PATH","TSL_EXE") do
begin
d[i,"caption"]:= v;
d[i,"value"]:= v;
d[i,"lvalue"]:= lowercase(v);
cl := length(v);
d[i,"clen"]:= cl;
d[i,"vlen"]:= cl;
end
SetCompData(d);
end
end
type TListBoxb=class(TListbox)//选择下拉
function Create(AOwner);
begin
inherited;
end
function CheckListItem(it);override;
begin
return ifobj(it);
end
function GetItemText(i);override;//获得标签
begin
it := GetItem(i);
if it then return it.FCaption;
return "";
end
function InsureItemVisible(idx); //移动当前的格子
begin
return ;//
rc := GetIdxRect(idx);
c := ClientRect;
if rc[1]<c[1]then
begin
SetYpos(-1+GetYPos()+(rc[1]-c[1])/GetYScrollDelta());
end else
if rc[3]>c[3]then
begin
SetYpos(1+GetYPos()+(rc[3]-c[3]+1)/GetYScrollDelta());
end
end
end
type TComboBoxb=class(TCombobox)
function Create(AOwner);
begin
INherited;
end
function CreateAlist();override;
begin
return new TListBoxb(self);
end
end
type TCobItem=class
function Create(d);
begin
FCaption := "";
FExe := "";
if not ifarray(d)then return;
FCaption := d["caption"];
FExe := d["exe"];
end
FCaption;
FExe;
end
public
function showexeediter();
begin
FMemo.ExecuteCommand(FMemo.ecGotoXY,array(1,1));
FMemO.SetFocus();
show();
end
function Create(AOwner);
begin
inherited;
WSsYSMenu := true;
WsDlgModalFrame := true;
WsSizeBox := true;
WSpOPUp := true;
FItems := new TMyArrayB();
caption := "编辑 Execute.....";
SetBoundsRect(array(50,50,930,201));
FMemo := new TSynMemoNorm(self);
FMemo.OnKeyPress := function(o,e)
begin
if 13=e.charcode then
begin
if o.Completion and o.Completion.Visible then return ;
e.skip := true;
//doSaveCurrentName();
end
end
{FMemo.OnKeyDown := function(o,e)
begin
case e.charcode of
VK_DOWN:
begin
e.skip := true;
FChooser.ItemIndex += 1;
end
VK_UP:
begin
e.skip := true;
FChooser.ItemIndex -= 1;
end
end;
end}
FMemo.Border := true;
FMemo.parent := self;
FChooser := new TComboBoxb(self); //new TEditList(self);
FChooser.ReadOnly := false;
FChooser.parent := self;
FOkBtn := new TBtn(self);
FCancelBtn := new TBtn(self);
FEgnorBtn := new TBtn(self);
cp := new TExecuteMemoComp(self);
FMemo.Completion := cp;
cp.PrepareCompletion();
OnClose := function(o,e)
begin
e.skip := true;
o.visible := false;
end
FOkBtn.Caption := "保存/添加";
FCancelBtn.Caption := "删除当前";
FEgnorBtn.caption := "取消";
FOkBtn.parent := self;
FCancelBtn.parent := self;
FEgnorBtn.parent := self;
FMemo.parent := self;
FChooser.OnSelChanged := thisfunction(OnChooserChanged);
FCancelBtn.OnClick := thisfunction(DeleteCurrent);
FOkBtn.OnClick := thisfunction(doSaveCurrentName);
FEGnorBtn.OnClick := thisfunction(OnIgnore);
end
function Recycling();override;
begin
inherited;
FMemo := nil;
FChooser := nil;
FCancelBtn := nil;
FOkBtn := nil;
FEgnorBtn := nil;
Fonsaveclk := nil;
end
function DeleteCurrent();
begin
if length(FChooser.Items)<2 then return ;
FChooser.DeleteItem(FChooser.ItemIndex);
end
function DoControlAlign();override;
begin
if FMemo and FChooser and FCancelBtn and FOkBtn and FEgnorBtn then
begin
r := clientRect;
r1 := r;
r1[3]-= 30;
FMemo.SetBoundsRect(r1);
tp := r1[3]+2;
wd := 200;
x := 50;
FChooser.SetBoundsRect(array(x,tp,x+200,tp+26));
x += 200;
FCancelBtn.SetBoundsRect(array(x+20,tp,x+20+100,tp+26));
x += 120;
FOkBtn.SetBoundsRect(array(x+20,tp,x+100,tp+26));
x += 120;
FEgnorBtn.SetBoundsRect(array(x+20,tp,x+100,tp+26));
x += 120;
end
end
function OnIgnore();
begin
idx := FChooser.ItemIndex;
if idx >= 0 then
begin
it := FChooser.GetItem(idx);
FChooser.Editer.Text := it.FCaption;
FMemo.Text := it.FExe;
end
Visible := false;
end
function GetCurrentExuteparams(f);
begin
return ParserCommandLine(GetCurrentExuteString(f));
end
function getcurrentcommandline();
begin
idx := FChooser.ItemIndex;
if not(idx >= 0)then return "";
s := FChooser.GetItem(idx).fexe;
if not ifstring(s)then return "";
return s;
end
function GetCurrentExuteString(f); //获得当前的执行字符串
begin
if not ifstring(f)then return "";
if not fileexists("",f)then return "";
idx := FChooser.ItemIndex;
if not(idx >= 0)then return "";
s := FChooser.GetItem(idx).fexe;
if not ifstring(s)then return "";
s := replacetext(s,"$(FULL_CURRENT_PATH)",f);
dir := "";
sp := ioFileseparator();
for i := length(f)downto 1 do
begin
if f[i]=sp then
begin
dir := f[1:i-1];
break;
end
end
s := replacetext(s,"$(CURRENT_DIRECTORY)",dir);
s := replacetext(s,"$(SEARCH_PATH)",owner.getlibpathstr());
s := replacetext(s,"$(TSL_EXE)",gettslexe());
len := length(s);
return s;
end
function doSaveCurrentName();
begin
Visible := false;
s := FChooser.Editer.Text;
its := FChooser.Items;
len := Length(its);
for i,v in its do
begin
if v.FCaption=s then
begin
v.FExe := FMemo.Text;
return callDatafunction( Fonsaveclk,self,self);
end
end
if cannotadd then return ;
FChooser.InsertItem(new TCobItem(array("caption":s,"exe":FMemo.Text)),0);
FChooser.ItemIndex := 0;
callDatafunction( Fonsaveclk,self,self);
end
function OnChooserChanged(o,e);
begin
idx := o.ItemIndex;
if idx >= 0 then
begin
it := O.GetItem(idx);
FMemo.Text := it.fexe;
end else
FMemo.Text := "";
FMemo.ClearUndo();
end
function GetData(); //获得数据
begin
r := array();
its := FChooser.Items;
if not(its)then return r;
r["itemindex"]:= FChooser.ItemIndex;
for i,v in its do
begin
r["items"][i]:= array("caption":v.FCaption,"exe":v.FExe);
end
return r;
end
function SetData(d); //设置数据
begin
if ifarray(d)then
begin
SetItems(d["items"]);
FChooser.ItemIndex := d["itemindex"];
end
end
property Items read FItems Write SetItems;
property onsaveclk read Fonsaveclk write Fonsaveclk;
property cannotadd read FCannotadd write FCannotadd;
private
FCannotadd;
Fonsaveclk;
FMemo;
FChooser;
FCancelBtn;
FOkBtn;
FItems;
FEgnorBtn;
private
function GetItemIndex();
begin
return FChooser.Items;
end
function SetItems(its); //设置信息
begin
vs := array();
for i,v in its do
begin
if ifarray(v)and ifstring(v["caption"])and ifstring(v["exe"])then
begin
vi := new TCobItem(v);
vs[length(vs)]:= vi;
end
end
FChooser.Items := vs;
end
end
type TFTSLScriptMemo = class(TFTSLScriptcustomMemo)
function create(AOwner);
begin
inherited;
global g_editer_font_size;
if g_editer_font_size and ifarray(g_editer_font_size) then
begin
ft := array("width":g_editer_font_size["width"]+1,"height":g_editer_font_size["height"]+2);
font := ft;
end
end
function SetFocus();override;
begin
global g_script_can_set_not_focus;
if g_script_can_set_not_focus then return ;
if HandleAllocated() then _wapi.SetFocus(self.Handle);
end
end
type TPageEditerItem=class(TPageItem)
FPageOrderId; //序号有调用者使用
FEditer; //编辑器
FSynType;
FInitCompletion;
FDebuger;
fisnewfile;
function create(AOwner);override;
begin
inherited;
FSynType := "";
FEnCode := "ANSI";
FGetInfoText := "";
FLastVersion := "";
FEditer := new TFTSLScriptMemo(AOwner);
FEditer.Align := FEditer.alClient;
FEditer.Visible := false;
FEditer._Tag := self;
Fscripttype := 0;
end
function Recycling();override;
begin
FDebuger := nil;
inherited;
FEditer.Recycling();
FEditer := nil;
end
function markline(l,f); //标记被调用
begin
if FDebuger then
begin
if f then
begin
FDebuger.addbreak(self,l);
end else
begin
FDebuger.removebreak(self,l);
end
end
end
function ScriptPathIs(v);
begin
return filenameIsTheSame(v,FScriptPath);
end
published
property scripttype read Fscripttype write setFscripttype;
property ScriptPath read FScriptPath write SetScriptPath; //文件名
property scriptname read fscriptname;
property OrigScriptPath read FOrgScriptPath;
property TslSynText read FTslSynText write FTslSynText;
property LastText read FLastVersion; //最新的版本
property EnCode read FEnCode;
RepreComple;
FISstm;
Fscripttype;
///////////////////设计器相关//////////////////////////////////////
public
function replacemfunc(fn,txt);
begin
d := getmfunctioninfo();
for i,v in d do
begin
if v["name"] = fn then
begin
rs := PosToRowCol(FTslParser2.Script,array(v["startpos"]-1,v["endpos"]));
p := rs[0];
if ifarray(p)then
begin
FEditer.ExecuteCommand(FEditer.ecGotoXY,p);
FEditer.ExecuteCommand(FEditer.ecSelGotoXY,rs[1]);
FEditer.ExecuteCommand(FEditer.ecString,txt);
end
return 1;
end
end
end
function Addfiled(fld); //添加成员变量
begin
if not FTslParser then return 0;
if not(fld and ifstring(fld))then return;
nfld := lowercase(fld);
nt := str2array(nfld,":");
nfld := nt[0];
nfldt := nt[1];
d := GetClassInfo();
if not(d and ifarray(d))then return 0;
for i,v in d["filed"] do
begin
if v["name"]=nfld then return 1;
end
crec := GetCreateFunctionRec(d);
if crec then
begin
p := crec[0];
if ifarray(p)then
begin
FEditer.ExecuteCommand(FEditer.ecGotoXY,p);
FEditer.ExecuteCommand(FEditer.ecString,fld+";\r\n ");
end
end
end
function getuses();
begin
if not FTslParser then return 0;
d := GetClassInfo();
if not(d and ifarray(d))then return 0;
return d["uses"]["info"];
end
function adduses(libs);//添加uses
begin
if not FTslParser then return 0;
if not(libs and ifarray(libs))then return;
d := GetClassInfo();
if not(d and ifarray(d))then return 0;
usd := d["uses"];
if usd then //存在uses
begin
adu := lowercase(libs) minus (usd["info"]) ;
if adu then
begin
adus := array2str(adu,",");
if adus then
begin
usd["beg"]+=5;
adus +=",";
rec := GetInfoRowCol2(usd);
p := rec[0];
if ifarray(p) then
begin
FEditer.ExecuteCommand(FEditer.ecGotoXY,rec[0]);
FEditer.ExecuteCommand(FEditer.ecString,adus);
end
end
end
end { else
begin
adus := array2str(lowercase(libs),",");
ups := d["inheritedendpos"];
if adus and ups>0 then
begin
ups +=1;
adus+=";";
//添加uses
end
end }
end
function GetCreateFunctionRec(d); //获得插入函数为位置
begin
fi := d["funcsinfo"];
for i,v in fi do
begin
if v["name"]="create" then
begin
return GetInfoRowCol(v);
end
end
return 0;
end
function Delfiled(fld,nn); //删除成员变量
begin
if not FTslParser then return 0;
if not(fld and ifstring(fld))then return;
if not ifstring(nn)then nn := "";
nfld := lowercase(fld);
d := GetClassInfo();
if not(d and ifarray(d))then return 0;
for i,v in d["filed"] do
begin
if v["name"]=nfld then
begin
frec := GetInfoRowCol2(v);
if ifarray(frec[0])and ifarray(frec[1])then
begin
FEditer.ExecuteCommand(FEditer.ecGotoXY,frec[0]);
FEditer.ExecuteCommand(FEditer.ecSelGotoXY,frec[1]);
FEditer.SelText := nn?(nn+";"):"";
end
wek := v["dstatic"];
if wek then
begin
frec := GetInfoRowCol2(wek);
if ifarray(frec[0])and ifarray(frec[1])then
begin
FEditer.ExecuteCommand(FEditer.ecGotoXY,frec[0]);
FEditer.ExecuteCommand(FEditer.ecSelGotoXY,frec[1]);
FEditer.SelText := nn?(nn+";"):"";
end
end
wek := v["weakref"];
if wek then
begin
frec := GetInfoRowCol2(wek);
if ifarray(frec[0])and ifarray(frec[1])then
begin
FEditer.ExecuteCommand(FEditer.ecGotoXY,frec[0]);
FEditer.ExecuteCommand(FEditer.ecSelGotoXY,frec[1]);
FEditer.SelText := nn?(nn+";"):"";
end
end
end
end
end
function GoToFunction(fn);
begin
if not(ifstring(fn))then return false;
nfld := lowercase(fn);
d := GetClassInfo();
if not ifarray(d)then return 0;
for i,v in d["funcsinfo"] do
begin
if v["name"]=nfld then
begin
crec := GetInfoRowCol(v);
if ifarray(crec)and ifarray(crec[0])then
begin
FEditer.ExecuteCommand(FEditer.ecGotoXY,crec[0]);
end
return true;
end
end
end
function AddFunction(fn,finfo); //添加函数
begin
if not FTslParser then return 0;
if not(ifstring(fn)and fn and ifstring(finfo))then return 0;
nfld := lowercase(fn);
d := GetClassInfo();
if not ifarray(d)then return 0;
for i,v in d["funcsinfo"] do
begin
if v["name"]=nfld then
begin
crec := GetInfoRowCol(v);
if ifarray(crec)and ifarray(crec[0])then
begin
FEditer.ExecuteCommand(FEditer.ecGotoXY,crec[0]);
end
return true;
end
end
crec := GetCreateFunctionRec(d);
if crec then
begin
p := crec[1];
if ifarray(p)then
begin
FEditer.ExecuteCommand(FEditer.ecGotoXY,p);
FEditer.ExecuteCommand(FEditer.ecString,"\r\n"+finfo+"\r\n ");
end
end
return true;
end
function GetLastLoadTime(); //最新时间
begin
return FLastFileTime;
end
function ReGetLastLoadTime(); //重新获得时间
begin
fi := FileList("",FScriptPath);
FLastFileTime := fi[0,"Time"];
return FLastFileTime;
end
function PrePareSave(); //准备保存
begin
if not FEditer.ChangedFlag then
begin
if RepreComple then itemPareCompletion();
return false;
end
if FEditer.ReadOnly then
begin
if RepreComple then itemPareCompletion();
return false;
end
t := FEditer.Text;
if FLastVersion=t then
begin
FEditer.ChangedFlag := false;
if RepreComple then itemPareCompletion();
return false;
end
FLastVersion := t;
itemPareCompletion();
//FEditer.PrePareCompletion(t); //准备自动完成
FEditer.ChangedFlag := false;
return true;
end
function itemPareCompletion();
begin
t := caption;
cp := FEditer.Completion;
if cp then cp.PrePareCompletion(t);
RepreComple := false;
end
function ToUnicode_big();
begin
if FEnCode="UCS2-big" then return;
if FEnCode = "None" then return ;
FEnCode := "UCS2-big";
FEditer.ChangedFlag := true;
FLastVersion := "";
end
function ToUniocode_little();
begin
if FEnCode="UCS2-little" then return;
if FEnCode = "None" then return ;
FEnCode := "UCS2-little";
FEditer.ChangedFlag := true;
FLastVersion := "";
end
function ToUTF8();
begin
if FEnCode="UTF8" then return;
if FEnCode = "None" then return ;
FEnCode := "UTF8";
FEditer.ChangedFlag := true;
FLastVersion := "";
return;
end
function ToUTF8BOM();
begin
if FEnCode="UTF8 BOM" then return;
if FEnCode = "None" then return ;
FEditer.ChangedFlag := true;
FEnCode := "UTF8 BOM";
FLastversion := "";
end
function ToANSI();
begin
if FEnCode="ANSI" then return;
if FEnCode = "None" then return ;
FEditer.ChangedFlag := true;
FEnCode := "ANSI";
FLastversion := "";
end
function currentcodeisnone();
begin
if FEnCode="UTF8" then
begin
FEnCode := "None";
end
end
function CurrentCodeIsUtf8();
begin
if FEnCode="ANSI" or FEnCode="None" then
begin
s := FEditer.Text;
try
s := UTF8toansi(s);
FEditer.Text := s;
FEnCode := "UTF8";
except
end
end
end
function CurrentCodeIsAnsi();
begin
if FEnCode="UTF8" then
begin
FEnCode := "ANSI";
end
end
function SetLoadScript(s); //保存文件
begin
if not ifstring(s)then return;
strcode := 0;
FEnCode := "None";
if(length(s)>= 2)and ord(s[1])=0xFE and ord(s[2])=0xFF then //ucs2-big
begin
strcode := 2;
FEnCode := "UCS2-big"; //要转换
if length(s)=2 then s := "";
else
begin
s1 := "";
setlength(s1,length(s)-2);
for i := 3 to length(s)-1 step 2 do
begin
s1[i-2]:= s[i+1];
s1[i-1]:= s[i];
end
s := unicodetomultibyte(s1,936);
end
end else
if(length(s)>= 2)and ord(s[1])=0xFF and ord(s[2])=0xFE then //ucs2-little
begin
strcode := 4;
FEnCode := "UCS2-little";
if length(s)=2 then s := "";
else
begin
s := unicodetomultibyte(s[3:],936);
end
end else
if(length(s)>= 3)and ord(s[1])=0xEF and ord(s[2])=0xBB and ord(s[3])=0xBF then
begin
FEnCode := "UTF8 BOM";
if length(s)=3 then s := "";
else s := utf8toansi(s[4:]);
strcode := 1;
end
if(0=strcode)then
begin
if IsTextUTF8(s)=1 then
begin
FEnCode := "UTF8";
strcode := 1;
s := utf8toansi(s);
end else
begin
if isTextGBK(s)=1 then
begin
FEnCode := "ANSI";
end
end
end
FLastVersion := s;
FEditer.Text := s;
FEditer.ExecuteCommand(FEditer.ecGotoXY,array(1,1));
FEditer.ClearUndo();
if FEnCode = "None" then FEditer.ReadOnly := true;
FEditer.ChangedFlag := false;
if not FTslSynText then return;
if not(s)then return;
if not FTslParser then FTslParser := new ttslscripparser(); #! end
//FTslParser := nil;
end
function GetClassInfo(); //获得信息
begin
if not FTslParser then return array();
txt := FEditer.Text;
if txt <> FGetInfoText then
begin
FGetInfoText := txt;
FTslParser.Script := txt;
FGetInfoChace := FTslParser.GetClassInfo(1);
end
return FGetInfoChace;
end
function getmfunctioninfo();
begin
if not ftslparser2 then
ftslparser2 := new ttslscripparser();
ftslparser2.Script :=FEditer.Text;
return ftslparser2.gettslfunctions();
end
private
fscriptname;
ftslparser2;
FEnCode;
FLastFileTime;
FTslSynText;
function GetInfoRowCol(v); //获得行列
begin
rs := PosToRowCol(FGetInfoText,array(v["startpos"]-1,v["endpos"]));
return rs;
end
function GetInfoRowCol2(v); //获得行列结尾
begin
rs := PosToRowCol(FGetInfoText,array(v["beg"]-1,v["end"]));
return rs;
end
function PosToRowCol(s,ps); //位置换算
begin
r := array();
idx := 0;
pi := ps[idx];
ri := ci := 1;
for i := 1 to length(s) do
begin
vi := s[i];
if vi="\n" then
begin
ri++;
ci := 1;
end else
ci++;
if i=pi then
begin
r[idx]:= array(ri,ci);
idx++;
pi := ps[idx];
end
end
return r;
end
FTslParser; //
FGetInfoChace; //class 信息
FGetInfoText; //文本
FLastVersion; //脚本
FScriptPath; //路径
FOrgScriptPath; //原始路径
function setFscripttype(v);
begin
if (v=0 or v=1) and v<>Fscripttype then
begin
Fscripttype := v;
FLastVersion := FEditer.Text;
end
end
function SetScriptPath(v);
begin
sp := ioFileseparator();
ddex := -1;
fscriptname:="";
if ifstring(v)then
begin
for i := length(v) downto 1 do
begin
if v[i]=sp then
begin
Caption := v[(i+1):];
if ddex>i then
begin
fscriptname := v[(i+1):(ddex)];
end else
begin
fscriptname := v[(i+1):];
end
break;
end
if ddex=-1 and v[i]="." then
begin
ddex := i-1;
if lowercase(v[i:])in array(".tsl",".tsf")then FTslSynText := true;
end
end
FScriptPath := v;
FOrgScriptPath := v;
FEditer.Caption := v;
end
end
end
type TPageEditer=class(TPage) //多页编辑
function Create(AOwner);override;
begin
inherited;
end
function MouseUp(o,e);override;
begin
inherited;
if e.button()=mbRight then
begin
return CallDatafunction(FPageItemOnRClick,self,e);
end
end
function CallSelChanged();override;
begin
it := Currentitem;
if it then
begin
it.FEditer.SetBoundsRect(getediterrect());
it.FEditer.Visible := true;
it.FEditer.SetFocus();
end
inherited;
end
function CallSelChanging();override;
begin
inherited;
it := CurrentItem;
if it and it.FEditer then it.FEditer.Visible := false;
end
function Recycling();override;
begin
inherited;
FCliper := nil;
FMenu := nil;
FPageItemOnRClick := nil;
end
function DoMouseWheel(o,e);override;
begin
IF ssCtrl in e.shiftstate then
begin
fw := font.Width;
if e.delta<0 then
begin
if fw>6 then
begin
finfo := array("width":fw-1,"height":font.height-2);
end
end else
begin
if fw<24 then
begin
finfo := array("width":fw+1,"height":font.height+2);
end
end
if finfo then
begin
font := finfo;
callMessgeFunction(onscrollfont,o,finfo);
InValidateRect(nil,false);
end
return;
end
end
[weakref] onscrollfont;
function DoControlAlign();override;
begin
inherited;
it := CurrentItem;
if it then
begin
it.FEditer.SetBoundsRect(getediterrect(trc));
end
end
property PageItemOnRClick read FPageItemOnRClick write FPageItemOnRClick;
private
function getediterrect();
begin
rc := ClientRect;
return rc;
end
[weakref]FPageItemOnRClick;
end
type TTslChmHelp=class
function SearchWord(s);
begin
if not s then return;
pm := format('%s::/%s.htm',FTSLinterpPath+FChmName,s); //>mainwin
HtmlHelpA(GetDesktopWindow(),pm,0,nil);
return;
end
function ShowTslLangChm();
begin
return HtmlHelpA(GetDesktopWindow(),FTSLinterpPath+FChmName,0,nil);
end
function Create();
begin
FChmName := "help\\LANGUAGEGUIDE.CHM";
FTSLinterpPath := TS_ModulePath();
end
property ChmName read FChmName write FChmName;
private
FTSLinterpPath;
FHanle;
FChmName;
end
type TEditer=class(TCustomcontrol) //包括工具栏,状态栏,输出,查找
function Create(AOwner);override;
begin
inherited;
if not Fhightercolor then
Fhightercolor := new thighlitcolor(self);
FOpenHistory := new TMyarrayb();
FFistShows := array();
FSynHCS := New TMyArrayA();
//构造部件
FLastDispathTime := 0;
FTslexe := gettslexe() ;//SysExecName();
FTabChar := " ";
FTabWidth := 4;
FCurrentItemCode := array();
FGoBackA := new TMyarrayB();
FGoBackB := new TMyarrayB();
//FToolbar := new TToolBar(self); //工具栏
ftoolbara := new TToolBar(self); //工具栏
ftoolbarb := new TToolBar(self); //工具栏
FStatus := new TStatusBar(self); //状态栏
fcoolbar := new tcoolbar(self);
ftoolbara.Align := alNone;
ftoolbarb.Align := alNone;
ftoolbara.Width := 430;
ftoolbarb.Width := 250;
fcoolbar.autosize := true;
FInfoShowWnd := new TEditerAuxiliary(self);
FPageEditer := new TPageEditer(self);
FPageEditer.onscrollfont := function(o,ft)begin
global g_editer_font_size := ft;
self.Notification(self,array("font",ft));
FinCodemap.FTree.font := ft;
FinCodemap.FTree.ItemHeight := ft["height"]+6;
end
//FPageEditer.CloseBtn := true;
FPageEditer.Onbmpbclick := function(o,e)
begin
it := e._Tag;
if not it then return ;
if it.fisnewfile then //单独处理新建关闭
begin
if MessageboxA("新建文件还未保存!关闭将删除","提示",1,self)= IDOK then
begin
f := it.OrigScriptPath;
DeletePageItem(it);
if fileexists("",f) then filedelete("",f);
end
end else
begin
if JudgeItemState(it)then return;
if it.FEditer.ChangedFlag then
begin
mr := MessageboxA(format("是否保存:%s",it.OrigScriptPath),"提示",3,self);
if mr=IDYES then
begin
SavePageItem(it);
end else
if mr=IDCANCEL then
begin
return;
end
end
DeletePageItem(it);
end
o.CallSelChanged();
end
FPageEditer.OnCloseClick := function(o,e)
begin
it := GetCurrentItem();
if not it then return ;
if JudgeItemState(it)then return;
if it.FEditer.ChangedFlag then
begin
mr := MessageboxA(format("是否保存:%s",it.OrigScriptPath),"提示",3,self);
if mr=IDYES then
begin
SavePageItem(it);
end else
if mr=IDCANCEL then
begin
return;
end
end
DeletePageItem(it);
end;
FFindWnd := new TFindWnd(self); //查找
FGotoLineWnd := new TGoToLineWnd(self); //共同
FListPages := new TListPages(self); //tab 跳转页面
FEchoWnd := new TEditerEchoWnd(self);
FEchoWnd.font := array("height":16,"width":8,"escapement":0,"orientation":0,"weight":400,"italic":0,"underline":0,"strikeout":0,
"charset":0,"outprecision":0,"clipprecision":0,"quality":1,"pitchandfamily":1,"facename":"Courier New","color":0);
FTslDebug := new TTslDebug(self);
FFindListWnd := new TFindListWnd(self);
FFileopen := new TOpenFileADlg(self);
FFileSave := new TSavefileADlg(self);
FFileopen.WndOwner := self;
FFileSave.WndOwner := self;
//初始部件
//////////////////////////////////////
FEchoWnd.Border := true;
FEchoWnd.WsSysMenu := false;
FEchoWnd.WsSizeBox := false;
FEchoWnd.Caption := "echo...";
FFindListWnd.Caption := "find....";
FFindListWnd.OnDblClick := thisfunction(FindListChoosed);
FGotoLineWnd.Visible := false;
/////////////////////////
FFindWnd.Visible := false;
FFileSave.Filter := array("any":"*.*","tsl文件":"*.tsl;*.tsf");
FFileSave.Caption := "另存为";
FFileopen.Filter := array("any":"*.*","tsl文件":"*.tsl;*.tsf");
FPageEditer.OnSelChanged := thisfunction(PageItemSelChanged);
////////
FListPages.Visible := false;
////////////////////////////
FPageMenu := new TPopUpMenu(self);
for i,v in array("关闭","关闭其他标签","关闭左侧所有","关闭右侧所有","复制文件名","复制文件全名","重新加载","打开目录","另存为") do
begin
mi := new TMenu(self);
mi.Caption := v;
mi.Parent := FPageMenu;
mi.OnClick := thisfunction(PageMenuClick);
end
FExecuteEditer := new TExecuteEditer(self);
FExecuteEditer.visible := false;
////////////
FPageEditer.PageItemOnRClick := thisfunction(PageItemOnRClick);
FImages := new TControlImageList(self);
FImages.Width := 24;
FImages.Height := 24;
imgs := GetEditIcons();
id := 0;
FToolbtns := array();
dbgbtns := array();
for i,v in imgs do
begin
bt := new TToolButton(self);
FToolbtns[i]:= bt;
if v=0 then
begin
//bt.stylesep := true;
continue;
end else
begin
bmp := new TBitmap();
bmp.Readvcon(HexFormatStrToTsl(v));
FImages.addbmp(bmp);
bt.OnClick := thisfunction(ToolClick);
bt.Caption := i;
bt.imageid := id;
id++;
end
if i in array("添加/删除断点F5","暂停","继续","进入","跳出","单步","下一行(F8)","终止","刷新符号表","刷新当前符号")then
begin
dbgbtns[i]:= bt;
bt.Parent := ftoolbarb;
end else
begin
BT.parent := ftoolbara;//FToolbar;
end
end
FImages.DrawBimpFirst := true;
Fdbgbtns := dbgbtns;
FTslDebug.addbtns(dbgbtns);
//FToolbar.ImageList := FImages;
ftoolbara.ImageList := FImages;
ftoolbarb.ImageList := FImages;
ftoolbara.Parent := fcoolbar;
ftoolbarb.Parent := fcoolbar;
FInfoShowWnd.Visible := false;
//FInfoShowWnd.WsSysMenu := true;
FInfoShowWnd.WSsizebox := true;
FInfoShowWnd.height := 200;
//FInfoShowWnd.OnSize := thisfunction(DoControlAlign);
FInfoShowWnd.OnCloseClick := function(o,e)
begin
o.visible := false;
e.skip := true;
DoControlAlign();
end
/////////////////////
FStatus.Items := array(("text":"","width":0.85),("text":"","width":0.16));
/////////////////////////////////////////
//FInfoShowWnd.Caption := "信息:";
////构造节点////////////////////////////////////////////////////
//FToolBar.Parent := self;
FinCodemap := new tfincodemap(self);
FinCodemap.WsSizeBox := true;
fcoolbar.arrange := "0,1";
FStatus.Parent := self;
FInfoShowWnd.Parent := self;
FinCodemap.Parent := self;
fcoolbar.Parent := self;
FPageEditer.Parent := self;
FGotoLineWnd.Parent := self;
FFindWnd.parent := self;
FFileopen.parent := self;
FFileSave.parent := self;
FListPages.parent := self;
FExecuteEditer.parent := self;
//FEchoWnd
FInfoShowWnd.AddWnd(FEchoWnd);
FInfoShowWnd.AddWnd(FFindListWnd);
FInfoShowWnd.AddWnd(FTslDebug);
FTempPageItem := new TPageEditerItem(FPageEditer);
/////////////
FSynClasses["txt"]:= array(class(TSynHighLighter),class(TSynCompletion),";txt;");
FSynClasses["tsl"]:= array(class(TTslSynHighLighter),class(TTslCompletion),";tsl;tsf;pas;stm;");
FSynClasses["json"]:= array(class(TJsonSynHighLighter),class(TSynCompletion),";json;");
FSynClasses["js"]:= array(class(TJsSynHighLighter),class(tjssyncompletion),";js;");
FSynClasses["css"]:= array(class(TcssSynHighLighter),class(tcsssyncompletion),";css;");
FSynClasses["xml"]:= array(class(TxmlSynHighLighter),class(tcsssyncompletion),";xml;");
FSynClasses["html"]:= array(class(ThtmlSynHighLighter),class(tcsssyncompletion),";html;");
FSynClasses["ini"]:= array(class(TINISynHigLighter),class(TSynCompletion),";ini;");
FSynClasses["bat"]:= array(class(TBatSynHigLighter),class(TSynCompletion),";bat;cmd;");
FSynClasses["tfm"]:= array(class(ttfmhighlighter),class(TSynCompletion),";tfm;");
FSynClasses["None"]:= array(nil,nil,"");
FTslChmHelp := new TTslChmHelp();
FCodeFormatInfo := array("wordct":80,"charct":200,"syn":true,"sel":false,"arraytype":0);
FPageEditer.OnDblClick := function(o,e)
begin
CreateAFile();
end
end
function PopUpAuxiliary();
begin
FInfoShowWnd.ShowPopUp();
end
function ClearPageItemMark(it);
begin
if not it then it := GetCurrentItem();
if not it then return;
ed := it.FEditer;
ls := ed.Lines;
canval := false;
for i := 0 to ls.length()-1 do
begin
li := ls[i];
if li.FMarked then
begin
li.FMarked := false;
canval := true;
end
end
if canval then ed.InValidateRect(nil,false);
end
function GetAllPageItems();
begin
return FPageEditer.PageItems;
end
function SaveFileByName(n);
begin
for i,v in FPageEditer.PageItems.Data do
begin
if v.ScriptPathIs(n)then
begin
return SavePageItem(v);
end
end
end
function GetAllPagesInfo();
begin
r := array();
its := FPageEditer.PageItems;
for i := 0 to its.Length()-1 do
begin
it := its[i];
r["pages"][i]["filename"]:= it.OrigScriptPath;
edt := it.FEditer;
r["pages"][i]["r"]:= edt.TopLine; //edt.CaretY;
ls := edt.Lines;
f2s := array();
for j := 0 to ls.Length()-1 do
begin
if ls[j].FMarked then f2s[j]:= true;
end
r["pages"][i]["f2"]:= f2s;
r["pages"][i]["isnewfile"]:= it.fisnewfile;
end
it := GetCurrentItem();
if it then
begin
r["currentpage"]:= array(it.OrigScriptPath,it.FEditer.TopLine);
end
//FPageEditer.DoControlAlign();
return r;
end
function CloseScriptByFileName(n);
begin
for i,v in FPageEditer.PageItems.Data do
begin
if v.ScriptPathIs(n)then
begin
return DeletePageItem(v);
end
end
end
function getpageitemcount(); //获得页面数量
begin
return FPageEditer.pageitemcount;
end
function CloseAllPageItems(it);
begin
its := FPageEditer.PageItems;
tits := its.Data;
FPageEditer.CloseAllItem(it);
for i,v in tits do
begin
if v=it then
begin
cit := it;
continue;
end
v.Recycling();
end
if cit then cit.FEditer.ReCreateCaret();
end
function SaveAllPageItems(); //保存所有
begin
its := FPageEditer.PageItems;
for i,v in its.Data do
begin
JudgeItemState(v);
end
its := FPageEditer.PageItems;
for i := 0 to its.Length()-1 do
begin
SavePageItem(its[i]);
end
end
function WMUSER(o,e):WM_USER;override;
begin
inherited;
if e.wparam=101 and e.lparam=102 then
begin
self.Enabled := true;
end
end
function EndFind();
begin
FIsFinding := false;
_send_(WM_USER,101,102,1);
end
function DoFind(d,o);
begin
if FIsFinding then return;
o.SetStatusText("查找.....");
o.SaveCurrentEditer();
self.Enabled := false;
FIsFinding := true;
if {not(d["c_reg"])}true then
begin
if(d["section"]="查找")and(d["btn"]="计数")then
begin
ct := "noshow";
//FindAllInCurrent(d,o,nil,ct);
Find_All(d,o,nil,ct);
o.SetStatusText(format("查找到 %d处",ct));
return EndFind();
end else
if(d["section"]="查找")and(d["btn"]="全部查找")then
begin
FFindListWnd.Clean();
ShowFindWnd();
//FindAllInCurrent(d,o,nil,ct);
Find_All(d,o,nil,ct);
o.SetStatusText(format("查找到 %d处",ct));
return EndFind();
end else
if(d["section"]in array("查找","替换"))and(d["btn"]="查找")then
begin
find_one(d,o);
//FindInCurrent(d,o);
return EndFind();
end else
if(d["section"]in array("替换"))and(d["btn"]="替换")then
begin
if d["replace"]<> d["target"]then
begin
//FindInCurrent(d,o,nil,1);
find_one(d,o,nil,1);
end
return EndFind();
end else
if(d["section"]in array("替换"))and(d["btn"]="全部替换")then
begin
if d["replace"]<> d["target"]then
begin
FFindListWnd.Clean();
ShowFindWnd();
//ReplaceAllInCurrent(d,o,nil,idx);
replace_allincurrent(d,o,nil,idx);
o.SetStatusText(format("替换 %d处",idx));
end
return EndFind();
end else
if(d["section"]in array("文件查找"))and(d["btn"]="全部替换")then
begin
if messageboxa("即将在目录中替换内容!!","提示",mb_YesNo,self.Handle)<> IDYES then return EndFind();
FFindListWnd.Clean();
ShowFindWnd();
//FindInFiles(d,o,true,ct);
Find_InFiles(d,o,true,ct);
o.SetStatusText(format("总共替换 %d处",ct));
return EndFind();
end else
if(d["section"]in array("文件查找"))and(d["btn"]="查找")then
begin
FFindListWnd.Clean();
ShowFindWnd();
//FindInFiles(d,o,false,ct);
Find_InFiles(d,o,false,ct);
o.SetStatusText(format("总共查找 %d处",ct));
return EndFind();
end
end
o.SetStatusText("功能开发中....");
EndFind();
end
function setdbugruncall(drc);
begin
FTslDebug.runbtncall := drc;
end
function DebugPageItem(it,h);
begin
if not it then return;
showdbugwnd();
FTslDebug.Debuglocal(it);
end
function Debugremote(it);
begin
showdbugwnd();
FTslDebug.Debugremote(it);
end
function DbgNextLine();
begin
FTslDebug.DbgNextLine(); //FDebuger
end
function ExecutePageItem(it,h);
begin
if not it then return;
ShowEchoWnd();
if FEchoWnd.Exeing()then return FEchoWnd.Endexe();
s := FExecuteEditer.GetCurrentExuteString(it.Scriptpath);
FEchoWnd.Exec("",s,h);
end
compile_config;
fpg_config_infos;
function buildpageitem(it);
begin
if not ifarray(fpg_config_infos) then fpg_config_infos := array();
if not it then return;
ShowEchoWnd();
if FEchoWnd.Exeing()then return FEchoWnd.Endexe();
r := array();
f := it.ScriptPath;
pginf := fpg_config_infos[f];
if not pginf then
begin
if 1=parseregexpr("\\.tsf$",f,"i",m,mp,ml) then
begin
r["build"] := "--buildlib";
{$ifdef linux}
hz := ".so" ;
{$else}
hz := ".dll";
{$endif}
end else
begin
r["build"] := "--buildexe";
{$ifdef linux}
hz := ".out" ;
{$else}
hz := ".exe";
{$endif}
end
r["buildfile"] := f;
r["resourcepat"] := "*.ini,*.tfm";
ot := TS_ModulePath()+ it.scriptname+hz;
ds := getlibpathstr();
r["libpath"] := ds;
if ot then r["output"] := ot;
r["dependsdir"] := replacetext(ds,";",",");
end else
begin
r := pginf;
end
nr := build_with_data(nil,r);
if nr then fpg_config_infos[f] := nr;
end
function get_local_pos(x,y);
begin
o := self;
x := 0;
y := 0;
while o and not(o.WSpOPUp) do
begin
o := o.Parent;
end
if o then
begin
x := o.left+100;
y := o.top+20;
end
end
function build_with_data(dir,data);
begin
if not compile_config then
begin
compile_config := new t_compile_config(self);
compile_config.visible := false;
compile_config.parent := self;
fcompier :=1;
end
compile_config.base_dir := dir;
compile_config.set_config(data);
get_local_pos(x,y);
compile_config.left := x;
compile_config.top := y;
if compile_config.ShowModal() then
begin
ndata := compile_config.get_config();
ShowEchoWnd();
if FEchoWnd.Exeing()then return FEchoWnd.Endexe();
FEchoWnd.build(dir,ndata);
return ndata;
end
return false ;
end
function SavePageItem(it,f);
begin
if not it then return -1;
if f or it.PrePareSave()then
begin
it.FEditer.ChangedFlag := false;
s := it.LastText;
case it.EnCode of
"UTF8":
begin
s := AnsiToutf8(it.LastText);
end
"UTF8 BOM":
begin
//0xEF, 0xBB, 0xBF
s := " ";
s[1]:= 0xEF;
s[2]:= 0xBB;
s[3]:= 0xBF;
s += AnsiToutf8(it.LastText);
//ECHO "SAVE UTFB-BOM\r\n";
end
"UCS2-little":
begin
s := " ";
s[1]:= 0xFF;
s[2]:= 0xFE;
s += multibytetounicode(it.LastText,936);
end
"UCS2-big":
begin
s2 := " ";
s2[1]:= 0xFF;
s2[2]:= 0xFE;
s2 += multibytetounicode(it.LastText,936);
s := "";
setlength(s,length(s2));
for i := 1 to length(s2)-1 step 2 do
begin
s[i]:= s2[i+1];
s[i+1]:= s2[i];
end
end
end;
fp := it.OrigScriptPath;
if it.FISstm then
begin
try
v := eval(&s);
//s := tostm(v);
r := exportfile(ftstream(),"",fp,v);
it.ReGetLastLoadTime();
dopageitemsaved(it);
return r;
except
end
end
if it.scripttype=1 then
begin
s := replacetext(s,"\r\n","\n");
end
r := ReWriteString(fp,s);
it.ReGetLastLoadTime();
dopageitemsaved(it);
return r;
end
return 1;
end
function dopageitemsaved(it);virtual;
begin
end
function ShowFindWnd();
begin
FInfoShowWnd.ShowByTag(FFindListWnd);
ShowLogWnd(true);
end
function showdbugwnd();
begin
FInfoShowWnd.ShowByTag(FTslDebug);
ShowLogWnd(true);
end
function ShowEchoWnd();
begin
FInfoShowWnd.ShowByTag(FEchoWnd);
ShowLogWnd(true);
end
function SwitchLogWnd();
begin
FInfoShowWnd.Visible := not(FInfoShowWnd.Visible);
DoControlAlign();
end
function SetFindHistroy(d);
begin
FFindWnd.SetHistory(d);
end
function GetFindHistory();
begin
return FFindWnd.GetHistory();
end
function getdbugtoolbtns();
begin
return Fdbgbtns;
end
function gettoolbar();
begin
return fcoolbar;//FToolbar;
end
function gettoolbarbtn(idxs);
begin
if ifarray(idxs) then
begin
r := array();
ri := 0;
for i,v in idxs do
begin
bi := ftoolbara.getbtnbyindex(v);
if bi then r[ri++] := bi;
end
return r;
end
return array(ftoolbara.getbtnbyindex(1),ftoolbara.getbtnbyindex(2));
end
function ShowLogWnd(flg);
begin
n :=(ifnil(flg)or flg)?true:false;
if n=FInfoShowWnd.Visible then return;
FInfoShowWnd.Visible := n;
DoControlAlign();
end
function JudgeItemState(it); //状态处理
begin
lt := it.GetLastLoadTime();
nlt := it.ReGetLastLoadTime();
if not lt then return;
if (nlt <> lt) then //文件改变了
begin
FPageEditer.FCanDraged := false;
FPageEditer.MouseDrageLeave(); //此处不知为什么会报错
if not nlt then //已经删除
begin
if Messageboxa("文件已经被删除,依然保存请按确定","提示",1,self)=IDOK then
begin
CreateDirWithFileName(it.OrigScriptPath); //新建
SavePageItem(it,true);
end else
begin
DeletepageItem(it); //删除
return true;
end
end else //被其他程序修改
begin
if (it.FEditer.ChangedFlag = false) and fcloseflag then
begin
return ;
end
if Messageboxa(format("%s\r\n被其他程序修改是否重新加载",it.ScriptPath),"提示",mb_YesNo,self)=IDYES then
begin
LoadFromFile(it,true);
end else
begin
it.FEditer.ChangedFlag := true;
end
end
end
end
function PageItemTextChanged(o,flg);
begin
its := FPageEditer.Pageitems;
cit := GetCurrentItem();
for i := 0 to its.Length()-1 do
begin
it := Its[i];
if it.FEditer=o then
begin
if cit=it then
begin
if it.fisnewfile then cp := (flg?"*":"")+" new ";
else
cp :=(flg?"*":"")+it.OrigScriptPath;
Caption := to_ansi_str(cp);
end
callDatafunction(OnPageEditerChanged,it,flg);
it.BitmapA := flg?GetNeedSaveBmp():GetNneedSaveBmp();
return;
end
end
end
function DeletePageItem(it);
begin
idx := FPageEditer.GetItemIndex(it);
if idx >= 0 then
begin
//f := it.OrigScriptPath;
FPageEditer.DeleteItemByIndex(idx);
it.Recycling();
it := GetCurrentItem();
if it then it.FEditer.ReCreateCaret();
//if it.fisnewfile then filedelete("",f);
end
end
function PageItemSelChanged(o,e);virtual;
begin
it := GetCurrentItem();
if not it then return Caption := "editer...";
//if JudgeItemState(it) then return ;
FCurrentItemCode[length(FCurrentItemCode)]:= it;
if it.fisnewfile then
begin
cp :=(it.FEditer.ChangedFlag?"*":"")+" new ";
end
else
begin
cp :=(it.FEditer.ChangedFlag?"*":"")+it.OrigScriptPath;
end
Caption := to_ansi_str(cp);
CallDatafunction(FOnPageItemSelChanged,self(true),it);
cp := it.FEditer.Completion;
if cp and it.FInitCompletion then
begin
it.FInitCompletion := false;
cp.PrePareCompletion(it.Caption);
end
EditerCaretChanged(it.FEditer,nil);
if FinCodemap then FinCodemap.ontimerdo();
end
function docloseapageitem(it);
begin
if it.fisnewfile then //单独处理新建关闭
begin
f := it.OrigScriptPath;
DeletePageItem(it);
if fileexists("",f) then filedelete("",f);
return ;
end
if JudgeItemState(it)then return;
if it.FEditer.ChangedFlag then
begin
mr := MessageboxA(format("是否保存:%s",it.OrigScriptPath),"提示",3,self);
if mr=IDYES then
begin
if SavePageItem(it)=0 then
begin
it.FEditer.ChangedFlag := true;
return 0;
end
end else
if mr=IDCANCEL then
begin
return;
end
end
DeletePageItem(it);
end
function PageMenuClick(o,e);
begin
it := GetCurrentItem();
if not it then return;
case o.Caption of
"关闭":
begin
docloseapageitem(it);
end
"关闭左侧所有":
begin
its := GetAllPageItems();
itss := array();
for i := 0 to its.Length()-1 do
begin
iti := its[i];
if iti=it then break ;
itss[i] := iti;
end
fcloseflag := true;
try
for i,iti in itss do
begin
docloseapageitem(iti);
end
finally
fcloseflag := false;
end;
if itss then FPageEditer.CallSelChanged();
end
"关闭右侧所有":
begin
dodel := 0;
its := GetAllPageItems();
itss := array();
for i := 0 to its.Length()-1 do
begin
itss[i] := its[i];
end
fcloseflag := true;
try
for i,iti in itss do
begin
if dodel then docloseapageitem(iti);
if iti=it then
begin
dodel := 1;
end ;
end
finally
fcloseflag := false;
end;
if dodel then FPageEditer.CallSelChanged();
end
"关闭其他标签":
begin
Cit := it;
its := GetAllPageItems();
fcloseflag := true;
try
for i := 0 to its.Length()-1 do
begin
it := its[i];
if it.FEditer.ChangedFlag then
begin
r := MessageBoxA("存在未保存的文件,是否保存!","提示",3,self);
if r=IDYES then
begin
SaveAllPageItems();
break;
end else
if r=IDCANCEL then
begin
return;
end else
begin
end
break;
end
end
CloseAllPageItems(Cit);
finally
fcloseflag := false;
end;
end
"另存为":
begin
if JudgeItemState(it)then return;
//FFileopen.OverwritePrompt := true;
if FFileSave.OpenDlg()then
begin
fn := FFileSave.FileName;
dfn := it.ScriptPath;
CreateDirWithFileName(fn);
//echo format('FileCopy("","%s","","%s",false)',dfn,fn);
ret := FileCopy("",dfn,"",fn,false);
if ret then
begin
it.ScriptPath := fn;
if SavePageItem(it)=0 then
begin
it.FEditer.ChangedFlag := true;
end
if it.fisnewfile then
begin
FileDelete("",dfn);
it.fisnewfile := false;
end
end
end
//FFileopen.OverwritePrompt := false;
end
"重新加载":
begin
LoadFromFile(it,true);
end
"复制文件全名":
begin
if not FCliper then FCliper := new TClipBoard(self);
FCliper.text := it.OrigScriptPath;
end
"复制文件名":
begin
if not FCliper then FCliper := new TClipBoard(self);
FCliper.text := it.Caption;
end
"打开目录":
begin
p := it.ScriptPath;
if FileExists("",p)then
begin
for i := length(p)downto 3 do
begin
if p[i]="\\" then
begin
p := p[1:i];
break;
end
end
//_wapi.WinExec('cmd.exe /C start "" "'+p,1);
_wapi.openresourcemanager(p);
end
end
"采用cmd执行":
begin
//ExecutePageItemWithCmd(it);
end
end
end
function PageItemOnRClick(o,e);
begin
if FPageEditer.GetItemIndexByPos(e.pos)>= 0 then o.PopUpMenu := FPageMenu;
else o.PoPupMenu := nil;
end
function PageEditerMenuClick(o,e);
begin
cp := o.Caption;
if ("转unix(LF)"=cp) then
begin
it := GetCurrentItem();
it.scripttype := 1;
SavePageItem(it,1);
//it.FEditer.ChangedFlag := true;
return ;
end else
if ("转windows(CR LF)"=cp) then
begin
it := GetCurrentItem();
it.scripttype := 0;
SavePageItem(it,1);
return ;
end else
if ("另存为"=cp) then
begin
return PageMenuClick(o,e);
end else
if pos("复制",cp)=1 then
begin
it := GetCurrentItem();
if it then
begin
ed := it.FEditer;
if ed then
begin
ed.ExecuteCommand(ed.ecCopy);
end
//it.FEditer.ReadOnly := not(o.Checked);
end
return;
end else
if pos("粘贴",cp)=1 then
begin
it := GetCurrentItem();
if it then
begin
ed := it.FEditer;
if ed then
begin
ed.ExecuteCommand(ed.ecPaste);
end
//it.FEditer.ReadOnly := not(o.Checked);
end
return;
end else
if pos("剪切",cp)=1 then
begin
it := GetCurrentItem();
if it then
begin
ed := it.FEditer;
if ed then
begin
ed.ExecuteCommand(ed.ecCut);
end
//it.FEditer.ReadOnly := not(o.Checked);
end
return;
end else
if pos("定位",cp)=1 then
begin
InitShowWndPos(FGotoLineWnd,"g",200,200);
FGotoLineWnd.ShowGoto();
return;
end else
if pos("查看",cp)=1 then
begin
cs := o.Caption;
if length(cs)<6 then return;
s :=(o.Caption)[6:];
GetCurrentEditer().Tryjump(s);
return;
end else
if pos("只读",cp)=1 then
begin
it := GetCurrentItem();
if it then
begin
it.FEditer.ReadOnly := not(o.Checked);
end
return;
end else
if pos("执行",cp)=1 then
begin
it := GetCurrentItem();
ExecutePageItem(it);
return;
end else
if pos("停止",cp)=1 then
begin
if FEchoWnd.Exeing()then FEchoWnd.EndExe();
return;
end else
if cp = "转换为大写" then
begin
upperorlowercase(1);
end else
if cp = "转换为小写" then
begin
upperorlowercase(0);
end else
if cp = "删除尾空白" then
begin
seltrimright();
end
end
function PageEditerOnRClick(o,e);
begin
o.popupMenu := nil;
if not FPageEditerMenu then
begin
FPageEditerMenu := new TPopUpMenu(self);
FPageEditerMenus := array();
for i,v in array("查看","复制(C)","粘贴(V)","剪切(X)","定位(G)","只读","转换为大写","转换为小写","删除尾空白","文档格式","执行(F9)","停止执行","另存为") do
begin
it := new TMenu(self);
it.Caption := v;
it.parent := FPageEditerMenu;
if "文档格式"=v then
begin
for j,vj in array("转unix(LF)","转windows(CR LF)") do
begin
subit := new TMenu(self);
FPageEditerMenus[vj]:= subit;
subit.Caption := vj ;
subit.Parent := it;
subit.OnClick := thisfunction(PageEditerMenuClick);
end
continue;
end
FPageEditerMenus[v]:= it;
it.OnClick := thisfunction(PageEditerMenuClick);
end
end
iflx := GetCurrentItem().scripttype = 1;
FPageEditerMenus["转unix(LF)"].Enabled := not iflx;
FPageEditerMenus["转windows(CR LF)"].Enabled := iflx;
rd := FPageEditerMenus["只读"];
if rd then
begin
zd := GetCurrentItem().FEditer.Readonly;
rd.Checked := zd;
it := FPageEditerMenus["粘贴(V)"];
if it then it.Enabled := not zd;
it := FPageEditerMenus["剪切(X)"];
if it then it.Enabled := not zd;
end
rd := FPageEditerMenus["查看"];
if rd then
begin
//mtic;
it := GetCurrentEditer();
s := it.CanJump();
if s then
begin
rd.Caption := "查看:"+s;
rd.Enabled := true;
end else
begin
rd.Caption := "查看";
rd.Enabled := false;
end
end
ex := FEchoWnd.Exeing()?true:false;
rd := FPageEditerMenus["执行(F9)"];
if rd then rd.Enabled := not ex;
rd := FPageEditerMenus["停止执行"];
if rd then rd.Enabled := ex;
rd := FPageEditerMenus["执行"];
if rd then
begin
end
o.popupMenu := FPageEditerMenu;
//MessageBoxA("MESSAGErclick","tis",0);
end
function createparams(p);override;
begin
inherited;
P.ExStyle := P.ExStyle .| WS_EX_ACCEPTFILES;
end
function WMDROPFILES(o,e):WM_DROPFILES;
begin
opends := _wapi.get_drage_file_names(e.wparam);
for i,v in opends do
begin
arr := FileList("",v);
if not(pos("D",arr[0,"Attr"]))then OpenAndGotoFileByName(v);
end
end
function GetOpendPageItemByFileName(n);
begin
its := FPageEditer.PageItems;
for i := 0 to its.Length()-1 do
begin
it := its[i];
if it.ScriptPathIs(n)then return it;
end
end
function EditerCaretChanged(o,e); //caret 位置改变
begin
if GetCurrentEditer()=o then
begin
FStatus.setitemtext(format("col:%d | %s",o.CaretX,o.PageItem.EnCode),1);
if FinCodemap and FinCodemap.Visible then
FinCodemap.caretchanged(o.CaretY);
end
end
function OpenScriptByFileName(n);
begin
if not ifstring(n)then return false;
it := GetOpendPageItemByFileName(n);
if it then return it;
fl := FileList("",n);
if not(length(fl)=1)then return false;
nn := fl[0,"FileName"];
if(POS("d",fl[0,"Attr"]))then return false;
it := new TPageEditerItem(FPageEditer);
oit := GetCurrentEditer();
if oit then
begin
it.FEditer.font := oit.font;//font;
end
it.FDebuger := FTslDebug;
it.FEditer.OnCaretChanged := thisfunction(EditerCaretChanged);
it.FEditer.Parent := FPageEditer;
it.FEditer.TabChar := FTabChar;
it.FEditer.PageItem := it;
it.FEditer.hgcolor := Fhightercolor;
tf := FTslCacheDir+"newfile"+ioFileseparator()+"new";
if pos(tf,n)=1 then it.fisnewfile := true;
it.FEditer.QuckKeys := Thisfunction(EditerQuckKeys);
it.FEditer.OnTextSetFocus := function(o,e)
begin
//echo "\r\n",o.PageItem.Scriptpath;
JudgeItemState(o.PageItem);
end
FPageEditer.PageItems.push(it);
nn1 := n;
nn1[(length(n)-length(nn)+1):]:= nn;
//echo nn1,"==",n,"\r\n";
it.ScriptPath := nn1;
it.BitmapA := GetNneedSaveBmp();
it.BitmapB := Closebmp();
LoadFromFile(it,true);
for i,v in FReadDirs do
begin
if not ifstring(v)then continue;
if pos(v,n)=1 then
begin
it.FEditer.ReadOnly := true;
break;
end
end
//DoControlAlign();
if it then
begin
SetHistoryFiles(n);
it.FEditer.OnRclick := thisfunction(PageEditerOnRClick);
it.FEditer.OnTextChanged := thisfunction(PageITEMtextChanged);
end
return it;
end
function GetHistoryFiles();
begin
return FOpenHistory.Data;
end
function SetHistoryFiles(v);
begin
if ifarray(v)then
begin
for i,vi in v do
begin
SetHistoryFiles(vi);
end
return;
end
if ifstring(v)and v then
begin
fcadd := true;
for i,vi in FOpenHistory.Data do
begin
if filenameIsTheSame(v,vi)then
begin
//fcadd := false;
FOpenHistory.Splice(i,1); //删除原来的记录
break;
end
end
if fcadd then
begin
FOpenHistory.push(v);
if FOpenHistory.Length()>30 then FOpenHistory.shift();
end
end
end
function ShowHistoryWnd();
begin
if not FHistoryWnd then
begin
FHistoryWnd := new TMouseMoveList(self);
FHistoryWnd.Visible := false;
FHistoryWnd.WSpOPUp := true;
FHistoryWnd.Parent := self;
FHistoryWnd.Caption := "打开历史....";
FHistoryWnd.WSsysMenu := true;
FHistoryWnd.WsSizeBox := true;
FHistoryWnd.Width := 400;
FHistoryWnd.Height := 600;
{FHistoryClearMenuPop := new TPopUpMenu(self);
FHistoryClearMenu := new TMenu(self);
FHistoryClearMenu.Caption := "清空历史记录";
FHistoryClearMenu.Parent := FHistoryClearMenuPop;
FHistoryWnd.PopUpMenu := FHistoryClearMenu;
FHistoryClearMenu.OnClick := function(o,e)begin
FHistoryWnd.SetData(array());
FOpenHistory.Splices(0,FOpenHistory.Length());
end }
FHistoryWnd.OnClose := function(o,e)
begin
o.EndModal();
o.Visible := false;
e.skip := true;
end
FHistoryWnd.OnClick := function(o,e)
begin
idx := o.getCurrentSelection();
if idx >= 0 then
begin
n := o.GetItem(idx);
o.EndModal();
O.Visible := false;
OpenAndGotoFileByName(n);
end
end
end
if FOpenHistory.Length()>0 then
begin
d := FOpenHistory.Data;
FHistoryWnd.SetData(d);
InitShowWndPos(FHistoryWnd,"history",100,100);
FHistoryWnd.ShowModal();
end
end
function OpenAndGoLineByName(n,L);
begin
it := OpenScriptByFileName(n);
if it then
begin
if l>0 then
begin
ed := it.FEditer;
ed.ExecuteCommand(ed.ecGoToXY,array(L,1));
end
end
return it;
end
function OpenAndGotoFileByName(n,L);
begin
bit := GetCurrentItem();
if bit then
begin
if not((ifnil(L)or(L=bit.FEditer.CaretY))and(filenameIsTheSame(n,bit.ScriptPath)))then
begin
bit := array("file":bit.OrigScriptPath,"line":bit.FEditer.CaretY);
if FRebackFlag then FGoBackB.Push(bit);
else FGoBackA.Push(bit);
end
end
it := OpenAndGoLineByName(n,L);
if it then FPageEditer.SetSel(it);
return it;
end
function CommetCurrentSel(); //注释选择
begin
it := GetCurrentEditer();
if it then
begin
if it.ReadOnly then return;
bg := it.BlockBegin;
ed := it.BlockEnd;
if bg and ed and ed[0]<> bg[0]then
begin
it.ExecuteCommand(it.ecTab,"//");
end else
begin
it.ExecuteCommand(it.ecLineStart);
it.ExecuteCommand(it.ecString,"//");
end
end
end
function UnCommentCurrentSel(); //取消注释
begin
it := GetCurrentEditer();
if it then
begin
if it.ReadOnly then return;
bg := it.BlockBegin;
ed := it.BlockEnd;
if bg and ed and bg[0]<> ed[0]then
begin
it.ExecuteCommand(it.ecShifttab,array("//"));
end else
begin
s := it.LineText;
if pos("//",s)=1 then
begin
it.ExecuteCommand(it.ecLineStart);
it.ExecuteCommand(it.ecSelLineEnd);
if length(s)>= 3 then it.ExecuteCommand(it.ecString,s[3:]);
else it.ExecuteCommand(it.ecString,"");
end
end
end
end
function UnDoCurrentEditer();
begin
it := GetCurrentEditer();
if it then
begin
if it.ReadOnly then return;
self.Enabled := false;
it.ExecuteCommand(it.ecUndo);
self.Enabled := true;
if it.ChangedFlag then
begin
cit := GetCurrentItem();
if it.Text=cit.LastText then //
begin
it.ChangedFlag := false;
end
end
end
end
function ToolClick(o,e); //
begin
case o.caption of
"打开文件":
begin
OpenAFile();
//FPages.OpenAFile();
end
"新建":
begin
CreateAFile();
//FPages.CreateAFile();
end
"保存全部":
begin
return SaveAllPageItems();
end
"保存":
begin
it := GetCurrentItem();
if SavePageItem(it)=0 then
begin
it.FEditer.ChangedFlag := true;
end
end
"取消注释":
begin
UnCommentCurrentSel();
end
"注释":
begin
CommetCurrentSel();
end
"快捷键说明":
begin
s := "";
s += "ctrl+o 打开\r\n";
s += "ctrl+N 新建\r\n";
s += "ctrl+s 保存\r\n";
s += "ctrl+F 查找窗口\r\n";
s += "ctrl+R 替换窗口\r\n";
s += "ctrl+a 全选\r\n";
s += "ctrl+c 拷贝选择\r\n";
s += "ctrl+D 复制被插入当前行\r\n";
s += "ctrl+v 粘贴\r\n";
s += "ctrl+x 剪切选择\r\n";
s += "ctrl+G 定位到行\r\n";
s += "ctrl+L|Y 删除当前行\r\n";
s += "tab | shift+tab 多行选中时缩进\r\n";
s += "ctrl+/ 注释当前选择\r\n";
s += "ctrl+\\ 取消当前注释\r\n";
s += "ctrl+U 反撤销\r\n";
s += "ctrl+z 撤销\r\n";
s += "ctrl+tab 切换标签\r\n";
s += "F2 跳转到下一个断点行\r\n";
s += "F5 添加删除断点\r\n";
s += "Alt+F5 将选中字符串转换为大写\r\n";
s += "ctl+F5 将选中字符串转换为小写\r\n";
s += "F3 正向搜索先前搜索的字符\r\n";
s += "ctrl+F3 反向搜索先前搜索的字符\r\n";
s += "ctrl+tab 切换标签页\r\n";
s += "F9 执行当前页的代码\r\n";
s += "ctrl+F9 打开执行代码编辑器\r\n";
s += "F7 显示隐藏日志窗口\r\n";
s += "F1 对于tsl语言查找当前光标所在位置的帮助\r\n";
s += "alt+m 弹出tsl代码地图\r\n";
messageboxa(s,"快捷键说明",0,self);
end
"撤销":
begin
UnDoCurrentEditer();
end
"反撤销":
begin
it := GetCurrentEditer();
if it then
begin
if it.ReadOnly then return;
self.Enabled := false;
it.ExecuteCommand(it.ecRedo);
self.Enabled := true;
end
end
"tsl语法检查":
begin
it := GetCurrentEditer();
if it then
begin
if not CheckTslCode(it.Text,err)then
begin
Messageboxa(err,"提示",0,self);
end else
messageboxa("符合tsl语法","提示",0,self);
end
end
"tsl代码格式化":
begin
it := GetCurrentEditer();
if it then
begin
if 1 <> MessageboxA("将格式化代码!!","提示",1,self.Handle)then return;
if it.ReadOnly then return;
//sel := FCodeFormatInfo["sel"];
syn := FCodeFormatInfo["syn"];
arraytype := FCodeFormatInfo["arraytype"];
cftype :=(FCodeFormatInfo["cmt"]=1);
arraytype :=(arraytype in array(0,1,3))?arraytype:1;
sel := true;
sel2 := false;
if sel then
begin
s := it.SelText;
if s then sel2 := true;
end
if not s then
begin
s := it.Text;
end
if not s then return;
if syn then
begin
if not CheckTslCode(s,err)then
begin
return Messageboxa(err,"提示-tsl语法错误",0,self);
end
end
try
Enabled := false;
fs := UNIT(UTslCodeFormat).FormatTsl(s,FTabWidth,wordct,charct,arraytype,cftype);
if fs <> s then
begin
if sel and sel2 then
begin
it.SelText := fs;
end else
begin
it.Text := fs;
it.ExecuteCommand(it.ecGotoXY,array(1,1));
end
end
finally
Enabled := true;
end;
end
end
"查找":
begin
FFindWnd.Show();
end
"前进":
begin
GoToReBack();
end
"后退":
begin
GoToBack();
end
"代码地图(alt+m)":
begin
if FinCodemap and not(FinCodemap.Visible) then
begin
FinCodemap.doshow(true);
end
end
end
end
function GetCurrentItem();
begin
return FPageEditer.CurrentItem;
end
function GetCurrentEditer();
begin
it := GetCurrentItem();
if it then return it.FEditer;
end
function DoControlAlign();override; // 对齐
begin
if not(FPageEditer and FPageEditer.parent=self) then return;
rr := ClientRect;
r := rr;
codemapin := false;
if FinCodemap and not(FinCodemap.WSpOPUp)and FinCodemap.Visible and FinCodemap.Parent=self then
begin
codemapin := min(FinCodemap.Width,integer(r[2] * 0.5));
//FinCodemap.SetBoundsRect(r);
end
if fcoolbar.Parent = self then
begin
htoolbar := true;
end
if htoolbar then
begin
fcoolbar.DoControlAlign();
r[3]:= r[0]+fcoolbar.Height;
r[0]+=codemapin+2;
fcoolbar.SetBoundsRect(r);
end
r := rr;
r[1]:= r[3]-FStatus.Height;
FStatus.SetBoundsRect(r);
rr := rr;
if htoolbar then
begin
rr[1]:= fcoolbar.Height+1;
end
rr[3]:= rr[3]-FStatus.Height-1;
if FInfoShowWnd.Visible and not(FInfoShowWnd.WSpOPUp)then
begin
r := rr;
r[1]:= r[3]-min(FInfoShowWnd.Height,integer(r[3] * 0.8)); //0.6 靠扩大到 0.8
rr[3]:= r[1]-1;
FInfoShowWnd.SetBoundsRect(r);
end
if codemapin then
begin
r := rr;
r[1] := 1;
r[2] := codemapin;
rr[0] := codemapin+2;
FinCodemap.SetBoundsRect(r);
end
FPageEditer.SetBoundsRect(rr);
end
function CreateAFile(); //构造文件
begin
if FTslCacheDir then
begin
idx := 0;
while true do
begin
idx++;
fn := FTslCacheDir+"newfile"+ioFileseparator()+"new"+inttostr(idx)+".tsl";
if fileexists("",fn) then continue;
r := ReWriteString(fn,"");
if r=1 then
begin
it := OpenAndGotoFileByName(fn);
it.fisnewfile := true;
end
return ;
end
end
FFileopen.Caption := "新建文件--输入文件名点击打开";
FFileopen.Multiselected := false;
it := GetCurrentItem();
if it then
begin
s := it.ScriptPath;
sp := ioFileseparator();
for i := length(s)downto 2 do
begin
if s[i]=sp then
begin
FFileopen.initialDir := s[1:i-1];
break;
end
end
end
if FFileopen.Opendlg()then
begin
exen := FFileopen.FileName;
if FileExists("",exen)then
begin
r := true;
end else
r := ReWriteString(exen,""); //exportfile(ftstream(),"",exen,"//createBytsl");
if r=1 then OpenAndGotoFileByName(exen);
end
end
function OpenAFile(); //打开文件
begin
FFileopen.Caption := "打开文件";
FFileopen.Multiselected := true;
it := GetCurrentItem();
if it then
begin
if not it.fisnewfile then
begin
s := it.ScriptPath;
sp := ioFileseparator();
for i := length(s)downto 3 do
begin
if s[i]=sp then
begin
FFileopen.initialDir := s[1:i-1];
break;
end
end
end
end
if FFileopen.Opendlg()then
begin
rs := FFileopen.getResults();
//echo tostn(rs);
lenrs := length(rs);
for i,v in rs do
begin
if lenrs=1 and not(FileList("",v))then
begin
if MessageboxA("文件不存在,点击确定新建.点击取消退出","提示",1)=IDOK then
begin
ReWriteString(v,"");
end
end
OpenAndGotoFileByName(v,1);
end
end
end
function GoToBack();
begin
FRebackFlag := true;
it := FGoBackA.Pop();
if it then OpenAndGotoFileByName(it["file"],it["line"]);
FRebackFlag := false;
end
function GoToReBack();
begin
it := FGoBackB.Pop();
if it then OpenAndGotoFileByName(it["file"],it["line"]);
end
function seltrimright();
begin
ed := GetCurrentEditer();
IF not ed then return;
//ed.Lines.SetValueByIndex
b := ed.BlockBegin;
e1 := ed.BlockEnd;
try
if b and e1 then
begin
ed.IncPaintLock();
for i := b[0] to e1[0] do
begin
s1 := ed.Lines.GetValueByIndex(i-1).FStr;
s := trimright(s1);
if s1=s then continue;
ed.Lines.SetValueByIndex(i-1,s);
end
ed.ExecuteCommand(ed.ecGoToXY,b);
ed.ExecuteCommand(ed.ecSelGotoXY,e1);
ed.DecPaintLock();
end else
begin
s1 := ed.LineText;
s := trimright(s1);
if s1<>s then ed.LineText :=s;
end
except
end;
end
function upperorlowercase(f);
begin
ed := GetCurrentEditer();
IF not ed then return;
s := ed.SelText;
if s then
begin
b := ed.BlockBegin;
e1 := ed.BlockEnd;
ed.SelText := f?uppercase(s):lowercase(s);
ed.ExecuteCommand(ed.ecGoToXY,b);
ed.ExecuteCommand(ed.ecSelGotoXY,e1);
end
end
function EditerQuckKeys(o,e);virtual; //快捷键
begin
if e.Result = 0 then
begin
case e.charcode of
VK_F9:
begin
if ssctrl in e.ShiftState()then
begin
ShowExeEditer();
e.skip := true;
return true;
end
ExecutePageItem(GetCurrentItem());
e.skip := true;
return true;
end
end;
end
if e.Result=0 and(ssAlt in e.shiftstate)then
begin
case e.charcode of
VK_F5: //大写
begin
upperorlowercase(1);
e.skip := true;
return true;
end
ord("M"):
begin
if FinCodemap then
begin
FinCodemap.doshow(1);
end
e.skip := true;
return true;
end
end
end
if ssCtrl in e.ShiftState then
begin
if e.Result=0 then //down
begin
case e.CharCode of
220,191:
begin
if e.CharCode=220 then UnCommentCurrentSel();
else CommetCurrentSel();
e.skip := true;
return true;
end
VK_F5: //小写
begin
upperorlowercase(0);
return true;
end
ord("D"):
begin
ed := GetCurrentEditer();
if not ed then return;
if ed.ReadOnly then return;
//xy := ed.CaretY;
ed.ExecuteCommand(ed.ecLineEnd,nil);
S := ed.LineText;
ed.ExecuteCommand(ed.ecString,"\r\n"+s);
return;
end
ord("R"):
begin
InitShowWndPos(FFindWnd,"fr",200,150);
FFindWnd.oPENreplace();
FFindWnd.Show();
return true;
end
ord("E"):
begin
ed := GetCurrentEditer();
IF not ed then return;
s := ed.CaretWords();
if s then ed.Tryjump(s);
return true;
end
ord("F"):
begin
InitShowWndPos(FFindWnd,"fr",200,150);
FFindWnd.OpenFind();
FFindWnd.Show();
return true;
end
ord("G"):
begin
InitShowWndPos(FGotoLineWnd,"g",200,200);
FGotoLineWnd.ShowGoto();
return true;
end
{ord("O"):
begin
OpenAfile();
return true;
end
ord("N"):
begin
CreateAfile();
return true;
end}
ord("Z"):
begin
UnDoCurrentEditer();
return true;
end
ord("S"):
begin
it := GetCurrentItem();
if 0=SavePageItem(it)then
begin
it.FEditer.ChangedFlag := true;
end
if FinCodemap then FinCodemap.ontimerdo();
return true;
end
end
end else //up
begin
case e.CharCode of
VK_TAB:
begin
TabChecking(ssShift in e.ShiftState);
return true;
end
VK_F3:
begin
d := FFindWnd.GetINfo();
d["section"]:= "查找";
d["btn"]:= "查找";
d["c_revers"]:= 1;
DoFind(d,FFindWnd);
return true;
end
end
end
end
if e.Result=1 then
begin
case e.CharCode of
17:
begin
if e.Result then
begin
TabCheckChanged();
end
end
VK_F7:
begin
SwitchLogWnd();
return true;
end
VK_F8:
begin
DbgNextLine();
return true;
end
VK_F3:
begin
d := FFindWnd.GetINfo();
d["section"]:= "查找";
d["btn"]:= "查找";
d["c_revers"]:= 0;
DoFind(d,FFindWnd);
return true;
end
VK_F1:
begin
it := GetCurrentItem();
if it.FSynType="tsl" then
begin
ed := it.FEditer;
IF not ed then return;
s := ed.CaretWords();
if s then FTslChmHelp.SearchWord(s);
end
return true;
end
end;
end
end
function ShowTslLangChm();
begin
FTslChmHelp.ShowTslLangChm();
end
function InitShowWndPos(wnd,n,ix,iy); //计算初始位置
begin
if not FFistShows[n]then
begin
FFistShows[n]:= true;
xy := Clienttoscreen(ix,iy);
wnd.left := xy[0];
wnd.top := xy[1];
end
end
function SetPageItemSyn(it,n);
begin
if not it then return;
if not ifstring(n)then return;
if it.FSynType=n then return;
hc := GetFreeSynObjectByName(n);
if hc then
begin
cp := hc[1];
it.FEditer.IncPaintLock();
it.FEditer.HighLighter := hc[0];
it.FEditer.Completion := hc[1];
it.FEditer.DecPaintLock();
cp.OnJumpChoosed := function(cmp,d);
begin
f := d["file"];
nf :=(f?(cmp.GetFileFullPath(f)):GetCurrentItem().OrigScriptPath);
//echo "\r\n",nf,"===",d["line"];
OpenAndGotoFileByName(nf,d["line"]);
end
cit := GetCurrentItem();
if cit=it then
begin
it.FInitCompletion := false;
cp.PrePareCompletion(it.Caption);
end else
begin
it.FInitCompletion := true;
end
it.FSynType := n;
end else
begin
it.FEditer.IncPaintLock();
it.FEditer.HighLighter := nil;
it.FEditer.Completion := nil;
it.FEditer.DecPaintLock();
it.FSynType := n;
end
end
function Recycling();override;
begin
inherited;
FSynHCS := nil;
FCurrentItemCode := array();
FPageEditer := nil;
fcoolbar := nil;
ftoolbara := nil;
ftoolbarb := nil;
FToolbar := nil;
FStatus := nil;
FInfoShowWnd := nil;
FPageMenu := nil;
FPageEditerMenu := nil;
FPageEditerMenus := array();
FOnPageEditerChanged := nil;
fOnPageItemSelChanged := nil;
FListPages := nil;
FinCodemap := nil;
FEchoWnd := nil;
FFindListWnd := nil;
FTempPageItem := nil;
FExecuteEditer := nil;
FTslDebug := nil;
end
function GetSynTypeNames();
begin
return FSynClasses.IndexNames();
end
function SetCodeFormatInfo(d);
begin
if ifarray(d)then FCodeFormatInfo := d;
else return FCodeFormatInfo;
end
function getexecuteparams(f); //获得当前的执行参数
begin
return FExecuteEditer.GetCurrentExuteparams(f);
end
function ShowExeEditer(flg);
begin
if ifnil(flg)or flg then
begin
InitShowWndPos(FExecuteEditer,"exe",200,200);
FExecuteEditer.showexeediter();
end else
begin
FExecuteEditer.Visible := false;
end
end
function getlibpathstr();
begin
dirs := "";
fio := ioFileseparator();
for i,v in FTslSearchDir do
begin
if ifstring(v)then
begin
if v[length(v)]=fio then
begin
dirs += v;
end else
begin
dirs += v;
dirs += fio;
end
end
dirs += ";";
end
return dirs;
end
function echoAppendString(s);
begin
FEchoWnd.AppendString(s);
end
published //property 位置
FHistoryDir;
property hltcolor read gethclor write sethclor;
function showhltcolor();
begin
if not fhltediter then
begin
fhltediter := new thighlightercoloredter(self);
fhltediter.Parent := self;
fhltediter.left := left+200;
fhltediter.top := top+200;
fhltediter.colorinfo := fhltediterdata;
end
if fhltediter.ShowModal() then
begin
Fhightercolor.colors := fhltediter.colorinfo;
end
end
property OnPageEditerChanged read FOnPageEditerChanged write FOnPageEditerChanged;
property OnPageItemSelChanged read FOnPageItemSelChanged write FOnPageItemSelChanged;
property TslSearchDir read FTslSearchDir write SetTslSearchDir;
property TslCacheDir read FTslCacheDir write SetTslCacheDir;
property TabWidth read FTabWidth write SetTabWidth;
property TabChar read FTabChar;
property Tslexe read FTslExe write FTslExe;
property ReadOnlyDirs read FReadDirs write FReadDirs;
function getpage();
begin
return FPageEditer;
end
protected
class function Sinit();override;
begin
inherited;
if not FSynClasses then FSynClasses := new TMyArrayA();
end
class function GetSynTypeByFileType(ft);
begin
if not string(ft)then return "txt";
nft := lowercase(ft);
for i,v in FSynClasses.IndexNames() do
begin
dv := FSynClasses[v];
dvf := dv[2];
if ifstring(dvf)then
begin
if pos(";"+nft+";",dvf)then
begin
return v;
end
end
end
return "None";
end
class function RegSynType(n,h,c,files);
begin
if ifstring(n)and(h is class(TSynhighLighter))and(c is TSynCompletion)then
begin
FSynClasses[n]:= array(h,c,files);
end
end
class function UnRegSynType(n,h,c);
begin
if ifstring(n)then
begin
FSynClasses.DeleteIndex(n);
end
end
{
r["section"] := CurrentITem.Caption;
r["target"]:= FEdit_target.Editer.Text;
r["replace"]:= FEdit_repace.Editer.Text;
r["filetype"] := FEdit_type.Editer.Text;
r["dir"] := FEdit_dir.Editer.Text;
r["c_revers"]:=FCheck_revers.Checked;
r["c_cycle"]:= FCheck_cycle.Checked;
r["c_wrap"] := FCheck_wrap.Checked;
r["c_case"] := FCheck_case.Checked;
r["c_reg"] := FCheck_reg.Checked;
r["c_dir"] := FCheck_subdir.Checked;
}
function replace_allincurrent(data,fo,it,idx);
begin
//data["c_revers"]:= 0;
//data["c_cycle"]:= 0;
if not it then it := GetCurrentItem();
if not it then return;
ed := it.FEditer;
if not ed then return;
if ed.ReadOnly then return ;//不能替换
TryDispatch();
if not FIsFinding then return rt;
fs := data["target"];
finder := finder_set_info(data,ed.Text);
idx := 0;
rsult := finder.replace_all(r);
if rsult then
begin
idx := length(rsult);
ed.ExecuteCommand(ed.ecSelectAll);
ed.SelText := r;
lastidx := -1;
for i,v in rsult do
begin
if i=0 then
FFindListWnd.AppendItem(array("caption":format("replace:%s in file:%s",fs,it.OrigScriptPath),"file":it.OrigScriptPath,"line":1));
rdx := v[1,0];
if rdx=lastidx then continue;
lastidx := rdx;
if not ifstring(v[3]) then continue;
scap := format(" %d:(第%d行) ",i,rdx)+limitstringlength(v[3]);
FFindListWnd.AppendItem(array("caption":scap,"file":it.OrigScriptPath,"line":rdx));
end
end
end
function Find_InFiles(d,o,rep,ct);
begin
fs := GetFilesFormSearchInfo(d);
ct := 0;
for i,v in fs do
begin
TryDispatch();
if not FIsFinding then break;
o.SetStatusText("查找文件:"+i);
it := GetOpendPageItemByFileName(i);
if not it then
begin
FTempPageItem.ScriptPath := i;
LoadFromFile(FTempPageItem,false);
it := FTempPageItem;
end
if rep then
begin
//ReplaceAllInCurrent(d,o,it,idx);
replace_allincurrent(d,o,it,idx);
SavePageItem(it);
end else
begin
//FindAllInCurrent(d,o,it,idx);
Find_All(d,o,it,idx);
end
ct += idx;
end
end
function finder_set_info(data,txt);
begin
finder := static new t_gbk_text_finder();
finder.set_text(txt);
finder.set_find_str(data["target"]);
finder.iscase := data["c_case"];
finder.iswrap := data["c_wrap"];
finder.isReg := data["c_reg"];
finder.isprev := data["c_revers"];
finder.iscycle := data["c_cycle"];
finder.ismline := data["c_mline"];
finder.set_replace_str(data["replace"]);
return finder;
end
function find_one(data,fo,it,rep);
begin
if not it then it := GetCurrentItem();
if not it then return -2;
ed := it.FEditer;
if not ed then return -2;
cy := ed.CaretY;
cx := ed.CaretX;
fs := data["target"];
if not(fs and ifstring(fs))then
begin
fo.SetStatusText("查找内容为空!");
return -2;
end
finder := finder_set_info(data,ed.Text);
finder.set_rc(array(cy,cx));
reslt := finder.find_one();
if reslt then
begin
if data["c_revers"] then
begin
p1 := reslt[0,4];
p2 := reslt[0,3];
end else
begin
p1 := reslt[0,3];
p2 := reslt[0,4];
end
ed.ExecuteCommand(ed.ecGotoXY,p1);
ed.ExecuteCommand(ed.ecSelGotoXY,p2);
fo.SetStatusText(format("位置: %d %d",p1[0],p1[1]));
if rep then
begin
rs := finder.format_rep_Str(reslt);
ed.SelText := rs;
end
return 0;
end else
begin
fo.SetStatusText("没找到");
return -2;
end
end
function FindListChoosed(o,e);
begin
it := o.GetItem(o.GetCurrentSelection());
if ifarray(it)then
begin
f := it["file"];
l := it["line"];
if ifstring(f)and l >= 0 then
begin
OpenAndGotoFileByName(f,l);
end
end
end
function TryDispatch();
begin
t := now();
if(t-FLastDispathTime)>0.25e-5 then
begin
FLastDispathTime := t;
GetAndDispatchMessageA();
end
end
function Find_All(data,fo,it,rt);
begin
if rt = "noshow" then
begin
fnoshow := true;
end
TryDispatch();
if not FIsFinding then return rt;
rt := 0;
if not it then it := GetCurrentItem();
if not it then return;
ed := it.FEditer;
if not ed then return;
finder := finder_set_info(data,ed.Text);
rsult := finder.find_all();
fs := data["target"];
lastidx := -1;
if rsult then
begin
rt := length(rsult);
iits := 0;
for i,v in rsult do
begin
if i=0 and (not fnoshow) then
FFindListWnd.AppendItem(array("caption":format("find:%s in file:%s",fs,it.OrigScriptPath),"file":it.OrigScriptPath,"line":1));
if not fnoshow then
begin
rdx := v[1,0];
if rdx=lastidx then continue;
lastidx := rdx;
if not ifstring(v[3]) then continue;
scap := format(" %d:(第%d行) ",i,rdx)+limitstringlength(v[3]);
FFindListWnd.AppendItem(array("caption":scap,"file":it.OrigScriptPath,"line":rdx));
iits++;
if iits>80 then
begin
iits := 0;
TryDispatch();
end
end
end
end else
begin
fo.SetStatusText("找到 0 处");
end
end
function TabCheckChanged();
begin
if not FListPages.Visible then return;
FListPages.Visible := false;
n := FListPages.GetSelFileName;
OpenAndGotoFileByName(n);
end
function TabChecking(f);
begin
its := FPageEditer.PageItems;
if not(its.Length()>1)then return FCurrentItemCode := array();
if FListPages.Visible then
begin
FListPages.IncIndex((f>0)?1:(-1));
end else
begin //初始化
//bit := GetCurrentItem();
for i := 0 to its.Length()-1 do
begin
it := its[i];
it.FPageOrderId := 0;
end
idx := 1;
for i := length(FCurrentItemCode)-1 downto 0 do
begin
it := FCurrentItemCode[i];
if it.FPageOrderId<1 then it.FPageOrderId := idx++;
end
sr := array();
for i := 0 to its.Length()-1 do
begin
it := its[i];
sv := it.OrigScriptPath;
if it.FEditer.ChangedFlag then sv := "*"+sv;
sr[i,0]:= sv;
sr[i,1]:= it.FPageOrderId;
sr[i,2]:= it;
if it.FPageOrderId=0 then
begin
it.FPageOrderId := idx++;
end
end
sit := sselect[0]from sr order by[1]asc end;
FCurrentItemCode := sselect[2]from sr order by[1]desc end;
FListPages.SetData(sit);
//FListPages.IncIndex(-1);
FListPages.SetCurrentSelection(1);
xy := ClientToScreen(100,100);
FListPages.Top := xy[1];
FListPages.Left := xy[0];
//FListPages.SetBoundsRect(array(xy[0],xy[1],xy[0]+600,xy[1]+600));
//FListPages.Visible := true;
FListPages.Show(SW_SHOWNOACTIVATE);
//bit.FEditer.SetFocus();
end
end
function GetFreeSynObjectByName(n);
begin
if not ifstring(n)then return;
lns := FSynHCS[n];
if not lns then
begin
lns := new TMyARRayB();
FSynHCS[n]:= lns;
end
for i := 0 to lns.length()-1 do
begin
vi := lns[i];
if not(vi[0].Memo)then return vi;
end
hc := CreateASynObject(n,self);
if hc then
begin
lns.Push(hc);
return hc;
end
end
public
static Fhightercolor;
FExecuteEditer;
private
function sethclor(cs);
begin
Fhightercolor.colors := cs;
fhltediterdata := cs;
end
function gethclor();
begin
if fhltediter then return fhltediter.colorinfo;
end
class function CreateASynObject(n,ow);
begin
c := FSynClasses[n];
//if not c then c := FSynClasses["txt"];
if c then
begin
if ifobj(c[0])and ifobj(c[1])then
begin
h := CreateObject(c[0],ow);//Fhightercolor;
//if n="tsl" then
// begin
h.hightercolor := Fhightercolor;
//end
return array(h,CreateObject(c[1],ow));
end
end
end
Fdbgbtns;
fhltediterdata;
static FSynClasses;
fhltediter;
FCodeFormatInfo;
FTslChmHelp;
FFistShows;
FSynHCS;
FLastDispathTime;
FIsFinding;
[weakref]FOnPageEditerChanged;
[weakref]fOnPageItemSelChanged;
FPageEditerMenu;
FPageEditerMenus;
FReadDirs;
FCurrentItemCode;
FGoBackA; // := new TMyarrayB();
FGoBackB; // := new TMyarrayB();
FRebackFlag;
FPageEditer;
fcoolbar;
ftoolbara;
ftoolbarb;
FToolbar;
FStatus;
FInfoShowWnd;
FinCodemap;
FListPages;
FFindWnd;
FFindListWnd;
FEchoWnd;
FGotoLineWnd;
FFileopen;
FFileSave;
FPageMenu;
//图标
FNeedSaveBmp;
FNotNeedSaveBmp;
FBmpClose;
FTabWidth;
FTabChar;
FTslexe;
FTslSearchDir;
FTslCacheDir;
FTempPageItem;
FOpenHistory;
FHistoryWnd;
FTslDebug;
fcloseflag;
private
function GetFilesFormSearchInfo(d);
begin
r := array();
dir := d["dir"];
if not dir then return r;
ft := d["filetype"];
if ft then
begin
ft := str2array(ft,";");
end
if not ft then ft := array("*");
FindFiles(dir,ft,d["c_dir"],r);
return r;
end
function FindFiles(dir,ft,sub,ret);
begin
TryDispatch();
dir_ := dir;
sp := ioFileseparator();
if not(dir_[length(dir_)]=sp)then dir_ += sp;
if sub then
begin
dirs := FileList("",dir_+"*");
for i,v in dirs do
begin
TryDispatch();
if not FIsFinding then return;
fn := v["FileName"];
if(pos("D",v["Attr"]))and not(fn in array(".",".."))then
begin
FindFiles(dir_+fn,ft,sub,ret);
end
end
end
for i,v in ft do
begin
vi := trim(v);
if not vi then continue;
fs := FileList("",dir_+vi);
for j,vj in fs do
begin
if(POS("D",vj["Attr"]))then continue;
ret[dir_+vj["FileName"]]:= true;
end
end
end
function SetTslCacheDir(d);
begin
if FTslCacheDir=d then return;
if ifstring(d)then
begin
FTslCacheDir := d;
class(TTSLCompletion).SetCacheDir(d);
end
end
function SetTslSearchDir(d);
begin
if FTslSearchDir=d then return;
if ifarray(d)then
begin
FTslSearchDir := d;
class(TTSLCompletion).SetFindDirs(d);
its := GetAllPageItems();
for i := 0 to its.Length()-1 do
begin
it := its[i];
it.RepreComple := true;
end
end
end
function SetTabWidth(n);
begin
if not(n >= 0)then return;
nn := integer(n);
if nn >= 0 and nn <> FTabWidth then
begin
FTabWidth := nn;
if nn=0 then FTabChar := "\t";
else
begin
FTabChar := "";
for i := 1 to nn do
begin
FTabChar += " ";
end
end
its := FPageEditer.PageITems;
for i := 0 to its.Length()-1 do its[i].FEditer.TabChar := FTabChar;
end
end
function getdirfromfile(p);
begin
r := "";
if not ifstring(p)then return r;
sp := ioFileseparator();
for i := length(p)downto 1 do
begin
if p[i]=sp then return p[1:i];
end
return r;
end
function LoadFromFile(it,ifinit);
begin
p := it.ScriptPath;
sz := filesize("",p);
if readFile(rwRaw(),"",p,0,sz,s)then
begin
it.ReGetLastLoadTime();
if lowercase(p[length(p)-3:length(p)])=".stm" then
begin
try
if s then
begin
v := stm(s);
s := tostn(v);
end
it.FEditer.ReadOnly := true;
it.FISstm := true;
except
end
end
edt := it.FEditer;
tl := edt.TopLine;
cxy := edt.CaretXY;
{$ifdef linux}
it.scripttype := 1;
{$else}
it.scripttype := 0;
{$endif}
if pos("\r\n",s) then
begin
it.scripttype := 0;
end else
if pos("\n",s) then
begin
it.scripttype := 1;
end
if it.scripttype<>0 and length(p)>3 and (lowercase(p[length(p)-3:length(p)]) in array(".tsl",".tsf")) then
begin
it.scripttype := 0;
end
it.SetLoadScript(s);
if ifinit then
begin
InitScriptHighLighter(it);
edt.TopLine := tl;
edt.ExecuteCommand(edt.ecGotoXY,cxy);
end
end else
begin
//MessageBoxA(s,"提示",0,self);
it.ReGetLastLoadTime();
it.SetLoadScript(s);
it.FEditer.ReadOnly := true; //设置为自读
end
end
function InitScriptHighLighter(it);
begin
p := it.ScriptPath;
for i := length(p)downto 3 do
begin
if p[i]="." then
begin
synt := GetSynTypeByFileType(p[i+1:]);
return SetPageItemSyn(it,synt);
end
end
end
function GetNNeedSaveBmp();
begin
if not FNOTneedSaveBmp then
begin
s := "0502000000060400000074797065000203000000696D670006040000006461746
100021701000089504E470D0A1A0A0000000D4948445200000010000000100806
0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA864000000AC49444154
384FB593CB0AC3201045FBFFFFE626820B71138C22E242B30B06A63874420C464
C4B2F5C84791C1DD117FC2804E49C41290552CAAE9765C1A6B310B0AE2B30C69A
4D571B63B0915401CADA530194BA18E3273208F0DEE3CE041042C0BEEF981B023
8E7406B7D008A69940A1042C0E055DBB6414A0938E77DC013FF07304D13067B9A
E7F91E40899EA9CE5ADB06D083B9335D6413F06484DB138CBA028C7EA6B3CBBB3
800DF0BE00DCA62BB159A123E940000000049454E44AE42608200";
FNOTneedSaveBmp := new TBitmap();
FNOTneedSaveBmp.ReadVcon(HexFormatStrToTsl(s));
end
return FNOTneedSaveBmp;
end
function Closebmp();
begin
if not FBmpClose then
begin
FBmpClose := new TBitmap();
s := "0502000000060400000074797065000203000000696D670006040000006461746
10002D800000089504E470D0A1A0A0000000D4948445200000010000000100806
0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000006D49444154
384FB592510A80300C43BDFFA5FADFEFDEA712212368A762E783B05192C0CAB66
CB2AEC0DDD3CC5E095E320A2AE39DC8A520220EA9B99A93B200A8B99A91F2091A
A8C21099EE8041700E43E49F028671EA5D3D64FD126152E36C4EA63B78121905E
DAFFC956641E60E1806A0968D1586A10000000049454E44AE42608200";
FBmpClose.ReadVcon(HexformatStrToTsl(s));
end
return FBmpClose;
end
function GetNeedSaveBmp();
begin
if not FNeedSaveBmp then
begin
s := "0502000000060400000074797065000203000000696D670006040000006461746
100022D01000089504E470D0A1A0A0000000D4948445200000010000000100806
0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA864000000C249444154
384F63F84F21001BF0E6D39FFF31BD8FFF07B43CC48BEB97BE046B420660038E5
CFBFA5F34FA3A564DE8B879C52BB0461840310044E303200340EA769DFF0C1521
D280B9BBDEFD6F59F90A6E8063D5FDFF1FBFFE05CB1165C0D42D6FFE572D7A093
700843BD740BC8262C0F2831FC082E8E0D1EB5FFFF75EFCF2DFA8E00E7E0348C1
B4314037E73658101F289EFB1CB70130097C18A6AE6BED6BEC06C0120C2E0C0B4
8AC0690E2059C2E2016A318406C6642C6BB2F7C4118403EF8FF1F00E2B93E0A61
AE40CC0000000049454E44AE42608200";//GetSaveFileBitmapInfo();
FNeedSaveBmp := new TBitmap();
FNeedSaveBmp.ReadVcon(HexFormatStrToTsl(s));
end
return FNeedSaveBmp;
end
end
implementation
type thighlightercoloredter=class(tvcform)
uses tslvcl;
colorcombobox1:tcolorcombobox;
listbox1:tlistbox;
btn1:tbtn;
btn2:tbtn;
colorcombobox2:tcolorcombobox;
btn3:tbtn;
btn4:tbtn;
btn5:tbtn;
openfileadlg1:topenfileadlg;
function Create(AOwner);override; //构造
begin
fcolorindexname := array("字体","关键字","符号","注释","字符串","数字","系统函数","选中背景","当前行背景","行号背景");
ffrontcolordefault := array(0,0x0000ff,0,0x228B22,0x8B008B,0x666666,0xcd0000,0,0,0);
fbkcolordefalut := zeros(7)+0xfafafa union array(rgb(192,192,192),rgb(232,232,255),rgb(228,228,228));
ffrontcolors := ffrontcolordefault;
fbkcols := fbkcolordefalut;
inherited;
Visible := false;
loader.LoadFromTfmScript(self,getscript());
listbox1.Items := fcolorindexname;
listbox1.ItemIndex := 1;
listbox1.SelBkColor := listbox1.Color;
end
function edtcolormain1_close(o;e);virtual;
begin
EndModal(0);
end
function import_clk(o;e);virtual;
begin
if openfileadlg1.OpenDlg() then
begin
importfile(ftstream(),"",openfileadlg1.filename,d);
if d and ifarray(d) then
begin
colorinfo := d;
listbox1.InvalidateRect(nil,false);
end
end
end
function export_clk(o;e);virtual;
begin
d := colorinfo;
if openfileadlg1.OpenDlg() then
begin
exportfile(ftstream(),"",openfileadlg1.filename,d);
end
end
function btn3_clk(o;e);virtual;
begin
ffrontcolors := ffrontcolordefault;
fbkcols := fbkcolordefalut;
listbox1_sel(listbox1,new tuieventbase(0,0,0,0));
listbox1.InvalidateRect(nil,false);
end
function colorcombobox2_onselchanged(o;e);virtual;
begin
if flistboxchanging then return ;
idx := listbox1.ItemIndex;
if idx in array(0,7,8,9) then
begin
cl := colorcombobox2.getcurrentColor();
fbkcols[idx] := cl;
listbox1.InvalidateRect(nil,false);
end
end
function btn1_clk(o;e);virtual;
begin
EndModal(0);
end
function btn2_clk(o;e);virtual;
begin
EndModal(1);
end
function colorcombobox1_onselchanged(o;e);virtual;
begin
if flistboxchanging then return ;
idx := listbox1.ItemIndex;
if idx <7 and idx>=0 then
begin
cl := colorcombobox1.getcurrentColor();
ffrontcolors[idx] := cl;
listbox1.InvalidateRect(nil,false);
end
end
function listbox1_sel(o;e);virtual;
begin
{**
@explan(说明) item选择改变回调 %%
@param(o)(listbox) 列表控件 %%
@param(e)(tuieventbase) 消息对象 %%
**}
flistboxchanging := true;
if not(colorcombobox1 and colorcombobox2) then return flistboxchanging := false;
cl := colorcombobox1.getcurrentColor();
id := listbox1.ItemIndex;
cc := ffrontcolors[id];
stnil := true;
if cl<>cc then
begin
for i,v in ccols() do
begin
if i=0 then continue;
if v = cc then
begin
colorcombobox1.ItemIndex := i;
stnil := 0;
break;
end
end
end
if stnil then
begin
if ifnil(cc) then
begin
colorcombobox1.ItemIndex := 1;
end else
begin
colorcombobox1.customcolor := cc;
colorcombobox1.ItemIndex := 0;
end
end
cl := colorcombobox2.getcurrentColor();
cc := fbkcols[id];
stnil := true;
if cl<>cc then
begin
for i,v in ccols() do
begin
if i=0 then continue;
if v = cc then
begin
colorcombobox2.ItemIndex := i;
stnil := 0;
break;
end
end
end
if stnil then
begin
if ifnil(cc) then
begin
colorcombobox2.ItemIndex := 1;
end else
begin
colorcombobox2.customcolor := cc;
colorcombobox2.ItemIndex := 0;
end
end
flistboxchanging := false;
end
function listbox1_draw(o;e);virtual;
begin
{**
@explan(说明) 自绘制 %%
@param(o)(listbox) 列表控件 %%
@param(e)(tlistdrawevent) 消息对象 %%
**}
id := e.idx;
cvs := e.canvas;
rec := e.rec;
rec2 := rec;
//rec2[0]+=100;
sel := e.sel;
if id<7 then
begin
ftcl := ffrontcolors[id];
cl := fbkcols[0];
end else
begin
ftcl := ffrontcolors[0];
cl := fbkcols[id];
end
if cl>=0 or cl<0 then
begin
cvs.brush.Color := cl;
cvs.fillrect(rec2);
end
if ftcl>0 or ftcl<=0 then
begin
cvs.font.Color := ftcl;
end
cvs.drawtext( o.getItemText(id),rec);
if sel then
begin
cvs.Pen.Width := 1;
cvs.pen.Color := 0x808080;
//cvs.pen.style := PS_DOT;
rec[0]+=1;
rec[1]+=1;
rec[2]-=1;
rec[3]-=1;
cvs.moveto(rec[array(0,1)]);
cvs.LineTo(rec[array(2,1)]);
cvs.LineTo(rec[array(2,3)]);
cvs.LineTo(rec[array(0,3)]);
cvs.LineTo(rec[array(0,1)]);
end
end
function DoControlAlign();override;//对齐子控件
begin
//当窗口大小改变时,该函数会被调用,
//可以通过 clientrect 获取客户区大小,设置子控件的位置以及大小
//如果自己处理了子控件的对齐,就可以去掉 inherited
inherited;
end
function Recycling();override; //回收变量
begin
inherited;
ci := self.classinfo(); //将成员变量赋值为nil避免循环引用
for i,v in ci["members"] do
begin
if v["static"] then continue;
invoke(self,v["name"],nil);
end
end
property colorinfo read getcolorinof write setcolorinfo;
private
function getcolorinof();
begin
r := array();
for i,v in fcolorindexname do
begin
r[v,"font"] := ffrontcolors[i];
r[v,"back"] := fbkcols[i];
end
return r;
end
function setcolorinfo(cs);
begin
if not ifarray(cs) then return ;
for i,v in fcolorindexname do
begin
ffrontcolors[i] := ifnumber(cs[v,"font"])?(cs[v,"font"]):ffrontcolordefault[i];
fbkcols[i] := ifnumber(cs[v,"back"])?(cs[v,"back"]):fbkcolordefalut[i];
end
end
function ccols();
begin
if fccboxcolors then return fccboxcolors;
fccboxcolors := array();
for i := 0 to colorcombobox1.ItemCount-1 do
begin
fccboxcolors[i] := colorcombobox1.getColorValue(i);
end
return fccboxcolors;
end
fccboxcolors;
ffrontcolors;
fcolorindexname;
fbkcolordefalut;
ffrontcolordefault;
flistboxchanging;
fbkcols;
end
function getscript();
begin
return %% object edtcolormain1:edtcolormain
caption="编辑器配色"
height=389
left=549
minmaxbox=false
onclose=edtcolormain1_close
top=292
width=360
wssizebox=false
object colorcombobox1:tcolorcombobox
color=0xC08000
height=23
itemindex=0
left=10
onselchanged=colorcombobox1_onselchanged
top=18
width=132
end
object listbox1:tlistbox
caption="listbox1"
height=252
itemindex=0
items=["" ]
left=10
ondrawlist=listbox1_draw
onselchanged=listbox1_sel
ownerdraw=true
top=52
width=323
end
object btn1:tbtn
caption="取消"
height=25
left=187
onclick=btn1_clk
top=311
width=65
end
object btn2:tbtn
caption="确定"
height=25
left=269
onclick=btn2_clk
top=312
width=58
end
object colorcombobox2:tcolorcombobox
height=23
itemindex=0
left=154
onselchanged=colorcombobox2_onselchanged
top=18
width=177
end
object btn3:tbtn
caption="还原默认"
height=25
left=103
onclick=btn3_clk
top=310
width=72
end
object btn4:tbtn
caption="导入"
height=25
left=3
onclick=import_clk;
top=310
width=30
end
object btn5:tbtn
caption="导出"
height=25
left=35
onclick=export_clk;
top=310
width=30
end
object openfileadlg1:topenfileadlg
left=314
top=36
height=30
width=30
caption="openfileadlg1"
filter=<
stm="*.stm"
"所有"="*"
>
end
end%%;
end
type TEditList=class(TComboBox)
function Create(AOwner);override;
begin
inherited;
width := 280;
dropdowncount := 30;
FMaxCoder := 20;
ReadONly := false;
Editer.OnKeyDown := function(o,e)
begin
case e.charcode of
VK_UP:
begin
ItemIndex -= 1;
e.skip := true;
end
VK_DOWN:
begin
ItemIndex += 1;
e.skip := true;
end
13:
begin
Calldatafunction(OnEnterUp,self(true),e);
e.skip := true;
end
VK_ESCAPE:
begin
oer := o.owner.owner;
if oer then oer.Visible := false;
end
ord("A"):
begin
if ssCtrl in e.Shiftstate()then
begin
e.skip := true;
o.SetSel(0,length(o.text));
end
end
end;
end
end
function Recycling();override;
begin
inherited;
FOnEnterUp := nil;
end
function Pushitem(s);
begin
if not ifstring(s)and s then return;
if s in Items then return 0;
insertItem(s,0);
if getItemCount()>FMaxCoder then
begin
deleteItem(FMaxCoder);
end
end
property OnEnterUp read FOnEnterUp write FOnEnterUp;
property MaxCoder read FMaxCoder write FMaxCoder;
private
FMaxCoder;
[weakref]FOnEnterUp;
end
type TEditerEchoWnd=class(TSynMemoNorm) //
function Create(AOwner);override;
begin
inherited;
autogutterwidth := true;
FDoLockTime := 0;
FIsLocked := false;
height := 250;
ReadOnly := true;
WsSizeBox := true;
WsSysMenu := true;
OnClose := function(o,e)
begin
o.visible := false;
e.skip := true;
end
m := new TPopUpMenu(self);
m1 := new TMenu(self);
m1.Caption := "清空";
m1.parent := m;
{m2 := new TMenu(self);
m2.Caption := "选中字符高亮";
m2.Checked := false;
m2.OnClick := function(o,e)begin
o.Checked := not(o.Checked);
self.HighLighter := (o.Checked) ?F_Highlighter :false;
end
m2.Parent := m;}
PopUpMenu := m;
m1.OnClick := function(o,e)
begin
ClearAll();
AppendString("ctrl+z 停止;ctrl+c 复制选择\r\n");
end;
FProcess := new tcustomprocess(self);
FProcess.OnEcho := thisfunction(TEchoToString);
FProcess.onended := thisfunction(onprocend);
FProcess.onstarted := thisfunction(onprocstart);
AppendString("ctrl+z 停止 ; ctrl+c 复制选择\r\n");
F_Highlighter := new tcustomsynhighlighter(self);
hg := F_Highlighter;
hg.ExecuteCommand("strings",array());
hg.ExecuteCommand("keywords",array("ctrl+z","ctrl+c","echo","执行结束","开始执行"));
hg.ExecuteCommand("blockannotes",array());
hg.ExecuteCommand("rowannotes",array());
//hg.ExecuteCommand("regs",array("^(V|v)\\d":0x00ff00));
hg.ExecuteCommand("syms",array(":",";"));
hg.ExecuteCommand("pairs",array(("开始执行","执行结束")));
self.HighLighter := hg;
end
function onprocstart(o,e);
begin
AppendString("开始执行 ");
end
function onprocend(o,e);
begin
AppendString(format("\r\n执行结束:endcode:%d\r\n",o.ErrInfo));
end
function TEchoToString(o,s);
begin
AppendString(s);
return true;
end
function build(dir,d);
begin
{$ifdef linux}
exe := TS_ModulePath()+"TSL" ;
{$else}
exe := TS_ModulePath()+"tsl.exe" ;
{$endif}
if fileexists("",exe) then
begin
AppendString("build:\r\n");
cmd := "tsl "+format_build_params(d);
FProcess.StartupDirectory := dir;
FProcess.execstr := true;
self.HighLighter := nil;
AppendString(format('%s %s\r\n',exe,cmd));
r := FProcess.CreateProcess(exe,cmd);
h := r;
if r=0 then AppendString("编译失败!");
self.HighLighter := F_Highlighter;
return r;
end
//AppendString(format('%s %s\r\n',exe,cmd));
end
function Exec(exe,cmd,h);
begin
self.HighLighter := nil;
AppendString(format('%s %s\r\n',exe,cmd));
FProcess.StartupDirectory := "";
FProcess.execstr := false;
r := FProcess.CreateProcess(exe,cmd);
h := r;
if r=0 then AppendString("执行失败!");
self.HighLighter := F_Highlighter;
return r;
end
function Exeing();
begin
return FProcess.Handle;
end
function EndExe();
begin
if FProcess.Handle then
begin
r := 1;
SysTerminate(r,FProcess.Handle);
end
end
function KeyDown(o,e);override;
begin
if ssCtrl in e.shiftstate then
begin
case e.charcode of
ord("Z"):
begin
EndExe();
return;
end
ord("C"):
begin
ExecuteCommand(ecCopy);
return;
end
end
end
inherited;
end
function AppendString(s);
begin
if not(ifstring(s)and s)then return;
ct := Lines.Length();
if ct>0 then
begin
ExecuteCommand(ecGoToXY,array(ct,1));
ExecuteCommand(ecLineEnd);
ExecuteCommand(ecString,s);
end
end
FExeHandle;
FProcess;
FIsLocked;
FDoLockTime;
F_Highlighter;
private
function format_build_params(d);
begin
r := d["build"]+"="+format('"%s" ',d["buildfile"]);
lbp := d["libpath"];
if lbp and ifstring(lbp) then
begin
r+='-libpath "'+lbp +'" ';
end else
r+="-libpath ."+ioFileseparator()+" ";
r += f_b_a_param(d,"exports");
r += f_b_a_param(d,"dependsdir");
r += f_b_a_param(d,"depends");
r += f_b_a_param(d,"excludes");
r += f_b_a_param(d,"pkg");
r += f_b_a_param(d,"resourcedir");
r += f_b_a_param(d,"resourcepat");
r += f_b_a_param(d,"extresource");
r += f_b_a_param(d,"buildico");
r += f_b_a_param(d,"output");
if d["strong"] then r+= " -strong";
if d["buildgui"] then r+= " -buildgui";
{$ifdef linux}
{$else}
if fileexists("",(d["buildfile"]+".manifest")) then
begin
r +=format(' --manifest="%s" ',d["buildfile"]+".manifest");
end
{$endif}
if d["nspace"] then
begin
r+=format("--setpkg2ns=%s ",d["nspace"]);
end
return r;
end
function f_b_a_param(d,n);
begin
dn := d[n];
if not ifstring(dn) then return "";
v :=trim( dn);
r :="";
if v then
begin
if v[length(v)]="\\" then v+=",";
r :=format( "--%s=",n)+format('"%s" ',v);
end
return r;
end
public
end
type tfincodemap = class(tcustomcontrol)
function create(AOwner);
begin
inherited;
Visible := false;
FTempNodes := array();
Width := 300;
Ftimer := new TTimer(self);
Ftimer.Interval := 200;
Ftimer.Ontimer := thisfunction(BdownTimeOut);
Ftimer.Enabled := false;
FList := new TCombobox(self);
flist.Width := 180;
ar := array("Class","Function","Statements","If","Else","SubCase","Goto","Try","Empty_Begin_End","NeedSql","Unit","property","Member");
flist.Multisel := true;
FList.AppendItems(ar);
flist.ItemIndex := 0->(length(ar)-1);
FList.Parent := self;
initbtn();
FTree := new TTreeView(self);
FTree.OnSelChanged := thisfunction(SynNodeSelected);
FTree.Parent := self;
FTree.onsyskeydown := function(o,e)begin
if e.char="M" then doshow(false);
end
ftree.OnKeyDown := function(o,e)begin
if e.charcode=13 then
begin
et := geteditor();
if et then et.SetFocus();
end
end
end
function caretchanged(y);
begin
if y>=fcaretya and y<fcaretyb then //记录位置减少计算
begin
return ;
end
if fisloading then return ;
fissetnode := true;
GoToTheNode(y);
fissetnode := false;
end
function DoControlAlign();override;
begin
if FList and fcbtn and FTree and ffbtn then
begin
rr := ClientRect;
ffbtn.left := 1;
r := rr;
r[0] := 25;
r[2] := min(200,r[2]-55);
r[3] := 25;
FList.SetBoundsRect(r);
fcbtn.left := rr[2]-25;
r := rr;
r[1]:= 27;
r[0]:=1;
r[2]:=r[2]-3;
FTree.SetBoundsRect(r);
end
end
function doshow(f); //显示
begin
st := f?true:false;
Visible := st;
BdownTimeOut();
if st then
begin
ontimerdo();
FTree.SetFocus();
hg := owner.Fhightercolor;
FTree.Color := hg.bkcolor().Color;
FTree.font.Color := hg.fontcolor().Color;
end else
begin
et := geteditor();
if et then et.SetFocus();
end
end
function SynNodeSelected(o,e);
begin
if fisloading then return ;
if fissetnode then return ;
edt := geteditor();
if not edt then return;
nd := FTree.CurrentNode;
if not nd then return ;
line := nd._tag;
if line>0 then
begin
edt.ExecuteCommand(edt.ecGoToXY,array(line,1));
end
end
function hasFocus();override;
begin
return true;
end
function ontimerdo(o,e);
begin
{ 代码块快类型
#define Block_TypeClass 1
#define Block_Function 2
#define Block_Statements 4
#define Block_If 8
#define Block_Else 16
#define Block_SubCase 32
#define Block_Goto_Label 64
#define Block_Empty_Begin_End 128
#define Block_Try 256
#define Block_NeedSql 512
#define Block_UnitStruct 1024
}
// 处理逻辑
//定时器中重算节点,如果发生改变,并定位节点到当前行位置
//行位置变化,=== 定位到节点
//节点选中定位到 编辑器
//if Parent then o.Enabled := false;
if not Visible then return ;
if not FTree then return ;
edt := geteditor();
nd := FTree.RootNode;
if not edt then return nd.RecyclingChildren();
y := edt.CaretY;
s := edt.Text;
if FString = s then //文本没变
begin
if flistv=getblocktypes() then //类型没变
begin
return ;
end
end else
FString := s;
flistv := getblocktypes();
if s then r := unit(utssvr_api_c).get_tsl_tokenizeex(s,flistv);// tsl_tokenizeex_2_(s,flistv);
else r := array();
fcaretya := -1;
fcaretyb := -1;
fisloading := true;
nd.RecyclingChildren();
FTempNodes := array();
ScriptDelBlocks(r["blcks"],str2array(s,"\r\n"),nd,0);
GoToTheNode(y);
fisloading := false;
end
function WMNCLBUTTONDOWN(o,e):WM_NCLBUTTONDOWN;override;
begin
FIgnoreSize := true;
Ftimer.Enabled := true;
end
function BdownTimeOut(o,e); //定时器处理
begin
if(_wapi.GetAsyncKeyState(VK_LBUTTON).& 0xFF00)>0 then
begin
end else
begin
FIgnoreSize := false;
Ftimer.Enabled := false;
p := Parent;
if p then p.DoControlAlign();
end
end
private
function GoToTheNode(line);
begin
nd := FTempNodes[0];
for i,v in FTempNodes do
begin
if v._tag <= line then
begin
nd := v;
fcaretya := v._tag;
end else
if v._tag >= Line then
begin
FTree.SetSel(nd);
fcaretyb := v._tag;
return ;
//break;
end
end
if nd and nd._Tag<=line then
begin
FTree.SetSel(nd);
fcaretyb := line;
end
end
function ScriptDelBlocks(blcks,strs,Node,ct);
begin
if not blcks then return;
for i,v in blcks do
begin
if v["mtype"]<> 1 then
begin
cnd := FTree.CreateTreeNode();
cnd.Caption := trim(strs[v["mbeg"]-1]);
cnd._tag := v["mbeg"];
FTempNodes[length(FTempNodes)]:= cnd;
cnd.parent := node;
end
if not cnd then cnd := node;
ScriptDelBlocks(v["msub"],strs,cnd,ct+1);
end
end
function getblocktypes();
begin
r := 0;
for i,v in FList.itemindex do
begin
r += 2^v;
end
return r;
end
function initbtn();
begin
fcbtn := new TBtn(self);
fcbtn.OnClick := function(o,e)
begin
doshow(0);
end
fcbtn.Caption := "";
fcbtn.top := 3;
fcbtn.Width := 20;
fcbtn.Height := 20;
fcbtn.Parent := self;
s := "0502000000060400000074797065000203000000696D670006040000006461746
10002C401000089504E470D0A1A0A0000000D4948445200000014000000140806
0000008D891D0D000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000015949444154
384F9D9431CA83401085F7625E21E015BC8156D639809D95AD36C142248568ED0
93C8277B0B0D99F4F32B2EB8EE1270F1EAC3B6FBE85901963156DDB66C771B455
55D93CCF6D1CC7873973478D8CA600B82C8B4D92C44651F4D564C85EE501BBAE5
39BBF991E5727709E67B5E13FA6577400D775F502455178DF9AAF19180770DF77
9BA6A917444DD3780DAEA921170A03961986C10B636968DB36A87187B4076199B
22C830296C6F7FB7DDE7146DA431896C9B24C2D6201F0BFC3C87DE06A58E6F178
A845B18010672D2386659800AD289EA6E983B3C759CB886119C6492BE2BEEF4F9
080B9D3B218966136B5E2EBF50A00F20035372B8665B4DFA5AEEBDB467988CCB5
06CBB035DC65F07C3E6F1BC4F22059B98301EB183DB686DBE006EF7CCDC8E6399
7C32F9B46EC6E1C6F7DFDB271DC4D833C20626BB8CBE2CE6464C3B80A8088ADC1
A0339B8C1313803973478D4C286BFF00D135DFBA6F19E4A90000000049454E44A
E42608200";
bmp := new TBitmap();
bmp.ReadVcon(HexformatStrToTsl(s));
fcbtn.BKBitmap := bmp;
ffbtn := new TBtn(self);
ffbtn.OnClick := function(o,e)
begin
//doshow(1);
ontimerdo();
end
ffbtn.Caption := "";
ffbtn.top := 3;
ffbtn.Width := 20;
ffbtn.Height := 20;
ffbtn.Parent := self;
s := "0502000000060400000074797065000203000000696D670006040000006461746
100029C01000089504E470D0A1A0A0000000D4948445200000014000000140806
0000008D891D0D000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000013149444154
384FBD940D8D834010464F10064000064000180001200004A0000318000128C00
0063030CD9B63B62D85CB5ED3F42513C8EEEC373F3BF0231FE67B82EBBA4ADBB6
92A6A90441A0C67B5DD732CFF3EEF5CAA960DFF72A1086A15455255DD7A9F11EC
7B1EE956529DBB6ED27EE3C099215360C83DAD9012020C1C8F8E8A382E338BAD2
78FAB02C8B8AE679BEAFFCA2824551489224AE5764E90355E0FFD85357323D222
23DC2D117FC49C87082599669D3C9EEAA7767344DA3591A4E9045B2FC2F9CF98E
209742D9BE585B6C360D2768BDF0BD6184B88C63654E102136F9027CB091C1984
51375826059F2BDFAC098E14FAB18747812044AB1A8D334EDAB7758638FE00CF4
B1452F8240FA163D8A221578FCEBB07735FCA782C02D7288C653920D3E6B7F0DF
EA5E0BB7C5850E4063EDA83420076B5E10000000049454E44AE42608200";
bmp := new TBitmap();
bmp.ReadVcon(HexformatStrToTsl(s));
ffbtn.BKBitmap := bmp;
end
function geteditor();
begin
if not owner then return 0;
it := Owner.GetCurrentItem();
edit := it.FEditer;
if not edit then return 0;
m := edit.HighLighter ;
if not(m is class(TTslSynHighLighter)) then
begin
return 0;
end
return edit;
end
fissetnode;
fisloading;
ffbtn;
FTempNodes; //节点
fcbtn;
FList;
flistv;
Ftimer;
Ftimer2;
FString;
fcaretya; //开始位置记录
fcaretyb; //截止位置记录
public
FTree;
end
type TListPages=class(TListBox)
function Create(AOwner);override;
begin
inherited;
Visible := false;
WsPopUp := true;
end
// function PaintIdx(idx,rc_,cvs);override;
// begin
// {**
// @explan(说明)绘制项 %%
// @param(item)(TCustomListItem) 项 %%
// @param(rc)(array) 绘制区域%%
// @param(cvs)(tcanvas) 画布 %%
// **}
// inherited;
// if idx=getCurrentSelection()then
// begin
// rc := rc_;
// rc[2:3]-= 1;
// cvs.pen.Color := rgb(30,144,255);
// cvs.draw("Polyline",array(rc[0:1],(rc[2],rc[1]),(rc[2],rc[3]),(rc[0],rc[3]),rc[0:1]));
// end
// end
function MouseUp(o,e);override;
begin
inherited;
visible := false;
end
function SetData(d);override;
begin
if not ifarray(d)then return;
height := ItemHeight * (1+min(15,length(d)));
x := 10;
for i,v in d do
begin
x := max(x,length(v));
end
width := font.Width * (x+3);
inherited;
end
function InsureItemVisible(idx); //移动当前的格子
begin
return ;//
//return InsureIdxInClient(idx);
rc := GetIdxRect(idx);
c := ClientRect;
if rc[1]<c[1]then
begin
SetYpos(-1+GetYPos()+(rc[1]-c[1])/GetYScrollDelta());
end else
if rc[3]>c[3]then
begin
SetYpos(1+GetYPos()+(rc[3]-c[3]+1)/GetYScrollDelta());
end
end
function GetSelFileName();
begin
r := GetItem(getCurrentSelection());
if r and pos("*",r)then
begin
return r[2:];
end
return r;
end
function IncIndex(f);
begin
if ifnil(f)then f :=-1;
idx := getCurrentSelection();
ct := ItemCount;
nidx := (idx-f+ct) mod ct;
SetCurrentSelection(nidx);
//InsureItemVisible(nidx);
end
end
type TFindListWnd=class(TListBox) //查找的地方
function Create(AOwner);
begin
inherited;
onnotification := function(o,e)begin
ms := e.message;
if ifarray(ms) and ms[0] ="font" then
begin
font := ms[1];
end
end
end
function CheckListItem(s);override;
begin
return ifarray(s);
end
function GetItemText(i);override;
begin
it := GetItem(i);
if it then r := it["caption"];
if not ifstring(r)then return "";
return r;
end
end
type TFindWnd=class(TPage)
type TFindBtn=class(TBtn)
function Create(AOwner);
begin
inherited;
left := 425;
width := 160;
height := 25;
end
end
type TFindCheck=class(TCheckBtn)
function Create(AOwner);
begin
inherited;
left := 25;
width := 160;
height := 25;
end
end
function CreateWndInfo(btn,sec); //触发
begin
r := GetInfo();
if sec then r["section"]:= sec;
r["btn"]:= btn;
end
function Create(AOwner);override;
begin
inherited;
OnClose := function(o,e)
begin
Parent.EndFind();
o.visible := false;
e.Skip := true;
end
WsDlgModalFrame := true;
Visible := false;
WsPopUp := true;
WsCaption := true;
WSsYSMenu := true;
//WsSizeBox := true;
caption := "查找";
SetBoundsRect(array(300,300,920,680));
IncPaintLock();
for i,v in array("查找","替换","文件查找") do
begin
it := CreateApageItem();
it.Caption := v;
PageItems.Push(it);
end
DecPaintLock();
lg := 30;
FEdit_Target := new TEditList(self);
FEdit_repace := new TEditList(self);
FEdit_Type := new TEditList(self);
FEdit_dir := new TEditList(self);
FDirChooser := new TFolderChooseADlg(self);
FEdit_dir_btn := new TBtn(self);
flabels := array();
for i,v in array("查找目标:"," 替换为:","文件类型:"," 目录:") do
begin
lb := new TLabel(self);
lb.TextAlign := AL9_CENTERRIGHT;
lb.caption := v;
lb.Top :=(i+1) * lg;
lb.Height := 25;
lb.Left := 20;
lb.Width := 120;
lb.Parent := self;
//lb.border := true;
flabels[i]:= lb;
end
FEdit_Target.left := 140;
FEdit_Target.top := lg;
FEdit_target.parent := self;
FEdit_target.Editer.OnKeyPress := thisfunction(EditerEnter);
FEdit_repace.left := 140;
FEdit_repace.top := lg+lg;
FEdit_repace.parent := self;
FEdit_type.left := 140;
FEdit_type.top := lg+lg+lg;
FEdit_type.Editer.Text := "*.tsf;*.tsl;";
FEdit_type.parent := self;
FEdit_dir.left := 140;
FEdit_dir.Width := FEdit_dir.Width-20;
FEdit_dir_btn.Caption := "..";
FEdit_dir_btn.top := lg+lg+lg+lg;
FEdit_dir_btn.Width := 18;
FEdit_dir_btn.left := 140+FEdit_dir.Width+2;
FEdit_dir_btn.height := 24;
FEdit_dir.top := lg+lg+lg+lg;
FEdit_dir.parent := self;
FEdit_dir_btn.OnClick := function(o,e)
begin
if FDirChooser.OpenDlg()then
begin
FEdit_dir.Editer.text := FDirChooser.Folder;
end
end
FBtn_Find := new TFindBtn(self);
FBtn_replace := new TFindBtn(self);
FBtn_Count := new TFindBtn(self); // 计数
FBtn_Count_a := new TFindBtn(self); // 计数
FBtn_replaceall := new TFindBtn(self);
FBtn_Find.caption := "查找";
FBtn_replace.caption := "替换";
FBtn_Count_a.Caption := "计数";
FBtn_Count.caption := "全部查找";
FBtn_replaceall.caption := "全部替换";
FBtn_Find.top := lg;
FBtn_Find.parent := self;
FBtn_replace.top := lg+lg;
FBtn_Count_a.top := lg+lg;
FBtn_replace.parent := self;
FBtn_Count_a.parent := self;
FBtn_replaceall.top := lg+lg+lg;
FBtn_replaceall.parent := self;
FBtn_Find.OnClick := thisfunction(FindBtnClick);
FBtn_replace.OnClick := thisfunction(FindBtnClick);
FBtn_Count_a.OnClick := thisfunction(FindBtnClick);
FBtn_Count.OnClick := thisfunction(FindBtnClick);
FBtn_replaceall.OnClick := thisfunction(FindBtnClick);
FBtn_Count.top := lg+lg+lg+lg;
FBtn_Count.parent := self;
FDirChooser.parent := self;
FCheck_revers := new TFindCheck(self);
FCheck_wrap := new TFindCheck(self);
FCheck_case := new TFindCheck(self);
FCheck_cycle := new TFindCheck(self);
FCheck_reg := new TFindCheck(self);
FCheck_subdir := new TFindCheck(self);
FCheck_gt := new TFindCheck(self);
FCheck_subdir.checked := true;
FCheck_subdir.Left := 425;
FCheck_subdir.top := lg+lg+lg+lg;
FCheck_subdir.Caption := "包含子目录";
FCheck_revers.caption := "反向查找";
FCheck_revers.top := lg * 5;
FCheck_revers.parent := self;
FCheck_wrap.caption := "全词匹配";
FCheck_wrap.top := lg * 6;
FCheck_wrap.parent := self;
FEdit_dir_btn.parent := self;
FCheck_case.caption := "忽略大小写";
FCheck_case.Checked := true;
FCheck_case.top := lg * 7;
FCheck_case.parent := self;
FCheck_cycle.caption := "循环查找";
FCheck_cycle.Checked := true;
FCheck_cycle.top := lg * 8;
FCheck_cycle.parent := self;
FCheck_reg.caption := "正则匹配";
FCheck_reg.Enabled := true;
FCheck_reg.top := lg * 9;
FCheck_reg.parent := self;
FCheck_gt.Visible := true;
FCheck_gt.caption := "多行";
FCheck_gt.Checked := true;
FCheck_gt.top := lg * 9;
FCheck_gt.Left := FCheck_reg.width+FCheck_reg.Left+10;
//FCheck_gt.parent := self;
FCheck_subdir.parent := self;
FStatus := new TStatusBar(self);
//FStatus.Align := alNone;
FStatus.Items := array(("text":"","width":700));
FStatus.Parent := self;
OnSelChanged := thisfunction(DoSelChanged);
ItemIndex := 0;
//SetStatusText("查找");
end
function FindBtnClick(o,e);
begin
r := GetInfo();
r["btn"]:= o.Caption;
Owner.DoFind(r,self);
end
function EditErEnter(o,e);
begin
if e.CharCode=13 then
begin
e.skip := true;
r := GetInfo();
r["btn"]:= "查找";
OWner.DoFind(r,self);
end
end
function GetInfo();
begin
r := array();
r["section"]:= CurrentITem.Caption;
s := FEdit_target.Editer.Text;
r["target"]:= s;
r["c_mline"] := FCheck_gt.Checked;
s := FEdit_repace.Editer.Text;
r["replace"]:= s;
r["filetype"]:= FEdit_type.Editer.Text;
r["dir"]:= FEdit_dir.Editer.Text;
r["c_revers"]:= FCheck_revers.Checked;
r["c_cycle"]:= FCheck_cycle.Checked;
r["c_wrap"]:= FCheck_wrap.Checked;
r["c_case"]:= FCheck_case.Checked;
r["c_reg"]:= FCheck_reg.Checked;
r["c_dir"]:= FCheck_subdir.Checked;
return r;
end
function SetStatusText(s);
begin
if ifstring(s)then FStatus.SetItemText(s,0);
end
function OpenFind();
begin
ItemIndex := 0;
end
function OpenReplace();
begin
ItemIndex := 1;
end
function Show(f);override;
begin
it := Owner.GetCurrentEditer();
if it then
begin
s1 := it.SelText;
if s1 and not(pos("\n",s1))then //length(s1)<20 and 取消长度限制
begin
s := s1;
end else
s := it.CaretWords();
SetFindText(s);
FEdit_target.Editer.SetFocus();
end
inherited;
end
Function SetFindText(s); //设置查找的字符串
begin
if s then
FEdit_target.Editer.Text := s;
else s := FEdit_target.Editer.Text;
FEdit_target.Editer.SetSel(0,length(s));
end
function SaveCurrentEditer(); //保存一下数据
begin
for i,v in array(FEdit_target,FEdit_dir,FEdit_type,FEdit_repace) do
begin
v.PushItem(v.Editer.Text);
end
//if e then e.PushItem(e.Editer.Text);
end
function DoSelChanged(o,e);
begin
if CurrentItem then Caption := CurrentItem.Caption;
case Caption of
"查找":
begin
for i := 1 to 3 do flabels[i].Visible := false;
FEdit_dir.visible := false;
FEdit_dir_btn.visible := false;
FEdit_type.visible := false;
FEdit_repace.visible := false;
FBtn_Count_a.visible := true;
FBtn_replace.visible := false;
FBtn_count.Visible := true;
FBtn_Replaceall.Visible := false;
FCheck_subdir.visible := false;
FCheck_Revers.visible := true;
FCheck_cycle.Visible := true;
end
"替换":
begin
flabels[1].Visible := true;
for i := 2 to 3 do flabels[i].Visible := false;
FBtn_Count_a.visible := false;
FEdit_dir.visible := false;
FEdit_dir_btn.visible := false;
FEdit_type.visible := false;
FEdit_repace.visible := true;
FBtn_replace.visible := true;
FBtn_count.Visible := false;
FBtn_Replaceall.Visible := true;
FCheck_subdir.visible := false;
FCheck_Revers.visible := false;
FCheck_cycle.Visible := true;
end
"文件查找":
begin
for i := 1 to 3 do flabels[i].Visible := true;
FBtn_Count_a.visible := false;
FEdit_dir.visible := true;
FEdit_dir_btn.Visible := true;
FEdit_type.visible := true;
FEdit_repace.visible := true;
FBtn_replace.visible := false;
FBtn_count.Visible := false;
FBtn_Replaceall.Visible := true;
FCheck_subdir.visible := true;
FCheck_Revers.visible := false;
FCheck_cycle.Visible := false;
end
end
end
function DoControlAlign();override;
begin
inherited;
if not FStatus then return;
rc := ClientRect;
rc[1]:= rc[3]-30;
FStatus.SetBoundsRect(rc);
end
function recycling();override;
begin
inherited;
FStatus := nil;
end
function GetHistory();
begin
r := array();
r["finds"]:= FEdit_Target.Items;
r["repalces"]:= FEdit_repace.Items;
r["dirs"]:= FEdit_dir.items;
r["findfiletyps"] := FEdit_Type.items;
return r;
end
function SetHistory(d);
begin
if not ifarray(d)then return;
fds := d["finds"];
if ifarray(fds)then
begin
FEdit_Target.Items := fds;
end
rps := d["repalces"];
if ifarray(rps)then
begin
FEdit_repace.Items := rps;
end
dirs := d["dirs"];
if ifarray(dirs)then
begin
FEdit_dir.items := dirs;
end
dirs := d["findfiletyps"];
if ifarray(dirs)then
begin
FEdit_Type.items := dirs;
end
end
private
weakref
FStatus;
FDirChooser;
//查找
FEdit_Target;
FEdit_repace;
FEdit_type;
FEdit_dir;
FEdit_dir_btn;
FBtn_Find;
FBtn_replace;
FBtn_Count_a;
FBtn_Replaceall;
FBtn_Count; // 计数
flabels;
FCheck_revers;
FCheck_wrap;
FCheck_case;
FCheck_cycle;
FCheck_reg;
FCheck_subdir;
FCheck_gt;
autoref
end
type TGoToLineWnd=class(TVCForm) //跳转
function Create(AOwner);override;
begin
inherited;
wssizebox := false;
minmaxbox := false;
WsDlgModalFrame := true;
width := 300;
height := 110;
caption := "转到..";
FLabel := new TLabel(self);
FLabel.SetBoundsRect(array(3,10,70,35));
FEdit := new TEdit(self);
FEdit.SetBoundsRect(array(75,10,200,35));
FBtn := new TBtn(self);
FBtn.SetBoundsRect(array(210,10,280,35));
FLabel.Caption := "目标位置:";
FBtn.Caption := "定位";
FLabel.parent := self;
FEdit.parent := self;
FEdit.OnKeyPress := function(o,e)
begin
if e.CharCode=13 then
begin
e.skip := true;
GotoTextInteger();
end
end
OnClose := function(o,e)
begin
o.visible := false;
e.skip := true;
end
FBtn.parent := self;
FBtn.OnClick := function(o,e)
begin
GotoTextInteger();
end
end
function DoControlAlign();override;
begin
end
function ShowGoto();
begin
show();
FEdit.SetFocus();
FEdit.ExecuteCommand("ecselall");
end
private
function GotoTextInteger();
begin
id := FEdit.Text;
id := StrToIntDef(id,0);
if id>0 then
begin
it := Owner.GetCurrentItem();
Visible := false;
Owner.OpenAndGotoFileByName(it.ScriptPath,id);
it := Owner.GetCurrentEditer();
if not it then return;
it.SetFocus();
end
end
FEdit;
FBtn;
end
function filenameIsTheSame(p1,p2);
begin
if not(ifstring(p1)and ifstring(p2))then return 0;
if p1=p2 then return 1;
{$ifdef linux}
{$else}
return lowercase(p1)=lowercase(p2);
{$endif}
end
type TMouseMoveList=class(TListBox)
function Create(AOwner);override;
begin
inherited;
FCurrentIndex :=-1;
end
function MouseMove(o,e);override;
begin
inherited;
idx := GetIdxByYpos(e.ypos);
if FCurrentIndex <> idx then
begin
FCurrentIndex := idx;
InValidateRect(nil,false);
end
end
function getItemText(i);override;
begin
r := inherited;
return "["$ i $"]" $ to_ansi_str(r);
end
function PaintIdx(idx,rc_,cvs);virtual;
begin
{**
@explan(说明)绘制项 %%
@param(item)(TCustomListItem) 项 %%
@param(rc)(array) 绘制区域%%
@param(cvs)(tcanvas) 画布 %%
**}
inherited;
if idx=FCurrentIndex then
begin
rc := rc_;
rc[2:3]-= 1;
cvs.pen.Color := rgb(30,144,255);
cvs.draw("Polyline",array(rc[0:1],(rc[2],rc[1]),(rc[2],rc[3]),(rc[0],rc[3]),rc[0:1]));
end
end
private
FCurrentIndex;
end
function GetEditIcons();
begin
r := array();
r["打开文件"]:= getopenfilebmpinfo();
r["保存全部"]:= getsaveallbitmapinfo();
r["保存"]:= GetSaveFileBitmapInfo();
r["取消注释"]:= getedituncommetbmpinfo();
r["注释"]:= geteditcommetbmpinfo();
r["tsl代码格式化"]:= gettslcodeformatbitmapinfo();
r["撤销"]:= getredobitmapinfo();
r["反撤销"]:= getunredobitmapinfo();
r["tsl语法检查"]:=gettslsyntaxcheckbitmapinfo();
r["查找"]:=getfindbitmapinfo();
r["后退"]:= getbackwardbitmapinfo();
r["前进"]:= getforwardbitmapinfo();
r["快捷键说明"]:= getquickkeybitmapinfo();
r["代码地图(alt+m)"]:= gettslcodemapbitmapinfo();
r["分隔符"] := 0;
return r union dbugicos();
end
function dbugicos();
begin
r := array();
r["添加/删除断点F5"]:= getdbugaddbreakbmpinfo();
r["暂停"]:= getdbugsuspendbmpinfo();
r["继续"]:= getdbugcontinuebmpinfo();
r["进入"]:= getdbugsetpinbmpinfo();
r["跳出"]:= getdbugstepoutbmpinfo();
//r["单步"] := getdbugmcronextbmpinfo();
r["下一行(F8)"]:= getdbugnextbmpinfo();
r["终止"]:= getdbugstopbmpinfo();
r["刷新符号表"]:= getdbugfreshsymsbmpinfo();
r["刷新当前符号"]:=getdbugfreshsymbmpinfo();
return r;
end
function to_ansi_str(s);
begin
if IsTextUTF8(s)=1 then return UTF8toansi(s);
return s;
end
function ReWriteString(fn,d);
begin
if not ifstring(d)then return 0;
als := "";
len := length(d);
sp := ioFileseparator();
if FileExists(als,fn) and (filesize(als,fn)>len)then
begin
lfn := FileList(als,fn); //修正文件名变小写的问题
if lfn then
begin
nfn := lfn[0,"FileName"];
if nfn then
begin
for i := length(fn) downto 1 do
begin
if fn[i]=sp then
begin
fn := fn[1:i]+nfn;
break;
end
end
end
end
FileDelete(als,fn);
end else
begin
CreateDirWithFileName(fn);
end
spos := 0;
return writefile(rwraw(),als,fn,spos,len,d);
end
function gettslexe();
begin
return static gettslexefullpath();
end
function limitstringlength(s);
begin
len := length(s);
n := 150;
if len>n then
begin
if bytetype(s,n)=1 then
begin
return trim(s[1:(n-1)])+"...";
end else
begin
return trim(s[1:n])+"...";
end
end
return trim(s);
end
{$ifdef linux}
function HtmlHelpA()
begin
return 0;
end
function GetDesktopWindow()
begin
return 0;
end
{$else}
function HtmlHelpA(hwndCaller:pointer;pszFile:string;uCommand:integer;dwData:pointer):pointer;stdcall;external "HHCTRL.OCX" name "HtmlHelpA";
function GetDesktopWindow():pointer;stdcall;external "User32.dll" name "GetDesktopWindow";
{$endif}
end.
Reference in New Issue View Git Blame Copy Permalink