4364 lines
110 KiB
Plaintext
4364 lines
110 KiB
Plaintext
unit utslvclauxiliary;
|
||
{**
|
||
@explan(说明) tslvcl 辅助库 %%
|
||
**}
|
||
//20221118 抽象计数锁定对象
|
||
//20220914 移入tire树
|
||
interface
|
||
function iffuncptr(fn);
|
||
function includestate(u,s);
|
||
function excludestate(u,s);
|
||
function makelong(low,high,ptrl);
|
||
function makeposition(x,y);
|
||
function getbitsfrominteger(n,b,e);
|
||
function unsignedtosigned(v,n);
|
||
function signedtounsigned(v,n);
|
||
function lowuperdword(value_,lvalue,uvalue,ptrl);
|
||
function FormatTslData(d,sj,tn);
|
||
function gettemppath();
|
||
function TSL_ReservedKeys2(); //保留关键字
|
||
function parsershortcutstr(s_); //快捷键解析
|
||
function lineintersect(xx1,xx2,xx);
|
||
function formatshortcut(d);
|
||
function getmonthdates(y,m);
|
||
function CallMessgeFunction(f,o,e);
|
||
////////////////////点区域操作//////////////////
|
||
function pointinrect(p,rec);
|
||
function intersectrect(rec1,rec2,irec);
|
||
|
||
function bitcombination(s,v,f);
|
||
function IsTextUTF8(str);
|
||
function exportjsonformat(d,tbw,ct);
|
||
function get_resource_by_name(n,full);
|
||
//****************************
|
||
///////////////////
|
||
function ParserCommandLine(s); //解析命令行参数
|
||
//function FormatTslData(d,sj,tn);
|
||
//function HexStrToTsl(hex);
|
||
//function TslToHexStr(d);
|
||
function TslToHexFormatStr(tsl);
|
||
function HexFormatStrToTsl(D);
|
||
function DeleteAllFiles(path);
|
||
function CreateDirWithFileName(fname);
|
||
function TS_GetUserProfileHome();
|
||
function TS_GetUserProfileHomeInstance(t:integer):string;
|
||
function TS_GetUserConfigHome(t:integer):string;
|
||
function TS_GetHomePath(t:integer):string;
|
||
function TS_ModulePath():string;
|
||
function TS_ExecPath():string;
|
||
function TS_GetAppPath():string;
|
||
function TS_GetIniPath(t:integer;iname:string):string;
|
||
function gettslexefullpath();
|
||
type tuiglobaldata=class() //全局对象存储
|
||
static UIData;
|
||
class Function uisetdata(n,d);
|
||
begin
|
||
InitUiData();
|
||
UIData[n]:= d;
|
||
end
|
||
class function uigetdata(n);
|
||
begin
|
||
InitUiData();
|
||
return UIData[n];
|
||
end
|
||
private
|
||
class function InitUiData();
|
||
begin
|
||
if not ifarray(UIData)then UIData := array();
|
||
end
|
||
end
|
||
type TCharDiscrimi=class() //字符判断
|
||
private
|
||
static CD_SMA;
|
||
static CD_BGA;
|
||
static CD_SMZ;
|
||
static CD_BGZ;
|
||
static CD_UDL;
|
||
static CD_NIN;
|
||
static CD_ZER;
|
||
static CD_ISOK;
|
||
class function sinit();virtual;
|
||
begin
|
||
if not CD_ISOK then
|
||
begin
|
||
CD_ISOK := 1;
|
||
CD_SMA := ord("a");
|
||
CD_BGA := ord("A");
|
||
CD_SMZ := ord("z");
|
||
CD_BGZ := ord("Z");
|
||
CD_UDL := ord("_");
|
||
CD_NIN := ord("9");
|
||
CD_ZER := ord("0");
|
||
end
|
||
end
|
||
public
|
||
function IsLetter(cc);
|
||
begin
|
||
return IsUppercaseLetter(CC)OR IsLowercaseLetter(cc);
|
||
end
|
||
function IsLowercaseLetter(cc);
|
||
begin
|
||
return(cc >= CD_SMA)and(cc <= CD_SMZ);
|
||
end
|
||
function IsUppercaseLetter(cc);
|
||
begin
|
||
return(cc >= CD_BGA)and(cc <= CD_BGZ);
|
||
end
|
||
function IsNumber(cc);
|
||
begin
|
||
return(cc >= CD_ZER)and(cc <= CD_NIN);
|
||
end
|
||
function IsVariableName(s);
|
||
begin
|
||
if ifstring(s)and length(s)>= 1 then
|
||
begin
|
||
cc := ord(s[1]);
|
||
if IsLetter(cc)or cc=CD_UDL then
|
||
begin
|
||
for i := 2 To length(s) do
|
||
begin
|
||
cc := ord(s[i]);
|
||
if not(IsLetter(cc)or IsNumber(cc)or(cc=CD_UDL))then
|
||
begin
|
||
return false;
|
||
end
|
||
end
|
||
return true;
|
||
end
|
||
end
|
||
return 0;
|
||
end
|
||
function IsLowercaseVariableName(s);
|
||
begin
|
||
if ifstring(s)and length(s)>= 1 then
|
||
begin
|
||
cc := ord(s[1]);
|
||
if IsLowercaseLetter(cc)or cc=CD_UDL then
|
||
begin
|
||
for i := 2 To length(s) do
|
||
begin
|
||
cc := ord(s[i]);
|
||
if not(IsLowercaseLetter(cc)or IsNumber(cc)or(cc=CD_UDL))then
|
||
begin
|
||
return false;
|
||
end
|
||
end
|
||
return true;
|
||
end
|
||
end
|
||
return 0;
|
||
end
|
||
function create();
|
||
begin
|
||
sinit();
|
||
end
|
||
end
|
||
type tidcreater=class() //id生成
|
||
{**
|
||
@ignore(忽略)
|
||
**}
|
||
private
|
||
__sid;
|
||
cid;
|
||
Reuseids;
|
||
usedids;
|
||
//protected
|
||
{**
|
||
@explan(说明) 不重复整数id 生成类 %%
|
||
@param(cid)(integer) 当前id值 %%
|
||
@param(Reuseids) (array) 已经回收的id %%
|
||
|
||
**}
|
||
public
|
||
function clean();
|
||
begin
|
||
Reuseids := array();
|
||
cid := __sid;
|
||
end
|
||
function create(sid);
|
||
begin
|
||
{**
|
||
@explan(说明) 构造函数 %%
|
||
@param(sid)(integer) 初始化的id值
|
||
**}
|
||
if ifnumber(sid)then cid := sid;
|
||
else cid := 0;
|
||
__sid := cid;
|
||
usedids := Reuseids := array();
|
||
end
|
||
function createid();
|
||
begin
|
||
{**
|
||
@explan(说明) 构造id %%
|
||
@return(integer) id值 %%
|
||
|
||
**}
|
||
ret := nil;
|
||
for i in Reuseids do
|
||
begin
|
||
if ifnumber(i)then
|
||
begin
|
||
ret := i;
|
||
break;
|
||
end
|
||
end
|
||
if ifnumber(ret)then
|
||
begin
|
||
reindex(Reuseids,array(ret:nil));
|
||
usedids[ret]:= ret;
|
||
return ret;
|
||
end
|
||
cid += 1;
|
||
usedids[cid]:= cid;
|
||
return cid;
|
||
end
|
||
function deleteid(id);
|
||
begin
|
||
{**
|
||
@explan(说明) 不重复整数id 生成类 %%
|
||
@param(id)(integer) 需要回收的id值 %%
|
||
@return(bool) 是否成功
|
||
**}
|
||
if ifnumber(id)then
|
||
begin
|
||
Reuseids[integer(id)]:= id;
|
||
reindex(usedids,array(integer(id):nil));
|
||
return 1;
|
||
end
|
||
return 0;
|
||
end
|
||
function addid(id);
|
||
begin
|
||
if ifnumber(id)and id>0 then
|
||
begin
|
||
cid := max(cid,id);
|
||
usedids[id]:= id;
|
||
end
|
||
end
|
||
end
|
||
type TByteDataOP=class() //位操作类
|
||
{**
|
||
@explan(说明) 位操作封装
|
||
**}
|
||
{**
|
||
@example(范例:byte数组转整数)
|
||
oa := new TByteDataOP();
|
||
echo tostn(oa.bytesasint(array(1,1,1,1)));
|
||
|
||
**}
|
||
{**
|
||
@example(范例:整数转byte数组)
|
||
oa := new TByteDataOP();
|
||
echo tostn(oa.intasbytes(235);
|
||
|
||
**}
|
||
class function BytesAsInt(a);
|
||
begin
|
||
{**
|
||
@explan(说明) 四个byte转换为integer %%
|
||
@param(a)(array) 正式表示的四字节 %%
|
||
@return(integer) 组装好的整数 %%
|
||
**}
|
||
uu := a[0];
|
||
ul := a[1];
|
||
lu := a[2];
|
||
ll := a[3];
|
||
l := makelong(ll,lu,8);
|
||
u := makelong(ul,uu,8);
|
||
return makelong(l,u);
|
||
end
|
||
class function IntAsBytes(v);
|
||
begin
|
||
{**
|
||
@explan(说明) 整数转换为byte 数组(整数数组模拟) %%
|
||
@param(v)(integer) %%
|
||
@return(array) 模拟的byte数组 %%
|
||
**}
|
||
lowuperdword(v,l,u);
|
||
lowuperdword(l,ll,lu);
|
||
lowuperdword(u,ul,uu);
|
||
return array(uu,ul,lu,ll);
|
||
end
|
||
class function ShortsToInt(a);
|
||
begin
|
||
{**
|
||
@explan(说明) 两个short转换为一个int %%
|
||
@param(a)(array) 两个元素的数组 %%
|
||
@return(integer) 整数 %%
|
||
**}
|
||
l := a[1];
|
||
u := a[0];
|
||
return makelong(l,u);
|
||
end
|
||
class function IntToShorts(v);
|
||
begin
|
||
{**
|
||
@explan(说明) 整数转换为两个short 数组(整数数组模拟) %%
|
||
@param(v)(integer) %%
|
||
@return(array) 模拟的short数组 %%
|
||
**}
|
||
lowuperdword(v,l,u);
|
||
return array(l,u);
|
||
end
|
||
class function StrAsBytes(s);
|
||
begin
|
||
{**
|
||
@explan(说明) 字符串转换为byte数组 %%
|
||
@param(s)(string) 字符串 %%
|
||
@return(array) 模拟的byte数组 %%
|
||
**}
|
||
r := array();
|
||
for i := 0 to length(s) do r[i]:= ord(s[i]);
|
||
return r;
|
||
end
|
||
class function BytesAsStr(b);
|
||
begin
|
||
{**
|
||
@explan(说明) byte数组转字符串 %%
|
||
@param(b)(array) byte数组 %%
|
||
@return(string) 字符串
|
||
**}
|
||
r := "";
|
||
for i := 0 to length(b)-1 do r += chr(b[i]);
|
||
return r;
|
||
end
|
||
end
|
||
|
||
//**************************数组链表类******************************************
|
||
type tarray1dlk=class //从0开始
|
||
private
|
||
_len;
|
||
[weakref]FCompareValue;
|
||
protected _data; //数据
|
||
public
|
||
{**
|
||
@explan(说明) 一维链表类 %%
|
||
@param(_len)(integer) 长度 %%
|
||
@param(_data)(array) 数据 %%
|
||
@param(CompareValue)(fpointer) 回调函数 function(v1,v2)begin return v1 = v2 ; end %%
|
||
**}
|
||
function setdata(data);
|
||
begin
|
||
{**
|
||
@explan(说明) 一次性设置数据 %%
|
||
@param(data)(array) 数据 %%
|
||
**}
|
||
_data := data;
|
||
_len := length(data);
|
||
end
|
||
function clean();
|
||
begin
|
||
{**
|
||
@explan(说明) 清空 %%
|
||
**}
|
||
_data := array();
|
||
_len := 0;
|
||
end
|
||
function create(); //构造
|
||
begin
|
||
{**
|
||
@explan(说明) 构造 %%
|
||
**}
|
||
_data := array();
|
||
_len := 0;
|
||
onchangelock := true;
|
||
end
|
||
function CallCompare(v1,v2,f);
|
||
begin
|
||
if iffuncptr(f) then return call(f,v1,v2);
|
||
if iffuncptr(FCompareValue)then return call(FCompareValue,v1,v2);
|
||
return v1=v2;
|
||
end
|
||
function append(v) //追加
|
||
begin
|
||
{**
|
||
@explan(说明) 追加 %%
|
||
@param(v)() tsl数据 %%
|
||
**}
|
||
_data[_len++]:= v;
|
||
dochanged("append");
|
||
end;
|
||
function geti(i); //获取
|
||
begin
|
||
{**
|
||
@explan(说明) 获得 %%
|
||
@param(i)(integer) id %%
|
||
**}
|
||
return _data[i];
|
||
end
|
||
function seti(i,v); //设置值
|
||
begin
|
||
{**
|
||
@explan(说明) 设置值 %%
|
||
@param(i)(integer) id %%
|
||
@param(v)() tsl数据 %%
|
||
**}
|
||
if i >= 0 and i<_len then
|
||
begin
|
||
_data[i]:= v;
|
||
dochanged("set");
|
||
end
|
||
end
|
||
function deli(i); //删除
|
||
begin
|
||
{**
|
||
@explan(说明) 删除 %%
|
||
@param(i)(integer) id %%
|
||
**}
|
||
if i<0 or i >= _len then return 0;
|
||
_len -= 1;
|
||
r := deleteindex(_data,i,1);
|
||
dochanged("del");
|
||
return r;
|
||
end
|
||
function delis(i);
|
||
begin
|
||
{**
|
||
@explan(说明) 批量删除 %%
|
||
@param(i)(array) 删除的id %%
|
||
**}
|
||
dels := getdels(i);
|
||
bkonchangelock := onchangelock;
|
||
onchangelock := true;
|
||
for ii,v in dels do deli(v);
|
||
onchangelock := bkonchangelock;
|
||
dochanged("dels");
|
||
end
|
||
function getdels(i); //删除多行
|
||
begin
|
||
{**
|
||
@ignore (忽略) %%
|
||
@explan(说明) 批量删除 %%
|
||
@param(i)(array) 删除的id %%
|
||
**}
|
||
ii := sselect thisrow from(i union2 array())where(thisrow >= 0 and thisrow<_len)order by thisrow end;
|
||
dels := array();
|
||
ix := 0;
|
||
for iv in ii do
|
||
begin
|
||
dels[iv]:= ii[iv]-ix;
|
||
ix++;
|
||
end
|
||
return dels;
|
||
end
|
||
function insertbefor(v,i); //之前插入
|
||
begin
|
||
{**
|
||
@explan(说明) 在i之前插入 %%
|
||
@param(v)() 插入数据 %%
|
||
@param(i)(integer) id %%
|
||
**}
|
||
if not ifnumber(i)then return;
|
||
if i >= _len then return append(v);
|
||
else if i <= 0 then
|
||
begin
|
||
_data := array(v)union _data;
|
||
end else
|
||
begin
|
||
_data := _data[0:(i-1)]union array(v)union _data[i:];
|
||
end
|
||
_len++;
|
||
end
|
||
function insertafter(v,i); //之后插入
|
||
begin
|
||
{**
|
||
@explan(说明) 在i之后插入 %%
|
||
@param(v)() 插入数据 %%
|
||
@param(i)(integer) id %%
|
||
**}
|
||
if not ifnumber(i)then return;
|
||
if i >= _len then return append(v);
|
||
else if i<0 then
|
||
begin
|
||
_data := array(v)union _data;
|
||
end else
|
||
begin
|
||
_data := _data[0:i]union array(v)union _data[i+1:];
|
||
end
|
||
_len++;
|
||
dochanged("insert");
|
||
end
|
||
function findvid(v1,func,lx); //查找序号,func通过送入的比较函数
|
||
begin
|
||
{**
|
||
@explan(说明) 查找序号和v1 匹配的id %%
|
||
@param(v1)(any) tsl数据 %%
|
||
@param(lx)(bool) 逆序查找 %%
|
||
@param(func)(fpointer) 比较函数 第一个参数为 数组中对象,第二个参数为输入判断条件 %%
|
||
**}
|
||
ret :=-1;
|
||
if lx then
|
||
begin
|
||
for i := length(_data) downto 0 do
|
||
begin
|
||
if CallCompare(_data[i],v1,func)then return i;
|
||
end
|
||
return ret;
|
||
end
|
||
for i,v in _data do
|
||
begin
|
||
if CallCompare(v,v1,func)then
|
||
begin
|
||
return i;
|
||
end
|
||
end
|
||
return ret;
|
||
end
|
||
function getprev(v1); //获得上一个
|
||
begin
|
||
{**
|
||
@explan(说明) 获得上一个 匹配的id %%
|
||
@param(v1)() tsl数据 %%
|
||
**}
|
||
if _len<2 then return nil;
|
||
id :=-1;
|
||
for i,v in _data do
|
||
begin
|
||
if CallCompare(v,v1)then
|
||
begin
|
||
id := i;
|
||
break;
|
||
end
|
||
end
|
||
return _data[id-1];
|
||
end
|
||
function getnext(v1); //获得下一个
|
||
begin
|
||
{**
|
||
@explan(说明) 获得下一个 匹配的id %%
|
||
@param(v1)() tsl数据 %%
|
||
**}
|
||
if _len<2 then return nil;
|
||
id := _len;
|
||
for i,v in _data do
|
||
begin
|
||
if CallCompare(v,v1)then
|
||
begin
|
||
id := i;
|
||
break;
|
||
end
|
||
end
|
||
return _data[id+1];
|
||
end
|
||
function ergodic(f); //循环处理
|
||
begin
|
||
{**
|
||
@explan(说明) 循环所有数据 %%
|
||
@param(f)(fpointer) 处理函数 function(id,v) begin end %%
|
||
**}
|
||
if not iffuncptr(f)then return nil;
|
||
for i,v in _data do
|
||
begin
|
||
ret := call(f,i,v); //## f(i,v);
|
||
if ret=-1 then break;
|
||
end
|
||
return 1;
|
||
end
|
||
function data(); //数组数据
|
||
begin
|
||
{**
|
||
@explan(说明) 返回所有数据 %%
|
||
**}
|
||
return _data;
|
||
end
|
||
function replace(i,v) //替换
|
||
begin
|
||
{**
|
||
@explan(说明) 替换 %%
|
||
@param(i)(integer) 序号 %%
|
||
@param(v)() tsl数据 %%
|
||
**}
|
||
if i >= 0 and i<_len then
|
||
begin
|
||
ret := _data[i];
|
||
_data[i]:= v;
|
||
dochanged("replace");
|
||
return ret;
|
||
end else
|
||
return nil;
|
||
end
|
||
function len(); //大小
|
||
begin
|
||
{**
|
||
@explan(说明) 长度 %%
|
||
**}
|
||
//return length(_data);
|
||
return _len;
|
||
end
|
||
function setorder(i,j);
|
||
begin
|
||
{**
|
||
@explan(说明) 设置元素位置 %%
|
||
@param(i)(integer)原始位置 %%
|
||
@param(j)(integer) 移动后的位置
|
||
**}
|
||
if j>_len-1 then j := _len-1;
|
||
if j<0 then j := 0;
|
||
if i=j or(i<0 or i>_len)then exit; //修改
|
||
sl := createserial(i,j);
|
||
for ii := 0 to length(sl)-2 do
|
||
begin
|
||
SwapNoCheck(sl[ii],sl[ii+1]);
|
||
end
|
||
dochanged("order");
|
||
end
|
||
function swap(i,j); //交换
|
||
begin
|
||
{**
|
||
@explan(说明) 交换 %%
|
||
@param(i)(integer) 序号 %%
|
||
@param(j)(integer) 序号 %%
|
||
**}
|
||
if ifnumber(i)and ifnumber(j)and i <> j and i >= 0 and j >= 0 and i<_len and j<_len then
|
||
begin
|
||
SwapNoCheck(i,j);
|
||
//vi := _data[i];
|
||
//_data[i]:=_data[j];
|
||
//_data[j] := vi;
|
||
end
|
||
dochanged("order");
|
||
end
|
||
property CompareValue read FCompareValue write FCompareValue;
|
||
property onchanged read fonchanged write fonchanged;
|
||
onchangelock;
|
||
private
|
||
function dochanged(info);
|
||
begin
|
||
if onchangelock then return ;
|
||
if fonchanged then CallMessgeFunction(fonchanged,self(true),info);
|
||
end
|
||
function SwapNoCheck(i,j);
|
||
begin
|
||
vi := _data[i];
|
||
_data[i]:= _data[j];
|
||
_data[j]:= vi;
|
||
end
|
||
function createserial(i,j);
|
||
begin
|
||
if j>i then return i -> j;
|
||
r := array();
|
||
kk := 0;
|
||
for ii := i downto j do r[kk++]:= ii;
|
||
return r;
|
||
end
|
||
function moveto(i,j); //将i移动到j前面
|
||
begin
|
||
{**
|
||
@ignore 忽略%%
|
||
@explan(说明) 将i移动到j前面 %%
|
||
@param(i)(integer) 序号 %%
|
||
@param(j)(integer) 序号 %%
|
||
**}
|
||
if not(ifnumber(i)and i >= 0 and i<_len)then return-1;
|
||
if ifnil(j)then j := 0;
|
||
if i=j then return-1;
|
||
vi := geti(i);
|
||
insertbefor(vi,j);
|
||
if i>j then
|
||
begin
|
||
deli(i+1);
|
||
end else
|
||
begin
|
||
deli(i);
|
||
end
|
||
end
|
||
fonchanged;
|
||
end
|
||
type TFpList=class(tarray1dlk)
|
||
{**
|
||
@explan(说明) list类 %%
|
||
**}
|
||
function create();
|
||
begin
|
||
inherited;
|
||
end
|
||
function indexof(v,f,lx);
|
||
begin
|
||
{**
|
||
@explan(说明) 查找值v在序列中的位置 %%
|
||
@param(v)(any) 任何类型 %%
|
||
@return(integer) 位置 ,等于-1 表示没查找到 %%
|
||
**}
|
||
return findvid(v,f,lx);
|
||
end
|
||
function operator[](index);
|
||
begin
|
||
{**
|
||
@explan(说明)获取序号为index的值 %%
|
||
@return(any) 数据 %%
|
||
**}
|
||
return geti(index);
|
||
end
|
||
function add(v);
|
||
begin
|
||
{**
|
||
@explan(说明)追加数据到链表 %%
|
||
@param(v)(any) 数据 %%
|
||
**}
|
||
return append(v);
|
||
end
|
||
function Remove(v);
|
||
begin
|
||
{**
|
||
@explan(说明)删除数据V %%
|
||
@param(v)(any) 数据 %%
|
||
**}
|
||
return deli(indexof(v));
|
||
end
|
||
function last();
|
||
begin
|
||
{**
|
||
@explan(说明)获取最后一个数据 %%
|
||
@return(any) 数据 %%
|
||
**}
|
||
return geti(self.Count()-1);
|
||
end
|
||
function Count();
|
||
begin
|
||
{**
|
||
@explan(说明)获取数据个数 %%
|
||
@return(integer) %%
|
||
**}
|
||
return len();
|
||
end
|
||
end
|
||
|
||
type tstrindexarray = class() //字符串大小写无关下标数组
|
||
{**
|
||
@explan(数组类型) 忽略字符串下标的大小写%%
|
||
**}
|
||
function create();
|
||
begin
|
||
FData := array();
|
||
FRows := array();
|
||
end
|
||
function DeleteIndex(idx);
|
||
begin
|
||
{**
|
||
@explan(说明) 删除指定下标 %%
|
||
**}
|
||
if ifnil(idx) or ifobj(idx)then return 0;
|
||
if ifstring(idx)then
|
||
begin
|
||
lidx := lowercase(idx);
|
||
::deleteindex(FData,lidx,0);
|
||
return ::deleteindex(FRows,lidx,0);
|
||
end
|
||
::deleteindex(FData,idx,0);
|
||
return ::deleteindex(FRows,idx,0);
|
||
end
|
||
function Operator[1](index,value);
|
||
begin
|
||
if ifstring(index)then
|
||
begin
|
||
li := lowercase(index);
|
||
end else
|
||
li := index;
|
||
if ifnone(value)then
|
||
begin
|
||
r := FData[li];
|
||
if r then return r;
|
||
r := new tstrindexarray();
|
||
FData[li]:= r;
|
||
FRows[li]:= index;
|
||
return r;
|
||
end
|
||
FRows[li]:= index;
|
||
if ifarray(value)and value then
|
||
begin
|
||
r := new tstrindexarray();
|
||
FData[li]:= r;
|
||
for i,v in value do
|
||
begin
|
||
r[i]:= v;
|
||
end
|
||
return;
|
||
end
|
||
FData[li]:= value;
|
||
end
|
||
function Operator[](index);
|
||
begin
|
||
if ifstring(index)then r := FData[lowercase(index)];
|
||
else r := FData[index];
|
||
//if ifnil(r) then return NeW tstrindexarray();
|
||
return r;
|
||
end
|
||
function Size();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得长度 %%
|
||
**}
|
||
return Length(FData);
|
||
end
|
||
function toarray(n);
|
||
begin
|
||
{**
|
||
@explan(说明) 获得tsl array %%
|
||
@param(n)(bool) false 返回小写下标，true 返回原始下标 %%
|
||
**}
|
||
r := array();
|
||
for i,v in FData do
|
||
begin
|
||
if v is class(tstrindexarray)then
|
||
begin
|
||
r[n?i:FRows[i]]:= v.toarray(n);
|
||
end else
|
||
r[n?i:FRows[i]]:= v;
|
||
end
|
||
return r;
|
||
end
|
||
function IndexNames();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得 所有下标 %%
|
||
**}
|
||
return FRows;
|
||
end
|
||
function HaveIndex();
|
||
begin
|
||
{**
|
||
@explan(说明) 判断是否有某个下标 %%
|
||
**}
|
||
o := self(true);
|
||
for i := 1 to Paramcount do
|
||
begin
|
||
if not(o is class(tstrindexarray))then return false;
|
||
id := params[i];
|
||
if ifnil(o.TrueIndex(id))then return false;
|
||
o := o[id];
|
||
end
|
||
return true;
|
||
end
|
||
function TrueIndex(n);
|
||
begin
|
||
{**
|
||
@explan(说明) 获得对应下标 %%
|
||
**}
|
||
if ifstring(n)then idx := lowercase(n);
|
||
else idx := n;
|
||
return FRows[idx];
|
||
end
|
||
property Data write SetData;
|
||
function destroy();
|
||
begin
|
||
FData := nil;
|
||
FRows := nil;
|
||
end
|
||
private
|
||
function SetData(d);
|
||
begin
|
||
if not ifarray(d)then return false;
|
||
FRows := array();
|
||
FData := array();
|
||
si := self(true);
|
||
for i,v in d do
|
||
begin
|
||
si[i]:= v;
|
||
end
|
||
return true;
|
||
end
|
||
FData;
|
||
FRows;
|
||
end
|
||
type tnumindexarray = Class() //栈模拟
|
||
{**
|
||
@explan(说明) 数字下标数组对象 %%
|
||
**}
|
||
private
|
||
FData;
|
||
fdlength;
|
||
public
|
||
function Create();virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 构造函数 %%
|
||
**}
|
||
FData := array();
|
||
fdlength := 0;
|
||
end
|
||
function Operator[1](idx,v);
|
||
begin
|
||
{**
|
||
@explan(说明)通过下标设置元素 %%
|
||
**}
|
||
return SetValueByIndex(idx,v);
|
||
end
|
||
function Operator[](idx);
|
||
begin
|
||
{**
|
||
@explan(说明) 通过下标获取元素 %%
|
||
**}
|
||
return GetValueByIndex(idx);
|
||
end
|
||
function length();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得数据长度 %%
|
||
@return(integer) 长度 %%
|
||
**}
|
||
return fdlength;
|
||
end
|
||
function Push({value1,value2,....});
|
||
begin
|
||
{**
|
||
@explan(说明) 在末尾追加元素,参数个数不定 %%
|
||
**}
|
||
return pushs(params);
|
||
end
|
||
function Pop();
|
||
begin
|
||
{**
|
||
@explan(说明) 弹出末尾的元素 %%
|
||
**}
|
||
if FData then
|
||
begin
|
||
id := fdlength-1;
|
||
r := FData[id];
|
||
deleteindex(FData,id);
|
||
fdlength--;
|
||
LengthChanged(-1);
|
||
return r;
|
||
end
|
||
return nil;
|
||
end
|
||
function IndexOf(v);
|
||
begin
|
||
for i,vi in FData do
|
||
begin
|
||
if vi=v then return i;
|
||
end
|
||
return -1;
|
||
end
|
||
function LastIndexOf(v);
|
||
begin
|
||
len := fdlength;
|
||
for i := len-1 downto 0 do
|
||
begin
|
||
if v=FData[i] then return i;
|
||
end
|
||
return -1;
|
||
end
|
||
function GetValueByIndex(idx);virtual;
|
||
begin
|
||
return FData[idx];
|
||
end
|
||
function SetValueByIndex(idx,v);virtual;
|
||
begin
|
||
len := fdlength;
|
||
if not(idx>=0) then return nil;
|
||
if idx <= len then
|
||
begin
|
||
FData[idx]:= v;
|
||
end else
|
||
begin
|
||
for i := len to idx do FData[i]:= nil;
|
||
FData[idx]:= v;
|
||
end
|
||
fdlength := ::length(FData);
|
||
return v;
|
||
end
|
||
function splice({startid,sellength,value1,valfue2,....});
|
||
begin
|
||
p := params;
|
||
return splices(p[0],p[1],p[2:]);
|
||
end
|
||
function shift();
|
||
begin
|
||
{**
|
||
@explan(说明) 弹出头部元素 %%
|
||
**}
|
||
r := nil;
|
||
len := fdlength;
|
||
if len>0 then
|
||
begin
|
||
deleteindex(FData,0);
|
||
fdlength--;
|
||
LengthChanged(-1);
|
||
end
|
||
return len<1?(len):(len-1);
|
||
end
|
||
function unshift({value1,value2,....});
|
||
begin
|
||
{**
|
||
@explan(说明) 在数据头部加入元素,个数待定 %%
|
||
**}
|
||
return unshifts(params);
|
||
end
|
||
function swap(i,j);
|
||
begin
|
||
{**
|
||
@explan(说明) 交换下标中的值 %%
|
||
**}
|
||
if i=j then return false;
|
||
len := fdlength;
|
||
if i >= 0 and i<len and j >= 0 and j<len then
|
||
begin
|
||
t := FData[i];
|
||
FData[i]:= FData[j];
|
||
FData[j]:= t;
|
||
return true;
|
||
end
|
||
return false;
|
||
end
|
||
function pushs(vs);
|
||
begin
|
||
if not(vs) and length(vs) then return r;
|
||
r := fdlength;
|
||
r1 := r;
|
||
FData union=vs;
|
||
r := length(FData);
|
||
//for i,v in vs do //20230724 修改 减少循环
|
||
//begin
|
||
// FData[r]:= v;
|
||
// r++;
|
||
//end
|
||
fdlength := r;
|
||
if r1 <> r then LengthChanged(r1-r);
|
||
return r;
|
||
end
|
||
function unshifts(vs);
|
||
begin
|
||
if ifarray(vs) and vs then
|
||
begin
|
||
FData := vs union FData;
|
||
fdlength := ::length(FData);
|
||
LengthChanged(1);
|
||
end
|
||
return fdlength;
|
||
end
|
||
function splices(startid,sellength,vs);
|
||
begin
|
||
{**
|
||
@explan(说明) 替换元素,第一个参数为开始位置,第二个为替换的个数,以后的参数为用来替换的值,返回被替换的值%%
|
||
**}
|
||
st := startid;
|
||
if not(st>=0) then st := 0;
|
||
sl := sellength;
|
||
sl := ifnil(sl)?inf:sl;
|
||
sl := (sl>=0)?sl:0;
|
||
len := fdlength;
|
||
st := st<0?0:st;
|
||
st := st >= len?(len):st;
|
||
et := st+sl;
|
||
et := et >= len?(len):et;
|
||
r := array();
|
||
r := FData[st:(et-1)];
|
||
r1 := FData[0:st-1];
|
||
r2 := FData[et:len-1];
|
||
if ifarray(vs) and vs then
|
||
begin
|
||
FData := r1 union vs union r2;
|
||
|
||
end else
|
||
begin
|
||
FData := r1 union r2;
|
||
end
|
||
fdlength := ::length(FData);
|
||
if len <> fdlength then LengthChanged(fdlength-len);
|
||
return r;
|
||
end
|
||
function set_len(n); //设置长度
|
||
begin
|
||
if fdlength<>n and n>=0 then
|
||
begin
|
||
ol := fdlength;
|
||
fdlength := n;
|
||
FData := nils(n);
|
||
LengthChanged(n-ol);
|
||
end
|
||
end
|
||
function LengthChanged(n);virtual;
|
||
begin
|
||
end
|
||
property Data read FData;
|
||
{**
|
||
@param(Data)(array) 数据 %%
|
||
**}
|
||
end
|
||
type tnumindexarrayex = class(tnumindexarray)
|
||
{**
|
||
@explan(说明) 扩展模拟数组 %%
|
||
**}
|
||
function create();
|
||
begin
|
||
inherited;
|
||
end
|
||
function Deli(idx);
|
||
begin
|
||
r := splice(idx,1);
|
||
return r?true:false;
|
||
end
|
||
function geti(i);
|
||
begin
|
||
return GetValueByIndex(i);
|
||
end
|
||
function InsertBefor(it,idx);
|
||
begin
|
||
splice(idx,0,it);
|
||
end
|
||
function clean();
|
||
begin
|
||
splice(nil,nil);
|
||
end
|
||
function setorder(i,j);
|
||
begin
|
||
{**
|
||
@explan(说明) 设置元素位置 %%
|
||
@param(i)(integer)原始位置 %%
|
||
@param(j)(integer) 移动后的位置
|
||
**}
|
||
len := count-1;
|
||
if j>len then j := len;
|
||
if j<0 then j := 0;
|
||
if i=j or(i<0 or i>len)then exit;
|
||
d := splice(i,1);
|
||
splice(j,0,d[0]);
|
||
end
|
||
function append(v);
|
||
begin
|
||
Push(v);
|
||
end
|
||
function add(v) ;
|
||
begin
|
||
Push(v);
|
||
end
|
||
function Remove(v);
|
||
begin
|
||
return deli(indexof(v));
|
||
end
|
||
property count read length;
|
||
end
|
||
//ifdef newgetop
|
||
type trefarray = class() //数组成员引用模拟
|
||
function create(d); //构造函数
|
||
begin
|
||
FData := d;
|
||
end
|
||
function mgset(idxs,v); //根据下标设置值
|
||
begin
|
||
return domgset(FData,idxs,v);
|
||
end
|
||
function mgget(idxs); //根据获得值
|
||
begin
|
||
return domgget(fdata,idxs);
|
||
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
|
||
published
|
||
property data read FData write setdata;
|
||
protected
|
||
function setdata(d);virtual;
|
||
begin
|
||
if FData<>d then
|
||
begin
|
||
FData := d;
|
||
return true;
|
||
end
|
||
end
|
||
function domgget(d,idxs);virtual; //根据获得值
|
||
begin
|
||
if not ifarray(idxs) then return nil;
|
||
if ifarray(d) then
|
||
begin
|
||
if ifarrayidx(idxs) then
|
||
begin
|
||
return eval(&("d"+formatarrayidx(idxs)));
|
||
end
|
||
return magicgetarray(d,idxs);
|
||
end
|
||
if d is class(trefarray) then return d.mgget(idxs,v);
|
||
end
|
||
function domgset(d,idxs,v);virtual; //根据下标设置值
|
||
begin
|
||
if not ifarray(idxs) then return nil;
|
||
if ifarray(d) then
|
||
begin
|
||
if ifarrayidx(idxs) then
|
||
begin
|
||
fsettemp := v;
|
||
s := "d"+formatarrayidx(idxs)+":=fsettemp;";
|
||
r := eval(&(s));
|
||
fsettemp := nil;
|
||
return r;
|
||
end
|
||
return magicsetarray(d, idxs,v);
|
||
end
|
||
if d is class(trefarray) then return d.mgset(idxs,v);
|
||
return nil;
|
||
end
|
||
function ifarrayidx(idx);
|
||
begin
|
||
for i,v in idx do
|
||
begin
|
||
if ifarray(v) then return true;
|
||
end
|
||
end
|
||
function formatarrayidx(idx);
|
||
begin
|
||
r := "[";
|
||
len := length(idx)-1;
|
||
for i ,v in idx do
|
||
begin
|
||
if ifarray(v) then r+=tostn(v);
|
||
else r+=tostn(v);
|
||
if i<len then
|
||
begin
|
||
r+=",";
|
||
end
|
||
end
|
||
r+="]";
|
||
return r;
|
||
end
|
||
FData; //原始数据
|
||
private //成员变量
|
||
fsettemp;
|
||
private
|
||
|
||
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;
|
||
FId;
|
||
class function sinit();
|
||
begin
|
||
if not ifarray(FValues)then FValues := array();
|
||
end
|
||
public
|
||
class function getvalue(id);
|
||
begin
|
||
sinit();
|
||
r := FValues[inttostr(id)];
|
||
//if r then reindex(FValues,id);
|
||
return r;
|
||
end
|
||
function Create(id,value);
|
||
begin
|
||
sinit();
|
||
tid := inttostr(id);
|
||
FOld := FValues[tid];
|
||
if not ifnil(FOld)then raise "全局变量冲突!";
|
||
FId := tid;
|
||
FValues[tid]:= value;
|
||
end
|
||
function destroy();
|
||
begin
|
||
reindex(FValues,array(FId:nil));
|
||
end
|
||
end
|
||
type TArrayTreeClass = class() //数组到树的转换
|
||
{**
|
||
@explan(说明) 树形类 %%
|
||
@param(FIdName)(integer | string) id名称 %%
|
||
@param(FPIdName)(integer | string) 父节点名称 %%
|
||
**}
|
||
{**
|
||
@example(转换范例) %%
|
||
d := array(("id":1,"pid":5,"caption":"jd1"),
|
||
("id":4,"pid":2,"caption":"jd2"),
|
||
("id":2,"pid":1,"caption":"jd3"),
|
||
("id":3,"pid":2,"caption":"jd4"),
|
||
("id":5,"pid":7,"caption":"jd5"),
|
||
);
|
||
dt := class(TArrayTreeClass).ToTreeArray(d,array("id":"id","pid":"pid","sub":"sub"));
|
||
return dt;
|
||
**}
|
||
private
|
||
class function ClumnNameOk(id);
|
||
begin
|
||
return ifnumber(id) or ifstring(id) ;
|
||
end
|
||
static FCounter;
|
||
static FIdName;
|
||
Static FPIdName;
|
||
static FSubName;
|
||
static FSInToArray;
|
||
FRecyce;
|
||
FInToArray;
|
||
FComponents; //节点
|
||
FId; //id
|
||
FValue; //数据
|
||
class function initconter();
|
||
begin
|
||
FCounter := 1;
|
||
end
|
||
class function GetCounter();
|
||
begin
|
||
return FCounter++;
|
||
end
|
||
public
|
||
class function SetIdName(id,pid,sub);
|
||
begin
|
||
if(id <> pid)and(ifstring(id)or ifnumber(id))and(ifstring(pid)or ifnumber(pid))and(ifstring(sub)or ifnumber(sub))then
|
||
begin
|
||
FIdName := id;
|
||
FPIdName := pid;
|
||
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 TNode = class() //树节点
|
||
{**
|
||
@explan(说明) 树结点 %%
|
||
**}
|
||
private
|
||
FItems; //子项
|
||
[weakref]FParent; //父节点
|
||
public
|
||
function Create();virtual;
|
||
begin
|
||
inherited;
|
||
FExpanded := true;
|
||
FItems := new TFpList(); //子项
|
||
end
|
||
function CreateNode();virtual;
|
||
begin
|
||
return CreateObject(self(true).Classinfo(1));
|
||
end
|
||
function CreateNodeAndAppend();virtual; //构造并追加
|
||
begin
|
||
nd := CreateNode();
|
||
AppendNode(nd);
|
||
return nd;
|
||
end
|
||
function GetNodeByIndex(idx);
|
||
begin
|
||
{**
|
||
@explan(说明) 通过序号获得子节点%%
|
||
@param(idx)(TNode) %%
|
||
**}
|
||
if idx >= 0 then return FItems[idx];
|
||
return nil;
|
||
end
|
||
function indexof(v); //获得序号
|
||
begin
|
||
return FItems.indexof(v);
|
||
end
|
||
function GetIndex();virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 获得在父节点中的序号 %%
|
||
@return(integer) 序号 %%
|
||
**}
|
||
if Parent then Parent.indexof(self);
|
||
end
|
||
function AppendNode(it);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 插入一个节点 %%
|
||
@param(it)(TNode) 节点 %%
|
||
@return(bool) 是否成功 %%
|
||
**}
|
||
return InsertNode(it,FItems.Count);
|
||
end
|
||
function HasNode(nd);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 是否为某个节点的祖先节点 %%
|
||
@param(nd)(TNode) 子节点 %%
|
||
@return(TNode|0) 如果为祖先节点,就返回查询节点的父节点 %%
|
||
**}
|
||
if not(nd is class(TNode))then return 0;
|
||
p1 := nd.Parent;
|
||
p := p1;
|
||
while p do
|
||
begin
|
||
if p=self then return p1;
|
||
if p is class(TNode)then p := p.Parent;
|
||
end
|
||
return 0;
|
||
end
|
||
function DeleteNode(nd);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 删除节点 %%
|
||
@param(nd)(TNode) 待删除节点 %%
|
||
**}
|
||
if nd=self then return 0;
|
||
pn := HasNode(nd);
|
||
if not pn then return;
|
||
return pn.DeleteChildNode(nd);
|
||
end
|
||
function DeleteChildNode(nd);
|
||
begin
|
||
{**
|
||
@explan(说明) 删除子节点%%
|
||
@param(nd)(TNode) 节点 %%
|
||
**}
|
||
idx :=-1;
|
||
idx := indexof(nd);
|
||
if idx=-1 then return 0;
|
||
return DeleteNodeByIndex(idx);
|
||
end
|
||
function DeleteNodeByIndex(idx);
|
||
begin
|
||
{**
|
||
@explan(说明) 根据位置删除节点%%
|
||
@param(idx)(integer) 序号 %%
|
||
**}
|
||
nd := FItems[idx];
|
||
if not nd then return;
|
||
//是否显示处理
|
||
FItems.Deli(idx);
|
||
CurrentDeleteNode := nd;
|
||
nd.parent := self(true);
|
||
CurrentDeleteNode := nil;
|
||
return true;
|
||
end
|
||
function DeleteChildren();virtual; //
|
||
begin
|
||
{**
|
||
@explan(说明) 删除所有的子节点%%
|
||
**}
|
||
while NodeCount>0 do
|
||
begin
|
||
idx := 0;
|
||
it := FItems[idx];
|
||
CurrentDeleteNode := it;
|
||
it.parent := self(true);
|
||
CurrentDeleteNode := nil;
|
||
FItems.Deli(idx);
|
||
end
|
||
end
|
||
function InsertNodes(its,idx);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 插入一个节点 %%
|
||
@param(it)( array of TNode) 字符串 %%
|
||
@param(idx)(integer) 序号 默认为0 %%
|
||
**}
|
||
idx0 := idx;
|
||
if idx<0 then idx0 := 0;
|
||
if idx>FItems.Count then idx0 := FItems.Count;
|
||
bidx := idx0;
|
||
for i,it in its do
|
||
begin
|
||
if(it is class(TNode))and(not it.Parent)then
|
||
begin
|
||
FItems.InsertBefor(it,idx0);
|
||
CurrentAddNode := it;
|
||
it.Parent := self(true);
|
||
CurrentAddNode := nil;
|
||
idx0++;
|
||
end
|
||
end
|
||
end
|
||
function InsertNode(it,idx);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 插入一个节点 %%
|
||
@param(it)(TNode) 字符串 %%
|
||
@param(idx)(integer) 序号 默认为0 %%
|
||
**}
|
||
if(it is class(TNode))and(not it.Parent)then
|
||
begin
|
||
if idx<0 then idx := 0;
|
||
if idx>FItems.Count then idx := FItems.Count;
|
||
if not(idx >= 0)then idx := 0;
|
||
FItems.InsertBefor(it,idx);
|
||
CurrentAddNode := it;
|
||
it.Parent := self(true);
|
||
CurrentAddNode := nil;
|
||
return true;
|
||
end
|
||
end
|
||
function Expand();virtual; //展开
|
||
begin
|
||
FExpanded := true;
|
||
end
|
||
function UnExpand();virtual; //折叠
|
||
begin
|
||
FExpanded := false;
|
||
end
|
||
function RecyclingChildren();virtual;
|
||
begin
|
||
while NodeCount>0 do
|
||
begin
|
||
it := FItems[0];
|
||
it.Recycling();
|
||
end
|
||
end
|
||
function Recycling();virtual;
|
||
begin
|
||
p := FParent;
|
||
if p then
|
||
begin
|
||
p.DeleteNode(self);
|
||
end
|
||
while NodeCount>0 do
|
||
begin
|
||
it := FItems[0];
|
||
it.Recycling();
|
||
end
|
||
//inherited;
|
||
end
|
||
property NodeCount read GetNodeCount; //节点数
|
||
property Expanded read FExpanded write SetExpand; //展开
|
||
property Parent read FParent write SetParent; //父节点
|
||
property LastChild read GetLstChild;
|
||
{**
|
||
@param(NodeCount)(integer) 子节点数量 %%
|
||
@param(Expanded)(bool) 是否展开 %%
|
||
@param(Parent)(TNode) 父节点 %%
|
||
**}
|
||
protected
|
||
property CurrentDeleteNode read FCurrentDeleteNode write FCurrentDeleteNode;
|
||
property CurrentAddNode read FCurrentAddNode write FCurrentAddNode;
|
||
{**
|
||
@ignoremembers(CurrentDeleteNode,CurrentAddNode)
|
||
**}
|
||
function SetParent(V);virtual;
|
||
begin
|
||
tp := Parent;
|
||
if v=tp then return;
|
||
if(v is class(TNode))then
|
||
begin
|
||
if v.CurrentAddNode=self then
|
||
begin
|
||
FParent := v; //新节点
|
||
end else
|
||
if v.CurrentDeleteNode=self then //从节点移除
|
||
begin
|
||
FParent := nil;
|
||
end else
|
||
begin
|
||
if tp=v then return;
|
||
if tp then
|
||
begin
|
||
tp.DeleteNode(self(true));
|
||
end
|
||
v.InsertNode(self(true),v.NodeCount);
|
||
end
|
||
end else
|
||
begin
|
||
if tp then tp.DeleteNode(self(true));
|
||
end
|
||
end
|
||
private
|
||
function GetLstChild();
|
||
begin
|
||
return FItems[FItems.Count-1];
|
||
end
|
||
FCurrentDeleteNode;
|
||
FCurrentAddNode;
|
||
FExpanded;
|
||
function SetExpand(v);virtual; //已经展开
|
||
begin
|
||
if v then Expanded();
|
||
else UnExpand();
|
||
end
|
||
function GetNodeCount(); //子节点数
|
||
begin
|
||
return FItems.Count;
|
||
end
|
||
end
|
||
type TTire = class()
|
||
{**
|
||
@explan(说明) tire树
|
||
**}
|
||
type TTireNode = class()
|
||
FChar;
|
||
FSub;
|
||
FEnd;
|
||
Ficase;
|
||
_tag;
|
||
function Create(v);
|
||
begin
|
||
FChar := v;
|
||
FSub := array();
|
||
FEnd := false;
|
||
Ficase := false;
|
||
end
|
||
function Add(s);
|
||
begin
|
||
v0 := s[1];
|
||
if Ficase then v0 := lowercase(v0);
|
||
vsub := FSub[v0];
|
||
if not vsub then
|
||
begin
|
||
vsub := new TTireNode(v0);
|
||
vsub.Ficase := Ficase;
|
||
FSub[v0] := vsub;
|
||
end
|
||
ls := length(s);
|
||
if ls>1 then
|
||
return vsub.Add(s[2:]);
|
||
else
|
||
begin
|
||
vsub.FEnd := true;
|
||
return vsub;
|
||
end
|
||
end
|
||
function Find(s,slen,idx);
|
||
begin
|
||
if idx>slen then return FEnd;
|
||
v0 := s[idx];
|
||
if Ficase then v0 := lowercase(v0);
|
||
vsub := FSub[v0];
|
||
if vsub then
|
||
begin
|
||
idx++;
|
||
return vsub.Find(s,slen,idx);
|
||
end
|
||
return FEnd ;
|
||
end
|
||
function find_node(s,slen,idx);
|
||
begin
|
||
if idx>slen then return (FEnd?self:0);
|
||
v0 := s[idx];
|
||
if Ficase then v0 := lowercase(v0);
|
||
vsub := FSub[v0];
|
||
if vsub then
|
||
begin
|
||
idx++;
|
||
return vsub.find_node(s,slen,idx);
|
||
end
|
||
return (FEnd?self:0);
|
||
end
|
||
function seticase(i);
|
||
begin
|
||
ni := i?true:false;
|
||
if ni<>Ficase then
|
||
begin
|
||
Ficase := ni;
|
||
for i,v in mrows(FSub,1) do
|
||
begin
|
||
vi := FSub[v];
|
||
if ni then //忽略大小写
|
||
begin
|
||
reindex(FSub,array(v:nil));
|
||
FSub[lowercase(vi.FChar)] := vi;
|
||
end else //区分大小写
|
||
begin
|
||
reindex(FSub,array(v:nil));
|
||
FSub[vi.FChar] := vi;
|
||
end
|
||
vi.seticase(i);
|
||
end
|
||
end
|
||
end
|
||
end
|
||
function Add(s);
|
||
begin
|
||
return FRoot.Add(s);
|
||
end
|
||
function Create();
|
||
begin
|
||
fignorecase := false;
|
||
FRoot := new TTireNode();
|
||
FRoot.Ficase := false;
|
||
end
|
||
function find_node(s,oidx);
|
||
begin
|
||
oidx := 1;
|
||
return FRoot.find_node(s,length(s),oidx);
|
||
end
|
||
function Find(s,slen,idx,outidx,ostr);
|
||
begin
|
||
tid := idx;
|
||
r := FRoot.Find(s,slen,idx);
|
||
if r then
|
||
begin
|
||
ostr := s[tid:idx-1];
|
||
outidx := idx;
|
||
end
|
||
idx := tid;
|
||
return r;
|
||
end
|
||
FRoot;
|
||
property ignorecase read fignorecase write setignorecase;
|
||
private
|
||
function setignorecase(i);
|
||
begin
|
||
ni := i?true :false;
|
||
if ni<>fignorecase then
|
||
begin
|
||
FRoot.seticase(ni);
|
||
end
|
||
end
|
||
fignorecase;
|
||
end
|
||
type tpairstate =class //括号状态
|
||
function Create(t);
|
||
begin
|
||
FType := ifstring(t)?t:"";
|
||
FCJ := 0;
|
||
FState := 0;
|
||
FIndexs := array(0);
|
||
FIndex := 0;
|
||
FCstate := false;
|
||
FSubcount := array(0);
|
||
end
|
||
function subitemadd();
|
||
begin
|
||
FSubcount[FIndex]++;
|
||
end
|
||
function subitemcount();
|
||
begin
|
||
return FSubcount[FIndex];
|
||
end
|
||
function GetLeft();
|
||
begin
|
||
FCstate := true;
|
||
if FState then // 上一个是左括号
|
||
begin
|
||
FCJ++;
|
||
FIndex++;
|
||
FIndexs[FIndex]:=0;
|
||
end else //上一个非左括号
|
||
begin
|
||
FIndexs[FIndex]++;
|
||
FSubcount[FIndex]:=0;
|
||
end
|
||
FState := true;
|
||
end
|
||
function GetRight();
|
||
begin
|
||
FCstate := true;
|
||
//if FCJ=0 then return ;
|
||
if FState then // 上一个是左括号
|
||
begin
|
||
|
||
//FIndexs[FIndex]++;
|
||
end else //上一个非左括号
|
||
begin
|
||
if FCJ>0 then
|
||
begin
|
||
FCJ--;
|
||
DeleteIndex(FIndexs,FIndex);
|
||
FIndex--;
|
||
end else
|
||
begin
|
||
FCstate := false;
|
||
end
|
||
end
|
||
FState := false;
|
||
end
|
||
function GetSate();
|
||
begin
|
||
if FCstate then
|
||
begin
|
||
//return inttostr(FIndexs[FCJ])+FType;
|
||
return tostn(FIndexs)+FType;// inttostr(FCJ)+"+"+inttostr(FIndexs[FIndex])+FType; length(FIndexs)+FType ;//
|
||
end
|
||
end
|
||
function Show();
|
||
begin
|
||
echo "层级:",FCJ," 序号:",FIndexs[FIndex],"状态:", FCstate;
|
||
end
|
||
property state read FState;
|
||
function Clone();
|
||
begin
|
||
r := new tpairstate(FType);
|
||
r.FCstate := FCstate;
|
||
r.FState := FState;
|
||
r.FCJ := FCJ;
|
||
r.FIndexs := FIndexs;
|
||
r.FIndex := FIndex;
|
||
r.FSubcount := FSubcount;
|
||
return r;
|
||
end
|
||
protected
|
||
FCstate;
|
||
FState;
|
||
FCJ;
|
||
FIndexs;
|
||
FSubcount;
|
||
FIndex;
|
||
FType;
|
||
|
||
end
|
||
type TIniFileExter=class()
|
||
{**
|
||
@explan(说明) ini文件读写封装 %%
|
||
**}
|
||
private
|
||
FTStringa;
|
||
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();
|
||
begin
|
||
{**
|
||
@explan(说明) 构造函数 %%
|
||
@param(al)(string) 别名 %%
|
||
@param(name)(string) 文件名 %%
|
||
**}
|
||
FTStringa := new TStringlist();
|
||
FAlias := "";
|
||
ffilename := "";
|
||
|
||
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
|
||
finiobj := nil;
|
||
FTStringa := nil;
|
||
end
|
||
property VType read FVtype write FVtype;
|
||
property LowerKey read FLowerKey write FLowerKey;
|
||
property LowerValue read FLowerValue write FLowerValue;
|
||
property Alias read FAlias write setalias; //目录别名
|
||
property filename read ffilename write setfilename; //文件名
|
||
_tag;
|
||
private
|
||
property Fini read getiniobj write finiobj;
|
||
private
|
||
function getiniobj();
|
||
begin
|
||
if not(finiobj) then
|
||
begin
|
||
if ifstring(FAlias) and ifstring(ffilename) then
|
||
begin
|
||
finiobj := new TIniFile(FAlias,ffilename);
|
||
end else
|
||
begin
|
||
raise "ini读写文件错误";
|
||
end
|
||
end
|
||
return finiobj;
|
||
end
|
||
function setfilename(v);
|
||
begin
|
||
if ifstring(v) and v<>ffilename then
|
||
begin
|
||
ffilename := v;
|
||
finiobj := nil;
|
||
end
|
||
end
|
||
function setalias(v);
|
||
begin
|
||
if ifstring(v) and v<>FAlias then
|
||
begin
|
||
FAlias := v;
|
||
finiobj := nil;
|
||
end
|
||
end
|
||
FAlias;
|
||
ffilename;
|
||
finiobj;
|
||
end
|
||
type TCanvsRgnClipAutoSave=class()
|
||
{**
|
||
@expan(说明) 裁剪canvas区域,销毁时还原 %%
|
||
**}
|
||
function Create(cvs,rec);
|
||
begin
|
||
{**
|
||
@explan(说明)构造裁剪对象 %%
|
||
@param(cvs)(tcustomcanvas) canvas 对象 %%
|
||
@param(rec)(array(左上右下))区域 %%
|
||
**}
|
||
if(ifobj(cvs))and cvs.HandleAllocated()and ifarray(rec)then
|
||
begin
|
||
FW32api := cvs._wapi;
|
||
FCvsHandle := cvs.Handle;
|
||
FCrg := FW32api.CreateRectRgn(rec[0],rec[1],rec[2],rec[3]);
|
||
FBKrg := FW32api.SelectClipRgn(FCvsHandle,FCrg); //裁剪区域
|
||
end
|
||
end
|
||
function Destroy();
|
||
begin
|
||
if FW32api and FCvsHandle and FBKrg and FCrg then
|
||
begin
|
||
FW32api.SelectClipRgn(FCvsHandle,FBKrg); //恢复区域
|
||
FW32api.DeleteObject(FCrg); //销毁区域
|
||
end
|
||
FW32api := nil;
|
||
end
|
||
private
|
||
FBKrg;
|
||
FCrg;
|
||
FCvsHandle;
|
||
FW32api;
|
||
end
|
||
type tcountkernel = class() //锁计数对象
|
||
function create();
|
||
begin
|
||
Flocked := 0;
|
||
end
|
||
function add();
|
||
begin
|
||
Flocked++;
|
||
end
|
||
function del();
|
||
begin
|
||
Flocked--;
|
||
end
|
||
property locked read Flocked;
|
||
private
|
||
Flocked;
|
||
end
|
||
type tcountlocker = class() //锁对象
|
||
function create(v);
|
||
begin
|
||
if v is class(tcountkernel) then
|
||
begin
|
||
fkernel := v;
|
||
fkernel.add();
|
||
end
|
||
end
|
||
function destroy();
|
||
begin
|
||
if fkernel then fkernel.del();
|
||
end
|
||
private
|
||
fkernel;
|
||
end
|
||
//////////////////////字符串文件读取累//////////////////////////////////
|
||
type tfileer_rwraw = class() //字符串文件类型
|
||
{**
|
||
@explan(说明)字符串文件类型,load save,local_changed_check,data %%
|
||
**}
|
||
function create();
|
||
begin
|
||
ffilename := "";
|
||
fAlias := "";
|
||
fdatachanged := false;
|
||
inputchanged();
|
||
end
|
||
function load();//加载
|
||
begin
|
||
if not(ifstring(ffilename) and fileexists("",ffilename)) then return 0; //文件名不存在
|
||
p := 0;
|
||
len := filesize(fAlias,ffilename);
|
||
tm := filetime(fAlias,ffilename);
|
||
if not fdatachanged then //对象数据修改了
|
||
begin
|
||
if (len=flen) and (tm=floadtime) then return 1; //大小时间没变
|
||
end
|
||
if 1 = readfile(rwraw(),fAlias,ffilename,p,len,d) then //读文件
|
||
begin
|
||
fdata := d;
|
||
flen := len;
|
||
floadtime := tm;
|
||
floaded := true;
|
||
fdatachanged := false;
|
||
return 1;
|
||
end
|
||
end
|
||
function del();//删除
|
||
begin
|
||
if not(ifstring(ffilename) and ffilename) then return 0;
|
||
if fileexists(fAlias,ffilename) then return true;
|
||
return filedelete(fAlias,ffilename)<>1;
|
||
end
|
||
function save(); //保存
|
||
begin
|
||
if not(ifstring(ffilename) and ffilename) then return 0;
|
||
if fileexists(fAlias,ffilename) then
|
||
begin
|
||
tm := filetime(fAlias,ffilename);
|
||
if tm=floadtime then return 1;
|
||
sz := filesize(fAlias,ffilename);
|
||
if sz>length(fdata) then
|
||
begin
|
||
if filedelete(fAlias,ffilename)<>1 then return 0;
|
||
if length(fdata)=0 then
|
||
begin
|
||
return true;
|
||
end
|
||
end else
|
||
begin
|
||
p := 0;
|
||
if 1 = readfile(rwraw(),fAlias,ffilename,p,sz,d) then
|
||
begin
|
||
if fdata=d then
|
||
begin
|
||
return 1;
|
||
end
|
||
end
|
||
end
|
||
end else
|
||
begin
|
||
exportfile(ftstring(),fAlias,ffilename,"");
|
||
end
|
||
if 1=writefile(rwraw(),fAlias,ffilename,0,length(fdata),fdata) then
|
||
begin
|
||
floadtime := filetime(fAlias,ffilename);
|
||
flen := length(fdata);
|
||
floaded := true;
|
||
fdatachanged := false;
|
||
return true;
|
||
end
|
||
return false;
|
||
end
|
||
function local_changed_check(); //本地文件是否从修改后发生改变
|
||
begin
|
||
if floaded then
|
||
begin
|
||
if fileexists(fAlias,ffilename) then
|
||
begin
|
||
if floadtime<>filetime(fAlias,ffilename) then
|
||
begin
|
||
return 1; //改变
|
||
end
|
||
end else
|
||
begin
|
||
return 2; //删除
|
||
end
|
||
end
|
||
end
|
||
property fname read ffilename write setfilename;//文件名
|
||
property Alias read fAlias write fAlias; //目录别名
|
||
property data read getdata write setdata; //数据集
|
||
property ftime read floadtime;//
|
||
private
|
||
fAlias;
|
||
floadtime;
|
||
ffilename;
|
||
flen;
|
||
fdata;
|
||
fleadload;
|
||
fdatachanged;
|
||
private
|
||
function getdata();
|
||
begin
|
||
return fdata;
|
||
end
|
||
function setdata(s);//设置数据
|
||
begin
|
||
if ifstring(s) and s<>fdata then
|
||
begin
|
||
inputchanged();
|
||
fdata := s;
|
||
fdatachanged := true;
|
||
end
|
||
end
|
||
function setalias(s);
|
||
begin
|
||
if ifstring(s) and s<>fAlias then
|
||
begin
|
||
fAlias := s;
|
||
inputchanged();
|
||
end
|
||
end
|
||
function setfilename(f); //修改文件名
|
||
begin
|
||
if f<>ffilename then //文件改变
|
||
begin
|
||
ffilename := f;
|
||
inputchanged();
|
||
end
|
||
end
|
||
function inputchanged();//输入改变
|
||
begin
|
||
fdata := "";
|
||
flen := "";
|
||
floadtime := 0;
|
||
floaded := false;
|
||
end
|
||
|
||
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 := inttostr(int64(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 := inttostr(int64(f));
|
||
h := fhandles[id];
|
||
if h then
|
||
begin
|
||
r := deleteinstance(h);
|
||
reindex(fhandles,array(id:nil));
|
||
return r;
|
||
end
|
||
end
|
||
private
|
||
fhandles;
|
||
end
|
||
type tstr_step_match=class()
|
||
{**
|
||
@explan(说明)字符串数组匹配 %%
|
||
**}
|
||
private
|
||
const find_end="end";
|
||
public
|
||
function create(its); //送入匹配的字符串数组
|
||
begin
|
||
fits := array();
|
||
fcaches := array();
|
||
fcaches[""] := array();
|
||
set_items(its);
|
||
end
|
||
function step_find_idx(s:string); //匹配的序号
|
||
begin
|
||
{**
|
||
@explan(说明)匹配字符串 %%
|
||
@param(s)(string) 匹配的目标 %%
|
||
@return(array of integer) 成功的位置 %%
|
||
**}
|
||
if fcaches[s] then return fcaches[s]; //完全
|
||
osi := fcaches[""];
|
||
for i:= 1 to length(s) do
|
||
begin
|
||
si := s[1:i];
|
||
if fcaches[si] then
|
||
begin
|
||
osi := fcaches[si];
|
||
continue;
|
||
end
|
||
osi := get_same_idexs(si,osi);
|
||
if not ifarray(osi) then osi := array();
|
||
fcaches[si] := osi;
|
||
end
|
||
return fcaches[s];
|
||
end
|
||
function step_find(s); //查找匹配的字符
|
||
begin
|
||
return fits[step_find_idx(s)];
|
||
end
|
||
function set_items(its); //设置查找数据
|
||
begin
|
||
if fits<> its and check_legal(its) then
|
||
begin
|
||
fits := its;
|
||
fcaches := array();
|
||
fcaches[""] := mrows(fits,1);
|
||
end
|
||
end
|
||
private
|
||
function get_same_idexs(si,idxs);virtual; //直接判断全部
|
||
begin
|
||
asi := array();
|
||
asidx := 0;
|
||
for ii,v in idxs do
|
||
begin
|
||
if checksame(si,v) then
|
||
begin
|
||
asi[asidx++] := v;
|
||
end
|
||
end
|
||
return asi;
|
||
end
|
||
function checksame(a,b);virtual;//判断相等
|
||
begin
|
||
return pos(a,fits[ b]);
|
||
end
|
||
function check_legal(its);virtual; //合法检查
|
||
begin
|
||
return ifarray(its);
|
||
end
|
||
protected
|
||
fits; //原始数据
|
||
fcaches;
|
||
fcacheslen;
|
||
private
|
||
end
|
||
type t_ini_format_operator=class()
|
||
static const type_section=1;
|
||
static const type_skey=2;
|
||
static const type_value=3;
|
||
function create();
|
||
begin
|
||
fscript := "";
|
||
factidx := 0;
|
||
fscriptlen := 0;
|
||
fdata := array();
|
||
ffirstchar := true;
|
||
fformatdata := array();
|
||
end
|
||
function read_sections();
|
||
begin
|
||
formatini();
|
||
r := array();
|
||
idx := 0;
|
||
for i,v in fformatdata do
|
||
begin
|
||
r[idx++] := v['n'];
|
||
end
|
||
return r;
|
||
end
|
||
function read_section_values(sn);
|
||
begin
|
||
formatini();
|
||
d := fformatdata[lowercase(sn),"d"];
|
||
r := array();
|
||
if d then
|
||
begin
|
||
idx := 0;
|
||
for i,v in d do
|
||
begin
|
||
r[idx++] := v[array('k',"v")];//array("name":v['k'],"value":v["v"]);
|
||
end
|
||
end
|
||
return r;
|
||
end
|
||
function read_key(sn,key);
|
||
begin
|
||
formatini();
|
||
d := fformatdata[lowercase(sn),"d",lowercase(key),"v"];
|
||
return d;
|
||
end
|
||
function write_key(sn,key,v);
|
||
begin
|
||
formatini();
|
||
d := fformatdata[lowercase(sn)];
|
||
if d then
|
||
begin
|
||
info := fformatdata[lowercase(sn),"d",lowercase(key)] ;
|
||
if info then
|
||
begin
|
||
s := fscript;
|
||
s[info["b"]:info["e"]] := formatkv(key,v);
|
||
//script := s;
|
||
setscript(s);
|
||
end else
|
||
begin
|
||
s := fscript;
|
||
s[d["e"]:-1] := "\r\n"+formatkv(key,v);
|
||
//script := s;
|
||
setscript(s);
|
||
end
|
||
end else
|
||
begin
|
||
s := "["+sn+"]\r\n"+formatkv(key,v)+"\r\n"+fscript;
|
||
//script := s;
|
||
setscript(s);
|
||
end
|
||
end
|
||
function delete_key(sn,key);
|
||
begin
|
||
formatini();
|
||
info := fformatdata[lowercase(sn),"d",lowercase(key)] ;
|
||
if info then
|
||
begin
|
||
s := fscript;
|
||
s[info["b"]:info["e"]] := "";
|
||
setscript(s);
|
||
end
|
||
end
|
||
function delete_section(sn); //移除
|
||
begin
|
||
formatini();
|
||
d := fformatdata[lowercase(sn)];
|
||
if d then
|
||
begin
|
||
b := d["b"];
|
||
e := d["e"];
|
||
s := fscript;
|
||
s[b:e]:="";
|
||
setscript(s);
|
||
end
|
||
end
|
||
function rename_section(sn1,sn2);
|
||
begin
|
||
formatini();
|
||
d := fformatdata[lowercase(sn1)];
|
||
if d then
|
||
begin
|
||
s := fscript;
|
||
s[d["b"]:d["e2"]]:= "["+sn2+"]";
|
||
setscript(s);
|
||
end
|
||
end
|
||
function rename_key(sn,key,nkey);
|
||
begin
|
||
formatini();
|
||
info := fformatdata[lowercase(sn),"d",lowercase(key)] ;
|
||
if info then
|
||
begin
|
||
s := fscript;
|
||
s[info["b"]:info["e"]] := formatkv(nkey,info["v"]);
|
||
setscript(s);
|
||
end
|
||
end
|
||
published
|
||
property script read fscript write setscript;
|
||
private
|
||
function formatkv(key,v);
|
||
begin
|
||
return formatstr(key)+"="+formatstr(v);
|
||
end
|
||
function formatstr(s);
|
||
begin
|
||
if ifstring(s) then s1 := s;
|
||
else s1 := tostn(s);
|
||
s1 := replacetext(s1,"\r","");
|
||
return replacetext(s1,"\n","");
|
||
end
|
||
function formatini();//获取格式数据
|
||
begin
|
||
parser_ini();
|
||
if not fdata then return ;
|
||
fformatdata := array();
|
||
for i,v in fdata do
|
||
begin
|
||
d := array();
|
||
for k,kv in v.fdata do
|
||
begin
|
||
kk := kv[0];
|
||
kkv := kv[1];
|
||
if kk.fb<=kk.fe then
|
||
begin
|
||
ks := trim(fscript[kk.fb:kk.fe]);
|
||
|
||
end else ks := "";
|
||
if kkv.fb<=kkv.fe then
|
||
begin
|
||
ksv := trim(fscript[kkv.fb:kkv.fe]);
|
||
end else ksv := "";
|
||
d[lowercase(ks)] := array("k":ks,"v":ksv,"b":kk.fb,"e":kkv.fe);
|
||
end
|
||
|
||
fformatdata[lowercase(v.fv)] := array("n":v.fv,"d":d,"b":v.fb,"e":v.fe,"e2":v.fe2);
|
||
end
|
||
fdata := array();
|
||
|
||
end
|
||
function parser_v();
|
||
begin
|
||
v := new tobjv(type_value,factidx+1);
|
||
while factidx<fscriptlen do
|
||
begin
|
||
factidx++;
|
||
vi := fscript[factidx];
|
||
if vi="\r" or vi="\n" then
|
||
begin
|
||
v.fe := factidx-1;
|
||
ffirstchar := true;
|
||
return v;
|
||
end
|
||
end
|
||
v.fe := factidx;
|
||
return v;
|
||
end
|
||
function parser_ini();
|
||
begin
|
||
if factidx>=fscriptlen then return ;
|
||
k := new tobjv(type_skey,factidx+1);
|
||
while factidx<fscriptlen do
|
||
begin
|
||
factidx++;
|
||
vi := fscript[factidx];
|
||
if ffirstchar then
|
||
begin
|
||
case vi of
|
||
"[":
|
||
begin
|
||
if fcsection.fv or fcsection.fdata then
|
||
begin
|
||
fdata[length(fdata)] := fcsection;
|
||
fcsection.fe := factidx-1;
|
||
end
|
||
fcsection := new tobjv(type_section,factidx);
|
||
parser_section();
|
||
|
||
end
|
||
"=":
|
||
begin
|
||
k.fe := factidx-1;
|
||
fcsection.add(k,parser_v());
|
||
k := new tobjv(type_skey,factidx);
|
||
end
|
||
";","#": //走到下一行
|
||
begin
|
||
gotonextline();
|
||
end
|
||
"\r","\n":
|
||
begin
|
||
|
||
end else
|
||
begin
|
||
ffirstchar := false;
|
||
k.fb := factidx;
|
||
end
|
||
end ;
|
||
end else
|
||
begin
|
||
case vi of
|
||
"\r","\n":
|
||
begin
|
||
ffirstchar := true;
|
||
parser_ini();
|
||
end
|
||
"=":
|
||
begin
|
||
k.fe := factidx-1;
|
||
fcsection.add(k,parser_v());
|
||
k := new tobjv(type_skey,factidx);
|
||
end
|
||
end
|
||
end
|
||
|
||
|
||
end
|
||
if fdata[length(fdata)-1]<>fcsection then
|
||
fdata[length(fdata)] := fcsection;
|
||
fcsection.fe := fscriptlen;
|
||
end
|
||
function parser_section();
|
||
begin
|
||
sn := "";
|
||
while factidx<fscriptlen do
|
||
begin
|
||
factidx++;
|
||
vi := fscript[factidx];
|
||
if vi="\r" or vi="\n" then
|
||
begin
|
||
ffirstchar := true;
|
||
break;
|
||
end
|
||
if vi="]" then //section 关闭
|
||
begin
|
||
fcsection.fv := trim(sn);
|
||
fcsection.fe2 := factidx;
|
||
ffirstchar := false;
|
||
return parser_ini();
|
||
end
|
||
sn+=vi;
|
||
end
|
||
end
|
||
function gotonextline(); //到达下一行
|
||
begin
|
||
while factidx<fscriptlen do
|
||
begin
|
||
factidx++;
|
||
vi := fscript[factidx] ;
|
||
if vi="\n" then
|
||
begin
|
||
ffirstchar := true;
|
||
break;
|
||
end
|
||
end
|
||
end
|
||
function setscript(s);
|
||
begin
|
||
if ifstring(s) and s<>fscript then
|
||
begin
|
||
fscript := s;
|
||
script_init();
|
||
end
|
||
end
|
||
function script_init();
|
||
begin
|
||
fscriptlen := length(fscript);
|
||
factidx := 0;
|
||
fdata := array();
|
||
ffirstchar := true;
|
||
fcsection := new tobjv(type_section,1);
|
||
end
|
||
fscript;
|
||
fscriptlen;
|
||
factidx;
|
||
fcsection;
|
||
fdata;
|
||
fformatdata;
|
||
ffirstchar;
|
||
type tobjv = class()
|
||
function create(t,b);
|
||
begin
|
||
fb := b;
|
||
fe := -1;
|
||
fv := "";
|
||
ft := t;
|
||
fdata := array();
|
||
end
|
||
function add(k,v);
|
||
begin
|
||
fdata[length(fdata)] := array(k,v);
|
||
end
|
||
fdata;
|
||
fb;
|
||
fe;
|
||
fe2;
|
||
fv;
|
||
ft;
|
||
end
|
||
end
|
||
implementation
|
||
function iffuncptr(fn);
|
||
begin
|
||
//return datatype(fn)=7;
|
||
return fn and ifobj(fn);
|
||
end
|
||
function includestate(u,s);
|
||
begin
|
||
{**
|
||
@explan(说明) 状态扩展 %%
|
||
**}
|
||
if not ifarray(u)then u := array();
|
||
if ifarray(s)then u union2= s;
|
||
else u union2= array(s);
|
||
return u;
|
||
end
|
||
function excludestate(u,s);
|
||
begin
|
||
{**
|
||
@explan(说明) 状态缩减%%
|
||
**}
|
||
if not ifarray(u)then u := array();
|
||
if ifarray(s)then u minus= s;
|
||
else u minus= array(s);
|
||
return u;
|
||
end
|
||
//*************makelong*****************************
|
||
function makelong(low,high,ptrl);
|
||
begin
|
||
{**
|
||
@explan(说明) 合并高低为 %%
|
||
@return(integer) 整数 %%
|
||
@param(low)(integer) 低位 %%
|
||
@param(high)(integer) 高位 %%
|
||
@param(ptrl)(integer) 长度 默认为 8 %%
|
||
**}
|
||
if not ifnumber(ptrl)then ptrl := 16;
|
||
mask := 2^(ptrl)-1;
|
||
low1 := low .& mask;
|
||
high1 := high .& mask;
|
||
return _shl(high1,ptrl).| low1;
|
||
end
|
||
|
||
function makeposition(x,y);
|
||
begin
|
||
{**
|
||
@explan(说明)将x,y构造为一个int类型 %%
|
||
@return(integer)
|
||
**}
|
||
if ifnumber(x)and ifnumber(y)then return makelong(signedtounsigned(x),signedtounsigned(y));
|
||
return 0;
|
||
end
|
||
function lowuperdword(value_,lvalue,uvalue,ptrl);
|
||
begin
|
||
{**
|
||
@explan(说明) 高低位获取 %%
|
||
@param(value_)(integer) 整数 %%
|
||
@param(lvalue)(integer) 低位 %%
|
||
@param(uvalue)(integer) 高位 %%
|
||
@param(ptrl)(integer) 长度 默认为 8 %%
|
||
**}
|
||
lvalue := uvalue := 0;
|
||
if not ifnumber(value_)then return array(0,0);
|
||
if not ifnumber(ptrl)then ptrl := 16;
|
||
value :=(value_);
|
||
mask := 2^(ptrl)-1;
|
||
uvalue := _shr(value,ptrl).& mask;
|
||
//t := _shl(value,ptrl);
|
||
//lvalue := _shr(t,ptrl) .& mask;
|
||
lvalue := value .& mask;
|
||
return array(lvalue,uvalue);
|
||
end
|
||
function signedtounsigned(v,n);
|
||
begin
|
||
{**
|
||
@explan(说明) 符号数转换为无符号数 %%
|
||
@param(v)(integer) 数字 %%
|
||
@param(n)(integer) 有效位数 %%
|
||
@return(integer)
|
||
**}
|
||
if not ifnumber(n)then n := 16;
|
||
if n>64 then n := 64;
|
||
mkv2 := 1;
|
||
ret := mkv2 .& v;
|
||
for i := 1 to n-1 do
|
||
begin
|
||
mkv2 := _shl(mkv2,1);
|
||
ret +=(mkv2 .& v);
|
||
end
|
||
mkv2 := _shl(mkv2,1);
|
||
if v<0 then
|
||
begin
|
||
ret .|= mkv2;
|
||
end else
|
||
begin
|
||
ret .&=(.! mkv2);
|
||
end
|
||
return ret;
|
||
end
|
||
function getbitsfrominteger(n,b,e);
|
||
begin
|
||
{**
|
||
@explan(说明) 获取数字的位数并转换为整数 %%
|
||
@param(b)(integer) 开始位 %%
|
||
@param(e)(integer) 截止位 %%
|
||
@param(n)(integer) 数字 %%
|
||
@return(integer)
|
||
**}
|
||
r := 0;
|
||
if b<0 then return 0;
|
||
mk := 2^(b);
|
||
for i := b to e do
|
||
begin
|
||
if(mk .& n)>0 then r += _shr(mk,b);
|
||
mk := _shl(mk,1);
|
||
end
|
||
return r;
|
||
end
|
||
|
||
function unsignedtosigned(v,n);
|
||
begin
|
||
{**
|
||
@explan(说明) 无符号数转换为符号数 %%
|
||
@param(v)(integer) 数字 %%
|
||
@param(n)(integer) 有效位数 %%
|
||
@return(integer)
|
||
**}
|
||
if not ifnumber(n)then n := 16;
|
||
if n>64 then n := 64;
|
||
mkv := 0;
|
||
mkv := _shl(1,n-1);
|
||
mkv2 := 1;
|
||
for i := 1 to n-1 do
|
||
begin
|
||
mkv2 := _shl(mkv2,1);
|
||
mkv2 += 1;
|
||
end
|
||
vv := v .& mkv2;
|
||
if(v .& mkv)then
|
||
begin
|
||
return 0-((_not(vv) .& mkv2)+1);
|
||
end
|
||
return vv;
|
||
end
|
||
function bitcombination(s,v,f);
|
||
begin
|
||
{**
|
||
@explan(说明)bit位组合 %%
|
||
@param(s)(integer) 原有值 %%
|
||
@param(v)(integer) 追加或者删除 %%
|
||
@param(f)(integer) 0 为 or ,1 为 and ;2 表示 删除 v的值 %%
|
||
**}
|
||
if not(ifnumber(s)and ifnumber(v))then return 0;
|
||
case f of
|
||
0:return s .| v;
|
||
1:return s .& v;
|
||
2:return(.!v).& s;
|
||
else return s;
|
||
end
|
||
hv :=((s .& v)=v);
|
||
if(hv)and f=2 then
|
||
begin
|
||
return(.!v).& s;
|
||
end else
|
||
if(f=0)and not(hv)then
|
||
begin
|
||
return s .| v;
|
||
end else
|
||
if(f=1)and not(hv)then
|
||
begin
|
||
return s .& v;
|
||
end else
|
||
return s;
|
||
end
|
||
function formatshortcut(d);
|
||
begin
|
||
r := "";
|
||
if d then
|
||
begin
|
||
if d["c"] then r +=(r)?"+Ctrl":"Ctrl";
|
||
if d["s"] then r +=(r)?"+Shift":"Shift";
|
||
if d["a"] then r +=(r)?"+Alt":"Alt";
|
||
if d["f"] then r +=(r)?("+"+d["f"]):d["f"];
|
||
if d["w"] then r +=(r)?("+"+d["w"]):d["w"];
|
||
end
|
||
return r;
|
||
end
|
||
function parsershortcutstr(s_); //快捷键解析
|
||
begin
|
||
s := uppercase(s_);
|
||
ls := length(s);
|
||
zmb := array();
|
||
fb := array();
|
||
for i := 65 to 90 do zmb[chr(i)] := true;
|
||
for i:= 1 to 12 do fb["F"+inttostr(i)] := true;
|
||
cword :="";
|
||
i := 1;
|
||
r := array();
|
||
while(i<=ls) do
|
||
begin
|
||
vi := s[i];
|
||
vio := ord(vi);
|
||
case vio of
|
||
65 to 90 ,48 to 57:
|
||
begin
|
||
cword +=vi;
|
||
end
|
||
else
|
||
begin
|
||
if cword then
|
||
begin
|
||
case cword of
|
||
"SHIFT":
|
||
begin
|
||
r["s"] := true;
|
||
end
|
||
"CTRL":
|
||
begin
|
||
r["c"] := true;
|
||
end
|
||
"ALT":
|
||
begin
|
||
r["a"] := true;
|
||
end
|
||
else
|
||
begin
|
||
|
||
if fb[cword] and not(r["w"]) then
|
||
begin
|
||
r["f"] := cword;
|
||
end else
|
||
if r and not(r["f"]) then
|
||
begin
|
||
if zmb[cword] then r["w"] := cword;
|
||
end
|
||
end
|
||
|
||
end ;
|
||
end
|
||
cword := "";
|
||
end
|
||
|
||
end;
|
||
i++;
|
||
end
|
||
if cword then
|
||
begin
|
||
case cword of
|
||
"SHIFT":
|
||
begin
|
||
r["s"] := true;
|
||
end
|
||
"CTRL":
|
||
begin
|
||
r["c"] := true;
|
||
end
|
||
"ALT":
|
||
begin
|
||
r["a"] := true;
|
||
end
|
||
else
|
||
begin
|
||
if fb[cword] and not(r["w"]) then
|
||
begin
|
||
r["f"] := cword;
|
||
end else
|
||
if r and not(r["f"]) then
|
||
begin
|
||
if zmb[cword] then r["w"] := cword;
|
||
end
|
||
end
|
||
|
||
end ;
|
||
end
|
||
if not(r["w"] or r["f"]) then r := array();
|
||
return r;
|
||
end
|
||
function FormatTslData(d,sj,tn);
|
||
begin
|
||
{**
|
||
@explan(说明) 格式化tsl数据 %%
|
||
@param(d)(any) tsl数据 %%
|
||
@param(sj)(string) 空格距离 %%
|
||
@param(tn)(nil) 空参数 %%
|
||
@return(string) 格式化后的字符串 %%
|
||
**}
|
||
r := "";
|
||
if not(sj and ifstring(sj))then sj := " ";
|
||
if ifarray(d)then
|
||
begin
|
||
r := "(\r\n";
|
||
if ifnil(tn)then
|
||
begin
|
||
tn := 0;
|
||
r := "array(\r\n";
|
||
end
|
||
di := 0;
|
||
len := length(d);
|
||
for i,v in d do
|
||
begin
|
||
bt := sj;
|
||
if di <> i then
|
||
begin
|
||
bt += tostn(i)+":";
|
||
end
|
||
di++;
|
||
vr := FormatTslData(v,sj,1);
|
||
if len>di then vr += ",";
|
||
r += bt;
|
||
if ifarray(v)then
|
||
begin
|
||
vrs := str2array(vr,"\r\n");
|
||
dii := 0;
|
||
for j,vj in vrs do
|
||
begin
|
||
if dii<1 then r += vj;
|
||
else r += sj+vj;
|
||
r += "\r\n";
|
||
dii++;
|
||
end
|
||
end else
|
||
r += vr+"\r\n";
|
||
end
|
||
r += ")";
|
||
return r;
|
||
end else
|
||
return tostn(d);
|
||
end
|
||
|
||
function DeleteItemsByIndexs(r,dxs);
|
||
begin
|
||
{**
|
||
@explan(说明) 删除数组下标, %%
|
||
@param(r)(array) 待删除下标的数组,采用字符串下标的数组,变参返回%%;
|
||
**}
|
||
if not ifarray(r)then exit;
|
||
rdx := array();
|
||
for i,v in dxs do rdx[v]:= nil;
|
||
return reindex(r,rdx);
|
||
end
|
||
function HexHash();
|
||
begin
|
||
c := array("A","B","C","D","E","F");
|
||
idxs := inttostr(0 -> 9)union c union lowercase(c);
|
||
r := array();
|
||
for i,v in idxs do
|
||
begin
|
||
if i<16 then r[v]:= i;
|
||
else r[v]:= i-6;
|
||
end
|
||
return r;
|
||
end
|
||
function TslToHexStr(t);
|
||
begin
|
||
{**
|
||
@explan(说明) 将tsl数据转换为16进制字符串 %%
|
||
@param(t)(any) 任意的tsl数据 %%;
|
||
@return(string) 16进制字符串 %%
|
||
**}
|
||
r := "";
|
||
str := tostm(t);
|
||
ky := static(inttostr(0 -> 9)union array("A","B","C","D","E","F"));
|
||
idx := 1;
|
||
setlength(r,length(str)* 2);
|
||
for i := 0 to length(str)-1 do
|
||
begin
|
||
vi := ord(str[i]);
|
||
//r += ky[_shr(vi,4) .& 0xf];
|
||
//r += ky[vi .& 0xf] ;
|
||
r[idx]:= ky[_shr(vi,4).& 0xf];
|
||
r[idx+1]:= ky[vi .& 0xf];
|
||
idx += 2;
|
||
end
|
||
return r;
|
||
end
|
||
|
||
function HexFormatStrToTsl(hex);
|
||
begin
|
||
{**
|
||
@explan(说明)将带有换行符的16进制字符串转换为tsl数据 %%
|
||
@param(hex)(string) 16进制字符串 %%
|
||
@return(any) tsl数据类型 %%
|
||
**}
|
||
r := "";
|
||
hs := static HexHash();
|
||
//rs := inttostr(0 -> 9)union array("A","B","C","D","E","F","a","b","c","d","e","f");
|
||
for i := 1 to length(hex) do
|
||
begin
|
||
ri := hex[i];
|
||
if hs[ri]>=0 then
|
||
begin
|
||
r += ri;
|
||
end
|
||
end
|
||
return HexStrToTsl(r);
|
||
end
|
||
function TslToHexFormatStr(tsl);
|
||
begin
|
||
{**
|
||
@explan(说明) 将tsl类型转换为16进制字符串,每行长度为64,用\r\n分割 %%
|
||
@param(tsl)(any) tsl基础类型%%
|
||
@return(string) 字符串形式的16进制 %%
|
||
**}
|
||
s := TslToHexStr(tsl);
|
||
r := "";
|
||
n := length(s);
|
||
i := 1;
|
||
bc := 64;
|
||
while true do
|
||
begin
|
||
if i>n then break;
|
||
ij := i+bc;
|
||
if ij>n and i <= n then
|
||
begin
|
||
r += s[i:n];
|
||
break;
|
||
end else
|
||
r += s[i:ij];
|
||
if ij>n then break;
|
||
r += "\r\n";
|
||
i := ij+1;
|
||
end
|
||
return r;
|
||
end
|
||
function HexStrToTsl(hex);
|
||
begin
|
||
{**
|
||
@explan(说明)16进制字符串转换为tsl数据 %%
|
||
@param(hex)(string) 16进制字符串 %%
|
||
@return(any) tsl数据类型 %%
|
||
**}
|
||
if not(hex and ifstring(hex)) then return nil;
|
||
r := tostm(nil);
|
||
setlength(r,Integer(length(hex)/2));
|
||
hs := static HexHash();
|
||
idx := 0;
|
||
for i := 1 to length(hex)-1 step 2 do
|
||
begin
|
||
vi := hs[hex[i]];
|
||
vi1 := hs[hex[i+1]];
|
||
r[idx]:= _shl(vi,4).| vi1;
|
||
idx++;
|
||
end
|
||
return stm(r);
|
||
end
|
||
function gettemppath();
|
||
begin
|
||
{**
|
||
@explan(说明)获取windows临时目录 %%
|
||
@return(string) 目录;
|
||
**}
|
||
{$ifdef linux}
|
||
return "/var/tmp/";
|
||
{$endif}
|
||
s := "";
|
||
n := 1024;
|
||
setlength(s,n);
|
||
s1 := s;
|
||
GetTempPathA(n,s);
|
||
GetLongPathNameA(s,s1,n);
|
||
r := "";
|
||
for i := 1 to n do
|
||
begin
|
||
vi := s1[i];
|
||
if vi="\0" then
|
||
begin
|
||
return s1[1:(i-1)];
|
||
end
|
||
end
|
||
return "";
|
||
end
|
||
function TSL_ReservedKeys(var buf:string;buflen:integer):integer;cdecl;external{$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TSL_ReservedKeys";
|
||
function TSL_ReservedKeys2();
|
||
begin
|
||
ks := "";
|
||
setlength(ks,1024 * 10);
|
||
TSL_ReservedKeys(ks,length(ks)-1);
|
||
r := array();
|
||
rl := 0;
|
||
ki := "";
|
||
for i := 1 to length(ks)-1 do
|
||
begin
|
||
vi := ks[i];
|
||
if vi="\0" then break;
|
||
if vi="\n" then
|
||
begin
|
||
if ki then
|
||
begin
|
||
r[rl++]:= ki;
|
||
ki := "";
|
||
end
|
||
end else
|
||
ki += vi;
|
||
end
|
||
return r union2 array("read","write"); //添加read write 关键字
|
||
end
|
||
function GetLongPathNameA(var s1:string;var s:string;L:integer):integer;stdcall;external "Kernel32.dll" name "GetLongPathNameA";
|
||
function GetTempPathA(L:integer;var s:string):integer;stdcall;external "Kernel32.dll" name "GetTempPathA";
|
||
function ParserCommandLine(s); //解析命令行参数
|
||
begin
|
||
r := array();
|
||
if not ifstring(s) then return r;
|
||
len := length(s);
|
||
p := "";
|
||
while idx<len do
|
||
begin
|
||
idx ++;
|
||
vi := s[idx];
|
||
if vi = '"' then
|
||
begin
|
||
if p then r[length(r)] := p;
|
||
p := "";
|
||
while idx<len do
|
||
begin
|
||
idx++;
|
||
vi := s[idx];
|
||
if vi = '"' then
|
||
begin
|
||
r[length(r)] := p;
|
||
p := "";
|
||
break;
|
||
end
|
||
p+=vi;
|
||
|
||
end
|
||
|
||
end else
|
||
if vi=" " or vi="\t" then
|
||
begin
|
||
if p then r[length(r)] := p;
|
||
p := "";
|
||
end else
|
||
p+=vi;
|
||
end
|
||
if p then r[length(r)] := p;
|
||
return r;
|
||
end
|
||
function intersectrect(rec1,rec2,irec);
|
||
begin
|
||
{**
|
||
@explan(说明) 计算矩形的交集 %%
|
||
@param(rec1)(array of integer) 矩形区域 %%
|
||
@param(rec2)(array of integer) 矩形区域 %%
|
||
@param(irec)(var array of integer) 重叠的区域 %%
|
||
@return(bool)
|
||
**}
|
||
if lineintersect(array(rec1[0],rec1[2]),array(rec2[0],rec2[2]),d1)and lineintersect(array(rec1[1],rec1[3]),array(rec2[1],rec2[3]),d2)then
|
||
begin
|
||
irec := array(d1[0],d2[0],d1[1],d2[1]);
|
||
return true;
|
||
end
|
||
return 0;
|
||
end
|
||
|
||
|
||
function pointinrect(p,rec);
|
||
begin
|
||
{**
|
||
@explan(说明) 判断点是否在矩形中 %%
|
||
@param(rec)(array of integer) 矩形区域 %%
|
||
@param(p)(array of integer) 点 array(x,y) %%
|
||
@return(bool)
|
||
|
||
**}
|
||
x := p[0];
|
||
y := p[1];
|
||
return x>rec[0]and y>rec[1]and x<rec[2]and y<rec[3];
|
||
end
|
||
function lineintersect(xx1,xx2,xx);
|
||
begin
|
||
if(xx1[0]>xx2[0]and xx1[0]>xx2[1])or(xx2[0]>xx1[1]and xx2[1]>xx1[0])then return 0;
|
||
xx := array(max(xx1[0],xx2[0]),min(xx1[1],xx2[1]));
|
||
return 1;
|
||
end
|
||
function leapyear(y); //闰年判断
|
||
begin
|
||
if not(y mod 4) then
|
||
begin
|
||
if not(y mod 100) then
|
||
begin
|
||
return not(y mod 400);
|
||
end
|
||
return 1;
|
||
end
|
||
return 0;
|
||
end
|
||
function getmonthdates(y,m); //获得所在月的天数
|
||
begin
|
||
if m = 2 then return leapyear(y)+ 28;
|
||
if m in array(1,3,5,7,8,10,12) then return 31;
|
||
return 30;
|
||
end
|
||
function CallMessgeFunction(f,o,e);
|
||
begin
|
||
{**
|
||
@ignore(忽略)
|
||
**}
|
||
if iffuncptr(f) then return call(f,o,e);
|
||
end
|
||
function CheckArrayIsNumbers(Value,n);
|
||
begin
|
||
if not(ifnumber(n)and n >= 1)then n := 4;
|
||
if ifarray(Value)then
|
||
begin
|
||
for i := 0 to n-1 do
|
||
begin
|
||
if not(ifnumber(Value[i]))then return 1;
|
||
end
|
||
return 0;
|
||
end
|
||
return 1;
|
||
end
|
||
function CheckArrayIsControlRect(Value);
|
||
begin
|
||
{**
|
||
@explan(说明) 检查数组是否可以作为control的rect %%;
|
||
**}
|
||
if not(CheckArrayIsNumbers(Value,4))then
|
||
begin
|
||
return Value[3]>0 and Value[2]>0;
|
||
end
|
||
end
|
||
function CheckArrayIsControlBounds(Value);
|
||
begin
|
||
{**
|
||
@explan(说明) 检查数组是否可以作为control 的 bounds
|
||
**}
|
||
if not(CheckArrayIsNumbers(Value,4))then
|
||
begin
|
||
return(Value[3]>Value[1])and(Value[2]>Value[0]);
|
||
end
|
||
end
|
||
|
||
function intasposition(i);
|
||
begin
|
||
if ifnumber(i)then
|
||
begin
|
||
return lowuperdword(i);
|
||
end
|
||
return array(0,0);
|
||
end
|
||
function DeleteAllFiles(path);
|
||
begin
|
||
{**
|
||
@explan(说明) 删除指定路径的文件或者文件夹 %%
|
||
**}
|
||
if not ifstring(path)then return 0;
|
||
if not path then return 0;
|
||
iofp := ioFileseparator();
|
||
if path[length(path)]=iofp then return call(thisfunction,path[1:(length(path)-1)]);
|
||
info := FileList("",path); //"A"
|
||
if info then
|
||
begin
|
||
if pos("D",info[0]["Attr"])then
|
||
begin
|
||
fs := FileList("",path+iofp+"*");
|
||
for i,v in fs do
|
||
begin
|
||
n := v["FileName"];
|
||
if n in array(".","..")then continue;
|
||
call(thisfunction,path+iofp+n);
|
||
end
|
||
return RemoveDir("",path);
|
||
end else
|
||
begin
|
||
return FileDelete("",path);
|
||
end
|
||
return 0;
|
||
end
|
||
end
|
||
function CreateDirWithFileName(fname);
|
||
begin
|
||
{**
|
||
@explan(说明) 根据文件全名构造目录 %%
|
||
**}
|
||
if not(ifstring(fname)and(length(fname)>4))then exit;
|
||
info := FileList("",fname);
|
||
if info then exit;
|
||
len := length(fname);
|
||
iofp := ioFileseparator();
|
||
for i := len downto 1 do
|
||
begin
|
||
vi := fname[i];
|
||
if vi=iofp then
|
||
begin
|
||
ffname := fname[1:i];
|
||
break;
|
||
end
|
||
end
|
||
if not ffname then exit;
|
||
nct := 4;
|
||
{$ifdef linux}
|
||
nct := 1;
|
||
{$endif}
|
||
if length(ffname)<1 then exit;
|
||
ph := ffname[1:nct];
|
||
for i := nct+1 to length(ffname) do
|
||
begin
|
||
vi := ffname[i];
|
||
if vi=iofp then
|
||
begin
|
||
if not FileList("",ph)then
|
||
begin
|
||
CreateDir("",ph);
|
||
end
|
||
end
|
||
ph += vi;
|
||
end
|
||
end
|
||
{$ifdef linux}
|
||
function TS_GetUserProfileHome();
|
||
begin
|
||
home := sysgetenv("HOME");
|
||
if home then bpath := home+"/.vcl/";
|
||
else
|
||
bpath := ".vcl/";
|
||
return bpath;
|
||
end
|
||
{$else}
|
||
function TS_GetUserProfileHome():string;cdecl;external "TSSVRAPI.dll" name "TS_GetUserProfileHome";
|
||
{$endif}
|
||
function TS_GetUserProfileHomeInstance(t:integer):string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetUserProfileHomeInstance";
|
||
function TS_GetUserConfigHome(t:integer):string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetUserConfigHome";
|
||
function TS_GetHomePath(t:integer):string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetHomePath";
|
||
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_GetAppPath";
|
||
function TS_GetIniPath(t:integer;iname:string):string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetIniPath";
|
||
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
|
||
function get_resource_by_name(n,full);
|
||
begin
|
||
return static get_resource_by_name_sub(n,full) name (n$":"$full);
|
||
end
|
||
function get_resource_by_name_sub(n,full);
|
||
begin
|
||
global g_w_tfm_resource,g_w_tfm_resource_withdir,g_w_tfm_resource_names;
|
||
if n=1 then return g_w_tfm_resource;
|
||
if n=2 then return g_w_tfm_resource_withdir;
|
||
if n=3 then return (g_w_tfm_resource union g_w_tfm_resource_withdir);
|
||
if n=4 then return g_w_tfm_resource_names;
|
||
p := filesize("","d:\\test\\get_source.txt");
|
||
|
||
r := g_w_tfm_resource[n];
|
||
if r then return r;
|
||
if full then
|
||
begin
|
||
return g_w_tfm_resource_withdir[n];
|
||
end
|
||
if not(ifstring(n) and n) then return 0;
|
||
for i,v in g_w_tfm_resource_withdir do
|
||
begin
|
||
nn := replacetext(n,".","\\.");
|
||
{$ifdef linux}
|
||
ctl := "/"+nn+"$|^"+nn+"$";
|
||
{$else}
|
||
ctl := "\\\\"+nn+"$|^"+nn+"$";
|
||
{$endif}
|
||
if 1= parseregexpr(ctl,i,"i",m,mp,ml) then
|
||
begin
|
||
return v;
|
||
|
||
end
|
||
end
|
||
end
|
||
function uinit();
|
||
begin
|
||
global g_w_tfm_resource,g_w_tfm_resource_withdir,g_w_tfm_resource_names;
|
||
sep := ioFileseparator();
|
||
g_w_tfm_resource := array();
|
||
g_w_tfm_resource_withdir := array();
|
||
g_w_tfm_resource_names := array();
|
||
idx := 0;
|
||
try
|
||
getglobalcache("@@tsl-resource@@",rs);
|
||
for i,v in rs do
|
||
begin
|
||
if ifstring(i) and ifstring(v) then
|
||
begin
|
||
li := lowercase(i);
|
||
g_w_tfm_resource_names[i] := li;
|
||
if pos(sep,li) then
|
||
begin
|
||
g_w_tfm_resource_withdir[li] := v;
|
||
end else
|
||
begin
|
||
g_w_tfm_resource[li] := v;
|
||
end
|
||
end
|
||
end
|
||
except
|
||
end
|
||
end
|
||
initialization
|
||
uinit();
|
||
end.
|
||
|
||
//////////////////////暂时没用到的类型///////////////////////////////////////
|
||
(*
|
||
|
||
type TFileLocker=class()
|
||
{**
|
||
@ignore(忽略) %%
|
||
@explan(说明) 文件锁定 %%
|
||
**}
|
||
private
|
||
FHandle;
|
||
FLocked;
|
||
FApi;
|
||
function GetFileOpen();
|
||
begin
|
||
return FHandle <> 0;
|
||
end
|
||
function GetFileLocked();
|
||
begin
|
||
return FLocked <> 0;
|
||
end
|
||
public
|
||
function Create(F);
|
||
begin
|
||
{**
|
||
@explan(说明)对文件加锁,防止其他进程读写 %%
|
||
@param(f)(string) 文件名 %%
|
||
**}
|
||
FHandle := 0;
|
||
FLocked := 0;
|
||
if not FileExists("",f)then exit;
|
||
FApi := gettswin32api();
|
||
FHandle := FApi.CreateFileA(F,0x40000000L,0,0,3,0x00000080,0);
|
||
if not FHandle then exit;
|
||
FLocked := FApi.LockFile(FHandle,0,0,0,0);
|
||
end
|
||
function Destroy();
|
||
begin
|
||
if FLocked then
|
||
begin
|
||
FApi.UnlockFile(FHandle,0,0,0,0);
|
||
end
|
||
if FHandle then
|
||
begin
|
||
FApi.CloseHandle(FHandle);
|
||
end
|
||
end
|
||
property FileOpend read GetFileOpen;
|
||
property FileLocked read GetFileLocked;
|
||
{**
|
||
@param(FileOpend)(bool) 是否有效%%
|
||
@param(FileLocked)(bool) 是否已经锁定%%
|
||
**}
|
||
end
|
||
|
||
|
||
type Ttagaccel=class(tslcstructureobj)
|
||
private
|
||
static SSTRUCT;
|
||
class function getstruct()
|
||
begin
|
||
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
|
||
("fvirt","byte",0),
|
||
("key","short",0),
|
||
("cmd","short",0)));
|
||
return SSTRUCT;
|
||
end
|
||
public
|
||
function create(ptr)
|
||
begin
|
||
inherited create(getstruct(),ptr);
|
||
end
|
||
property fvirt index "fvirt" read _getvalue_ write _setvalue_;
|
||
property key index "key" read _getvalue_ write _setvalue_;
|
||
property cmd index "cmd" read _getvalue_ write _setvalue_;
|
||
end
|
||
type TBITMAPINFOHEADER=class(tslcstructureobj)
|
||
private
|
||
static SSTRUCT;
|
||
class function getstruct()
|
||
begin
|
||
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
|
||
("bisize","int",40),
|
||
("biwidth","int",0),
|
||
("biheight","int",0),
|
||
("biplanes","short",0),
|
||
("bibitcount","short",0),
|
||
("bicompression","int",0),
|
||
("bisizeimage","int",0),
|
||
("bixpelspermeter","int",0),
|
||
("biypelspermeter","int",0),
|
||
("biclrused","int",0),
|
||
("biclrimportant","int",0)
|
||
));
|
||
return SSTRUCT;
|
||
end
|
||
public
|
||
function create(ptr)
|
||
begin
|
||
inherited create(getstruct(),ptr);
|
||
bisize := _size_();
|
||
end
|
||
property bisize index "bisize" read _getvalue_ write _setvalue_;
|
||
property biwidth index "biwidth" read _getvalue_ write _setvalue_;
|
||
property biheight index "biheight" read _getvalue_ write _setvalue_;
|
||
property biplanes index "biplanes" read _getvalue_ write _setvalue_;
|
||
property bibitcount index "bibitcount" read _getvalue_ write _setvalue_;
|
||
property bicompression index "bicompression" read _getvalue_ write _setvalue_;
|
||
property bisizeimage index "bisizeimage" read _getvalue_ write _setvalue_;
|
||
property bixpelspermeter index "bixpelspermeter" read _getvalue_ write _setvalue_;
|
||
property biypelspermeter index "biypelspermeter" read _getvalue_ write _setvalue_;
|
||
property biclrused index "biclrused" read _getvalue_ write _setvalue_;
|
||
property biclrimportant index "biclrimportant" read _getvalue_ write _setvalue_;
|
||
end
|
||
type TTBBUTTONINFOA=class(tcstructwithcharptr)
|
||
{**
|
||
@explan(说明) 工具条项内存对象 %%
|
||
**}
|
||
private
|
||
static SSTRUCT;
|
||
function getstruct()
|
||
begin
|
||
if not SSTRUCT then SSTRUCT := array(
|
||
("cbsize","int",0),
|
||
("dwmask","int",0),
|
||
("idcommand","int",0),
|
||
("iimage","int",0),
|
||
("fsstate","byte",0),
|
||
("fsstyle","byte",0),
|
||
("cx","short",0),
|
||
("lparam","intptr",0),
|
||
("psztext","char*",0),
|
||
("cchtext","int",100));
|
||
return SSTRUCT;
|
||
end
|
||
public
|
||
function create();override;
|
||
begin
|
||
inherited create(getstruct(),array("psztext":"cchtext"),nil);
|
||
cbsize := _size_();
|
||
end
|
||
property cbsize index "cbsize" read _getvalue_ write _setvalue_;
|
||
property dwmask index "dwmask" read _getvalue_ write _setvalue_;
|
||
property idcommand index "idcommand" read _getvalue_ write _setvalue_;
|
||
property iimage index "iimage" read _getvalue_ write _setvalue_;
|
||
property fsstate index "fsstate" read _getvalue_ write _setvalue_;
|
||
property fsstyle index "fsstyle" read _getvalue_ write _setvalue_;
|
||
property cx index "cx" read _getvalue_ write _setvalue_;
|
||
property lparam index "lparam" read _getvalue_ write _setvalue_;
|
||
property psztext index "psztext" read _getvalue_ write _setvalue_;
|
||
property cchtext index "cchtext" read _getvalue_ write _setvalue_;
|
||
end
|
||
|
||
type TTBBUTTON=class(tslcstructureobj)
|
||
{**
|
||
@explan(说明) 工具栏按钮内存对象 %%
|
||
**}
|
||
private
|
||
static SSTRUCT;
|
||
function getstruct()
|
||
begin
|
||
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
|
||
("ibitmap","int",0),
|
||
("idcommand","int",0),
|
||
("fsstate","byte",0),
|
||
("fsstyle","byte",0),
|
||
("dwdata","intptr",0),
|
||
("istring","char*",128)));
|
||
return SSTRUCT;
|
||
end
|
||
public
|
||
function create(ptr)
|
||
begin
|
||
inherited create(getstruct(),ptr);
|
||
end
|
||
function _setvalue_(id,v);
|
||
begin
|
||
if id="istring" then
|
||
begin
|
||
if ifstring(v)and length(v)<127 then
|
||
begin
|
||
return inherited;
|
||
end
|
||
return;
|
||
end
|
||
return inherited;
|
||
end
|
||
property ibitmap index "ibitmap" read _getvalue_ write _setvalue_;
|
||
property idcommand index "idcommand" read _getvalue_ write _setvalue_;
|
||
property fsstate index "fsstate" read _getvalue_ write _setvalue_;
|
||
property fsstyle index "fsstyle" read _getvalue_ write _setvalue_;
|
||
property dwdata index "dwdata" read _getvalue_ write _setvalue_;
|
||
property istring index "istring" read _getvalue_ write _setvalue_;
|
||
end
|
||
type TScrollBarKind=class(tenumeration)
|
||
static sbHorizontal;
|
||
static sbVertical;
|
||
end
|
||
|
||
type TToolTipsFlags=class
|
||
{**
|
||
@ignore(忽略) %%
|
||
@explan() tooltips flags 常量 %%
|
||
**}
|
||
static TTF_IDISHWND;
|
||
static TTF_CENTERTIP;
|
||
static TTF_RTLREADING;
|
||
static TTF_SUBCLASS;
|
||
static TTF_TRACK;
|
||
static TTF_ABSOLUTE;
|
||
static TTF_TRANSPARENT;
|
||
static TTF_PARSELINKS;
|
||
static TTF_DI_SETITEM;
|
||
end
|
||
|
||
type TIMAGEINFO = class(tslcstructureobj)
|
||
{**
|
||
@ignore 忽略 %%
|
||
@explan(说明) imgelist中image的信息 %%
|
||
**}
|
||
private
|
||
static SSTRUCT;
|
||
function getstruct()
|
||
begin
|
||
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(
|
||
array(
|
||
("hbmimage","intptr",0),
|
||
("hbmmask","intptr",0),
|
||
("unused1","int",0),
|
||
("unused2","int",0),
|
||
("rcimage","int[4]",
|
||
(0,0,0,0))));
|
||
return SSTRUCT;
|
||
end
|
||
function getbmp(v);
|
||
begin
|
||
{**
|
||
@explan(说明)构造tbitmap对象 %%
|
||
**}
|
||
hm := _getvalue_(v);
|
||
if hm then
|
||
begin
|
||
r := new tbitmap();
|
||
r.handle := hm;
|
||
r.AutoDestroy := false;
|
||
return r;
|
||
end
|
||
end
|
||
public
|
||
function create(ptr)
|
||
begin
|
||
inherited create(getstruct(),ptr);
|
||
end
|
||
property bmimage:tbitmap index "hbmimage" read getbmp write getbmp;
|
||
property bmmask:tbitmap index "hbmmask" read getbmp write getbmp;
|
||
property hbmimage index "hbmimage" read _getvalue_ write _setvalue_;
|
||
property hbmmask index "hbmmask" read _getvalue_ write _setvalue_;
|
||
property unused1 index "unused1" read _getvalue_ write _setvalue_;
|
||
property unused2 index "unused2" read _getvalue_ write _setvalue_;
|
||
property rcimage index "rcimage" read _getvalue_ write _setvalue_;
|
||
{**
|
||
@param(bmimage)(tbitmap) 位图 %%
|
||
@param(bmmask)(tbitmap) mask %%
|
||
@param(rcimage)(array) 左上右下 %%
|
||
**}
|
||
end
|
||
|
||
*)
|
||
|
||
|
||
//////////////twincontrol 中移除的函数
|
||
(*
|
||
function CreateDrawItemEvent();virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 主动构造drawitem消息,可以自行填写信息在DoDrawItem中使用,与DestroyDrawItemEvent成对出现 %%
|
||
@return(TMDRAWITEM|nil) item绘制对象 %%
|
||
**}
|
||
e := nil;
|
||
if HandleAllocated() then
|
||
begin
|
||
hd := self.Handle;
|
||
itptr := FTtageDrawItem._getptr_;
|
||
e := new TMDRAWITEM(WM_DRAWITEM,0,itptr,hd);
|
||
e.canvas := canvas;
|
||
canvas.handle := _wapi.GetDC(self.Handle);
|
||
end
|
||
return e;
|
||
end
|
||
function DestroyDrawItemEvent(e);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 与CreateDrawItemEvent配合使用 %%
|
||
@param(e)(TMDRAWITEM) CreateDrawItemEvent 构造的消息对象 %%
|
||
**}
|
||
if HandleAllocated() and ( e is class(TMDRAWITEM)) and (e.lparam = FTtageDrawItem._getptr_()) then
|
||
begin
|
||
dc := canvas.Handle;
|
||
if dc then
|
||
begin
|
||
canvas.handle := 0;
|
||
return _wapi.ReleaseDC(self.Handle,dc);
|
||
end
|
||
end
|
||
end
|
||
*)
|
||
|
||
(*
|
||
//tcontrol 移除代码
|
||
function GetDeviceContext(var WindowHandle:HWND);virtual; //type_tcontrol
|
||
begin
|
||
{**
|
||
@explan(说明) 获取设备hdc %%
|
||
@param(WindowHandle)(pointer) 窗口句柄 %%
|
||
@return(pointer) dc 句柄 %%
|
||
**}
|
||
if Parent is class(TWinControl)then
|
||
begin
|
||
Result := Parent.GetDeviceContext(WindowHandle);
|
||
MoveWindowOrgEx(Result,Left,Top);
|
||
IntersectClipRect(Result,0,0,Width,Height);
|
||
end else
|
||
raise "错误";
|
||
return Result;
|
||
end;
|
||
|
||
function IntersectClipRect(hdc, x0, y0, x1, y1);virtual; //type_tcontrol
|
||
begin
|
||
_wapi.IntersectClipRect(hdc, x0, y0, x1, y1);
|
||
end
|
||
function MoveWindowOrgEx(hdc;x:integer;y:integer);virtual; //type_tcontrol
|
||
begin
|
||
{**
|
||
@explan(说明) 移动dc原点 %%
|
||
@param(hdc)(pointer) dc 句柄 %%
|
||
**}
|
||
return _wapi.SetViewportOrgEx(hdc,x,y,nil);
|
||
end
|
||
|
||
function WMXButtonDown(o,e): LM_XBUTTONDOWN;virtual;
|
||
begin
|
||
end
|
||
function WMMButtonDBLCLK(o,e): LM_MBUTTONDBLCLK;virtual;
|
||
begin
|
||
|
||
end
|
||
function WMXButtonDBLCLK(o,e): LM_XBUTTONDBLCLK;virtual;
|
||
begin
|
||
|
||
end
|
||
function WMLButtonTripleCLK(o,e): LM_LBUTTONTRIPLECLK;virtual;
|
||
begin
|
||
|
||
end
|
||
function WMRButtonTripleCLK(o,e): LM_RBUTTONTRIPLECLK;virtual;
|
||
begin
|
||
|
||
end
|
||
function WMMButtonTripleCLK(o,e): LM_MBUTTONTRIPLECLK;virtual;
|
||
begin
|
||
|
||
end
|
||
function WMXButtonTripleCLK(o,e): LM_XBUTTONTRIPLECLK;virtual;
|
||
begin
|
||
|
||
end
|
||
function WMXButtonUp(o,e): LM_XBUTTONUP;virtual;
|
||
begin
|
||
|
||
end
|
||
function WMLButtonQuadCLK(): LM_LBUTTONQUADCLK;virtual;
|
||
function WMRButtonQuadCLK(): LM_RBUTTONQUADCLK;virtual;
|
||
function WMMButtonQuadCLK(): LM_MBUTTONQUADCLK;virtual;
|
||
function WMXButtonQuadCLK(): LM_XBUTTONQUADCLK;virtual;
|
||
*)
|
||
(*
|
||
|
||
function SetMainMenubk(mu);
|
||
begin
|
||
if csDesigning in ComponentState then
|
||
begin
|
||
if FMainMenu and mu then //已经存在 %%
|
||
begin
|
||
return ;
|
||
end
|
||
if (not FMainMenu) and mu then
|
||
begin
|
||
mu := new TMainmenu(self); //构造一个假的菜单
|
||
tm := new TMenu(mu);
|
||
tm.caption := "menu";
|
||
tm.parent := mu;
|
||
end
|
||
end
|
||
if FMainMenu<>mu then
|
||
begin
|
||
OM := FMainMenu;
|
||
if OM is class(tmainmenu) then
|
||
begin
|
||
OM.DestroyHandle(); //删除句柄 %%
|
||
OM.Hwnd := 0;
|
||
//if HandleAllocated() then _wapi.SetMenu(self.Handle,0); //删除窗口上面的菜单句柄
|
||
end
|
||
if (mu is class(tmainmenu)) then
|
||
begin
|
||
if HandleAllocated() then
|
||
begin
|
||
mu.Hwnd := handle;
|
||
//_wapi.SetMenu(self.Handle,mu.handle);
|
||
end
|
||
end
|
||
FMainMenu := mu;
|
||
end
|
||
end
|
||
|
||
type TTempFile = class
|
||
function Create(dt);
|
||
begin
|
||
if not ifarray(FFiles) then FFiles := array();
|
||
bp :=gettemppath()+"tinysoft"+ioFileseparator()+"tslvcl"+ioFileseparator();
|
||
{if not fileexists("",bp) then
|
||
begin
|
||
for i:=2 to length(bp) do
|
||
begin
|
||
if bp[i]=ioFileseparator() then
|
||
begin
|
||
if fileexists("",bp[1:i-1]) then
|
||
begin
|
||
createdir("",bp[1:i-1])
|
||
end
|
||
end
|
||
end
|
||
end }
|
||
for i,v in mrows( FFiles,1) do
|
||
begin
|
||
if not(FFiles[v]) then
|
||
begin
|
||
FFiles[v] := true;
|
||
FPath := v;
|
||
break;
|
||
end
|
||
end
|
||
while not FPath do
|
||
begin
|
||
i := 0;
|
||
while true do
|
||
begin
|
||
subdir := tostn( rand(3)[1]);
|
||
p := bp+subdir[3]+ioFileseparator()+subdir[4]+".png";
|
||
echo p,"\r\n";
|
||
if not(FFiles[p]) then
|
||
begin
|
||
FFiles[p] := true;
|
||
FPath := p;
|
||
//writefile(rwraw(),"",FPath,0,1,"0") ;
|
||
break;
|
||
end
|
||
end
|
||
end
|
||
if ifstring(dt) then
|
||
begin
|
||
//if FileExists("",FPath) then filedelete("",FPath);
|
||
writefile(rwraw(),"",FPath,0,length(dt),dt) ;
|
||
end
|
||
end
|
||
function GetData(buf);//获得数据
|
||
begin
|
||
if FPath then
|
||
begin
|
||
sz := filesize("",FPath);
|
||
return readfile(rwraw(),"",FPath,0,sz,buf);
|
||
end
|
||
end
|
||
function Destroy();
|
||
begin
|
||
//FFiles[FPath] := false;
|
||
if FileExists("",FPath) then echo "\r\ndeletefile:",filedelete("",FPath);
|
||
FPath := "";
|
||
end
|
||
property path read FPath ;
|
||
private
|
||
FPath;
|
||
static FFiles;
|
||
end
|
||
|
||
*)
|
||
//暂时不用的函数
|
||
{function chartoint(c);
|
||
begin
|
||
v := ord(c);
|
||
case v of
|
||
48 to 57:vk := v-48;
|
||
65 to 70:vk := v-65+10;
|
||
97 to 102:vk := v-97+10;
|
||
else raise "非16进制字符串";
|
||
end
|
||
return vk;
|
||
end} |