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

设计器

Browse Source 
拆分代码
This commit is contained in:
JianjunLiu
2022-05-21 07:02:54 +08:00
parent df9c3b8dbc
commit 8cd45006e2
24 changed files with 9329 additions and 9780 deletions
Download Patch File Download Diff File Expand all files Collapse all files
funcext/tvclib/tcomponent.tsf
+10 -10
View File
@@ -1,5 +1,5 @@
type tcomponent = class(TSLUIBASE)
uses utslvclauxiliary,utslvclbase;
uses utslvclauxiliary,UVCPropertyTypesPersistence,utslvclbase;
{**
@explan(说明) 可视化组件基类 %%
@date(20220505) 分离tcomponent基类
@@ -31,9 +31,9 @@ uses utslvclauxiliary,utslvclbase;
#!begin //private methods
function GetLoader();
begin
global G_T_TTFM2COMPONET_;
if not G_T_TTFM2COMPONET_ then return 0;
if not FLoader then FLoader := createobject(G_T_TTFM2COMPONET_);
m2 := class(tUIglobalData).uigetdata("G_T_TTFM2COMPONET_");
if not m2 then return 0;
if not FLoader then FLoader := createobject(m2);
return FLoader;
end
function GetPropInfo();
@@ -310,7 +310,7 @@ public
if cd=self then return true;
for i := 0 to FComponents.count()-1 do
begin
if FComponents[i].isDescendant(cd)then return true;
if FComponents[i].isDescendant(cd) then return true;
end
return false;
end
@@ -320,7 +320,7 @@ public
@explan(说明) 设置所有者,注意只能成功设置一次,之后设置无效 %%
@param(AOwner)(tcomponent) 所有者 %%
**}
if ifnil(FOwner)and(AOwner is class(tcomponent))then
if (ifnil(FOwner)) and (AOwner is class(tcomponent))then
begin
if isDescendant(AOwner)then exit;
FOwner := AOwner;
@@ -471,7 +471,7 @@ public
begin
typ := v["type"];
if typ="eventhandler" then continue;
otype := GetPropertyType(typ);
otype :=GetComponentPropertyType(typ);// GetPropertyType(typ);
if otype then
begin
n := v["name"];
@@ -502,7 +502,7 @@ public
begin
typ := v["type"];
if typ <> "eventhandler" then continue;
otype := GetPropertyType(typ);
otype :=GetComponentPropertyType(typ);// GetPropertyType(typ);
if otype then
begin
n := v["name"];
@@ -532,7 +532,7 @@ public
vv := FChangedProperties[n];
if ifnil(vv)then continue;
vit := vi["type"];
otype := GetPropertyType(vit);
otype := GetComponentPropertyType(vit);//GetPropertyType(vit);
if vi["write"]and otype then
begin
r[n]:= otype.FormatTMF(vv);
@@ -570,7 +570,7 @@ public
if n=vi["name"]then
begin
vit := vi["type"];
otype := GetPropertyType(vit); //获得转换对象
otype := GetComponentPropertyType(vit);//GetPropertyType(vit); //获得转换对象
if ifobj(otype)then
begin
iv := otype.UnformatEdit(v); //反转换
funcext/tvclib/tcontrol.tsf
+8 -1
View File
@@ -3,6 +3,13 @@ type tcontrol = class(tcomponent)
@explan(说明) 界面控件基类 %%
@date(20220509) %%
**}
///////////平台判断////////
{$ifdef linux}
{$define gtkpaint}
{$define linuxgtk}
{$else}
{$define gdipaint}
{$endif}
uses utslvclauxiliary,utslvclmemstruct,utslvclevent,utslvclgdi,utslvclaction,utslvclmenu;
private //计量处数据
#!begin //members
@@ -815,7 +822,7 @@ type tcontrol = class(tcomponent)
begin
CallMessgeFunction(FOnDblClick,o,e);
end
end
end
function WMRButtonDBLCLK(o,e):LM_RBUTTONDBLCLK;virtual;
begin
{
funcext/tvclib/tslvcl.tsf
+60 -58
View File
@@ -23,7 +23,7 @@ unit tslvcl;
interface
uses utslvclconstant,utslvclbase,utslvclauxiliary,cstructurelib,utslvclmemstruct,utslvclevent,UVCPropertyTypesPersistence,utslvclgdi,utslvclaction,utslvclmenu,utslvclstdctl,utslvclgrid,utslvcltree;
function initializeapplication(); //获得app对象
function RegisterComponentType(n,typ); //设计器中注册控件
function RegisterComponentType(n,typ); //注册控件,便于通过控件名称构造控件
function GetAndDispatchMessageA(hwnd,minm,maxm); //win32 分发消息
function ExitMessageLoop(); //退出主循环
//function gettswin32api(); //win32 api
@@ -59,7 +59,6 @@ function TslToHexFormatStr(tsl);
function HexFormatStrToTsl(D);
function GetTextWidthAndHeightWidthFont(s,f,mul);
//**********操作系统相关函数*********************
function initlib();
////////////////////////////////////
@@ -133,8 +132,7 @@ type Ttfm2Component = class(TTmfParser)
nn := lowercase(n);
r := FComponentTypes[nn];
if r then return r;
global G_F_TSLVCL_FINDCLASS;
if G_F_TSLVCL_FINDCLASS then return call(G_F_TSLVCL_FINDCLASS,nn);
return findclass(nn);
end
end
function SetTfmData(owner,obj,data,lazydata);
@@ -156,7 +154,7 @@ type Ttfm2Component = class(TTmfParser)
ddpv := ddp[n];
if not ifarray(ddpv)then continue;
cls := v["class"];
et := owner.GetPropertyType(cls);
et := GetComponentPropertyType(cls);//owner.GetPropertyType(cls);
if not et then continue;
td := SampleValue(ddpv);
if et.LazyProperty()then
@@ -2097,7 +2095,6 @@ type tmemo = class(TSynMemoNorm)
begin
inherited;
end
function MouseUp(o,e);override;
begin
if csDesigning in ComponentState then return ;
@@ -10450,8 +10447,6 @@ begin
**}
class(Ttfm2Component).RegisterComponentType(n,typ);
end
function initializeapplication();
begin
{**
@@ -10579,31 +10574,12 @@ begin
**}
return class(ttimer)._timeproc_(hwnd,message,wparam,lparam);
end
type tglobalabc=class
function create();
begin
global xxxx;
xxxx++;
echo "\r\nin:",xxxx;
end
function destroy();
begin
global xxxx;
xxxx--;
echo "\r\nout:",xxxx;
end
end
function controlisCustomPaint(id);
begin
wd := class(tUIglobalData).uigetdata("TGlobalValues").getvalue(id);
if wd then return wd.isCustomPaint();
return false;
end
function tslvclfindclass(n);
begin
r := findclass(n);
return r;
end
function _twinproc_(hwnd,message,wparam,lparam); //消息分发
begin
{**
@@ -10701,29 +10677,7 @@ begin
end
end
function initallib();
begin
//ClearScriptCache();
//global tuiapplication;
//tuiapplication := getapplication();
global G_F_CONTROL_IS_CUSTOMPAINT;
global G_F_TSLVCL_FINDCLASS;
global G_F_TWIN_PROC_;
global G_F_TIME_PROC_;
global G_T_TTFM2COMPONET_;
global G_T_TVCFORM_;
G_F_CONTROL_IS_CUSTOMPAINT := thisfunction(controlisCustomPaint);
G_F_TSLVCL_FINDCLASS := thisfunction(tslvclfindclass);
G_F_TWIN_PROC_ := thisfunction(_twinproc_);
G_F_TIME_PROC_ := thisfunction(_timeproc_);
G_T_TTFM2COMPONET_ := class(Ttfm2Component);
G_T_TVCFORM_ := class(TVCForm);
class(tUIglobalData).uisetdata("TGlobalComponentcache",class(TGlobalComponentcache));
class(tUIglobalData).uisetdata("TGlobalValues",class(TGlobalValues));
class(TRegKey).sinit(); //初始化reg注册表
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";
@@ -10743,23 +10697,22 @@ function TSL_FreeObj(L:pointer;v:pointer);cdecl;external {$ifdef linux}"libTSSVR
//function TS_ModulePath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ModulePath";
//function TS_ExecPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ExecPath";
//function TS_GetAppPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ExecPath";
function TS_GetUserProfileHome():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetUserProfileHome";
//function TS_GetIniPath(hometype:integer; var IniName:string):string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetIniPath";
function TSL_Check(func:string;funclen:integer;oResult:pointer):integer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TSL_Check";
procedure tslprocessmessages();begin {echo "\r\n processmessage";}end;
function TS_GetUserProfileHome();
begin
return unit(utslvclauxiliary).TS_GetUserProfileHome();
end
function RunWorkerThreadLoop();
begin
sleep(10);
class(TThreadWorker).dispatch();
end
//procedure ClearScriptCache();cdecl;external "TSLInterp.dll" name "ClearScriptCache";
function initlib();
begin
{**
@explan(说明) 初始化lib %%
**}
a := static initallib();
end
function CreateDirWithFileName(fname);
begin
return unit(utslvclauxiliary).CreateDirWithFileName(fname);
@@ -11000,6 +10953,7 @@ begin
**}
return(a and not(b))or(b and not(a));
end
////////////////////封装已经移动到其他库的接口为了兼容///////////
function TslToHexFormatStr(tsl);
begin
return unit(utslvclauxiliary).TslToHexFormatStr(tsl);
@@ -11016,7 +10970,55 @@ function CallMessgeFunction(f,o,e);
begin
return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);
end
/////////////////////////初始化////////////////////////////////////
function initallib();
begin
class(tUIglobalData).uisetdata("G_F_CONTROL_IS_CUSTOMPAINT",thisfunction(controlisCustomPaint));
class(tUIglobalData).uisetdata("G_F_TWIN_PROC_",thisfunction(_twinproc_));
class(tUIglobalData).uisetdata("G_F_TIME_PROC_",thisfunction(_timeproc_));
class(tUIglobalData).uisetdata("G_T_TVCFORM_",class(TVCForm));
class(tUIglobalData).uisetdata("G_T_TTFM2COMPONET_",class(Ttfm2Component));
class(tUIglobalData).uisetdata("TGlobalComponentcache",class(TGlobalComponentcache));
class(tUIglobalData).uisetdata("TGlobalValues",class(TGlobalValues));
class(TRegKey).sinit(); //初始化reg注册表
//导入注册的componet
vclini := pluginpath()+"tslvcl.ini";
if fileexists("",vclini) then
begin
ini := new TIniFileExta("",vclini);
ini.LowerKey := true;
for i,v in ini.ReadSectionValues("components") do //控件
begin
if v then
begin
cv := findclass(v);
if cv then
begin
RegisterComponentType(i,cv);
end
end
end
for i,v in ini.ReadSectionValues("propertys") do //属性
begin
if v then
begin
cv := findclass(v);
if cv then
begin
RegComponentPropertyType(createobject(cv));
end
end
end
end
end
function initlib();
begin
{**
@explan(说明) 初始化lib %%
**}
a := static initallib();
end
Initialization
initlib();
funcext/tvclib/twincontrol.tsf
+2 -2
View File
@@ -2432,8 +2432,8 @@ end
if dispatchmenushortcut(o.Action,st) then return "havedoshortcut";
if dispatchmenushortcut(o.PopupMenu,st) then return "havedoshortcut";
end
global G_T_TVCFORM_;
if G_T_TVCFORM_ and (o is G_T_TVCFORM_ ) then
w := class(tUIglobalData).uigetdata("G_T_TVCFORM_");
if w and (o is w ) then
begin
if dispatchmenushortcut(o.MainMenu,st) then return "havedoshortcut";
end
funcext/tvclib/ugtkinterface.tsf
+25 -25
View File
@@ -455,7 +455,7 @@ type tsgtkapi = class(tgtkapis)
// class(tUIglobalData).uigetdata("TGlobalComponentcache").getwndbyhwnd(hwnd);
function Gtk_TrigMoveSizeEvent(h,aleft,atop,AWidth,AHeight,flg);
begin
global G_F_TWIN_PROC_;
gfw := class(tUIglobalData).uigetdata("G_F_TWIN_PROC_");
SWP_NOMOVE := 2;
SWP_NOSIZE := 1;
WM_WINDOWPOSCHANGED := 0x47;
@@ -479,14 +479,14 @@ type tsgtkapi = class(tgtkapis)
else
d.cy := AHeight;
D.flags := SWP_NOMOVE;
if G_F_TWIN_PROC_ then call(G_F_TWIN_PROC_,h,WM_WINDOWPOSCHANGED,0,d._getptr_);
if gfw then call(gfw,h,WM_WINDOWPOSCHANGED,0,d._getptr_);
end
if PosChanged then
begin
d.x := ALeft;
d.y := ATop;
d.flags := SWP_NOSIZE;
if G_F_TWIN_PROC_ then call(G_F_TWIN_PROC_,h,WM_WINDOWPOSCHANGED,0,d._getptr_);
if gfw then call(gfw,h,WM_WINDOWPOSCHANGED,0,d._getptr_);
end
if SizeChanged then //这个是不是应该放前面
begin
@@ -498,9 +498,9 @@ type tsgtkapi = class(tgtkapis)
end}
if PosChanged then
begin
if G_F_TWIN_PROC_ then
if gfw then
begin
call(G_F_TWIN_PROC_,h,0x3,0,makeposition(ALeft,ATop));
call(gfw,h,0x3,0,makeposition(ALeft,ATop));
end
end
@@ -1894,10 +1894,10 @@ type tsgtkapi = class(tgtkapis)
obj := g_image_list_caches[sptr,"imglist"] ;
if not obj then return ;
class(TGdiplusflat).GdipCreateBitmapFromHBITMAP(hbmImage,r1,0);
global G_T_BITMAP_;
if G_T_BITMAP_ then
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
if cbmp then
begin
bmp := createobject(G_T_BITMAP_);
bmp := createobject(cbmp);
bmp.Handle := r1;
obj.Push(bmp);
end
@@ -2007,11 +2007,11 @@ type tsgtkapi = class(tgtkapis)
if not ifarray(g_image_list_caches) then return 0;
obj := g_image_list_caches[inttostr(himl),"imglist"];
if not obj then return ;
global G_T_BITMAP_;
if not G_T_BITMAP_ then return 0;
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
if not cbmp then return 0;
class(TGdiplusflat).GdipCreateBitmapFromHBITMAP(hbmImage,0,r1);
bmp := createobject(G_T_BITMAP_);
bmp := createobject(cbmp);
bmp.Handle := r1;
if id=-1 then obj.Push(bmp);
else
@@ -2445,9 +2445,9 @@ type tsgtkapi = class(tgtkapis)
global g_gtk_caret_cache_timer; //缓存
if not g_gtk_caret_cache_timer then
begin
global G_T_TTIMER_;
if not G_T_TTIMER_ then return 0;
g_gtk_caret_cache_timer := createobject(G_T_TTIMER_,nil);
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.Ontimer := function(o,e)begin
global g_current_get_focus_widget;
@@ -4426,14 +4426,14 @@ type tenterouterlist = class
end
function create(api);
begin
global G_T_TTIMER_;
if not G_T_TTIMER_ then return ;
ctm := class(tUIglobalData).uigetdata("G_T_TTIMER_");
if not ctm then return ;
_wapi := api;
FCpos := array(0,0);
_wapi.GetCursorPos(FCpos);
FList := array();
FIndex := -1;
FTimer := createobject(G_T_TTIMER_,nil);
FTimer := createobject(ctm,nil);
FTimer.interval := 30; //30毫秒
FTimer.Ontimer := thisfunction(MouseIsMoved);
FTimer.start();
@@ -4536,10 +4536,10 @@ type tgtk_ctl_object = class(_gtkeventtype)
return AddMessageToGtkMessageQueue(FHandle,msg,w,l,p);
end else
begin
global G_F_TWIN_PROC_;
if G_F_TWIN_PROC_ then
gfw := class(tUIglobalData).uigetdata("G_F_TWIN_PROC_");
if gfw then
begin
r := call(G_F_TWIN_PROC_,FHandle,msg,w,l);
r := call(gfw,FHandle,msg,w,l);
end
if msg = CM_CURSORCHANGED then
begin
@@ -5877,12 +5877,12 @@ type tgtk_ctl_scroll_window = class(tgtk_ctl_object)
end;
function CreateWnd(dwExStyle,lpClassName,lpWindowName,dwStyle,x,y,nwidth,nheight,hwndparent,hmenu,hinstance,lpParam);override;
begin
global G_F_CONTROL_IS_CUSTOMPAINT;
fispaint := class(tUIglobalData).uigetdata("G_F_CONTROL_IS_CUSTOMPAINT");
//echo "\r\nctl:",tostn(params),tostn(__stack_frame),datetimetostr(now());
d := new tslcstructureobj(MemoryAlignmentCalculate( array(("lpcreateparams","intptr",0))),lpParam);
if G_F_CONTROL_IS_CUSTOMPAINT then
if fispaint then
begin
isp := call(G_F_CONTROL_IS_CUSTOMPAINT,d._getvalue_("lpcreateparams"));
isp := call(fispaint,d._getvalue_("lpcreateparams"));
end
h := self.handle;
{if (_const.WS_BORDER .& dwStyle)=_const.WS_BORDER then
@@ -6697,8 +6697,8 @@ begin
end }
if d[4]=0x113 and d[0]=0 then //定时
begin
global G_F_TIME_PROC_;
if G_F_TIME_PROC_ then call(G_F_TIME_PROC_,d[0],d[1],d[2],d[3]);
fgt := class(tUIglobalData).uigetdata("G_F_TIME_PROC_");
if fgt then call(fgt,d[0],d[1],d[2],d[3]);
end else
if d[0] then
begin
funcext/tvclib/utslmemo.tsf
+6 -3
View File
@@ -454,7 +454,7 @@ type TCustomMemoCmd=class()
static ecColumnSelect;
static ecLineSelect;
static ecMatchBracket;
static ecGotoMarker0;
{static ecGotoMarker0;
static ecGotoMarker1;
static ecGotoMarker2;
static ecGotoMarker3;
@@ -473,7 +473,7 @@ type TCustomMemoCmd=class()
static ecSetMarker6;
static ecSetMarker7;
static ecSetMarker8;
static ecSetMarker9;
static ecSetMarker9;}
static ecDeleteLastChar;
static ecDeleteChar;
static ecDeleteWord;
@@ -571,7 +571,7 @@ type TCustomMemoCmd=class()
ecColumnSelect := 232; // Column selection mode
ecLineSelect := 233; // Line selection mode
ecMatchBracket := 250; // Go to matching bracket
ecGotoMarker0 := 301; // Goto marker
{ecGotoMarker0 := 301; // Goto marker
ecGotoMarker1 := 302; // Goto marker
ecGotoMarker2 := 303; // Goto marker
ecGotoMarker3 := 304; // Goto marker
@@ -591,6 +591,7 @@ type TCustomMemoCmd=class()
ecSetMarker7 := 358; // Set marker, Data := PPoint - X, Y Pos
ecSetMarker8 := 359; // Set marker, Data := PPoint - X, Y Pos
ecSetMarker9 := 360; // Set marker, Data := PPoint - X, Y Pos
}
ecDeleteLastChar := 501; // Delete last char (i.e. backspace key)
ecDeleteChar := 502; // Delete char at cursor (i.e. delete key)
ecDeleteWord := 503; // Delete from cursor to end of word
@@ -2360,6 +2361,7 @@ type TSynCompletion = class(TSynCompletionList)
function SetJumpData(s);
begin
FJumpData := s;
FFilter :="";
end
function Recycling();override;
begin
@@ -2713,6 +2715,7 @@ type TSynCompletion = class(TSynCompletionList)
begin
SetMemo(nil);
inherited;
FCompData := array();
end
function TryJump(s); //跳转
funcext/tvclib/utslvclauxiliary.tsf
+285
View File
@@ -24,6 +24,9 @@ function pointinrect(p,rec);
function intersectrect(rec1,rec2,irec);
function bitcombination(s,v,f);
function IsTextUTF8(str);
function exportjsonformat(d,tbw,ct);
//****************************
///////////////////
function ParserCommandLine(s); //解析命令行参数
@@ -34,6 +37,8 @@ function TslToHexFormatStr(tsl);
function HexFormatStrToTsl(D);
function DeleteAllFiles(path);
function CreateDirWithFileName(fname);
function TS_GetUserProfileHome();
function gettslexefullpath();
type tuiglobaldata=class
static UIData;
@@ -997,6 +1002,103 @@ type tnumindexarray = Class
@param(Data)(array) 数据 %%
**}
end
//ifdef newgetop
type trefarray = class
function create(d,bidxs); //构造函数
begin
if ifarray(d) or (d is class(trefarray)) then
begin
FData := d;
end else
begin
FData := array();
end
if ifarray(bidxs) then
begin
FBindexs := bidxs;
end else
begin
FBindexs := array();
end
end
function mgset(idxs,v); //根据下标设置值
begin
if not ifarray(idxs) then return nil;
if ifarray(FData) then
begin
return magicsetarray(FData,FBindexs union idxs,v);
end
return FData.mgset(FBindexs union idxs,v);
end
function mgget(idxs); //根据获得值
begin
if not ifarray(idxs) then return nil;
if ifarray(FData) then
begin
return magicgetarray(FData,idxs);
end
return FData.mgget(FBindexs union idxs,v);
end
function operator[0](idx,v); //获取值
begin
if v<0 then //一级直接返回
begin
return mgget(array(idx));
end
return new trefgetter(self,idx);//多级的时候构建一个中间对象
end
function operator[1](idx,v); //设置值
begin
if ifnone(v) then //多级构建一个中间对象
begin
return new trefsetter(self,idx);
end
return mgset(array(idx),v); //一级直接返回
end
private //成员变量
FData;
FBindexs;
private //中间对象
type trefsgter = class()
function create(a,idx);
begin
FA := a;
FIndexs := array(idx);
FIndexsidx := 1;
end
protected
FA;
FIndexs;
FIndexsidx;
end
type trefgetter = class(trefsgter) //getter 对象
function operator[0](idx,v);
begin
FIndexs[FIndexsidx++] := idx;
if v<0 then
begin
return fa.mgget(FIndexs);
end
return self;
end
function create(a,idx);
begin
inherited;
end
end
type trefsetter = class(trefsgter) //setter 对象
function operator[1](idx,v);
begin
FIndexs[FIndexsidx++] := idx;
if ifnone(v) then return self;
return fa.mgset(FIndexs,v);
end
function create(a,idx);
begin
inherited;
end
end
end;
type TGlobalValues=class
private
static FValues;
@@ -2194,6 +2296,189 @@ begin
ph += vi;
end
end
function TS_GetUserProfileHome():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetUserProfileHome";
function IsTextUTF8(str)
begin
{utf8规则
单字节: 0xxxxxxx
二字节 110xxxxx 10xxxxxx
三字节 1110xxxx 10xxxxxx 10xxxxxx
四字节 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx
五字节 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
刘字节 1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx
}
// 0 为ansi 编码,1 为utf8编码 -1 不能确定什么编码
nBytes := 0; //UFT8可用1-6个字节编码,ASCII用一个字节
DY := 0;
chr := "";
bAllAscii := TRUE; //如果全部都是ASCII, 说明不是UTF-8
for i := 1 to length(str) do
begin
chr := ord(str[i]);
if((chr .& 0x80)<> 0)then
begin // 判断是否ASCII编码,如果不是,说明有可能是UTF-8,ASCII用7位编码,但用一个字节存,最高位标记为0,o0xxxxxxx
bAllAscii := FALSE;
end
if(nBytes=0)then //如果不是ASCII码,应该是多字节符,计算字节数
begin
if(chr >= 0x80)then
begin
if(chr >= 0xFC and chr <= 0xFD)then nBytes := 6;
else if(chr >= 0xF8)then nBytes := 5;
else if(chr >= 0xF0)then nBytes := 4;
else if(chr >= 0xE0)then nBytes := 3;
else if(chr >= 0xC0)then nBytes := 2;
else return 0;
DY := MAX(nBytes,DY);
nBytes--;
end
end else //多字节符的非首字节,应为 10xxxxxx
begin
if((chr .& 0xC0)<> 0x80)then return-1;
nBytes--;
end
end;
//违返规则
if(nBytes>0)then
return -1;
//如果全部都是ASCII, 说明不是UTF-8
if(bAllAscii)then
return 0;
//return 1;
return DY>2;
end
function exportjsonformat(d,tbw,ct);
begin
//d:天软数据
//tbw : 字符串,tab 宽度
//ct 递归深度,忽略
case datatype(d)of
0,20:return inttostr(d);
1:return floattostr(d);
2:return tostn(d);
8,10,11,12:return "null";
end;
if not(ct>0)then ct := 0;
if not ifstring(tbw)then tbw := " ";
tbstr := "";
tbstra := "";
for i := 0 to ct do
begin
tbstr += tbw;
if i>0 then tbstra += tbw
end
if ifarray(d)then
begin
if not d then return "[]";
idx := 0;
for i,v in d do
begin
if idx <> i then
begin
fobj := true;
break;
end
idx++;
end
if fobj then
begin
r := "{";
for i,v in d do
begin
if ifstring(i)then ii := tostn(i);
else ii := tostn(tostn(i));
r += "\r\n"+tbstr+ii+":";
if ifarray(v)and v then
begin
r += "\r\n"+tbstr;
end
r += exportjsonformat(v,tbw,ct+1)+",";
end
lr := length(r);
r[lr:]:= "\r\n"+tbstra+"}";
end else
begin
r := "[";
for i,v in d do
begin
r += "\r\n"+(tbstr)+exportjsonformat(v,tbw,ct+1)+",";
end
lr := length(r);
r[lr:]:= "\r\n"+tbstra+"]";
end
return r;
end else
if ifobj(d)then
begin
try
//return "{}";
//此处可以遍历对象信息
tslobjtoarray(d,dinfo);
for i,v in mrows(dinfo,1) do
begin
nv := invoke(d,v);
if ifobj(nv)then nv := nil; //避免死循环
dinfo[v]:= nv;
end
return exportjsonformat(dinfo,tbw,ct);
except
return "{}";
end
end else
return "null";
end
function tslobjtoarray(o,r);
begin
d := o.classinfo();
if not ifarray(r)then r := array();
for i,v in d["inherited"] do
begin
tslobjtoarray(findclass(v,o),r);
end
for i,v in d["members"] do
begin
n := v["name"];
if v["access"]in array(0,1)then
begin
r[n]:= 0;
end else
begin
reindex(r,array(n:nil));
end
end
for i,v in d["properties"] do
begin
n := v["name"];
if v["read"]and(v["access"]in array(0,1))then
begin
r[n]:= 0;
end else
begin
reindex(r,array(n:nil));
end
end
end
function gettslexefullpath();
begin
plg := pluginpath();
sp := ioFileseparator();
for i:= length(plg)-1 downto 1 do
begin
if plg[i]=sp then
begin
if sp="/" then
begin
return plg[1:i]+"TSL";
end else
begin
return plg[1:i]+"tsl.exe";
end
end
end
return "";
end
initialization
funcext/tvclib/utslvclbase.tsf
+1 -9
View File
@@ -6,7 +6,7 @@ interface
{$else}
{$define gdipaint}
{$endif}
uses utslvclconstant,utslvclmemstruct,utslvclauxiliary,UVCPropertyTypesPersistence;
uses utslvclconstant,utslvclmemstruct,utslvclauxiliary;
type tswin32api = class({$ifdef linuxgtk}tsgtkapi {$else} twindowsapi {$endif} ) //windows接口
{$ifdef linuxgtk}
uses ugtkinterface;
@@ -303,14 +303,6 @@ type TSLUIBASE=class(TSLUICONST) //ͼ
if not(ifstring(_temppath)and _temppath)then _temppath := gettemppath()+"tinysoft";
return _temppath;
end
class function RegPropertyType(v); //注册设计器编辑
begin
RegComponentPropertyType(v);
end
class function GetPropertyType(n); //获得设计器编辑
begin
return GetComponentPropertyType(n);
end
property happ read Gethapp write SetHapp;
property ReCycleState read FReCycleState; //write FReCycleState;
_Tag; //标签
funcext/tvclib/utslvclgdi.tsf
+2 -4
View File
@@ -2981,10 +2981,8 @@ end
initialization
sinitgidplus();
class(tcustomimage).sinit();
global G_T_BITMAP_;
global G_T_ICON_;
G_T_BITMAP_ := class(TcustomBitmap);
G_T_ICON_ := class(TcustomIcon);
class(tUIglobalData).uisetdata("G_T_BITMAP_",class(TcustomBitmap));
class(tUIglobalData).uisetdata("G_T_ICON_",class(TcustomIcon));
finalization
end.
funcext/tvclib/utslvclstdctl.tsf
+9 -208
View File
@@ -331,204 +331,6 @@ type TCustomTimer = class(tcomponent)//
@param(Enabled)(bool) 是否已经启动 %%
**}
end
type TCustomTimer = class(tcomponent)//定时器类
{**
@explan(说明)定时器类,间隔是以毫秒为最小单位 %%
**}
{**
@example(范例--定时器)
//构造计算器,第一个参数为间隔(毫秒),第二个为函数指针
tm := new TCustomTimer(1000,function(o,e)begin echo now(); end );
tm.start();//启动定时器
tm.stop();//停止
**}
private
static _STIMERS; //TIMER对象
static FSIDC; //id 构造器
class function Sgettimer(id);
begin
{**
@explan(说明) 通过id获得定时器对象 %%
@param(id)(integer) 定时器id %%
**}
return _STIMERS[id];
end
class function Ssettimer(tm);
begin
{**
@explan(说明)存储定时器 %%
@param(tm)(TCustomTimer) 定时器对象%%
**}
_STIMERS[tm.id]:= tm;
end
class function Sdeltimer(tid);
begin
{**
@explan(说明) 删除定时器 %%
@param(tid)(integer) id%%
**}
if tid and(ifnumber(tid))then reindex(_STIMERS,array(tid:nil));
end
protected FOntimeout;
private
FOntimer;
Fid;
FInterval;
FStart;
_kill0; //标记
function SetEnabled(f);
begin
if f then start();
else stop();
end
function SetInterval(intv); //设置间隔
begin
{**
@explan(说明)设置间隔 %%
@param(intv)(integer) 间隔,毫秒 %%
**}
if not(ifnumber(intv))then return FInterval;
if FStart then
begin
ndstart := 1;
stop();
end
if intv <> FInterval and ifnumber(intv)and intv>0 then //时间不等
begin
FInterval := intv;
end
if ndstart then start();
end
public
{**
@param(FSIDC)(tidcreater) id构造器%%
@param(_STIMERS)(array) 全局存储%%
@param(FOntimer)(fpointer) timeout执行对象%%
@param(_kill0)(bool) 标记%%
**}
function create(AOwner);override;
begin
inherited;
FID := FSIDC.createid();
FStart := false;
FInterval := 1000;
end
function timeout(cmd,t); //一次性事件
begin
{**
@explan(说明) 一次性事件 %%
@param(cmd)(fpointer) 执行回调 %%
@param(t)(integer) t毫秒后执行 %%
**}
FOntimeout := cmd;
if ifnumber(t)then SetInterval(t);
FOntimer := function(o,e)
begin
try
stop();
CallMessgeFunction(FOntimeout,o,e);
finally
FOntimeout := nil;
end;
end;
start();
end
function start(); //开始
begin
{**
@explan(说明)启动 %%
**}
if not((datatype(FOntimer) = 7 )and FInterval)>0 then return-1;
if FStart then return FStart;
ret := _wapi.SetTimer(nil,Fid,FInterval,getwinprocptr(2));
_kill0 := ret;
Ssettimer(self(true));
FStart := ret <> 0;
return FStart;
end
function stop(); //停止
begin
{**
@explan(说明)停止 %%
**}
if FStart then
begin
if _kill0 then
begin
FStart := not((_wapi.KillTimer(nil,_kill0))<> 0);
if FStart=false then _kill0 := 0;
end
Sdeltimer(FID);
end
return not FStart;
end
function Recycling();override;
begin
{**
@explan(说明)析构预备 %%
**}
stop();
FSIDC.deleteid(FID);
FOntimer := nil;
FOntimeout := nil;
FTimerStrc := nil;
inherited;
end
function destroy();override;
begin
inherited;
end
class function _timeproc_(hwnd,message,wparam,lparam);
begin
{**
@explan(说明) 定时回调入接口 %%
@param(hwnd)(integer) 窗口句柄 %%
@param(message)(integer) 消息id %%
@param(lparam)(integer) 消息参数2 %%
@param(wparam)(integer) 消息参数1 %%
**}
e := new tuieventbase(message,wparam,lparam,hwnd);
for i,iv in mrows(_STIMERS,1) do
begin
v := _STIMERS[iv];
if v is class(TCustomTimer)then if v.tproc(e)then return;
end
//return _twinproc_(hwnd,message,wparam,lparam);
end
class function Sinit();override;
begin
{**
@explan(说明)初始化定时器全局 %%
**}
if not FSIDC then
begin
_STIMERS := array();
FSIDC := new tidcreater();
end
inherited;
end
function tproc(e);virtual;
begin
if e.wparam and(e.wparam=_kill0)then
begin
CallMessgeFunction(FOntimer,self(true),e);
return 1;
end
end
property Interval:integer read FInterval write SetInterval;
property Ontimer:eventhandler read FOntimer write FOntimer;
property Enabled:bool read FStart Write SetEnabled;
property id read FID;
function publishs();override;
begin
return array("name","interval","ontimer");
end
{**
@param(Interval)(integer) 设置运行间隔 %%
@param(Ontimer)(funtion[self,tuieventbase]) 定时调度 %%
@param(Enabled)(bool) 是否已经启动 %%
**}
end
type teditable=class(TSLUIBASE)
private
FInsertState;
@@ -2579,8 +2381,9 @@ type TCustomListBoxbase=class(TCustomScrollControl)
if e.Button()=mbLeft then
begin
CallMessgeFunction(onclick,o,e);
e.skip := true;
end
e.skip := true;
end
function MouseDown(o,e);override;
begin
@@ -3976,13 +3779,9 @@ type TcustomToolBar=class(TCustomControl)
FBtnRects := array();
FTipWnd := new TTipWnd(self);
FTipWnd.Parent := self;
global G_T_TTIMER_;
if G_T_TTIMER_ then
begin
FTimer := createobject(G_T_TTIMER_,self);
FTimer.Interval := 200;
FTimer.Ontimer := thisfunction(DoTimerShowTip);
end
FTimer := new TCustomTimer(self);
FTimer.Interval := 200;
FTimer.Ontimer := thisfunction(DoTimerShowTip);
end
function MouseDown(o,e);override;
begin
@@ -4851,6 +4650,8 @@ type TTipWnd=class(TCustomControl) //tip
FSize;
end
initialization
global G_T_TTIMER_;
G_T_TTIMER_ := class(TCustomTimer);
{$ifdef linux}
class(tUIglobalData).uisetdata("G_T_TTIMER_",class(TCustomTimer));
{$endif}
end.
funcext/tvclib/uvcpropertytypespersistence.tsf
+45 -49
View File
@@ -1,6 +1,6 @@
Unit UVCPropertyTypesPersistence;
interface
uses utslvclauxiliary;
uses utslvclauxiliary;//,utslvclgdi;
{**
@explan(说明) 可视控件属性处理库 %%
**}
@@ -926,7 +926,7 @@ type TPropertyType=class
function FormatTMF(d);virtual;
begin
{**
@explan(说明)修改表格数据转换为tfm文件数据 %%
@explan(说明)修改表格数据转换为tmf文件数据 %%
**}
return d;
end
@@ -1182,7 +1182,7 @@ type TPropertyaction=class(TPropertyVarible) //action
begin
return "taction";
end
function IfComponent();virtual;
function IfComponent();override;
begin
{**
@explan(说明) 是否为控件%%
@@ -1190,19 +1190,19 @@ type TPropertyaction=class(TPropertyVarible) //action
return true;
end
end
type TPropertyTray=class(TPropertyaction) //action
type TPropertyTray=class(TPropertyaction) //托盘
Function EditType();override;
begin
return "ttray";
end
end
type TPropertyPopupMenu=class(TPropertyaction) //action
type TPropertyPopupMenu=class(TPropertyaction) //右键菜单
Function EditType();override;
begin
return "tpopupmenu";
end
end
type TPropertyMainMenu=class(TPropertyaction) //action
type TPropertyMainMenu=class(TPropertyaction) //主菜单
Function EditType();override;
begin
return "tmainmenu";
@@ -1216,21 +1216,21 @@ type TPropertyMainMenu=class(TPropertyaction) //action
return false;
end
end
type TPropertyImagelist=class(TPropertyaction) //action
type TPropertyImagelist=class(TPropertyaction) //imagelist
Function EditType();override;
begin
return "tcontrolimagelist";
end
end
type TPropertyImagesData=class(TPropertyType)
type TPropertyImagesData=class(TPropertyType) //imagedata,作为imagelist的数据
Function EditType();override;
begin
return "imagesdata";
end
function TmfToNode(d);override;
begin
global G_T_BITMAP_;
if not G_T_BITMAP_ then return ;
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
if not cbmp then return ;
if ifstring(d)then
begin
r := HexFormatStrToTsl(d);
@@ -1239,7 +1239,7 @@ type TPropertyImagesData=class(TPropertyType)
ret := array();
for i,v in r["items"] do
begin
bmp := createobject(G_T_BITMAP_);
bmp := createobject(cbmp);
bmp.Readvcon(v);
ret[i]:= bmp;
end
@@ -1276,8 +1276,8 @@ type TPropertyImagesData=class(TPropertyType)
end
function ReadTMF(d,o);override;
begin
global G_T_BITMAP_;
if not G_T_BITMAP_ then return ;
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
if not cbmp then return ;
if ifstring(d)then
begin
r := HexFormatStrToTsl(d);
@@ -1286,7 +1286,7 @@ type TPropertyImagesData=class(TPropertyType)
ret := array("type":"bmps");
for i,v in r["items"] do
begin
bmp := createobject(G_T_BITMAP_);
bmp := createobject(cbmp);
bmp.Readvcon(v);
ret["items"][i]:= bmp;
end
@@ -1302,12 +1302,12 @@ type TPropertyBitmap=class(TPropertyType)
end
function TmfToNode(d);override;
begin
global G_T_BITMAP_;
if not G_T_BITMAP_ then return ;
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
if not cbmp then return ;
if ifstring(d)and d then
begin
tar := HexFormatStrToTsl(d);
bmp := createobject(G_T_BITMAP_);
bmp := createobject(cbmp);
bmp.Readvcon(tar);
return bmp;
end
@@ -1319,11 +1319,9 @@ type TPropertyBitmap=class(TPropertyType)
@explan(说明)修改表格数据转换为tmf文件数据 %%
**}
reti := "";
global G_T_BITMAP_;
if d is G_T_BITMAP_ then
cbmp := class(tUIglobalData).uigetdata("G_T_BITMAP_");
if d is cbmp then
begin
echo " \r\nglob bitmap===";
reti := TSlToHexFormatStr(d.tovcon);
end
ret := "{ ";
@@ -1343,14 +1341,14 @@ type TPropertyIcon=class(TPropertyType)
end
function TmfToNode(d);override;
begin
global G_T_ICON_;
if not G_T_ICON_ then return ;
cico := class(tUIglobalData).uigetdata("G_T_ICON_");
if not cico then return ;
if ifstring(d)and d then
begin
dd := HexFormatStrToTsl(d);
if ifarray(dd)then
begin
r := createobject(G_T_ICON_);
r := createobject(cico);
r.Readvcon(dd);
return r;
end
@@ -1362,8 +1360,8 @@ type TPropertyIcon=class(TPropertyType)
@explan(说明)修改表格数据转换为tmf文件数据 %%
**}
reti := "";
global G_T_ICON_;
if G_T_ICON_ and (d is G_T_ICON_) then
cico := class(tUIglobalData).uigetdata("G_T_ICON_");
if cico and (d is cico) then
begin
reti := TSlToHexFormatStr(d.tovcon());
end
@@ -1563,7 +1561,7 @@ type TPropertyAnchors=class(UniObjectMember)
function create();
begin
akTop := 0;
akTop := 1;
akLeft := 1;
akRight := 2;
akBottom := 3;
end
@@ -1995,6 +1993,25 @@ begin
end
return r;
end
function RegComponentPropertyType(v);
begin
//return ;
global g_ComponentPropertyType_a;
if not ifarray(g_ComponentPropertyType_a)then g_ComponentPropertyType_a := array();
if v is class(TPropertyType) then
begin
n := v.EditType();
if n and ifstring(n)then
begin
g_ComponentPropertyType_a[n]:= v; //createobject(v,0);
end
end
end
function GetComponentPropertyType(n);
begin
global g_ComponentPropertyType_a;
if ifstring(n)and ifarray(g_ComponentPropertyType_a)then return g_ComponentPropertyType_a[n];
end
function Sinitlib();
begin
types := array( //"tpropertytype",
@@ -2049,28 +2066,7 @@ begin
end
//注册属性编辑
end
function RegComponentPropertyType(v);
begin
//return ;
global g_ComponentPropertyType_a;
if not ifarray(g_ComponentPropertyType_a)then g_ComponentPropertyType_a := array();
if ifobj(v)then
begin
try
n := v.EditType();
if n and ifstring(n)then
begin
g_ComponentPropertyType_a[n]:= v; //createobject(v,0);
end
except
end;
end
end
function GetComponentPropertyType(n);
begin
global g_ComponentPropertyType_a;
if ifstring(n)and ifarray(g_ComponentPropertyType_a)then return g_ComponentPropertyType_a[n];
end
function InitLib();
begin
static Sinitlib();