8816 lines
248 KiB
Plaintext
8816 lines
248 KiB
Plaintext
unit tslvcl;
|
||
{**
|
||
@explan(说明) tsl语言可视化组件库库,支持windows以及gtk(linux)%%
|
||
@auther 天软科技 %%
|
||
@date(20220223)
|
||
**}
|
||
{
|
||
更新说明
|
||
20220328整理代码
|
||
20200721 修改设计器中属性的显示控制,将属性持久化和设计器分离
|
||
20200515 整理代码去掉一些不需要使用的代码
|
||
20190612 添加缓存抽象 TCacheItem,TCacheList 对象
|
||
固定listview 固定在设计模式下表头宽度
|
||
20191115 删除popup窗口句柄
|
||
}
|
||
///////////平台判断////////
|
||
{$ifdef linux}
|
||
{$define gtkpaint}
|
||
{$define linuxgtk}
|
||
{$else}
|
||
{$define gdipaint}
|
||
{$endif}
|
||
interface
|
||
uses utslvclconstant,utslvclbase,utslvclauxiliary,cstructurelib,utslvclmemstruct,utslvclevent,
|
||
UVCPropertyTypesPersistence,utslvclgdi,utslvclaction,utslvclmenu,utslvclstdctl,utslvclpage,
|
||
utslvcldlg,utslvclgrid,utslvcltree,utslvclcoolbar;
|
||
function initializeapplication(); //获得app对象
|
||
function RegisterComponentType(n,typ); //注册控件,便于通过控件名称构造控件
|
||
function GetAndDispatchMessageA(hwnd,minm,maxm); //win32 分发消息
|
||
function ExitMessageLoop(); //退出主循环
|
||
//function gettswin32api(); //win32 api
|
||
function NotifyComponent(Sender,Act,ToComponent); //notfiy
|
||
//////////////////////操作/////////////////////
|
||
Function tslcstructure(data,dsize,pack,ptr);
|
||
|
||
//function CompareRect(orect,nrect);
|
||
function calldatafunction();
|
||
function CallMessgeFunction(f,o,e);
|
||
//////////////////////执行tsl脚本代码////////////////////
|
||
//function TSL_Check(func,funclen,oResult);
|
||
function CheckTslCode(code,err); //检查tsl语法
|
||
//function SysExecWait(handle,exe,cmd,dir,fui); //执行 win32 程序
|
||
//function TS_ModulePath();
|
||
//function TS_ExecPath();
|
||
//function TS_GetAppPath();
|
||
function TS_GetUserProfileHome();
|
||
//function TS_GetIniPath(hometype,IniName);
|
||
function CopyUsedTslDllToNewDir(p);
|
||
/////////////////////////////////////////////
|
||
function DeleteAllFiles(path);
|
||
function CreateDirWithFileName(fname);
|
||
//************************
|
||
//*******************************
|
||
function MessageBoxA(txt,title,flag,hd);
|
||
function _timeproc_(hwnd,message,wparam,lparam);//win32消息分发
|
||
function _twinproc_(hwnd,message,wparam,lparam);//win32消息分发
|
||
function _MessgeHook_a(hwnd,message,wparam,lparam);
|
||
function remotetslcallback(data);
|
||
//********其他辅助函数*******
|
||
function TslToHexFormatStr(tsl);
|
||
function HexFormatStrToTsl(D);
|
||
function GetTextWidthAndHeightWidthFont(s,f,mul);
|
||
//**********操作系统相关函数*********************
|
||
////////////////////////////////////
|
||
|
||
|
||
type TByteData = class(TByteDataOP)
|
||
end
|
||
///////////////////////////内存对象//////////////////////////////
|
||
|
||
//////////////////////////////////内存对象截止////////////////////////////////////////////////////
|
||
|
||
//******************常量类型**********************************
|
||
|
||
/////////////////////////////////
|
||
|
||
///////////////////////////消息对象////////////////////////////////////
|
||
|
||
|
||
|
||
///////////////tmf文件转换///////////////////////
|
||
type Ttfm2Component = class(TTmfParser)
|
||
{**
|
||
@explan(说明) tfm数据到组件转换 %%
|
||
**}
|
||
private
|
||
static FComponentTypes;
|
||
protected
|
||
class function sinit();override;
|
||
begin
|
||
inherited;
|
||
if not ifarray(FComponentTypes)then FComponentTypes := array();
|
||
end
|
||
function formatpath(s);
|
||
begin
|
||
r := "";
|
||
if s and ifstring(s)then
|
||
begin
|
||
for i := 1 to length(s) do
|
||
begin
|
||
vi := s[i];
|
||
if vi="/" then r += "\\";
|
||
else r += vi;
|
||
end
|
||
end
|
||
return r;
|
||
end
|
||
function GetExeScriptPath();
|
||
begin
|
||
{$ifdef linux}
|
||
p := tsl_getcurrentdir_();
|
||
return p+ioFileseparator()+SysParamstr(0);
|
||
{$endif}
|
||
pth2 := formatpath(sysparamstr(0));
|
||
if pth2[2]=":" then return pth2;
|
||
s := "";
|
||
setlength(s,1024);
|
||
N := GetCurrentDirectoryA(1023,s);
|
||
return s[1:N]+ioFileseparator()+SysParamstr(0);
|
||
end
|
||
public
|
||
class function RegisterComponentType(n,typ);
|
||
begin
|
||
if ifstring(n)and n and(typ is class(TComponent))then
|
||
begin
|
||
if not ifarray(FComponentTypes)then FComponentTypes := array();
|
||
FComponentTypes[lowercase(n)]:= typ;
|
||
end
|
||
end
|
||
class function GetComponentType(n);
|
||
begin
|
||
if(ifstring(n)and n)and ifarray(FComponentTypes)then
|
||
begin
|
||
nn := lowercase(n);
|
||
r := FComponentTypes[nn];
|
||
if r then return r;
|
||
return findclass(nn);
|
||
end
|
||
end
|
||
function SetTfmData(owner,obj,data,lazydata);
|
||
begin
|
||
u1 := obj.GetPublishproperties();
|
||
u2 := obj.GetPublishEvents();
|
||
if not ifarray(u1)then u1 := array();
|
||
if not ifarray(u2)then u2 := array();
|
||
pubs := u1 union u2;
|
||
dprop := data["property"];
|
||
ddp := array();
|
||
for i,v in dprop do
|
||
begin
|
||
ddp[v["name"]]:= v;
|
||
end
|
||
for i,v in pubs do
|
||
begin
|
||
n := i;
|
||
ddpv := ddp[n];
|
||
if not ifarray(ddpv)then continue;
|
||
cls := v["class"];
|
||
et := GetComponentPropertyType(cls);//owner.GetPropertyType(cls);
|
||
if not et then continue;
|
||
td := SampleValue(ddpv);
|
||
if et.LazyProperty()then
|
||
begin
|
||
if not ifarray(lazydata)then lazydata := array();
|
||
lazydata[length(lazydata)]:= array("et":et,"owner":owner,"ownerp":td,
|
||
"obj":obj,"objp":n);
|
||
continue;
|
||
end
|
||
d := et.ReadTMF(td,owner);
|
||
if ifnil(d)then continue;
|
||
try
|
||
pbs := obj.publishs();
|
||
if(n in pbs)then
|
||
begin
|
||
//echo "\r\n====",n,"****",d;
|
||
invoke(obj,n,1,d);
|
||
end else
|
||
begin
|
||
//echo "pbs:",tostn(pbs);
|
||
end
|
||
except
|
||
//echo obj.classinfo()["classname"],"错误 \r\n";
|
||
end;
|
||
end
|
||
for i,v in data["object"] do
|
||
begin
|
||
n := v["name"];
|
||
cls := v["class"];
|
||
cobj := GetComponentType(cls);
|
||
if cobj then
|
||
begin
|
||
nobj := createobject(cobj,owner);
|
||
try
|
||
if(nobj is class(TToolBar))then
|
||
begin
|
||
for iii,iiiv in v["property"] do
|
||
begin
|
||
if(iiiv["name"]="align")and(iiiv["value"]="alnone")then
|
||
begin
|
||
nobj.Align := nobj.alNone;
|
||
break;
|
||
end
|
||
end
|
||
end
|
||
nobj.parent := obj;
|
||
invoke(owner,n,1,nobj);
|
||
except
|
||
end;
|
||
call(thisfunction,owner,nobj,v,lazydata);
|
||
end
|
||
end
|
||
end
|
||
function Create();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function LoadFromTfmScript(owner,s);
|
||
begin
|
||
if s and ifstring(s)then
|
||
begin
|
||
self.Script := s;
|
||
lazydata := array();
|
||
//lazydata[0] := array();
|
||
darray := gettree();
|
||
SetTfmData(owner,owner,darray,lazydata);
|
||
for i,v in lazydata do
|
||
begin
|
||
try
|
||
dd := v["et"].ReadTMF(v["ownerp"],v["owner"]);
|
||
invoke(v["obj"],v["objp"],1,dd);
|
||
except
|
||
end;
|
||
end
|
||
end
|
||
end
|
||
function LoadFromTfm(owner);
|
||
begin
|
||
{**
|
||
@explan(说明) 从默认路径导入tfm文件信息 %%
|
||
**}
|
||
Loadinherited(owner); //导入
|
||
end
|
||
private
|
||
function Loadtfmtoform(o,phs,cn);
|
||
begin
|
||
for i,v in phs do
|
||
begin
|
||
pi := v+cn+".tfm";
|
||
size := filesize("",pi); //获取文件大小
|
||
if readFile(rwraw(),"",pi,0,size,data)=1 then
|
||
begin
|
||
LoadFromTfmScript(o,data);
|
||
return true;
|
||
end
|
||
end
|
||
end
|
||
function Loadinherited(o);//导入
|
||
begin
|
||
return Loadinherited_sub(o);
|
||
if not ifobj(o) then return ;
|
||
if not((o is class(TDCreateForm)) or (o is class(TDCreatePanel))) then return ;//判断类型
|
||
ci := o.classinfo;
|
||
cn := ci["classname"];
|
||
ic := ci["inherited"][0];
|
||
if ((cn<>"tdcreateform") and (cn<>"tdcreatepanel")) then
|
||
begin
|
||
Loadinherited(findclass(ic,o));
|
||
phs := static GetSourceDirs();
|
||
Loadtfmtoform(o,phs,cn);
|
||
end
|
||
end
|
||
function Loadinherited_sub(o);
|
||
begin
|
||
if not ifobj(o) then return ;
|
||
if not((o is class(TDCreateForm)) or (o is class(TDCreatePanel))) then return ;//判断类型
|
||
o2 := o;
|
||
phs := static GetSourceDirs();
|
||
objs := array();
|
||
while true do
|
||
begin
|
||
ci := o2.classinfo();
|
||
cn := ci["classname"];
|
||
ic := ci["inherited"][0];
|
||
if((cn<>"tdcreateform") and (cn<>"tdcreatepanel")) then
|
||
begin
|
||
objs[length(objs)] := cn;
|
||
o2 := findclass(ic,o2);
|
||
end else break;
|
||
end
|
||
for i := length(objs)-1 downto 0 do
|
||
begin
|
||
Loadtfmtoform(o,phs,objs[i]);
|
||
end
|
||
end
|
||
function GetSourceDirs();
|
||
begin
|
||
lps := GetLibPaths();
|
||
lps[length(lps)] := static GetCurrentTslDir()+"funcext"+ioFileseparator();
|
||
lps union2=array();
|
||
r := array();
|
||
for i,v in lps do
|
||
begin
|
||
GetReSourcetfmdir(v,r);
|
||
end
|
||
return r;
|
||
end
|
||
function GetReSourcetfmdir(p,rp);
|
||
begin
|
||
if not ifarray(rp) then rp := array();
|
||
iofp := ioFileseparator();
|
||
for ii,vv in filelist("",p+"*") do
|
||
begin
|
||
fn := vv["FileName"];
|
||
if fn="." or fn=".." then continue;
|
||
if Pos("D",vv["Attr"]) then
|
||
begin
|
||
if lowercase(fn)="resource.tfm" then
|
||
begin
|
||
rp[length(rp)] := p+"resource.tfm"+iofp;
|
||
end else
|
||
begin
|
||
GetReSourcetfmdir(p+fn+iofp,rp);
|
||
end
|
||
end
|
||
end
|
||
end
|
||
function GetLibPaths();
|
||
begin
|
||
p := tsl_getlibpath_();
|
||
if not p then return array();
|
||
FCurrentp := "";
|
||
{$ifdef linux}
|
||
FCurrentp := tsl_getcurrentdir_();
|
||
{$else}
|
||
s := "";
|
||
setlength(s,1024);
|
||
wapi := gettswin32api();
|
||
N := wapi.GetCurrentDirectoryA(1023,s);
|
||
FCurrentp := s[1:N];
|
||
{$endif}
|
||
FCurrentp1 := "";
|
||
iofp := ioFileseparator();
|
||
for i:= length(FCurrentp)-1 downto 1 do
|
||
begin
|
||
if FCurrentp[i] = iofp then
|
||
begin
|
||
FCurrentp1 := FCurrentp[1:i-1];
|
||
break;
|
||
end
|
||
end
|
||
ri := 0;
|
||
r := array();
|
||
iofp2 := "."+iofp;
|
||
iofp3 := ".."+iofp;
|
||
for i,v in str2array(p,";") do
|
||
begin
|
||
vi := trim(v);
|
||
if not vi then continue;
|
||
if vi[length(vi)]<>iofp then continue;
|
||
if pos(iofp2,vi)=1 then
|
||
begin
|
||
r[ri] := FCurrentp+vi[2:];
|
||
end else
|
||
if pos(iofp3,vi)=1 then
|
||
begin
|
||
r[ri] := FCurrentp1+vi[3:];
|
||
end
|
||
else
|
||
begin
|
||
r[ri] := vi;
|
||
end
|
||
ri++;
|
||
end
|
||
return r;
|
||
end
|
||
end
|
||
|
||
type TGlobalComponentcache=class
|
||
{**
|
||
@ignore(忽略) %%
|
||
@explan(说明) 窗口存储类 %%
|
||
@param(FWidowhandes)(array) 组件全局存储类 %%
|
||
**}
|
||
STATIC FWidowhandes;
|
||
class function getwndbyhwnd(hwnd);
|
||
begin
|
||
{**
|
||
@explan(说明) 根据id查找组件 %%
|
||
**}
|
||
sinit();
|
||
if ifnumber(hwnd)then return FWidowhandes[inttostr(hwnd)];
|
||
end
|
||
class function registerhandle(handle,o);
|
||
begin
|
||
{**
|
||
@explan(说明)保存组件对象 %%
|
||
**}
|
||
sinit();
|
||
if o is class(tcomponent)then
|
||
begin
|
||
//o.handle := handle;
|
||
if ifnumber(handle)then FWidowhandes[inttostr(handle)]:= o;
|
||
end
|
||
end
|
||
class function unregisterhandle(handle);
|
||
begin
|
||
{**
|
||
@explan(说明)删除组件对象 %%
|
||
**}
|
||
sinit();
|
||
if ifnumber(handle)then
|
||
begin
|
||
reindex(FWidowhandes,array(inttostr(handle):nil));
|
||
end
|
||
end
|
||
class function sinit();
|
||
begin
|
||
{**
|
||
@ignore(忽略) 忽略 %%
|
||
@explan(说明)初始化 %%
|
||
**}
|
||
if not ifarray(FWidowhandes)then
|
||
begin
|
||
FWidowhandes := array();
|
||
end
|
||
end
|
||
end
|
||
|
||
|
||
//应用
|
||
type tapplication=class(tcomponent)
|
||
{**
|
||
@explan(说明) application 窗口 %%
|
||
**}
|
||
private
|
||
static FApplicationWindow;
|
||
static FMessageObj;
|
||
//static Ftooltips;
|
||
FVisible;
|
||
FHandle; //句柄
|
||
Fmainform; //主窗口
|
||
FDebug;
|
||
//FTiptimer;
|
||
//FTiptimertag1;
|
||
Foldforminfo;
|
||
function SetVisible(v);
|
||
begin
|
||
FVisible := v?true:false;
|
||
if FApplicationWindow is class(TWinControl)then
|
||
begin
|
||
FApplicationWindow.visible := FVisible;
|
||
end
|
||
end
|
||
function SetMainForm(f);
|
||
begin
|
||
if not(f is class(TVCForm))then exit;
|
||
if f=Fmainform then exit;
|
||
if Fmainform then
|
||
begin
|
||
odf := Fmainform;
|
||
odf.onclose := Foldforminfo["close"];
|
||
odf.OnMinimize := Foldforminfo["minimize"];
|
||
end
|
||
Fmainform := f;
|
||
//{$ifdef linuxgtk}
|
||
//{$else}
|
||
if not(FApplicationWindow)then initialize();
|
||
if not(f.HandleAllocated())then
|
||
begin
|
||
f.parent := FApplicationWindow;
|
||
end
|
||
IC := f.FormIcon;
|
||
if(ic is class(tcustomicon))and ic.HandleAllocated then
|
||
begin
|
||
FApplicationWindow._send_(WM_SETICON,1,ic.handle,1);
|
||
end
|
||
FApplicationWindow.caption := f.caption;
|
||
//{$endif}
|
||
Foldforminfo := array("close":Fmainform.onclose,"minimize":Fmainform.OnMinimize);
|
||
Fmainform.onclose := thisfunction(mainformclose);
|
||
Fmainform.OnMinimize := thisfunction(mainformminmize);
|
||
end
|
||
function CreateHandle();
|
||
begin
|
||
if not FApplicationWindow then
|
||
begin
|
||
FApplicationWindow := new tapplicationwindow(self);
|
||
FApplicationWindow.Visible := FVisible;
|
||
end
|
||
//echo "???",tostn(FApplicationWindow.classinfo());
|
||
FHandle := FApplicationWindow.Handle;
|
||
end
|
||
public
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FVisible := false;
|
||
//FTiptimer := new ttimer();
|
||
//FTiptimer.Interval := 2000;
|
||
//FTiptimer.Ontimer := thisfunction(ontiptimer);
|
||
end
|
||
function WMACTIVATEAPP(o,e);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) active处理
|
||
**}
|
||
if Fmainform then
|
||
begin
|
||
if e.wparam then
|
||
begin
|
||
//_wapi.SetWindowPos(Fmainform.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE .|SWP_NOSIZE);
|
||
//Fmainform.Visible := true;//
|
||
Fmainform.show();
|
||
if Fmainform.HandleAllocated() then
|
||
begin
|
||
_wapi.SetForegroundWindow(Fmainform.handle);
|
||
end
|
||
end //Fmainform.Visible := true;
|
||
//else _wapi.SetWindowPos(Fmainform.Handle, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE .|SWP_NOSIZE);
|
||
end
|
||
end
|
||
function initialize();
|
||
begin
|
||
{**
|
||
@explan(说明) 初始化 %%
|
||
**}
|
||
CreateHandle();
|
||
FApplicationWindow.bindmessage(WM_ACTIVATEAPP,thisfunction(WMACTIVATEAPP));
|
||
end
|
||
function Notification(a,op);override;
|
||
begin
|
||
inherited;
|
||
if a=Fmainform and op="recycling" then
|
||
begin
|
||
Fmainform := nil;
|
||
end
|
||
end
|
||
function createform(classname,varable);
|
||
begin
|
||
{**
|
||
@explan(说明) 构造主窗口%%
|
||
@param(classname)(class of TVCForm) 主窗口类 %%
|
||
@param(varable)() tsl变量返回ClassName 构造的窗口对象 %%
|
||
**}
|
||
if paramcount<2 then exit; //变量不够
|
||
if classname is class(tcomponent)then
|
||
begin
|
||
//if not(FApplicationWindow)then
|
||
initialize();
|
||
varable := createobject(classname,FApplicationWindow);
|
||
if varable is class(TVCForm)then
|
||
begin
|
||
varable.parent := FApplicationWindow;
|
||
if not Fmainform then
|
||
begin
|
||
SetMainForm(varable);
|
||
end
|
||
end
|
||
end
|
||
end
|
||
function mainformclose(o,e);
|
||
begin
|
||
{**
|
||
@ignore(忽略) %%
|
||
**}
|
||
CallMessgeFunction(Foldforminfo["close"],o,e);
|
||
if e.skip then exit;
|
||
FApplicationWindow._send_(WM_CLOSE,0,0);
|
||
end
|
||
function mainformminmize(o,e);
|
||
begin
|
||
{**
|
||
@ignore(忽略) %%
|
||
**}
|
||
CallMessgeFunction(Foldforminfo["minimize"],o,e);
|
||
//e.skip := true;
|
||
//if Fmainform then Fmainform.Visible := false;
|
||
//FApplicationWindow._send_(,0,0);
|
||
end
|
||
function run();
|
||
begin
|
||
{**
|
||
@explan(说明) 运行主循环 %%
|
||
**}
|
||
initialize();
|
||
{$ifdef linuxgtk}
|
||
idledata :=(new tcbytearray(4))._getptr_();
|
||
id := tsl_gtk_idle_interface(idledata);//_wapi.tsl_gtk_idle_interface(idledata); //构造idle
|
||
_wapi.gtk_main();
|
||
_Wapi.g_idle_remove_by_data(idledata); //删除idle
|
||
return 1;
|
||
{$endif}
|
||
if not FMessageObj then FMessageObj := new TTagMSG();
|
||
ptr := FMessageObj._getptr_;
|
||
while true do
|
||
begin
|
||
if(_wapi.PeekMessageA(ptr,0,0,0,0x1))then
|
||
begin
|
||
if FMessageObj.message=0x12 then
|
||
begin
|
||
return 1;
|
||
end else
|
||
begin
|
||
_wapi.TranslateMessage(ptr);
|
||
_wapi.DispatchMessageA(ptr);
|
||
end
|
||
end else
|
||
begin
|
||
tslprocessmessages(false);
|
||
RunWorkerThreadLoop();
|
||
_wapi.WaitMessage();
|
||
end
|
||
end
|
||
{while (_wapi.GetMessageA(ptr, 0, 0, 0)) do
|
||
begin
|
||
_wapi.TranslateMessage(ptr);
|
||
_wapi.DispatchMessageA(ptr);
|
||
end}
|
||
return 1;
|
||
end
|
||
function GetApplicationWindow();
|
||
begin
|
||
return FApplicationWindow;
|
||
end
|
||
function ShowErrorMessage(msg);
|
||
begin
|
||
{**
|
||
@explan(说明)错误提示信息 %%
|
||
**}
|
||
if FDebug and ifstring(msg)then messageboxA(msg,"错误提示",1);
|
||
end
|
||
function CloseMainForm();
|
||
begin
|
||
{**
|
||
@explan(说明) 关闭主窗口 %%
|
||
**}
|
||
if FApplicationWindow is class(TVCForm)then FApplicationWindow._send_(WM_CLOSE,0,0);
|
||
else _wapi.PostQuitMessage(0);
|
||
end
|
||
function Close();
|
||
begin
|
||
CloseMainForm();
|
||
end
|
||
property Visible read FVisible write SetVisible;
|
||
property handle read FHandle;
|
||
property IfDebug read FDebug write FDebug;
|
||
property MainForm read Fmainform write SetMainForm;
|
||
end
|
||
|
||
type TLabel = class(TGraphicControl)
|
||
{**
|
||
@explan(说明)标签控件 %%
|
||
**}
|
||
private
|
||
FTextAlign;
|
||
function SetTextAlign(v);
|
||
begin
|
||
if v <> FTextAlign then
|
||
begin
|
||
FTextAlign := v;
|
||
InvalidateRect(nil,true);
|
||
end
|
||
end
|
||
protected
|
||
function SetControlFont(v);override;
|
||
begin
|
||
inherited;
|
||
//invalidaterect(nil,true);
|
||
invalidaterect(nil,false);
|
||
end
|
||
public
|
||
function paint();override;
|
||
begin
|
||
dc := canvas;
|
||
dc.font := font;
|
||
rc := ClientRect;
|
||
if border then
|
||
begin
|
||
rc[0]+= 1;
|
||
rc[1]+= 1;
|
||
rc[2]-= 1;
|
||
rc[3]-= 1;
|
||
end
|
||
CanvasDrawAlignText(dc,rc,self.Caption,FTextAlign);
|
||
if border then
|
||
begin
|
||
dc.Draw("polyline",array((rc[0],rc[1]),(rc[2],rc[1]),(rc[2],rc[3]),(rc[0],rc[3]),(rc[0],rc[1])));
|
||
end
|
||
end
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
caption := "label";
|
||
FTextAlign := 0;
|
||
//border := true;
|
||
end
|
||
class function CanvasDrawAlignText(dc,rect,txt,al);
|
||
begin
|
||
{**
|
||
@explan(说明) 在指定区域内按照对齐方式绘制文本%%
|
||
@param(al)(member of TAlignStyle9) 对齐方式 %%
|
||
**}
|
||
if not(dc is class(TCustomcanvas))then exit;
|
||
als := array(36,0,33
|
||
,2,36
|
||
,37
|
||
,38,40
|
||
,41
|
||
,42);
|
||
val := als[al];
|
||
if ifnil(val)then val := 36;
|
||
return dc.drawtext(txt,rect,val .| DT_NOPREFIX);
|
||
end
|
||
property TextAlign:AlignStyle9 read FTextAlign write SetTextAlign;
|
||
function publishs();override;
|
||
begin
|
||
return array("name","action","align","anchors","caption","enabled","font",
|
||
"popupmenu","visible","textalign",
|
||
"height","width","left","top","color","bkbitmap","parentcolor","parentfont","transparent",
|
||
"onpopupmenu","onmousedown","onmouseup");
|
||
end
|
||
{**
|
||
@param(TextAlign)(member of TAlignStyle9) 文字对齐 %%
|
||
**}
|
||
end
|
||
//窗口
|
||
|
||
type TSysControl=class(TWincontrol)
|
||
{**
|
||
@explan(说明) 系统绘制窗口,屏蔽绘制和背景处理,加快速度 %%
|
||
**}
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function WMPAINT(o,e):WM_PAINT;override;
|
||
begin
|
||
if not Font.HandleAllocated()then
|
||
begin
|
||
FontChanged();
|
||
end
|
||
end
|
||
function WMERASEBKGND(o,e):WM_ERASEBKGND;override;
|
||
begin
|
||
end
|
||
end
|
||
type TWinControlWraper=class(TWinControl)
|
||
{**
|
||
@explan(说明) 包裹window句柄类,继承该类,根据CreateWnd 注释的提示重写该函数
|
||
实现其他窗口库(必须含有句柄)和tslvcl库的对象兼容%%
|
||
**}
|
||
private
|
||
FWindowInfo;
|
||
protected
|
||
function WrapHandle(h);
|
||
begin
|
||
{**
|
||
@explan(说明) 包裹句柄,重写 CreateWnd中调用 %%
|
||
**}
|
||
oh := Handle;
|
||
if _wapi.IsWindow(h)and h <> oh then
|
||
begin
|
||
if oh then
|
||
begin
|
||
WMNCDESTROY(self(true),new tuieventbase(0,0,0,0));
|
||
end
|
||
_wapi.GetWindowInfo(h,FWindowInfo._getptr_);
|
||
rc := FWindowInfo.rcwindow;
|
||
FLeft := rc[0];
|
||
FTop := rc[1];
|
||
FWidth := rc[2]-rc[0];
|
||
FHeight := rc[3]-rc[1];
|
||
old := _wapi.SetWindowLongPtrA(h,GWLP_WNDPROC,getwinprocptr());
|
||
FDefWndproc := old;
|
||
class(tUIglobalData).uigetdata("TGlobalComponentcache").registerhandle(h,self(true));
|
||
Handle := h;
|
||
end
|
||
end
|
||
public
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FWindowInfo := new TWINDOWINFO();
|
||
end
|
||
function WMNCDESTROY(o,e):WM_NCDESTROY;override;
|
||
begin
|
||
if HandleAllocated()then
|
||
begin
|
||
h := Handle;
|
||
_wapi.SetWindowLongPtrA(h,GWLP_WNDPROC,FDefWndproc);
|
||
class(tUIglobalData).uigetdata("TGlobalComponentcache").unregisterhandle(h);
|
||
end
|
||
inherited;
|
||
end
|
||
function CreateWnd();override;
|
||
begin
|
||
{**
|
||
@explan(说明) 重写该函数构造句柄 包括三部分
|
||
//************获得构造参数*************************
|
||
CreateParams(p); //构造参数函数
|
||
tcc := p.Caption; //标题
|
||
stl := p.style;
|
||
x := p.x; //下边
|
||
y := p.y; //上边
|
||
w := p.width;//宽度
|
||
h := p.height; //高度
|
||
phandle := p.WndParent; //父窗口句柄
|
||
//***********构造句柄******************
|
||
//****************************************
|
||
//***********包裹句柄*************************
|
||
WrapHandle(thandle); //包裹句柄
|
||
//************初始化*************************
|
||
InitializeWnd(); //初始化
|
||
ControlCreateWnd(); //构造子窗口句柄
|
||
**}
|
||
end
|
||
end
|
||
|
||
type TScrollingWinControl = class(TCustomScrollControl)
|
||
{**
|
||
@explan(说明) 滚动条窗口 %%
|
||
**}
|
||
protected
|
||
function GetClientXCapacity();virtual; //宽度容量
|
||
begin
|
||
return integer(ClientRect[2]/GetXScrollDelta());
|
||
end
|
||
function GetClientYCapacity();virtual; //高度容量
|
||
begin
|
||
return integer(ClientRect[3]/GetYScrollDelta());
|
||
end
|
||
function GetClientXCount();virtual; //宽度间隔
|
||
begin
|
||
wd := 0;
|
||
for i := 0 to Controls.Count-1 do
|
||
begin
|
||
c := Controls[i];
|
||
if(c is class(TWinControl))and c.WsPopUp then continue; //处理
|
||
br := c.Left+c.Width;
|
||
wd := max(wd,br);
|
||
end
|
||
return integer(wd/GetXScrollDelta());
|
||
end
|
||
function GetClientYCount();virtual; //高度项
|
||
begin
|
||
h := 0;
|
||
for i := 0 to Controls.Count-1 do
|
||
begin
|
||
c := Controls[i];
|
||
if(c is class(TWinControl))and c.WsPopUp then continue; //处理
|
||
br := c.Top+c.Height;
|
||
h := max(h,br);
|
||
end
|
||
return integer(h/GetYScrollDelta());
|
||
end
|
||
function PositionChanged();virtual;
|
||
begin
|
||
dx := GetXScrollDelta()* GetDeltaXPos();
|
||
dy := GetYScrollDelta()* GetDeltaYPos();
|
||
for i := 0 to Controls.Count-1 do
|
||
begin
|
||
c := Controls[i];
|
||
if(c is class(TWinControl))and c.WsPopUp then
|
||
begin
|
||
continue;
|
||
end
|
||
c.Top -= dy;
|
||
c.Left -= dx;
|
||
end
|
||
end
|
||
public
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
ThumbTrack := TRUE;
|
||
end
|
||
function doControlALign();override;
|
||
begin
|
||
if AutoScroll then InitialScroll();
|
||
else inherited;
|
||
end
|
||
function DoControlAnchor();virtual;
|
||
begin
|
||
if AutoScroll then return;
|
||
inherited;
|
||
end
|
||
end
|
||
|
||
type TPanel=class(TScrollingWinControl) //容器
|
||
{**
|
||
@explan(说明) 面板控件 %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
caption := "panel";
|
||
height := 300;
|
||
width := 300;
|
||
AutoScroll := false;
|
||
WsDlgModalFrame := true;
|
||
//color := _wapi.GetSysColor(COLOR_MENU);
|
||
end
|
||
function CreateParams(p);override;
|
||
begin
|
||
inherited;
|
||
p.WinClassName := "tui_panel";
|
||
p.cstyle := CS_HREDRAW .| CS_VREDRAW .| CS_OWNDC .| CS_DBLCLKS;
|
||
//p.exstyle := 0x101;
|
||
end
|
||
function paint();override;
|
||
begin
|
||
inherited;
|
||
drawdesigninggrid();
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","align","anchors","caption","enabled","cursor","font",
|
||
"popupmenu","visible",
|
||
"height","width","left","top","border",
|
||
"zorder","color","bkbitmap","parentcolor","parentfont",
|
||
"minwidth","minheight",
|
||
"wspopup","wsdlgmodalframe","wscaption","wssizebox","wssysmenu",
|
||
"autoscroll",
|
||
"onmousewheel","onsize","onmove","onmousemove","onpopupmenu",
|
||
"onmousedown","onmouseup",
|
||
"onactivate","onclose",
|
||
"onsetfocus","onkillfocus",
|
||
"onkeyup","onkeydown","onkeypress"
|
||
);
|
||
end
|
||
end
|
||
//托盘
|
||
type TTray=class(TComponent)
|
||
{**
|
||
@explan(说明) 托盘类 %%
|
||
**}
|
||
private
|
||
FNid;
|
||
FTrayID;
|
||
FIcon;
|
||
FHaveadd;
|
||
FPopupMenu;
|
||
FOnclick;
|
||
FOnMouseMove;
|
||
static FSIDC; //id 构造器
|
||
FCaption;
|
||
FForm;
|
||
function SetCaption(v);
|
||
begin
|
||
if v <> FCaption then
|
||
begin
|
||
if ifstring(v)then
|
||
begin
|
||
FCaption := v;
|
||
end else
|
||
begin
|
||
FCaption := "";
|
||
end
|
||
FNid.sztip := FCaption;
|
||
if FHaveadd then
|
||
begin
|
||
_wapi.Shell_NotifyIconA(NIM_MODIFY,FNid._getptr_);
|
||
end
|
||
end
|
||
end
|
||
function seticonhandle(ic);
|
||
begin
|
||
if(ic is class(tcustomicon))and ic.HandleAllocated()and FHaveadd then
|
||
begin
|
||
Fnid.uFlags := NIF_ICON .| NIF_MESSAGE .| NIF_TIP .| NIF_INFO;
|
||
Fnid.hicon := ic.Handle;
|
||
_wapi.Shell_NotifyIconA(NIM_MODIFY,FNid._getptr_);
|
||
end
|
||
end
|
||
function SetIcon(v);
|
||
begin
|
||
if v=FIcon then exit;
|
||
FIcon := v;
|
||
seticonhandle(FIcon);
|
||
end
|
||
function SetForm(f);
|
||
begin
|
||
if FForm=f then exit;
|
||
if FHaveadd then
|
||
begin
|
||
TrayDelete();
|
||
end
|
||
FForm := f;
|
||
TrayAdd();
|
||
end
|
||
public
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FHaveadd := false;
|
||
if not FSIDC then FSIDC := new tidcreater(1);
|
||
FTrayID := FSIDC.CreateId();
|
||
FNid := new TNOTIFYICONDATAA();
|
||
FNid.uID := FTrayID;
|
||
FNid.ucallbackmessage := WM_TRAY;
|
||
end
|
||
function ShowTrayMessage(title,text);
|
||
begin
|
||
{**
|
||
@ignore(忽略) %%
|
||
@explan(说明) 显示托盘消息 %%
|
||
@param(title)(string)标题 %%
|
||
@param(text)(string) 消息 %%
|
||
|
||
**}
|
||
if not FHaveadd then exit;
|
||
if not(ifstring(title)and ifstring(text))then exit;
|
||
if not((FForm is class(TVCForm))and FForm.HandleAllocated)then exit;
|
||
FNid.szinfotitle := title+"\0";
|
||
FNid.szinfo := text+"\0";
|
||
FNid.utimeout := 1000;
|
||
_wapi.Shell_NotifyIconA(NIM_MODIFY,FNid._getptr_);
|
||
end
|
||
function ShowPopUpMenu();
|
||
begin
|
||
if not FHaveadd then exit;
|
||
if FPopupMenu is class({TcustomPopupmenu}TcustomMenu)then
|
||
begin
|
||
ps := array(x,y);
|
||
_wapi.GetCursorPos(ps);
|
||
uf := TPM_LEFTALIGN .| TPM_TOPALIGN .| TPM_RIGHTBUTTON;
|
||
hd := FForm.Handle;
|
||
_wapi.SetForegroundWindow(hd);
|
||
_wapi.TrackPopupMenu(FPopupMenu.Handle,uf,ps[0],ps[1],0,hd,nil);
|
||
return true;
|
||
end
|
||
end
|
||
function Notification(AComponent:TComponent;Operation:TOperation);override;
|
||
begin
|
||
{**
|
||
@explan(说明) 通知消息处理 %%
|
||
**}
|
||
if Operation="recycling" then //opRemove
|
||
begin
|
||
if FPopupMenu=AComponent then
|
||
begin
|
||
FPopupMenu := nil;
|
||
end
|
||
if FForm=AComponent then
|
||
begin
|
||
Form := nil;
|
||
end
|
||
end;
|
||
inherited;
|
||
end;
|
||
function Recycling();override;
|
||
begin
|
||
FIcon := nil;
|
||
TrayDelete();
|
||
FForm := nil;
|
||
FPopupMenu := nil;
|
||
inherited;
|
||
end
|
||
//添加到托盘栏
|
||
function TrayAdd();
|
||
begin
|
||
{**
|
||
@ignore(忽略) %%
|
||
@explan(说明) 添加 %%
|
||
**}
|
||
if FHaveadd then exit;
|
||
if(FForm is class(TVCForm))and FForm.HandleAllocated()then
|
||
begin
|
||
FNid.hWnd := FForm.Handle;
|
||
if not FIcon then FIcon := FForm.FormIcon;
|
||
if FIcon is class(tcustomicon)then
|
||
begin
|
||
FNid.hIcon := FIcon.Handle;
|
||
end
|
||
if ifstring(FCaption)then FNid.sztip := FCaption;
|
||
else FNid.sztip := FForm.Caption;
|
||
//FNid.dwInfoFlags := 1;
|
||
Fnid.uFlags := NIF_ICON .| NIF_MESSAGE .| NIF_TIP .| NIF_INFO;
|
||
_wapi.Shell_NotifyIconA(NIM_ADD,FNid._getptr_);
|
||
FHaveadd := true;
|
||
end
|
||
end
|
||
//从托盘栏删除
|
||
function TrayDelete();
|
||
begin
|
||
{**
|
||
@ignore(忽略) %%
|
||
@explan(说明) 删除 %%
|
||
**}
|
||
if FHaveadd then
|
||
begin
|
||
_wapi.Shell_NotifyIconA(nim_delete,FNid._getptr_);
|
||
FHaveadd := false;
|
||
end
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","caption","icon","popupmenu","onclick");
|
||
end
|
||
property Form read FForm write SetForm;
|
||
property Caption:string read FCaption write SetCaption;
|
||
property OnClick:eventhandler read FOnclick write FOnclick;
|
||
property OnMouseMove:eventhandler read FOnMouseMove write FOnMouseMove;
|
||
property Icon:ticon read FIcon write SetIcon;
|
||
property PopupMenu:TPopUpmenu read FPopupMenu write FPopupMenu;
|
||
property TrayId read FTrayID;
|
||
end
|
||
type TVCForm = class(TScrollingWinControl)
|
||
{**
|
||
@explan(说明)主窗口类 %%
|
||
**}
|
||
private
|
||
FOnMinimize;
|
||
FMainMenu;
|
||
FTray;
|
||
FFormBorderStyle;
|
||
FMaxminbox;
|
||
FFormIcon;
|
||
function traypopmenu();
|
||
begin
|
||
if(FTray is class(TTray))then
|
||
begin
|
||
tp := FTray.PopupMenu;
|
||
if tp is class({TcustomPopupmenu}TcustomMenu)then
|
||
begin
|
||
return tp;
|
||
end
|
||
end
|
||
end
|
||
function SetTray(t);
|
||
begin
|
||
if FTray=t then exit;
|
||
FTray := t;
|
||
if csDesigning in ComponentState then
|
||
begin
|
||
return;
|
||
end
|
||
if FTray is class(TTray)then
|
||
begin
|
||
FTray.Form := self(true);
|
||
end
|
||
end
|
||
function seticonhandle();
|
||
begin
|
||
if HandleAllocated()and(FFormIcon is class(tcustomicon))and FFormIcon.HandleAllocated()then
|
||
begin
|
||
_send_(WM_SETICON,1,FFormIcon.handle,1);
|
||
end else
|
||
_send_(WM_SETICON,1,0,1);
|
||
end
|
||
function SetFormIcon(v);
|
||
begin
|
||
if v=FFormIcon then exit;
|
||
FFormIcon := v;
|
||
return seticonhandle();
|
||
if csDesigning in ComponentState then
|
||
begin
|
||
FFormIcon := v;
|
||
return;
|
||
end
|
||
if v is class(tcustombitmap)then
|
||
begin
|
||
if v.HandleAllocated()then
|
||
begin
|
||
vn := v.tovcon();
|
||
end
|
||
end
|
||
if ifarray(v)or ifarray(vn)then
|
||
begin
|
||
if not(FFormIcon is class(tcustomicon))then FFormIcon := new tcustomicon();
|
||
FFormIcon.readvcon(v?v:vn);
|
||
seticonhandle();
|
||
end //else
|
||
end
|
||
function GetFormIcon();
|
||
begin
|
||
return FFormIcon;
|
||
end
|
||
function SetMaxMinBox(v);
|
||
begin
|
||
nv := v?true:false;
|
||
if nv <> FMaxminbox then
|
||
begin
|
||
FMaxminbox := nv;
|
||
if HandleAllocated()then
|
||
begin
|
||
if nv then appendwstyle(WS_MAXIMIZEBOX .| WS_MINIMIZEBOX);
|
||
else minuswstyle(WS_MAXIMIZEBOX .| WS_MINIMIZEBOX);
|
||
end
|
||
end
|
||
end
|
||
function SetFormBorderStyle(NewStyle);
|
||
begin
|
||
//if FFormBorderStyle = NewStyle then exit;
|
||
end
|
||
function SetMainMenu(mu);
|
||
begin
|
||
if FMainMenu <> mu then
|
||
begin
|
||
OM := FMainMenu;
|
||
if OM is class(TcustomMainmenu)then
|
||
begin
|
||
OM.DestroyHandle(); //删除句柄 %%
|
||
OM.Hwnd := 0;
|
||
//if HandleAllocated() then _wapi.SetMenu(self.Handle,0); //删除窗口上面的菜单句柄
|
||
end
|
||
if(mu is class(TcustomMainmenu))then
|
||
begin
|
||
if HandleAllocated()then
|
||
begin
|
||
mu.Hwnd := handle;
|
||
//_wapi.SetMenu(self.Handle,mu.handle);
|
||
end
|
||
end
|
||
FMainMenu := mu;
|
||
end
|
||
end
|
||
function GetWsSysMenu();override;
|
||
begin
|
||
return true;
|
||
end
|
||
function SetWsSysMenu(v);override;
|
||
begin
|
||
end
|
||
function SetBorder(v);override;
|
||
begin
|
||
end
|
||
function SetWsPopUp(v);override;
|
||
begin
|
||
end
|
||
function GetWsPopUp();override;
|
||
begin
|
||
return true;
|
||
end
|
||
{
|
||
function GetWsCaption(v);override;
|
||
begin
|
||
return true;
|
||
end
|
||
function SetWsCaption(v);override;
|
||
begin
|
||
|
||
end }
|
||
public
|
||
class function MenuBarHeight();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得菜单栏的高度 %%
|
||
@return(integer) 高度 %%
|
||
**}
|
||
return _wapi.GetSystemMetrics(SM_CYMENU);
|
||
end
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FFormBorderStyle := bsNone;
|
||
caption := "tform";
|
||
rc := _wapi.GetScreenRect();
|
||
wd :=(rc[2]-rc[0])/2;
|
||
h :=(rc[3]-rc[1])/2;
|
||
FLeft := rc[0]+wd/2;
|
||
FTop := rc[1]+h/2;
|
||
FHeight := h;
|
||
FWidth := wd;
|
||
Color := 0x00FFFFFF;
|
||
cursor := IDC_ARROW; //OCR_NORMAL;
|
||
WsPopUp := true;
|
||
FMaxminbox := true;
|
||
WsCaption := true;
|
||
WSSizebox := true;
|
||
end
|
||
function WMTIMER(o,e):WM_TIMER;virtual;
|
||
begin
|
||
//echo "\r\ntimer";
|
||
end
|
||
function WMTRAY(o,e):WM_TRAY;virtual;
|
||
begin
|
||
if not(FTray is class(TTray))then exit;
|
||
case e.lParam of
|
||
WM_RBUTTONUP:
|
||
begin
|
||
//左键
|
||
FTray.ShowPopUpMenu();
|
||
end
|
||
WM_LBUTTONUP:
|
||
begin
|
||
if Visible and HandleAllocated()then _wapi.SetForegroundWindow(self.Handle);
|
||
CallMessgeFunction(FTray.OnClick,FTray,e);
|
||
end
|
||
WM_MOUSEMOVE:
|
||
begin
|
||
CallMessgeFunction(FTray.OnMouseMove,FTray,e);
|
||
end
|
||
end;
|
||
end
|
||
function IsContainer(cd);override;
|
||
begin
|
||
{**
|
||
@explan(说明) 重写该方法,该类可以作为容器 %%
|
||
**}
|
||
if cd is class(TComponent)then return Controls.indexof(cd)<0;
|
||
return true;
|
||
end
|
||
function Paint();override;
|
||
begin
|
||
inherited;
|
||
drawdesigninggrid();
|
||
end
|
||
function WMSYSCOMMAND(o,e):WM_SYSCOMMAND;override;
|
||
begin
|
||
{**
|
||
@explan(说明)系统菜单消息处理 %%
|
||
**}
|
||
if e.wparam=SC_MINIMIZE then
|
||
begin
|
||
CallMessgeFunction(OnMinimize,o,e);
|
||
end else
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
function WMCOMMAND(o,e):WM_COMMAND;override;
|
||
begin
|
||
{**
|
||
@explan(说明) command 消息处理
|
||
**}
|
||
if(FMainMenu is class(TcustomMainmenu))and FMainMenu.dispatch(e)then exit;
|
||
trp := traypopmenu();
|
||
if trp and trp.dispatch(e)then exit;
|
||
inherited;
|
||
end
|
||
function wmcreate(o,e):WM_CREATE;override;
|
||
begin
|
||
inherited;
|
||
//echo "\r\ncreate:",o.caption;
|
||
end
|
||
function WMMEASUREITEM(o,e):WM_MEASUREITEM;override;
|
||
begin
|
||
if e.wparam=0 and(FMainMenu is class(TcustomMainmenu))and FMainMenu.dispatch(e)then exit;
|
||
trp := traypopmenu();
|
||
if trp and trp.dispatch(e)then exit;
|
||
inherited;
|
||
end
|
||
function WMMENURBUTTONUP(o,e):WM_MENURBUTTONUP;override;
|
||
begin
|
||
if(FMainMenu is class(TcustomMainmenu))and FMainMenu.dispatch(e)then exit;
|
||
trp := traypopmenu();
|
||
if trp and trp.dispatch(e)then exit;
|
||
inherited;
|
||
end
|
||
function WMMENUSELECT(o,e):WM_MENUSELECT;override;
|
||
begin
|
||
if(FMainMenu is class(TcustomMainmenu))and FMainMenu.dispatch(e)then exit;
|
||
trp := traypopmenu();
|
||
if trp and trp.dispatch(e)then exit;
|
||
inherited;
|
||
end
|
||
function WMINITMENUPOPUP(o,e):WM_INITMENUPOPUP;override;
|
||
begin
|
||
if(FMainMenu is class(TcustomMainmenu))and FMainMenu.dispatch(e)then exit;
|
||
trp := traypopmenu();
|
||
if trp and trp.dispatch(e)then exit;
|
||
inherited;
|
||
end
|
||
function WMDRAWITEM(o,e):WM_DRAWITEM;override;
|
||
begin
|
||
if e.wparam=0 and(FMainMenu is class(TcustomMainmenu))then
|
||
begin
|
||
e.canvas := canvas;
|
||
canvas.handle := e.hdc;
|
||
r := FMainMenu.Dispatch(e);
|
||
e.canvas := nil;
|
||
if r then exit;
|
||
end
|
||
trp := traypopmenu();
|
||
if e.wparam=0 and trp then
|
||
begin
|
||
e.canvas := canvas;
|
||
canvas.handle := e.hdc;
|
||
r := trp.Dispatch(e);
|
||
e.canvas := nil;
|
||
if r then exit;
|
||
end
|
||
inherited;
|
||
end
|
||
function createparams(p);override;
|
||
begin
|
||
inherited;
|
||
p.WinClassName := "tsui_form"; //"tsui_form";
|
||
//p.style :=( p.style .| WS_TILEDWINDOW );// .& (.! ( WS_CHILD));//WS_GROUP .| WS_TABSTOP .|
|
||
p.style .|= WS_OVERLAPPED .| WS_SYSMENU .| WS_POPUP .| WS_MINIMIZEBOX .| WS_MAXIMIZEBOX;
|
||
p.style := bitcombination(p.style,WS_CHILD .| WS_GROUP .| WS_TABSTOP,2);
|
||
//P.style .|= WS_CLIPSIBLINGS;
|
||
if minmaxbox then
|
||
begin
|
||
p.style .|= WS_MAXIMIZEBOX .| WS_MINIMIZEBOX;
|
||
end else
|
||
begin
|
||
p.style := bitcombination(p.style,WS_MAXIMIZEBOX .| WS_MINIMIZEBOX,2);
|
||
end
|
||
P.ExStyle := P.ExStyle .| WS_EX_APPWINDOW;
|
||
//p.style :=0xcf0000 .| 0x0008 .| 0x02000000L .|0x04000000L ;//.| WS_VSCROLL .| WS_HSCROLL;// WS_VISIBLE .| WS_POPUP .| WS_CAPTION .| WS_CLIPSIBLINGS .| WS_SYSMENU .| WS_MINIMIZE .| WS_MAXIMIZEBOX;
|
||
p.cstyle := CS_HREDRAW .| CS_VREDRAW .| CS_OWNDC .| CS_DBLCLKS;
|
||
end
|
||
procedure FontChanged(Sender:TObject);override;
|
||
begin
|
||
if(HandleAllocated())then
|
||
begin
|
||
_send_(WM_SETFONT,Font.Handle,1);
|
||
end else
|
||
inherited;
|
||
end
|
||
function DestroyHandle();override;
|
||
begin
|
||
if FMainMenu is class(TcustomMainmenu)then
|
||
begin
|
||
FMainMenu.DestroyHandle();
|
||
end
|
||
if FTray is class(TTray)then
|
||
begin
|
||
FTray.TrayDelete();
|
||
end
|
||
inherited;
|
||
end
|
||
function InitializeWnd();override;
|
||
begin
|
||
if HandleAllocated()then
|
||
begin
|
||
if FMainMenu is class(TcustomMainmenu)then
|
||
begin
|
||
FMainMenu.Hwnd := handle;
|
||
end
|
||
seticonhandle();
|
||
if FTray is class(TTray)then
|
||
begin
|
||
FTray.TrayAdd();
|
||
end
|
||
end
|
||
end
|
||
function Notification(AComponent:TComponent;Operation:TOperation);override;
|
||
begin
|
||
{**
|
||
@explan(说明) 通知消息处理 %%
|
||
**}
|
||
if Operation="recycling" then //opRemove
|
||
begin
|
||
if AComponent=FMainMenu then FMainMenu := nil;
|
||
if FTray=AComponent then
|
||
begin
|
||
FTray := nil;
|
||
end
|
||
end;
|
||
inherited;
|
||
end;
|
||
property OnMinimize:eventhandler read FOnMinimize write FOnMinimize;
|
||
property MainMenu:tmainmenu read FMainMenu write SetMainMenu;
|
||
property minmaxbox:bool read FMaxminbox write SetMaxMinBox;
|
||
{**
|
||
@param(MainMenu)(tmainmenu) 主菜单 %%
|
||
@param(OnMinimize)(function[self,tuieventbase]) 主菜单 %%
|
||
**}
|
||
property BorderStyle:TFormBorderStyle read FFormBorderStyle write SetFormBorderStyle;
|
||
property FormIcon:ticon read GetFormIcon write SetFormIcon;
|
||
property Tray:ttray READ FTray write SetTray;
|
||
function publishs();override;
|
||
begin
|
||
return array(
|
||
"name","action","caption","cursor","font",
|
||
"popupmenu","visible",
|
||
"height","width","left","top",
|
||
"color","bkbitmap","parentcolor","parentfont",
|
||
"minwidth","minheight","wssizebox","wsdlgmodalframe",
|
||
"mainmenu","minmaxbox","formicon","tray",
|
||
"onsize","onmove","onmousemove",
|
||
"onmousedown","onmouseup",
|
||
"onactivate","onclose",
|
||
"onsetfocus","onkillfocus",
|
||
"onkeyup","onkeydown","onkeypress"
|
||
);
|
||
end
|
||
|
||
end
|
||
type tform=class(TVCForm)
|
||
{**
|
||
@explan(说明) 可能和web全局重名不建议使用 %%
|
||
**}
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
type TpanelForm=class(tpanel)
|
||
{**
|
||
@explan(说明) 面板窗口 ,在设计器中使用 %%
|
||
**}
|
||
protected
|
||
function SetWsPopUp(v);override;
|
||
begin
|
||
if csDesigning in ComponentState then
|
||
begin
|
||
end else
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
function GetWsPopUp();override;
|
||
begin
|
||
if csDesigning in ComponentState then
|
||
begin
|
||
return true;
|
||
end else
|
||
begin
|
||
return inherited;
|
||
end
|
||
end
|
||
public
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
rc := _wapi.GetScreenRect();
|
||
wd :=(rc[2]-rc[0])/3;
|
||
h :=(rc[3]-rc[1])/3;
|
||
FLeft := rc[0]+wd/2;
|
||
FTop := rc[1]+h/2;
|
||
FHeight := h;
|
||
FWidth := wd;
|
||
wspopup := true;
|
||
end
|
||
function Paint();override;
|
||
begin
|
||
inherited;
|
||
drawdesigninggrid();
|
||
end
|
||
function SetDesigning(f,fc);override;
|
||
begin
|
||
if f then wspopup := true;
|
||
inherited;
|
||
end
|
||
end
|
||
type TDCreateForm=class(TVCForm)
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
Loader.LoadFromTfm(self(true));
|
||
end
|
||
end
|
||
type TDCreatePanel=class(TpanelForm)
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
Loader.LoadFromTfm(self(true));
|
||
end
|
||
|
||
end
|
||
|
||
//按钮
|
||
type tbtn = class(tcustombtn)
|
||
{**
|
||
@explan(说明) 普通按钮 %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","action","left","top","width","height",
|
||
"align","anchors","caption","font","enabled","visible","bkbitmap","color","parentcolor","parentfont","tabstop",
|
||
"onclick","onmousemove","onsetfocus","onkillfocus","onkeyup","onkeydown","onkeypress");
|
||
end
|
||
|
||
end
|
||
type tcheckbtn = class(tcustomcheckbtn)
|
||
{**
|
||
@explan(说明) 复选框 %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","left","top","width","height",
|
||
"caption","anchors","enabled","color","visible","font","parentcolor","parentfont",
|
||
"textpos","checked","lefttext","tabstop","onclick","onmousemove","onmousedown","onmouseup");
|
||
end
|
||
|
||
end
|
||
type tradiobtn = class(tcustomradiobtn)
|
||
{**
|
||
@explan(说明)radiobtn单选按钮控件
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","left","top","width","height",
|
||
"caption","anchors","enabled","color","visible","font","parentcolor","parentfont",
|
||
"textpos","checked","lefttext","tabstop","onclick","onmousemove","onmousedown","onmouseup");
|
||
end
|
||
|
||
end
|
||
|
||
type TPopMenuBtn=class(TBtn)
|
||
{**
|
||
@ignore(忽略) %%
|
||
@explan(说明) 弹出菜单的按钮 %%
|
||
**}
|
||
private
|
||
FInfo;
|
||
public
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
caption := "menubtn";
|
||
end
|
||
function SetInfo(info);
|
||
begin
|
||
if FInfo=info then exit;
|
||
mu := nil;
|
||
if ifarray(info)then
|
||
begin
|
||
mu := new TPopUpMenu(self);
|
||
mu.caption := info["caption"];
|
||
CreateMenu(mu,info["menus"]);
|
||
FInfo := info;
|
||
end
|
||
PopUpMenu := mu;
|
||
end
|
||
function BMCLICK(o,e):BM_CLICK;override;
|
||
begin
|
||
DoClick(o,e);
|
||
end
|
||
property PopupMenu:tpopupmenu read GetPopUpMenu write SetPopUpMenu;
|
||
private
|
||
function SetPopUpMenu(p);
|
||
begin
|
||
if p is class(TPopUpmenu)then
|
||
begin
|
||
caption := p.caption;
|
||
end
|
||
class(TBtn).PopupMenu := p;
|
||
end
|
||
function GetPopUpMenu();
|
||
begin
|
||
return class(TBtn).PoPupMenu;
|
||
end
|
||
function ContextMenu(o,e);override;
|
||
begin
|
||
e.skip := true;
|
||
end
|
||
function DoClick(o,e);
|
||
begin
|
||
xy := array(0,height+1);
|
||
xy := clienttoscreen(xy[0],xy[1]);
|
||
if PopupMenu is class(TPopUpmenu)then
|
||
begin
|
||
uf := TPM_LEFTALIGN .| TPM_TOPALIGN .| TPM_RIGHTBUTTON;
|
||
_wapi.TrackPopupMenu(PopupMenu.Handle,uf,xy[0],xy[1],0,self.Handle,nil);
|
||
end
|
||
end
|
||
function CreateMenu(o,info);
|
||
begin
|
||
for i,v in info do
|
||
begin
|
||
if ifarray(v)then
|
||
begin
|
||
mi := new TMenu(o);
|
||
mi.caption := v["caption"];
|
||
mi.onclick := v["onclick"];
|
||
mi.Bitmap := v["bitmap"];
|
||
mi.parent := o;
|
||
CreateMenu(mi,v["menus"]);
|
||
end
|
||
end
|
||
end
|
||
end
|
||
|
||
//edit
|
||
type tedit = class(tcustomedit)
|
||
{**
|
||
@explan(说明) 单行文本编辑框类 %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","align","anchors","border","font","color","enabled","parentcolor","parentfont","popupmenu","visible","height","width","left","top","text","placeholder"
|
||
,"readonly","limitlength","linewrap","tabstop","onmousemove","onpopupmenu","onmousedown","onmouseup","onkeyup"
|
||
,"onkeydown","onkeypress","onmaxtext","onkillfocus","onsetfocus","onchange");
|
||
end
|
||
end
|
||
type tpassword = class(tcustompassword)
|
||
{**
|
||
@explan(说明) 密码编辑框类 %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name",
|
||
"align","anchors","font","color","parentcolor","parentfont",
|
||
"popupmenu","visible",
|
||
"height","width","left","top",
|
||
"text","placeholder","readonly","limitlength","tabstop",
|
||
"passwordchar","onmousemove","onpopupmenu",
|
||
"onmousedown","onmouseup",
|
||
"onkeyup","onkeydown","onkeypress",
|
||
"onmaxtext","onkillfocus","onsetfocus","onchange");
|
||
end
|
||
end
|
||
|
||
type tmemo = class(TSynMemoNorm)
|
||
uses UTslMemo;
|
||
{**
|
||
@explan(说明) 多行文本控件 %%
|
||
**}
|
||
function create(aowner);
|
||
begin
|
||
inherited;
|
||
Left := 10;
|
||
Top := 10;
|
||
Width := 150;
|
||
Height := 90;
|
||
GutterCharCnt := 0;
|
||
Border := true;
|
||
end
|
||
function DoTextChanged(p);override;//文本改变
|
||
begin
|
||
inherited;
|
||
end
|
||
function MouseUp(o,e);override;
|
||
begin
|
||
if csDesigning in ComponentState then return ;
|
||
inherited;
|
||
end
|
||
function MouseDown(o,e);override;
|
||
begin
|
||
if csDesigning in ComponentState then return ;
|
||
inherited;
|
||
end
|
||
function getlinecount();
|
||
begin
|
||
return Lines.length();
|
||
end
|
||
function getline(i);
|
||
begin
|
||
ls := lines;
|
||
r := ls.GetStringByIndex(i-1);
|
||
if ifstring(r) then return r;
|
||
return "";
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
inherited;
|
||
Fonchange := nil;
|
||
FTabspace := nil;
|
||
FLineWrap := nil;
|
||
FonSetFocus := nil;
|
||
FonKillFocus := nil;
|
||
end
|
||
public
|
||
property onupdate read Fonchange write Fonchange;
|
||
property onchange read Fonchange write Fonchange;
|
||
property LineWrap read FLineWrap write FLineWrap;
|
||
property tabspace read FTabspace write FTabspace;
|
||
{**
|
||
@param(LineWrap)(bool)自动换行,默认为false不自动换行%%
|
||
@param(onupdate)(fpointer)文本更新回调%%
|
||
@param(onchange)(fpointer)文本改变回调%%
|
||
**}
|
||
function publishs();override;
|
||
begin
|
||
return array("name","font","color","parentcolor","parentfont",
|
||
"popupmenu","visible","anchors","align",
|
||
"height","width","left","top",
|
||
"text","readonly","selectbkcolor","guttercolor","currentlinecolor","guttercharcnt",
|
||
"tabspace","onmousewheel","onmousemove","onpopupmenu",
|
||
"onmousedown","onmouseup","onsetfocus","onkillfocus",
|
||
"onkeyup","onkeydown","onkeypress",
|
||
"onchange");
|
||
end
|
||
private
|
||
Fonchange;
|
||
FLineWrap;
|
||
FTabspace;
|
||
FonSetFocus;
|
||
fonKillFocus;
|
||
end
|
||
|
||
//goupbox
|
||
type tgroupbox = class(tcustomgroupbox)
|
||
{**
|
||
@explan(说明) groupbox %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","left","top","width","height",
|
||
"align","anchors","border","caption","color","enabled","font","visible","textpos","parentcolor","parentfont","wsdlgmodalframe",
|
||
"onsize");
|
||
end
|
||
end
|
||
|
||
type TCheckGroupBox=class(TRadioGroupBox)
|
||
{**
|
||
@explan(说明) checkgroupbox %%
|
||
@ignore(忽略) %%
|
||
**}
|
||
private
|
||
FItemIndexs;
|
||
function GetSelected();virtual;
|
||
begin
|
||
return GetItemByIndex(FItemIndexs);
|
||
end
|
||
function SetItemIndex();override;
|
||
begin
|
||
end
|
||
function GetItemIndexs();
|
||
begin
|
||
r := array();
|
||
k := 0;
|
||
for i,v in FItemIndexs do
|
||
begin
|
||
if ifstring(GetItemByIndex(v))then
|
||
begin
|
||
r[k++]:= v;
|
||
end
|
||
end
|
||
return r;
|
||
end
|
||
function SetItemIndexs(v);
|
||
begin
|
||
if v=FItemIndexs then exit;
|
||
FItemIndexs := array();
|
||
for i,vi in v do if vi >=-1 then FItemIndexs[k++]:= vi;
|
||
if Items then
|
||
begin
|
||
ReDrawItems();
|
||
end
|
||
end
|
||
public
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
caption := "check groupbox";
|
||
FItemIndexs := array();
|
||
end
|
||
function Drawbox(dc,src,idx);override;
|
||
begin
|
||
//_wapi.DrawFrameControl(dc.Handle,src,DFC_BUTTON,(idx in FItemIndexs)?DFCS_CHECKED:DFCS_BUTTONCHECK);
|
||
dc.Draw("framecontrol",array(src[0:1],src[2:3]),DFC_BUTTON,(idx in FItemIndexs)?DFCS_CHECKED:DFCS_BUTTONCHECK);
|
||
end
|
||
function GridClick(o,e);override;
|
||
begin
|
||
i := e.iitem;
|
||
j := e.isubitem;
|
||
idx := rctoindex(i,j);
|
||
it := GetItemByIndex(idx);
|
||
if not(i >= 0 and j >= 0)then exit;
|
||
if not ifstring(it)then exit;
|
||
if idx in FItemIndexs then
|
||
begin
|
||
FItemIndexs minus= array(idx);
|
||
end else
|
||
begin
|
||
FItemIndexs union=array(idx);
|
||
end
|
||
InvalidateSubItem(idx,true);
|
||
CallMessgeFunction(OnSelectionChanged,self,e);
|
||
end
|
||
property ItemIndexs:integers read GetItemIndexs write SetItemIndexs;
|
||
function publishs();override;
|
||
begin
|
||
return array("name","left","top","width","height",
|
||
"align","border","ItemIndexs","caption","color","enabled","font",
|
||
"minheight","minwidth","parentfont","parentfont","visible","textpos","wsdlgmodalframe");
|
||
end
|
||
end
|
||
|
||
type TRadioGroupBox=class(TGroupbox)
|
||
{**
|
||
@explan(说明) radiogroupbox %%
|
||
@ignore(忽略) %%
|
||
**}
|
||
private
|
||
FGrid;
|
||
FItemIndex;
|
||
FColumns;
|
||
FRows;
|
||
FItems;
|
||
FSelectionChanged;
|
||
FColumnLayout;
|
||
function SetColumnLayout(v);
|
||
begin
|
||
if FColumnLayout <> V and(v in array(pstHorizontal,pstVertical))then
|
||
begin
|
||
FColumnLayout := v;
|
||
if FColumns>1 and FItems then
|
||
begin
|
||
ReDrawItems();
|
||
end
|
||
end
|
||
end
|
||
Function SetColumns(n);
|
||
begin
|
||
if n>0 and n <> FColumns then
|
||
begin
|
||
FColumns := n;
|
||
fcs := array();
|
||
for i := 1 to n do fcs[i-1]:= array("text":" ","width":100);
|
||
FGrid.Columns := fcs;
|
||
FRows := ceil(length(FItems)/FColumns);
|
||
FGrid.ItemCount := FRows;
|
||
GRIDsize(FGrid);
|
||
end
|
||
end
|
||
function SetItemIndex(idx);virtual;
|
||
begin
|
||
if idx>-2 and idx <> FItemIndex then
|
||
begin
|
||
FItemIndex := idx;
|
||
FGrid.InvalidateRect(nil,true);
|
||
end
|
||
end
|
||
function SetItems(v);
|
||
begin
|
||
its := array();
|
||
k := 0;
|
||
for i,vi in v do
|
||
begin
|
||
if ifstring(vi)then
|
||
begin
|
||
its[k++]:= vi;
|
||
end
|
||
end
|
||
if FItems=its then exit;
|
||
FItems := its;
|
||
FRows := ceil(length(its)/FColumns);
|
||
FGrid.ItemCount := FRows;
|
||
GRIDsize(FGrid);
|
||
end
|
||
protected
|
||
function GetControlFont();override;
|
||
begin
|
||
return FGrid.Font;
|
||
end
|
||
function SetControlFont(v);override;
|
||
begin
|
||
if FGrid then
|
||
begin
|
||
FGrid.font := v;
|
||
end
|
||
end
|
||
function rctoindex(i,j);
|
||
begin
|
||
if FColumnLayout=pstHorizontal then return i * Columns+j;
|
||
return idx := j * FRows+i;
|
||
end
|
||
function indextorc(idx,i,j);
|
||
begin
|
||
case FColumnLayout of
|
||
pstHorizontal:
|
||
begin
|
||
j := idx mod FColumns;
|
||
i := idx div FColumns;
|
||
end
|
||
pstVertical:
|
||
begin
|
||
i := idx mod FRows;
|
||
j := idx div FRows;
|
||
end
|
||
end;
|
||
end
|
||
function ReDrawItems();
|
||
begin
|
||
if FGrid and FGrid.HandleAllocated()and FItems then FGrid.InvalidateRect(nil,true);
|
||
end
|
||
function GetSelected();virtual;
|
||
begin
|
||
return GetItemByIndex(array(FItemIndex));
|
||
end
|
||
public
|
||
function SetItemByIndex(idx,v);
|
||
begin
|
||
if not ifstring(v)then exit;
|
||
s := GetItemByIndex(idx);
|
||
if ifstring(s)then FItems[idx]:= v;
|
||
return 1;
|
||
end
|
||
function GetItemByIndex(idx);
|
||
begin
|
||
if ifarray(idx)then
|
||
begin
|
||
r := array();
|
||
k := 0;
|
||
for i,v in idx do
|
||
begin
|
||
vi := call(thisfunction,v);
|
||
if ifstring(vi)then r[v]:= vi;
|
||
end
|
||
return r;
|
||
end else
|
||
if ifnumber(idx)then return FItems[idx];
|
||
end
|
||
function SetDesigning(f,fc);override;
|
||
begin
|
||
{**
|
||
@explan(说明) 设计器使用方法,设置为设计状态,或者解除设置状态 %%
|
||
@param(f)(bool) 状态值 %%
|
||
@param(fc)(bool) 是否修改子控件状态 %%
|
||
**}
|
||
inherited;
|
||
if not FGrid then exit;
|
||
if f then
|
||
begin
|
||
FGrid.Enabled := false;
|
||
end else
|
||
FGrid.Enabled := true;
|
||
end
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
caption := "radio groupbox";
|
||
color := _wapi.GetSysColor(COLOR_WINDOW);
|
||
FRows := 0;
|
||
FColumnLayout := pstHorizontal;
|
||
border := true;
|
||
FGrid := new TDrawGrid(self);
|
||
FGrid.border := false;
|
||
FGrid.ColumnHeader := false;
|
||
FGrid.GridLine := false;
|
||
FGrid.MouseSizeCell := 0;
|
||
FItems := array();
|
||
FItemIndex :=-1;
|
||
FGrid.Onclick := thisfunction(GridClick);
|
||
FGrid.parent := self;
|
||
FGrid.onsize := thisfunction(GRIDsize);
|
||
FGrid.OnDoDrawSubItem := thisfunction(DrawGrid);
|
||
SetColumns(1);
|
||
end
|
||
function DoControlAlign();override;
|
||
begin
|
||
cr := ClientRect;
|
||
cr[1]+= 20;
|
||
cr[0]+= 2;
|
||
cr[2]-= 2;
|
||
cr[3]-= 2;
|
||
if FGrid then FGrid.SetBoundsRect(cr);
|
||
end
|
||
function InitializeWnd();override;
|
||
begin
|
||
if csDesigning in ComponentState then
|
||
begin
|
||
FGrid.enabled := false;
|
||
end
|
||
end
|
||
function GRIDsize(o,e);
|
||
begin
|
||
if length(FItems)<1 then exit;
|
||
wd := floor((o.width-4)/(FColumns));
|
||
if wd<22 then exit;
|
||
for i := 0 to FColumns-1 do
|
||
begin
|
||
o.SetColumnWidth(i,wd);
|
||
end
|
||
end
|
||
function Drawbox(dc,src,idx);virtual;
|
||
begin
|
||
//_wapi.DrawFrameControl(dc.Handle,src,DFC_BUTTON,(idx=FItemIndex)?DFCS_BUTTONRADIOIMAGE:DFCS_BUTTONRADIO);
|
||
dc.Draw("framecontrol",array(src[0:1],src[2:3]),DFC_BUTTON,(idx=FItemIndex)?DFCS_BUTTONRADIOIMAGE:DFCS_BUTTONRADIO);
|
||
end
|
||
function DrawGrid(o,e);
|
||
begin
|
||
i := e.itemid;
|
||
j := e.subitemid;
|
||
idx := rctoindex(i,j);
|
||
it := FItems[idx];
|
||
if not ifstring(it)then exit;
|
||
rc := e.SubItemRect;
|
||
dc := e.canvas;
|
||
//src := array(rc[0]+1,rc[1]+1,rc[0]+18,rc[1]+18);
|
||
tp :=(rc[3]-rc[1])/2+rc[1]-7;
|
||
src := array(rc[0]+1,tp,rc[0]+15,tp+14);
|
||
Drawbox(dc,src,idx);
|
||
src := array(rc[0]+19,rc[1]+1,rc[2],rc[3]);
|
||
dc.font := o.font;
|
||
class(TLabel).CanvasDrawAlignText(dc,src,it,AL9_CENTERLEFT);
|
||
e.skip := true;
|
||
end
|
||
function InvalidateSubItem(idx,f);
|
||
begin
|
||
indextorc(idx,i,j);
|
||
rec := FGrid.GetSubItemRect(i,j);
|
||
FGrid.invalidaterect(rec,f);
|
||
end
|
||
function GridClick(o,e);virtual;
|
||
begin
|
||
i := e.iitem;
|
||
j := e.isubitem;
|
||
idx := rctoindex(i,j);
|
||
it := FItems[idx];
|
||
if not(i >= 0 and j >= 0)then exit;
|
||
if not ifstring(it)then exit;
|
||
odx := FItemIndex;
|
||
if FItemIndex=idx then
|
||
begin
|
||
exit;
|
||
end else
|
||
FItemIndex := idx;
|
||
if odx >= 0 then
|
||
begin
|
||
InvalidateSubItem(odx,false);
|
||
end
|
||
if FItemIndex >= 0 then
|
||
begin
|
||
InvalidateSubItem(FItemIndex,true);
|
||
end
|
||
CallMessgeFunction(OnSelectionChanged,self,e);
|
||
end
|
||
function SetItemText(i,c);
|
||
begin
|
||
{**
|
||
@explan(说明) 修改文字 %%
|
||
@param(i)(integer) 序号 %%
|
||
@param(c)(string) 文本 %%
|
||
**}
|
||
vi := FItems[i];
|
||
if ifstring(c)and vi <> c then
|
||
begin
|
||
FItems[i]:= c;
|
||
InvalidateSubItem(i,true);
|
||
end
|
||
end
|
||
function DeleteItem(i);
|
||
begin
|
||
vi := FItems[i];
|
||
if ifstring(vi)then
|
||
begin
|
||
nits := FItems;
|
||
reindex(nits,array(i:nil));
|
||
Items := nits;
|
||
end
|
||
end
|
||
property OnSelectionChanged:eventhandler read FSelectionChanged write FSelectionChanged;
|
||
property Columns:integer read FColumns write SetColumns;
|
||
property ItemIndex:integer read FItemIndex write SetItemIndex;
|
||
property Items:strings read FItems write SetItems;
|
||
property Selected read GetSelected;
|
||
property ColumnLayout:SplitterType read FColumnLayout write SetColumnLayout;
|
||
function publishs();override;
|
||
begin
|
||
r := array("name","left","top","width","height",
|
||
"align","border","ItemIndexs","caption","color","enabled","font",
|
||
"minheight","minwidth","parentfont","parentcolor","visible","textpos","wsdlgmodalframe","onselectionchanged");
|
||
return r;
|
||
end
|
||
{**
|
||
@param(OnSelectionChanged)(function[TRadioGroupBox,tuieventbase]) 选择改变时回调 %%
|
||
@param(Columns)(integer) 列数 %%
|
||
@param(ItemIndex)(integer) 选中项目%%
|
||
@param(Items)(array of string) 项目标签%%
|
||
|
||
**}
|
||
end
|
||
//listbox
|
||
|
||
type TListBox = class(TcustomListBox)
|
||
{**
|
||
@explan(说明) listbox控件 %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","caption","anchors","align","enabled",
|
||
"font","visible","border","color",
|
||
"height","width","left","top","items",
|
||
"multisel","popupmenu","wsdlgmodalframe",
|
||
"onmousedown","onmouseup",
|
||
"onselectionchange"
|
||
);
|
||
end
|
||
|
||
end
|
||
type TColorbox=class(TcustomListBox)
|
||
{**
|
||
@explan(说明) color box 控件 %%
|
||
**}
|
||
public
|
||
function create(aOwner);override;
|
||
begin
|
||
inherited;
|
||
arr := array(
|
||
("value":"Black","color":0),
|
||
("value":"Maroon","color":128),
|
||
("value":"Green","color":32768),
|
||
("value":"Olive","color":32896),
|
||
("value":"Navy","color":8388608),
|
||
("value":"Purple","color":8388736),
|
||
("value":"Teal","color":8421376),
|
||
("value":"Gray","color":8421504),
|
||
("value":"Silver","color":12632256),
|
||
("value":"Red","color":255),
|
||
("value":"Lime","color":65280),
|
||
("value":"Yellow","color":65535),
|
||
("value":"Blue","color":16711680),
|
||
("value":"Fuchsia","color":16711935),
|
||
("value":"Aqua","color":16776960),
|
||
("value":"LtGray","color":12632256),
|
||
("value":"DkGray","color":8421504),
|
||
("value":"White","color":16777215),
|
||
("value":"MoneyGreen","color":12639424),
|
||
("value":"SkyBlue","color":15780518),
|
||
("value":"Cream","color":15793151),
|
||
("value":"MedGray","color":10789024));
|
||
setData(arr);
|
||
end
|
||
function getColor(n);
|
||
begin
|
||
{**
|
||
@explan(说明)获取指定下标颜色的值%%
|
||
@param(n)(integer)指定下标%%
|
||
@return(tcolor)颜色值%%
|
||
**}
|
||
r := FitemData[n];
|
||
if ifarray(r)then r := r["color"];
|
||
if ifnumber(r)then return r;
|
||
return nil;
|
||
end
|
||
function getColorName(n);
|
||
begin
|
||
{**
|
||
@explan(说明)获取指定下标颜色的名字%%
|
||
@param(n)(integer)指定下标%%
|
||
@return(string)颜色值%%
|
||
**}
|
||
r := FitemData[n];
|
||
if ifarray(r)then r := r["value"];
|
||
if ifstring(r)then return r;
|
||
return "";
|
||
end
|
||
function addColor(name,clr);
|
||
begin
|
||
//应输入使用rgb()函数处理的颜色值
|
||
{**
|
||
@explan(说明)在列表框尾部增加指定的颜色%%
|
||
@param(name)(string)指定颜色名%%
|
||
@param(clr)(tcolor)指定颜色值%%
|
||
**}
|
||
if ifnumber(clr)and ifstring(name)then appendItem(array("value":name,"color":clr));
|
||
end
|
||
function AppendColors(d);
|
||
begin
|
||
{**
|
||
@expaln(说明) 追加多个 颜色值 %%
|
||
@param(d)(array) 包括"value" 和 "color" 两个字段 %%
|
||
**}
|
||
appendItems(d);
|
||
end
|
||
function CheckListItem(v);override;
|
||
begin
|
||
return ifarray(v)and ifstring(v["value"])and ifnumber(v["color"]);
|
||
end
|
||
function PaintIdexText(idx,rc,cvs);override;
|
||
begin
|
||
rl := integer((rc[3]-rc[1])* 0.15);
|
||
rrect := array(rc[0]+rl,rc[1]+rl,rc[0]-rl+rc[3]-rc[1],rc[3]-rl);
|
||
cvs.brush.color := getColor(idx);
|
||
cvs.fillrect(rrect);
|
||
rc[0]+= rc[3]-rc[1];
|
||
cvs.drawtext(getColorName(idx),rc,DT_NOPREFIX);
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","align","anchors","font","color",
|
||
"visible","border","enabled",
|
||
"height","width","left","top",
|
||
"wsdlgmodalframe","popupmenu","parentcolor","parentfont",
|
||
"onmousedown","onmouseup",
|
||
"onselectionchange"
|
||
);
|
||
end
|
||
private
|
||
multiSel;
|
||
end
|
||
|
||
//combobox
|
||
|
||
type TColorCombobox=class(TCustomComboBoxbase)
|
||
{**
|
||
@explan(说明) Tcolorcombobox 是一种颜色选择的combobox%%
|
||
**}
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FListBox.visible := false;
|
||
FListBox.WsPopUp := true;
|
||
FListBox.onSelectionChange := function(o,e)
|
||
begin
|
||
if o.visible then
|
||
begin
|
||
ShowDropDown(false);
|
||
InvalidateRect(nil,false);
|
||
CallDataFunction(OnSelchanged,self(true),e);
|
||
end
|
||
end
|
||
FListBox.Parent := self;
|
||
itemindex := 0;
|
||
end
|
||
function CreateAlist();override;
|
||
begin
|
||
r := new tcolorbox(self);
|
||
return r;
|
||
end
|
||
function Paint();override;
|
||
begin
|
||
inherited;
|
||
idx := ItemIndex;
|
||
if not(idx >= 0)then return;
|
||
dc := canvas;
|
||
rc := ClientRect;
|
||
rc[2]-= BtnWidth;
|
||
FListBox.PaintIdx(idx,rc,dc);
|
||
return;
|
||
cl := getColorValue(idx);
|
||
txt := getColorName(idx);
|
||
dc.brush.Color := cl;
|
||
rc[2]-= BtnWidth;
|
||
rc2 := rc;
|
||
rc2[2]:= 20;
|
||
rc[0]+= 22;
|
||
bd := 2;
|
||
rc2[0]+= bd;
|
||
rc2[1]+= bd;
|
||
rc2[2]-= bd;
|
||
rc2[3]-= bd;
|
||
dc.Draw("rectangle",array(rc2[0:1],rc2[2:3]));
|
||
dc.DrawText(txt,rc,DT_VCENTER .| DT_SINGLELINE .| DT_NOPREFIX);
|
||
end
|
||
function addColor(name,clr);
|
||
begin
|
||
{**
|
||
@explan(说明)添加颜色%%
|
||
@param(colorName)(string)颜色名称例如"Red"%
|
||
@param(colorValue)(integer)颜色值%%
|
||
**}
|
||
FListBox.addColor(name,clr);
|
||
end
|
||
function AppendColors(d);
|
||
begin
|
||
{**
|
||
@expaln(说明) 追加多个 颜色值 %%
|
||
@param(d)(array) 包括"value" 和 "color" 两个字段 %%
|
||
**}
|
||
return FListBox.AppendColors(d);
|
||
end
|
||
function Clean();
|
||
begin
|
||
{**
|
||
@explan(说明)清空颜色值 %%
|
||
**}
|
||
FListBox.Clean();
|
||
end
|
||
function getcurrentColor();
|
||
begin
|
||
{**
|
||
@explan(说明)获得被选中的颜色名称%%
|
||
@return(integer) 颜色 %%
|
||
**}
|
||
idx := ItemIndex;
|
||
return getColorValue(idx);
|
||
end
|
||
function getColorName(id)
|
||
begin
|
||
{**
|
||
@explan(说明)获取颜色%%
|
||
@param(id)(integer)序号id%%
|
||
@return(string)返回颜色名称%%
|
||
**}
|
||
return FListBox.getColorName(id);
|
||
end
|
||
function getColorValue(id)
|
||
begin
|
||
{**
|
||
@explan(说明)获取颜色值%%
|
||
@param(id)(integer)序号id%%
|
||
@return(integer)返回颜色值%%
|
||
**}
|
||
return FListBox.getColor(id);
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","anchors","font","color",
|
||
"visible","parentcolor","parentfont",
|
||
"height","width","left","top",
|
||
"readonly","itemindex",
|
||
"onselchanged","ondropdown","oncloseup");
|
||
end
|
||
private
|
||
function SetItemIndex(idx);override;
|
||
begin
|
||
FListBox.SetCurrentSelection(idx);
|
||
InvalidateRect(nil,false);
|
||
end
|
||
function GetItemIndex();override;
|
||
begin
|
||
return FListBox.GetCurrentSelection();
|
||
end
|
||
end
|
||
type TComboBox = class(TcustomComboBox)
|
||
{**
|
||
@explan(说明) comboBox下拉框 %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","font","border","font","color",
|
||
"visible","anchors","align","enabled","parentcolor","parentfont",
|
||
"height","width","left","top",
|
||
"readonly","itemindex",
|
||
"items","dropdowncount","oncloseup","ondropdown","onselchanged","oneditchanged");
|
||
end
|
||
end
|
||
|
||
|
||
|
||
|
||
type TToolButton = class(TcustomToolButton)
|
||
{**
|
||
@explan(说明) 工具栏项 %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","action","caption","enabled","stylesep","imageid","visible","onclick","popupmenu");
|
||
end
|
||
end
|
||
|
||
type TToolBar = class( TcustomToolBar)
|
||
{**
|
||
@explan(说明) 工具栏控件 %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","align","caption","enabled","font","left","top","width","height",
|
||
"visible","imagelist","mainmenu");
|
||
if Align <> alNone then
|
||
begin
|
||
return array("name","align","caption","enabled","font",
|
||
"visible","imagelist");
|
||
end else
|
||
return array("name","align","caption","enabled","font","left","top","width","height",
|
||
"visible","imagelist");
|
||
end
|
||
end
|
||
type TStatusBar = class(TcustomStatusBar)
|
||
{**
|
||
@explan(说明) 状态栏 %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","caption","enabled","border",
|
||
"font","visible","items","ondblclick","onmousedown","onmouseup");
|
||
end
|
||
end
|
||
type tcoolbar = class(tcustomcoolbar)
|
||
{**
|
||
@explan(说明) coolbar控件 %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","enabled","caption","autosize","border","wsdlgmodalframe","font","color","dragbtncolor","visible","arrange");
|
||
end
|
||
end
|
||
|
||
//树控件
|
||
type TTreeCtlNode = class( TcustomTreeCtlNode)
|
||
{**
|
||
@explan(说明) 树结点 %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
type TTreeCtl = class(TcustomTreeCtl)
|
||
{**
|
||
@explan(说明) 树控件 %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
|
||
type TTreeNode=class(TTreeCtlNode)
|
||
{**
|
||
@explan(说明)tree控件节点 %%
|
||
**}
|
||
public
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function GetSibling(id);
|
||
begin
|
||
{**
|
||
@explan(说明) 获得兄弟节点%%
|
||
@param(id)(integer) 序号,自己的位置为0%%
|
||
**}
|
||
r := nil;
|
||
if id=0 then return self(true);
|
||
if not(Parent is class(TTreeNode))then return r;
|
||
if(id>-100000)and(id<100000)then
|
||
begin
|
||
idx := Parent.indexof(self);
|
||
return Parent.GetNodeByIndex(idx+id);
|
||
end
|
||
return r;
|
||
end
|
||
function deletenode(nd);override;
|
||
begin
|
||
DeleteChildNode(nd);
|
||
end
|
||
function InsertSibling(node,ifprev);
|
||
begin
|
||
{**
|
||
@explan(说明) 插入兄弟节点 %%
|
||
@param(node)(TTreeNode) 待插入节点 %%
|
||
@param(ifprev)(bool)
|
||
**}
|
||
if not(Parent is class(TTreeNode))then exit;
|
||
idx := Parent.IndexOf(self);
|
||
if ifprev then
|
||
begin
|
||
return Parent.InsertNode(node,idx);
|
||
end else
|
||
begin
|
||
return Parent.InsertNode(node,idx+1);
|
||
end
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function Destroy();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function moveup();virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 节点上移 %%
|
||
@return(bool) 是否移动成功 %%
|
||
**}
|
||
bf := GetSibling(-1);
|
||
if not bf then return false;
|
||
ndp := parent;
|
||
nd := self(true);
|
||
if ndp then
|
||
begin
|
||
ndp.deletenode(nd);
|
||
ndp.insertnode(nd,bf);
|
||
return true;
|
||
end
|
||
return false;
|
||
end
|
||
function movedown();virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 节点下移%%
|
||
**}
|
||
bf := GetSibling(1);
|
||
if not bf then return false;
|
||
ndp := parent;
|
||
if ndp then
|
||
begin
|
||
nd := self(true);
|
||
ndp.deletenode(nd);
|
||
ndp.insertnode(nd,ndp.indexof(bf)+1);
|
||
end
|
||
return false;
|
||
end
|
||
function insertbefor(node,befor);
|
||
begin
|
||
{**
|
||
@ignore(忽略)
|
||
**}
|
||
insertnode(node,befor);
|
||
end
|
||
function append(node);
|
||
begin
|
||
{**
|
||
@ignore(忽略)
|
||
**}
|
||
insertnode(node,self.ItemCount);
|
||
end
|
||
function deleteAllChild();
|
||
begin
|
||
DeleteChildren();
|
||
end
|
||
function HandleAllocated();
|
||
begin
|
||
{**
|
||
@explan(说明)是否句柄有效%%
|
||
@return(bool)
|
||
**}
|
||
return true;
|
||
end
|
||
function CreateHandle();virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 构建句柄 %%
|
||
**}
|
||
end
|
||
function InsertNode(node,bnode);override;
|
||
begin
|
||
{**
|
||
@expaln(说明) 在子节点bnode 前面插入新的子节点node %%
|
||
@param(node)(TTreeNode) 待插入节点 %%
|
||
@param(bnode)(TTreeNode|TVI_FIRST|TVI_LAST) 基准节点 %%
|
||
**}
|
||
if ifarray(node)then return Owner.InsertNode(node,self(true),bnode);
|
||
if ifnil(bnode)then bnode := TVI_LAST;
|
||
ct := ItemCount;
|
||
if bnode=TVI_LAST then
|
||
begin
|
||
pos := ct;
|
||
end else
|
||
if bnode=TVI_FIRST then
|
||
begin
|
||
pos := 0;
|
||
end else
|
||
if bnode is class(TTreeNode)then
|
||
begin
|
||
pos := IndexOf(bnode);
|
||
if pos<0 then return 0;
|
||
end else
|
||
if bnode<ct and bnode >= 0 then
|
||
begin
|
||
pos := bnode;
|
||
end else
|
||
if bnode >= ct then
|
||
begin
|
||
pos := ct;
|
||
end else
|
||
begin
|
||
pos := ct;
|
||
end
|
||
return inherited InsertNode(node,pos);
|
||
end
|
||
function GetNodeByPosition(id);
|
||
begin
|
||
{**
|
||
@expaln(说明) 通过位置获得子节点%%
|
||
**}
|
||
return GetNodeByIndex(id);
|
||
end
|
||
function GetNodeCount();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得当前节点下所有节点数量 %%
|
||
@return(integer) %%;
|
||
**}
|
||
r := 0;
|
||
ct := ItemCount;
|
||
for i := 0 to ct-1 do
|
||
begin
|
||
it := GetNodeByIndex(i);
|
||
r += it.GetNodeCount();
|
||
end
|
||
r += ct;
|
||
return r;
|
||
end
|
||
property items read Gitems;
|
||
end
|
||
type TTreeView=class(TTreeCtl)
|
||
{**
|
||
@explan(说明) tree控件 %%
|
||
**}
|
||
private
|
||
FBackColor;
|
||
FHaveFocus;
|
||
function SetLazyItems(v);
|
||
begin
|
||
if ifarray(v)and v["type"]="treenodes" then
|
||
begin
|
||
RootItem.RecyclingChildren();
|
||
InsertNodes(v);
|
||
end
|
||
end
|
||
function GetLazyItems();
|
||
begin
|
||
return(RootItem.toarray())["nodes"];
|
||
end
|
||
protected
|
||
function GetitemByCursorPos();
|
||
begin
|
||
ps := array(x,y);
|
||
_wapi.GetCursorPos(ps);
|
||
pt := ScreentoClient(ps[0],ps[1]);
|
||
return TvHittest(pt[0],pt[1]);
|
||
end
|
||
function TvHittest(x,y,flag);
|
||
begin
|
||
{**
|
||
@explan(说明) 获取指定位置的item %%
|
||
**}
|
||
id := GetItemIndexByYpos(y);
|
||
if id >= 0 then return GetItemByIndex(id);
|
||
end
|
||
public
|
||
function hasFocus();override;
|
||
begin
|
||
return FHaveFocus;
|
||
end
|
||
function MouseDown(o,e);override;
|
||
begin
|
||
if csDesigning in ComponentState then return;
|
||
inherited;
|
||
if not FHaveFocus then
|
||
begin
|
||
SetFocus();
|
||
FHaveFocus := true;
|
||
InvalidateItem(self.CurrentNode);
|
||
end
|
||
end
|
||
function WMKILLFOCUS(o,e):WM_KILLFOCUS;override;
|
||
begin
|
||
FHaveFocus := false;
|
||
InvalidateItem(self.CurrentNode);
|
||
end
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
height := 150;
|
||
border := true;
|
||
HasLine := true;
|
||
end
|
||
function expand(item);
|
||
begin
|
||
{**
|
||
@explan(说明) 展开节点 %%
|
||
@param(item)(TTreeNode) ;
|
||
**}
|
||
if item is class(TTreeNode)then item.Expand();
|
||
end
|
||
function collapse(item);
|
||
begin
|
||
{**
|
||
@explan(说明) 收拢节点 %%
|
||
@param(item)(TTreeNode) ;
|
||
**}
|
||
if item is class(TTreeNode)then item.UnExpand();
|
||
end
|
||
function SwitchCollapse(item);
|
||
begin
|
||
{**
|
||
@explan(说明) 切换收拢或者展 %%
|
||
@param(item)(TTreeNode) ;
|
||
**}
|
||
if item is class(TTreeNode)then
|
||
begin
|
||
if Item.Expaned then Item.UnExpand();
|
||
else Item.UnExpand();
|
||
end
|
||
end
|
||
function InsertNodes(iteminfos,pnode,bnode);
|
||
begin
|
||
{**
|
||
@explan(说明) 批量插入节点 %%
|
||
**}
|
||
if ifarray(iteminfos)and iteminfos["type"]="treenodes" then
|
||
begin
|
||
its := iteminfos["items"];
|
||
for i,v in its do
|
||
begin
|
||
InsertNode(v,pnode,bnode);
|
||
end
|
||
end
|
||
end
|
||
function InsertNode(iteminfo,pnode,bnode);
|
||
begin
|
||
{**
|
||
@explan(说明)插入单个节点 %%
|
||
@param(iteminfo)(array) array("type":"treenode","caption":"","imgid":id,"nodes":array()) 节点信息
|
||
nodes字段为子节点信息 %% 包括
|
||
%%
|
||
@param(pnode)(TTreeNode) 父节点 %%
|
||
@param(bnode)(TTreeNode) 前一个节点 %%
|
||
**}
|
||
if not(pnode is class(TTreeNode))then pnode := RootItem;
|
||
if self <> pnode.Owner then return;
|
||
if iteminfo is class(TTreeNode)then
|
||
begin
|
||
return pnode.InsertNode(iteminfo,bnode);
|
||
end
|
||
if not(ifarray(iteminfo)and iteminfo)then return nil;
|
||
item := CreateTreeNode();
|
||
item.Checked := iteminfo["checked"];
|
||
item.caption := iteminfo["caption"];
|
||
item.SelImgId := iteminfo["selimgid"];
|
||
item.ImgId := iteminfo["imgid"];
|
||
item._tag := iteminfo["tag"];
|
||
pnode.InsertNode(item,bnode);
|
||
InsertNodes(iteminfo["nodes"],item);
|
||
return item;
|
||
end
|
||
function deleteitem(node);
|
||
begin
|
||
{**
|
||
@explan(说明) 删除 节点,但是节点不会销毁,请用node.recycling 销毁 %%
|
||
@param(node)(TTreeNode)
|
||
**}
|
||
if node is class(TTreeNode)then
|
||
begin
|
||
end else
|
||
return;
|
||
np := RootItem.HasNode(node);
|
||
if np then np.DeleteChildNode(node);
|
||
end
|
||
function CreateTreeNode();override;
|
||
begin
|
||
r := new TTreeNode(self(true));
|
||
return r;
|
||
end
|
||
public
|
||
function Recycling();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function Destroy();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function GetItemCount();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得item的数量 %%
|
||
@return(integer) 数量 %%
|
||
**}
|
||
RootItem.GetNodeCount();
|
||
end
|
||
function clean();override;
|
||
begin
|
||
{**
|
||
@explan(说明)删除节点并销毁 %%
|
||
**}
|
||
BeginUpdate();
|
||
RootItem.RecyclingChildren();
|
||
EndUpDate();
|
||
end
|
||
property RootItem read GetRootNode;
|
||
property LazyItems:TreeData read GetLazyItems Write SetLazyItems;
|
||
function publishs();override;
|
||
begin
|
||
return array("name",
|
||
"left","top","width","height","caption","align","anchors",
|
||
"checkbox","visible","itemheght","imagelist","hasline","singleexpand","color","font","parentcolor","parentfont",
|
||
"lazyitems","onselchanged","onmousedown","onsetfocus","onkillfocus","onkeyup","onkeydown");
|
||
end
|
||
//property OnDeleteItem read FOnDeleteItem write FOnDeleteItem;
|
||
//property OnItemExpand:eventhandler read FOnItemExpand write FOnItemExpand;
|
||
{**
|
||
@param(RootItem)(TTreeNode) 根节点 %%
|
||
@param(LazyItems)(array) 结构化数据数组 %%
|
||
**}
|
||
end
|
||
//tab控件
|
||
type TTabSheet = class(tcustomtabsheet)
|
||
{**
|
||
@explan(说明)page控件页面 %%
|
||
**}
|
||
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","caption","font","color","border","parentcolor","parentfont","wsdlgmodalframe","onsize");
|
||
end
|
||
end
|
||
type tpagecontrol = class(tcustompagecontrol)
|
||
{**
|
||
@explan(说明)page控件 %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","left","top","width","height",
|
||
"align","anchors","color","font","parentcolor","parentfont","border","caption","popupmenu","enabled","visible","cursel","cursor",
|
||
"wsdlgmodalframe","wssizebox","OnSelChange");
|
||
end
|
||
end
|
||
//二分控件
|
||
type TPairSplitterSide=class(TCustomControl)
|
||
{**
|
||
@explan(说明) 分开控件side窗口 %%
|
||
**}
|
||
Private
|
||
FPairSplitter;
|
||
public
|
||
function DesigningMove();override;
|
||
begin
|
||
return false;
|
||
end
|
||
function paint();override;
|
||
begin
|
||
inherited;
|
||
drawdesigninggrid();
|
||
end
|
||
function DesigningSizer();override;
|
||
begin
|
||
return false;
|
||
end
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
caption := "PairSplitterSide";
|
||
cursor := OCR_NORMAL;
|
||
border := true;
|
||
end
|
||
function CreateParams(p);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function SetParent(p);override;
|
||
begin
|
||
if(P is class(TPairSplitter))and parent <> p then
|
||
begin
|
||
oldparent := Parent;
|
||
if oldparent then
|
||
begin
|
||
oldparent.RemoveSide(self);
|
||
end
|
||
inherited;
|
||
parent.AddSide(self);
|
||
end else
|
||
if not(p is class(TWincontrol))then
|
||
begin
|
||
odp := Parent;
|
||
inherited;
|
||
if odp then odp.RemoveSide(self);
|
||
end
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","border","caption","color","font","parentcolor","parentfont","popupmenu","bkbitmap","wsdlgmodalframe","onsize");
|
||
end
|
||
end
|
||
type TPairSplitter=class(tcustomcontrol) //
|
||
{**
|
||
@explan(说明)分割控件 %%
|
||
**}
|
||
private
|
||
FDRageimglist;
|
||
FWill_Drag;
|
||
FIs_Draging;
|
||
FPosition;
|
||
FSides;
|
||
FSplitterType;
|
||
Fhimgelist;
|
||
FEnables;
|
||
function EnabledChild(f);
|
||
begin
|
||
if f then
|
||
begin
|
||
if FEnables[0]then FSides[0].enabled := true;
|
||
if FEnables[1]then FSides[1].enabled := true;
|
||
return;
|
||
end
|
||
FEnables := array();
|
||
s1 := FSides[0];
|
||
S2 := FSides[1];
|
||
if s1 then
|
||
begin
|
||
FEnables[0]:= s1.enabled;
|
||
s1.enabled := false;
|
||
end
|
||
if s2 then
|
||
begin
|
||
FEnables[1]:= s2.enabled;
|
||
s2.enabled := false;
|
||
end
|
||
end
|
||
Function SetSplitterType(v);
|
||
begin
|
||
if (v in array(pstHorizontal,pstVertical)) and v <> FSplitterType then
|
||
begin
|
||
FSplitterType := v;
|
||
if FSplitterType=pstVertical then cursor := OCR_SIZENS else cursor := OCR_SIZEWE;
|
||
DoControlAlign();
|
||
end
|
||
end
|
||
function GetPosition();
|
||
begin
|
||
if ifnil(FPosition)then
|
||
begin
|
||
if FSplitterType=pstHorizontal then
|
||
begin
|
||
FPosition := Width * 0.3;
|
||
end else
|
||
begin
|
||
FPosition := Height * 0.7;
|
||
end
|
||
end
|
||
return FPosition;
|
||
end
|
||
function SetPosition(AValue);
|
||
begin
|
||
if AValue>0 and AValue <> FPosition then
|
||
begin
|
||
FPosition := integer(AValue);
|
||
DoControlAlign();
|
||
end
|
||
end
|
||
protected
|
||
function GetSides(index);
|
||
begin
|
||
return FSides[index];
|
||
end
|
||
public
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
caption := "pairspliter";
|
||
width := 200;
|
||
height := 200;
|
||
Border := false;
|
||
WsDlgModalFrame := true;
|
||
FSides := new TFpList();
|
||
FSplitterType := pstHorizontal;
|
||
cursor := OCR_SIZEWE;
|
||
FWill_Drag := true;
|
||
Color := _wapi.GetSysColor(COLOR_MENUBAR);
|
||
end
|
||
function AddSide(ASide);
|
||
begin
|
||
{**
|
||
@explan(说明) 添加side
|
||
**}
|
||
if not(ASide is class(TPairSplitterSide))then return -1;
|
||
if ASide.Parent=self then
|
||
begin
|
||
if FSides.indexof(ASide)<0 {and FSides.count<2}then
|
||
begin
|
||
FSides.add(ASide);
|
||
DoControlAlign();
|
||
end
|
||
end else
|
||
begin
|
||
ASide.parent := self;
|
||
end
|
||
end
|
||
function MouseUp(o,e);override;
|
||
begin
|
||
if csDesigning in ComponentState then exit;
|
||
if e.button=mbLeft then
|
||
begin
|
||
if FIs_Draging then
|
||
begin
|
||
_wapi.ImageList_DragLeave(self.Handle);
|
||
_wapi.ImageList_EndDrag();
|
||
r := ClientRect;
|
||
if FSplitterType=pstHorizontal then
|
||
begin
|
||
x := e.xpos ;
|
||
if x<(r[0]+2) then
|
||
begin
|
||
x := r[0]+5;
|
||
end else
|
||
if x>(r[2]-2) then
|
||
begin
|
||
x := r[2]-5;
|
||
end
|
||
FPosition := x;
|
||
end else
|
||
begin
|
||
x := e.ypos;
|
||
if x<(r[1]+2) then
|
||
begin
|
||
x := r[1]+5;
|
||
end else
|
||
if x>(r[3]-2) then
|
||
begin
|
||
x := r[3]-5;
|
||
end
|
||
|
||
FPosition :=x;
|
||
end
|
||
EnabledChild(true);
|
||
FWill_Drag := true;
|
||
FIs_Draging := false;
|
||
_wapi.clipcursor(0);
|
||
DoControlAlign();
|
||
end
|
||
end
|
||
inherited;
|
||
end
|
||
function MouseDown(o,e);override;
|
||
begin
|
||
if csDesigning in ComponentState then exit;
|
||
if e.button=mbLeft then
|
||
begin
|
||
nxy := clienttowindow(e.xpos,e.ypos);
|
||
if FWill_Drag then
|
||
begin
|
||
FWill_Drag := false;
|
||
FIs_Draging := true;
|
||
if FDRageimglist then _wapi.ImageList_Destroy(FDRageimglist);
|
||
crect := clientrect;
|
||
if FSplitterType=pstHorizontal then
|
||
begin
|
||
FDRageimglist := _wapi.ImageList_Create(5,crect[3],ILC_COLOR16 .| ILC_MASK,5,1);
|
||
_wapi.ImageList_BeginDrag(FDRageimglist,0,2,nxy[1]);
|
||
end else
|
||
begin
|
||
FDRageimglist := _wapi.ImageList_Create(crect[2],5,ILC_COLOR16 .| ILC_MASK,5,1);
|
||
_wapi.ImageList_BeginDrag(FDRageimglist,0,nxy[0],2);
|
||
end
|
||
_wapi.ImageList_DragEnter(self.Handle,nxy[0],nxy[1]);
|
||
//_wapi.ImageList_DragEnter(self.Handle,e.xpos,e.ypos);
|
||
ps := array(clienttoscreen(crect[0],crect[1]),clienttoscreen(crect[2],crect[3]));
|
||
_wapi.clipcursor(ps);
|
||
EnabledChild(false);
|
||
end
|
||
end
|
||
inherited;
|
||
end
|
||
function MouseMove(o,e);override;
|
||
begin
|
||
if FIs_Draging then
|
||
begin
|
||
nxy := clienttowindow(e.xpos,e.ypos);
|
||
_wapi.ImageList_DragMove(nxy[0],nxy[1]);
|
||
end
|
||
inherited;
|
||
end
|
||
function RemoveSide(ASide);
|
||
begin
|
||
{**
|
||
@explan(说明)pairsider %%
|
||
**}
|
||
id := FSides.indexof(ASide);
|
||
if id<0 then exit;
|
||
FSides.deli(id);
|
||
DoControlAlign();
|
||
if ASide.parent=self then
|
||
begin
|
||
ASide.parent := nil;
|
||
end
|
||
end
|
||
function Notification(AComponent,Operation);override;
|
||
begin
|
||
inherited;
|
||
if Operation=opRemove then
|
||
begin
|
||
RemoveSide(AComponent);
|
||
end
|
||
end
|
||
function DoControlAlign();override;
|
||
begin
|
||
{**
|
||
@explan(说明) 对齐调整 %%
|
||
**}
|
||
if not HandleAllocated()then return;
|
||
sd1 := GetSides(0);
|
||
sd2 := GetSides(1);
|
||
if not(sd1 or sd2)then return;
|
||
rc := GetClientRect();
|
||
pz := GetPosition();
|
||
pbdr := 0;
|
||
{$ifdef linux}
|
||
if (csDesigning in ComponentState) then
|
||
begin
|
||
pbdr := 2;
|
||
end
|
||
{$endif}
|
||
if sd1 and sd1.HandleAllocated()then
|
||
begin
|
||
if FSplitterType=pstHorizontal then sd1.setboundsrect(array(rc[0]+pbdr,rc[1]+pbdr,rc[0]+pz,rc[3]-pbdr));
|
||
else sd1.setboundsrect(array(rc[0]+pbdr,rc[1]+pbdr,rc[2]-pbdr,rc[1]+pz));
|
||
end
|
||
if sd2 and sd2.HandleAllocated()then
|
||
begin
|
||
if FSplitterType=pstHorizontal then sd2.setboundsrect(array(rc[0]+pz+4,rc[1]+pbdr,rc[2]-pbdr,rc[3]-pbdr));
|
||
else sd2.setboundsrect(array(rc[0]+pbdr,rc[1]+pz+4,rc[2]-pbdr,rc[3]-pbdr));
|
||
end
|
||
end
|
||
function Destroy();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
if FDRageimglist then _wapi.ImageList_Destroy(FDRageimglist);
|
||
inherited;
|
||
end
|
||
function WMERASEBKGND(o,e):WM_ERASEBKGND;override;
|
||
begin
|
||
return inherited;
|
||
dc := e.wparam;
|
||
if dc then
|
||
begin
|
||
cl := Color;
|
||
rect := array(0,0,0,0);
|
||
if e.lparam=2 then
|
||
begin
|
||
rect := PAINTSTRUCT().rcpaint();
|
||
end else
|
||
if HandleAllocated()then
|
||
begin
|
||
_wapi.GetClientRect(self.Handle,rect);
|
||
end else
|
||
return;
|
||
rc := rect;
|
||
wd := 5;
|
||
if pstHorizontal=FSplitterType then
|
||
begin
|
||
rc[0]:= FPosition-wd;
|
||
rc[2]:= FPosition+wd;
|
||
end else
|
||
begin
|
||
rc[1]:= FPosition-wd;
|
||
rc[3]:= FPosition+wd;
|
||
end
|
||
rect := rc;
|
||
if ifnumber(cl)then
|
||
begin
|
||
Canvas.Brush.Color := cl;
|
||
Canvas.Handle := dc;
|
||
Canvas.FillRect(rect);
|
||
end else
|
||
begin
|
||
cl := _wapi.GetStockObject(WHITE_BRUSH);
|
||
_wapi.FillRect(dc,rect,cl);
|
||
end
|
||
e.skip := true;
|
||
e.Result := 1;
|
||
end
|
||
end
|
||
|
||
property Position:integer read GetPosition write SetPosition;
|
||
property SplitterType:SplitterType read FSplitterType write SetSplitterType;
|
||
function publishs();override;
|
||
begin
|
||
return array("name","left","top","width","height",
|
||
"align","anchors","border","color","font","caption","enabled","visible","parentcolor","parentfont","splittertype","position",
|
||
"wsdlgmodalframe","wscaption","wspopup","wssizebox","wssysmenu");
|
||
end
|
||
{**
|
||
@param(Position)(integer) 分割线位置 %%
|
||
@param(SplitterType)(menuber of TPairSplitterType) 分割线位置 %%
|
||
**}
|
||
end
|
||
|
||
//表格控件
|
||
type TTlvnActiveEvent=class(tuieventbase)
|
||
{**
|
||
@explan(说明) listview active 通知消息 %%
|
||
**}
|
||
private
|
||
FNmList;
|
||
function _getvalue_(n);
|
||
begin
|
||
return FNmList._getvalue_(n);
|
||
end
|
||
function _setvalue_(n,v);
|
||
begin
|
||
return FNmList._setvalue_(n,v);
|
||
end
|
||
public
|
||
function create(m,w,l,h);override;
|
||
begin
|
||
inherited;
|
||
FNmList := new ttagNMLISTVIEW(l);
|
||
end
|
||
property hdr index "hdr" read _getvalue_ write _setvalue_;
|
||
property iitem index "iitem" read _getvalue_ write _setvalue_;
|
||
property isubitem index "isubitem" read _getvalue_ write _setvalue_;
|
||
property unewstate index "unewstate" read _getvalue_ write _setvalue_;
|
||
property uoldstate index "uoldstate" read _getvalue_ write _setvalue_;
|
||
property uchanged index "uchanged" read _getvalue_ write _setvalue_;
|
||
property ptaction index "ptaction" read _getvalue_ write _setvalue_;
|
||
property lparam index "lparam" read _getvalue_ write _setvalue_;
|
||
end
|
||
type ttagNMLISTVIEW=class(tslcstructureobj)
|
||
private
|
||
static SSTRUCT;
|
||
class function getstruct()
|
||
begin
|
||
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
|
||
("hdr","user",
|
||
(
|
||
("hwndfrom","intptr",0),
|
||
("idfrom","intptr",0),
|
||
("code","int",0))),
|
||
("iitem","int",0),
|
||
("isubitem","int",0),
|
||
("unewstate","int",0),
|
||
("uoldstate","int",0),
|
||
("uchanged","int",0),
|
||
("ptaction","int[2]",
|
||
(0,0)),
|
||
("lparam","intptr",0)));
|
||
return SSTRUCT;
|
||
end
|
||
public
|
||
function create(ptr)
|
||
begin
|
||
inherited create(getstruct(),ptr);
|
||
end
|
||
end
|
||
type TGridCtl = class(TcustomGridCtl)
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
|
||
type TGRidBase = class(TGridCtl)
|
||
{**
|
||
@explan(说明)表格基础类 %%
|
||
**}
|
||
private
|
||
FGridLine;
|
||
FColumHeader;
|
||
FonColumnClick;
|
||
FColumTexts;
|
||
private
|
||
function SetGridLine(v);
|
||
begin
|
||
nv := v?true:false;
|
||
if nv <> FGridLine then
|
||
begin
|
||
FGridLine := nv;
|
||
end
|
||
end
|
||
function SetColumHeader(v);
|
||
begin
|
||
nv := v?true:false;
|
||
if nv <> FColumHeader then
|
||
begin
|
||
ct := ItemCount;
|
||
FColumHeader := nv;
|
||
if nv then
|
||
begin
|
||
FixedRows := 1;
|
||
end else
|
||
FixedRows := 0;
|
||
ItemCount := ct;
|
||
end
|
||
end
|
||
|
||
function SetItemCount(r);
|
||
begin
|
||
if r >= 0 then
|
||
begin
|
||
if ColumnHeader then
|
||
begin
|
||
class(TGridCtl).ItemCount := r+1;
|
||
end else
|
||
class(TGridCtl).ItemCount := r;
|
||
end
|
||
end
|
||
function GetItemCount();
|
||
begin
|
||
if ColumnHeader then
|
||
begin
|
||
return class(TGridCtl).ItemCount-1;
|
||
end else
|
||
return class(TGridCtl).ItemCount;
|
||
end
|
||
function GetColumInfo();
|
||
begin
|
||
r := array();
|
||
for i := 0 to FColumTexts.Length()-1 do
|
||
begin
|
||
r[i,"text"]:= FColumTexts[i];
|
||
r[i,"width"]:= GetColumnWidth(i);
|
||
end
|
||
return r;
|
||
end
|
||
protected
|
||
function GetColumns();virtual;
|
||
begin
|
||
return GetColumInfo();
|
||
end
|
||
function ClickedGridItem(o,e);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明)点击时处理 %%
|
||
**}
|
||
end
|
||
function RClickedGridItem(o,e);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明)点击时处理 %%
|
||
**}
|
||
end
|
||
function CreateVclick(o,e);
|
||
begin
|
||
ne := new TTlvnActiveEvent(100,0,0,o.handle);
|
||
ne.iitem := GetRowIndexByPos(e.ypos);
|
||
ne.isubitem := GetColIndexByPos(e.xpos);
|
||
ne.ptaction := array(e.xpos,e.ypos);
|
||
return ne;
|
||
end
|
||
public
|
||
function GetRowIndexByPos(y);override;
|
||
begin
|
||
r := inherited;
|
||
if r >= 0 and FColumHeader then r--;
|
||
return r;
|
||
end
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
caption := "grid";
|
||
FixedRows := 1;
|
||
FGridLine := true;
|
||
FColumHeader := true;
|
||
ItemCount := 0;
|
||
Visible := true;
|
||
FColumTexts := new TMyarrayB();
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
onColumnClick := nil;
|
||
inherited;
|
||
end
|
||
function GetSubItemRect(i,j);override;
|
||
begin
|
||
{**
|
||
@explan(说明)获得子项的区域 %%
|
||
@return(array) array(左,上,右,下);
|
||
**}
|
||
i1 := i;
|
||
if FColumHeader then
|
||
begin
|
||
i1 := i+1;
|
||
end
|
||
r := inherited GetSubItemRect(i1,j);
|
||
if not r then return zeros(4);
|
||
return r;
|
||
end
|
||
function InvalidateItem(i);override;
|
||
begin
|
||
i1 := i;
|
||
if FColumHeader then i1++;
|
||
inherited InvalidateItem(i1);
|
||
end
|
||
function GetItemRect(id);override;
|
||
begin
|
||
{**
|
||
@explan(说明) 获得行的区域 %%
|
||
@return(array) array(左,上,右,下);
|
||
**}
|
||
i1 := id;
|
||
if FColumHeader then
|
||
begin
|
||
i1 += 1;
|
||
end
|
||
r := inherited GetItemRect(i1);
|
||
if r then return r;
|
||
return array(0,0,0,0);
|
||
end
|
||
function HitTestItem(x,y)
|
||
begin
|
||
{**
|
||
@explan(说明)位置命中 测试 %%
|
||
**}
|
||
i := GetRowIndexByPos(y);
|
||
return array(i,ifnumber(x)?GetColIndexByPos(x):0);
|
||
end
|
||
function SetColumns(cs,beg,len);override;
|
||
begin
|
||
if not cs then
|
||
begin
|
||
FColumTexts.splices(beg>0?beg:0,len >= 0?len:FColumTexts.Length(),array());
|
||
Inherited SetColumns(array(),beg,len);
|
||
return;
|
||
end
|
||
if ifarray(cs)then
|
||
begin
|
||
wds := array();
|
||
cls := array();
|
||
idx := 0;
|
||
for i,v in cs do
|
||
begin
|
||
if ifarray(v)and ifstring(v["text"])then
|
||
begin
|
||
wd := v["width"];
|
||
owd := GetColumnWidth(i);
|
||
wds[idx]:= v["width"]>= 0?v["width"]:(owd >= 0?owd:100);
|
||
cls[idx++]:= v["text"];
|
||
end
|
||
end
|
||
owds := array();
|
||
for i := 0 to ColumnCount-1 do
|
||
begin
|
||
owds[i]:= GetColumnWidth(i);
|
||
end
|
||
if(cls=FColumTexts.Data)and(owds=wds)then exit;
|
||
if ifnil(beg)and ifnil(len)then DeleteAllColumns();
|
||
FColumTexts.splices(beg>0?beg:0,len >= 0?len:FColumTexts.Length(),cls);
|
||
Inherited SetColumns(wds,beg,len);
|
||
end
|
||
end
|
||
function DeleteColumn(i);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 删除某列
|
||
**}
|
||
SetColumns(array(),i,1);
|
||
end
|
||
function InSertColumn(txt,wd,idx);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 插入列 %%
|
||
@param(txt)(string) 标题 %%
|
||
@param(wd)(integer) 宽度 %%
|
||
@param(idx)(integer) 插入在序号之前%%
|
||
**}
|
||
if not(ifstring(txt)and wd >= 0)then return-1;
|
||
if idx >= 0 then p := idx;
|
||
else p := ColumnCount;
|
||
SetColumns(array(("text":txt,"width":wd)),p,0);
|
||
end
|
||
function DeleteAllColumns();virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 删除所有列 %%
|
||
**}
|
||
DeleteAllItems();
|
||
SetColumns(array(),nil,nil);
|
||
end
|
||
function DeleteAllItems();virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 清空内容 %%
|
||
**}
|
||
ItemCount := 0;
|
||
end
|
||
function DeleteItem(i);virtual;
|
||
begin
|
||
ItemCount := ItemCount-1;
|
||
end
|
||
function InsertItem(item);virtual;
|
||
begin
|
||
ItemCount := ItemCount+1;
|
||
end
|
||
function SetColumnText(n,t);
|
||
begin
|
||
FColumTexts[n]:= t;
|
||
end
|
||
function GetColumnText(n);
|
||
begin
|
||
return FColumTexts[n];
|
||
end
|
||
function clean();
|
||
begin
|
||
{**
|
||
@explan(说明) 清空所有项目以及表头 %%
|
||
**}
|
||
DeleteAllColumns();
|
||
end
|
||
function DrawHeader(o,e);virtual;
|
||
begin
|
||
rec := e.rcitem;
|
||
cvs := e.canvas;
|
||
j := e.Subitemid;
|
||
dr := array(rec[0:1],rec[2:3]);
|
||
cvs.Draw("FrameControl",dr,DFC_BUTTON,DFCS_BUTTONPUSH);
|
||
cs := GetColumnText(j);
|
||
if ifstring(cs)then cvs.drawtext(cs,rec,DT_VCENTER .| DT_SINGLELINE .| DT_CENTER .| DT_NOPREFIX);
|
||
end
|
||
function DrawCell(cvs,rec,i,j);override; //绘制表头
|
||
begin
|
||
if not HandleAllocated()then return;
|
||
//构造消息对象
|
||
hd := self.Handle;
|
||
e := new TGRIDMDRAWITEM(WM_DRAWITEM,0,0,hd);
|
||
e.canvas := cvs;
|
||
if FColumHeader then e.itemid := i-1;
|
||
else e.itemid := i;
|
||
e.rcitem := rec;
|
||
e.SubItemRect := rec;
|
||
e.Subitemid := j;
|
||
if FColumHeader and i=0 then
|
||
begin
|
||
return DrawHeader(self(true),e);
|
||
end
|
||
DoDrawItem(self(true),e);
|
||
end
|
||
function DoDrawItem(o,e);virtual;
|
||
begin
|
||
DoDrawSubItem(o,e);
|
||
end
|
||
function DoDrawSubItem(o,e);virtual;
|
||
begin
|
||
if FGridLine then
|
||
begin
|
||
rc := e.rcitem;
|
||
dc := e.canvas;
|
||
dc.Pen.Color := rgb(200,200,200);
|
||
dc.moveto(array(rc[2],rc[1]));
|
||
dc.LineTo(array(rc[2],rc[3]));
|
||
dc.LineTo(array(rc[0],rc[3]));
|
||
if e.Subitemid=0 then
|
||
begin
|
||
dc.LineTo(array(rc[0],rc[1]));
|
||
end
|
||
if e.itemid=0 then
|
||
begin
|
||
dc.MoveTo(array(rc[0],rc[1]));
|
||
dc.LineTo(array(rc[2],rc[1]));
|
||
end
|
||
end
|
||
end
|
||
function DoSelectChanged(o,nindex,oindex);virtual;
|
||
begin
|
||
end
|
||
function MouseDown(o,e);override;
|
||
begin
|
||
r := inherited;
|
||
if r then return r;
|
||
if e.shiftdouble()and e.button()=mbLeft then //双击
|
||
begin
|
||
ne := CreateVclick(o,e);
|
||
ClickedGridItem(o,ne);
|
||
CallMessgeFunction(ondblclick,o,ne);
|
||
end
|
||
end
|
||
function MouseUp(o,e);override;
|
||
begin
|
||
r := inherited;
|
||
if r then return r;
|
||
ne := CreateVclick(o,e);
|
||
bt := e.button();
|
||
if bt=mbRight then
|
||
begin
|
||
RClickedGridItem(o,ne);
|
||
CallMessgeFunction(onrclick,o,ne);
|
||
end else
|
||
if bt=mbLeft then
|
||
begin
|
||
if FColumHeader and(inherited GetRowIndexByPos((ne.ptaction)[1]))=0 then
|
||
begin
|
||
CallMessgeFunction(onColumnClick,o,ne);
|
||
end else
|
||
begin
|
||
ClickedGridItem(o,ne);
|
||
CallMessgeFunction(onclick,o,ne);
|
||
end
|
||
end
|
||
//e.skip := true;
|
||
//rclick
|
||
//click
|
||
//LVN_COLUMNCLICK
|
||
end
|
||
property GridLine:bool read FGridLine write SetGridLine;
|
||
property ColumnHeader:bool read FColumHeader write SetColumHeader;
|
||
property ItemCount:integer read GetItemCount write SetItemCount;
|
||
property onColumnClick:eventhandler read FonColumnClick write FonColumnClick;
|
||
property Columns:statusitems read GetColumns write SetColumns;
|
||
{
|
||
@param(GridLine)(bool) 是否有网格线 %%
|
||
@param(ColumnHeader)(bool) 是否有表头 %%
|
||
@param(color)(integer) 颜色 %%
|
||
@param(onColumnClick)(function[TGRidBase,TTlvnActiveEvent]) 列被点击 %%
|
||
}
|
||
end
|
||
type TDrawGrid=class(TGRidBase)
|
||
{**
|
||
@explan(说明)自绘制网格 %%
|
||
**}
|
||
Private
|
||
FOnDoDrawSubItem;
|
||
protected
|
||
public
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function DoDrawSubItem(o,e);override;
|
||
begin
|
||
inherited;
|
||
CallMessgeFunction(OnDoDrawSubItem,o,e);
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
FOnDoDrawSubItem := nil;
|
||
inherited;
|
||
end
|
||
property OnDoDrawSubItem read FOnDoDrawSubItem write FOnDoDrawSubItem;
|
||
{**
|
||
@param(OnDoDrawSubItem)(function[tdrawgrid,TGRIDMDRAWITEM]) 子项绘制 %%
|
||
@param(ItemCount)(integer) 行数 %%
|
||
**}
|
||
end
|
||
|
||
type TListView = class(TDrawGrid)
|
||
{**
|
||
@explan(说明) listview控件 %%
|
||
**}
|
||
private
|
||
FMouseCurrentTime;
|
||
FList;
|
||
FIntAlign;
|
||
FSelected;
|
||
FMoueonItem;
|
||
FSelBkColor;
|
||
FMouseOnBkColor;
|
||
FMenus;
|
||
FSelectedChanged;
|
||
FOnCheckItem;
|
||
FCanSelected;
|
||
FColumnBool;
|
||
FPrevSelectedId;
|
||
Function SetIntAlign(v);
|
||
begin
|
||
if v in array(DT_CENTER,DT_LEFT,DT_RIGHT)then
|
||
begin
|
||
if v <> FIntAlign then
|
||
begin
|
||
FIntAlign := v;
|
||
InvalidateRect(nil,false);
|
||
end
|
||
end
|
||
end
|
||
function CallSelChanged();
|
||
begin
|
||
return calldatafunction(OnSelChanged,self(true),new tuieventbase(0,0,0,0));
|
||
end
|
||
function SetCanSelected(v);
|
||
begin
|
||
vn := v?true:false;
|
||
if FCanSelected <> vn then
|
||
begin
|
||
FCanSelected := vn;
|
||
if not UnSelected then UnSelected();
|
||
end
|
||
end
|
||
function SetSelected(id);
|
||
begin
|
||
if not FCanSelected then exit;
|
||
if id=FSelected then exit;
|
||
if id<0 then exit;
|
||
odid := FSelected;
|
||
FPrevSelectedId := odid;
|
||
FSelected := id;
|
||
if odid >= 0 then
|
||
begin
|
||
InvalidateItem(odid);
|
||
end
|
||
InvalidateItem(id);
|
||
CallSelChanged();
|
||
end
|
||
function GetSelected();
|
||
begin
|
||
if FSelected >= 0 then return FList[FSelected];
|
||
return nil;
|
||
end
|
||
|
||
function GetListValues();
|
||
begin
|
||
r := array();
|
||
for i := 0 to FList.count-1 do
|
||
begin
|
||
r[i]:= FList[i];
|
||
end
|
||
return r;
|
||
end
|
||
function CreateMenu();
|
||
begin
|
||
if FMenus then return FMenus;
|
||
createmenubyarray(menus(),FMenus);
|
||
return FMenus;
|
||
end
|
||
function createmenubyarray(ms,pm);
|
||
begin
|
||
if not(ifarray(ms)and ms)then exit;
|
||
if ms["type"]="menu" then
|
||
begin
|
||
if not pm then pm := new TPopUpmenu(FCwnd);
|
||
if ifstring(ms["caption"])then
|
||
begin
|
||
mu := new tmenu(FCwnd);
|
||
mu.caption := ms["caption"];
|
||
o := ms["onclick"];
|
||
mu.onclick := ms["onclick"];
|
||
mu.parent := pm;
|
||
call(thisfunction,ms["items"],mu);
|
||
end
|
||
end else
|
||
for i,v in ms do
|
||
begin
|
||
call(thisfunction,v,pm);
|
||
end
|
||
end
|
||
public
|
||
function menus();virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 返回菜单数组 %%
|
||
@return(array) array(("type":"menu","caption":"删除")
|
||
,("type":"menu","caption":"添加"))
|
||
**}
|
||
return array();
|
||
return array(("type":"menu","caption":"删除")
|
||
,("type":"menu","caption":"添加"));
|
||
end
|
||
function DeleteAllItems();override;
|
||
begin
|
||
{**
|
||
@explan(说明) 清空内容 %%
|
||
**}
|
||
UnSelected();
|
||
FList.clean();
|
||
inherited;
|
||
end
|
||
function GridDrawItem(id);
|
||
begin
|
||
{**
|
||
@explan(说明) 绘制第id项 %%
|
||
**}
|
||
InvalidateItem(id);
|
||
end
|
||
function SetSelectedValue(v);
|
||
begin
|
||
{**
|
||
@explan(说明) 设置选中项目 %%
|
||
**}
|
||
id := FList.indexof(v);
|
||
if id >= 0 and id<FList.Count then SetSelected(id);
|
||
end
|
||
function MouseMove(o,e);override;
|
||
begin
|
||
return inherited;
|
||
{r := inherited;
|
||
if r then return r;
|
||
t := now();
|
||
if(t-FMouseCurrentTime)<1/24/60/60/5 then return;
|
||
FMouseCurrentTime := t;
|
||
if(FMouseOnBkColor=rgb(255,255,255))or not(ifnumber(FMouseOnBkColor))then exit;
|
||
item := HitTestItem(e.xpos,e.ypos);
|
||
if not item then exit;
|
||
id := item[0];
|
||
if id >= 0 and id <> FMoueonItem then
|
||
begin
|
||
odid := FMoueonItem;
|
||
FMoueonItem := id;
|
||
if odid >= 0 and odid <> FSelected then
|
||
begin
|
||
InvalidateItem(odid);
|
||
end
|
||
if id <> FSelected then
|
||
begin
|
||
InvalidateItem(id);
|
||
end
|
||
end}
|
||
end
|
||
protected
|
||
function ClickedGridItem(o,e);override;
|
||
begin
|
||
{**
|
||
@explan(说明)点击时处理 %%
|
||
**}
|
||
id := e.iitem;
|
||
j := e.isubitem;
|
||
BJ := FColumnBool[j];
|
||
if BJ then
|
||
begin
|
||
if ifarray(BJ)and BJ[1]then
|
||
begin
|
||
it := o.GetItem(id);
|
||
if ifarray(it)then
|
||
begin
|
||
idx := mrows(it,1)[j];
|
||
if ifnumber(idx)or ifstring(idx)then
|
||
begin
|
||
tti := it[idx];
|
||
if tti=inf or tti=-inf then exit;
|
||
it[idx]:= not tti;
|
||
o.SetItem(id,it);
|
||
rec := o.GetSubItemRect(i,j);
|
||
o.InvalidateRect(rec,false);
|
||
return;
|
||
end
|
||
end
|
||
end
|
||
end
|
||
return SetSelected(id);
|
||
end
|
||
function RClickedGridItem(o,e);override;
|
||
begin
|
||
{**
|
||
@explan(说明)点击时处理 %%
|
||
**}
|
||
id := e.iitem;
|
||
return SetSelected(id);
|
||
end
|
||
public
|
||
function DoDrawItem(o,e);override; //
|
||
begin
|
||
{
|
||
@explan(说明) 绘制 %%
|
||
}
|
||
if not Visible then exit;
|
||
if FSelected=e.itemid then
|
||
begin
|
||
if ifnumber(SelBkColor)then e.canvas.brush.color := SelBkColor;
|
||
else e.canvas.brush.color := rgb(255,255,255);
|
||
end else
|
||
if FMoueonItem=e.itemid then
|
||
begin
|
||
if ifnumber(MouseOnBkColor)then e.canvas.brush.color := MouseOnBkColor;
|
||
else e.canvas.brush.color := rgb(255,255,255);
|
||
end else
|
||
begin
|
||
e.canvas.brush.color := rgb(255,255,255);
|
||
end
|
||
rec := e.rcitem;
|
||
rec[0]+= 1;
|
||
rec[1]+= 1;
|
||
rec[2]-= 1;
|
||
rec[3]-= 1;
|
||
e.canvas.fillrect(rec);
|
||
DoDrawSubItem(o,e);
|
||
end
|
||
function moveup();
|
||
begin
|
||
{**
|
||
@explan(说明) 选中项上移 %%
|
||
**}
|
||
sd := FSelected;
|
||
if sd>0 then
|
||
begin
|
||
FList.swap(sd,sd-1);
|
||
FSelected -= 1;
|
||
GridDrawItem(sd);
|
||
GridDrawItem(sd-1);
|
||
end
|
||
end
|
||
function movedown();
|
||
begin
|
||
{**
|
||
@explan(说明) 选中项下移 %%
|
||
**}
|
||
sd := FSelected;
|
||
if sd >= 0 and sd<FList.Count-1 then
|
||
begin
|
||
FList.swap(sd,sd+1);
|
||
FSelected += 1;
|
||
GridDrawItem(sd);
|
||
GridDrawItem(sd+1);
|
||
end
|
||
end
|
||
function deletebyid(id);
|
||
begin
|
||
{**
|
||
@explan(说明) 根据 序号删除项目 %%
|
||
**}
|
||
if not(id >= 0 and id<FList.Count)then exit;
|
||
SetSelected(id);
|
||
deleteselect();
|
||
end
|
||
function finditemid(v);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 根据类容查找序号 %%
|
||
@return(integer) 序号 ,没找到返回 -1
|
||
**}
|
||
r :=-1;
|
||
for i := 0 to FList.Count-1 do if v=FList[i]then return i;
|
||
return r;
|
||
end
|
||
function deletebyvalue(v);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 根据 值删除 %%
|
||
**}
|
||
deletebyid(FList.indexof(v));
|
||
end
|
||
function deleteselect();
|
||
begin
|
||
{**
|
||
@explan(说明) 删除选中项 %%
|
||
**}
|
||
sd := FSelected;
|
||
return DeleteItem(sd);
|
||
if sd >= 0 then
|
||
begin
|
||
FMoueonItem := nil;
|
||
FList.deli(sd);
|
||
ct := FList.Count-1;
|
||
if sd>ct then
|
||
begin
|
||
FPrevSelectedId := FSelected;
|
||
FSelected := ct;
|
||
CallSelChanged();
|
||
end
|
||
deleteitem(sd);
|
||
end
|
||
end
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FMouseCurrentTime := 0;
|
||
FIntAlign := DT_RIGHT;
|
||
border := true;
|
||
FList := new TFpList();
|
||
SelBkColor := 0xface87;//0xffbf00;//0xB0E0E6; //rgb(200,200,0);
|
||
ItemHeight := 30;
|
||
//MouseOnBkColor := nil;// 0xface87;//0xF8F8FF; //rgb(0,200,200);
|
||
CreateMenu();
|
||
PopupMenu := FMenus;
|
||
FCanSelected := true;
|
||
FPrevSelectedId :=-1;
|
||
FColumnBool := array();
|
||
end
|
||
function CheckItem(v);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 检查项目 %%
|
||
**}
|
||
if datatype(FOnCheckItem)=7 then
|
||
begin
|
||
return call(FOnCheckItem,v);
|
||
end
|
||
return true;
|
||
end
|
||
function InsertItem(v,id);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 在序号id处面插入项目 %%
|
||
@param(v)() 待插入的项目 %%
|
||
@param(id)(integer) 插入位置 %%
|
||
**}
|
||
if CheckItem(v)then
|
||
begin
|
||
if id >= 0 and id <= FList.Count+1 then
|
||
begin
|
||
FList.insertafter(v,id-1);
|
||
ItemCount := FList.Count;
|
||
if FSelected >= 0 and(id-1)<FSelected then
|
||
begin
|
||
FSelected += 1;
|
||
end
|
||
end
|
||
end
|
||
end
|
||
function InsertItemAfter(v,id);virtual;
|
||
begin
|
||
{**
|
||
@ignore(忽略) %%
|
||
@explan(说明) 在序号id后面插入项目 %%
|
||
@param(v)() 待插入的项目 %%
|
||
@param(id)(integer) 插入位置 %%
|
||
**}
|
||
if CheckItem(v)then
|
||
begin
|
||
if id >= 0 and id <= FList.Count then
|
||
begin
|
||
FList.insertafter(v,id);
|
||
ItemCount := FList.Count;
|
||
if FSelected >= 0 and id<FSelected then
|
||
begin
|
||
FSelected += 1;
|
||
end
|
||
end
|
||
end
|
||
end
|
||
function AppendItem(v);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 追加项 %%
|
||
**}
|
||
if CheckItem(v)then
|
||
begin
|
||
FMoueonItem := nil;
|
||
FList.append(v);
|
||
ItemCount := FList.Count;
|
||
//inherited InsertItem(self.ItemCount);
|
||
end
|
||
end
|
||
function SetsubItem(idx,subid,v);
|
||
begin
|
||
{**
|
||
@explan(说明)设置子项 %%
|
||
@param(subid)(string|integer) 下标 %%
|
||
@param(v)(any) 值 %%
|
||
**}
|
||
it := GetItem(idx);
|
||
if not ifarray(it)then exit;
|
||
it[subid]:= v;
|
||
SetItem(idx,it);
|
||
end
|
||
function SetSubItemByIndex(idx,subidx,v);
|
||
begin
|
||
{**
|
||
@explan(说明)通过序号设置子项 %%
|
||
@param(subid)(integer) 下标 %%
|
||
@param(v)(any) 值 %%
|
||
**}
|
||
it := GetItem(idx);
|
||
if not ifarray(it)then exit;
|
||
vid := mrows(it,1)[subidx];
|
||
if ifnumber(vid)or ifstring(vid)then
|
||
begin
|
||
it[vid]:= v;
|
||
end
|
||
SetItem(idx,it);
|
||
end
|
||
function GetItem(idx);
|
||
begin
|
||
{**
|
||
@explan(说明) 获得项 %%
|
||
@param(idx)(integer) 序号 %%
|
||
@param(v)(any) 值%%
|
||
**}
|
||
idx := integer(idx);
|
||
if idx >= 0 and idx<FList.Count then
|
||
begin
|
||
return FList[idx];
|
||
end
|
||
end
|
||
function SetItem(idx,v);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 修改值 %%
|
||
@param(idx)(integer) 序号 %%
|
||
@param(v)(any) 任何数据 %%
|
||
**}
|
||
idx := integer(idx);
|
||
if idx >= 0 and idx<FList.Count then
|
||
begin
|
||
if CheckItem(V)then
|
||
begin
|
||
vi := FList[idx];
|
||
if vi <> v then
|
||
begin
|
||
FList.seti(idx,v);
|
||
if HandleAllocated()then
|
||
begin
|
||
rec := GetItemRect(idx);
|
||
InvalidateRect(rec,false);
|
||
end
|
||
end
|
||
end
|
||
end
|
||
end
|
||
function DeleteItem(i);override;
|
||
begin
|
||
sd := i;
|
||
if sd >= 0 and sd<FList.Count then
|
||
begin
|
||
FMoueonItem := nil;
|
||
FList.deli(sd);
|
||
dsf := sd=FSelected;
|
||
if sd <= FSelected then
|
||
begin
|
||
FSelected := FSelected-1;
|
||
if dsf >= 0 then FPrevSelectedId := dsf;
|
||
CallSelChanged();
|
||
end
|
||
inherited;
|
||
end
|
||
end
|
||
function AppendItems(arr);
|
||
begin
|
||
{**
|
||
@expaln(说明) 追加多个项目 %%
|
||
@param(arr)(array) 项数组 %%
|
||
**}
|
||
cv := array();
|
||
FMoueonItem := nil;
|
||
for i,v in arr do
|
||
begin
|
||
if CheckItem(v)then
|
||
begin
|
||
FList.append(v);
|
||
end
|
||
end
|
||
ItemCount := FList.Count;
|
||
end
|
||
function DoDrawSubItem(o,e);override;
|
||
begin
|
||
{**
|
||
@explan(说明) 绘制子项 %%
|
||
**}
|
||
inherited;
|
||
if e.skip then exit;
|
||
dc := e.canvas;
|
||
if not dc.Handle then exit;
|
||
i := e.itemid;
|
||
di := FList[i];
|
||
if not ifarray(di)then exit;
|
||
j := e.subitemid;
|
||
iddx := mrows(di,1)[j];
|
||
if ifnil(iddx)then exit;
|
||
dij := di[iddx];
|
||
src := e.subItemRect;
|
||
if FColumnBool[j]then
|
||
begin
|
||
//src[0] := src[2]-20-10;
|
||
//src[2]-=10;
|
||
src[1]+= 3;
|
||
src[3]-= 3;
|
||
v := List[i];
|
||
if ifarray(v)then
|
||
begin
|
||
if dij=-inf then dij := false;
|
||
else if dij=inf then dij := true;
|
||
rrx := integer(src[0]-10+(src[2]-src[0])/2);
|
||
rry := integer(src[1]-10+(src[3]-src[1])/2);
|
||
dc.Draw("framecontrol",array((rrx,rry),(rrx+18,rry+18)),DFC_BUTTON,dij?DFCS_CHECKED:DFCS_BUTTONCHECK);
|
||
//_wapi.DrawFrameControl(dc.Handle,src,DFC_BUTTON,dij?DFCS_CHECKED:DFCS_BUTTONCHECK);
|
||
end
|
||
end else
|
||
begin
|
||
if ifstring(dij)and dij then
|
||
begin
|
||
dc.font := font;
|
||
dc.DrawText(dij,src,DT_VCENTER .| DT_LEFT .| DT_SINGLELINE .| DT_NOPREFIX);
|
||
end else
|
||
if ifnumber(dij)then
|
||
begin
|
||
dc.font := font;
|
||
dc.DrawText(tostn(dij),src,DT_VCENTER .| FIntAlign .| DT_SINGLELINE .| DT_NOPREFIX);
|
||
end
|
||
end
|
||
end
|
||
function SetSelectedByValue(v);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 通过值确定选中项
|
||
**}
|
||
if ifnil(v)then UnSelected();
|
||
for i := 0 to List.Count-1 do
|
||
begin
|
||
if v=List[i]then
|
||
begin
|
||
SelectedId := i;
|
||
end
|
||
end
|
||
end
|
||
function ColumnAsBool(n,f,ce);
|
||
begin
|
||
{**
|
||
@expaln(说明) 设置某列为bool %%
|
||
@param(n)(integer) 列号 %%
|
||
@param(f)(bool) 取消或者设置,默认为true %%
|
||
@param(ce)(bool) 是否可以编辑 %%
|
||
**}
|
||
if not(n >= 0)then exit;
|
||
//if not ifarray(FColumnBool) then FColumnBool := array();
|
||
nv := ifnil(f)?:(f?true:false);
|
||
ov := FColumnBool[n];
|
||
ov := ov?true:false;
|
||
if ov <> nv then
|
||
begin
|
||
FColumnBool[n]:= array(nv,ce);
|
||
if HandleAllocated()and n<ColumnCount then
|
||
begin
|
||
InValidateRect(nil,true);
|
||
end
|
||
end
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
SelectedChanged := nil;
|
||
OnCheckItem := nil;
|
||
FMenus := nil;
|
||
DeleteAllItems();
|
||
inherited;
|
||
end
|
||
function UnSelected();
|
||
begin
|
||
{**
|
||
@explan(说明) 取消选择 %%
|
||
**}
|
||
if FSelected >= 0 then
|
||
begin
|
||
sd := FSelected;
|
||
FPrevSelectedId := sd;
|
||
Fselected :=-1;
|
||
GridDrawItem(sd);
|
||
//calldatafunction(SelectedChanged,self(true));
|
||
end
|
||
end
|
||
property SelectedChanged read FSelectedChanged write FSelectedChanged;
|
||
property OnSelChanged:eventhandler read FSelectedChanged write FSelectedChanged;
|
||
property List read FList;
|
||
property CanSelected read FCanSelected write SetCanSelected;
|
||
property SelectedId:integer read Fselected write SetSelected;
|
||
property PrevSelectedId read FPrevSelectedId;
|
||
property SelectedValue read GetSelected;
|
||
property SelBkColor:color read FSelBkColor write FSelBkColor;
|
||
property MouseOnBkColor:color read FMouseOnBkColor write FMouseOnBkColor;
|
||
property ListValues read GetListValues;
|
||
property OnCheckItem:eventhandler read FOnCheckItem write FOnCheckItem;
|
||
property NumberAlign read FIntAlign write SetIntAlign;
|
||
function publishs();override;
|
||
begin
|
||
return array("name","height","width","left","top","border","anchors","align","font","color","parentcolor","parentfont",
|
||
"autoscroll","itemcount","itemheight","mousesizecell",
|
||
"fixedrows","fixedcolumns","columncount",
|
||
"gridline","columnheader","columns",
|
||
"selectedid","selbkcolor","mouseonbkcolor",
|
||
"onmousewheel","onmousemove",
|
||
"onmousedown","onmouseup","ondblclick",
|
||
"onkeyup","onkeydown","onkeypress","oncolumnclick","oncheckitem");
|
||
end
|
||
{**
|
||
@param(SelectedId)(integer) 当前选中的序号,<0表示没有选中项 %%
|
||
@param(PrevSelectedId)(integer) 选择切换前面的选中id %%
|
||
@param(onselchanged)(function[tlistview]) 选中改变回调 %%
|
||
@param(SelectedValue)(any) 选中项的值 %%
|
||
@param(SelBkColor)(integer) 颜色rgb值 %%
|
||
@param(MouseOnBkColor)(integer) 颜色rgb值 %%
|
||
@param(ListValues)(array) 数据 %%
|
||
@param(OnCheckItem)(function[any]:bool) 添加数据时的检测的回调 %%
|
||
**}
|
||
end
|
||
|
||
|
||
|
||
//其他控件
|
||
type tprogressbar = class(tcustomprogressbar)
|
||
{**
|
||
@explan(说明) 进度栏
|
||
进度栏是显示任务进行完成度的控件。进度栏的上下限是进度条位置可移动的
|
||
范围，可以通过range属性获取、修改，其默认值是array(0,100)。进度条的位置可以通过
|
||
position属性获取、修改。进度栏的步增量是其每次调用increaseByStep函数进度条
|
||
位置移动的量，可以通过step属性获取、修改，其默认值是10.
|
||
进度条默认是分段离散的，可通过修改smooth成员设置其为平滑连续的。默认是
|
||
水平从左到右移动，可通过修改vertical成员来设置其为垂直从底部到顶部移动。
|
||
**}
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name",
|
||
"align","anchors",
|
||
"popupmenu","color","visible","enabled","parnetcolor",
|
||
"height","width","left","top",
|
||
"vertical","range","position","barcolor","onmousemove","onpopupmenu",
|
||
"onmousedown","onmouseup");
|
||
end
|
||
|
||
end
|
||
type tmonthcalendar = class(TCustomControl)
|
||
{**
|
||
@explan(说明)月历控件
|
||
该控件的函数可能的返回值：
|
||
array等期望的数据/1：成功。
|
||
-1：一般是函数参数格式不正确。
|
||
nil：该项属性在控件种类正确、窗口未创建、无默认值的情况下未设置过或被重置过。
|
||
0：失败，可能的原因：
|
||
1.参数格式正确但不适用于控件的当前状态，如对多选月历设置当前选择项时项数超过其最大多选项数限制。
|
||
2.控件类型错误，如对单选月历调用设置其最大多选项数限制的函数。
|
||
3.要求控件创建后才可调用的函数在控件创建之前被调用。
|
||
4.未知错误。
|
||
**}
|
||
function create(aowner);
|
||
begin
|
||
inherited;
|
||
width := 213;
|
||
height := 175;
|
||
FCalender := new tVirtualCalender();
|
||
FCalender.ExecuteCommand("memymd",date());
|
||
FCalender.Left := 1;
|
||
FCalender.top := 1;
|
||
FCalender.host := self(true);
|
||
//TodayButton := false;
|
||
end
|
||
function isContainer(cd);override;
|
||
begin
|
||
return 0;
|
||
end
|
||
function paint();override;
|
||
begin
|
||
if FCalender then FCalender.paint();
|
||
end
|
||
function MouseUp(o,e);override;
|
||
begin
|
||
inherited;
|
||
if e.skip then return ;
|
||
if not FCalender then return ;
|
||
if e.button()= mbLeft then
|
||
begin
|
||
r := FCalender.ExecuteCommand("mestatebypos",e.pos);
|
||
if r then return ;
|
||
r := FCalender.ExecuteCommand("megetincpos",e.pos);
|
||
if r then return FCalender.ExecuteCommand("meminc",r);
|
||
std := FCalender.ExecuteCommand("mestate");
|
||
r := FCalender.ExecuteCommand("meselbypos",e.pos);
|
||
if std=3 or r="today" then
|
||
begin
|
||
CallMessgeFunction(FonSelect,self(true),new tuieventbase(0,0,0,0));
|
||
end
|
||
end
|
||
end
|
||
function getCurrentSelection();begin
|
||
{**
|
||
@explan(说明)获取当前选择的日期，该函数仅能用于单选的月历控件%%
|
||
@return(array/integer/nil)array:成功;0:失败;nil:未设置过此项。
|
||
array(2019,2,1)
|
||
**}
|
||
if FCalender then
|
||
begin
|
||
r := FCalender.ExecuteCommand("meymd");
|
||
decodedate(r,y,m,d);
|
||
return array(y,m,d);
|
||
end
|
||
return 0;
|
||
end
|
||
function setCurrentSelection(y,m,d);
|
||
begin
|
||
{**
|
||
@explan(说明)设置当前选择日期，该函数仅能用于单选的月历控件%%
|
||
@param(y)(integer)年%%
|
||
@param(m)(integer)月%%
|
||
@param(d)(integer)日%%
|
||
@return(integer)1:成功;0:失败;-1:出错%%
|
||
**}
|
||
if ifnumber(y) and ifnumber(m) or ifnumber(d) then
|
||
begin
|
||
dt := encodedate(y,m,d);
|
||
if FCalender then
|
||
begin
|
||
FCalender.ExecuteCommand("meymd",dt);
|
||
return 1;
|
||
end
|
||
end
|
||
end
|
||
function DoDatechanged();
|
||
begin
|
||
CallMessgeFunction(FonSelectChange,self(true),new tuieventbase(0,0,0,0));
|
||
end
|
||
function recycling();override;
|
||
begin
|
||
FCalender.recycling();
|
||
inherited;
|
||
FCalender := nil;
|
||
FonSelect := nil;
|
||
FonSelectChange := nil;
|
||
end
|
||
property TodayButton:bool read getnoTodayButton write setNoTodayButton;
|
||
property onSelect:eventhandler read FonSelect write FonSelect;
|
||
property onSelectChange:eventhandler read FonSelectChange write FonSelectChange;
|
||
function publishs();override;
|
||
begin
|
||
return array("name","caption","anchors","enabled","color",
|
||
"popupmenu","visible","parentcolor",
|
||
"height","width","left","top","border","onmousemove","onpopupmenu",
|
||
"onmousedown","onmouseup","onselect","onselectchange");
|
||
end
|
||
{**
|
||
@param(todayButton)(bool)月历显示“今日”按钮（默认开启）%%
|
||
@param(onSelect)(function[tmonthcalendar,tuieventbase])显式选择日期%%
|
||
@param(onSelectChange)(function[tmonthcalendar,tuieventbase])选择日期改变%%
|
||
**}
|
||
|
||
private
|
||
function setNoTodayButton(v);
|
||
begin
|
||
if FCalender then return FCalender.ExecuteCommand("metodaybutton",v);
|
||
end
|
||
function getnoTodayButton();
|
||
begin
|
||
if FCalender then return FCalender.ExecuteCommand("metodaybutton");
|
||
end
|
||
private
|
||
FCalender;
|
||
FMousedownState;
|
||
FonSelect;
|
||
FonSelectChange;
|
||
end
|
||
|
||
type tdatetimepicker = class(tthreeEntry)
|
||
{**
|
||
@explan(说明) 日期选择控件 %%
|
||
**}
|
||
function create(aowner);
|
||
begin
|
||
inherited;
|
||
caption:="Date/TimePicker";
|
||
FCalender := new tmonthcalendar(self);
|
||
FCalender.border := true;
|
||
FCalender.WsPopUp := true;
|
||
FCalender.parent := self;
|
||
FCalender.Visible := false;
|
||
FScreenRect := _wapi.GetScreenRect();
|
||
decodedate(date(),y,m,d);
|
||
setDate(y,m,d);
|
||
FCalender.onSelect := function(o,e)begin
|
||
FCalender.Visible := false;
|
||
d := FCalender.getCurrentSelection();
|
||
setDate(d[0],d[1],d[2]);
|
||
end
|
||
FCalender.OnActivate := function(o,e)begin
|
||
if e.wparam=0 then
|
||
begin
|
||
FCalender.Visible := false;
|
||
end
|
||
end
|
||
end
|
||
function btnclicked(p);override;
|
||
begin
|
||
rec := BtnRect;
|
||
if pointinrect(p,rec) then
|
||
begin
|
||
ShowDropDown(true);
|
||
return true;
|
||
end
|
||
end
|
||
|
||
function ExecuteCommand(cmd,p);override;
|
||
begin
|
||
case cmd of
|
||
"dtchanged":
|
||
begin
|
||
es := entrys;
|
||
if p = es[2] then //日
|
||
begin
|
||
pn := getenumber(p);
|
||
y := getenumber(es[0]);
|
||
m := getenumber(es[1]);
|
||
if pn<1 then p.text := inttostr(getmonthdates(y,m));
|
||
else
|
||
if pn>28 and pn>getmonthdates(y,m) then
|
||
begin
|
||
p.text := "1";
|
||
end
|
||
end else
|
||
if p = es[1] then //月
|
||
begin
|
||
y := getenumber(es[0]);
|
||
m := getenumber(es[1]);
|
||
bm := m;
|
||
if m>12 then
|
||
begin
|
||
m := 1;
|
||
end else
|
||
if m<1 then m := 12;
|
||
if bm<>m then
|
||
begin
|
||
p.text := inttostr(m);
|
||
end
|
||
d := getenumber(es[2]);
|
||
if d<1 then es[2].text := "1";
|
||
else
|
||
if d>28 then
|
||
begin
|
||
ct := getmonthdates(y,m);
|
||
if d>ct then es[2].text := inttostr(ct);
|
||
end
|
||
end else
|
||
if p = es[0] then //年
|
||
begin
|
||
y := getenumber(p);
|
||
m := getenumber(es[1]);
|
||
d := getenumber(es[2]);
|
||
if dt>28 then
|
||
begin
|
||
ct := getmonthdates(y,m);
|
||
if d>ct then es[2].text := inttostr(ct);
|
||
end
|
||
end
|
||
calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));
|
||
end
|
||
"dtadate":
|
||
begin
|
||
es := entrys;
|
||
if ifarray(p) and ifnumber(p[0]) and ifnumber(p[1]) and ifnumber(p[2]) then
|
||
begin
|
||
dt := encodedate(p[0],p[1],p[2]);
|
||
decodedate(dt,y,m,d);
|
||
es[0].text := inttostr(y);
|
||
es[1].text := inttostr(m);
|
||
es[2].text := inttostr(d);
|
||
calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));
|
||
end else
|
||
begin
|
||
y := strtointdef(es[0].text,2021);
|
||
m := strtointdef(es[1].text,1);
|
||
d := strtointdef(es[2].text,1);
|
||
return array(y,m,d);
|
||
end
|
||
|
||
end
|
||
|
||
end
|
||
end
|
||
function ShowDropDown(f);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 设置弹出框的显示区域 %%
|
||
**}
|
||
if not(FCalender ) then return ;
|
||
nv := ifnil(f)?true:(f?true:false);
|
||
if FCalender.Visible = nv then return FCalender.show(0);
|
||
rc := ClientRect;
|
||
nrc := ClientToScreen(rc[0],rc[3]);
|
||
if FScreenRect[3]-nrc[1]<200 then
|
||
begin
|
||
nrc[1]:= nrc[0]-height-FCalender.height-2;
|
||
end
|
||
FCalender.Left := nrc[0];
|
||
FCalender.top := nrc[1];
|
||
dt := getDate();
|
||
FCalender.setCurrentSelection(dt[0],dt[1],dt[2]);
|
||
FCalender.show();
|
||
end
|
||
function getDate();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得日期 %%
|
||
@return(array) array(y,m,d) %%
|
||
**}
|
||
return ExecuteCommand("dtadate");
|
||
end
|
||
function setDate(y,m,d);
|
||
begin
|
||
{**
|
||
@explan(说明) 获得日期 %%
|
||
@param(y)(integer) 年 %%
|
||
@param(m)(integer) 月 %%
|
||
@param(d)(integer) 日 %%
|
||
**}
|
||
return ExecuteCommand("dtadate",array(y,m,d));
|
||
end
|
||
function recycling();override;
|
||
begin
|
||
inherited;
|
||
FCalender := nil;
|
||
Fonselectchange := nil;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","caption","anchors","enabled","font","color",
|
||
"popupmenu","visible","parentcolor","parentfont",
|
||
"height","width","left","top","border","onmousemove","onpopupmenu",
|
||
"onmousedown","onmouseup","onselectchange");
|
||
end
|
||
property onselectchange:eventhandler read Fonselectchange write Fonselectchange;
|
||
{
|
||
@param(onSelectChange)(function[tmonthcalendar,tuieventbase])选择日期改变%%
|
||
}
|
||
private
|
||
function getenumber(e);
|
||
begin
|
||
t := e.text;
|
||
ti := strtointdef(t,1);
|
||
return ti;
|
||
end
|
||
FScreenRect;
|
||
FCalender;
|
||
Fonselectchange;
|
||
end
|
||
type ttimepicker = class(tthreeEntry)
|
||
function create(aowner);
|
||
begin
|
||
inherited;
|
||
caption := "timepicker";
|
||
width := 120;
|
||
ExecuteCommand("dttime",now());
|
||
end
|
||
function ExecuteCommand(cmd,p);override;
|
||
begin
|
||
case cmd of
|
||
"dttime":
|
||
begin
|
||
if ifnumber(p) then
|
||
begin
|
||
decodedatetime(p,y,mt,d,h,m,s,ms);
|
||
ExecuteCommand("dtatime",array(h,m,s));
|
||
|
||
end else
|
||
begin
|
||
r := ExecuteCommand("dtatime");
|
||
r2 := encodedatetime(2021,1,1,r[0],r[1],r[2],0);
|
||
if ifarray(r) then
|
||
begin
|
||
return frac(r2);
|
||
end
|
||
end
|
||
end
|
||
"dtatime":
|
||
begin
|
||
es := entrys;
|
||
if ifarray(p) and ifnumber(p[0]) and ifnumber(p[1]) and ifnumber(p[1]) then
|
||
begin
|
||
es[0].text := inttostr(p[0]);
|
||
es[1].text := inttostr(p[1]);
|
||
es[2].text := inttostr(p[2]);
|
||
ExecuteCommand("dtchanged",es[2]);
|
||
end else
|
||
begin
|
||
r := array();
|
||
for i,v in es do r[i] := strtointdef(v.text,0);
|
||
return r;
|
||
end
|
||
end
|
||
"dtchanged":
|
||
begin
|
||
es := entrys;
|
||
if es[2]=p then
|
||
begin
|
||
t := p.text;
|
||
ti := strtointdef(t,0);
|
||
if ti<0 then
|
||
begin
|
||
p.text := "59";
|
||
es[1].dec();
|
||
end else
|
||
if ti>59 then
|
||
begin
|
||
p.text := "0";
|
||
es[1].inc();
|
||
end
|
||
end else
|
||
if es[1] = p then
|
||
begin
|
||
t := p.text;
|
||
ti := strtointdef(t,0);
|
||
if ti<0 then
|
||
begin
|
||
p.text := "59";
|
||
es[0].dec();
|
||
end else
|
||
if ti>59 then
|
||
begin
|
||
p.text := "0";
|
||
es[0].inc();
|
||
end
|
||
end else
|
||
if es[0] = p then
|
||
begin
|
||
t := p.text;
|
||
ti := strtointdef(t,0);
|
||
if ti<0 then p.text := "24";
|
||
else if ti>24 then p.text := "0";
|
||
end
|
||
calldatafunction(Fonselectchange,self(true),new tuieventbase(0,0,0,0));
|
||
end
|
||
end
|
||
end
|
||
function PaintBtn();override;
|
||
begin
|
||
if FRectUp then
|
||
begin
|
||
dc := Canvas;
|
||
dc.Draw("framecontrol",array(FRectUp[0:1],FRectUp[2:3]),DFC_SCROLL,DFCS_SCROLLUP);
|
||
dc.Draw("framecontrol",array(FRectDown[0:1],FRectDown[2:3]),DFC_SCROLL,DFCS_SCROLLDOWN);
|
||
end
|
||
end
|
||
function btnClicked(p);virtual;
|
||
begin
|
||
if pointinrect(p,FRectUp) then
|
||
begin
|
||
for i,v in entrys do
|
||
begin
|
||
if v.HasFocus then
|
||
begin
|
||
v.inc();
|
||
return 1;
|
||
end
|
||
end
|
||
|
||
end else
|
||
if pointinrect(p,FRectDown) then
|
||
begin
|
||
for i,v in entrys do
|
||
begin
|
||
if v.HasFocus then
|
||
begin
|
||
v.dec();
|
||
return 1;
|
||
end
|
||
end
|
||
|
||
end
|
||
end
|
||
function isContainer(cd);override;
|
||
begin
|
||
return 0;
|
||
end
|
||
function getTime();override;begin
|
||
{**
|
||
@explan(说明)获取控件当前选择的时间%%
|
||
@return(array)%%
|
||
**}
|
||
return ExecuteCommand("dtatime");
|
||
end
|
||
function setTime(h,m,s);override;begin
|
||
{**
|
||
@explan(说明)设置控件当前选择的时间%%
|
||
@param(h)(integer)时，24小时制%%
|
||
@param(m)(integer)分%%
|
||
@param(s)(integer)秒%%
|
||
**}
|
||
return ExecuteCommand("dtatime",array(h,m,s));
|
||
end
|
||
function recycling();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","align","anchors","caption","enabled","font","color",
|
||
"popupmenu","visible","parentcolor","parentfont",
|
||
"height","width","left","top","border","onmousemove","onpopupmenu",
|
||
"onmousedown","onmouseup","onkeyup","onkeydown","onselectchange");
|
||
end
|
||
property onselectchange:eventhandler read Fonselectchange write Fonselectchange;
|
||
{
|
||
@param(onSelectChange)(function[tmonthcalendar,tuieventbase])选择日期改变%%
|
||
}
|
||
protected
|
||
function calcCtls();override;
|
||
begin
|
||
inherited;
|
||
rec := BtnRect;
|
||
FRectUp := array(rec[0],rec[1],rec[2],integer(rec[1]+rec[3]/2));
|
||
FRectDown := array(rec[0],integer(rec[1]+rec[3]/2),rec[2],rec[3]);
|
||
end
|
||
private
|
||
function getEntryWidth(i);virtual;
|
||
begin
|
||
return 2;
|
||
end
|
||
function getSym(i);virtual;
|
||
begin
|
||
return ":";
|
||
end
|
||
FRectUp;
|
||
FRectDown;
|
||
Fonselectchange;
|
||
end
|
||
type tipaddr = class(tcustomipaddr)
|
||
{**
|
||
@explan(说明) ip控件 %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","align","anchors","font","color","caption","visible","parentcolor","parentfont","height","width","left","top",
|
||
"ipaddr","HasPort","onAddrChange","border","wsdlgmodalframe");
|
||
end
|
||
end
|
||
|
||
type TSpinEdit=class(TCustomSpinEdit)
|
||
{**
|
||
@explan(说明)spinedit控件
|
||
**}
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
//border := true;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","left","top","anchors","width","height",
|
||
"border","enabled","visible",
|
||
"increment","minvalue","maxvalue","value","wsdlgmodalframe","onincrease","ondecrease");
|
||
end
|
||
end
|
||
|
||
type tapplicationwindow=class(TWinControl)
|
||
{**
|
||
@explan(说明) application窗口类 %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
//class(TWinControl).create(AOwner);
|
||
inherited;
|
||
caption := "applicationwindow";
|
||
FLeft := 0;
|
||
FTop := 0;
|
||
FHeight := 0;
|
||
Fwidth := 0;
|
||
Visible := true;
|
||
WsPopUp := true;
|
||
WsCaption := true;
|
||
end
|
||
function createparams(p);override;
|
||
begin
|
||
inherited;
|
||
p.WinClassName := "tsui_application";
|
||
//p.style := p.style .& (.! (WS_GROUP .| WS_TABSTOP .| WS_CHILD));
|
||
//p.exstyle := WS_EX_TOOLWINDOW;
|
||
//p.style := WS_VISIBLE .| WS_POPUP .| WS_CAPTION ;//.| WS_CLIPSIBLINGS .| WS_SYSMENU;
|
||
end
|
||
function InitializeWnd();override;
|
||
begin
|
||
inherited;
|
||
{echo self.Handle;
|
||
SysMeu := _wapi.GetSystemMenu(self.Handle,False);
|
||
echo "\r\nsysmenu",sysmenu;
|
||
echo "\r\ndelete:",_wapi.DeleteMenu(SysMeu,SC_MAXIMIZE,MF_BYCOMMAND);
|
||
echo "\r\ndelete:",_wapi.DeleteMenu(SysMeu,SC_SIZE,MF_BYCOMMAND);
|
||
echo "\r\ndelete:",_wapi.DeleteMenu(SysMeu,SC_MOVE,MF_BYCOMMAND);
|
||
echo "\r\nsysmenu",sysmenu;}
|
||
end
|
||
Function DoWMCLOSE(o,e);override;
|
||
begin
|
||
//Recycling();
|
||
DestroyComponents();
|
||
_wapi.PostQuitMessage(0);
|
||
end
|
||
function DoCnNotify(o,e);override;
|
||
begin
|
||
end
|
||
end
|
||
|
||
type TImageListDrawStyle = class
|
||
{**
|
||
@explan(说明) imagelist 绘制的样式选择 %%
|
||
**}
|
||
static ILD_NORMAL;static ILD_TRANSPARENT;
|
||
static ILD_MASK;static ILD_IMAGE;static ILD_ROP;
|
||
static ILD_BLEND25;static ILD_BLEND50;static ILD_OVERLAYMASK;
|
||
static ILD_PRESERVEALPHA;static ILD_SCALE;static ILD_DPISCALE;
|
||
static ILD_ASYNC;static ILD_SELECTED;static ILD_FOCUS;
|
||
static ILD_BLEND;
|
||
end
|
||
type TImageListCreateflags = class
|
||
{**
|
||
@explan(说明) imagelist 构造的参数 %%;
|
||
**}
|
||
static ILC_MASK;static ILC_COLOR;static ILC_COLORDDB;
|
||
static ILC_COLOR4;static ILC_COLOR8;static ILC_COLOR16;
|
||
static ILC_COLOR24;static ILC_COLOR32;static ILC_PALETTE;
|
||
static ILC_MIRROR;static ILC_PERITEMMIRROR;static ILC_ORIGINALSIZE;
|
||
static ILC_HIGHQUALITYSCALE;
|
||
|
||
end
|
||
|
||
type tcontrolimagelist=class(tcustomcontrolimagelist)
|
||
{**
|
||
@explan(说明) 控件imagleit %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
|
||
|
||
type TDragImageList=class(TCustomImageList)
|
||
{**
|
||
@ignore(忽略) %%
|
||
**}
|
||
private
|
||
FDragCursor:TCursor;
|
||
FDragging:Boolean;
|
||
FDragHotspot:TPoint;
|
||
FOldCursor:TCursor;
|
||
FImageIndex:Integer;
|
||
FLastDragPos:TPoint;
|
||
FLockedWindow:HWND; // window where drag started and locked via DragLock, invalid=NoLockedWindow=High(PtrInt)
|
||
procedure SetDragCursor(AValue);
|
||
begin
|
||
if ifnumber(AValue)and FDragCursor.id <> AValue then
|
||
begin
|
||
FDragCursor.id := AValue;
|
||
end
|
||
end
|
||
protected
|
||
procedure Initialize;override;
|
||
public
|
||
function create(Owner);override;
|
||
begin
|
||
inherited;
|
||
FDragCursor := new TCursor();
|
||
end
|
||
function BeginDrag(Window:HWND;X,Y:Integer):Boolean;
|
||
begin
|
||
if not HandleAllocated()then exit;
|
||
if not FDragging then
|
||
begin
|
||
FDragCursor.show();
|
||
FDragging := true;
|
||
DragLock(Window,x,y);
|
||
FDragHotspot := array(x,y);
|
||
px := integer(Width/2);
|
||
py := integer(Height/2);
|
||
_wapi.ImageList_BeginDrag(self.Handle,FImageIndex>0?FImageIndex:0,px,py);
|
||
_wapi.ImageList_DragEnter(Window,x,y);
|
||
end else
|
||
DragMove(x,y);
|
||
end
|
||
function DragLock(Window:HWND;XPos,YPos:Integer):Boolean;
|
||
begin
|
||
FLockedWindow := HWND;
|
||
end
|
||
function DragMove(X,Y:Integer):Boolean;
|
||
begin
|
||
if FDragging then
|
||
begin
|
||
_wapi.ImageList_DragMove(x,y);
|
||
end
|
||
end
|
||
procedure DragUnlock;
|
||
function EndDrag:
|
||
Boolean;
|
||
begin
|
||
if FDragging then
|
||
begin
|
||
_wapi.ImageList_DragLeave(FLockedWindow);
|
||
_wapi.ImageList_EndDrag();
|
||
FDragging := false;
|
||
end
|
||
end
|
||
function GetHotSpot:
|
||
TPoint;
|
||
override;
|
||
begin
|
||
return FDragHotspot;
|
||
end
|
||
procedure HideDragImage;
|
||
function SetDragImage(Index,HotSpotX,HotSpotY:Integer):Boolean;
|
||
//procedure ShowDragImage;
|
||
property DragCursor:TCursor read FDragCursor write SetDragCursor;
|
||
property DragHotspot:TPoint read FDragHotspot write FDragHotspot;
|
||
property Dragging:Boolean read FDragging;
|
||
property ImageIndex read FImageIndex write FImageIndex;
|
||
end
|
||
type TImage = class(tcustomimage)
|
||
function create();
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
type TBitmap = class(tcustombitmap)
|
||
|
||
function create();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
type TIcon = class(tcustomicon)
|
||
function create();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
|
||
end
|
||
type tcursor = class(tcustomcursor)
|
||
function create();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
|
||
type TFont = class(tcustomfont)
|
||
function create();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
|
||
type tpen = class(tcustompen)
|
||
function create();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
|
||
end
|
||
|
||
type TBrush = class(tcustombrush)
|
||
function create();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
type TCanvas = class(TCustomcanvas)
|
||
function create();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
type TTimer = class(TCustomTimer)
|
||
{**
|
||
@explan(说明)定时器类,间隔是以毫秒为最小单位 %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","interval","ontimer");
|
||
end
|
||
end
|
||
|
||
//******action 相关*****************************************
|
||
|
||
|
||
type TAction=class(TCustomAction)
|
||
{**
|
||
@explan(说明) action / command 类 对外接口,参考 TCustomAction 类 %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
|
||
function publishs();override;
|
||
begin
|
||
r := array("name","caption","enabled","shortcut","onexecute");
|
||
return r;
|
||
end
|
||
end
|
||
type tactionlist =class(TCustomactionlist)
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name");
|
||
end
|
||
end
|
||
|
||
|
||
//*****************************
|
||
type TMessageboxADlg = class(TcustommsgADlg)
|
||
{**
|
||
@explan(说明) 消息提示框 %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","chooseok","caption",
|
||
"mbtext","mbbtnstyle","mbiconstyle");
|
||
end
|
||
end
|
||
type TColorChooseADlg = class(tcustomcolordlg)
|
||
{**
|
||
@explan(说明)颜色选择器 %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","chooseok","caption",
|
||
"customcolors","result");
|
||
end
|
||
end
|
||
type TFontChooseADlg = class(tcustomfontdlg)
|
||
{**
|
||
@explan(说明) 字体选择对话框 %%
|
||
**}
|
||
function Create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
array("name","chooseok","caption","color");
|
||
end
|
||
|
||
end
|
||
type TSavefileADlg = class(tcustomfsdlg)
|
||
{**
|
||
@explan(说明) 保存文件,获得文件名 %%
|
||
@param(FFileTag)(TtagOFNA)openfile 对象 %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","caption","filter","filterindex","filename","defaultfileextension",
|
||
"showhidden","multiselected","overwriteprompt","filemustexist"); //"linkfilepath" "createprompt"
|
||
end
|
||
|
||
end
|
||
type TOpenFileADlg=class(tcustomfsdlg)
|
||
{**
|
||
@explan(说明) 打开文件对话框类 %%
|
||
**}
|
||
private
|
||
function OpenFileDlg();virtual;
|
||
begin
|
||
r := _wapi.GetOpenFileNameA(FFileTag._getptr_);
|
||
return r;
|
||
end
|
||
protected
|
||
function dlgType();virtual;
|
||
begin
|
||
return 2;
|
||
end
|
||
public
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","caption","filter","filterindex","filename",
|
||
"defaultfileextension","showhidden","multiselected"); //,"linkfilepath"
|
||
end
|
||
end
|
||
type TFolderChooseADlg = class(tcustomfolderdlg)
|
||
{**
|
||
@explan(说明) 文件夹路径选择对话框 %%
|
||
**}
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","caption",
|
||
"defaultdir","rootfolder","folder");
|
||
end
|
||
end
|
||
|
||
//菜单
|
||
type TMenu = class(TcustomMenu)
|
||
{**
|
||
@explan(说明) 菜单 %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("action","bitmap","caption","checked","enabled","name","tseparator",
|
||
"onclick","onrbuttonup","onselect");
|
||
end
|
||
end
|
||
type TPopupmenu=class(TcustomPopupmenu)
|
||
{**
|
||
@explan(说明) 弹出菜单 %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","caption","enabled","onrbuttonup");
|
||
end
|
||
end
|
||
type TMainmenu = class(TcustomMainmenu)
|
||
{**
|
||
@explan(说明) 主窗口菜单 %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name");
|
||
end
|
||
end
|
||
|
||
type TApplicationProperties=class(TComponent)
|
||
{**
|
||
|
||
@ignore(忽略) %%
|
||
@explan(说明)应用属性设置 %%
|
||
**}
|
||
private
|
||
FApplication;
|
||
FTrayData;
|
||
function SetShowTray();
|
||
begin
|
||
end
|
||
function SetPopupMenu();
|
||
begin
|
||
end
|
||
public
|
||
function Create(AOwner);
|
||
begin
|
||
inherited;
|
||
FApplication := getapplication();
|
||
FTrayData := new TNOTIFYICONDATAA();
|
||
end
|
||
property TrayMenu:tpopupmenu read FPopupMenu write SetPopupMenu;
|
||
property TrayIcon:icondata read FTrayIcon write FTrayIcon;
|
||
property ShowTray:bool read FShowTray write SetShowTray;
|
||
end
|
||
|
||
|
||
//windoes socket通信类
|
||
type TSocketInterface=class(TComponent)
|
||
{**
|
||
@explan(说明) windows socket 接口类 %%
|
||
**}
|
||
private
|
||
FPort;
|
||
FIp;
|
||
FHandle;
|
||
FCSocket;
|
||
FIPproto;
|
||
//*******************
|
||
FOnRead;
|
||
FOnConnect;
|
||
FOnWrite;
|
||
FOnAccept;
|
||
FOnError;
|
||
FOnClose;
|
||
FCache;
|
||
FErrorId;
|
||
//**********************
|
||
static FNetWindow; //窗口
|
||
static FRootSocket; //socket
|
||
static FWSDATA; //结构体
|
||
function SetIPproto(V);virtual;
|
||
begin
|
||
if v in array(IPPROTO_TCP,IPPROTO_UDP)and v <> FIPproto then
|
||
begin
|
||
FIPproto := v;
|
||
if HandleAllocated()then CloseSocket();
|
||
end
|
||
end
|
||
protected
|
||
class function sinit();override;
|
||
begin
|
||
inherited;
|
||
if not FNetWindow then
|
||
begin
|
||
FNetWindow := new TCustomControl(getapplication());
|
||
FNetWindow.visible := false;
|
||
FNetWindow.WSPopUp := true;
|
||
FNetWindow.bindmessage(WM_SOCKET,thisfunction(WMSOCKET));
|
||
FWSDATA := new TWSADATA();
|
||
_wapi.WSAStartup(2^9+1,FWSDATA._getptr_);
|
||
FRootSocket := array();
|
||
end
|
||
end
|
||
class function BindSoketEvents(sk,flag);
|
||
begin
|
||
{**
|
||
@expaln(说明)绑定事件 %%
|
||
**}
|
||
if sk is class(TSocketInterface)then
|
||
begin
|
||
if not(ifnumber(flag))then flag := FD_ALL_EVENTS;
|
||
if flag=0 then
|
||
begin
|
||
reindex(FRootSocket,array(inttostr(sk.Handle):nil));
|
||
_wapi.WSAAsyncSelect(sk.Handle,FNetWindow.Handle,0,0);
|
||
end else
|
||
begin
|
||
_wapi.WSAAsyncSelect(sk.Handle,FNetWindow.Handle,WM_SOCKET,(FD_READ .| FD_WRITE .| FD_CONNECT .| FD_CLOSE .| FD_ACCEPT //flag
|
||
));
|
||
FRootSocket[inttostr(sk.Handle)]:= sk;
|
||
end
|
||
end
|
||
end
|
||
class function GetSocket(id);
|
||
begin
|
||
{**
|
||
@param(id)(pointer) 句柄 %%
|
||
**}
|
||
return FRootSocket[inttostr(id)];
|
||
end
|
||
class function WMSOCKET(o,e);
|
||
begin
|
||
gw := _wapi;
|
||
sk := GetSocket(e.wparam);
|
||
if not sk then exit;
|
||
if e.hilparam then //错误
|
||
begin
|
||
FErrorId := e.hilparam;
|
||
return sk.DoError();
|
||
end
|
||
FErrorId := 0;
|
||
case e.lolparam of
|
||
FD_ACCEPT:
|
||
begin
|
||
sk.DoAccept();
|
||
end
|
||
FD_CLOSE:
|
||
begin
|
||
sk.CloseSocket();
|
||
sk.DoClose();
|
||
end
|
||
FD_WRITE:
|
||
begin
|
||
sk.DoWrite();
|
||
end
|
||
FD_READ:
|
||
begin
|
||
sk.DoRead();
|
||
end
|
||
FD_CONNECT:
|
||
begin
|
||
sk.DoConnected();
|
||
end
|
||
end
|
||
end
|
||
type TSocketCache=class
|
||
{**
|
||
@explan(说明) 缓存 %%
|
||
**}
|
||
FData;
|
||
FBottom;
|
||
FTop;
|
||
function create();
|
||
begin
|
||
init();
|
||
end
|
||
function size();
|
||
begin
|
||
return FTop-FBottom;
|
||
end
|
||
function init();
|
||
begin
|
||
FData := array();
|
||
FTop := FBottom := 0;
|
||
end
|
||
function GetBottom();
|
||
begin
|
||
if FBottom<FTop then
|
||
begin
|
||
return FData[FBottom++];
|
||
end
|
||
end
|
||
function adjust();
|
||
begin
|
||
if size()=0 then init();
|
||
end
|
||
function back(v);
|
||
begin
|
||
if FBottom>0 then
|
||
begin
|
||
FBottom--;
|
||
if v then
|
||
begin
|
||
FData[FBottom]:= v;
|
||
end
|
||
end
|
||
end
|
||
function add(v); //
|
||
begin
|
||
if v then
|
||
begin
|
||
FData[FTop++]:= v;
|
||
end
|
||
end
|
||
end
|
||
function GetHandle();
|
||
begin
|
||
if not HandleAllocated()then CreateHandle();
|
||
return FHandle;
|
||
end
|
||
function InitCSocket();virtual;
|
||
begin
|
||
adr := _wapi.inet_addr(FIp);
|
||
FCSocket.sin_family := AF_INET;
|
||
FCSocket.sin_addr := adr;
|
||
FCSocket.sin_port := _wapi.htons(FPort);
|
||
return adr=INADDR_NONE;
|
||
end
|
||
function CreateInitialStr(n);
|
||
begin
|
||
{**
|
||
@explan(说明) 初始化字符串 %%
|
||
@param(n)(integer) 字符串长度 %%
|
||
@return(string) %%
|
||
**}
|
||
ret := "\0";
|
||
if n>0 then
|
||
begin
|
||
setlength(ret,n);
|
||
for i := 1 to n-1 do
|
||
begin
|
||
ret[i]:= "\0";
|
||
end
|
||
end
|
||
return ret;
|
||
end
|
||
function CreateHandle();virtual;
|
||
begin
|
||
if csDesigning in ComponentState then exit;
|
||
if not HandleAllocated()then FHandle := _wapi.socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
|
||
MD := 1;
|
||
//_wapi.ioctlsocket(FHandle,FIONBIO,MD);
|
||
BindSoketEvents(self(true),nil);
|
||
end
|
||
function SetIp(v);virtual;
|
||
begin
|
||
if v <> FIp and ifstring(v)then
|
||
begin
|
||
FIp := v;
|
||
end
|
||
end
|
||
function SetPort(v);virtual;
|
||
begin
|
||
if v <> FProt and v>0 then
|
||
begin
|
||
FPort := v;
|
||
end
|
||
end
|
||
public
|
||
function HandleAllocated();
|
||
begin
|
||
return ifnumber(FHandle)and FHandle <> 0 and INVALID_SOCKET <> FHandle;
|
||
end
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FCSocket := new tsockaddr_in();
|
||
FCache := new TSocketCache();
|
||
FIPproto := IPPROTO_TCP;
|
||
FIp := "127.0.0.1";
|
||
FPort := 1025;
|
||
end
|
||
function CloseSocket();virtual;
|
||
begin
|
||
if not HandleAllocated()then exit;
|
||
_wapi.ShutDown(FHandle,SD_BOTH);
|
||
rt := _wapi.closesocket(FHandle);
|
||
BindSoketEvents(self,0);
|
||
FHandle := 0;
|
||
if rt=0 then FHandle := 0;
|
||
else
|
||
begin
|
||
end
|
||
return rt;
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
CloseSocket();
|
||
FOnRead := nil;
|
||
FOnConnect := nil;
|
||
FOnWrite := nil;
|
||
FOnAccept := nil;
|
||
FOnError := nil;
|
||
FOnClose := nil;
|
||
FCache := array();
|
||
inherited;
|
||
end
|
||
function DoRead();virtual;
|
||
begin
|
||
calldatafunction(FOnRead,self(true));
|
||
end
|
||
function DoAccept();virtual;
|
||
begin
|
||
calldatafunction(FOnAccept,self(true));
|
||
end
|
||
function DoWrite();virtual;
|
||
begin
|
||
WriteData();
|
||
calldatafunction(FOnWrite,self(true));
|
||
end
|
||
function DoError();virtual;
|
||
begin
|
||
calldatafunction(FOnError,self(true));
|
||
end
|
||
function DoConnected();virtual;
|
||
begin
|
||
calldatafunction(FOnConnect,self(true));
|
||
end
|
||
function DoClose();virtual;
|
||
begin
|
||
calldatafunction(FOnClose,self(true));
|
||
end
|
||
function writeData(data);virtual;
|
||
begin
|
||
if data then FCache.add(data);
|
||
while FCache.size() do
|
||
begin
|
||
d := FCache.GetBottom();
|
||
if not(d and ifstring(d))then continue;
|
||
len := length(d);
|
||
ret := _wapi.send(FHandle,d,len,0);
|
||
if ret=WSAEWOULDBLOCK then
|
||
begin
|
||
return FCache.back();
|
||
end else
|
||
if ret<len and ret>0 then
|
||
begin
|
||
FCache.back(d[(ret+1):]);
|
||
end
|
||
end
|
||
end
|
||
function ReceiveDataLen();
|
||
begin
|
||
{**
|
||
@explan(说明) 数据长度 %%
|
||
@return(integer) 长度 %%
|
||
**}
|
||
len := 0;
|
||
if HandleAllocated()then ret := _wapi.ioctlsocket(self.Handle,FIONREAD,len);
|
||
return len;
|
||
end
|
||
function ReadData(len);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 读数据 %%
|
||
@param(len)(integer) 读取长度 %%
|
||
@return(string) 数据 %%
|
||
**}
|
||
if not ifnumber(len)then len := ReceiveDataLen();
|
||
if len<1 then return "";
|
||
dt := CreateInitialStr(len);
|
||
if HandleAllocated()then r := _wapi.recv(self.Handle,dt,length(dt),0);
|
||
return dt;
|
||
end
|
||
property Handle read GetHandle write FHandle;
|
||
property IP:string read FIp write SetIp;
|
||
property Port:integer read FPort write SetPort;
|
||
property CSocket read FCSocket;
|
||
property OnClose:eventhandler read FOnClose write FOnClose;
|
||
property OnConnected:eventhandler read FOnConnect write FOnConnect;
|
||
property OnRead:eventhandler read FOnRead write FOnRead;
|
||
property OnWrite:eventhandler read FOnWrite write FOnWrite;
|
||
property OnAccept:eventhandler read FOnAccept write FOnAccept;
|
||
property OnError:eventhandler read FOnError write FOnError;
|
||
property IPPROTO read FIPproto write SetIPproto;
|
||
property ErrorId read FErrorId;
|
||
{**
|
||
@param(ErrorId)(integer) 错误信息 %%
|
||
**}
|
||
end
|
||
|
||
type TSocketClient=class(TSocketInterface)
|
||
{**
|
||
@explan(说明) windows socket客户端 %%
|
||
**}
|
||
private
|
||
FConnected;
|
||
protected
|
||
function SetIp(v);override;
|
||
begin
|
||
t := self.ip;
|
||
inherited;
|
||
if csDesigning in ComponentState then exit;
|
||
t1 := self.ip;
|
||
if t <> t1 and FConnected then
|
||
begin
|
||
CloseSocket();
|
||
end
|
||
end
|
||
function SetPort(v);override;
|
||
begin
|
||
t := self.Port;
|
||
inherited;
|
||
if csDesigning in ComponentState then exit;
|
||
t1 := self.Port;
|
||
if t <> t1 and FConnected then
|
||
begin
|
||
CloseSocket();
|
||
end
|
||
end
|
||
public
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FConnected := false;
|
||
end
|
||
function CloseSocket();override;
|
||
begin
|
||
inherited;
|
||
FConnected := false;
|
||
end
|
||
function DoClose();override;
|
||
begin
|
||
FConnected := false;
|
||
inherited;
|
||
end
|
||
function DoConnected();override;
|
||
begin
|
||
FConnected := true;
|
||
inherited;
|
||
end
|
||
function connect();
|
||
begin
|
||
{**
|
||
@explan(说明) 连接服务器 %%
|
||
**}
|
||
if csDesigning in ComponentState then exit;
|
||
if InitCSocket()then return-1;
|
||
if not FConnected then
|
||
begin
|
||
r := _wapi.Connect(self.Handle,CSocket._getptr_(),CSocket._size_());
|
||
end
|
||
return r;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","handle","ip","port","ipproto",
|
||
"onclose","onconnected","onread","onwrite","onaccept","onerror");
|
||
end
|
||
end
|
||
type TSocketAccept=class(TSocketInterface)
|
||
{**
|
||
@explan(说明) windows socket 服务socket连接 %%
|
||
**}
|
||
private
|
||
FServer;
|
||
function DeleteFromServer();
|
||
begin
|
||
if FServer then
|
||
begin
|
||
FServer.DeleteNode(self);
|
||
end
|
||
end
|
||
function SetIPproto(V);override;
|
||
begin
|
||
end
|
||
public
|
||
function Create(server);override;
|
||
begin
|
||
inherited;
|
||
FServer := server;
|
||
if(FServer is class(TSocketServer))and(FServer.HandleAllocated)then
|
||
begin
|
||
Handle := _wapi.accept(server.Handle,CSocket._getptr_(),CSocket._size_());
|
||
self.OnRead := server.OnRead;
|
||
self.OnWrite := server.OnWrite;
|
||
self.OnClose := Server.OnClose;
|
||
self.onerror := Server.OnError;
|
||
if Handle then
|
||
begin
|
||
BindSoketEvents(self(true),nil);
|
||
end
|
||
end
|
||
end
|
||
function CreateHandle();override;
|
||
begin
|
||
end;
|
||
function DoClose(sk);override;
|
||
begin
|
||
inherited;
|
||
DeleteFromServer();
|
||
end
|
||
function CloseSocket();override;
|
||
begin
|
||
inherited;
|
||
DeleteFromServer();
|
||
end
|
||
property Server read FServer write FServer;
|
||
function publishs();override;
|
||
begin
|
||
return array("name","handle","ip","port","ipproto",
|
||
"onread","onwrite","onaccept","onerror");
|
||
end
|
||
end
|
||
type TSocketServer=class(TSocketInterface)
|
||
{**
|
||
@explan(说明) windows socket 服务端
|
||
**}
|
||
private
|
||
FChildren;
|
||
FBinded;
|
||
FAccept;
|
||
FListenCount;
|
||
function SetListenCount(v);
|
||
begin
|
||
if v >= 0 and v <> FListenCount then
|
||
begin
|
||
FListenCount := v;
|
||
end
|
||
end
|
||
function SetIp(v);override;
|
||
begin
|
||
t := self.ip;
|
||
inherited;
|
||
t1 := self.ip;
|
||
if t <> t1 and FBinded then
|
||
begin
|
||
CloseSocket();
|
||
end
|
||
end
|
||
function SetPort(v);override;
|
||
begin
|
||
t := self.Port;
|
||
inherited;
|
||
t1 := self.Port;
|
||
if t <> t1 and FBinded then
|
||
begin
|
||
CloseSocket();
|
||
end
|
||
end
|
||
public
|
||
function CreateHandle();override;
|
||
begin
|
||
inherited;
|
||
FAccept := false;
|
||
end
|
||
function DoAccept();override;
|
||
begin
|
||
FAccept := true;
|
||
r := new TSocketAccept(self(true));
|
||
FChildren[length(FChildren)]:= r;
|
||
inherited;
|
||
end
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FListenCount := 100;
|
||
FChildren := array();
|
||
FConnected := false;
|
||
FBinded := false;
|
||
end
|
||
function CloseSocket();override;
|
||
begin
|
||
len := length(FChildren);
|
||
while len>0 do
|
||
begin
|
||
vi := FChildren[len-1];
|
||
vi.CloseSocket();
|
||
len := length(FChildren);
|
||
end
|
||
FBinded := false;
|
||
FAccept := false;
|
||
return inherited;
|
||
end
|
||
function DeleteNode(acp);
|
||
begin
|
||
{**
|
||
@explan(说明) 删除节点 %%
|
||
**}
|
||
idx :=-1;
|
||
if acp.HandleAllocated()then return acp.CloseSocket();
|
||
for i,v in FChildren do
|
||
begin
|
||
if acp=V then
|
||
begin
|
||
idx := i;
|
||
end
|
||
end
|
||
if idx>-0.5 then
|
||
begin
|
||
acp.Server := nil;
|
||
DeleteIndex(FChildren,idx,true);
|
||
end
|
||
end
|
||
function listen();
|
||
begin
|
||
{**
|
||
@explan(说明)监听 %%
|
||
**}
|
||
if FBinded then exit;
|
||
lsn := FListenCount;
|
||
if InitCSocket()then return-1;
|
||
r := _wapi.bind(self.Handle,CSocket._getptr_(),CSocket._size_());
|
||
if r=0 then
|
||
begin
|
||
FBinded := true;
|
||
if ifnil(lsn)then lsn := 10;
|
||
r := _wapi.listen(self.Handle,lsn);
|
||
return r;
|
||
end else
|
||
begin
|
||
return-1;
|
||
end
|
||
return r;
|
||
end
|
||
property ListenCount:integer read FListenCount write SetListenCount;
|
||
function publishs();override;
|
||
begin
|
||
return array("name","handle","ip","port","ipproto",
|
||
"onclose","onconnected","onread","onwrite","onaccept","onerror");
|
||
end
|
||
end
|
||
type TClipBoard = class(TcustomClipBoard)
|
||
{**
|
||
@explan(说明) 剪切板类 %%
|
||
**}
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return array("name","text","bmp");
|
||
end
|
||
end
|
||
|
||
//线程
|
||
type TThreadWorker =class(TCustomThreadworker)
|
||
{**
|
||
@explan(说明) 工作线程 %%
|
||
**}
|
||
uses uvclthreadworker;
|
||
function create(s,libs,declaration);
|
||
begin
|
||
inherited;
|
||
end
|
||
protected
|
||
function Check_TslCode(FScript,err);override;
|
||
begin
|
||
return CheckTslCode(FScript,err);
|
||
end
|
||
end
|
||
//注册表操作类
|
||
type TRegKey = class
|
||
{**
|
||
@explan(说明) windows注册表操作类 %%
|
||
**}
|
||
static HKEY_CLASSES_ROOT;
|
||
static HKEY_CURRENT_USER;
|
||
static HKEY_LOCAL_MACHINE;
|
||
static HKEY_USERS;
|
||
static HKEY_PERFORMANCE_DATA;
|
||
static HKEY_PERFORMANCE_TEXT;
|
||
static HKEY_PERFORMANCE_NLSTEXT;
|
||
{$ifdef linux}
|
||
class function RegEnumValueA(hKey:pointer;dwIndex:integer;var lpValueName:string;var lpcchValueName:integer;lpReserved:pointer;lpType:pointer;lpData:pointer;lpcbData:pointer):integer;
|
||
class function RegEnumKeyA(hKey:pointer;dwindex:integer;var lpName:string;ccname:integer):integer;
|
||
class function RegQueryValueExA(hKey:pointer;lpValueName:string;lpReserved:integer;var lpType:integer;var lpData:string;var lpcbData:integer):integer;
|
||
class function RegSetValueExA(hkey:pointer;keyValueName:string;lpReserved:integer;lpType:integer;data:string;len:integer):integer;
|
||
class function RegOpenKeyA(Key:pointer;lpSubKey:string;var phkResult:pointer):integer;
|
||
class function RegCloseKey(hKey:pointer):integer;
|
||
class function RegOpenKeyExA(Key:pointer;lpSubKey:string;rs:integer;ac:integer;var phkResult:pointer):integer;
|
||
class function RegCreateKeyExA(hKey:pointer;lpSubKey:string;Reserved:integer;lpClass:string;dwOptions:integer;samDesired:integer;lpSecurityAttributes:pointer;var phkResult:pointer;var lpdwDisposition:integer):integer;
|
||
class function RegDeleteKeyExA(hKey:pointer;lpSubKey:string;samDesired:integer;Reserved:integer):integer;
|
||
class function RegDeleteKeyA(hKey:pointer;lpSubKey:string):integer;
|
||
class function RegDeleteValueA(hKey:pointer;lpValueName:string):integer;
|
||
class function RegDeleteKeyValueA(hKey:pointer;lpSubKey:string;lpValueName:string):integer;
|
||
class function RegDeleteTreeA(hKey:pointer;lpSubKey:string):integer;
|
||
class function FormatMessageA(dwFlags:integer;lpSource:pointer;dwMessageId:integer;dwLanguageId:integer;var pBuffer:string;nSize:integer;):integer;
|
||
{$else}
|
||
class function RegEnumValueA(hKey:pointer;dwIndex:integer;var lpValueName:string;var lpcchValueName:integer;lpReserved:pointer;lpType:pointer;lpData:pointer;lpcbData:pointer):integer;stdcall;external "Advapi32.dll" name "RegEnumValueA";
|
||
class function RegEnumKeyA(hKey:pointer;dwindex:integer;var lpName:string;ccname:integer):integer;stdcall;external "Advapi32.dll" name "RegEnumKeyA";
|
||
class function RegQueryValueExA(hKey:pointer;lpValueName:string;lpReserved:integer;var lpType:integer;var lpData:string;var lpcbData:integer):integer;stdcall;external "Advapi32.dll" name "RegQueryValueExA";
|
||
class function RegSetValueExA(hkey:pointer;keyValueName:string;lpReserved:integer;lpType:integer;data:string;len:integer):integer;stdcall;external "Advapi32.dll" name "RegSetValueExA";
|
||
class function RegOpenKeyA(Key:pointer;lpSubKey:string;var phkResult:pointer):integer;stdcall;external "Advapi32.dll" name "RegOpenKeyA";
|
||
class function RegCloseKey(hKey:pointer):integer;stdcall;external "Advapi32.dll" name "RegCloseKey";
|
||
class function RegOpenKeyExA(Key:pointer;lpSubKey:string;rs:integer;ac:integer;var phkResult:pointer):integer;stdcall;external "Advapi32.dll" name "RegOpenKeyExA";
|
||
class function RegCreateKeyExA(hKey:pointer;lpSubKey:string;Reserved:integer;lpClass:string;dwOptions:integer;samDesired:integer;lpSecurityAttributes:pointer;var phkResult:pointer;var lpdwDisposition:integer):integer;stdcall;external "Advapi32.dll" name "RegCreateKeyExA";
|
||
class function RegDeleteKeyExA(hKey:pointer;lpSubKey:string;samDesired:integer;Reserved:integer):integer;stdcall;external "Advapi32.dll" name "RegDeleteKeyExA";
|
||
class function RegDeleteKeyA(hKey:pointer;lpSubKey:string):integer;stdcall;external "Advapi32.dll" name "RegDeleteKeyA";
|
||
class function RegDeleteValueA(hKey:pointer;lpValueName:string):integer;stdcall;external "Advapi32.dll" name "RegDeleteValueA";
|
||
class function RegDeleteKeyValueA(hKey:pointer;lpSubKey:string;lpValueName:string):integer;stdcall;external "Advapi32.dll" name "RegDeleteKeyValueA";
|
||
class function RegDeleteTreeA(hKey:pointer;lpSubKey:string):integer;stdcall;external "Advapi32.dll" name "RegDeleteTreeA";
|
||
class function FormatMessageA(dwFlags:integer;lpSource:pointer;dwMessageId:integer;dwLanguageId:integer;var pBuffer:string;nSize:integer;):integer;stdcall;external "Kernel32.dll" name "FormatMessageA";
|
||
{$endif}
|
||
class function GetRegKeyRoot();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得HKEY_CLASSES_ROOT的key %%
|
||
@return(TRegKey|integer) 如果成功返回 key 对象 %%
|
||
**}
|
||
sinit();
|
||
return new TRegKey(HKEY_CLASSES_ROOT);
|
||
end
|
||
class function GetRegKeyUser();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得HKEY_CURRENT_USER的key %%
|
||
@return(TRegKey|integer) 如果成功返回 key 对象 %%
|
||
**}
|
||
sinit();
|
||
return new TRegKey(HKEY_CURRENT_USER);
|
||
end
|
||
class function GetRegKeyMachine();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得HKEY_LOCAL_MACHINE的key %%
|
||
@return(TRegKey|integer) 如果成功返回 key 对象 %%
|
||
**}
|
||
sinit();
|
||
return new TRegKey(HKEY_LOCAL_MACHINE);
|
||
end
|
||
class function GetEnviromentKey();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得环境变量的key %%
|
||
@return(TRegKey|integer) 如果成功返回 key 对象 %%
|
||
**}
|
||
sinit();
|
||
k1 := new TRegKey(HKEY_LOCAL_MACHINE);
|
||
return k1.openKeyA("SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment");
|
||
end
|
||
class function EnvironmentPath(k2);
|
||
begin
|
||
{**
|
||
@explan(说明) 获得环境路径的所有值%%
|
||
@return(array of string) 环境路径数组 %%
|
||
**}
|
||
if ifnil(k2)then k2 := GetEnviromentKey();
|
||
if not ifobj(k2)then return nil;
|
||
r := str2array(k2.GetValueA("path"),";");
|
||
rt := array();
|
||
for i,v in r do
|
||
begin
|
||
vi := trim(v);
|
||
if vi then rt[length(rt)]:= lowercase(vi);
|
||
end
|
||
return rt;
|
||
end
|
||
private
|
||
FHandle;
|
||
FResult;
|
||
function CloseRegKey();
|
||
begin
|
||
if ifnumber(FHandle)and not(FHandle in array(HKEY_CLASSES_ROOT,HKEY_CURRENT_USER,HKEY_LOCAL_MACHINE,HKEY_USERS,HKEY_PERFORMANCE_DATA,HKEY_PERFORMANCE_TEXT,HKEY_PERFORMANCE_NLSTEXT))then
|
||
RegCloseKey(FHandle);
|
||
end
|
||
function SetHandle(h);
|
||
begin
|
||
if h <> FHandle then
|
||
begin
|
||
CloseRegKey();
|
||
FHandle := h;
|
||
end
|
||
end
|
||
public
|
||
function create(h);
|
||
begin
|
||
if not HKEY_CLASSES_ROOT then sinit();
|
||
SetHandle(h);
|
||
end
|
||
function Destroy();
|
||
begin
|
||
CloseRegKey();
|
||
end
|
||
function openKeyA(vn);
|
||
begin
|
||
{**
|
||
@explan(说明) 打开或者新建 key%%
|
||
@param(vn)(string) value 名字 %%
|
||
@return(TRegKey) 值 %%
|
||
**}
|
||
if not FHandle then return-1;
|
||
if not(ifstring(vn)and vn)then return-1;
|
||
h2 := 0;
|
||
rr := RegOpenKeyExA(FHandle,vn,0,0xF003F,h2);
|
||
if 0=rr then
|
||
begin
|
||
r := new TRegKey(h2);
|
||
return r;
|
||
end
|
||
state := 0;
|
||
hk2 := 0;
|
||
rr := RegCreateKeyExA(FHandle,vn,0,"",0,0,0,hk2,state);
|
||
if rr=0 then
|
||
begin
|
||
r := openKeyA(vn); //new TRegKey(hk2);
|
||
return r;
|
||
end
|
||
return rr;
|
||
end
|
||
function GetValueA(vn,vt);
|
||
begin
|
||
{**
|
||
@explan(说明) 获得value值%%
|
||
@param(vn)(string) value 名字 %%
|
||
@param(vt)(integer) 类型 %%
|
||
@return(string) 值 %%
|
||
**}
|
||
if not FHandle then return-1;
|
||
if not(ifstring(vn)or ifnil(vn))then return-1;
|
||
if not ifnumber(vt)then vt := 0;
|
||
d := "";
|
||
setlength(d,2064);
|
||
len := 2063;
|
||
rr := RegQueryValueExA(FHandle,vn,0,vt,d,len);
|
||
if 0=rr then
|
||
begin
|
||
return d[1:len-1];
|
||
end
|
||
return rr;
|
||
end
|
||
function SetValueStringA(vn,v);
|
||
begin
|
||
{**
|
||
@explan(说明) 设置value值%%
|
||
@param(vn)(string) value 名字,nil为默认值%%
|
||
@param(v)(string) 值 %%
|
||
**}
|
||
if not FHandle then return-1;
|
||
if not(ifstring(vn)or ifnil(vn))then return-1;
|
||
rs := 0;
|
||
tp := 1;
|
||
return RegSetValueExA(FHandle,vn,rs,tp,v,length(v));
|
||
end
|
||
|
||
function DeleteValueA(vn);
|
||
begin
|
||
{**
|
||
@explan(说明) 删除value %%
|
||
@param(vn)(string) value 名字 %%
|
||
**}
|
||
if not FHandle then return-1;
|
||
if not(ifstring(vn))then return-1;
|
||
return RegDeleteValueA(FHandle,vn);
|
||
end
|
||
function DeleteKeyA(vn);
|
||
begin
|
||
{**
|
||
@explan(说明) key %%
|
||
@param(vn)(string) key %%
|
||
**}
|
||
if not FHandle then return-1;
|
||
if not(ifstring(vn))then return-1;
|
||
return RegDeleteKeyExA(FHandle,vn,0x0100,0);
|
||
end
|
||
function DeleteTreeA(vn);
|
||
begin
|
||
{**
|
||
@explan(说明) 删除目录 %%
|
||
@param(vn)(string) 目录名 %%
|
||
**}
|
||
if not FHandle then return-1;
|
||
if not(ifstring(vn))then return-1;
|
||
return RegDeleteTreeA(FHandle,vn);
|
||
end
|
||
function GetValueNames();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得value的名称 %%
|
||
@return(array of string) 所有名称 %%
|
||
**}
|
||
r := array();
|
||
if FHandle then
|
||
begin
|
||
s := "";
|
||
ls := 1024;
|
||
setlength(s,1024);
|
||
idx := 0;
|
||
while true do
|
||
begin
|
||
ls := 1024;
|
||
sc := RegEnumValueA(FHandle,idx,s,ls,0,0,0,0);
|
||
if sc=0 then
|
||
begin
|
||
r[idx]:= s[1:ls];
|
||
idx++;
|
||
end else
|
||
break;
|
||
end
|
||
end
|
||
return r;
|
||
end
|
||
function GetSubKeyNames();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得子项的名称 %%
|
||
@return(array of string) 所有名称 %%
|
||
**}
|
||
r := array();
|
||
if FHandle then
|
||
begin
|
||
s := "";
|
||
ls := 1024;
|
||
setlength(s,1024);
|
||
idx := 0;
|
||
while true do
|
||
begin
|
||
sc := RegEnumKeyA(FHandle,idx,s,ls);
|
||
if sc=0 then
|
||
begin
|
||
for i := 1 to 1024 do
|
||
begin
|
||
if s[i]="\0" then
|
||
begin
|
||
r[idx]:= s[1:(i-1)];
|
||
break;
|
||
end
|
||
end
|
||
idx++;
|
||
end else
|
||
break;
|
||
end
|
||
end
|
||
return r;
|
||
end
|
||
class function sinit();override;
|
||
begin
|
||
{**
|
||
@explan(说明) 初始化 %%
|
||
**}
|
||
if not HKEY_CLASSES_ROOT then
|
||
begin
|
||
HKEY_CLASSES_ROOT := 0x80000000;
|
||
HKEY_CURRENT_USER := 0x80000001;
|
||
HKEY_LOCAL_MACHINE := 0x80000002;
|
||
HKEY_USERS := 0x80000003;
|
||
HKEY_PERFORMANCE_DATA := 0x80000004;
|
||
HKEY_PERFORMANCE_TEXT := 0x80000050;
|
||
HKEY_PERFORMANCE_NLSTEXT := 0x80000060;
|
||
end
|
||
inherited;
|
||
end
|
||
property Handle read FHandle write SetHandle;
|
||
{**
|
||
@param(Handle)(pointer) regkey句柄 %%
|
||
**}
|
||
end
|
||
type TWinEnviroment=class()
|
||
{**
|
||
@explan(说明) windows环境变量操作 %%
|
||
**}
|
||
function Create();
|
||
begin
|
||
FRegkey := class(TRegKey).GetEnviromentKey();
|
||
if not(ifobj(FRegkey))then raise "非管理员不能操作环境变量!";
|
||
end
|
||
function GetPaths();
|
||
begin
|
||
{**
|
||
@explan(说明) 获得环境路径 %%
|
||
@return(array of string) 路径 %%
|
||
**}
|
||
PathInPaths("===",r);
|
||
return r;
|
||
end
|
||
function AppendPath(p);
|
||
begin
|
||
{**
|
||
@explan(说明) 追加环境路径 %%
|
||
@param(p)(string) 路径 %%
|
||
@return(bool) true 成功 false 失败 %%
|
||
**}
|
||
if not(PathOk(p))then return false;
|
||
if not PathInPaths(p,paths)then
|
||
begin
|
||
return 0=FRegkey.SetValueStringA("path",array2str(paths,";")+";"+p);
|
||
end
|
||
end
|
||
function RemovePath(p);
|
||
begin
|
||
{**
|
||
@explan(说明) 移除环境路径 %%
|
||
@param(p)(string) 路径 %%
|
||
@return(bool)true 成功 false 失败 %%
|
||
**}
|
||
if not PathOk(p)then return false;
|
||
if PathInPaths(p,paths)then
|
||
begin
|
||
return 0=FRegkey.SetValueStringA("path",array2str(paths,";"));
|
||
end
|
||
end
|
||
private
|
||
function PathOk(p);
|
||
begin
|
||
if not(ifstring(p)and p)then return false;
|
||
for i,v in array(";","?",'"',"|","*") do
|
||
begin
|
||
if pos(v,p)then return false;
|
||
end
|
||
return true;
|
||
end
|
||
function PathInPaths(p,paths);
|
||
begin
|
||
pv := lowercase(RegularPath(p));
|
||
if not pv then return 0;
|
||
d := FRegkey.GetValueA("path");
|
||
nothavepath := false;
|
||
paths := array();
|
||
LP := 0;
|
||
for i,v in str2array(d,";") do
|
||
begin
|
||
vi := RegularPath(v);
|
||
if not vi then continue;
|
||
if lowercase(vi)=pv then
|
||
begin
|
||
nothavepath := true;
|
||
continue;
|
||
end
|
||
paths[LP++]:= v;
|
||
end
|
||
return nothavepath;
|
||
end
|
||
function RegularPath(p);
|
||
begin
|
||
{**
|
||
@explan(说明) 规则化数据 %%
|
||
**}
|
||
r := "";
|
||
if p and ifstring(p)then
|
||
begin
|
||
r := trim(p);
|
||
len := length(r);
|
||
if r[len]="\\" and len>1 then return r[1:(len-1)];
|
||
end
|
||
return r;
|
||
end
|
||
FRegkey;
|
||
end
|
||
|
||
//剪切板类
|
||
|
||
type TQuotations=class(tcomponent)
|
||
{**
|
||
@explan(说明) 行情订阅以及远程执行类 %%
|
||
**}
|
||
private
|
||
static FSQuotations;
|
||
static RE_ERROR;
|
||
static RE_FUNCRESULT;
|
||
static RE_FUNCSTATE;
|
||
static RE_ECHO;
|
||
static RE_QUERY;
|
||
FOncallBack; //回调函数
|
||
FChannel; //通道
|
||
FData; //返回数据
|
||
FIds;
|
||
FSUbs;
|
||
FScript;
|
||
FGlobalVariable;
|
||
function EndRemoteExecute();
|
||
begin
|
||
if FChannel then
|
||
begin
|
||
EndExecute(FChannel);
|
||
reindex(FSQuotations,array(FChannel:nil));
|
||
FChannel := 0;
|
||
FData := array();
|
||
end
|
||
end
|
||
protected
|
||
class function sinit();override;
|
||
begin
|
||
inherited;
|
||
if not ifarray(FSQuotations)then
|
||
begin
|
||
FSQuotations := array();
|
||
RE_ERROR := 0;
|
||
RE_FUNCRESULT := 0x0201;
|
||
RE_FUNCSTATE := 0x0301;
|
||
RE_ECHO := 0x0401;
|
||
RE_QUERY := 0x0402;
|
||
end
|
||
end
|
||
function RemoteCallBack(d);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 回调执行 %%
|
||
**}
|
||
if not ifarray(d)then exit;
|
||
FData := d;
|
||
calldatafunction(FOncallBack,self(true));
|
||
end
|
||
public
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
FData := array();
|
||
FIds := array();
|
||
FGlobalVariable := array();
|
||
FSUbs := array();
|
||
FScript := "";
|
||
end
|
||
function RemoteExecute();
|
||
begin
|
||
{**
|
||
@explan(说明) 远程执行代码 %%
|
||
@return(integer) channel %%
|
||
**}
|
||
if not ifstring(FScript)then return 0;
|
||
if not ifarray(FGlobalVariable)then sysp := array();
|
||
else sysp := FGlobalVariable;
|
||
EndRemoteExecute();
|
||
FChannel := SendExecute(FScript,sysp,"return unit(tslvcl).remotetslcallback(sysparams);",1);
|
||
if not FChannel then return 0;
|
||
FSQuotations[FChannel]:= self(true);
|
||
return FChannel;
|
||
end
|
||
function MarketSubscription();
|
||
begin
|
||
{**
|
||
@explan(说明) 构造行情订阅 %%
|
||
@return(integer) channel %%
|
||
**}
|
||
EndRemoteExecute();
|
||
if not(FIds and ifarray(FIds)and FSUbs and ifarray(FSUbs))then
|
||
begin
|
||
return 0;
|
||
end
|
||
qts := array("Type":1);
|
||
qts["IDs"]:= FIds;
|
||
qts["SUBs"]:= FSUbs;
|
||
FChannel := SendExecute("",qts,"return unit(tslvcl).remotetslcallback(sysparams);",0);
|
||
if not FChannel then return 0;
|
||
FSQuotations[FChannel]:= self(true);
|
||
return FChannel;
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
EndRemoteExecute();
|
||
FOncallBack := nil;
|
||
inherited;
|
||
end
|
||
function destroy();override;
|
||
begin
|
||
inherited;
|
||
end
|
||
class function Dispatch(dt);
|
||
begin
|
||
{**
|
||
@explan(说明) 消息分发 %%
|
||
**}
|
||
if ifarray(dt)then
|
||
begin
|
||
// 0:错误通知
|
||
// 0x0201:执行函数返回
|
||
// 0x0301:提交委托函数的状态返回
|
||
// 0x0401:Echo
|
||
// 0x0402:RunningData返回/订阅行情的结果集
|
||
o := FSQuotations[dt["channel"]];
|
||
if ifobj(o)then o.RemoteCallBack(dt);
|
||
end
|
||
end
|
||
function echodata();
|
||
begin
|
||
{**
|
||
@explan(说明) 获取echo 的信息 %%
|
||
@return(string|nil) 非echo 类型返回nil%%
|
||
**}
|
||
if FData["recvtype"]=RE_ECHO then
|
||
begin
|
||
return FData["errmsg"];
|
||
end
|
||
return nil;
|
||
end
|
||
function errormessage();
|
||
begin
|
||
{**
|
||
@explan(说明) 获取错误的信息 %%
|
||
@return(string|nil) 无错误返回nil%%
|
||
**}
|
||
if FData["recvtype"]=RE_ERROR then
|
||
begin
|
||
return FData["errmsg"];
|
||
end
|
||
return nil;
|
||
end
|
||
function result();
|
||
begin
|
||
{**
|
||
@explan(说明) 获取执行结果 %%
|
||
**}
|
||
if FData["recvtype"]in array(RE_FUNCRESULT,RE_QUERY)then
|
||
begin
|
||
return FData["result"];
|
||
end
|
||
return nil;
|
||
end
|
||
property OnCallBack:eventhandler read FOncallBack write FOncallBack;
|
||
property Ids:strings read FIds write FIds;
|
||
property SUBs:strings read FSUbs write FSUbs;
|
||
property GlobalVariable:tsldata read FGlobalVariable write FGlobalVariable;
|
||
property Script:text read FScript write FScript;
|
||
function publishs();override;
|
||
begin
|
||
return array("name","ids","subs","globalvariable","script","oncallback");
|
||
end
|
||
{**
|
||
@param(OnCallBack)(function[TQuotations]) 执行回调 %%
|
||
@param(ids)(array of stockid) 证券代码数组 array("SZ000001","SZ000002") %%
|
||
@param(SUBs)(array of string) 订阅字段数组 array("StockName", "date","price", "open") %%
|
||
**}
|
||
end
|
||
|
||
type tlogincontrol=class(tpanel)
|
||
{**
|
||
@explan(说明) 登陆控件 %%
|
||
**}
|
||
private
|
||
FserverEdit;
|
||
FserverLabel;
|
||
FuserLabel;
|
||
FpwdLabel;
|
||
Fstatus;
|
||
FportEdit;
|
||
FpwdEdit;
|
||
FlogoutBtn;
|
||
FloginBtn;
|
||
FuserEdit;
|
||
FCacheFile;
|
||
FOnLogined;
|
||
function LoadCacheData(); //导出缓存
|
||
begin
|
||
importfile(ftStream(),"",FCacheFile,configinfos);
|
||
if ifarray(configinfos)then
|
||
begin
|
||
FserverEdit.text := configinfos["server"];
|
||
FportEdit.text := configinfos["port"];
|
||
FuserEdit.text := configinfos["user"];
|
||
FpwdEdit.text := configinfos["pwd"];
|
||
end
|
||
end
|
||
function SaveCacheData() //保存缓存
|
||
begin
|
||
exportfile(ftStream(),"",FCacheFile,array("server":FserverEdit.text,"port":FportEdit.text,"user":FuserEdit.text,"pwd":FpwdEdit.text));
|
||
end
|
||
function closelogin(); //关闭登陆窗口
|
||
begin
|
||
SaveCacheData();
|
||
if Parent then EndModal();
|
||
else show(0);
|
||
end
|
||
function setsatus(s);
|
||
begin
|
||
if ifstring(s)then Fstatus.setitemtext(s,1);
|
||
end
|
||
function clklogin(o,e);
|
||
begin
|
||
clklogin2(o,e);
|
||
CallMessgeFunction(FOnLogined,self,e);
|
||
end
|
||
function clklogin2(o,e); //登陆按钮
|
||
begin
|
||
//登陆 设置状态
|
||
//参考 函数 LoginTslServer
|
||
setsatus("正在登陆...");
|
||
logintext := FuserEdit.text;
|
||
loginpwd := FpwdEdit.text;
|
||
loginserve := FserverEdit.text+":"+FportEdit.text;
|
||
if(CheckConnected()or(ConnectServer(FserverEdit.text,StrToFloatDef(FportEdit.text,443))=0))then
|
||
begin
|
||
msg := "";
|
||
setlength(msg,200);
|
||
if(CheckLogined()or LoginServer(logintext,loginpwd,msg)=0)then
|
||
begin
|
||
setsatus("登陆成功");
|
||
FloginBtn.enabled := false;
|
||
FlogoutBtn.enabled := true;
|
||
hidenwindow();
|
||
return 0;
|
||
end else
|
||
begin
|
||
setsatus("登陆失败");
|
||
messageboxA(msg,"登陆失败",1);
|
||
return 1;
|
||
end
|
||
end else
|
||
begin
|
||
setsatus("连接服务器失败");
|
||
messageboxA("连接服务器失败","提示",1);
|
||
return 2;
|
||
end
|
||
return-1;
|
||
end
|
||
function clklogout(o,e); //退出登陆按钮
|
||
begin
|
||
//退出登陆设置状态
|
||
setsatus("与服务器断开连接");
|
||
FloginBtn.enabled := true;
|
||
FlogoutBtn.enabled := false;
|
||
DisconnectServer();
|
||
end
|
||
function hidenwindow(o,e); //关闭按钮
|
||
begin
|
||
//e.skip := true;
|
||
closelogin();
|
||
end
|
||
function GetUsrName();
|
||
begin
|
||
return FuserEdit.text;
|
||
end
|
||
function SetUsrName(v);
|
||
begin
|
||
FuserEdit.text := v;
|
||
end
|
||
function GetPort();
|
||
begin
|
||
return FportEdit.text;
|
||
end
|
||
function SetPort(v);
|
||
begin
|
||
FportEdit.text := v;
|
||
end
|
||
function SetIp(v);
|
||
begin
|
||
FserverEdit.text := v;
|
||
end
|
||
function GetIp();
|
||
begin
|
||
return FserverEdit.text;
|
||
end
|
||
public
|
||
function create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
visible := false;
|
||
FCacheFile := temppath()+ioFileseparator()+"loginer.stm";
|
||
self.caption := "TinySoftLogin";
|
||
rc := _wapi.GetScreenRect();
|
||
self.height := 306;
|
||
self.left :=(rc[2]-rc[0])/2-350;
|
||
self.top :=(rc[3]-rc[1])/2-210;
|
||
self.width := 428;
|
||
self.wscaption := true;
|
||
self.wspopup := true;
|
||
self.wssizebox := true;
|
||
self.wssysmenu := true;
|
||
FserverEdit := new tedit(self);
|
||
FserverEdit.parent := self;
|
||
FserverEdit.height := 25;
|
||
FserverEdit.left := 106;
|
||
FserverEdit.text := "tsl.tinysoft.com.cn";
|
||
FserverEdit.top := 26;
|
||
FserverEdit.width := 179;
|
||
FserverLabel := new tlabel(self);
|
||
FserverLabel.parent := self;
|
||
FserverLabel.left := 22;
|
||
FserverLabel.top := 23;
|
||
FserverLabel.width := 60;
|
||
FserverLabel.height := 25;
|
||
FserverLabel.caption := "服务器";
|
||
FuserLabel := new tlabel(self);
|
||
FuserLabel.parent := self;
|
||
FuserLabel.left := 22;
|
||
FuserLabel.top := 68;
|
||
FuserLabel.width := 59;
|
||
FuserLabel.height := 25;
|
||
FuserLabel.caption := "用户名";
|
||
FpwdLabel := new tlabel(self);
|
||
FpwdLabel.parent := self;
|
||
FpwdLabel.caption := "密码";
|
||
FpwdLabel.left := 21;
|
||
FpwdLabel.top := 112;
|
||
FpwdLabel.width := 57;
|
||
FpwdLabel.height := 25;
|
||
Fstatus := new tstatusbar(self);
|
||
Fstatus.parent := self;
|
||
Fstatus.left := 0;
|
||
Fstatus.top := 244;
|
||
Fstatus.Items := array(("text":"状态","width":40),("text":"","width":200));
|
||
FportEdit := new tedit(self);
|
||
FportEdit.parent := self;
|
||
FportEdit.height := 25;
|
||
FportEdit.left := 298;
|
||
FportEdit.text := "443";
|
||
FportEdit.top := 25;
|
||
FportEdit.width := 80;
|
||
FlogoutBtn := new tbtn(self);
|
||
FlogoutBtn.parent := self;
|
||
FlogoutBtn.caption := "退出";
|
||
FlogoutBtn.height := 31;
|
||
FlogoutBtn.left := 80;
|
||
FlogoutBtn.top := 173;
|
||
FlogoutBtn.width := 94;
|
||
FloginBtn := new tbtn(self);
|
||
FloginBtn.parent := self;
|
||
FloginBtn.caption := "登陆";
|
||
FloginBtn.height := 31;
|
||
FloginBtn.left := 226;
|
||
FloginBtn.top := 173;
|
||
FloginBtn.width := 94;
|
||
FuserEdit := new tedit(self);
|
||
FuserEdit.parent := self;
|
||
FuserEdit.height := 25;
|
||
FuserEdit.left := 107;
|
||
FuserEdit.top := 68;
|
||
FuserEdit.width := 177;
|
||
FpwdEdit := new tpassword(self);
|
||
FpwdEdit.parent := self;
|
||
FpwdEdit.height := 25;
|
||
FpwdEdit.left := 107;
|
||
FpwdEdit.top := 114;
|
||
FpwdEdit.width := 174;
|
||
FloginBtn.onclick := thisfunction(clklogin);
|
||
FlogoutBtn.onclick := thisfunction(clklogout);
|
||
self.onclose := thisfunction(hidenwindow);
|
||
FlogoutBtn.enabled := false;
|
||
end
|
||
function openlogin() //打开登录窗口
|
||
begin
|
||
LoadCacheData();
|
||
if getloginstatus()then
|
||
begin
|
||
setsatus("登陆成功");
|
||
end else
|
||
setsatus("未登录");
|
||
if Parent then ShowModal();
|
||
else show();
|
||
end
|
||
function getloginstatus(); //获得状态
|
||
begin
|
||
{**
|
||
@explan(说明) 获得登陆状态 %%
|
||
@return(bool) true 已经登陆 false 未登陆
|
||
**}
|
||
if CheckLogined()then return true;
|
||
else return false;
|
||
end
|
||
function publishs();override;
|
||
begin
|
||
return lowercase(array("name","port","ip","usrname","onlogined"));
|
||
end
|
||
property Port:string read GetPort write SetPort;
|
||
property Ip:string read GetIp write SetIp;
|
||
property UsrName:string read GetUsrName write SetUsrName;
|
||
property OnLogined:eventhandler read FOnLogined write FOnLogined;
|
||
{**
|
||
@param(port)(string) 端口号%%
|
||
@param(ip)(string) 天软服务器 %%
|
||
@param(UsrName)(string) 天软用户名 %%
|
||
@param(OnLogined)(function[tlogincontrol,tuieventbase]) 登陆回调 %%
|
||
**}
|
||
end
|
||
|
||
|
||
type TIniFileExta=class()
|
||
{**
|
||
@explan(说明) ini文件读写封装 %%
|
||
**}
|
||
private
|
||
FTStringa;
|
||
Fini;
|
||
FVtype;
|
||
FLowerKey;
|
||
FLowerValue;
|
||
function CheckSK(s,k);
|
||
begin
|
||
return ifstring(s) and s and ifstring(k) and k;
|
||
end
|
||
function ChangeV(V);
|
||
begin
|
||
vv := v;
|
||
case Vtype of
|
||
1:vv := vv="0"?false:true;
|
||
2:vv := StrToIntDef(vv,0);
|
||
else
|
||
begin
|
||
if FLowerValue then vv := lowercase(vv);
|
||
end
|
||
end
|
||
return vv;
|
||
end
|
||
function STNVA();
|
||
begin
|
||
{**
|
||
@explan(说明) 转换为name,value 列的二维数组 %%
|
||
**}
|
||
r := array();
|
||
for i := 0 to FTStringa.Count-1 do
|
||
begin
|
||
n := FTStringa.Names(i);
|
||
if n then
|
||
begin
|
||
if FLowerKey then n := lowercase(n);
|
||
vv := FTStringa.Values(n);
|
||
r[length(r)]:= array("name":n,"value":ChangeV(vv));
|
||
end
|
||
end
|
||
FTStringa.Clear();
|
||
return r;
|
||
end
|
||
function STNV();
|
||
begin
|
||
{**
|
||
@explan(说明) 转换为name:value 一维数组 %%
|
||
**}
|
||
nr := STNVA();
|
||
r := array();
|
||
for i,v in nr do
|
||
begin
|
||
r[v["name"]]:= v["value"];
|
||
end
|
||
return r;
|
||
end
|
||
function STA();
|
||
begin
|
||
{**
|
||
@explan(说明) 转换为一维数组 %%
|
||
**}
|
||
r := array();
|
||
for i := 0 to FTStringa.Count-1 do
|
||
begin
|
||
vi := FTStringa.Strings(i);
|
||
r[i]:= FLowerKey?lowercase(vi):vi;
|
||
end
|
||
FTStringa.Clear();
|
||
return r;
|
||
end
|
||
public
|
||
function create(al,Fname);override;
|
||
begin
|
||
{**
|
||
@explan(说明) 构造函数 %%
|
||
@param(al)(string) 别名 %%
|
||
@param(name)(string) 文件名 %%
|
||
**}
|
||
if ifstring(al)and ifstring(Fname)then
|
||
begin
|
||
FIni := new TIniFile(al,Fname);
|
||
FTStringa := new TStringlist();
|
||
end else
|
||
raise "ini对象读写构造参数错误";
|
||
end
|
||
function readSection(sn);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 读取section 下面key %%
|
||
**}
|
||
if ifstring(sn)and sn then Fini.readSection(sn,FTStringa);
|
||
return STA();
|
||
end
|
||
function ReadSections();virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 读取所有section名字 %%
|
||
**}
|
||
FIni.ReadSections(FTStringa);
|
||
return STA();
|
||
end
|
||
function ReadSectionValues(sn);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 读取section下面的所有key:value %%
|
||
**}
|
||
if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa);
|
||
return STNV();
|
||
end
|
||
function RenameSection(sn1,sn2);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 重命名section %%
|
||
@param(sn1)(string) 旧名字 %%
|
||
@param(sn2)(string) 新名字 %%
|
||
**}
|
||
if not(sn1 and sn2 and ifstring(sn1))and ifstring(sn2)then exit;
|
||
vs1 := ReadSectionValues(sn1);
|
||
EraseSection(sn1);
|
||
for i,v in vs1 do
|
||
begin
|
||
WriteKey(sn2,i,v);
|
||
end
|
||
end
|
||
function RenameKey(sec,k1,k2);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 重命名key %%
|
||
@param(sec)(string) section名称 %%
|
||
@param(k1)(string) 旧名字 %%
|
||
@param(k2)(string) 新名字 %%
|
||
**}
|
||
if(sec and k2 and k1 and ifstring(sec)and ifstring(k1)and ifstring(k2))then exit;
|
||
v := ReadKey(sec,k1);
|
||
DeleteKey(sec,k1);
|
||
WriteKey(sec,k2,v);
|
||
end
|
||
function ReadSectionValues2(sn);
|
||
begin
|
||
{**
|
||
@explan(说明) 获得section 数据,二维表,name,value 列
|
||
**}
|
||
if ifstring(sn)and sn then FIni.ReadSectionValues(sn,FTStringa);
|
||
return STNVA();
|
||
end
|
||
function ReadSectionValues3(sn);
|
||
begin
|
||
{**
|
||
@explan(说明) 获得section 数据,二维表,0列为key,1列为value
|
||
**}
|
||
d := ReadSectionValues2(sn);
|
||
r := array();
|
||
for i,v in d do
|
||
begin
|
||
r[length(r)]:= array(v["name"],v["value"]);
|
||
end
|
||
return r;
|
||
end
|
||
function ReadKey(sn,key,def);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 读取key %%
|
||
**}
|
||
if CheckSK(sn,key)then return FIni.ReadString(sn,key,ifstring(def)?def:"");
|
||
return nil;
|
||
end
|
||
function WriteKey(sn,key,v);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 写入key %%
|
||
**}
|
||
if ifnil(v)then v := "";
|
||
if CheckSK(sn,key)then return FIni.WriteString(sn,key,ifstring(v)?v:tostn(v));
|
||
return 0;
|
||
end
|
||
function DeleteKey(sn,key);virtual;
|
||
begin
|
||
if CheckSK(sn,key)then return FIni.DeleteKey(sn,key);
|
||
end
|
||
function EraseSection(sn);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明)删除section %%
|
||
**}
|
||
if ifstring(sn)and sn then return FIni.EraseSection(sn);
|
||
end
|
||
function Destroy();virtual;
|
||
begin
|
||
FIni := nil;
|
||
FTStringa := nil;
|
||
end
|
||
property VType read FVtype write FVtype;
|
||
property LowerKey read FLowerKey write FLowerKey;
|
||
property LowerValue read FLowerValue write FLowerValue;
|
||
_tag;
|
||
end
|
||
|
||
type TCreateProcessA = class()
|
||
{**
|
||
@explan(说明) 进程构造对象 %%
|
||
**}
|
||
private
|
||
FOnEcho;
|
||
FBufSize;
|
||
{$ifdef linux}
|
||
static FProcesswnd;
|
||
function parserasexeclevparam(exe,cmd,e,arg,envp);
|
||
begin
|
||
arg := ParserCommandLine(exe+" "+cmd);
|
||
if not arg then return 0;
|
||
e := arg[0];
|
||
for i := length(e) downto 2 do
|
||
begin
|
||
if e[i]="/" then
|
||
begin
|
||
ph := e[1:i];
|
||
break;
|
||
end
|
||
end
|
||
arg[length(arg)] := nil;
|
||
envp := array();
|
||
if ph then
|
||
begin
|
||
envp[length(envp)] := "LD_LIBRARY_PATH=LD_LIBRARY_PATH:"+ph;
|
||
end
|
||
envp[length(envp)] := getgtkdisplay();
|
||
envp[length(envp)] :=nil;
|
||
return 1;
|
||
end
|
||
function getgtkdisplay();
|
||
begin
|
||
try
|
||
dsp := sys_getenv("DISPLAY");
|
||
if dsp="" then dsp := ":0";
|
||
if not ifstring(dsp) then dsp := ":0";
|
||
except
|
||
dsp := ":0";
|
||
end;
|
||
return "DISPLAY="+dsp;
|
||
end
|
||
|
||
type tprocesswnd = class(TCustomControl)
|
||
private
|
||
fidarraya;
|
||
fidarrayb;
|
||
fidarray;
|
||
Fmsg;
|
||
public
|
||
function create(AOwner);
|
||
begin
|
||
inherited;
|
||
Visible := false;
|
||
WsPopUp := true;
|
||
ht :=Handle ;
|
||
fidarray := array();
|
||
fidarraya := array();
|
||
fidarrayb := array();
|
||
Fmsg := "";
|
||
setlength(fmsg,1024);
|
||
//bindmessage(WM_USER,thisfunction(wmuser));
|
||
end
|
||
function addproc(pid,fid,obj,t);
|
||
begin
|
||
fidarray[pid] := fid;
|
||
fidarraya[pid] := obj;
|
||
fidarrayb[pid] := t;
|
||
CallDatafunction(obj.OnPressStart,obj,pid);
|
||
_send_(WM_USER,pid,fid,1);
|
||
|
||
end
|
||
function proccount();
|
||
begin
|
||
return length(fidarrayb);
|
||
end
|
||
function clearproc();
|
||
begin
|
||
for i,v in mrows(fidarray,1) do
|
||
begin
|
||
deleteproc(v);
|
||
end
|
||
end
|
||
function deleteproc(pid,flg);
|
||
begin
|
||
tsl_gtk_closehandle(fidarray[pid]);//删除fid
|
||
reindex(fidarray,array(pid:nil));
|
||
reindex(fidarraya,array(pid:nil));
|
||
tp := fidarrayb[pid];
|
||
if (tp .& 2) and ifnil(flg) then
|
||
begin
|
||
SysTerminate(1,pid);
|
||
end
|
||
if tp .& 1 then
|
||
begin
|
||
ExitMessageLoop();
|
||
end
|
||
reindex(fidarrayb,array(pid:nil));
|
||
end
|
||
function wmuser(o,e):WM_USER;override;
|
||
begin
|
||
pid := e.wparam;
|
||
fid := e.lparam;
|
||
if pid and fid then
|
||
begin
|
||
r := _wapi.tsl_gtk_pipread(fid,Fmsg,1024);
|
||
if r=0 then
|
||
begin
|
||
deleteproc(pid,1);
|
||
return ;
|
||
end else
|
||
if r>0 then
|
||
begin
|
||
obj := fidarraya[pid];
|
||
obj.DoOnEcho(obj,Fmsg[1:r]);
|
||
end else
|
||
begin
|
||
sleep(20);
|
||
end
|
||
_send_(WM_USER,pid,fid,1);
|
||
end
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
inherited;
|
||
deleteproc();
|
||
end
|
||
end
|
||
{$endif}
|
||
public
|
||
function DoOnEcho(o,s);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 打印
|
||
**}
|
||
if not(CallMessgeFunction(FOnEcho,o,s))then
|
||
begin
|
||
echo s;
|
||
end
|
||
end
|
||
function create();override;
|
||
begin
|
||
inherited;
|
||
{$ifdef linux}
|
||
if not FProcesswnd then FProcesswnd := new tprocesswnd(initializeapplication());
|
||
{$endif}
|
||
FBufSize := 1024;
|
||
end
|
||
function CreateProcessThread(exe,cmd);
|
||
begin
|
||
{$ifdef linux}
|
||
if parserasexeclevparam(exe,cmd,e,arg,envp)then
|
||
begin
|
||
//echo tostn(arg);
|
||
id := FProcesswnd._wapi.tsl_gtk_createprocessa(e,arg,envp,rh);
|
||
//1 跟着退出 2 4
|
||
ct := FProcesswnd.proccount();
|
||
FProcesswnd.addproc(id,rh,self(true),0);
|
||
end
|
||
return id;
|
||
{$endif}
|
||
si := new T_startupinfoa();
|
||
sa := new T_security_attributes();
|
||
pi := new T_process_information();
|
||
sa.bInheritHandle := TRUE; //必须为TRUE，父进程的读写句柄可以被子进程继承
|
||
sa.nLength := sa._size_;
|
||
//创建匿名管道
|
||
w32 := gettswin32api();
|
||
bRet := w32.CreatePipe(hRead,hWrite,sa._getptr_,0);
|
||
if not bRet then return 0;
|
||
w32.GetStartupInfoA(si._getptr_);
|
||
si.dwflags := 0x100;
|
||
si.hStdOutput := hWrite;
|
||
si.hStdError := hwrite;
|
||
p := w32.CreateProcessA(nil,format('%s %s ',exe,cmd),0,0,true,0,0,nil,si._getptr_,pi._getptr_);
|
||
return pi.hProcess;
|
||
end
|
||
function CreateProcessWaitRead(exe,cmd,hd,exitWithParent);
|
||
begin
|
||
{**
|
||
@explan(说明) 执行代码,非阻塞当前线程 %%
|
||
@param(exe)(string) 程序 %%
|
||
@param(cmd)(string) 命令行 %%
|
||
@param(hd)(pointer) 句柄,返回 %%
|
||
@return(integer) 进程退出码 %%
|
||
**}
|
||
if FCurrentExeHandle then return;
|
||
{$ifdef linux}
|
||
if parserasexeclevparam(exe,cmd,e,arg,envp)then
|
||
begin
|
||
//echo tostn(arg);
|
||
id := FProcesswnd._wapi.tsl_gtk_createprocessa(e,arg,envp,rh);
|
||
hd := id;
|
||
FCurrentExeHandle := id;
|
||
//1 跟着退出 2 4
|
||
ct := FProcesswnd.proccount();
|
||
FProcesswnd.addproc(id,rh,self(true),(((exitWithParent or ifnil(exitWithParent))* 2).| 1));
|
||
initializeapplication().run();
|
||
if ct <> FProcesswnd.proccount()then
|
||
begin
|
||
FProcesswnd.clearproc();
|
||
end
|
||
FCurrentExeHandle := 0;
|
||
end
|
||
id := 0;
|
||
return 0;
|
||
{$endif}
|
||
if not(FBufSize>100)then FBufSize := 1024;
|
||
w32 := gettswin32api();
|
||
si := new T_startupinfoa();
|
||
sa := new T_security_attributes();
|
||
pi := new T_process_information();
|
||
sa.bInheritHandle := TRUE; //必须为TRUE，父进程的读写句柄可以被子进程继承
|
||
sa.nLength := sa._size_;
|
||
//创建匿名管道
|
||
bRet := w32.CreatePipe(hRead,hWrite,sa._getptr_,0);
|
||
if not bRet then return 0;
|
||
w32.GetStartupInfoA(si._getptr_);
|
||
si.dwflags := 0x100;
|
||
si.hStdOutput := hWrite;
|
||
si.hStdError := hwrite;
|
||
p := w32.CreateProcessA(nil,format('%s %s ',exe,cmd),0,0,true,0,0,nil,si._getptr_,pi._getptr_);
|
||
hd := pi.hProcess;
|
||
FCurrentExeHandle := hd;
|
||
w32.CloseHandle(hWrite);
|
||
if p then
|
||
begin
|
||
CallDatafunction(FOnPressStart,self(true),hd);
|
||
szReadBuf := "";
|
||
setlength(szReadBuf,FBufSize);
|
||
nReadNum := 0;
|
||
ct1 := 0;
|
||
ct2 := 0;
|
||
ct3 := 0;
|
||
s := "123456";
|
||
while w32.PeekNamedPipe(hRead,s,3,ct1,ct2,ct3) do
|
||
begin
|
||
if ct1 then
|
||
begin
|
||
if w32.ReadFile__(hRead,szReadBuf,FBufSize-1,nReadNum,nil)=0 then
|
||
begin
|
||
break;
|
||
end
|
||
tcs := szreadbuf[1:nreadnum];
|
||
DoOnEcho(self(true),tcs);
|
||
end
|
||
MSG := new TTagMSG();
|
||
hmsg := MSG._getptr_;
|
||
/////////////////////////////////////////////////////
|
||
if(w32.PeekMessageA(hmsg,0,0,0,0x1))then
|
||
begin
|
||
if MSG.message=0x12 then
|
||
begin
|
||
if exitWithParent or ifnil(exitWithParent)then SysTerminate(1,hd);
|
||
w32.PostQuitMessage(0);
|
||
break;
|
||
end else
|
||
begin
|
||
w32.TranslateMessage(hmsg);
|
||
w32.DispatchMessageA(hmsg);
|
||
end
|
||
end else
|
||
begin
|
||
tslprocessmessages(false);
|
||
RunWorkerThreadLoop();
|
||
w32.WaitMessage();
|
||
end
|
||
//////////////////////////////////////////
|
||
end
|
||
hd := 0;
|
||
w32.GetExitCodeProcess(pi.hProcess,cd);
|
||
w32.CloseHandle(hRead);
|
||
FCurrentExeHandle := 0;
|
||
end
|
||
return cd;
|
||
end
|
||
function CreateProcessWaitReadBlockThread(exe,cmd);
|
||
begin
|
||
{**
|
||
@explan(说明) 阻塞当前线程等待输出 %%
|
||
@param(exe)(string) 程序 %%
|
||
@param(cmd)(string) 命令行 %%
|
||
@return(integer) 进程退出码 %%
|
||
**}
|
||
{$ifdef linux}
|
||
return 0;
|
||
{$endif}
|
||
if not(FBufSize>100)then FBufSize := 1024;
|
||
w32 := gettswin32api();
|
||
si := new T_startupinfoa();
|
||
sa := new T_security_attributes();
|
||
pi := new T_process_information();
|
||
sa.bInheritHandle := TRUE; //必须为TRUE，父进程的读写句柄可以被子进程继承
|
||
sa.nLength := sa._size_;
|
||
//创建匿名管道
|
||
bRet := w32.CreatePipe(hRead,hWrite,sa._getptr_,0);
|
||
if not bRet then return 0;
|
||
w32.GetStartupInfoA(si._getptr_);
|
||
si.dwflags := 0x100;
|
||
si.hStdOutput := hWrite;
|
||
si.hStdError := hwrite;
|
||
p := w32.CreateProcessA(nil,format('%s %s ',exe,cmd),0,0,true,0,0,nil,si._getptr_,pi._getptr_);
|
||
w32.CloseHandle(hWrite);
|
||
if p then
|
||
begin
|
||
CallDatafunction(FOnPressStart,self(true),pi.hProcess);
|
||
szReadBuf := "";
|
||
setlength(szReadBuf,FBufSize);
|
||
nReadNum := 0;
|
||
while(w32.ReadFile__(hRead,szReadBuf,FBufSize-1,nReadNum,nil)) do
|
||
begin
|
||
tcs := szreadbuf[1:nreadnum];
|
||
DoOnEcho(self(true),tcs);
|
||
nreadnum := 0;
|
||
end
|
||
end
|
||
w32.GetExitCodeProcess(pi.hProcess,cd);
|
||
w32.CloseHandle(hRead);
|
||
return cd;
|
||
end
|
||
property BufSize read FBufSize write FBufSize;
|
||
property OnEcho read FOnEcho write FOnEcho;
|
||
property LastExeHandle read FCurrentExeHandle;
|
||
property OnPressStart read FOnPressStart write FOnPressStart;
|
||
private
|
||
FOnPressStart;
|
||
FCurrentExeHandle;
|
||
{**
|
||
@param(OnEcho)(function[TCreateProcessA,s:string]) 程序 %%
|
||
**}
|
||
end
|
||
type TMyArrayA = class(tstrindexarray)
|
||
{**
|
||
@explan(数组类型) 忽略字符串下标的大小写%%
|
||
**}
|
||
function create();
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
type TMyArrayB = class(tnumindexarray)
|
||
{**
|
||
@explan(说明) 数字下标数组对象 %%
|
||
**}
|
||
function create();
|
||
begin
|
||
inherited;
|
||
end
|
||
end
|
||
type TInputEditor=class
|
||
{**
|
||
@ignore(忽略) %%
|
||
@explan(说明)输入框注册控件基类 %%
|
||
**}
|
||
class function ClassType();
|
||
begin
|
||
{**
|
||
@explan(说明) 类型名字 %%
|
||
@return(string) 名字 %%
|
||
**}
|
||
return "";
|
||
end
|
||
function OnNextKeyPress(o,e);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) key值判断 %%
|
||
**}
|
||
if e.CharCode=0x9 then FocusNext();
|
||
end
|
||
function FocusNext();virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 设置下一个获得焦点 %%
|
||
**}
|
||
if NextCtrl is class(TWinControl)then
|
||
begin
|
||
NextCtrl.SetFocus();
|
||
end
|
||
end
|
||
function SetInfo(info);virtual;
|
||
begin
|
||
{**
|
||
@explan(说明) 设置额外信息 %%
|
||
@param(info)(array) 信息 %%
|
||
**}
|
||
end
|
||
property NextCtrl read FNextCtrl Write FNextCtrl;
|
||
property Value read GetValue write SetValue;
|
||
{**
|
||
@param(NextCtrl)(TInputEditor) 下一个控件 %%
|
||
@param(Value)(any) 值 %%
|
||
**}
|
||
private
|
||
function GetValue();virtual;
|
||
begin
|
||
end
|
||
function SetValue();virtual;
|
||
begin
|
||
end
|
||
FNextCtrl;
|
||
end
|
||
|
||
type TTipMessageButton = class(TGraphicControl)
|
||
{**
|
||
@ignore(忽略) %%
|
||
@explan(说明) 提示按钮 %%
|
||
**}
|
||
public
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
height := 18;
|
||
width := 18;
|
||
caption := "提示信息";
|
||
fmessageCaption := nil;
|
||
fmessageText := nil;
|
||
fimageType := 0;
|
||
fmessagebox := new TMessageboxADlg(AOwner);
|
||
setMessageCaption("提示");
|
||
end
|
||
function MouseUp(o,e);override;
|
||
begin
|
||
inherited;
|
||
if e.skip then return;
|
||
if not fmessagebox.parent then fmessagebox.parent := parent;
|
||
if fmessageText=nil then fmessagebox.mbText := caption;
|
||
fmessagebox.ChooseDlg();
|
||
end
|
||
procedure Paint();override;
|
||
begin
|
||
{**
|
||
@explan(说明)控件绘制调用 ,使用Canvas属性和PAINTSTRUCT结构体 绘制控件 %%
|
||
**}
|
||
reset_tn();
|
||
Canvas.StretchDraw(array(0,iconTop,iconSidelength,iconSidelength+iconTop),ftipImage.getImage(fimageType));
|
||
if iconSidelength<width then
|
||
begin
|
||
canvas.font := font;
|
||
canvas.drawtext(caption,array(iconSidelength,0,width,height),36);
|
||
end
|
||
end
|
||
function setIconSize(l);
|
||
begin
|
||
{**
|
||
@explan(说明) 设置提示图标的边长，设置之后图标大小就不会根据控件大小变化而变化。%%
|
||
@param(l)(integer)要设置的长度，以像素为单位，为nil时取消设置%%
|
||
**}
|
||
if l <> nil then
|
||
begin
|
||
isConstIconSize := 1;
|
||
iconSidelength := l;
|
||
end else
|
||
isConstIconSize := 0;
|
||
end
|
||
function getIconSize();
|
||
begin
|
||
{**
|
||
@explan(说明) 获取提示图标的边长%%
|
||
@return(integer)边长%%
|
||
**}
|
||
if isConstIconSize then return iconSidelength;
|
||
reset_tn();
|
||
return iconSidelength;
|
||
end
|
||
function setIconType(i);
|
||
begin
|
||
{**
|
||
@explan(说明) 设置显示的提示图标类型%%
|
||
@param(l)(integer)0:疑问，默认
|
||
1：错误
|
||
2：消息
|
||
3：警告%%
|
||
**}
|
||
if(ifint(i)or ifint64(i))and i >= 0 and i<5 then
|
||
begin
|
||
if fimageType <> i then
|
||
begin
|
||
fimageType := i;
|
||
if parent then invalidateRect(nil,1);
|
||
end
|
||
return 1;
|
||
end
|
||
return 0;
|
||
end
|
||
property messageText:string read fmessageText write setMessageText;
|
||
property messageCaption:string read fmessageCaption write setMessageCaption;
|
||
property showInfomationIcon:bool read isInfomationIcon write setInfomationIcon;
|
||
{**
|
||
@param(messageText)(string)要显示的提示对话框的文字%%
|
||
@param(messageCaption)(string)要显示的提示对话框的标题%%
|
||
@param(showInfomationIcon)(bool)提示对话框内是否显示一个消息图标%%
|
||
**}
|
||
protected
|
||
class function Sinit();override;
|
||
begin
|
||
inherited;
|
||
if not ftipImage then ftipImage := new TTipImage();
|
||
end
|
||
|
||
private
|
||
type TTipImage=class
|
||
public
|
||
function create();
|
||
begin
|
||
init();
|
||
end
|
||
function getImage(n);
|
||
begin
|
||
return imageData[n];
|
||
end
|
||
private
|
||
{
|
||
0:state_unknown ○?
|
||
1:state_error ○!
|
||
2:state_hint ○i
|
||
3:state_warning △!
|
||
4:state_infomation □
|
||
}
|
||
function init();
|
||
begin
|
||
imageData := array();
|
||
imageData[0]:= "0502000000060400000074797065000203000000696D670006040000006461746
|
||
100026502000089504E470D0A1A0A0000000D4948445200000010000000100806
|
||
0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0
|
||
BFC6105000000097048597300000EC300000EC301C76FA864000001FA49444154
|
||
384FA590C16BD37014C7FD63A617118F3B78F0A6C2849D062AEEB08322E261301
|
||
0E7CDE1C58975177187ECB0218A8843F0302C8C6DB0D16DD0DAAEB16BBB68D3AD
|
||
59D3C43499499A768D7ECD7BD01FCD7612BFF08197F7BEDF6F48CEE03F75AAC07
|
||
4427C5CF1F1447270FFB9C5D04C3BBA9D54AC6035ED623CA1E1CD928DEFB56304
|
||
9D3F0CCDB4A31B79FA250A92290B77A68A500E5A08C310DD6E3706EDE8461EF2F
|
||
6C40587668091896D942ABFD06EB71104012E8DAEC5D8CC36F8461EF2524614CC
|
||
2CEC627A4E86EFFB705D97997D5F661E25BEE2C2F067CCCCE7794F9E6792CC195
|
||
170FD5E12E96F061CC71198A6095555F142DAC4C0950F989C5E462693412EB783
|
||
D594C21951707EE8132CDB43B3D9846118D8DB5322631ED2DB14CE5E5DC4AD893
|
||
528CA0F64B33BCC6EB1C2195170713809ABE941D3EA2814CA90E52273EEDA1253
|
||
A91C881D51285639230A46C6B3D14F32502E57512AA902CB3A62FA77C4F27A953
|
||
3A2E0D5BB46F41335ECEF1BD1DBEA82C19B05A67FA7AA3A9EBEAE724614D4CD2E
|
||
6E3CD491CEBBD16738A8D56CE6F298C6F49E8954DA662F654401E9CB4607A3933
|
||
6327280462380AE07F0BC90A19976DBB9166E471EF2F6240A485CF2D8C1CB053F
|
||
321F43AB87D00E436CE53A48CC7B51D8898549B10292FEF337A4C516EE4E1D61E
|
||
881CDD04C3BBA9DD4A9827F13F017E5DF89FE289AB2290000000049454E44AE42
|
||
608200";
|
||
imageData[1]:= "0502000000060400000074797065000203000000696D670006040000006461746
|
||
10002C502000089504E470D0A1A0A0000000D4948445200000010000000100806
|
||
0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0
|
||
BFC6105000000097048597300000EC300000EC301C76FA8640000025A49444154
|
||
384FA592FB4B53611CC6FB63C2B40B2111843F686988D9C598E6A5EDB09B735B2
|
||
DA78C4CCAA9BB485B91E8424C22B6650E85A0A00B545A1121116194457431529B
|
||
6B37DBDCA6672B787ADF77E76C893F450FBC3F7D9FCFF3BD9CB309FFA90D01BFF
|
||
B4E2063D7236DD562AD578354B71A892E25E267E5F87986135C79AD0BC8823A2C
|
||
DB5A91F4B9C0DFF5B097F00D2268D6216C6A42B0BD5E7067950B48DB74E02D2D8
|
||
80FDBF16B6A02FCE805AC3A4FB2C75F772233398E88AB07DF0D122CE86B044A08
|
||
E02D5AACF668101BB631386555B3272AD1AD246B28907EE043E8D2397C6DAEC66
|
||
75515ABB100BA67C462C8C3161592BD2A66A0A2FBC73AC90D3A38F0F7C630D7C6
|
||
E10357C16A2C801AE89EBCD7C140B1A3280A2E9B6488B44911BF6C45E48A136F1
|
||
B4B598D05443BA4E0EF7B91B46B1928761445C170EB71840CE4884639E2E35731
|
||
535BC26A2C20D8DE80B53B1EAC90CF268E4A3B663ECE3213057FE81B11D036206
|
||
0E0101F1BC1CB9ADDACC602FCA72488B9FB911CB1E746A51DE3D70690B8E563E0
|
||
92A61E7ED531849D660406FB305D5D9C0F98D71DC13793824C7123372AED288A8
|
||
28BCA3A2CC86BB132E1C61BE5513CABDCC16A2CE08BFA003E292AB1E4E844EAF6
|
||
68AE63D4E524DFDEC1C0794EC2E039B3114FF76FC3E3F2A27C00D57B5939669BC
|
||
AB0683F8DE44D2F2217C94FA39561B1458AD07933391C81BB8C78525184A97D5B
|
||
04EAAF00AAD775257825D98377CD120406C83D3C4388BA87E0EFB761863B44C04
|
||
23C2A2B10DC59AD0BA07A717817A60F16E379D54EB2E77632EE56326E2126F716
|
||
E061E966C195D786807F13F007E8743A916FA8D5250000000049454E44AE42608
|
||
200";
|
||
imageData[2]:= "0502000000060400000074797065000203000000696D670006040000006461746
|
||
100026F01000089504E470D0A1A0A0000000D4948445200000010000000100806
|
||
0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0
|
||
BFC6105000000097048597300000EC300000EC301C76FA8640000010449444154
|
||
384FC590CD4EC24014467D4C1FC23720AE890FC082858961876B6358E24A59904
|
||
0F83102024A2920CA6F202632F7F3DEA197D0306D349A709259F44ECF99764EF0
|
||
47FE2F709ACCFD6A29A140F6AE81AF8D09266E6E0A9D50C406746088305B13460
|
||
B823F277853C2CB84D07E2734DF0C5ABC84C4D5FD61E02C95B783218BFE8CD063
|
||
B9FB41780EE4C7A141CDDF062EAE8BD1813ECBAF7CAA95C784C6682B57592E7B3
|
||
10159F20BF2F91D3EB535367862B93E30A8B05C62B9EC6DAC749E7908070419C8
|
||
254A641FF99A52CFD8B0E0BC444187FBEB32570B7681E9F2D33EEB9EB20BB8901
|
||
707939553542203F272FAB61A292ACE804A71A212FB0B3FE1D801E01BC7E9AA1F
|
||
1B492A780000000049454E44AE42608200";
|
||
imageData[3]:= "0502000000060400000074797065000203000000696D670006040000006461746
|
||
100029B02000089504E470D0A1A0A0000000D4948445200000010000000100806
|
||
0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0
|
||
BFC6105000000097048597300000EC300000EC301C76FA8640000023049444154
|
||
384FA5924B68135114860342C1858208BA1041B42A528A146BADA5ED4A70272AD
|
||
5048D2EA48B2E74D195B85044280A165D3488A216DA8A521F68D5FAC65402DAE2
|
||
BBCD63F268A3C699BC6D329919F398CCEF99C9A531A45D883FFC309C7BFEEF70C
|
||
F5C13FE530B0212F636C45FB522F6A2059167DB59B55A0B02F470DAD983D4D733
|
||
088F6E63D56ACD0BD0C3519A5CCCA7919F754178B8153FEF6F61A7959A17107DD
|
||
E0291B3415333D0F261A4A62E2274B7819D56AA0AA087234F9B81620EB9A80DF9
|
||
783F4112F83EBC19DF6ED6B3AEB2AA007A580A0E533E09F750BB61557622ED19C
|
||
4CC501DEB2AAB021079D28CE47837A0E520050EC335D86E58F25AA11592E05F76
|
||
C17F6D03EB2E690EA08785C74DF81D1BA7E509907C87E01A68332C7ACC5033EF2
|
||
085C6E0BD520BEED25A96FA0B203C6A426AB29726C590156C04B0627A642703EC
|
||
87ECB7A2989D4178EC249C1756B31403E8617EA491C2191444079480D50028C14
|
||
EC4DF9B21BAF741F676201BB6A12085F0E5EC4A7C3CBDBC0CE01F34D292AED3E2
|
||
C2C8F2E7A1F80F10E060F90AEE0EC8DC5E48EEDD50150EBCFD1C264E2C2D01F47
|
||
0C47E84FEB9448F6614B2CF6238C3D1648F85C2165AA299007B20797641F1512F
|
||
5D73B26F071CC76A600ADD6B801C7A6D00B4C22CF957C92A7DEB9EAB259913541
|
||
711FF74076FBA16C1F4E3363D905BF508DEA8C3F4C02604FA37C277753DBC97D7
|
||
C1DDB70653BDABF0B967053E9C5A8689E34BF0B67B311C476B8CB0BDD354F90EF
|
||
E5DC01F26687F1D27F303B60000000049454E44AE42608200";
|
||
imageData[4]:= "0502000000060400000074797065000203000000696D670006040000006461746
|
||
10002F002000089504E470D0A1A0A0000000D4948445200000010000000100806
|
||
0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0
|
||
BFC6105000000097048597300000EC300000EC301C76FA8640000028549444154
|
||
384FA591CB4F136114C5FD9F9C71634C646188090644C18588A60852C028442D6
|
||
2202A1429EFB6D08729050BC8A3CAAB552A9456DA0E15C7D287057948DA8AC1C4
|
||
44571A8D28C73BD3490B61653CC959CD3DBF7BCF7C87F09F3A00C835ACE2942E8
|
||
A2C4D04275A03C868E171BC6591ECC7B1079C3495D63E40B67E0527D56194F585
|
||
D0E78E638CDB12DDEB8C41A67F05B6760E6C9D539A4E2A0510B666B605D13AB50
|
||
647601B3D337128ADEF707F64056ADB1AAC9E041AC7A260CB27C15E9B94521220
|
||
4B1B4166FB9218B6BDDE462D856E0F8631ECFB80616F02B72C212806C2B0CC6D4
|
||
2F92404B6C40AB678240DC8542FA1D414809DFF849AC1281454E1863988EF3F77
|
||
44579A7954F6F0503C0A60F0650CE79B5F802918480332DA79EA1987D6B6819B7
|
||
D41549903A834F1E8776FC2422E3772491B7C542B0CFDCC2AD87C731A7054C961
|
||
62F1236AFA43B4E90D2A1EFA6938F9C777C9729D17A55DF3640FAE1ABCB072313
|
||
067BAC5EF2280AD7363DCBF2576153695E97D14F2211AFF8A6F3F7650D2E94671
|
||
870B97C9728D0BA30B04C8D1EC053861726E40F5741915063FE4DD5E5CD1CEE36
|
||
DEC0B017EA1A8651645D45BD6EC40750F07AD2302F674E71E40B503856A37863D
|
||
7154E838C8D51E38F8047EFFD9152B84DE7F46A1D24EB6C1F82C8AFC3B6304E81
|
||
0A212E0FA3858B915F74683B038D751A27641D63A838BAA691436D870A17E1205
|
||
F513681B0DD0F32ED0F92AB0E4144010231BC2E1BC5ED40ED18BCCAE4261F2D2C
|
||
9CF71A9D18E2A9D0B7A5B188A7E0E6C76432A2C280510C4E4F782C933E2DCDD29
|
||
68A797F1D8BB415E47A73D82DC1A2B98EC460A3749D349ED030862CFEAE989BAC
|
||
0E46AE8D4660A35891B051FC96990A6D23A00F837017F01AE4B3263C856875900
|
||
00000049454E44AE42608200";
|
||
for i := 0 to length(imageData)-1 do
|
||
begin
|
||
t := new tcustombitmap();
|
||
t.Readvcon(HexFormatStrToTsl(imageData[i]));
|
||
imageData[i]:= t;
|
||
end
|
||
end
|
||
imageData;
|
||
end
|
||
function setMessageText(str);
|
||
begin
|
||
fmessageText := str;
|
||
fmessagebox.mbText := str;
|
||
end
|
||
function setMessageCaption(str);
|
||
begin
|
||
fmessageCaption := str;
|
||
fmessagebox.Caption := str;
|
||
end
|
||
function setInfomationIcon(b);
|
||
begin
|
||
isInfomationIcon := b?1:0;
|
||
fmessagebox.mbiconstyle := isInfomationIcon?0x40:0;
|
||
end
|
||
function reset_tn();
|
||
begin
|
||
//重新计算图标的边长及位置
|
||
if not isConstIconSize then iconSidelength := height<width?height:width;
|
||
iconTop :=(height-iconSidelength)/2;
|
||
if iconTop<0 then iconTop := 0;
|
||
end
|
||
isConstIconSize;//控件显示的图标尺寸是否不变
|
||
iconSidelength;//控件图标边长
|
||
iconTop;//控件图标位置
|
||
fmessageCaption;//对话框标题
|
||
fmessageText;//对话框内容
|
||
isInfomationIcon;
|
||
fimageType;//控件图标类型
|
||
fmessagebox;
|
||
static ftipImage;
|
||
end
|
||
type TInPutQuerys= class(tpanel)
|
||
{**
|
||
@ignore(忽略) %%
|
||
@explan(说明) 输入 %%
|
||
**}
|
||
{**
|
||
@example(输入范例)
|
||
wd := new TInPutQuerys();
|
||
d := array(("name":"A","value":100,"Comment":"年龄","readonly":0),
|
||
("Name":"b","value":10,"caption":"工作年限","readonly":1));
|
||
wd.SetData(d);
|
||
if wd.ShowDlg(r,"get") then echo tostn(r);
|
||
**}
|
||
protected
|
||
class Function Sinit();override;
|
||
begin
|
||
inherited;
|
||
if not SHashInited then
|
||
begin
|
||
SHashInited := 1;
|
||
RegisterInputType(array(class(TInputString),class(TInputInteger),
|
||
class(TInputFile),class(TInputPath),class(TInputPassWord),
|
||
class(TInputBool)));
|
||
end
|
||
end
|
||
public
|
||
function Create(AOwner);
|
||
begin
|
||
inherited;
|
||
caption := "input";
|
||
visible := false;
|
||
wspopup := true;
|
||
wscaption := true;
|
||
FBOk := new TInputBtn(self);
|
||
FBOk.caption := "确定";
|
||
FBOk.onclick := thisfunction(OnOkClk);
|
||
FBOk.parent := self;
|
||
FTips := array();
|
||
FBCancel := new TInputBtn(self);
|
||
FBOk.NextCtrl := FBCancel;
|
||
FBCancel.caption := "取消";
|
||
FBCancel.onclick := thisfunction(OnCancelClk);
|
||
FBCancel.parent := self;
|
||
FLabels := FEdits := array();
|
||
height := 150;
|
||
width := 400;
|
||
end
|
||
function SetData(d);
|
||
begin
|
||
{**
|
||
@explan(说明) 输入框 %%
|
||
@param(d)(array) 二维表,列标为 name ,value ,caption %%
|
||
**}
|
||
if FSetData=d then return;
|
||
FSetData := d;
|
||
r := RegularData(d);
|
||
FInfoa := r;
|
||
return RebuildInput();
|
||
end
|
||
function ShowDlg(result,c);
|
||
begin
|
||
{**
|
||
@explan(说明) 显示输入框 %%
|
||
@param(result)(array) 返回值 %%
|
||
@param(c)(string) 标题 ,可以忽略%%
|
||
**}
|
||
if ifstring(c)then caption := c;
|
||
if ShowModal()then
|
||
begin
|
||
for i,v in FLabels do
|
||
begin
|
||
FInfo[FInfoa[i,"name"]]:= FEdits[i].value;
|
||
end
|
||
result := FInfo.ToArray();
|
||
return true;
|
||
end
|
||
end
|
||
function ShowQuerys(result,t);
|
||
begin
|
||
{**
|
||
@explan(说明) 根据位置显示输入框 %%
|
||
@param(result)(array) 返回值 %%
|
||
@param(t)(string) 标题,可以忽略 %%
|
||
**}
|
||
c := array(200,200);
|
||
_wapi.GetCursorPos(c);
|
||
Left := c[0]>50?(c[0]-50):100;
|
||
top := c[1]>50?(c[1]-50):100;
|
||
return ShowDlg(result,t);
|
||
end
|
||
function OnOkClk();
|
||
begin
|
||
EndModal(1);
|
||
end
|
||
function OnCancelClk();
|
||
begin
|
||
EndModal(0);
|
||
end
|
||
function DoWMSIZE(o,e);override;
|
||
begin
|
||
h := clientrect;
|
||
ht := h[3]-h[1];
|
||
wd := h[2]-h[0];
|
||
FBOk.Left := wd/2-50;
|
||
FBOK.top := ht-33;
|
||
FBCancel.Left := FBOk.Left+FBOK.Width+20;
|
||
FBCancel.top := ht-33;
|
||
end
|
||
class function RegisterInputType(t);
|
||
begin
|
||
{**
|
||
@explan(说明) 注册input类型 %%
|
||
@param(t)(TInputEditor) 编辑类 %%
|
||
**}
|
||
if t is class(TInputEditor)then
|
||
begin
|
||
if not SFInputType then SFInputType := new TMyArrayA();
|
||
return SFInputType[t.classtype]:= t;
|
||
end else
|
||
if ifarray(t)then
|
||
begin
|
||
for i,v in t do RegisterInputType(v);
|
||
end
|
||
end
|
||
class function GetInputType(n);
|
||
begin
|
||
{**
|
||
@explan(说明) 获得注册类型 %%
|
||
**}
|
||
if SFInputType and ifstring(n)then return SFInputType[n];
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
inherited;
|
||
FSetData := nil;
|
||
FInfoa := nil;
|
||
FInfo := nil;
|
||
FBOk := nil;
|
||
FBCancel := nil;
|
||
FLabels := nil;
|
||
FEdits := nil;
|
||
FTips := nil;
|
||
end
|
||
private
|
||
function RebuildInput();
|
||
begin
|
||
ld := length(FInfoa);
|
||
lb := length(FLabels);
|
||
lp := length(FTips);
|
||
for i := 0 to lp-1 do FTips[i].Recycling();
|
||
for i := 0 to lb-1 do
|
||
begin
|
||
FLabels[i].Recycling();
|
||
FEdits[i].Recycling();
|
||
end
|
||
FLabels := array();
|
||
FEdits := array();
|
||
for i := 0 to ld-1 do
|
||
begin
|
||
FLabels[i]:= new TLabel(self);
|
||
tp := FInfoa[i]["type"];
|
||
if ifstring(tp)then
|
||
begin
|
||
tp := GetInputType(tp);
|
||
end
|
||
if ifobj(tp)then FEdits[i]:= createobject(tp,self);
|
||
else FEdits[i]:= new TInputString(self);
|
||
syg := FEdits[i-1];
|
||
if syg then
|
||
begin
|
||
syg.NextCtrl := FEdits[i];
|
||
end
|
||
if i=ld-1 then FEdits[i].NextCtrl := FBOk;
|
||
end
|
||
sp := 5;
|
||
for i,v in FInfoa do
|
||
begin
|
||
lb := FLabels[i];
|
||
le := FEdits[i];
|
||
lb.caption := v["caption"];
|
||
lb.left := 20;
|
||
vtp := v["tip"];
|
||
if ifstring(vtp)and vtp then
|
||
begin
|
||
tp := new TTipMessageButton(self);
|
||
tp.caption := vtp;
|
||
tp.left := 2;
|
||
tp.top := sp+3;
|
||
FTips[length(FTips)]:= tp;
|
||
tp.parent := self;
|
||
end
|
||
lb.top := sp;
|
||
lb.width := length(v["caption"])* 8+3;
|
||
le.value := v["value"];
|
||
le.top := lb.top;
|
||
le.left := lb.width+lb.left;
|
||
if v["readonly"]then
|
||
begin
|
||
if le is class(tedit)then le.readonly := true;
|
||
else le.Enabled := false;
|
||
end else
|
||
begin
|
||
if le is class(tedit)then le.readonly := false;
|
||
else le.Enabled := true;
|
||
end
|
||
wd := max(le.left+le.width+10,wd);
|
||
sp += max(lb.height,le.height);
|
||
sp += 4;
|
||
le.SetInfo(v);
|
||
le.parent := self;
|
||
lb.parent := self;
|
||
end
|
||
width := wd+10;
|
||
height := sp+60+10;
|
||
//echo "\r\nin thisf function:",wd,"===",(sp+60);
|
||
//echo "\r\nin thisf function:",width,"===",height;
|
||
end
|
||
type tinputbool=class(tcheckbtn,TInputEditor)
|
||
{**
|
||
@explan(说明) 输入框 %%
|
||
**}
|
||
class function ClassType();override;
|
||
begin
|
||
return "bool";
|
||
end
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
width := 16;
|
||
height := 17;
|
||
OnKeyPress := thisfunction(OnNextKeyPress);
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
NextCtrl := nil;
|
||
inherited;
|
||
end
|
||
private
|
||
function GetValue();virtual;
|
||
begin
|
||
return Checked;
|
||
end
|
||
function SetValue(v);virtual;
|
||
begin
|
||
Checked := v;
|
||
end
|
||
end
|
||
type TInputString=class(TEdit,TInputEditor)
|
||
{**
|
||
@explan(说明) 输入框 %%
|
||
**}
|
||
class function ClassType();override;
|
||
begin
|
||
return "string";
|
||
end
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
width := 300;
|
||
OnKeyPress := thisfunction(OnNextKeyPress);
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
NextCtrl := nil;
|
||
inherited;
|
||
end
|
||
private
|
||
function GetValue();virtual;
|
||
begin
|
||
return text;
|
||
end
|
||
function SetValue(v);virtual;
|
||
begin
|
||
text := v;
|
||
end
|
||
end
|
||
type TInputPassWord=class(tpassword,TInputEditor)
|
||
{**
|
||
@explan(说明) 输入框 %%
|
||
**}
|
||
class function ClassType();override;
|
||
begin
|
||
return "password";
|
||
end
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
width := 300;
|
||
OnKeyPress := thisfunction(OnNextKeyPress);
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
NextCtrl := nil;
|
||
inherited;
|
||
end
|
||
private
|
||
function GetValue();virtual;
|
||
begin
|
||
return text;
|
||
end
|
||
function SetValue(v);virtual;
|
||
begin
|
||
text := v;
|
||
end
|
||
end
|
||
type TInputInteger=class(TInputString)
|
||
class function ClassType();override;
|
||
begin
|
||
return "integer";
|
||
end
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
OnKeyPress := thisfunction(InPutChar);
|
||
end
|
||
function InPutChar(o,e);
|
||
begin
|
||
cd := e.CharCode;
|
||
if cd=VK_BACK or cd=VK_DELETE then return;
|
||
if cd=VK_TAB then OnNextKeyPress(o,e);
|
||
else
|
||
begin
|
||
if not(cd >= ord("0")and cd <= ord("9"))then
|
||
begin
|
||
e.skip := true;
|
||
end
|
||
end
|
||
end
|
||
private
|
||
function GetValue();override;
|
||
begin
|
||
return StrToIntDef(self.Text,0);
|
||
end
|
||
function SetValue(v);override;
|
||
begin
|
||
if ifnumber(v)then Text := IntToStr(v);
|
||
end
|
||
end
|
||
type TInputBtn=class(TBtn,TInputEditor)
|
||
{**
|
||
@explan(说明) 按钮 %%
|
||
**}
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
height := 25;
|
||
OnKeyPress := thisfunction(OnNextKeyPress);
|
||
end
|
||
function Recycling();override;
|
||
begin
|
||
NextCtrl := nil;
|
||
inherited;
|
||
end
|
||
end
|
||
type TEditAndBtnUni=class(TWincontrol)
|
||
{**
|
||
@explan(说明) edit button 组合 %%
|
||
**}
|
||
private
|
||
FBtn;
|
||
FText;
|
||
public
|
||
function BtnClick(o,e);virtual;
|
||
function WMSETFOCUS(o,e):WM_SETFOCUS;override;
|
||
begin
|
||
if FBtn then FBtn.SetFocus();
|
||
end
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
Height := 22;
|
||
FBtn := new tbtn(self);
|
||
FBtn.caption := "..";
|
||
FText := new tedit(self);
|
||
FText.caption := "";
|
||
FBtn.Parent := self;
|
||
FText.Parent := self;
|
||
FBtn.OnClick := thisfunction(BtnClick);
|
||
FText.OnKeyUP := function(o,e)
|
||
begin
|
||
if e.CharCode=VK_TAB then
|
||
begin
|
||
self.parent._send_(WM_USER,3,self.Handle);
|
||
end
|
||
end
|
||
end
|
||
function DoControlAlign();override;
|
||
begin
|
||
c := clientRect;
|
||
FBtn.top := 1;
|
||
FBtn.Left := C[2]-C[0]-18;
|
||
FBtn.Width := 15;
|
||
FBtn.Height := c[3]-c[1]-2;
|
||
FText.top := 1;
|
||
FText.Left := 1;
|
||
FText.Height := c[3]-c[1]-2;
|
||
FText.Width := C[2]-C[0]-22;
|
||
end
|
||
property Text read GetText Write SetText;
|
||
private
|
||
function GetText();
|
||
begin
|
||
return FText.Text;
|
||
end
|
||
function SetText(v);
|
||
begin
|
||
FText.Text := v;
|
||
end
|
||
end
|
||
type TInputFile=class(TEditAndBtnUni,TInputEditor)
|
||
class function ClassType();override;
|
||
begin
|
||
return "file";
|
||
end
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
width := 300;
|
||
height := 30;
|
||
end
|
||
function BtnClick(o,e);override;
|
||
begin
|
||
if not FFile then
|
||
begin
|
||
FFile := new TOpenFileADlg(self);
|
||
FFile.parent := self;
|
||
end
|
||
if FFile.ChooseDlg()then
|
||
begin
|
||
text := FFile.FileName;
|
||
end
|
||
end
|
||
private
|
||
function GetValue();override;
|
||
begin
|
||
return text;
|
||
end
|
||
function SetValue(v);override;
|
||
begin
|
||
text := v;
|
||
end
|
||
FFile;
|
||
end
|
||
type TInputPath=class(TEditAndBtnUni,TInputEditor)
|
||
class function ClassType();override;
|
||
begin
|
||
return "path";
|
||
end
|
||
function Create(AOwner);override;
|
||
begin
|
||
inherited;
|
||
width := 300;
|
||
height := 30;
|
||
end
|
||
function BtnClick(o,e);override;
|
||
begin
|
||
if not FFile then
|
||
begin
|
||
FFile := new TFolderChooseADlg(self);
|
||
FFile.parent := self;
|
||
end
|
||
if FFile.ChooseDlg()then
|
||
begin
|
||
text := FFile.Folder;
|
||
end
|
||
end
|
||
private
|
||
function GetValue();override;
|
||
begin
|
||
return text;
|
||
end
|
||
function SetValue(v);override;
|
||
begin
|
||
text := v;
|
||
end
|
||
FFile;
|
||
end
|
||
function Tostr(v);
|
||
begin
|
||
if not ifstring(v)then return tostn(v);
|
||
return v;
|
||
end
|
||
function RegularData(d);
|
||
begin
|
||
r := array();
|
||
FInfo := New TMyArrayA();
|
||
v := new TMyArrayA();
|
||
for i in d do
|
||
begin
|
||
vi := d[i];
|
||
if not ifarray(vi)then continue;
|
||
v.Data := vi;
|
||
vn := v["name"];
|
||
//if not ifstring(vn) then continue;
|
||
if FInfo[vn]then continue;
|
||
FInfo[vn]:= 1;
|
||
r[idx,"name"]:= vn;
|
||
r[idx,"caption"]:= v["caption"]?:(v["Comment"]?: wn);
|
||
for j in v.IndexNames() do
|
||
begin
|
||
if j in array("caption","name")then continue;
|
||
vj := v[j];
|
||
r[idx,j]:= vj;
|
||
end
|
||
idx++;
|
||
end
|
||
return r;
|
||
end
|
||
FSetData;
|
||
FInfoa;
|
||
FInfo;
|
||
FBOk;
|
||
FBCancel;
|
||
FLabels;
|
||
FEdits;
|
||
FTips;
|
||
static SFInputType;
|
||
static SHashInited;
|
||
end
|
||
|
||
implementation
|
||
type TDragManager=class(TComponent)
|
||
private
|
||
FDragImmediate:Boolean;
|
||
FDragThreshold:Integer;
|
||
protected //input capture
|
||
procedure KeyUp(var Key:Word;Shift:TShiftState);virtual;
|
||
procedure KeyDown(var Key:Word;Shift:TShiftState);virtual;
|
||
procedure CaptureChanged(OldCaptureControl:TControl);virtual;
|
||
procedure MouseMove(Shift:TShiftState;X,Y:Integer);virtual;
|
||
procedure MouseUp(Button:TMouseButton;Shift:TShiftState;X,Y:Integer);virtual;
|
||
procedure MouseDown(Button:TMouseButton;Shift:TShiftState;X,Y:Integer);virtual;
|
||
public
|
||
function Create(TheOwner:TComponent);override;
|
||
function IsDragging():boolean;virtual;
|
||
function Dragging(AControl:TControl):boolean;virtual;
|
||
procedure RegisterDockSite(Site:TWinControl;DoRegister:Boolean);virtual;
|
||
procedure DragStart(AControl:TControl;AImmediate:Boolean;AThreshold:Integer);virtual;
|
||
procedure DragMove(APosition:TPoint);virtual;
|
||
procedure DragStop(ADrop:Boolean);virtual;
|
||
property DragImmediate:Boolean read FDragImmediate write FDragImmediate; // default True;
|
||
property DragThreshold:Integer read FDragThreshold write FDragThreshold; // default 5;
|
||
end;
|
||
|
||
function GetAndDispatchMessageA(hwnd,minm,maxm);
|
||
begin
|
||
{**
|
||
@explan(说明) 获得和分发消息 %%
|
||
@param(hwnd)(pointer) 窗口句柄 默认为0 %%
|
||
@param(minm)(integer) 最小消息值 默认为空 %%
|
||
@param(maxm)(integer) 最大消息值 默认为空 %%
|
||
@return(integer)0表示WM_QUIT ,-1表示错误,其他返回大于0 %%
|
||
**}
|
||
FMSG := new TTagMSG();
|
||
ptr := FMSG._getptr_();
|
||
API := gettswin32api();
|
||
///////////////////////////////////////////////
|
||
if(API.PeekMessageA(ptr,0,0,0,0x1))then
|
||
begin
|
||
if FMSG.message=0x12 then
|
||
begin
|
||
return 0;
|
||
end else
|
||
begin
|
||
API.TranslateMessage(ptr);
|
||
API.DispatchMessageA(ptr);
|
||
end
|
||
end else
|
||
begin
|
||
tslprocessmessages(false);
|
||
RunWorkerThreadLoop();
|
||
API.WaitMessage();
|
||
end
|
||
return-1;
|
||
//////////////////////////////////////////////////////
|
||
{r := API.GetMessageA(ptr, hwnd>0?hwnd:0, minm>0?minm:0, maxm>0?maxm:0);
|
||
if r=0 then
|
||
begin
|
||
return r;
|
||
end
|
||
API.TranslateMessage(ptr);
|
||
API.DispatchMessageA(ptr);}
|
||
return r;
|
||
end
|
||
|
||
function GetGdipStatus(v);
|
||
begin
|
||
{**
|
||
@explan(说明) 获得gdiflat的运行状态说明 %%
|
||
@param(v)(integer) 状态值 %%
|
||
@return(string) 状态说明 %%
|
||
**}
|
||
vs := static array(
|
||
"Ok",
|
||
"GenericError",
|
||
"InvalidParameter",
|
||
"OutOfMemory",
|
||
"ObjectBusy",
|
||
"InsufficientBuffer",
|
||
"NotImplemented",
|
||
"Win32Error",
|
||
"WrongState",
|
||
"Aborted",
|
||
"FileNotFound",
|
||
"ValueOverflow",
|
||
"AccessDenied",
|
||
"UnknownImageFormat",
|
||
"FontFamilyNotFound",
|
||
"FontStyleNotFound",
|
||
"NotTrueTypeFont",
|
||
"UnsupportedGdiplusVersion",
|
||
"GdiplusNotInitialized",
|
||
"PropertyNotFound",
|
||
"PropertyNotSupported",
|
||
"ProfileNotFound");
|
||
return vs[v];
|
||
end
|
||
|
||
function RegisterComponentType(n,typ);
|
||
begin
|
||
{**
|
||
@explan(说明) 注册component组件 %%
|
||
**}
|
||
class(Ttfm2Component).RegisterComponentType(n,typ);
|
||
end
|
||
function initializeapplication();
|
||
begin
|
||
{**
|
||
@explan(说明) 初始化application %%
|
||
@return(tapplication) 窗口程序管理对象 %%
|
||
**}
|
||
return getapplication();
|
||
end
|
||
function getapplication();
|
||
begin
|
||
{**
|
||
@explan(说明) 返回application对象%%
|
||
@return(tapplication) 应用对象 %%
|
||
**}
|
||
r := class(tUIglobalData).uigetdata("tuiapplication");
|
||
if not(r)then
|
||
begin
|
||
r := new tapplication();
|
||
class(tUIglobalData).uisetdata("tuiapplication",r);
|
||
end
|
||
return r;
|
||
//return static new tapplication();
|
||
end
|
||
function gettswin32api(); //win32 api
|
||
begin
|
||
{**
|
||
@explan(说明) 返回win32api对象
|
||
**}
|
||
global G_O_TSWIN32API_;
|
||
if not G_O_TSWIN32API_ then G_O_TSWIN32API_ := new tswin32api();
|
||
return G_O_TSWIN32API_;
|
||
end
|
||
Function tslcstructure(data,dsize,pack,ptr);
|
||
Begin
|
||
{**
|
||
@explan(说明) 结构体排布计算 %%
|
||
@param(data)(array) 结构体信息数组,参考 cstructurelib中 tslarraytocstructcalc %%
|
||
@param(ssize)(integer) 大小 忽略%%
|
||
@param(pack)(integer) 对其方式 忽略%%
|
||
@return(tslcstructureobj) 内存分布对象 %%
|
||
**}
|
||
dt := unit(cstructurelib).MemoryAlignmentCalculate(data,1,dsize,pack);
|
||
r := new tslcstructureobj(dt,ptr);
|
||
return r;
|
||
End;
|
||
|
||
function tslcstructure_calc(data,baselen,ssize,pack);
|
||
begin
|
||
{**
|
||
@explan(说明) 结构体排布计算 %%
|
||
@param(data)(array) 结构体信息数组,参考 cstructurelib中 tslarraytocstructcalc %%
|
||
@param(baselen)(integer) 基准长度%%
|
||
@param(ssize)(integer) 大小 %%
|
||
@param(pack)(integer) 对其方式 %%
|
||
**}
|
||
return tslarraytocstructcalc(data,pack,0,ssize);
|
||
end
|
||
|
||
function remotetslcallback(data);
|
||
begin
|
||
{**
|
||
@explan(说明) 行情订阅回调 %%
|
||
**}
|
||
class(TQuotations).Dispatch(data);
|
||
//return class(TQuotations)._SWINDOWS._send_(0X4400,0,data,1);
|
||
end
|
||
|
||
|
||
//*********字符串相关对象**************************************
|
||
|
||
function calldatafunction();
|
||
begin
|
||
{**
|
||
@explan(说明)执行函数句柄,默认第一个参数为函数句柄,后面的参数为该句柄的参数 %%
|
||
**}
|
||
pc := paramcount;
|
||
if pc<1 then return nil;
|
||
f := params[1];
|
||
if datatype(f)<> 7 then return nil;
|
||
case pc of
|
||
1:return call(f);
|
||
2:return call(f,params[2]);
|
||
3:return call(f,params[2],params[3]);
|
||
4:return call(f,params[2],params[3],params[4]);
|
||
end;
|
||
return nil;
|
||
ps := params;
|
||
f := ps[0];
|
||
pms := ps[1:];
|
||
if datatype(f)<> 7 or not(ifarray(pms))then exit;
|
||
info := f.functioninfo();
|
||
pt := info["parameter"];
|
||
lpt := length(pt);
|
||
if(lpt=0)or length(pms)<= lpt then
|
||
begin
|
||
return callinarray(f,pms);
|
||
end else
|
||
return callinarray(f,pms[0:lpt-1]);
|
||
end
|
||
function NotifyComponent(Acomponent,Act,AOwner);
|
||
begin
|
||
{**
|
||
@explan(说明) 通知节点AOwner有节点Acomponent 发生了改变,通知码为act %%
|
||
@param(Acomponent)(tcomponent) 改变的节点 %%
|
||
@param(Act)(member of TOperation) 通知码 %%
|
||
@param(AOwner)(tcomponent|nil) 被通知的节点,默认采用application 对象 %%
|
||
**}
|
||
if not(Acomponent is class(tcomponent))then exit;
|
||
owner := AOwner;
|
||
if not(owner is class(tcomponent))then
|
||
begin
|
||
owner := getapplication();
|
||
end
|
||
owner.Notification(Acomponent,Act);
|
||
end
|
||
function _timeproc_(hwnd,message,wparam,lparam); //消息分发
|
||
begin
|
||
{**
|
||
@explan(说明) 消息分发预处理函数被底层调用 %%
|
||
@param(hwnd)(integer) 窗口句柄 %%
|
||
@param(message)(integer) 消息id %%
|
||
@param(lparam)(integer) 消息参数2 %%
|
||
@param(wparam)(integer) 消息参数1 %%
|
||
|
||
**}
|
||
return class(ttimer)._timeproc_(hwnd,message,wparam,lparam);
|
||
end
|
||
function controlisCustomPaint(id);
|
||
begin
|
||
wd := class(tUIglobalData).uigetdata("TGlobalValues").getvalue(id);
|
||
if wd then return wd.isCustomPaint();
|
||
return false;
|
||
end
|
||
function _twinproc_(hwnd,message,wparam,lparam); //消息分发
|
||
begin
|
||
{**
|
||
@explan(说明) 消息分发预处理函数被底层调用 %%
|
||
@param(hwnd)(integer) 窗口句柄 %%
|
||
@param(message)(integer) 消息id %%
|
||
@param(lparam)(integer) 消息参数2 %%
|
||
@param(wparam)(integer) 消息参数1 %%
|
||
|
||
**}
|
||
//return gettswin32api().DefWindowProcA(hwnd,message,wparam,lparam);
|
||
//echo format("\r\n%x\t%x\t%x\t%x",hwnd,message,wparam,lparam);
|
||
//wdobj := class(TGlobalComponentcache).getwndbyhwnd(hwnd);
|
||
//wdobj := uigetdata("TGlobalComponentcache").getwndbyhwnd(hwnd);
|
||
wdobj := class(tUIglobalData).uigetdata("TGlobalComponentcache").getwndbyhwnd(hwnd);
|
||
if ifnil(wdobj)then //没有注册
|
||
begin
|
||
if message=0x81 then //如果为 WM_CREATE WM_NCCREATE 就注册
|
||
begin
|
||
cpm := new tslcstructureobj(MemoryAlignmentCalculate(array(
|
||
("lpcreateparams","intptr",0))),lparam);
|
||
cid := cpm._getvalue_("lpcreateparams");
|
||
wdobj := class(tUIglobalData).uigetdata("TGlobalValues").getvalue(cid);
|
||
{if wdobj is class(TWincontrol) then
|
||
begin
|
||
//return wdobj.MainWndProc(hwnd,message,wparam,lparam);
|
||
//class(TGlobalComponentcache).registerhandle(hwnd,wdobj);
|
||
end }
|
||
end
|
||
end
|
||
r := 0;
|
||
if wdobj then
|
||
begin
|
||
r := wdobj.MainWndProc(hwnd,message,wparam,lparam);
|
||
end else
|
||
begin
|
||
//echo format("\r\n%x,%d,%x,%x",hwnd,message,wparam,lparam);
|
||
end
|
||
if message=0x82 then
|
||
begin
|
||
class(tUIglobalData).uigetdata("TGlobalComponentcache").unregisterhandle(hwnd);
|
||
end
|
||
return r;
|
||
if message in array(1,0x81)then
|
||
begin
|
||
obj := new tslcstructureobj(MemoryAlignmentCalculate(array(
|
||
("lpcreateparams","intptr",0),
|
||
("hinstance","intptr",0),
|
||
("hmenu","intptr",0),
|
||
("hwndparent","intptr",0),
|
||
("cy","int",0),
|
||
("cx","int",0),
|
||
("y","int",0),
|
||
("x","int",0),
|
||
("style","int",0),
|
||
("lpszname","intptr",0),
|
||
("lpszclass","intptr",0),
|
||
("dwexstyle","int",0))),lparam);
|
||
echo tostn(obj._getdata_);
|
||
end
|
||
end
|
||
function _MessgeHook_a(hwnd,message,wparam,lparam);
|
||
begin
|
||
{**
|
||
@ignore(忽略)
|
||
@explan(说明) 文件夹对话框回调函数,系统调用%%
|
||
**}
|
||
{
|
||
// messages to browser
|
||
0x0400
|
||
#define BFFM_SETSTATUSTEXTA (WM_USER + 100)
|
||
#define BFFM_ENABLEOK (WM_USER + 101)
|
||
#define BFFM_SETSELECTIONA (WM_USER + 102)
|
||
#define BFFM_SETSELECTIONW (WM_USER + 103)
|
||
#define BFFM_SETSTATUSTEXTW (WM_USER + 104)
|
||
#define BFFM_SETOKTEXT (WM_USER + 105) // Unicode only
|
||
#define BFFM_SETEXPANDED (WM_USER + 106) // Unicode only
|
||
|
||
#define BFFM_INITIALIZED 1
|
||
#define BFFM_SELCHANGED 2
|
||
#define BFFM_VALIDATEFAILEDA 3 // lParam:szPath ret:1(cont),0(EndDialog)
|
||
#define BFFM_VALIDATEFAILEDW 4 // lParam:wzPath ret:1(cont),0(EndDialog)
|
||
#define BFFM_IUNKNOWN 5 // provides IUnknown to client. lParam: IUnknown*
|
||
}
|
||
//echo "\r\nhook",tostn(array(format("0x%x",hwnd),format("0x%x",message),format("0x%x",wparam),format("0x%x",lparam)));
|
||
if message=1 then
|
||
begin
|
||
gettswin32api().SendMessageA(hwnd,0x0400+102,TRUE,lparam);
|
||
end
|
||
return 0;
|
||
if message=0x110 then //如果为 WM_CREATE WM_NCCREATE 就注册
|
||
begin
|
||
s := array(format("0x%x",hwnd),format("0x%x",message),format("0x%x",wparam),format("0x%x",lparam));
|
||
d := new TtagOFNA(lparam);
|
||
end
|
||
end
|
||
|
||
|
||
|
||
//function GetModuleFileNameA(m:pointer;var buf:string;len:integer):integer;stdcall;external "Kernel32.dll" name "GetModuleFileNameA";
|
||
//function CallWindowProcA(lpPrevWndFunc:pointer;hWnd:pointer;Msg:integer;wParam:pointer;lParam:pointer):pointer;stdcall;external "User32.dll" name "CallWindowProcA";
|
||
//function RegisterClassExA(wc:pointer):short;stdcall;external "User32.dll" name "RegisterClassExA";
|
||
|
||
//临时文件
|
||
|
||
|
||
function TS_EndExecute(id:integer);cdecl;external "TSSVRAPI.dll" name "TS_EndExecute";
|
||
function TSL_ScriptGo(L:pointer;Content:string;v:pointer):integer;cdecl;external "TSSVRAPI.dll" name "TSL_ScriptGo";
|
||
function TSL_InterpFreeLWrap(lWrap:pointer);cdecl;external "TSSVRAPI.dll" name "TSL_InterpFreeLWrap";
|
||
function TSL_InterpNewLWrap():pointer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TSL_InterpNewLWrap";
|
||
function TSL_NewObject():pointer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TSL_NewObject";
|
||
function TSL_InterpGetLFromWrap(L:pointer):pointer;cdecl;external "TSSVRAPI.dll" name "TSL_InterpGetLFromWrap";
|
||
function TS_GetGlobalL():pointer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetGlobalL";
|
||
function TSL_FreeObj(L:pointer;v:pointer);cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TSL_FreeObj";
|
||
//function TS_ModulePath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ModulePath";
|
||
//function TS_ExecPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ExecPath";
|
||
//function TS_GetAppPath():string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_ExecPath";
|
||
|
||
//function TS_GetIniPath(hometype:integer; var IniName:string):string;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TS_GetIniPath";
|
||
function TSL_Check(func:string;funclen:integer;oResult:pointer):integer;cdecl;external {$ifdef linux}"libTSSVRAPI.so"{$else}"TSSVRAPI.dll"{$endif} name "TSL_Check";
|
||
procedure tslprocessmessages();begin {echo "\r\n processmessage";}end;
|
||
function TS_GetUserProfileHome();
|
||
begin
|
||
return unit(utslvclauxiliary).TS_GetUserProfileHome();
|
||
|
||
end
|
||
function RunWorkerThreadLoop();
|
||
begin
|
||
class(TThreadWorker).dispatch();
|
||
end
|
||
//procedure ClearScriptCache();cdecl;external "TSLInterp.dll" name "ClearScriptCache";
|
||
|
||
function CreateDirWithFileName(fname);
|
||
begin
|
||
return unit(utslvclauxiliary).CreateDirWithFileName(fname);
|
||
end
|
||
|
||
function DeleteAllFiles(path);
|
||
begin
|
||
return unit(utslvclauxiliary).DeleteAllFiles(path);
|
||
end
|
||
|
||
function LoginTslServer(usr,pwd,addr,port);
|
||
begin
|
||
{**
|
||
@explan(说明) 登陆服务器 %%
|
||
@param(usr)(string) 用户名 %%
|
||
@param(pwd)(string) 密码 %%
|
||
@return(int) 1 成功 0 失败 %%
|
||
**}
|
||
if not(port>0)then port := 443;
|
||
if not(ifstring(addr))then addr := "tsl.tinysoft.com.cn";
|
||
if(CheckConnected()or(ConnectServer(addr,port)=0))then
|
||
begin
|
||
msg := "";
|
||
setlength(msg,200);
|
||
if(CheckLogined()or LoginServer(usr,pwd,msg)=0)then
|
||
begin
|
||
//messagebox("进入管理界面","登陆成功",1);
|
||
return 1;
|
||
end;
|
||
messageboxA(msg,"登陆失败",1);
|
||
return 0;
|
||
end else
|
||
begin
|
||
messageboxA("连接服务器失败","提示",1);
|
||
return 0;
|
||
end
|
||
return 0;
|
||
end
|
||
|
||
function GetCheckStruct();
|
||
begin
|
||
return new TCHECK_RESULT();
|
||
end
|
||
function CheckTslCode(code,err);
|
||
begin
|
||
{**
|
||
@explan(说明) tsl语法检查 %%
|
||
@param(code)(string) tsl代码 %%
|
||
@param(err)(string) 错误信息 %%
|
||
@return(bool)成功返回true %%
|
||
**}
|
||
if not ifstring(code)then
|
||
begin
|
||
err := "非字符串";
|
||
return false;
|
||
end
|
||
CheckInfo := static GetCheckStruct();
|
||
if TSL_Check(code,length(code),CheckInfo._getptr_)<> 1 then
|
||
begin
|
||
err := CheckInfo.errmsg;
|
||
return false;
|
||
end
|
||
return true;
|
||
end
|
||
function tslScriptGo(script);
|
||
begin
|
||
{**
|
||
@explan(说明)执行tsl脚本 %%
|
||
@param(script)(string) tsl语句 %%
|
||
@return(bool) 1表示成功; 1 失败 %%
|
||
@example(scriptgo-范例)
|
||
script := "
|
||
a := testabc();
|
||
echo a;
|
||
function testabc();
|
||
begin
|
||
return 10;
|
||
end
|
||
";
|
||
return tslScriptGo(script);
|
||
**}
|
||
ph := gettemppath();
|
||
name := ph+"tslpengt.tsl";
|
||
if ifstring(script)and script then
|
||
begin
|
||
tsexe := SysExecName();
|
||
FileDelete("",name);
|
||
writefile(rwraw(),"",name,0,length(script),script);
|
||
r := SysExec(tsexe,format('"%s" "%s"',tsexe,name),nil,0,r,nil);
|
||
end
|
||
return r;
|
||
lwrap := TSL_InterpNewLWrap();
|
||
L := TSL_InterpGetLFromWrap(lwrap);
|
||
//L := TS_GetGlobalL();
|
||
if ifstring(script)then
|
||
begin
|
||
v := TSL_NewObject();
|
||
ret := TSL_ScriptGo(L,script,v);
|
||
TSL_FreeObj(L,v);
|
||
end
|
||
//TSL_InterpFreeLWrap(lwrap);
|
||
return ret;
|
||
end
|
||
function version();
|
||
begin
|
||
{**
|
||
@explan(说明) 返回版本号 %%
|
||
@return(string) "主版本号.次版本号.修订号.日期版本号 "
|
||
**}
|
||
//return "1.1.0.20190929_beta";
|
||
//return "1.1.1.20200731_beta";
|
||
//return "1.1.2.20210915_beta";
|
||
//return "1.1.3.20220210_beta";
|
||
return "1.1.4.20220310_beta";
|
||
end
|
||
|
||
function ExitMessageLoop();
|
||
begin
|
||
{**
|
||
@expaln(说明)退出消息循环 %%
|
||
**}
|
||
WPI := gettswin32api();
|
||
return WPI.PostQuitMessage(0);
|
||
end
|
||
|
||
function SysExecWait(handle,exe,cmd,dir,fwait);
|
||
begin
|
||
{**
|
||
@explan(说明) 运行进程 %%
|
||
@param(handle)(pointer) 返回进程句柄,作为返回值 %%
|
||
@param(exe)(string) 执行程序 %%
|
||
@param(cmd)(string) 命令行参数 %%
|
||
@param(dir)(string) 目录 %%
|
||
@param(fwait)(bool) 是否强行等待,默认为false %%
|
||
**}
|
||
if fwait then
|
||
begin
|
||
handle := SysExec(exe,cmd,dir,1,r);
|
||
return r;
|
||
end
|
||
handle := SysExec(exe,cmd,dir,0,r);
|
||
FMSG := new TTagMSG();
|
||
msg := FMSG._getptr_;
|
||
WPI := gettswin32api();
|
||
while(handle) do
|
||
begin
|
||
{if (not WPI.GetMessageA(msg, 0, 0, 0)) then break;
|
||
WPI.TranslateMessage(msg);
|
||
WPI.DispatchMessageA(msg);}
|
||
//////////////////////////////////////////////////////
|
||
if(WPI.PeekMessageA(msg,0,0,0,0x1))then
|
||
begin
|
||
if FMSG.message=0x12 then
|
||
begin
|
||
break;
|
||
end else
|
||
begin
|
||
WPI.TranslateMessage(msg);
|
||
WPI.DispatchMessageA(msg);
|
||
end
|
||
end else
|
||
begin
|
||
tslprocessmessages(false);
|
||
RunWorkerThreadLoop();
|
||
WPI.WaitMessage();
|
||
end
|
||
////////////////////////////////////////////////
|
||
if not handle then break;
|
||
if not SysWaitForSingleObject(handle,5)then
|
||
begin
|
||
handle := 0;
|
||
return r;
|
||
end
|
||
end
|
||
return r;
|
||
end
|
||
function MessageBoxA(txt,title,flag,wnd);
|
||
begin
|
||
{**
|
||
@explan(说明) 提示对话框 %%
|
||
@param(txt)(string) 文本 %%
|
||
@param(title)(string) 标题 %%
|
||
@param(flag)(integer) 按钮类型 %%
|
||
@param(wnd)(twinControl) 父窗口 %%
|
||
@return(integer) 值 %%
|
||
**}
|
||
hd := 0;
|
||
if(wnd is class(TWincontrol))and wnd.HandleAllocated()then hd := wnd.Handle;
|
||
else if ifnumber(wnd)then hd := wnd;
|
||
return gettswin32api().MessageBoxA(hd,ifstring(txt)?txt:"",ifstring(title)?title:"",flag >= 0?flag:0);
|
||
end
|
||
function GetCurrentTslDir(); //获得tsl目录以\结尾
|
||
begin
|
||
p := pluginpath();iofp := ioFileseparator();
|
||
for i:= length(p)-1 downto 1 do
|
||
begin
|
||
if p[i]=iofp then
|
||
begin
|
||
return p[1:i];
|
||
end
|
||
end
|
||
end
|
||
function CopyUsedTslDllToNewDir(npre);
|
||
begin
|
||
{**
|
||
@explan(说明) 拷贝当前的tsl目录中使用的dll到指定目录%%
|
||
@param(npre)(string) 新的指定目录 %%
|
||
**}
|
||
if not ifstring(npre) then return false;
|
||
if not (length(npre)>2) then return false;
|
||
bpre := npre;
|
||
if npre[length(npre)]=ioFileseparator() then
|
||
begin
|
||
npre := npre[1:length(npre)-1];
|
||
end
|
||
pre1 := pre := GetCurrentTslDir();
|
||
lpre := length(pre);
|
||
app :=initializeapplication();
|
||
d := app._wapi.Toolhelp32Snapshotmodule();
|
||
pre := pre1;
|
||
for i,v in d do
|
||
begin
|
||
vi := v["szexepath"];
|
||
if pos(pre,vi) then
|
||
begin
|
||
fn := npre+vi[lpre:];
|
||
CreateDirWithFileName(fn);
|
||
FileCopy("",vi,"",fn,0);
|
||
end
|
||
end
|
||
npre := bpre;
|
||
return true;
|
||
end
|
||
|
||
////////////////////封装已经移动到其他库的接口为了兼容///////////
|
||
function TslToHexFormatStr(tsl);
|
||
begin
|
||
return unit(utslvclauxiliary).TslToHexFormatStr(tsl);
|
||
end
|
||
function HexFormatStrToTsl(D);
|
||
begin
|
||
return unit(utslvclauxiliary).HexFormatStrToTsl(d);
|
||
end
|
||
function GetTextWidthAndHeightWidthFont(s,f,mul);
|
||
begin
|
||
return unit(utslvclgdi).GetTextWidthAndHeightWidthFont(s,f,mul);
|
||
end
|
||
function CallMessgeFunction(f,o,e);
|
||
begin
|
||
return unit(utslvclauxiliary).CallMessgeFunction(f,o,e);
|
||
end
|
||
/////////////////////////初始化////////////////////////////////////
|
||
function initallib();
|
||
begin
|
||
class(tUIglobalData).uisetdata("G_F_CONTROL_IS_CUSTOMPAINT",thisfunction(controlisCustomPaint));
|
||
class(tUIglobalData).uisetdata("G_F_TWIN_PROC_",thisfunction(_twinproc_));
|
||
class(tUIglobalData).uisetdata("G_F_TIME_PROC_",thisfunction(_timeproc_));
|
||
class(tUIglobalData).uisetdata("G_T_TVCFORM_",class(TVCForm));
|
||
class(tUIglobalData).uisetdata("G_T_TTFM2COMPONET_",class(Ttfm2Component));
|
||
class(tUIglobalData).uisetdata("TGlobalComponentcache",class(TGlobalComponentcache));
|
||
class(tUIglobalData).uisetdata("TGlobalValues",class(TGlobalValues));
|
||
class(TRegKey).sinit(); //初始化reg注册表
|
||
//导入注册的componet
|
||
vclini := pluginpath()+"tslvcl.ini";
|
||
if fileexists("",vclini) then
|
||
begin
|
||
ini := new TIniFileExta("",vclini);
|
||
ini.LowerKey := true;
|
||
for i,v in ini.ReadSectionValues("components") do //控件
|
||
begin
|
||
if v then
|
||
begin
|
||
cv := findclass(v);
|
||
if cv then
|
||
begin
|
||
RegisterComponentType(i,cv);
|
||
end
|
||
end
|
||
end
|
||
for i,v in ini.ReadSectionValues("propertys") do //属性
|
||
begin
|
||
if v then
|
||
begin
|
||
cv := findclass(v);
|
||
if cv then
|
||
begin
|
||
RegComponentPropertyType(createobject(cv));
|
||
end
|
||
end
|
||
end
|
||
end
|
||
|
||
end
|
||
function initlib();
|
||
begin
|
||
{**
|
||
@explan(说明) 初始化lib %%
|
||
**}
|
||
a := static initallib();
|
||
end
|
||
|
||
Initialization
|
||
initlib();
|
||
Finalization
|
||
end.
|