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

界面库 

采用马克instance替代 c函数回调
This commit is contained in:
JianjunLiu 2022-12-06 16:48:33 +08:00
parent 0bf9fdc972
commit 784d0b6a8a
10 changed files with 336 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
TSLInterp.dll
View File

Binary file not shown.

9
funcext/tvclib/lpseudointerface.tsl
View File

@ -10,7 +10,6 @@ interface
function getsenderdatabyid();
function gettslvariableptr(obj);
function getctypesize();
function getwinprocptr(f);
type aefclassobj_=class
{**
@nickname(内存管理对象) %%
@ -159,14 +158,6 @@ begin
@return(integer) 变量地址 %%
**}
end
function getwinprocptr(f);
begin
{**
@explan(说明) 获取winProc函数句柄 %%
@param(f)(integer|nil) 1表示DefWindowProcA ,0 表示timeproc nil表示twinproc %%
@return(integer) 消息函数句柄 %%
**}
end
function getctypesize();
begin
{**

46
funcext/tvclib/tslvcl.tsf
View File

@ -53,9 +53,8 @@ function CreateDirWithFileName(fname);
//************************
//*******************************
function MessageBoxA(txt,title,flag,hd);
function _timeproc_(hwnd,message,wparam,lparam);//win32消息分发
//function _timeproc_(hwnd,message,wparam,lparam);//win32消息分发
function _twinproc_(hwnd,message,wparam,lparam);//win32ÏûÏ¢·Ö·¢
function _MessgeHook_a(hwnd,message,wparam,lparam);
function remotetslcallback(data);
//********ÆäËû¸¨Öúº¯Êý*******
function TslToHexFormatStr(tsl);
@ -215,11 +214,7 @@ type tapplication=class(tcomponent)
**}
initialize();
{$ifdef linuxgtk}
idledata :=(new tcbytearray(4))._getptr_();
id := tsl_gtk_idle_interface(idledata);//_wapi.tsl_gtk_idle_interface(idledata); //构造idle
_wapi.gtk_main();
_Wapi.g_idle_remove_by_data(idledata); //删除idle
return 1;
return _wapi.gtk_mainidle();
{$endif}
if not FMessageObj then FMessageObj := new TTagMSG();
ptr := FMessageObj._getptr_;
@ -325,7 +320,7 @@ type TWinControlWraper=class(TWinControl)
FTop := rc[1];
FWidth := rc[2]-rc[0];
FHeight := rc[3]-rc[1];
old := _wapi.SetWindowLongPtrA(h,GWLP_WNDPROC,getwinprocptr());
old := _wapi.SetWindowLongPtrA(h,GWLP_WNDPROC,_wapi.getvclwindowprocA());
FDefWndproc := old;
class(tUIglobalData).uigetdata("TGlobalComponentcache").registerhandle(h,self(true));
Handle := h;
@ -6360,41 +6355,6 @@ begin
end
return r;
end
function _MessgeHook_a(hwnd,message,wparam,lparam);
begin
{**
@ignore(忽略)
@explan(说明) 文件夹对话框回调函数,系统调用%%
**}
{
// messages to browser
0x0400
#define BFFM_SETSTATUSTEXTA (WM_USER + 100)
#define BFFM_ENABLEOK (WM_USER + 101)
#define BFFM_SETSELECTIONA (WM_USER + 102)
#define BFFM_SETSELECTIONW (WM_USER + 103)
#define BFFM_SETSTATUSTEXTW (WM_USER + 104)
#define BFFM_SETOKTEXT (WM_USER + 105) // Unicode only
#define BFFM_SETEXPANDED (WM_USER + 106) // Unicode only
#define BFFM_INITIALIZED 1
#define BFFM_SELCHANGED 2
#define BFFM_VALIDATEFAILEDA 3 // lParam:szPath ret:1(cont),0(EndDialog)
#define BFFM_VALIDATEFAILEDW 4 // lParam:wzPath ret:1(cont),0(EndDialog)
#define BFFM_IUNKNOWN 5 // provides IUnknown to client. lParam: IUnknown*
}
//echo "\r\nhook",tostn(array(format("0x%x",hwnd),format("0x%x",message),format("0x%x",wparam),format("0x%x",lparam)));
if message=1 then
begin
gettswin32api().SendMessageA(hwnd,0x0400+102,TRUE,lparam);
end
return 0;
if message=0x110 then //如果为 WM_CREATE WM_NCCREATE 就注册
begin
s := array(format("0x%x",hwnd),format("0x%x",message),format("0x%x",wparam),format("0x%x",lparam));
d := new TtagOFNA(lparam);
end
end
//function GetModuleFileNameA(m:pointer;var buf:string;len:integer):integer;stdcall;external "Kernel32.dll" name "GetModuleFileNameA";
//function CallWindowProcA(lpPrevWndFunc:pointer;hWnd:pointer;Msg:integer;wParam:pointer;lParam:pointer):pointer;stdcall;external "User32.dll" name "CallWindowProcA";
//function RegisterClassExA(wc:pointer):short;stdcall;external "User32.dll" name "RegisterClassExA";

8
funcext/tvclib/twincontrol.tsf
View File

@ -327,7 +327,7 @@ type TWinControl = class(tcontrol)
{**
@explan(˵Ã÷)³õʼ»¯ %%
**}
if ifnil(FDefaultProc)then FDefaultProc := getwinprocptr(1);
if ifnil(FDefaultProc)then FDefaultProc := _wapi.getDefWindowProcA() ;
end
function SetBorder(v);override; //type_twinctrol
begin
@ -451,8 +451,8 @@ type TWinControl = class(tcontrol)
**}
classobj := p.winclass; //new tagWNDCLASSA();
subclass := p.subclass;
uiproc := getwinprocptr();
dfproc := getwinprocptr(1);
uiproc := _wapi.getvclwindowprocA();
dfproc := _wapi.getDefWindowProcA() ;
p.subclasswndproc := dfproc;
tclass := new tagWNDCLASSA();
classobj._setvalue_("lpszclassname",p.WinClassName);
@ -2457,7 +2457,7 @@ type TWinControl = class(tcontrol)
DestroyHandle();
if _wapi.IsWindow(h)then
begin
ph := _wapi.SetWindowLongPtrA(h,_wapi.GWLP_WNDPROC,getwinprocptr());
ph := _wapi.SetWindowLongPtrA(h,_wapi.GWLP_WNDPROC,_wapi.getvclwindowprocA());
FDefWndproc := ph;
MainWndProc(h,WM_NCCREATE,0,0);
end

115
funcext/tvclib/ugtkinterface.tsf
View File

@ -2929,6 +2929,14 @@ type tgtkapis = class() //gtk
begin
return class(tgtk_ctl_object).widgetsizechangeda(hwnd,h,w) ;
end
function getDefWindowProcA();
begin
return 0;
end
function getvclwindowprocA();
begin
return 0;
end
function gtk_GetScrollInfo(hwnd,nBar,lpsi); //¹ö¶¯ÌõÐÅÏ¢
begin
//»ñµÃscroll
@ -3269,6 +3277,21 @@ type tgtkapis = class() //gtk
////////////////////////// start ////////////////////////////////////////
procedure gtk_init(argc:string;argcv:string);cdecl;external 'libgtk-3.so';
procedure gtk_main ();cdecl;external 'libgtk-3.so';
function gtk_mainidle();
begin
idledata :=(new tcbytearray(4))._getptr_();
id := g_idle_add(gettslvcleventhandler_("tsl_gtk_idle"),idledata);
gtk_main();
g_idle_remove_by_data(idledata); //删除idle
return 1;
idledata :=(new tcbytearray(4))._getptr_();
id := tsl_gtk_idle_interface(idledata);//_wapi.tsl_gtk_idle_interface(idledata); //构造idle
_wapi.gtk_main();
_Wapi.g_idle_remove_by_data(idledata); //删除idle
return 1;
end
function g_idle_add(f:pointer;d:pointer):integer;cdecl;external 'libgtk-3.so';
procedure gtk_main_quit();cdecl;external 'libgtk-3.so';
@ -5563,7 +5586,7 @@ type tgtk_ctl_object = class(_gtkeventtype)
eid := GetGtkEventNameOrId(ln);
fn := (getsignalmap())[ln];
if not(fn and ifstring(fn)) then fn := "tsl_gtk_normal_event_cb";
lnid := g_signal_connect_data(FHandle, ln, gettslvcleventhandler(fn), eid,nil,0);
lnid := g_signal_connect_data(FHandle, ln, gettslvcleventhandler_(fn), eid,nil,0);
FConnectNameIds[ln] := lnid;
FConnectHandlers[inttostr(eid)] := f;
return lnid;
@ -6901,7 +6924,7 @@ begin
if not ifarray(G_GTK_WINDOW_CLASSINFO) then
begin
G_GTK_WINDOW_CLASSINFO := array();
fp := getwinprocptr();
fp := 0;//getwinprocptr();
cls := array(array("cbsize":80,"style":43,"lpfnwndproc":fp,"cbclsextra":0,"cbwndextra":0,"hinstance":0,"hicon":0L,"hcursor":0L,"hbrbackground":0L,"lpszmenuname":0L,"lpszclassname":"tsui_application","hiconsm":0L)
,array("cbsize":80,"style":43,"lpfnwndproc":fp,"cbclsextra":0,"cbwndextra":0,"hinstance":0,"hicon":0L,"hcursor":0L,"hbrbackground":0L,"lpszmenuname":0L,"lpszclassname":"tsui_window","hiconsm":0L)
,array("cbsize":80,"style":43,"lpfnwndproc":fp,"cbclsextra":0,"cbwndextra":0,"hinstance":0,"hicon":0L,"hcursor":0L,"hbrbackground":0L,"lpszmenuname":0L,"lpszclassname":"tui_panel","hiconsm":0L)
@ -7135,13 +7158,99 @@ CAIRO_OPERATOR_HSL_LUMINOSITY:=28;
function gtk_init_check(argc:string;argcv:string):integer;cdecl;external 'libgtk-3.so';
function igtk();
begin
global g_w_i_datas,g_w_c_width, g_gtk_buttontable,g_gtk_keytable;
global g_w_i_datas,g_w_c_width, g_gtk_buttontable,g_gtk_keytable,g_gtk_call_handler_manager;
gtk_init_check(nil,nil);
g_w_i_datas := array();
g_w_c_width := 35;
g_gtk_buttontable := array(0,0);
g_gtk_keytable := array(0x10:0,0x11:0,0x12:0);
g_gtk_call_handler_manager := new tinstancemanager();
end
function ugtk();
begin
global g_gtk_call_handler_manager;
g_gtk_call_handler_manager := nil;
end
function gettslvcleventhandler_(fname:string):pointer;
begin
global g_gtk_call_handler_manager;
if not g_gtk_call_handler_manager then return 0;
mgnr := g_gtk_call_handler_manager;
case fname of
"tsl_gtk_wmuser_event": return mgnr.get(thisfunction(tsl_gtk_wmuser_event));
"tsl_gtk_destroy_event": return mgnr.get(thisfunction(tsl_gtk_destroy_event));
"tsl_gtk_activate_event": return mgnr.get(thisfunction(tsl_gtk_activate_event));
"tsl_gtk_clicked_event": return mgnr.get(thisfunction(tsl_gtk_clicked_event));
"tsl_gtk_adj_value_changed_event": return mgnr.get(thisfunction(tsl_gtk_adj_value_changed_event));
"tsl_gtk_delete_event": return mgnr.get(thisfunction(tsl_gtk_delete_event));
"tsl_gtk_day_select_event": return mgnr.get(thisfunction(tsl_gtk_day_select_event));
"tsl_gtk_changed_event": return mgnr.get(thisfunction(tsl_gtk_changed_event));
"tsl_gtk_preedit_changed_event": return mgnr.get(thisfunction(tsl_gtk_preedit_changed_event));
"dodeleteevents": return mgnr.get(thisfunction(dodeleteevents));
"tsl_gtk_normal_event_cb": return mgnr.get(thisfunction(tsl_gtk_normal_event_cb));
"tsl_gtk_normal_event_bc": return mgnr.get(thisfunction(tsl_gtk_normal_event_bc));
"tsl_gtk_idle":return mgnr.get(thisfunction(tsl_gtk_idle));
end ;
end
function tsl_gtk_idle(dlg:pointer):integer;
begin
return _gtkidledo_(dlg);
end
function tsl_gtk_normal_event_bc(a:pointer;b:pointer;c:pointer):integer;
begin
return _gtkeventcall_(a,b,c);
end
function tsl_gtk_normal_event_cb(a:pointer;b:pointer;c:pointer):integer;
begin
return _gtkeventcall_(a,c,b);
//获得消息处理函数的指针
end
function tsl_gtk_preedit_changed_event(a:pointer;b:pointer;c:pointer):integer;
begin
return dotparamseevents(a, "preedit-changed", b, c);
end
function tsl_gtk_changed_event(a:pointer;b:pointer):integer;
begin
return dodeleteevents(a, "changed");
end
function tsl_gtk_day_select_event(a:pointer;b:pointer):integer;
begin
return dodeleteevents(a, "day-selected");
end
function tsl_gtk_delete_event(a:pointer;b:pointer):integer;
begin
return dodeleteevents(a, "delete-event");
end
function tsl_gtk_adj_value_changed_event(a:pointer;b:pointer):integer;
begin
return dodeleteevents(a, "value-changed");
end
function tsl_gtk_clicked_event(a:pointer;b:pointer):integer;
begin
return dodeleteevents(a, "clicked");
end
function tsl_gtk_activate_event(a:pointer;b:pointer):integer;
begin
return dodeleteevents(a, "activate");
end
function tsl_gtk_destroy_event(a:pointer; b:pointer;c:pointer):integer;
begin
return _gtkeventcall_(a,b,c);
end
function tsl_gtk_wmuser_event(a:pointer; p1:pointer;p2:pointer):integer;
begin
return dotparamseevents(a, "wm-user", p1, p2);
end
function dodeleteevents( a:pointer;b:string):integer;
begin
return _gtkeventcall_(a,GetGtkEventNameOrId(b),0);
end
function dotparamseevents(a:pointer; b:string;p1:pointer;p2:pointer):pointer;
begin
return _gtkeventcall_(a,GetGtkEventNameOrId(b),p1,p2);
end
initialization
igtk();
finalization
ugtk();
end.

52
funcext/tvclib/utslvclauxiliary.tsf
View File

@ -2188,6 +2188,58 @@ type tcountlocker = class() //
private
fkernel;
end
type tinstancemanager = class()
{**
@explan(说明)函数c语言指针管理器 %%
**}
function create();
begin
fhandles := array();
end
function destroy();
begin
for i,v in fhandles do
begin
deleteinstance(v);
end
fhandles := array();
end
function get(f); //获得
begin
{**
@explan(说明)通过函数句柄获取c回调指针 %%
@param(f)(handler) tsl函数对象 %%
@return(pointer) c函数回调 %%
**}
id := integer(f);
r := fhandles[id];
if r then return r;
r := makeinstance(f);
if r then
begin
fhandles[id] := r;
return r;
end
end
function del(f);
begin
{**
@explan(说明)通过函数句柄删除c回调指针 %%
@param(f)(handler) tsl函数对象 %%
@return(bool) 是否成功 %%
**}
id := integer(f);
h := fhandles[id];
if h then
begin
r := deleteinstance(h);
reindex(fhandles,array(id:nil));
return r;
end
end
private
fhandles;
end
implementation
function includestate(u,s);
begin

61
funcext/tvclib/utslvcldlg.tsf
View File

@ -292,7 +292,7 @@ type tcustomfolderdlg=class(TCommDlg)
if FDefaultDirstr then
begin
FBrowse.lparam := FDefaultDir.ptr;
FBrowse.lpfn := getwinprocptr(0x11);
FBrowse.lpfn := getdlgcall(0x11);
end
ft := _wapi.SHBrowseForFolderA(FBrowse._getptr_);
if not ft then return 0;
@ -1376,5 +1376,64 @@ begin
**}
return(a and not(b))or(b and not(a));
end
function SendMessageA(hWnd:pointer;Msg:integer;wParam:pointer;lParam:pointer):pointer;stdcall;external "User32.dll" name "SendMessageA";
function folderdlgcall(hwnd:pointer;message:integer;wparam:pointer;lparam:pointer):pointer;stdcall;
begin
{**
@ignore(忽略)
@explan(说明) 文件夹对话框回调函数,系统调用%%
**}
{
// messages to browser
0x0400
#define BFFM_SETSTATUSTEXTA (WM_USER + 100)
#define BFFM_ENABLEOK (WM_USER + 101)
#define BFFM_SETSELECTIONA (WM_USER + 102)
#define BFFM_SETSELECTIONW (WM_USER + 103)
#define BFFM_SETSTATUSTEXTW (WM_USER + 104)
#define BFFM_SETOKTEXT (WM_USER + 105) // Unicode only
#define BFFM_SETEXPANDED (WM_USER + 106) // Unicode only
#define BFFM_INITIALIZED 1
#define BFFM_SELCHANGED 2
#define BFFM_VALIDATEFAILEDA 3 // lParam:szPath ret:1(cont),0(EndDialog)
#define BFFM_VALIDATEFAILEDW 4 // lParam:wzPath ret:1(cont),0(EndDialog)
#define BFFM_IUNKNOWN 5 // provides IUnknown to client. lParam: IUnknown*
}
//echo "\r\nhook",tostn(array(format("0x%x",hwnd),format("0x%x",message),format("0x%x",wparam),format("0x%x",lparam)));
if message=1 then
begin
SendMessageA(hwnd,0x0400+102,TRUE,lparam);
end
return 0;
if message=0x110 then //如果为 WM_CREATE WM_NCCREATE 就注册
begin
//s := array(format("0x%x",hwnd),format("0x%x",message),format("0x%x",wparam),format("0x%x",lparam));
//d := new TtagOFNA(lparam);
end
end
function getdlgcall();
begin
{$ifdef linux}
return 0;
{$endif}
global g_dlg_call_back;
if not g_dlg_call_back then
begin
g_dlg_call_back := makeinstance(thisfunction(folderdlgcall));
end
return g_dlg_call_back;
end
function uninit();
begin
global g_dlg_call_back;
if g_dlg_call_back then
begin
deleteinstance(g_dlg_call_back);
g_dlg_call_back := nil;
end
end
initialization
finalization
uninit();
end.

58
funcext/tvclib/utslvclstdctl.tsf
View File

@ -238,7 +238,7 @@ type TCustomTimer = class(tcomponent)//
**}
if not((datatype(FOntimer) = 7 )and FInterval)>0 then return -1;
if FStart then return FStart;
ret := _wapi.SetTimer(nil,Fid,FInterval,getwinprocptr(2));
ret := _wapi.SetTimer(nil,Fid,FInterval,gettimerptr(2));
_kill0 := ret;
Ssettimer(self(true));
FStart := ret <> 0;
@ -7001,15 +7001,67 @@ type tedolist = class()
flockct; //¼ÆÊý
flist; //Á´±í
end
{$ifdef linux}
type _timerstruct = class(tslcstructureobj)
uses cstructurelib;
private
static SSTRUCT;
class function getstruct()
begin
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(
array(
("id","intptr",0),
("flg","intptr",0)
),nil,nil,4);
return SSTRUCT;
end
public
function create(ptr)
begin
inherited create(getstruct(),ptr);
end
end
function uitimerproc( p:pointer):integer;
begin
op := new _timerstruct(p);
unit(ugtkinterface)._gtk_add_time_msg_(0,op._getvalue_("flg"),op._getvalue_("id"),0x113);
return true;
end
{$else}
function uitimerproc(hwnd:pointer;message:integer;wparam:pointer;lparam:pointer):pointer;stdcall;
begin
return class(TCustomTimer)._timeproc_(hwnd,message,wparam,lparam);
end
{$endif}
function gettimerptr();
begin
global g_timer_proc;
if not g_timer_proc then
begin
g_timer_proc := makeinstance(thisfunction(uitimerproc));
end
return g_timer_proc;
end
function uinit();
begin
{$ifdef linux}
class(tUIglobalData).uisetdata("G_T_TTIMER_",class(TCustomTimer));
//o := new TSLUIBASE();
//o._wapi.SetTimer(nil,10000,200,getwinprocptr(2));
{$endif}
end
function unuinit();
begin
global g_timer_proc;
if g_timer_proc then
begin
deleteinstance(g_timer_proc);
g_timer_proc := nil;
end
end
initialization
uinit();
finalization
unuinit();
end.

56
funcext/tvclib/uwindowsinterface.tsf
View File

@ -4,8 +4,11 @@ interface
@explan(说明) windows平台相关接口 %%
@date(20220509) %%
**}
uses cstructurelib;
uses cstructurelib,utslvclauxiliary;
type twindowsapi = class
private
static fdefaultwinprochandle;
public
function openresourcemanager(p); //打开资源管理器
begin
if ifstring(p) then
@ -95,6 +98,26 @@ type twindowsapi = class
function GetDpiForMonitor(hmonitor:pointer; dpiType:integer;var dpiX:integer;var dpiY:integer):pointer;stdcall;external "Shcore.dll" name "GetDpiForMonitor";
//Kernel32.dll
//进程和内存相关
function LoadLibraryA(txt:string):POINTER;stdcall;external "Kernel32.dll" name "LoadLibraryA";
function FreeLibrary(hd:pointer):integer;stdcall;external "Kernel32.dll" name "FreeLibrary";
function GetProcAddress(h:pointer;n:string):pointer;stdcall;external "Kernel32.dll" name "GetProcAddress";
function getDefWindowProcA();
begin
if not fdefaultwinprochandle then
begin
h := LoadLibraryA("User32.dll");
if h then
begin
fdefaultwinprochandle := GetProcAddress(h,"DefWindowProcA");
end
end
return fdefaultwinprochandle;
end
function getvclwindowprocA();
begin
global g_windows_proc_handle;
return g_windows_proc_handle;
end
class function SetTimer(hWnd:pointer; nIDEvent:pointer; uElapse:integer;lpTimerFunc:pointer):integer;stdcall;external "User32.dll" name "SetTimer";
class function KillTimer(hWnd:pointer; nIDEvent:pointer):integer;stdcall;external "User32.dll" name "KillTimer";
@ -596,13 +619,34 @@ type twindowsapi = class
function ioctlsocket(s:pointer;cmd:integer;var argp:integer):integer;stdcall;external "Ws2_32.dll" name "ioctlsocket";
function setsockopt(s:pointer;level:integer;optname:integer;optval:string;optlen:integer):integer;stdcall;external "Ws2_32.dll" name "setsockopt";
function getsockopt(s:pointer;level:integer;optname:integer;var optval:string;var optlen:integer):integer;stdcall;external "Ws2_32.dll" name "getsockopt";
end
implementation
function tslvclproc(hwnd:pointer;message:integer;wparam:pointer;lparam:pointer):pointer;stdcall; //»Øµ÷
begin
gfw := class(tUIglobalData).uigetdata("G_F_TWIN_PROC_");
if gfw then
return call(gfw,hWnd,message,wparam,lparam);
return 0;
end
function init(); //¼ÓÔØ
begin
global g_windows_proc_handle;//
if not g_windows_proc_handle then
begin
g_windows_proc_handle := makeinstance(thisfunction(tslvclproc));
end
end
function uninit();//жÔØ
begin
global g_windows_proc_handle;
if g_windows_proc_handle then
begin
deleteinstance(g_windows_proc_handle);
g_windows_proc_handle := nil;
end
end
initialization
init();
finalization
uninit();
end.

BIN
plugin/TSLCPLUGIN.DLL
View File

Binary file not shown.