diff --git a/TSLInterp.dll b/TSLInterp.dll index a1e826b..c540b88 100644 Binary files a/TSLInterp.dll and b/TSLInterp.dll differ diff --git a/designer/tediterform.tsf b/designer/tediterform.tsf index d138c6a..1a20542 100644 --- a/designer/tediterform.tsf +++ b/designer/tediterform.tsf @@ -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 diff --git a/designer/tslvcldesigner.tsf b/designer/tslvcldesigner.tsf index dd85b2b..d56e6e4 100644 --- a/designer/tslvcldesigner.tsf +++ b/designer/tslvcldesigner.tsf @@ -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":( diff --git a/designer/utslvcldebuger.tsf b/designer/utslvcldebuger.tsf index 033bb0d..281a817 100644 --- a/designer/utslvcldebuger.tsf +++ b/designer/utslvcldebuger.tsf @@ -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 fyr[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(); diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index c467e18..f8dbf5a 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/funcext/tvclib/tslvcl.tsf @@ -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 diff --git a/funcext/tvclib/twincontrol.tsf b/funcext/tvclib/twincontrol.tsf index 7e799da..acf94e0 100644 --- a/funcext/tvclib/twincontrol.tsf +++ b/funcext/tvclib/twincontrol.tsf @@ -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(); diff --git a/funcext/tvclib/ugtkinterface.tsf b/funcext/tvclib/ugtkinterface.tsf index 105bc21..16942a4 100644 --- a/funcext/tvclib/ugtkinterface.tsf +++ b/funcext/tvclib/ugtkinterface.tsf @@ -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. \ No newline at end of file diff --git a/funcext/tvclib/utslmemo.tsf b/funcext/tvclib/utslmemo.tsf index dfdc24f..f6ecac3 100644 --- a/funcext/tvclib/utslmemo.tsf +++ b/funcext/tvclib/utslmemo.tsf @@ -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 diff --git a/funcext/tvclib/utslvclaction.tsf b/funcext/tvclib/utslvclaction.tsf index c3e0ac5..6cfd729 100644 --- a/funcext/tvclib/utslvclaction.tsf +++ b/funcext/tvclib/utslvclaction.tsf @@ -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) {** diff --git a/funcext/tvclib/utslvclstdctl.tsf b/funcext/tvclib/utslvclstdctl.tsf index e8432b4..672ff51 100644 --- a/funcext/tvclib/utslvclstdctl.tsf +++ b/funcext/tvclib/utslvclstdctl.tsf @@ -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 xrec[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 diff --git a/tslkrnl.dll b/tslkrnl.dll index d2c51f0..ff8ef4f 100644 Binary files a/tslkrnl.dll and b/tslkrnl.dll differ