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

界面库 

优化代码
This commit is contained in:
JianjunLiu 2022-04-22 15:27:57 +08:00
parent f6c6342cef
commit 517a052205
4 changed files with 387 additions and 418 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
funcext/tvclib/tgdiplusflat.tsf
View File

@ -314,7 +314,11 @@ type TGdiplusflat=class
class function GlobalSize(menm:pointer):integer;stdcall;external "Kernel32.dll" name "GlobalSize";
class function memcpy(dst:pointer;src:string;size_t:integer):pointer;cdecl;external "msvcrt.dll" name "memcpy";
class function memcpy2(var dst:string;src:pointer;size_t:integer):pointer;cdecl;external "msvcrt.dll" name "memcpy";
class function tuicloseistream(sm:pointer):integer;cdecl;external "TSLUIL.dll" name "tuicloseistream";
class function tuicloseistream(sm:pointer);
begin
r := tslvclcloseistream(sm);
return r;
end
class function GlobalAlloc(uFlags :integer;dwBytes:integer):pointer;stdcall;external "Kernel32.dll" name "GlobalAlloc";
class Function GdipCreatePath(brushMode:integer;var path:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreatePath";

792
funcext/tvclib/tslvcl.tsf
View File

@ -954,7 +954,6 @@ end
end
end
class function MultiByteToWideChar_a(CodePage:integer;dwFlags:integer;lpMultiByteStr:string;cbMultiByte:integer;var lpWideCharStr:string;cchWideChar:integer):integer;
class function tuicloseistream(sm:pointer):integer;
class function GetEncoderClsid(n:String;ed:pointer):integer;
begin
WriteStringToPtr(ed,n); //保存
@ -2770,7 +2769,7 @@ end
gtk_widget_destroy(cdlg);
return r=-5;
end
function tsl_gtk_color_selection_property(w:pointer):pointer;cdecl;external "./plugin/libTSLUIL.so";
type TBrowseinfoA_ = class(tslcstructureobj)
{**
@explan(说明)文件夹选择结构 %%
@ -3066,8 +3065,11 @@ end
MultiByteToWideChar_a(0, 0, c , -1, pwszUnicode , iSize-1);
return pwszUnicode;
end
class function GetEncoderClsid(n:String;ed:pointer):integer;cdecl;external "TSLUIL.dll" name "GetEncoderClsid";
class function tuicloseistream(sm:pointer):integer;cdecl;external "TSLUIL.dll" name "tuicloseistream";
class function GetEncoderClsid(n:String;ed:pointer);
begin
r := tslvclgetencoderclsid(n,ed);
return r;
end;
//***********
function GetDpiForMonitor(hmonitor:pointer; dpiType:integer;var dpiX:integer;var dpiY:integer):pointer;stdcall;external "Shcore.dll" name "GetDpiForMonitor";
//Kernel32.dll
@ -25745,16 +25747,6 @@ type TImage=class(TSLUIBASE)
vp := GetFileType(t);
s := gdi.imagetostring(FHandle,vp);
return s;
/////////////////
st := ImageToStream(t);
_wapi.GetHGlobalFromStream(st,memo);
len := _wapi.GlobalSize(memo);
s := "";
lm := _wapi.GlobalLock(memo);
setlength(s,len);
_wapi.memcpy2(s,lm,len);
_wapi.tuicloseistream(st);
return s;
end
function StringToImage(b);
begin
@ -25771,24 +25763,6 @@ type TImage=class(TSLUIBASE)
FHandle := hd;
end
return r;
////////////////////////////////////
len := length(b);
hm := _wapi.GlobalAlloc(2,len+1); //分配内容
lm := _wapi.GlobalLock(hm); //枷锁
if lm <> 0 then
begin
_wapi.memcpy(lm,b,len); //内存拷贝
_wapi.GlobalUnlock(hm); //解锁
end
_wapi.CreateStreamOnHGlobal(hm,true,st);
r := gdi.GdipLoadImageFromStream(st,hd);
if hd then
begin
DestroyHandle();
FHandle := hd;
end
_wapi.tuicloseistream(st);
return r;
end
function ToHbitmap();
begin
@ -28221,7 +28195,8 @@ type TBasicAction=class(TComponent)
begin
if FOnExecute then
begin
calldatafunction(FOnExecute,self);
e := new tuieventbase(0,0,0,0);
calldatafunction(FOnExecute,self(true),e);
return true;
end
return false;
@ -31809,388 +31784,377 @@ type TArrayTreeClass = class
FSubName := sub;
end
end
function create(v);
begin
{**
@explan(说明) 构造节点 %%
**}
FId := v[FIdName];
FValue := v;
FComponents := array();
end
function addcomponent(o);
begin
{**
@explan(说明) 添加节点 %%
**}
len := length(FComponents);
for i := 0 to len-1 do if o=FComponents[i]then exit;
FComponents[len]:= o;
end
function Recycle();
begin
{**
@explan(说明) 出现死循环的时候的处理 %%
**}
if FRecyce then return;
FRecyce := true;
for i,v in FComponents do
begin
v.Recycle();
end
FComponents := array();
end
function toarray();
begin
{**
@explan(说明) 转换为array %%
**}
if FInToArray=FSInToArray then
begin
Recycle();
raise "节点关系出现循环";
end
FInToArray := FSInToArray;
ret := array();
sub := array();
for i := 0 to length(FComponents)-1 do
begin
ret[FSubName,i]:= FComponents[i].toarray();
end
for i,v in FValue do
begin
if i=FSubName then continue;
ret[i]:= v;
end
return ret;
end
class function SetColumnName(info);
begin
if not ifarray(info)then info := array("id":"id","pid":"pid","sub":"sub");
if not ClumnNameOk(info["id"])then info["id"]:= "id";
if not ClumnNameOk(info["pid"])then info["pid"]:= "pid";
if not ClumnNameOk(info["sub"])then info["sub"]:= "sub";
SetIdName(info["id"],info["pid"],info["sub"]);
end
class function ToTree(d,info);
begin
{**
@explan(说明) 二维表转换为树结构 %%
@param(d)(array) 数据包含 信息 %%
@param(info)(array) 字段信息 "id" 当前节点的字段,"pid" 当前节点的父节点字段,"sub" ,返回子节点的字段
默认值 array("id":"id","pid":"pid","sub":"sub"); %%
@return(TArrayTreeClass)
**}
SetColumnName(info);
root := new TArrayTreeClass(array(FIdName:nil,FPIdName:nil));
oarray := array();
oarray[-inf]:= root;
for i,v in d do //构建id
begin
id := v[FIdName];
ido := oarray[id];
if ifnil(ido)then
begin
ido := new TArrayTreeClass(v);
oarray[id]:= ido;
end
end
ifcycle := true;
for i,v in d do
begin
id := v[FIdName];
ido := oarray[id];
pid := v[FPIdName];
pdo := oarray[pid];
if not pdo then
begin
pdo := oarray[-inf];
ifcycle := false;
end
pdo.addcomponent(ido);
end
if ifcycle and oarray then
begin
for i,v in oarray do
begin
v.Recycle();
raise "节点关系出现循环";
break;
end
end
return root;
end
class function CreateRow(d,id,r);
begin
for i,v in d do
begin
ri := array();
if not v then continue;
ri[FIdName]:= GetCounter();
ri[FPIdName]:= id;
for j,vi in v do
begin
if j=FSubName then
begin
call(thisfunction,vi,ri[FIdName],r);
end
{else if j=FIdName or j = FPIdName then
begin
end}else
begin
ri[j]:= vi;
end
end
if ri then
begin
r[length(r)]:= ri;
end
end
end
class function TreeArrayToArray(d,info);
begin
{**
@explan(说明) 树结构转换为二维表 %%
@param(d)(array) 数据包含 信息 %%
@param(info)(array) 字段信息 "id" 当前节点的字段,"pid" 当前节点的父节点字段,"sub" ,返回子节点的字段
默认值 array("id":"id","pid":"pid","sub":"sub"); %%
@return(array)
**}
if not ifarray(d)then exit;
SetColumnName(info);
r := array();
initconter();
CreateRow(d,GetCounter(),r);
return r;
end
class function ToTreeArray(d,info);
begin
{**
@explan(说明) 二维表转换为树结构 %%
@param(d)(array) 数据包含 信息 %%
@param(info)(array) 字段信息 "id" 当前节点的字段,"pid" 当前节点的父节点字段,"sub" ,返回子节点的字段
默认值 array("id":"id","pid":"pid","sub":"sub"); %%
@return(array) 树形结构的array
**}
root := ToTree(d,info);
if not root then return;
FSInToArray := tostn(now());
r :=(root.toarray());
return r;
end
end
type TIniFileExta=class()
{**
@explan(说明) ini文件读写封装 %%
**}
private
FTStringa;
Fini;
FVtype;
FLowerKey;
FLowerValue;
function CheckSK(s,k);
begin
return ifstring(s) and s and ifstring(k) and k;
end
function ChangeV(V);
begin
vv := v;
case Vtype of
1:vv := vv="0"?false:true;
2:vv := StrToIntDef(vv,0);
else
begin
if FLowerValue then vv := lowercase(vv);
end
end
return vv;
end
function STNVA();
begin
{**
@explan(说明) 转换为name,value 列的二维数组 %%
**}
r := array();
for i := 0 to FTStringa.Count-1 do
begin
n := FTStringa.Names(i);
if n then
begin
if FLowerKey then n := lowercase(n);
vv := FTStringa.Values(n);
r[length(r)]:= array("name":n,"value":ChangeV(vv));
end
end
FTStringa.Clear();
return r;
end
function STNV();
begin
{**
@explan(说明) 转换为name:value 一维数组 %%
**}
nr := STNVA();
r := array();
for i,v in nr do
begin
r[v["name"]]:= v["value"];
end
return r;
end
function STA();
begin
{**
@explan(说明) 转换为一维数组 %%
**}
r := array();
for i := 0 to FTStringa.Count-1 do
begin
vi := FTStringa.Strings(i);
r[i]:= FLowerKey?lowercase(vi):vi;
end
FTStringa.Clear();
return r;
end
public
function create(al,Fname);override;
begin
{**
@explan(说明) 构造函数 %%
@param(al)(string) 别名 %%
@param(name)(string) 文件名 %%
**}
if ifstring(al)and ifstring(Fname)then
begin
FIni := new TIniFile(al,Fname);
FTStringa := new TStringlist();
end else
raise "ini对象读写构造参数错误";
end
function readSection(sn);virtual;
begin
{**
@explan(说明) 读取section 下面key %%
**}
if ifstring(sn)and sn then Fini.readSection(sn,FTStringa);
return STA();
end
function ReadSections();virtual;
begin
{**
@explan(说明) 读取所有section名字 %%
**}
FIni.ReadSections(FTStringa);
return STA();
end
function ReadSectionValues(sn);virtual;
begin
{**
@explan(说明) 读取section下面的所有key:value %%
**}
if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa);
return STNV();
end
function RenameSection(sn1,sn2);virtual;
begin
{**
@explan(说明) 重命名section %%
@param(sn1)(string) 旧名字 %%
@param(sn2)(string) 新名字 %%
**}
if not(sn1 and sn2 and ifstring(sn1))and ifstring(sn2)then exit;
vs1 := ReadSectionValues(sn1);
EraseSection(sn1);
for i,v in vs1 do
begin
WriteKey(sn2,i,v);
end
end
function RenameKey(sec,k1,k2);virtual;
begin
{**
@explan(说明) 重命名key %%
@param(sec)(string) section名称 %%
@param(k1)(string) 旧名字 %%
@param(k2)(string) 新名字 %%
**}
if(sec and k2 and k1 and ifstring(sec)and ifstring(k1)and ifstring(k2))then exit;
v := ReadKey(sec,k1);
DeleteKey(sec,k1);
WriteKey(sec,k2,v);
end
function ReadSectionValues2(sn);
begin
{**
@explan(说明) 获得section 数据,二维表,name,value 列
**}
if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa);
return STNVA();
end
function ReadSectionValues3(sn);
begin
{**
@explan(说明) 获得section 数据,二维表,0列为key,1列为value
**}
d := ReadSectionValues2(sn);
r := array();
for i,v in d do
begin
r[length(r)]:= array(v["name"],v["value"]);
end
return r;
end
function ReadKey(sn,key,def);virtual;
begin
{**
@explan(说明) 读取key %%
**}
if CheckSK(sn,key)then return FIni.ReadString(sn,key,ifstring(def)?def:"");
return nil;
end
function WriteKey(sn,key,v);virtual;
begin
{**
@explan(说明) 写入key %%
**}
if ifnil(v)then v := "";
if CheckSK(sn,key)then return FIni.WriteString(sn,key,ifstring(v)?v:tostn(v));
return 0;
end
function DeleteKey(sn,key);virtual;
begin
if CheckSK(sn,key)then return FIni.DeleteKey(sn,key);
end
function EraseSection(sn);virtual;
begin
{**
@explan(说明)删除section %%
**}
if ifstring(sn)and sn then return FIni.EraseSection(sn);
end
function Destroy();virtual;
begin
FIni := nil;
FTStringa := nil;
end
property VType read FVtype write FVtype;
property LowerKey read FLowerKey write FLowerKey;
property LowerValue read FLowerValue write FLowerValue;
_tag;
end
function create(v);
begin
{**
@explan(说明) 构造节点 %%
**}
FId := v[FIdName];
FValue := v;
FComponents := array();
end
function addcomponent(o);
begin
{**
@explan(说明) 添加节点 %%
**}
len := length(FComponents);
for i:= 0 to len-1 do if o= FComponents[i] then exit;
FComponents[len] := o;
end
function Recycle();
begin
{**
@explan(说明) 出现死循环的时候的处理 %%
**}
if FRecyce then return ;
FRecyce := true;
for i,v in FComponents do
begin
v.Recycle();
end
FComponents := array();
end
function toarray();
begin
{**
@explan(说明) 转换为array %%
**}
if FInToArray=FSInToArray then
begin
Recycle();
raise "节点关系出现循环";
end
FInToArray := FSInToArray;
ret := array();
sub := array();
for i := 0 to length( FComponents)-1 do
begin
ret[FSubName,i] := FComponents[i].toarray();
end
for i,v in FValue do
begin
if i =FSubName then continue;
ret[i] := v;
end
return ret;
end
class function SetColumnName(info);
begin
if not ifarray(info) then info := array("id":"id","pid":"pid","sub":"sub");
if not ClumnNameOk(info["id"]) then info["id"] := "id";
if not ClumnNameOk(info["pid"]) then info["pid"] := "pid";
if not ClumnNameOk(info["sub"]) then info["sub"] := "sub";
SetIdName(info["id"],info["pid"],info["sub"]);
end
class function ToTree(d,info);
begin
{**
@explan(说明) 二维表转换为树结构 %%
@param(d)(array) 数据包含 信息 %%
@param(info)(array) 字段信息 "id" 当前节点的字段,"pid" 当前节点的父节点字段,"sub" ,返回子节点的字段
默认值 array("id":"id","pid":"pid","sub":"sub"); %%
@return(TArrayTreeClass)
**}
SetColumnName(info);
root := new TArrayTreeClass(array(FIdName:nil,FPIdName:nil));
oarray := array();
oarray[-inf] := root;
for i,v in d do //构建id
begin
id := v[FIdName];
ido := oarray[id];
if ifnil(ido) then
begin
ido := new TArrayTreeClass(v);
oarray[id] := ido;
end
end
ifcycle := true;
for i,v in d do
begin
id := v[FIdName];
ido := oarray[id];
pid := v[FPIdName];
pdo := oarray[pid];
if not pdo then
begin
pdo := oarray[-inf];
ifcycle := false;
end
pdo.addcomponent(ido);
end
if ifcycle and oarray then
begin
for i,v in oarray do
begin
v.Recycle();
raise "节点关系出现循环";
break;
end
end
return root;
end
class function CreateRow(d,id,r);
begin
for i,v in d do
begin
ri := array();
if not v then continue;
ri[FIdName] := GetCounter();
ri[FPIdName] := id;
for j,vi in v do
begin
if j = FSubName then
begin
call(thisfunction,vi,ri[FIdName],r);
end
{else if j=FIdName or j = FPIdName then
begin
end} else
begin
ri[j] := vi;
end
end
if ri then
begin
r[length(r)] := ri;
end
end
end
class function TreeArrayToArray(d,info);
begin
{**
@explan(说明) 树结构转换为二维表 %%
@param(d)(array) 数据包含 信息 %%
@param(info)(array) 字段信息 "id" 当前节点的字段,"pid" 当前节点的父节点字段,"sub" ,返回子节点的字段
默认值 array("id":"id","pid":"pid","sub":"sub"); %%
@return(array)
**}
if not ifarray(d) then exit;
SetColumnName(info);
r := array();
initconter();
CreateRow(d,GetCounter(),r);
return r;
end
class function ToTreeArray(d,info);
begin
{**
@explan(说明) 二维表转换为树结构 %%
@param(d)(array) 数据包含 信息 %%
@param(info)(array) 字段信息 "id" 当前节点的字段,"pid" 当前节点的父节点字段,"sub" ,返回子节点的字段
默认值 array("id":"id","pid":"pid","sub":"sub"); %%
@return(array) 树形结构的array
**}
root := ToTree(d,info);
if not root then return ;
FSInToArray := tostn(now());
r := (root.toarray());
return r;
end
end
type TIniFileExta = class()
{**
@explan(说明) ini文件读写封装 %%
**}
private
FTStringa;
Fini;
FVtype;
FLowerKey;
FLowerValue;
function CheckSK(s,k);
begin
return ifstring(s) and s and ifstring(k) and k;
end
function ChangeV(V);
begin
vv := v;
case Vtype of
1:vv := vv="0"?false:true;
2:vv := StrToIntDef(vv,0);
else
begin
if FLowerValue then vv := lowercase(vv);
end
end
return vv;
end
function STNVA();
begin
{**
@explan(说明) 转换为name,value 列的二维数组 %%
**}
r := array();
for i:=0 to FTStringa.Count-1 do
begin
n := FTStringa.Names(i);
if n then
begin
if FLowerKey then n := lowercase(n);
vv := FTStringa.Values(n);
r[length(r)] := array("name":n,"value":ChangeV(vv));
end
end
FTStringa.Clear();
return r;
end
function STNV();
begin
{**
@explan(说明) 转换为name:value 一维数组 %%
**}
nr := STNVA();
r := array();
for i,v in nr do
begin
r[v["name"]] := v["value"];
end
return r;
end
function STA();
begin
{**
@explan(说明) 转换为一维数组 %%
**}
r := array();
for i:=0 to FTStringa.Count-1 do
begin
vi := FTStringa.Strings(i);
r[i] := FLowerKey?lowercase(vi):vi ;
end
FTStringa.Clear();
return r;
end
public
function create(al,Fname);override;
begin
{**
@explan(说明) 构造函数 %%
@param(al)(string) 别名 %%
@param(name)(string) 文件名 %%
**}
if ifstring(al) and ifstring(Fname) then
begin
FIni := new TIniFile(al,Fname);
FTStringa := new TStringlist();
end else
raise "ini对象读写构造参数错误";
end
function readSection(sn);virtual;
begin
{**
@explan(说明) 读取section 下面key %%
**}
if ifstring(sn) and sn then
Fini.readSection(sn,FTStringa);
return STA();
end
function ReadSections();virtual;
begin
{**
@explan(说明) 读取所有section名字 %%
**}
FIni.ReadSections(FTStringa);
return STA();
end
function ReadSectionValues(sn);virtual;
begin
{**
@explan(说明) 读取section下面的所有key:value %%
**}
if ifstring(sn) and sn then
FIni.ReadSectionValues(sn,FTStringa);
return STNV();
end
function RenameSection(sn1,sn2);virtual;
begin
{**
@explan(说明) 重命名section %%
@param(sn1)(string) 旧名字 %%
@param(sn2)(string) 新名字 %%
**}
if not(sn1 and sn2 and ifstring(sn1)) and ifstring(sn2) then exit;
vs1 := ReadSectionValues(sn1);
EraseSection(sn1);
for i,v in vs1 do
begin
WriteKey(sn2,i,v);
end
end
function RenameKey(sec,k1,k2);virtual;
begin
{**
@explan(说明) 重命名key %%
@param(sec)(string) section名称 %%
@param(k1)(string) 旧名字 %%
@param(k2)(string) 新名字 %%
**}
if (sec and k2 and k1 and ifstring(sec) and ifstring(k1) and ifstring(k2)) then exit;
v := ReadKey(sec,k1);
DeleteKey(sec,k1);
WriteKey(sec,k2,v);
end
function ReadSectionValues2(sn);
begin
{**
@explan(说明) 获得section 数据,二维表,name,value 列
**}
if ifstring(sn) and sn then
FIni.ReadSectionValues(sn,FTStringa);
return STNVA();
end
function ReadSectionValues3(sn);
begin
{**
@explan(说明) 获得section 数据,二维表,0列为key,1列为value
**}
d := ReadSectionValues2(sn);
r := array();
for i,v in d do
begin
r[length(r)] := array(v["name"],v["value"]);
end
return r;
end
function ReadKey(sn,key,def);virtual;
begin
{**
@explan(说明) 读取key %%
**}
if CheckSK(sn,key) then
return FIni.ReadString(sn,key,ifstring(def)?def:"");
return nil;
end
function WriteKey(sn,key,v);virtual;
begin
{**
@explan(说明) 写入key %%
**}
if ifnil(v) then v := "";
if CheckSK(sn,key) then
return FIni.WriteString(sn,key,ifstring(v)?v:tostn(v));
return 0;
end
function DeleteKey(sn,key);virtual;
begin
if CheckSK(sn,key) then
return FIni.DeleteKey(sn,key);
end
function EraseSection(sn);virtual;
begin
{**
@explan(说明)删除section %%
**}
if ifstring(sn) and sn then
return FIni.EraseSection(sn);
end
function Destroy();virtual;
begin
FIni := nil;
FTStringa := nil;
end
property VType read FVtype write FVtype;
property LowerKey read FLowerKey write FLowerKey;
property LowerValue read FLowerValue write FLowerValue;
_tag;
end
type TCreateProcessA = class()
{**
@explan(说明) 进程构造对象 %%

7
funcext/tvclib/ugtkinterface.tsf
View File

@ -453,6 +453,7 @@ type tgtkapis = class() //gtk
function gtk_main_iteration():integer ;cdecl;external 'libgtk-3.so';
///////////////////////////////////////////////////////
function tsl_gtk_idle_interface(p:pointer):integer;cdecl;external "./plugin/libTSLUIL.so";
function tsl_gtk_color_selection_property(w:pointer):pointer;cdecl;external "./plugin/libTSLUIL.so";
function g_idle_remove_by_data(p:pointer):integer;cdecl;external 'libgtk-3.so';
////////////////
@ -2867,7 +2868,7 @@ type tgtk_ctl_object = class(_gtkeventtype)
FConnectNameIds := array();
FConnectHandlers := array();
end
function getsingalmap();virtual;
function getsignalmap();virtual;
begin
return array(
"wm-user":'tsl_gtk_wmuser_event', //Óû§
@ -2898,7 +2899,7 @@ type tgtk_ctl_object = class(_gtkeventtype)
end
//echo "\r\nconnect ===========================",FHandle,"=====",n;
eid := GetGtkEventNameOrId(ln);
fn := (getsingalmap())[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);
FConnectNameIds[ln] := lnid;
@ -3143,7 +3144,7 @@ type tgtk_im_object = class(tgtk_ctl_object)
Connect(v,f);
end
end
function getsingalmap();override;
function getsignalmap();override;
begin
return array(
"preedit-start":"dodeleteevents" ,

BIN
plugin/TSLUIL.dll
View File

Binary file not shown.