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

编辑器 

优化
This commit is contained in:
tslediter 2023-11-29 09:21:06 +08:00
parent 362e8a697b
commit b60fdfdc3e
7 changed files with 54 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
designer/utslcodeeditor.tsf
View File

@ -1676,13 +1676,13 @@ type TPageEditer=class(TPage) //
fw := font.Width; fw := font.Width;
if e.delta<0 then if e.delta<0 then
begin begin
if fw>8 then if fw>6 then
begin begin
finfo := array("width":fw-1,"height":font.height-2); finfo := array("width":fw-1,"height":font.height-2);
end end
end else end else
begin begin
if fw<15 then if fw<24 then
begin begin
finfo := array("width":fw+1,"height":font.height+2); finfo := array("width":fw+1,"height":font.height+2);
end end

25
designer/utslvcldebuger.tsf
View File

@ -652,7 +652,8 @@ type TTslDebuga=class(TCustomControl)
if h then if h then
begin begin
ExecuteCommand("dbgcreatechannel"); ExecuteCommand("dbgcreatechannel");
ExecuteCommand("showeval","调试程序:"+FDebugExe); ExecuteCommand("showstr","调试程序:"+FDebugExe);
ExecuteCommand("showstr","命令行参数:"+exestr);
if FConnectchannel then if FConnectchannel then
begin begin
dbgattachwait(FConnectchannel); dbgattachwait(FConnectchannel);
@ -903,7 +904,7 @@ type TTslDebuga=class(TCustomControl)
if recvtype=0 then if recvtype=0 then
begin begin
FRemoteWait := 0; FRemoteWait := 0;
ExecuteCommand("showeval","调试结束"); ExecuteCommand("showstr","调试结束");
if FConnectchannel then dbgdeletechannel(FConnectchannel); if FConnectchannel then dbgdeletechannel(FConnectchannel);
FConnectchannel := 0; FConnectchannel := 0;
g_tsldbgcallback_handle := nil; g_tsldbgcallback_handle := nil;
@ -1017,7 +1018,7 @@ type TTslDebuga=class(TCustomControl)
end end
FRemoteWait := 0; FRemoteWait := 0;
if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil); if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil);
ExecuteCommand("showeval","调试结束"); ExecuteCommand("showstr","调试结束");
toolbtnState("停止"); toolbtnState("停止");
return; return;
end end
@ -1174,6 +1175,10 @@ type TTslDebuga=class(TCustomControl)
FCommandtext.Text := ""; FCommandtext.Text := "";
end end
end end
"showstr":
begin
FShowText.Text += (ifstring(p)?p:tostn(p)) +"\r\n";
end
"showeval": "showeval":
begin begin
FShowText.Text += "ans="+tostn(p)+"\r\n"; FShowText.Text += "ans="+tostn(p)+"\r\n";
@ -1352,7 +1357,7 @@ type TTslDebuga=class(TCustomControl)
end else end else
begin begin
if FDebugExe="1" then if FDebugExe="1" then
ExecuteCommand("showeval","当前指定的执行程序不存在!!"); ExecuteCommand("showstr","当前指定的执行程序不存在!!");
end end
psi := ps[1]; psi := ps[1];
if psi and fileexists("",psi)then if psi and fileexists("",psi)then
@ -1378,22 +1383,22 @@ type TTslDebuga=class(TCustomControl)
if(FDebugExe="1")and cmdexe then if(FDebugExe="1")and cmdexe then
begin begin
FDebugExe := cmdexe; FDebugExe := cmdexe;
ExecuteCommand("showeval","<当前执行程序(F9)做调试器>"); ExecuteCommand("showstr","<当前执行程序(F9)做调试器>");
end else end else
if fileexists("",FDebugExe)then if fileexists("",FDebugExe)then
begin begin
ExecuteCommand("showeval","<用配置文件给定的调试器>"); ExecuteCommand("showstr","<用配置文件给定的调试器>");
end else end else
begin begin
FDebugExe := fdefaultdbger; FDebugExe := fdefaultdbger;
ExecuteCommand("showeval","<用编辑器自带的调试器b:>"); ExecuteCommand("showstr","<用编辑器自带的调试器b:>");
end end
end end
function remotedbugok(); function remotedbugok();
begin begin
if FAttchedid then if FAttchedid then
begin begin
ExecuteCommand("showeval","远程启动脚本:"+FAttchedid["info"]); ExecuteCommand("showstr","远程启动脚本:"+FAttchedid["info"]);
end end
end end
function remotewaitinit(d); function remotewaitinit(d);
@ -1425,7 +1430,7 @@ type TTslDebuga=class(TCustomControl)
begin begin
if FDebugtype <> "remotewait" then setbrks(); //设置断点 if FDebugtype <> "remotewait" then setbrks(); //设置断点
//showbtns(); //显示按钮 //showbtns(); //显示按钮
ExecuteCommand("showeval","开始调试"); ExecuteCommand("showstr","开始调试");
//toolbtnState("暂停"); //toolbtnState("暂停");
remotedbugok(); remotedbugok();
return; return;
@ -1457,7 +1462,7 @@ type TTslDebuga=class(TCustomControl)
if e then e.skip := true; if e then e.skip := true;
if FConnectchannel then dbgdeletechannel(FConnectchannel); if FConnectchannel then dbgdeletechannel(FConnectchannel);
FConnectchannel := 0; FConnectchannel := 0;
ExecuteCommand("showeval",ifstring(s)?s:"取消远程调试..."); ExecuteCommand("showstr",ifstring(s)?s:"取消远程调试...");
end end
function stkdbclk(o,e); function stkdbclk(o,e);
begin begin

55
funcext/tvclib/tslvcl.tsf
View File

@ -1475,28 +1475,28 @@ type twrapmemo = class(TScrollingWinControl)
return FCopyer; return FCopyer;
end end
function cutstr(s,w,r); function cutstr(s,w,r);
begin
idx := length(r);
len := length(s);
i := 0;
while i<len do
begin begin
if i=len then break; idx := length(r);
et := min(i+w,len); len := length(s);
if bytetype(s,et)=1 then i := 0;
while i<len do
begin begin
et-=1; if i=len then break;
end et := min(i+w,len);
r[idx++] := s[i+1:et]; if bytetype(s,et)=1 then
i := et; begin
end et-=1;
return ; end
for i := 0 to len step w do r[idx++] := s[i+1:et];
begin i := et;
if i=len then continue; end
r[idx++] := s[i+1:min(i+w,len)]; return ;
end for i := 0 to len step w do
end begin
if i=len then continue;
r[idx++] := s[i+1:min(i+w,len)];
end
end
private private
FCharwidth; FCharwidth;
fcharcount; fcharcount;
@ -5403,11 +5403,11 @@ type TQuotations=class(tcomponent)
**} **}
private private
static FSQuotations; static FSQuotations;
static RE_ERROR; static const RE_ERROR=0;
static RE_FUNCRESULT; static const RE_FUNCRESULT=0x0201;
static RE_FUNCSTATE; static const RE_FUNCSTATE=0x0301;
static RE_ECHO; static const RE_ECHO=0x0401;
static RE_QUERY; static const RE_QUERY=0x0402;
[weakref]FOncallBack; //回调函数 [weakref]FOncallBack; //回调函数
FChannel; //通道 FChannel; //通道
FData; //返回数据 FData; //返回数据
@ -5432,11 +5432,6 @@ type TQuotations=class(tcomponent)
if not ifarray(FSQuotations)then if not ifarray(FSQuotations)then
begin begin
FSQuotations := array(); FSQuotations := array();
RE_ERROR := 0;
RE_FUNCRESULT := 0x0201;
RE_FUNCSTATE := 0x0301;
RE_ECHO := 0x0401;
RE_QUERY := 0x0402;
end end
end end
function RemoteCallBack(d);virtual; function RemoteCallBack(d);virtual;

3
funcext/tvclib/utslmemo.tsf
View File

@ -4276,9 +4276,10 @@ type TSynMemoNorm = class(TsynCustomMemo) //
begin begin
fw := font.Width; fw := font.Width;
flg := false; flg := false;
//echo "\r\n:",fw,"--",font.Height;
if e.delta<0 then if e.delta<0 then
begin begin
if fw>8 then if fw>6 then
begin begin
flg := true; flg := true;
font := array("width":fw-1,"height":font.height-2); font := array("width":fw-1,"height":font.height-2);

6
funcext/tvclib/utslvcl_com.tsf
View File

@ -679,6 +679,7 @@ type idispatch=class(iunkown)
end end
frgDispIds := array(); frgDispIds := array();
frgDispIds2 := array(); frgDispIds2 := array();
fglobalL := TS_GetGlobalL();
end end
function GetTypeInfoCount(s:pointer;var pctinfo:integer):integer;stdcall;virtual; function GetTypeInfoCount(s:pointer;var pctinfo:integer):integer;stdcall;virtual;
begin begin
@ -706,11 +707,11 @@ type idispatch=class(iunkown)
fname := getdispidstr(dispIdMember); fname := getdispidstr(dispIdMember);
for idx,p1 in pp do for idx,p1 in pp do
begin begin
VariantToObj2(TS_GetGlobalL(),p1._getptr_,r,fcom_mgr.invoke_param_is_excel(fname)); VariantToObj2(fglobalL,p1._getptr_,r,fcom_mgr.invoke_param_is_excel(fname));
pms[idx] := r; pms[idx] := r;
end end
x := fcom_mgr.invoke_call(fname,pms); x := fcom_mgr.invoke_call(fname,pms);
ObjToVariantRef(TS_GetGlobalL(),x,pVarResult,fcom_mgr.execute_retun_is_excel(fname)); ObjToVariantRef(fglobalL,x,pVarResult,fcom_mgr.execute_retun_is_excel(fname));
return 0; return 0;
end end
function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;virtual; function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;virtual;
@ -732,6 +733,7 @@ type idispatch=class(iunkown)
private private
frgDispIds; frgDispIds;
frgDispIds2; frgDispIds2;
fglobalL;
function getdispid(s); function getdispid(s);
begin begin
id := frgDispIds[s]; id := frgDispIds[s];

7
funcext/tvclib/utslvclgdi.tsf
View File

@ -2209,7 +2209,7 @@ type TcustomCanvas = class(TSLUIBASE)
begin begin
FFont.SetValues(f); FFont.SetValues(f);
end else end else
FFont.copyfont(f); FFont.copyfont(f);
end end
function SetBrush(b); function SetBrush(b);
begin begin
@ -2529,7 +2529,10 @@ type TcustomCanvas = class(TSLUIBASE)
@explan(说明)在指定区域上输出文本%% @explan(说明)在指定区域上输出文本%%
@param(str)(string) 绘制的文字 %% @param(str)(string) 绘制的文字 %%
@param(rec)(array) array(left,top,right,bottom) %% @param(rec)(array) array(left,top,right,bottom) %%
@param(uft)(integer) DT_CALCRECT：这个参数比较重要，可以使DrawText函数计算出输出文本的尺寸。如果输出文本有多行，DrawText函数使用lpRect定义的矩形的宽度，并扩展矩形的底部以容纳输出文本的最后一行。如果输出文本只有一行，则DrawText函数改变矩形的右边界，以容纳下正文行的最后一个字符。出现上述任何一种情况，DrawText函数将返回格式化文本的高度，而不是绘制文本。 @param(uft)(integer) DT_CALCRECT：这个参数比较重要，可以使DrawText函数计算出输出文本的尺寸。
如果输出文本有多行，DrawText函数使用lpRect定义的矩形的宽度，并扩展矩形的底部以容纳输出文本的最后一行。
如果输出文本只有一行，则DrawText函数改变矩形的右边界，以容纳下正文行的最后一个字符。
出现上述任何一种情况，DrawText函数将返回格式化文本的高度，而不是绘制文本。
DT_CENTER：指定文本水平居中显示。 DT_CENTER：指定文本水平居中显示。
DT_VCENTER：指定文本垂直居中显示。该标记只在单行文本输出时有效，所以它必须与DT_SINGLELINE结合使用。 DT_VCENTER：指定文本垂直居中显示。该标记只在单行文本输出时有效，所以它必须与DT_SINGLELINE结合使用。
DT_SINGLELINE：单行显示文本，回车和换行符都不断行。 DT_SINGLELINE：单行显示文本，回车和换行符都不断行。

2
funcext/tvclib/uwindowsinterface.tsf
View File

@ -498,7 +498,7 @@ type twindowsapi = class()
Function LoadIconA2(hd:pointer;n:pointer):pointer;stdcall;external "User32.dll" name "LoadIconA"; Function LoadIconA2(hd:pointer;n:pointer):pointer;stdcall;external "User32.dll" name "LoadIconA";
Function DrawTextA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer):integer;stdcall;external "User32.dll" name "DrawTextA"; Function DrawTextA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer):integer;stdcall;external "User32.dll" name "DrawTextA";
Function DrawTextExA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer;lpdtp:pointer):integer;stdcall;external "User32.dll" name "DrawTextExA"; Function DrawTextExA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer;lpdtp:pointer):integer;stdcall;external "User32.dll" name "DrawTextExA";
Function DrawFrameControl(DC:pointer; var LPRECT: array of integer ; dr1 :integer;dr2:integer):integer;stdcall;external "User32.dll" name "DrawFrameControl"; Function DrawFrameControl(DC:pointer; LPRECT: array of integer ; dr1 :integer;dr2:integer):integer;stdcall;external "User32.dll" name "DrawFrameControl";
function DrawEdge(hdc:pointer;var qrc:array of integer;edge:integer;grfFlags:integer):integer;;stdcall;external "User32.dll" name "DrawEdge"; function DrawEdge(hdc:pointer;var qrc:array of integer;edge:integer;grfFlags:integer):integer;;stdcall;external "User32.dll" name "DrawEdge";
function DrawFocusRect(hDC:pointer; var rect:array of integer):integer;stdcall;external "User32.dll" name "DrawFocusRect"; function DrawFocusRect(hDC:pointer; var rect:array of integer):integer;stdcall;external "User32.dll" name "DrawFocusRect";
Function FillRect(dc:pointer;rec:array of integer;br:pointer):integer;stdcall;external "User32.dll" name "FillRect"; Function FillRect(dc:pointer;rec:array of integer;br:pointer):integer;stdcall;external "User32.dll" name "FillRect";