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

编辑器,界面库 

优化
This commit is contained in:
JianjunLiu 2022-08-05 18:23:40 +08:00
parent d833e12ca6
commit a5fa616a3e
11 changed files with 318 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
TSLInterp.dll
View File

Binary file not shown.

2
designer/tediterform.tsf
View File

@ -24,7 +24,7 @@ type TEditerForm = class(TVCform) //
end
function editerinfo();
begin
return "tsl语言本地编辑器\r\n版本:1.1.2\r\n日期:2022-03-22";
return "tsl语言本地编辑器\r\n版本:1.0.0\r\n日期:2022-07-19";
end
function Create(AOwner);override;
begin

10
designer/tslvcldesigner.tsf
View File

@ -1153,12 +1153,12 @@ type TVclDesigner = class(tvcform)
),
("type":"menu","caption":"运行","items":(
("type":"menu","caption":"配置命令行","onclick":thisfunction(editcommandline)),
{$ifdef linux}
("type":"menu","caption":"运行","onclick":thisfunction(RunProject),"filed":"FRounMenu","bitmap":getrunbmpinfo()),
("type":"menu","caption":"停止","onclick":thisfunction(StopProject),"enabled":false,"filed":"FStopMenu","bitmap":getstopbmpinfo()),
{$else}
//{$ifdef linux}
//("type":"menu","caption":"运行","onclick":thisfunction(RunProject),"filed":"FRounMenu","bitmap":getrunbmpinfo()),
//("type":"menu","caption":"停止","onclick":thisfunction(StopProject),"enabled":false,"filed":"FStopMenu","bitmap":getstopbmpinfo()),
//{$else}
("type":"menu","caption":"运行","bitmap":getrunbmpinfo(),"onclick":thisfunction( debugproject)), //之前的调试运行
{$endif}
//{$endif}
)),
("type":"menu","caption":"工具","items":(

45
designer/utslvcldebuger.tsf
View File

@ -60,11 +60,10 @@ type TFTSLScriptcustomMemo=class(TSYNmemoNorm)
{$endif}
function InvalidateLines(FirstLine,LastLine:integer);override;
begin
//return inherited;
if not HandleAllocated()then return;
if HighLighter is class(TTslSynHighLighter)then
begin
fy :=(FirstLine-TopLine) * TextHeight;
fy :=(FirstLine-TopLine) * LineHeight;
r := ClientRect;
if fy<r[1]then return;
if fy>r[3]then return;
@ -507,7 +506,7 @@ type TTslDebuga=class(TCustomControl)
function Debugremote(flg);
begin
{$ifdef linux}
return MessageboxA("linux目前不支持调试","提示",0,self.Handle);
//return MessageboxA("linux目前不支持调试","提示",0,self.Handle);
{$endif}
if FRemoteWait then
begin
@ -558,7 +557,7 @@ type TTslDebuga=class(TCustomControl)
function Debuglocal(item); //调试脚本
begin
{$ifdef linux}
return MessageboxA("linux目前不支持调试","提示",0,self.Handle);
//return MessageboxA("linux目前不支持调试","提示",0,self.Handle);
{$endif}
if not item then return 0;
if FConnectchannel then return MessageboxA("正在调试中","提示",0,self.Handle);
@ -579,7 +578,23 @@ type TTslDebuga=class(TCustomControl)
getdebuger(pms);
exestr := format('"%s" "%s" -DEBUGSERVER -DEBUGLOGIN 0 -WAITATTACH -DEBUGPORT %d -libpath "%s" ',FDebugExe,FRuningfile,FDebugport,dirs);
exestr += pms;
FDebughandle := sysexec(FDebugExe,exestr,nil,0,rcode,0);
{$ifdef linux}
//
sp := ioFileseparator();
for i:= length(FDebugExe) downto 1 do
begin
if FDebugExe[i] = sp then
begin
exepath := FDebugExe[1:i];
break;
end
end
npm := array("LD_LIBRARY_PATH=" $ exepath ,getgtkdisplay());
exestr := ParserCommandLine(exestr);
{$else }
npm := nil;
{$endif}
FDebughandle := sysexec(FDebugExe,exestr,npm,0,rcode,0);
if FDebughandle then
begin
ExecuteCommand("dbgcreatechannel");
@ -590,6 +605,7 @@ type TTslDebuga=class(TCustomControl)
end
end
end
function wmuser(o,e):WM_USER;virtual;
begin
if FRemoteWait and not(checkconnected())then
@ -693,7 +709,7 @@ type TTslDebuga=class(TCustomControl)
if(pid=dwProcessID)then
begin
// here h is the handle to the window
while(api.GetParent(h)<> 0) do h := api.GetParent(h);
while(api.GetParent(h)<> 0) do h := api.GetParent(h);
return h;
end
end
@ -877,7 +893,7 @@ type TTslDebuga=class(TCustomControl)
FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",stk[0,"LINE"]-1);
end
end
//_wapi.SetForegroundWindow(self.Handle); //移动到前端 SetForegroundWindow BringWindowToTop
_wapi.SetForegroundWindow(self.Handle); //移动到前端 SetForegroundWindow BringWindowToTop
return;
end
"detached":
@ -1091,7 +1107,9 @@ type TTslDebuga=class(TCustomControl)
begin
if FDebughandle then
begin
return SysTerminate(-1,FDebughandle);
//cd := {$ifdef linux} 1 {$else} -1 {$endif} ;
return SysTerminate(1,FDebughandle);
end
if FAttchedid then
begin
@ -1155,6 +1173,17 @@ type TTslDebuga=class(TCustomControl)
end
//property rundirect read Frundirect write Frundirect;
private
function getgtkdisplay();
begin
try
dsp := sys_getenv("DISPLAY");
if dsp="" then dsp := ":0";
if not ifstring(dsp) then dsp := ":0";
except
dsp := ":0";
end;
return "DISPLAY="+dsp;
end
function getdefaultdbger();
begin
fdefaultdbger := gettslexefullpath();

27
funcext/tvclib/tslvcl.tsf
View File

@ -509,6 +509,10 @@ type tapplication=class(tcomponent)
//_wapi.SetWindowPos(Fmainform.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE .|SWP_NOSIZE);
//Fmainform.Visible := true;//
Fmainform.show();
if Fmainform.HandleAllocated() then
begin
_wapi.SetForegroundWindow(Fmainform.handle);
end
end //Fmainform.Visible := true;
//else _wapi.SetWindowPos(Fmainform.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE .|SWP_NOSIZE);
end
@ -6942,6 +6946,16 @@ type TAction=class(TCustomAction)
return r;
end
end
type tactionlist =class(TCustomactionlist)
function create(AOwner);override;
begin
inherited;
end
function publishs();override;
begin
return array("name");
end
end
//*****************************
@ -9211,10 +9225,21 @@ type TCreateProcessA = class()
begin
envp[length(envp)] := "LD_LIBRARY_PATH=LD_LIBRARY_PATH:"+ph;
end
envp[length(envp)] := "DISPLAY=:0";
envp[length(envp)] := getgtkdisplay();
envp[length(envp)] :=nil;
return 1;
end
function getgtkdisplay();
begin
try
dsp := sys_getenv("DISPLAY");
if dsp="" then dsp := ":0";
if not ifstring(dsp) then dsp := ":0";
except
dsp := ":0";
end;
return "DISPLAY="+dsp;
end
type tprocesswnd = class(TCustomControl)
private

33
funcext/tvclib/twincontrol.tsf
View File

@ -548,6 +548,16 @@ type TWinControl = class(tcontrol)
inherited;
if HandleAllocated()then
begin
{
if v=SW_SHOWNOACTIVATE then
begin
_wapi.ShowWindow(FHandle,SW_SHOWNOACTIVATE);
end else
begin
_wapi.ShowWindow(FHandle,v?SW_SHOW:SW_HIDE);
end
if v=SW_SHOWNOACTIVATE then return ;
}
_wapi.ShowWindow(FHandle,v?SW_SHOW:SW_HIDE);
if(Parent is class(TWinControl))and parent.HandleAllocated()then
begin
@ -1577,13 +1587,14 @@ type TWinControl = class(tcontrol)
h := self.Handle;
if SW=SW_SHOW then return Visible := true;
if SW=SW_HIDE then return Visible := false;
//Visible := sw;
_wapi.ShowWindow(h,sw);
class(TControl).Visible := true;
end
function showmodal();virtual;
begin
return DoModal();
end
function showmodal();virtual;
begin
return DoModal();
end
function EndModal(endc);virtual;
begin
{**
@ -1712,10 +1723,24 @@ end
end
if ValidFlag then
begin
{$ifdef linux}
nrec := FPaintRects[0];
for i,v in FPaintRects do
begin
nrec := array(
min(nrec[0],v[0]),
min(nrec[1],v[1]),
max(nrec[2],v[2]),
max(nrec[3],v[3]),
);
end
_wapi.InvalidateRect(FHandle,nrec,f);
{$else}
for i,v in FPaintRects do
begin
_wapi.InvalidateRect(FHandle,v,f);
end
{$endif}
end
end
FPaintRects := array();

214
funcext/tvclib/ugtkinterface.tsf
View File

@ -100,7 +100,7 @@ type tsgtkapi = class(tgtkapis)
if f=0x4 then
begin
if not gtk_window_get_decorated(hwd) then
gtk_window_set_type_hint((hwd),3);
gtk_window_set_type_hint(hwd,3);
if cf and cf<>g_current_get_focus_widget then //设置一下focus
begin
tplev := gtk_widget_get_toplevel(cf);
@ -681,14 +681,23 @@ type tsgtkapi = class(tgtkapis)
begin
//return gtk_widget_queue_draw(h);
if ifarray(rec) and ifnumber(rec[0]) and ifnumber(rec[1]) and ifnumber(rec[2]) and ifnumber(rec[3]) then
begin
gtk_widget_queue_draw_area(h,rec[0],rec[1],rec[2]-rec[0],rec[3]-rec[1]);
begin
gtk_widget_queue_draw_area(h,rec[0],rec[1],rec[2]-rec[0],rec[3]-rec[1]);
{echo "\r\nvalidate rect:",hwnd,"====",h,tostn(array(rec[0],rec[1],rec[2]-rec[0],rec[3]-rec[1]));
r := zeros(4);
hd := gtk_widget_get_window(h);
if hd then
begin
cr := gdk_cairo_create(hd);
echo "rueturna:",gdk_cairo_get_clip_rectangle(cr,r);
echo "\r\ngetset:",tostn(r);
end }
end
else
begin
gtk_widget_queue_draw(h);
gtk_widget_queue_draw(h);
//echo "\r\nvalidate nil:",hwnd,"====",h;
end
end
end
@ -1344,10 +1353,11 @@ type tsgtkapi = class(tgtkapis)
begin
psc := new TPAINTSTRUCT(strc);
dc := g_object_get_data(hwd,"paint_dc");
h := g_object_get_data(hwd,"paint_height");
w := g_object_get_data(hwd,"paint_width");
//h := g_object_get_data(hwd,"paint_height");
//w := g_object_get_data(hwd,"paint_width");
rec := g_object_get_data(hwd,"paint_rect");
psc._setvalue_("hdc",dc);
psc._setvalue_("rcpaint",array(0,0,w,h));
psc._setvalue_("rcpaint",array(rec[0],rec[1],rec[0]+rec[2],rec[1]+rec[3])); //{array(0,0,w,h)}
return dc;
end
function EndPaint(hwd :pointer;strc:pointer):integer;
@ -1589,7 +1599,7 @@ type tsgtkapi = class(tgtkapis)
cairo_set_source_rgb(dc,135/255,135/255,135/255);
cairo_set_line_width(dc,5);
cairo_rectangle (dc, LPRECT[0]+x, LPRECT[1]+y, LPRECT[2]-LPRECT[0], LPRECT[3]-LPRECT[1]);
cairo_rectangle(dc, LPRECT[0]+x, LPRECT[1]+y, LPRECT[2]-LPRECT[0], LPRECT[3]-LPRECT[1]);
cairo_stroke_preserve(dc);
cairo_set_source_rgb(dc,1,1,1);
cairo_fill(dc);
@ -1599,7 +1609,7 @@ type tsgtkapi = class(tgtkapis)
cairo_set_source_rgb(dc,135/255,135/255,135/255);
cairo_set_line_width(dc,5);
cairo_rectangle (dc, LPRECT[0]+x, LPRECT[1]+y, LPRECT[2]-LPRECT[0], LPRECT[3]-LPRECT[1]);
cairo_rectangle(dc, LPRECT[0]+x, LPRECT[1]+y, LPRECT[2]-LPRECT[0], LPRECT[3]-LPRECT[1]);
cairo_stroke_preserve(dc);
cairo_set_source_rgb(dc,1,1,1);
cairo_fill(dc);
@ -1798,6 +1808,10 @@ type tsgtkapi = class(tgtkapis)
Function LoadImageA(hinst:pointer;lpszName:string; uType:integer; cxDesired:integer;cyDesired:integer;fuLoad:integer):pointer;
begin
end
function LoadIconA2(t,id);
begin
end
function LoadBitmapA(hin:pointer;lpsz:string):pointer;
begin
@ -2458,6 +2472,46 @@ type tsgtkapi = class(tgtkapis)
mt.tfree(pidl);
end
//caret 插入符号 处理
function drawcaret(h,xy,f);
begin
ct := g_object_get_data(h,"gtk_window_caret");
if f=1 then //清除
begin
if g_object_get_data(ct,"isshow") then return ;
end
//获得窗口
hwcr := g_object_get_data(h,"gtk_clientwideget");
hcr := gdk_cairo_create(gtk_widget_get_window(hwcr));
//echo "\r\n>>get:",cairo_get_operator(hcr);
//cairo_set_operator(hcr,11);
//echo ">>2get:",cairo_get_operator(hcr);
//cairo_set_source_rgb(hcr,0,0,0);
if f=-1 then
begin
if g_object_get_data(ct,"isshow") then
begin
g_object_set_data(ct,"isshow",0);
cairo_set_source_rgb(hcr,0,0,0);
end else
begin
g_object_set_data(ct,"isshow",true);
cairo_set_source_rgb(hcr,1,1,1);
end
end else
if f = 1 then
begin
g_object_set_data(ct,"isshow",true);
cairo_set_source_rgb(hcr,1,1,1);
end
cairo_set_line_width(hcr,max(2, g_object_get_data(ct,"width_c")));
cairo_move_to(hcr, xy[0], xy[1]);
cairo_line_to(hcr, xy[0], xy[1]+g_object_get_data(ct,"heigt_c"));
cairo_stroke(hcr);
//cairo_rectangle(hcr,xy[0],xy[1],5,20);
//cairo_fill(hcr);
cairo_destroy(hcr); //?
end
function CreateCaret(hWnd :pointer;hBitmap:pointer;nWidth:integer;nHeight:integer):integer;
begin
if not(hwnd>0 or hwnd<0) then return 0;
@ -2467,37 +2521,29 @@ type tsgtkapi = class(tgtkapis)
ctm := class(tUIglobalData).uigetdata("G_T_TTIMER_");
if not ctm then return 0;
g_gtk_caret_cache_timer := createobject(ctm,nil);
g_gtk_caret_cache_timer.Interval := 680;
g_gtk_caret_cache_timer.Interval := 500;//680;
g_gtk_caret_cache_timer.Ontimer := function(o,e)begin
global g_current_get_focus_widget;
global g_current_get_focus_widget;
h := g_current_get_focus_widget;
if not h then return ;
if not g_object_get_data(h,"caretshow") then return ;
ct := g_object_get_data(h,"gtk_window_caret");
//if not gtk_widget_is_visible(ct) then gtk_widget_show(ct);
//return ;
if gtk_widget_is_visible(ct) then gtk_widget_hide(ct);
else
gtk_widget_show(ct);
end
g_gtk_caret_cache_timer.start();
GetCaretPos(xy);
drawcaret(h,xy,-1);
end
g_gtk_caret_cache_timer.start();
end
h := g_object_get_data(hwnd,"gtk_window_caret"); //获得caret
if not h then
begin
h := gtk_event_box_new();
c := new _GdkColor(nil);
c.SetRgb(0,0,0);
gtk_widget_modify_bg(h,0,c._getptr_());
gtk_widget_hide(h);
lot := g_object_get_data(hWnd,"gtk_layout");
g_object_set_data(hwnd,"gtk_window_caret",h);
//g_object_set_data(h,"gtk_caret_window",hwnd); //ËùÊô´°¿Ú
gtk_layout_put(lot,h,0,0); //λÖÃ
end
if nWidth>=0 and nHeight>=0 then
gtk_widget_set_size_request(h,nWidth,nHeight);
//g_gtk_caret_cache_caret := h;
gtk_widget_hide(h);
g_object_set_data(hwnd,"gtk_window_caret",h);
if nWidth>=0 and nHeight>=0 then
begin
g_object_set_data(h,"width_c",nWidth);
g_object_set_data(h,"heigt_c",nHeight);
end
end
return h;
end
function DestroyCaret():integer;
@ -2508,10 +2554,6 @@ type tsgtkapi = class(tgtkapis)
if not IsGtkWidget(hwnd) then return ;
g_object_set_data(hwnd,"caretshow",0);
ct := g_object_get_data(hwnd,"gtk_window_caret");
if IsGtkWidget(ct) then
begin
gtk_widget_hide(ct);
end
return ;
// 获得focus
end
@ -2521,11 +2563,12 @@ type tsgtkapi = class(tgtkapis)
hwnd := g_current_get_focus_widget;
if IsGtkWidget(hwnd) then
begin
lot := g_object_get_data(hwnd,"gtk_layout");
crt := g_object_get_data( hwnd,"gtk_window_caret");
if lot and crt then
GetCaretPos(xy);
if xy[0]<>x then
drawcaret(hwnd,xy,1);
if crt then //处理此处
begin
gtk_layout_move(lot,crt,x,y);
gtk_object_set_data(hwnd,"caret_x_pos",x);
gtk_object_set_data(hwnd,"caret_y_pos",y);
end
@ -2542,6 +2585,7 @@ type tsgtkapi = class(tgtkapis)
x := gtk_object_get_data(hwnd,"caret_x_pos");
y := gtk_object_get_data(hwnd,"caret_y_pos");
lp := array(x,y);
return ;
end
lp := array(0,0);
return ;
@ -2553,10 +2597,6 @@ type tsgtkapi = class(tgtkapis)
if not IsGtkWidget(hwnd) then return ;
ct := g_object_get_data(hwnd,"gtk_window_caret");
g_object_set_data(hwnd,"caretshow",0);
if IsGtkWidget(ct) then
begin
gtk_widget_hide(ct);
end
return ;
end
function ShowCaret(hwnd :pointer):integer;
@ -3184,7 +3224,7 @@ type tgtkapis = class() //gtk
function gdk_screen_height():integer;cdecl;external 'libgtk-3.so';
function gdk_screen_width():integer;cdecl;external 'libgtk-3.so';
function gdk_event_get_event_type(e:pointer):integer;cdecl;external 'libgtk-3.so';
function gdk_cairo_get_clip_rectangle(cr:pointer;var rec:array of integer):integer;cdecl;external 'libgtk-3.so';
////////////////////////// start ////////////////////////////////////////
procedure gtk_init(argc:string;argcv:string);cdecl;external 'libgtk-3.so';
procedure gtk_main ();cdecl;external 'libgtk-3.so';
@ -3308,7 +3348,7 @@ type tgtkapis = class() //gtk
procedure cairo_set_fill_rule(c:pointer;rul:integer);cdecl;external 'libgtk-3.so';
procedure cairo_clip(c:pointer);cdecl;external 'libgtk-3.so';
procedure cairo_clip_preserve(c:pointer);cdecl;external 'libgtk-3.so';
procedure cairo_clip_extents(c:pointer;x1:double;y1:double;x2:double;y2:double);cdecl;external 'libgtk-3.so';
procedure cairo_clip_extents(c:pointer;var x1:double;var y1:double;var x2:double;var y2:double);cdecl;external 'libgtk-3.so';
function cairo_in_clip(c:pointer;x:double;y:double);cdecl;external 'libgtk-3.so';
procedure cairo_reset_clip(c:pointer);cdecl;external 'libgtk-3.so';
procedure cairo_stroke(c:pointer);cdecl;external 'libgtk-3.so';
@ -5865,37 +5905,45 @@ type tgtk_ctl_scroll_window = class(tgtk_ctl_object)
end
function scrollwindowdraw(a,b,c,d);
begin
hd := a.handle;
r := zeros(4);
r := zeros(4);
_wapi.gtk_widget_get_allocation(hd,r);
cr := _wapi.gdk_cairo_create(_wapi.gtk_widget_get_window(hd));
rec := zeros(4);
_wapi.gdk_cairo_get_clip_rectangle(cr,rec);
//echo ">>>1111",tostn(rec);
//echo ">>>extents:";
//_wapi.cairo_clip_extents(cr,x,y,w,h);
hwd := handle;
//echo "paintrect:",hd,tostn(rec);
_wapi.g_object_set_data(hwd,"paint_dc",cr);
_wapi.g_object_set_data(hwd,"paint_height",r[3]);
_wapi.g_object_set_data(hwd,"paint_width",r[2]);
_wapi.g_object_set_data(hwd,"paint_rect",rec);
//_wapi.g_object_set_data(hwd,"paint_height",r[3]);
//_wapi.g_object_set_data(hwd,"paint_width",r[2]);
//mtic;
CallTslVclProc(_const.WM_PAINT,0,0); //绘制
_wapi.cairo_set_dash(cr,array(4.0,0.0),2,0);
if not(self(true) is class(tgtk_ctl_window_PoPup)) then
begin
if (FExdwstyle .& _const.WS_EX_DLGMODALFRAME)= _const.WS_EX_DLGMODALFRAME then
begin
_wapi.cairo_set_source_rgb(cr, 225/255, 225/255, 225/255);
_wapi.cairo_set_line_width (cr, 2);
_wapi.cairo_rectangle(cr,0,0,r[2]-1,r[3]-1);
_wapi.cairo_stroke(cr);
end
if (Fdwstyle .& _const.WS_BORDER)= _const.WS_BORDER then
if (r[2]<=(rec[0]+rec[2])) or (r[3]<=(rec[1]+rec[3])) then
begin
_wapi.cairo_set_source_rgb(cr, 100/255, 100/255, 100/255);
_wapi.cairo_set_line_width(cr, 0.5);
_wapi.cairo_rectangle(cr,1,1,r[2]-1,r[3]-1);
_wapi.cairo_stroke(cr);
_wapi.cairo_set_dash(cr,array(4.0,0.0),2,0);
if (FExdwstyle .& _const.WS_EX_DLGMODALFRAME)= _const.WS_EX_DLGMODALFRAME then
begin
_wapi.cairo_set_source_rgb(cr, 225/255, 225/255, 225/255);
_wapi.cairo_set_line_width (cr, 2);
_wapi.cairo_rectangle(cr,0,0,r[2]-1,r[3]-1);
_wapi.cairo_stroke(cr);
end
if (Fdwstyle .& _const.WS_BORDER)= _const.WS_BORDER then
begin
_wapi.cairo_set_source_rgb(cr, 100/255, 100/255, 100/255);
_wapi.cairo_set_line_width(cr, 0.5);
_wapi.cairo_rectangle(cr,1,1,r[2]-1,r[3]-1);
_wapi.cairo_stroke(cr);
end
CallTslVclProc(_const.WM_NCPAINT,0,cr); //绘制
end
CallTslVclProc(_const.WM_NCPAINT,0,cr); //»æÖÆ
end
_wapi.cairo_destroy(cr);
_wapi.gtk_object_set_data(cr);
@ -6961,6 +7009,38 @@ type _gtkeventtype=class
GTK_RESPONSE_NONE := -1;
end
end
{ //cairo 常量
CAIRO_OPERATOR_CLEAR:=0;
CAIRO_OPERATOR_SOURCE:=1;
CAIRO_OPERATOR_OVER:=2;
CAIRO_OPERATOR_IN:=3;
CAIRO_OPERATOR_OUT:=4;
CAIRO_OPERATOR_ATOP:=5;
CAIRO_OPERATOR_DEST:=6;
CAIRO_OPERATOR_DEST_OVER:=7;
CAIRO_OPERATOR_DEST_IN:=8;
CAIRO_OPERATOR_DEST_OUT:=9;
CAIRO_OPERATOR_DEST_ATOP:=10;
CAIRO_OPERATOR_XOR:=11;
CAIRO_OPERATOR_ADD:=12;
CAIRO_OPERATOR_SATURATE:=13;
CAIRO_OPERATOR_MULTIPLY:=14;
CAIRO_OPERATOR_SCREEN:=15;
CAIRO_OPERATOR_OVERLAY:=16;
CAIRO_OPERATOR_DARKEN:=17;
CAIRO_OPERATOR_LIGHTEN:=18;
CAIRO_OPERATOR_COLOR_DODGE:=19;
CAIRO_OPERATOR_COLOR_BURN:=20;
CAIRO_OPERATOR_HARD_LIGHT:=21;
CAIRO_OPERATOR_SOFT_LIGHT:=22;
CAIRO_OPERATOR_DIFFERENCE:=23;
CAIRO_OPERATOR_EXCLUSION:=24;
CAIRO_OPERATOR_HSL_HUE:=25;
CAIRO_OPERATOR_HSL_SATURATION:=26;
CAIRO_OPERATOR_HSL_COLOR:=27;
CAIRO_OPERATOR_HSL_LUMINOSITY:=28;
}
function gtk_init_check(argc:string;argcv:string):integer;cdecl;external 'libgtk-3.so';
initialization
gtk_init_check(nil,nil);
end.

69
funcext/tvclib/utslmemo.tsf
View File

@ -1050,8 +1050,15 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
end
function ClearSelBlock();
begin
bg := BlockBegin;
ed := BlockEnd;
fBlockBegin := array(FCaretY,FCaretX);
fBlockEnd := array(FCaretY,FCaretX);
if (bg and ed) and bg<>ed then
begin
//InvalidateLines(bg[0],ed[0]);
InvalidateRect(nil,false);
end
end
function TrySetFoucs();
begin
@ -1088,6 +1095,8 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
begin
inherited;
if e.skip then return ;
IncPaintLock();
try
if e.Button() = mbLeft then
begin
if ssShift in e.Shiftstate() then
@ -1097,8 +1106,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
begin
ComputeCaret(e.xpos,e.ypos);
ClearSelBlock();
ClipCursor();
ClipCursor();
end
TrySetFoucs();
UpDateCaret();
@ -1108,6 +1116,9 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
begin
ComputeCaret(e.xpos,e.ypos);
end
finally
DecPaintLock();
end ;
end
function MouseMove(o,e);override;
@ -1494,7 +1505,11 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
begin
if not SelAvail then fBlockBegin := p1;
fBlockEnd := CaretXY;
InvalidateRect(nil,false);
InvalidateRect(nil,false); //20220729 修改刷新
{bg := GetBlockBegin();
ed := GetBlockEnd();
if ifarray(bg) and ifarray(ed) then
InvalidateLines(bg[0],ed[0]);}
end else
begin
if SelAvail then
@ -1952,32 +1967,62 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd)
fLastCaretY := fCaretY;
end
EnsureCursorPosVisible();
if docc then DoCaretPosChanged(); //之前在finally后
finally
DecPaintLock();
end;
if docc then DoCaretPosChanged();
end
end
function getcurrentselpos(pa,pb);
begin
pa := BlockBegin;
pb := BlockEnd;
end
function SetBlockBegin(p);
begin
if not(ifarray(p)and p[0]>0 and p[1]>0)then return;
np := p[0:1];
if np=fBlockBegin then return;
getcurrentselpos(bg,ed);
y := min(fLines.length(),p[0]);
x := Column2StrPos(y,p[1]);
fBlockBegin := array(y,x);
if fBlockBegin <> fBlockEnd then InvalidateRect(nil,false);
IncPaintLock();
if bg and ed and pg<>ed then
begin
InvalidateLines(bg[0],ed[0]);
end
getcurrentselpos(bg,ed);
if bg and ed and pg<>ed then
begin
InvalidateLines(bg[0],ed[0]);
end
DecPaintLock();
end
function SetBlockEnd(p);
begin
if not(ifarray(p)and p[0]>0 and p[1]>0)then return;
np := p[0:1];
if np=fBlockEnd then return;
getcurrentselpos(bg,ed);
y := min(fLines.length(),p[0]);
x := Column2StrPos(y,p[1]);
fBlockEnd := array(y,x);
if fBlockBegin <> fBlockEnd then InvalidateRect(nil,false);
IncPaintLock();
if bg and ed and pg<>ed then
begin
InvalidateLines(bg[0],ed[0]);
end
getcurrentselpos(bg,ed);
if bg and ed and pg<>ed then
begin
InvalidateLines(bg[0],ed[0]);
end
DecPaintLock();
//if fBlockBegin <> fBlockEnd then InvalidateRect(nil,false);
end
function ComputeCaret(X,Y:Integer);
begin
xy := PixelsToRowColumn(x,y);
@ -2484,7 +2529,11 @@ type TSynCompletion = class(TSynCompletionList)
function Create(AOwner);override;
begin
inherited;
{$ifdef linux} //处理避免闪烁
{$else}
WsPopUp := true;
{$endif}
FFilter := "";
FIgnoreCase := true;
visible := false;
@ -2573,7 +2622,11 @@ type TSynCompletion = class(TSynCompletionList)
dh := GetYscrollDelta();
h := 3+dh*min(self.ItemCount,8);
Memo.GetCaretPos(x,y);
xy := Memo.ClientToscreen(x,y);
{$ifdef linux}
xy := array(x,y);//
{$else}
xy := Memo.ClientToscreen(x,y);
{$endif }
if y+h>mh then
begin
begin
@ -2587,7 +2640,7 @@ type TSynCompletion = class(TSynCompletionList)
end
Show(SW_SHOWNOACTIVATE);
//Visible := true;
//Memo.SetFocus();
//Memo.SetFocus(); //setfocus
end
end
end

12
funcext/tvclib/utslvclaction.tsf
View File

@ -15,11 +15,11 @@ type TBasicAction=class(TComponent)
begin
if FParent <> p then
begin
if FParent is class(TActionList)then
if FParent is class(TCustomactionlist)then
begin
FParent.DeleteAction(self);
end
if p is class(TActionList)then
if p is class(TCustomactionlist)then
begin
p.AddAction(self);
end
@ -109,7 +109,7 @@ type TBasicAction=class(TComponent)
if Operation=opRemove and AComponent=FActionComponent then
begin
FActionComponent := nil;
if FParent is class(TActionList)then
if FParent is class(TCustomactionlist)then
begin
FParent.DeleteAction(self);
end
@ -280,7 +280,7 @@ type TCustomAction=class(TContainedAction)
return r;
end
end;
type TActionList=class(TComponent)
type TCustomactionlist=class(TComponent)
{**
@explan(˵Ã÷) actionlist %%
**}
@ -342,10 +342,6 @@ type TActionList=class(TComponent)
DeleteAllActions();
inherited;
end
function publishs();override;
begin
return array("name");
end
end
type TBasicActionLink=class(TSLUIBASE)
{**

9
funcext/tvclib/utslvclstdctl.tsf
View File

@ -745,7 +745,7 @@ type teditable=class(TSLUIBASE)
end
dc.drawtext(ns,rec,DT_VCENTER .| DT_SINGLELINE);
end else
dc.drawtext(s,rec,DT_VCENTER .| DT_SINGLELINE);
dc.drawtext(s,rec,DT_VCENTER .| DT_SINGLELINE .| DT_NOPREFIX);
end
end
public
@ -1116,6 +1116,10 @@ type teditable=class(TSLUIBASE)
if not(FHost and FHost.HandleAllocated())then return;
rec := GetEntryRect();
if not(pointinrect(e.pos,FClientRect))then return;
if FIsCaretShow and e.shiftdouble() then
begin
return selectall();
end
x := e.xpos;
if x<rec[2]and x>rec[0]then
begin
@ -3556,8 +3560,10 @@ type TcustomToolButton=class(tcomponent)
end
function ExecuteCommand(cmd,d);override;
begin
if cmd="doshortcut" then //shortcut
begin
if FStylesep then return ;
if csDesigning in ComponentState then return;
if Enabled and Visible then
begin
@ -3571,6 +3577,7 @@ type TcustomToolButton=class(tcomponent)
end
function DoOnClick(o,e);virtual;
begin
if FStylesep then return ;
if Parent then
begin
if FPopupMenu is class(TcustomPopupmenu) then

BIN
tslkrnl.dll
View File

Binary file not shown.