编辑器

优化
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

View File

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

View File

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

View File

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

View File

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

View File

@ -679,6 +679,7 @@ type idispatch=class(iunkown)
end
frgDispIds := array();
frgDispIds2 := array();
fglobalL := TS_GetGlobalL();
end
function GetTypeInfoCount(s:pointer;var pctinfo:integer):integer;stdcall;virtual;
begin
@ -706,11 +707,11 @@ type idispatch=class(iunkown)
fname := getdispidstr(dispIdMember);
for idx,p1 in pp do
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;
end
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;
end
function QueryInterface(s:pointer;riid:pointer;var ppv:pointer):integer;stdcall;virtual;
@ -732,6 +733,7 @@ type idispatch=class(iunkown)
private
frgDispIds;
frgDispIds2;
fglobalL;
function getdispid(s);
begin
id := frgDispIds[s];

View File

@ -2209,7 +2209,7 @@ type TcustomCanvas = class(TSLUIBASE)
begin
FFont.SetValues(f);
end else
FFont.copyfont(f);
FFont.copyfont(f);
end
function SetBrush(b);
begin
@ -2529,7 +2529,10 @@ type TcustomCanvas = class(TSLUIBASE)
@explan(说明)在指定区域上输出文本%%
@param(str)(string) 绘制的文字 %%
@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_VCENTER指定文本垂直居中显示。该标记只在单行文本输出时有效所以它必须与DT_SINGLELINE结合使用。
DT_SINGLELINE单行显示文本回车和换行符都不断行。

View File

@ -498,7 +498,7 @@ type twindowsapi = class()
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 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 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";