liujianjun
/
tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

更新编辑器

This commit is contained in:
liujianjun 2025-01-26 11:54:31 +08:00
parent 9a87a6286b
commit 314869d09c
19 changed files with 647 additions and 608 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

122
designer/ctl_mgr/resource.tfm/t_code_format_mgr.tfm Normal file
View File

@ -0,0 +1,122 @@
object codeformateditor:t_code_format_mgr
autosize=true
caption="tsl代码格式化参数"
childsizing=<
layout=1
controlsperline=2
horizontalspacing=10
verticalspacing=10
leftrightspacing=20
topbottomspacing=10
>
font=<
height=19
width=9
escapement=0
orientation=0
weight=400
italic=0
underline=0
strikeout=0
charset=134
outprecision=3
clipprecision=2
quality=1
pitchandfamily=49
facename="新宋体"
color=0
>
height=90
left=547
minmaxbox=false
onclose=tformatinfownd1_close
parentfont=false
top=277
width=449
wssizebox=false
object label1:tlabel
left=20
top=10
width=128
height=22
autosize=true
caption="多行注释对齐"
end
object faligncmt:tcheckbtn
autosize=false
caption=""
height=22
left=158
parentcolor=true
top=10
width=110
end
object label3:tlabel
left=20
top=42
width=128
height=22
autosize=true
caption="array格式化"
end
object farraytype:tcombobox
autosize=true
height=22
itemindex=1
items=["默认" "普通" "宽松" ]
left=158
top=42
width=110
end
object label4:tlabel
left=20
top=74
width=128
height=22
autosize=true
caption="语法检查"
end
object fsyncheck:tcheckbtn
caption=""
checked=true
height=22
left=158
parentcolor=true
top=74
width=110
end
object label5:tlabel
left=20
top=106
width=128
height=22
autosize=true
caption="格式化选择区域"
end
object fselectcheck:tcheckbtn
caption=""
height=22
left=158
parentcolor=true
top=106
width=110
end
object label2:tlabel
left=20
top=138
width=128
height=22
caption=""
end
object btn1:tbtn
autosize=true
caption="确定"
height=22
left=158
onclick=dookclick
top=138
width=110
end
end

132
designer/ctl_mgr/resource.tfm/t_editor_color_mgr.tfm Normal file
View File

@ -0,0 +1,132 @@
object ditor_color_mgr:t_editor_color_mgr
autosize=true
caption="编辑器配色"
font=<
height=16
width=8
escapement=0
orientation=0
weight=400
italic=0
underline=0
strikeout=0
charset=134
outprecision=3
clipprecision=2
quality=1
pitchandfamily=49
facename="新宋体"
color=0
>
height=382
left=645
minmaxbox=false
onclose=edtcolormain1_close
top=312
visible=false
width=373
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=7
ondrawlist=listbox1_draw
onselchanged=listbox1_sel
ownerdraw=true
top=47
width=323
end
object colorcombobox2:tcolorcombobox
height=23
itemindex=0
left=154
onselchanged=colorcombobox2_onselchanged
top=18
width=177
end
object openfileadlg1:topenfileadlg
left=314
top=36
height=30
width=30
caption="openfileadlg1"
filter=<
stm="*.stm"
"所有"="*"
>
end
object panel2:tpanel
autosize=true
caption="panel2"
childsizing=<
layout=1
controlsperline=5
horizontalspacing=10
verticalspacing=10
leftrightspacing=20
topbottomspacing=10
>
height=39
left=5
top=304
width=352
wsdlgmodalframe=false
object btn4:tbtn
autosize=true
caption="导入"
height=19
left=20
onclick=import_clk
top=10
width=48
end
object btn5:tbtn
autosize=true
caption="导出"
height=19
left=78
onclick=export_clk
top=10
width=48
end
object btn3:tbtn
autosize=true
caption="还原默认"
height=19
left=136
onclick=btn3_clk
top=10
width=80
end
object btn1:tbtn
autosize=true
caption="取消"
height=19
left=226
onclick=btn1_clk
top=10
width=48
end
object btn2:tbtn
autosize=true
caption="确定"
height=19
left=284
onclick=btn2_clk
top=10
width=48
end
end
end

47
designer/ctl_mgr/resource.tfm/t_searchdir_mgr.tfm
View File

@ -1,47 +0,0 @@
object searchdir_mgr:t_searchdir_mgr
caption="函数搜索目录:左侧为别名,右侧为-libpath目录...."
height=454
left=570
top=447
width=766
object panel1:tpanel
caption="panel1"
height=300
left=165
top=85
width=455
object panel2:tpanel
align=alleft
autosize=true
caption="panel2"
height=294
left=0
top=0
width=140
object label1:tlabel
left=90
top=145
width=44
height=17
autosize=true
caption="label1"
end
end
object splitter1:tsplitter
left=140
top=0
width=10
height=294
align=alleft
caption="splitter1"
end
object panel3:tpanel
align=alclient
caption="panel3"
height=294
left=150
top=0
width=299
end
end
end

62
designer/ctl_mgr/t_code_format_mgr.tsf Normal file
View File

@ -0,0 +1,62 @@
type t_code_format_mgr=class(tdcreateform)
uses tslvcl;
label1:tlabel;
label2:tlabel;
label3:tlabel;
label4:tlabel;
label5:tlabel;
faligncmt:tcombobox;
fcharct:tcombobox;
farraytype:tcombobox;
fsyncheck:tcheckbtn;
fselectcheck:tcheckbtn;
btn1:tbtn;
function Create(AOwner);override;//构造
begin
inherited;
end
function DoOKClick(o;e);virtual;
begin
calldatafunction(FOnOkClick,self,e);
end
function tformatinfownd1_close(o;e);virtual;
begin
e.skip := true;
o.Visible := false;
end
function Recycling();override;//回收变量
begin
inherited;
ci := self.classinfo();
//将成员变量赋值为nil避免循环引用
for i,v in ci["members"]do
begin
invoke(self,v["name"],nil);
end
end
function GetData();
begin
r := array();
r["cmt"]:= faligncmt.Checked;
r["arraytype"]:= array("普通":1,"默认":0,"宽松":3)[farraytype.getCurrentItemText()];
r["syn"]:= fsyncheck.checked;
r["sel"]:= fselectcheck.checked;
return r;
end
function SetData(d);
begin
//"50" "80" "100" "130"
// "50" "100" "130" "150" "200" "250" "300"
//"默认" "普通" "宽松"
if ifarray(d) then
begin
faligncmt.Checked := (d["cmt"]=1);
farraytype.ItemIndex := (array(0:0,1:1,3:2))[d["arraytype"]];
fsyncheck.Checked := d["syn"];
fselectcheck.Checked := d["sel"];
end
end
property OnOkClicked read FOnOkClick write FOnOkClick;
private
[weakref] FOnOkClick;
end

260
designer/ctl_mgr/t_editor_color_mgr.tsf Normal file
View File

@ -0,0 +1,260 @@
type t_editor_color_mgr=class(tdcreateform)
uses tslvcl;
colorcombobox1:tcolorcombobox;
listbox1:tlistbox;
colorcombobox2:tcolorcombobox;
openfileadlg1:topenfileadlg;
panel2:tpanel;
btn4:tbtn;
btn5:tbtn;
btn3:tbtn;
btn1:tbtn;
btn2:tbtn;
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;
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

30
designer/ctl_mgr/t_searchdir_mgr.tsf
View File

@ -1,30 +0,0 @@
type t_searchdir_mgr=class(tdcreateform)
uses tslvcl;
panel1:tpanel;
panel2:tpanel;
splitter1:tsplitter;
panel3:tpanel;
label1:tlabel;
function Create(AOwner);override; //构造
begin
inherited;
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["const"] then continue;
if v["static"] then continue;
invoke(self,v["name"],nil);
end
end
end

10
designer/ctl_mgr/vcldesginer.tpj
View File

@ -58,6 +58,16 @@ array(
"name":"tsl1",
"type":"tsl",
"dir":""
),
"t_editor_color_mgr":(
"name":"t_editor_color_mgr",
"type":"form",
"dir":""
),
"t_code_format_mgr":(
"name":"t_code_format_mgr",
"type":"form",
"dir":""
)
),
"mainform":"t_shortcut_keys_view",

150
designer/teditorform.tsf
View File

@ -509,7 +509,7 @@ type teditorform = class(TVCform) //
formIcon := GetIcon();
FEdter.Visible := true;
FFormatInfoWnd := NEW tformatinfownd(self);
FFormatInfoWnd := NEW t_code_format_mgr(self);
FFormatInfoWnd.Visible := false;
FFormatInfoWnd.WsDlgModalFrame := true;
FFormatInfoWnd.Parent := self;
@ -992,154 +992,6 @@ end
%%;
end
end
type TFormatInfoWnd=class(tvcform)
uses tslvcl;
label1:tlabel;
label2:tlabel;
label3:tlabel;
label4:tlabel;
label5:tlabel;
faligncmt:tcombobox;
fcharct:tcombobox;
farraytype:tcombobox;
fsyncheck:tcheckbtn;
fselectcheck:tcheckbtn;
btn1:tbtn;
function Create(AOwner);override;//构造
begin
inherited;
Loader.LoadFromTfmScript(self,GetWndInfo());
//WSSizebox := true;
end
function DoOKClick(o;e);virtual;
begin
calldatafunction(FOnOkClick,self,e);
end
function tformatinfownd1_close(o;e);virtual;
begin
e.skip := true;
o.Visible := false;
end
function DoControlAlign();override;//对齐子控件
begin
end
function Recycling();override;//回收变量
begin
inherited;
ci := self.classinfo();
//将成员变量赋值为nil避免循环引用
for i,v in ci["members"]do
begin
invoke(self,v["name"],nil);
end
end
function GetData();
begin
r := array();
r["cmt"]:= faligncmt.Checked;
r["arraytype"]:= array("普通":1,"默认":0,"宽松":3)[farraytype.getCurrentItemText()];
r["syn"]:= fsyncheck.checked;
r["sel"]:= fselectcheck.checked;
return r;
end
function SetData(d);
begin
//"50" "80" "100" "130"
// "50" "100" "130" "150" "200" "250" "300"
//"默认" "普通" "宽松"
if ifarray(d) then
begin
faligncmt.Checked := (d["cmt"]=1);
farraytype.ItemIndex := (array(0:0,1:1,3:2))[d["arraytype"]];
fsyncheck.Checked := d["syn"];
fselectcheck.Checked := d["sel"];
end
end
property OnOkClicked read FOnOkClick write FOnOkClick;
private
[weakref] FOnOkClick;
function GetWndInfo();
begin
return %% object tformatinfownd1:tformatinfownd
caption="tsl代码格式化参数"
height=240
left=497
minmaxbox=false
autosize=true
onclose=tformatinfownd1_close
top=295
width=280
wssizebox=false
object label1:tlabel
left=16
top=19
width=92
height=25
caption="多行注释对齐"
end
object label3:tlabel
left=16
top=67
width=80
height=25
caption="array格式化"
end
object label4:tlabel
left=13
top=112
width=80
height=21
caption="语法检查"
end
object label5:tlabel
left=13
top=138
width=114
height=25
caption="格式化选择区域"
end
object faligncmt:tcheckbtn
height=22
left=113
top=19
width=22
caption =""
end
object farraytype:tcombobox
height=23
itemindex=1
items=["默认" "普通" "宽松" ]
left=103
top=67
width=143
end
object fsyncheck:tcheckbtn
caption=""
checked=true
height=22
left=124
top=109
width=22
end
object fselectcheck:tcheckbtn
caption=""
height=20
left=135
top=141
width=21
end
object btn1:tbtn
caption="确定"
height=31
left=154
onclick=dookclick
top=166
width=82
end
end%%;
end
end
type TBlockEditer = class(TPanel)
uses TSLVCL,UtslCodeEditor;
function Create(AOwner);override;

369
designer/utslcodeeditor.tsf
View File

@ -1802,7 +1802,6 @@ type TEditer=class(TCustomcontrol) //
global g_editer_font_size := ft;
self.Notification(self,array("font",ft));
FinCodemap.FTree.font := ft;
FinCodemap.FTree.ItemHeight := fh+6;
if fh<20 then
begin
@ -1881,10 +1880,12 @@ type TEditer=class(TCustomcontrol) //
end;
FFindWnd := new TFindWnd(self); //²éÕÒ
FFindWnd.ParentFont := false;
FFindWnd.font := array("height":20,"width":10);
FGotoLineWnd := new TGoToLineWnd(self); //¹²Í¬
FListPages := new TListPages(self); //tab ÌøתҳÃæ
FEchoWnd := new TEditerEchoWnd(self);
FEchoWnd.font := array("height":24,"width":12,"escapement":0,"orientation":0,"weight":400,"italic":0,"underline":0,"strikeout":0,
FEchoWnd.font := array("height":22,"width":11,"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);
@ -3862,12 +3863,12 @@ type TEditer=class(TCustomcontrol) //
begin
if not fhltediter then
begin
fhltediter := new thighlightercoloredter(self);
fhltediter := new t_editor_color_mgr(self);
fhltediter.ParentFont := false;
fhltediter.Parent := self;
fhltediter.left := left+200;
fhltediter.top := top+200;
fhltediter.colorinfo := fhltediterdata;
end
move_popwnd_to_center2(fhltediter);
if fhltediter.ShowModal() then
begin
Fhightercolor.colors := fhltediter.colorinfo;
@ -4551,361 +4552,6 @@ begin
wnd.Left := max(0,xy[0]+(r[2]-r[0]-wnd.width)/2) ;
wnd.top := max(0,xy[1]+(r[3]-r[1]-wnd.Height)/2);
end
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;
@ -5204,6 +4850,8 @@ type tfincodemap = class(tcustomcontrol)
initbtn();
FTree := new TTreeView(self);
FTree.ParentFont := false;
FTree.font := array("width":11,"height":22);
ftree.ItemHeight := 28;
FTree.OnSelChanged := thisfunction(SynNodeSelected);
FTree.Parent := self;
FTree.onsyskeydown := function(o,e)begin
@ -5569,6 +5217,7 @@ type TFindListWnd=class(TListBox) //
function Create(AOwner);
begin
inherited;
font := array("width":11,"height":22);
ParentFont := false;
onnotification := function(o,e)begin
ms := e.message;

8
designer/utslvcldebuger.tsf
View File

@ -689,18 +689,19 @@ type TTslDebuga=class(TCustomControl)
dbwnd.Parent := self;
FStackList := new TListView(self); // new TListBox(self); //new tmemo(self);//
FStackList.ItemHeight := 23;
FStackList.Columns := array(("text":"line","width":40),
FStackList.Columns := array(("text":"line","width":80),
("text":"function","width":250) //,("text":"type","width":70)
);
FStackList.Border := true;
FVaraiblesList := new TGroupGridA(self);
FVaraiblesList.Border := false;
FVaraiblesList.ItemHeight := 23;
FVaraiblesList.Columns := array(("text":"name","width":95),
FVaraiblesList.Columns := array(("text":"name","width":105),
("text":"value","width":135),
("text":"type","width":50)
("text":"type","width":80)
);
FCommandtext := new TEdit(self);
FCommandtext.autosize := true;
FCommandtext.placeholder := "ÃüÁîÊäÈë¿ò";
FCommandtext.Height := 23;
FCommandtext.onkeyup := thisfunction(cmdkeyup);
@ -1949,6 +1950,7 @@ type tdbgselwnd=class(tdcreateform)
begin
inherited;
Visible := false;
ParentFont := false;
Loader.LoadFromTfmScript(self,getinfo());
flist.Columns := array(
("text":"IDºÅ","width":150),

2
designer/utslvcldesigner.tsf
View File

@ -1447,7 +1447,7 @@ type TVclDesigner = class(tvcform)
rect := _wapi.GetScreenRect();
twidth := (rect[2]-50);
width := twidth;
height := 200;
height := 180;
//calcheight(twidth);
caption := "TVCL界面设计器";
FProjectsManager := new TProjectManagerForm(self);

BIN
editor-install.exe
View File

Binary file not shown.

2
funcext/tvclib/t_children_sizer.tsf
View File

@ -41,6 +41,8 @@ type t_children_sizer = class()
bds[3] := bds[1]+h+dh;
fowner.BoundsRect := bds;
end
p := fowner.parent;
if p and p.autosize then p.AdjustSize();//处理传到
fautosizing := false;
end
function getsizerinfo();

8
funcext/tvclib/tcontrol.tsf
View File

@ -1016,8 +1016,8 @@ type tcontrol = class(tcomponent)
if (o is class(TWinControl)) and o.WsPopUp then return ;
if (Align=alNone) then
begin
p := Parent ;
if p and p.childsizing.layout>0 then return p.AdjustSize();
//p := Parent ;
//if p and p.childsizing.layout>0 then return p.AdjustSize();
AdjustSize();
end
end
@ -1029,8 +1029,8 @@ type tcontrol = class(tcomponent)
if not NoRecycled() then return ;
CallMessgeFunction(OnSize,o,e);
DoWMSIZE(o,e);
p := Parent ;
if p and p.childsizing.layout>0 then return p.AdjustSize();
//p := Parent ;
//if p and p.childsizing.layout>0 then return p.AdjustSize();
AdjustSize();
end
function CMCursorChanged(o,e):CM_CURSORCHANGED;virtual;

6
funcext/tvclib/twincontrol.tsf
View File

@ -2597,7 +2597,7 @@ type TWinControl = class(tcontrol)
begin
return ;
end
cs := childsizing;
cs := fchildsizing;
if cs and cs.layout>0 then return cs.AdjustSize();
if autosize then
begin
@ -2682,7 +2682,7 @@ type TWinControl = class(tcontrol)
@explan(说明) 控件对齐 %%
**}
if not HandleAllocated()then exit;
cs := childsizing;
cs := fchildsizing;
if cs and cs.layout>0 then return;
if not ifarray(rect)then
begin
@ -2710,7 +2710,7 @@ type TWinControl = class(tcontrol)
@explan(说明) 控件锚定调整 %%
**}
if not HandleAllocated()then exit;
cs := childsizing;
cs := fchildsizing;
if cs and cs.layout>0 then return ;
e := new TMANCHOR(CN_ANCHOR,0,0,0);
c := ClientRect;

15
funcext/tvclib/utslvclstdctl.tsf
View File

@ -4179,8 +4179,10 @@ type TcustomListBox=class(TCustomListBoxbase)
begin
if h>0 and h<>FListitemheigt then
begin
dy := GetYScrollDelta();
FListitemheigt := integer(h);
if FOwnerDraw then
dy2 := GetYScrollDelta();
if dy<>dy2 then
begin
doControlALign();
InvalidateRect(nil,false);
@ -4194,7 +4196,7 @@ type TcustomListBox=class(TCustomListBoxbase)
fselbkcolor := v;
end
end
function SetItemCount(n);
function SetItemCount(n); //自绘制才能设置项目
begin
if fownerdraw and (n>=0) and ItemCount<>n then
begin
@ -4208,9 +4210,14 @@ type TcustomListBox=class(TCustomListBoxbase)
if FOwnerDraw<>nv then
begin
FOwnerDraw := nv;
if not(FListitemheigt>0) then
dy := GetYScrollDelta();
ft := Font;
if ft then FListitemheigt := font.Height+4;
dy2 := GetYScrollDelta();
if dy1<>dy2 then //改变
begin
FListitemheigt := font.Height+4;
doControlALign();
InvalidateRect(nil,false);
end
end
end

22
funcext/tvclib/utvclgraphics.tsf
View File

@ -2932,7 +2932,16 @@ type tg_text = class(tg_base)
if (visible<>tgc_on) then return ;
if not fdata then return ;
if not zoom_to_xyz(fdata[0],fdata[1],fdata[2],x,y) then return ;
if clip_state=tgc_on then cvs.axesclip();
if clip_state=tgc_on then
begin
bx := axes.zoom_box;
vj := fdata;
if vj[0]<bx[0,0] or vj[1]<bx[1,0] or vj[2]<bx[2,0] or vj[0]>bx[0,1] or vj[1]>bx[1,1] or vj[2]>bx[2,1] then
begin
return ;
end
cvs.axesclip();
end
else cvs.axesunclip();
get_text_size(w,h,hi);
set_lineinfo_to_canvas(cvs);
@ -3222,7 +3231,16 @@ type tg_tips = class(tg_base) //
ss := get_text();
if not ss then return ;
if not(f_ps and ifnumber(f_ps[0]) and ifnumber(f_ps[1])) then return ;
if clip_state=tgc_on then cvs.axesclip();
if clip_state=tgc_on then //Óػش¦Àí
begin
bx := axes.zoom_box;
vj := d;
if vj[0]<bx[0,0] or vj[1]<bx[1,0] or vj[2]<bx[2,0] or vj[0]>bx[0,1] or vj[1]>bx[1,1] or vj[2]>bx[2,1] then
begin
return ;
end
cvs.axesclip();
end
else cvs.axesunclip();
ws := 0;
hs := array();

BIN
tsleditor.exe
View File

Binary file not shown.

BIN
tslvcltool.exe
View File

Binary file not shown.