tslediter/designer/utslvcldesigner.tsf

2098 lines
64 KiB
Plaintext

unit utslvclDesigner;
{**
@explan(说明)设计器库 %%
**}
interface
uses utslvcldesignerresource,cstructurelib,utslvclauxiliary,utslvclbase,
utslvclgdi,utslvcldcomponents,utslvcldpropertytypes,tslvcl,
UVCPropertyTypesPersistence,utslmemo,UDesignerProject;
//*******设计控件基类**********************
//**********设计控件类************
type TVclDesigner = class(tvcform)
{**
@explan(说明) 控件设计器 对象 %%
**}
private
Foh ;
fcwindowinfo; //当前窗口文件对象
fwindowinfos; //窗口文件节点存储对象
fcutcopyinfo;//复制的信息
FChmHelper; //帮助文档
fdimagelist; //图标
FViewBitmap; //图片管理器
fmgr_ctl;//控件管理
FVariableSelecter; //当前控件树的变量
FFunctionSelecter; //当前控件树的函数
//**********菜单***************
FMenu0; //主菜单
//********************************
FToolBars; //控件工具栏
FTree; //当前的树
FObjInspector; //控件树展示器
FPropGrid; //控件属性grid
FEventGrid; //控件事件grid
//************************************
fselctlnode;
FCurrentClikPos;
FComponentCreater;
FRounMenu;
FStopMenu;
FProjectsManager;
FProjectManager;
//***************************
function WrapProjectTo(); //打包当前
begin
FProjectManager.WrapTo();
end
function OpenProjectFromtpj(); //工程选择
begin
SetWndPostWithMouse(FProjectsManager);
FProjectsManager.Show();
return ;
end
function ShowProjectView(o,e); //工程文件打开
begin
FProjectManager.visible := not FProjectManager.visible;
if o then
begin
FProjectManager._tag := o;
o.Checked := FProjectManager.visible;
end
//FProjectManager.show();
end
function addtoolbuttons();//添加工具栏
begin
{**
@explan(说明)添加工具栏 %%
**}
for i,v in class(TDComponent).GetClassItem() do
begin
addaboolbutton(v);
end
end
function addaboolbutton(v);
begin
fdimagelist.RegisterDitem(v);
//if not v.InToolBar() then continue;
tb := new TToolButton(self);
tb.caption := v.HitTip;
tb.Enabled := v.InToolBar();
ig := fdimagelist.GetImageId(V.dclassname);
tb.imageid := ig;
v.Imgs := ig;
tb._tag := v;
tb.onclick := thisfunction(OnToolButtonCick);
FToolBars.addbtn(tb,v.classification);
end
function delttolbutton(n);
begin
FToolBars.delbtn(n);
end
function calcheight(twidth); //高度计算
begin
//extheight := CaptionHeight()+MenuBarHeight();
clc := array();
for i,v in class(TDComponent).GetClassItem() do
begin
cli := v.classification;
if not(cli and ifstring(cli)) then cli := "常用";
if ifnil(clc[cli]) then clc[cli] := 0;
clc[cli]+=1;
end
mx := 0;
for i,v in clc do mx := max(mx,v);
height := (integer(mx*32/twidth)+1)*32+60+30{+24}+5;
end
function TreeNode2tfmsub(lib,node,itemnames,nd);//tmf文件字符串
begin
if not(node) then
begin
tr := ftree;
if nd then
begin
tr := fwindowinfos.gettreebyid(nd);
end
if not tr then return ;
it := tr.RootItem;
node := (it.items)[0];
ifnit := true;
end
if not ifarray(itemnames) then itemnames := array();
if not ifarray(lib) then lib := array();
if not node then exit;
tc := node.Component;
wlibs := tc.libs();
tlibs := array();
for i,v in wlibs do if v and ifstring(v) then tlibs[length(tlibs)] := lowercase(v);
tclib := lowercase(tc.libs());
lib union2= tlibs;
r := "";
tab := " ";
if tc is class(TDComponent) then
begin
tcname := tc.name;
tcclassname := tc.dclassname;
if not(tcclassname and tcname and ifstring(tcname) and ifstring(tcclassname)) then raise "错误!";
oorinh := (tc.isinherited)?"inherited ":"object ";
ihp := "";
if tc.isinherited then
begin
if ifstring(tc.inheritedparent) then
begin
ihp := "("+tc.inheritedparent+")";
end
end
r+= oorinh + tcname +":"+tcclassname+ihp+"\r\n";
itemnames[length(itemnames)] := array(tcname,tcclassname);
cr := tc.GetChangedPublish();
for i,v in cr do
begin
if not(v and ifstring(i) and ifstring(v) ) then continue; //严格判断
r+=tab;
r+= i + "=" + v +"\r\n";
end
for i := 0 to node.ItemCount-1 do
begin
r += tablelines( TreeNode2tfmsub(lib,(node.items)[i],itemnames),tab);
end
r += "end";
end
return r;
//GetChangedPublish
end
function DeletComponent(comp); //删除控件
begin
if comp is class(TDComponent) then
begin
DeleteNode(comp.TreeNode);
end
end
function DeleteNode(node); //删除节点
begin
if node Is class(TComponentTreeNode) then
begin
comp := node.Component;
node.Recycling(); //销毁节点
if comp is class(TDComponent) then //销毁节点对应控件
begin
wd := comp.Cwnd;
if wd is class(TComponent) then wd.Recycling();
end
end
end
function createmainmenubyarray(ms,pm,oer); //构造菜单
begin
if not(ifarray(ms) and ms) then exit;
if ms["type"]="menu" then
begin
if not pm then pm := new TMainmenu(oer);
if ifstring(ms["caption"]) then
begin
mu := new tmenu(oer);
mu.caption := ms["caption"];
o := ms["onclick"];
mu.onclick := ms["onclick"];
mu.parent := pm;
if ms["checked"] =1 then
begin
mu.Checked := true;
end
field := ms["filed"];
if ms["checked"]=true then
begin
mu.Checked := true;
end else
begin
bp := ms["bitmap"];
if bp and ifstring(bp) then
begin
bpp := new tbitmap();
bpp.Readvcon(HexFormatStrToTsl( bp));
mu.bitmap := bpp;
end
end
if ms["enabled"]=0 then
begin
mu.Enabled := false;
end
if ifstring(field) then
begin
try
invoke(oer,lowercase(field),1,mu);
except
end ;
end
call(thisfunction,ms["items"],mu,oer);
end
end
else for i,v in ms do
begin
call(thisfunction,v,pm,oer);
end
end
public //复制粘贴
function copynode(node); //复制
begin
fcutcopyinfo := getnodeinfodata(node);
end
function cutnode(node); //剪切节点
begin
fcutcopyinfo := getnodeinfodata(node);
fcutcopyinfo[2] := true;
end
function pasttonode(nd);//粘贴节点
begin
if not fcutcopyinfo then return ;
ifc := fcutcopyinfo[2];
r := pastinfotonode(nd,fcutcopyinfo,1,not(ifc));
if ifc and not(r) then fcutcopyinfo := nil; //如果失败就不清除内容
end
function pastinfotonode(nd,data,fst,notcute); //粘贴节点
begin
tc := data[0];
if ifstring(tc) then tc := class(TDComponent).GetClassItem(tc);
if (tc is class(TDRootComponent)) and not( tc is class(TDMenu)) then
begin
tr := nd.owner;
nd := (tr.RootItem.items)[0];
end
pwnd := nd.Component.Cwnd;
nnd := tc.ComponentCreater(nd,pwnd);
if not nnd then return 1; //加入失败处理
nnd.CreateName();
FVariableSelecter.additem(nnd);
BindCwndMessage(nnd.Cwnd);
if fst and (pwnd is class(TWinControl)) then
pclt := pwnd.ClientRect; //获得父节点区域
for i,v in data do
begin
vi := v;
if not ifstring(i) then continue;
///////////////////////
if pclt and ( (i = "left") or (i= "top") ) then //特殊位置处理
begin
if notcute then //复制
begin
vi+=6;
end
pidx := 2;
if i = "top" then pidx := 3 ; //位置判断
if vi>pclt[pidx] then
begin
vi := integer(pclt[pidx]+(pclt[pidx-2]/2)-10); //位置处理
end
end
nnd.SetComponentProperties(i,vi);
end
for i,v in data[1] do
begin
pastinfotonode(nnd.TreeNode,v);
end
end
function getnodeinfodata(node); //复制节点信息
begin
tc := node.Component;
r := array();
if tc is class(TDComponent) then
begin
r[0] := tc.dclassname() ;
cr := tc.GetChangedPublish(2);
for i,v in cr do
begin
if not(v and ifstring(i) ) then continue; //严格判断
r[i] := v;
end
for i := 0 to node.ItemCount-1 do
begin
r[1,i] := getnodeinfodata((node.items)[i]);//
end
end
return r;
end
public //设计器工程
ffilemenu;
fviewmenu;
function OpenFileFromTpjFile(); //从文件打开工程
begin
FProjectFileOpener.caption := "打开";
if FProjectFileOpener.OpenDlg() then
begin
f := FProjectFileOpener.FileName;
FProjectsManager.OpenFileFromTpjFile(f);
fio := ioFileseparator();
for i := length(f) downto 2 do
begin
if f[i]=fio then
begin
FProjectFileOpener.initialDir := f[1:(i-1)];
break;
end
end
end
end
function OpenExaple();
begin
FProjectFileOpener.caption := "打开范例....";
f := 0;// tslfilename();
fio := ioFileseparator();
if f then
begin
for i := length(f) downto 2 do
begin
if f[i]=fio then
begin
ef := f[1:i]+"examples";
if filelist("",ef) then
begin
FProjectFileOpener.initialDir := ef;
end
else
begin
FProjectFileOpener.initialDir := f[1:(i-1)];
end
break;
end
end
end else
begin
f := sysexecname();
for i := length(f) downto 3 do
begin
if f[i]=fio then
begin
ef := f[1:i]+"d_examples";
if filelist("",ef) then
begin
FProjectFileOpener.initialDir := ef;
end
else
begin
return messageboxa("examples not exists!","提示",0,self);
//FProjectFileOpener.initialDir := f[1:(i-1)];
end
break;
end
end
end
if FProjectFileOpener.OpenDlg() then
begin
//echo ,"\r\n";
FProjectsManager.OpenFileFromTpjFile(FProjectFileOpener.FileName);
end
end
function CreateTpjFomFile();//新建工程
begin
FProjectFileOpener.caption := "新建";
if FProjectFileOpener.OpenDlg() then
begin
f := FProjectFileOpener.FileName;
if parseregexpr(".tpj$",f,"",pp1,pp2,pp3)<>1 then f+=".tpj";
FProjectsManager.CreateTpjFomFile(f);
end
end
function WMSYSCOMMAND(o,e);override;
begin
case e.wparam of
SC_MAXIMIZE:
begin
Foh := o.height;
_send_(WM_USER,123,123,1);
return ;
end
SC_MINIMIZE:
begin
e.skip := true;
return ;
end
SC_DEFAULT:
begin
end
SC_ZOOM:
begin
end
SC_MOUSEMENU:
begin
end
SC_RESTORE:
begin
end
end;
return ;
return inherited;
end
function db(o,e): WM_NCLBUTTONDBLCLK;virtual;//最大化处理
begin
//e.skip := true;
Foh := o.height;
_send_(WM_USER,123,123,1);
end
function WMUSER(o,e):WM_USER;override;
begin
if e.wparam = 123 and e.lparam=123 then
begin
if o.height>Foh then
begin
o.height := Foh; //gtk 逻辑正确但是设置无效
end
end
end
function openclassfile(); //打开编辑器
begin
FProjectManager.ShowCurrentFormCode();//ShowEditor();
end
function opentfm(); //打开资源文件
begin
FProjectManager.ShowCurrenttfm();
end
function TreeNode2tfm(lib,itemnames,nd); //转换文件
begin
{**
@explan(说明) 将结构转换为文件格式 %%
**}
r := TreeNode2tfmsub(lib,nil,itemnames,nd);
if itemnames then itemnames := itemnames[1:];
return r;
end
function saveCurrentForm(); //保存当前编辑
begin
FProjectManager.saveCurrentEdit();
end
function mainmenus(); //设计器菜单
begin
{**
@explan(说明) 菜单
**}
return array(
("type":"menu","caption":"文件","filed":"ffilemenu","onclick",nil,"items":(
("type":"menu","caption":"保存","onclick":thisfunction(saveCurrentForm),
"bitmap":getsaveallbitmapinfo()),
("type":"menu","caption":"代码编辑","onclick":thisfunction(openclassfile),
"bitmap":geteditcodebitmapinfo())
)),
("type":"menu","caption":"视图","filed":"fviewmenu","items":(
("type":"menu","caption":"工程文件管理","checked":1,"bitmap":GetWindowMgrBmp(),"onclick":thisfunction(ShowProjectView)),
("type":"menu","caption":"对象浏览","checked":true,"onclick":thisfunction(Mobjinspect),
"bitmap":getdefaultbmpinfo())
)),
("type":"menu","caption":"工程","items":(
("type":"menu","caption":"打开工程","onclick":thisfunction(OpenFileFromTpjFile),
"bitmap":GetOpenFileBitmapInfo()),
("type":"menu","caption":"新建工程","onclick":thisfunction(CreateTpjFomFile),
"bitmap":getcreateprojectbmpinfo()),
("type":"menu","caption":"打开历史","onclick":thisfunction(OpenProjectFromtpj),
"bitmap":GetHostroyBimp()),
("type":"menu","caption":"编译工程","onclick":thisfunction(WrapProjectTo),"bitmap":getwrapprojectbmpinfo())
)
),
("type":"menu","caption":"运行","items":(
("type":"menu","caption":"配置命令行","onclick":thisfunction(editcommandline)),
//{$ifdef linux}
//("type":"menu","caption":"运行","onclick":thisfunction(RunProject),"filed":"FRounMenu","bitmap":getrunbmpinfo()),
//("type":"menu","caption":"停止","onclick":thisfunction(StopProject),"enabled":false,"filed":"FStopMenu","bitmap":getstopbmpinfo()),
//{$else}
("type":"menu","caption":"运行","bitmap":getdbugcontinuebmpinfo(),"onclick":thisfunction( debugproject)), //之前的调试运行
//{$endif}
)),
("type":"menu","caption":"工具","items":(
("type":"menu","caption":"控件管理","checked":0,"onclick":thisfunction(mgr_control)),
("type":"menu","caption":"打开图片","checked":0,"onclick":thisfunction(ViewBitmap)),
("type":"menu","caption":"编辑器颜色","checked":0,"onclick":thisfunction(showhltcolor))
)),
("type":"menu","caption":"帮助","items":(
("type":"menu","caption":"关于","onclick":thisfunction(openabout)),
("type":"menu","caption":"使用手册","onclick":thisfunction(OpenHelp),
"bitmap":getmanubmpinfo()),
("type":"menu","caption":"控件详情","onclick":thisfunction(OpenHelp),
"bitmap":getctlsbmpinfo()),
("type":"menu","caption":"范例..","onclick":thisfunction(OpenExaple),
"bitmap":getexamplesbmpinfo())
),
)
);
end
public //编辑器中代码操作
function DeleFiledFromEdit(n,nn); //删除变量
begin
if FTree.Loading then return ;
FProjectManager.DeleteAFiled(n,nn);
end
function AddFiledFromEdit(n); //添加变量
begin
if FTree.Loading then return ;
FProjectManager.AddAFiled(n);
end
function AddusesFromEdit(lbs); //添加uses
begin
if FTree.Loading then return ;
FProjectManager.adduses(lbs);
end
function EditerCodeChanged(nd); //代码改变
begin
if FTree.Loading then return ;
classinfo := FProjectManager.GetFormClassInfo(nd);
if classinfo and ifarray(classinfo) then
begin
class(TDComponent).TemporaryNotName := classinfo["members"];
SetFunctionList(classinfo["funcs"]);
end
end
function LoadProject(n); //当如工程
begin
FProjectManager.SetProjectInfo(n);
end
private //设计器控件的事件响应
function tablelines(str,n);
begin
lines := str2array(str,"\r\n");
r := "";
for i,v in lines do
begin
if not v then continue;
r+=n;
r+= v;
r+="\r\n";
end
return r;
end
function openabout(o,e);
begin
return messageboxa(static editerinfo(),"关于",0,self.Handle);
end
function editerinfo();
begin
s := "tsl语言界面设计器\r\n版本:1.0.0\r\n日期:2023-01-19";
sc := get_resource_by_name("vcldesigner.tsl.about");
if sc then return sc;
f := tslfilename()+".about";
if fileexists("",f) then
begin
size := filesize("",f);
if readFile(rwraw(),"",f,0,size,data) then
begin
return data;
end
end
return s;
end
function OpenHelp(o,e); //打开帮助
begin
if not FChmHelper then
begin
FChmHelper := new unit(UtslCodeEditor).TTslChmHelp();
end
case o.caption of
"使用手册":
begin
FChmHelper.ChmName := "help\\designerUserGuid.CHM";
// p := "C:\\Program Files\\Tinysoft\\Analyse.NETplug\\help\\designerUserGuid.pdf" ;//pluginpath()+"..\\help\\designerUserGuid.pdf";
//_wapi.WinExec(format('cmd.exe /C call "start %s"',p),0); //http://bzjj.sinaapp.com/tslvclhelp/index.html
//_wapi.WinExec(format('start "%s"',p),0);
//_wapi.WinExec('cmd.exe /C start http://bzjj.sinaapp.com/tslvclhelp/index.html',0);
//_wapi.WinExec('cmd.exe /C "start http://bzjj.sinaapp.com/tvcldesignerhelp/tvcldesigner.pdf"',0);
end
"常用控件":
begin
FChmHelper.ChmName := "help\\vclNormalControls.CHM";
end
"控件详情":
begin
FChmHelper.ChmName := "help\\tslvclhelp.chm";
end
end
FChmHelper.ShowTslLangChm();
//_wapi.WinExec('cmd.exe /C start http://bzjj.sinaapp.com/tslvclhelp/index.html',0);
end
function ComponentMove(o,e); //控件移动
begin
{**
@explan(说明) 移动 控件 %%
**}
//setcomponentfocus(o,false);
l := O.left;
r := o.top;
if not FPropGrid.SetGridValue("left",l,O) then o.setpublish("left",l);
if not FPropGrid.SetGridValue("top",r,O) then o.setpublish("top",r);
if o.WsPopUp then return ;
p := o.parent;
if p then
p.Invalidaterect(nil,0);
end
function ComponentSize(o,e);//大小改变
begin
{**
@explan(说明) 调整控件大小 %%
**}
w := o.width;
h := o.height;
if not FPropGrid.SetGridValue("width",w,O) then o.setpublish("width",w);
if not FPropGrid.SetGridValue("height",h,O) then o.setpublish("height",h);
if o.WsPopUp then return ;
p := o.parent;
if p then
p.Invalidaterect(nil,0);
//setcomponentfocus(o,false);
end
function DesignerClose(o,e) //控件窗口关闭
begin
{**
@explan(说明)保存 %%
**}
if _wapi.MessageBoxA(self.Handle,"退出应用","提示", MB_YESNO.| MB_ICONWARNING) = IDNO then
begin
e.skip := true;
end
else
begin //工程处理
FProjectManager.StopProject();
FProjectManager.CloseCurrentEdit("all");
end
end
function CompClose(o,e); //隐藏控件
begin
{**
@explan(说明) 控件关闭 %%
**}
e.skip := true;
end
function OnDesignerActivate(o,e);
begin
{**
@explan(说明) 设计器被激活 %%
**}
return ;
if e.wparam = WA_CLICKACTIVE then
begin
end
end
public //控件选中
//****************************************
function CreateComponent(); //构造控件
begin
{**
@explan(说明) 构造组件 %%
@return (TDComponent)
**}
if FComponentCreater and fselctlnode and FCurrentClikPos then
begin
par := fselctlnode.Component.Cwnd;
r := FComponentCreater.ComponentCreater(fselctlnode,par);
if not r then exit;
//////////////////////////////////////////
//npar := par;
//while not(npar.WsPopUp) do
//begin
// npar := par.parent;
//end
//FProjectManager.hiddeneditor(npar.BoundsRect);//此处隐藏编辑器
////////////////////////////////////////////////
global g_script_can_set_not_focus;
g_script_can_set_not_focus := true;
r.CreateName();
FVariableSelecter.additem(r);
BindCwndMessage(r.Cwnd);
if ifarray(FCurrentClikPos) and (r.Cwnd is class(TControl)) then
begin
if r.Cwnd.Align<>alnone then
begin
//par.DoControlAlign();
end else
begin
x := FCurrentClikPos[0];
y := FCurrentClikPos[1];
if r.Cwnd is class(TControl) then
begin
if ifnumber(x) then r.Cwnd.left := x;
if ifnumber(y) then r.Cwnd.top := y;
end
end
end
FTree.SetSel(r.TreeNode);
end
FCurrentClikPos := nil;
FComponentCreater := nil;
fselctlnode := nil;
FTree.PopupMenu := nil;
//echo "\r\n 添加控件";
g_script_can_set_not_focus := false;
return r;
end
function setcomponentfocus(cwnd,fk); //设置获得选中
begin
{**
@explan(说明) 设计控件获得焦点 %%
**}
if not(cwnd is class(TWincontrol)) then exit ;
if not cwnd.HandleAllocated() then exit;
return cwnd.DesigningSelect(fk);
end
function TreeNodeSelected(n); //控件树选中节点
begin
{**
@explan(说明) 节点被选择 %%
@param(n)(TComponentTreeNode) 被选择节点 %%
**}
if fselctlnode=n then exit;
fselctlnode := n;
if not ifobj(n) then exit;
t := n.Component;
if not t then exit;
mu := t.CreateMenu();
n.owner.PopupMenu := mu;
FPropGrid.Component := t;
FEventGrid.Component := t;
wd := t.cwnd ;
setcomponentfocus(wd,true);
return t.SelectedNode();
end
private //右键菜单处理
function RClickComponent(o,e); //右键控件窗口
begin
{**
@explan(说明)右键菜单 %%
**}
nd := o._tag;
tr := nd.owner;
if not(tr.visible) then
begin
wnd := fwindowinfos.getnodebytree(tr);
FProjectManager.setnodesel(wnd);
return ;//
end
if fselctlnode<>nd then
begin
nd.owner.SetSel(nd);
TreeNodeSelected(nd);
end
cp := nd.Component;
if cp then
begin
mu := cp.CreateMenu();
if mu then
begin
//直接将弹出菜单赋值给控件,修正gtk窗口焦点导致弹出菜单的问题
cwnd := cp.Cwnd;
cwnd.PopupMenu := mu;
xy := o.ClientToScreen(e.lolparamsigned,e.hilparamsigned);
_send_(WM_CONTEXTMENU,cwnd.handle,makeposition(xy[0],xy[1]),1);
return ;
uf := TPM_LEFTALIGN .| TPM_TOPALIGN .| TPM_RIGHTBUTTON;
_wapi.TrackPopupMenu(mu.Handle,uf,xy[0],xy[1],0,self.Handle,nil);
end
end
end
//FClickTime;
public //双击添加事件到代码
function addandopeneventbyname(nd,n); //打开事件函数位置
begin
if nd then
begin
cp := nd.Component;
if cp then
begin
pe := cp.GetPublishEvents();
if ifstring(n) and n then
begin
de := cp.geteventfunctionbyname(n);
end else
de := cp.DefaultEvent;
if ifarray(de) and de then
begin
dei := de["event"];
dvs := pe[dei];
if ifarray(dvs) then
begin
dv := dvs["value"];
if not dv then
begin
td := de;
td["name"] := cp.Name+"_"+td["name"];
if FProjectManager.AddAFunction(td) then
begin
FEventGrid.SetGridValue(dei,td["name"],cp.Cwnd);
FProjectManager.GoToAFunction(td["name"]);
return ;
end
end else
begin
FProjectManager.GoToAFunction(dv);
return ;
end
end
end
end
end
FProjectManager.ShowEditor();
end
function AddAndOPenEvent(nd); //打开事件函数
begin
{**
@explan(说明)通过节点打开函数编辑器 %%
**}
addandopeneventbyname(nd,n);
end
function DBLClickComponent(o,e);//双击组件
begin
{**
@explan(说明) 组件被双击 %%
**}
if o then AddAndOPenEvent(o._tag);
if e then e.skip := true;
end
private //节点点击
factivatedonging;
function windowactive(o,e);
begin
if e.wparam then
begin
o1 := o;
if fselctlnode then
begin
wd := fselctlnode.Component.Cwnd;
wd1 := wd;
while wd1 do
begin
if wd1 = o then
begin
factivatedonging := true;
ClickComponent(wd,e);
factivatedonging := false;
return ;
end
wd1 := wd1.parent;
end
end
factivatedonging := true;
ClickComponent(o,e);
factivatedonging := false;
end
end
function ClickComponent(o,e); //点击组件选择
begin
{**
@explan(说明) 组件被点击 %%
**}
nd := o._tag;
tr := nd.owner;
if not(tr.visible) then
begin
wnd := fwindowinfos.getnodebytree(tr);
FProjectManager.setnodesel(wnd);
return ;//
end
if fselctlnode<> nd then
begin
//wd := o;//nd.Component.Cwnd;
//if wd is class(TWincontrol) then _wapi.BringWindowToTop(wd.Handle);
tr.SetSel(nd);
TreeNodeSelected(nd);
end;
setcomponentfocus(o,true);
if factivatedonging then return ;
if FComponentCreater and fselctlnode then
begin
//SetSysParam("cpos_screan",array(e.lolparam,e.hilparam));
if FComponentCreater is class(TDRootComponent) then
begin
fselctlnode := (tr.RootItem.items)[0];
if not fselctlnode then return FComponentCreater := nil;
//O1 := fselctlnode.Component.Cwnd;
//if not o1 then return FComponentCreater := nil;
end
//else o1 := o;
xy := array(0,0);
_wapi.GetCursorPos(xy);
FCurrentClikPos := o.ScreenToClient(xy[0],xy[1]);
//FCurrentClikPos := array(e.lolparam,e.hilparam);//o1.screentoclient(e.lolparam,e.hilparam);
r := CreateComponent();
FComponentCreater := nil;
if not r then return MessageBoxA("控件放置位置不兼容!","提示",0,self);
o1 := r.Cwnd;
o1.setpublish("left",o1.left,nil);
o1.setpublish("top",o1.top,nil);
end
return ;
end
function ClickTreeNode(o,e);//点击树选择
begin
{**
@explan(说明) 通过点击选择节点 %%
**}
od := e.itemold;
if od then
begin
cp := od.Component;
if cp then
begin
setcomponentfocus(cp.Cwnd,false);
end
end
TreeNodeSelected(e.item);
end
function SpectorClose(o,e);//objectspector 关闭
begin
{**
@explan(说明) 目录树关闭 %%
**}
e.skip := true;
o.visible := false;
if o._Tag is class(tmenu) then o._tag.Checked := false;
end
function OnToolButtonCick(o,e); //工具按钮被点击
begin
{**
@explan(说明) 选择工具按钮 %%
**}
cct := o._tag;
FComponentCreater := cct;
end
function CloseShowForm(o,e); //主窗口关闭
begin
{**
@explan(说明)关闭当前工程窗口%%
**}
FProjectManager.CloseCurrentEdit(nil,true);
end
public //设计器中绑定事件
function BindCwndMessage(wnd); //给控件绑定处理函数
begin
{**
@explan(说明) 为控件添加事件 %%
**}
if wnd is class(tmenu) then wnd.OnDesignClick := thisfunction(ClickComponent);
if wnd is class(TWincontrol) then
begin
wnd.OnDesignClick := thisfunction(ClickComponent);
wnd.OnDesigndblClick := thisfunction(DBLClickComponent);
wnd.OnDesignrClick := thisfunction(RClickComponent);
wnd.onmove := thisfunction(ComponentMove);
wnd.onsize := thisfunction(ComponentSize);
//wnd.Onclose := thisfunction(CompClose); //只是忽略
wnd.Onclose := function(o,e)begin
e.skip := true;
CloseShowForm(); //并保存窗口信息
end ;
//wnd.bindmessage(wnd.WM_NCLBUTTONDOWN,thisfunction(ClickComponent));
wnd.bindmessage(wnd.WM_ACTIVATE,thisfunction(windowactive));
//WM_NCLBUTTONUP wnd.
if (wnd is class(TVCForm)) then
begin
wnd.OnMinimize := thisfunction(CompClose);
end
end
end
function isloadednode(wndnode);
begin
return fwindowinfos.getdata(wndnode);
end
function UnLoadTreeNode(wndnode); //卸载控件树
begin
{**
@explan(说明) 卸载tree的节点%%
**}
nd := fwindowinfos.getdata(wndnode);
if not nd then return ;
hidenatree(nd);
tr := nd.ftree;
node := tr.RootItem;
if node.ItemCount>0 then
begin
DeleteNode((Node.items)[0]);
end
fwindowinfos.deletedata(wndnode);
tr.Recycling();
end
private //不同窗口切换
function hidenatree(nd);//隐藏控件树
begin
fselctlnode := nil;
if nd then
begin
tr := nd.ftree;
tr.visible := false;
nd.fvars := FVariableSelecter.getlistds();
nd.fcomp := FEventGrid.Component;
FEventGrid.Component := array();
FPropGrid.Component := array();
nd.ffuncs := FFunctionSelecter.List.data;
nd.fnames := class(TDComponent).TemporaryNotName;
class(TDComponent).TemporaryNotName:= array();
end
end
function showtree(nd); //显示控件树
begin
fselctlnode := nil;
tr := nd.ftree;
tr.visible := false;
FTree.visible := true;
FVariableSelecter.setlistds(nd.fvars);
FFunctionSelecter.additems(nd.ffuncs);
class(TDComponent).TemporaryNotName := nd.fnames;
FPropGrid.Component := nd.fcomp ;
FEventGrid.Component := nd.fcomp ;
end
function showcurrent();
begin
nd := fcwindowinfo;
if nd then
begin
FTree := fcwindowinfo.ftree;
nnd := FTree.RootItem.GetNodeByIndex(0);
if nnd then
begin
cp := nnd.Component;
if cp then
begin
wd := cp.Cwnd;
if wd.visible then
begin
_wapi.SetActiveWindow(wd.Handle);
end
end
end
end
end
function switchtree(nd); //切换控件树
begin
fselctlnode := nil;
if nd<>fcwindowinfo then
begin
if fcwindowinfo then //处理就有的
begin
hidenatree(fcwindowinfo);
end
fcwindowinfo := nd;
if nd then
begin
FTree := fcwindowinfo.ftree;
showtree(fcwindowinfo);
if not(nd.fclk) then //不在最上层处理一下
begin
nnd := FTree.RootItem.GetNodeByIndex(0);
if nnd then
begin
cp := nnd.Component;
if cp then
begin
wd := cp.Cwnd;
if wd.visible then
begin
//wd.visible := false;
//wd.visible := true;
_wapi.SetActiveWindow(wd.Handle);
end
end
end
end
nd.fclk := false;
end
end
end
public //类型注册相关
function addexttypeclass(info);//注册额外的类
begin
addextdtypeclass(info["dclassname"],info["dclassbody"]); //添加容器类
addexttypeclasstoini(info["name"],info["dclassname"]);//添加ini文件
fwilladdclasstype := info["dclassname"];
fwilladdclass := info["name"];
dc := findclass(fwilladdclasstype);
if not dc then return ;
addexttypeclasscomp(dc);
it := class(TDComponent).GetClassItemext(fwilladdclass);
if not it then return ;
addaboolbutton(it);
//name
//class
//dclassbody
//添加类型
//添加工具栏
end
function delexttypeclass(n);//删除注册类
begin
delexttypeclassini(n);//移除ini文件
delexttypeclasscomp(n);//移除类型
delttolbutton(n);//移除工具栏
end
function getexttypeclass(n);//获得注册类列表
begin
r:= class(TDComponent).GetClassItemext(n);
return r;
end
public //加载以及处理
function ExecuteCommand(cmd,p);override;
begin
case cmd of
"imglist":
begin
return fdimagelist;
end
"allopendnod":
begin
r := array();
for i,v in fwindowinfos.fdata.data do
begin
r[i] := v.fnode;
end
return r;
end
"shownode":
begin
showcurrent();
end
"hiddrennode":
begin
hidenatree(fcwindowinfo);
fcwindowinfo := nil;
end
"renamefile": //修改名字
begin
node := FTree.RootItem;
nnd := node.GetNodeByIndex(0);
if nnd then
begin
nnd.Component.dclassname(p);
cp := nnd.caption;
pidx := pos(":",cp);
if pidx then cp[pidx:] := ":"+p;
nnd.caption := cp;
end
end
else
return inherited;
end ;
end
function LoadTreeNode(Ptfm,inh,wndnode);//加载控件树
begin
{**
@explan(说明) 加载tree节点 %%
**}
if FTree and FTree.Loading then return ;
cwindowinfo := fwindowinfos.getorcreate(wndnode,ifold);
if cwindowinfo = fcwindowinfo then
begin
return ;//重复导入
end
switchtree(cwindowinfo);
//处理新的
if ifold then
begin
return ;//
end
FTree.Loading := true;
try
prs := array();
obarray := array();
loadtfmtotree(Ptfm,Ptfm.gettree2,FTree.RootItem,FTree,prs,obarray,const inh,1);
for i,v in prs do
begin
va := obarray[v[2]];
if va then
begin
v[0].SetComponentProperties(v[1],va.GetTrueComponent(),v[3]);
end
end
except
end ;
FTree.Loading := nil;
end
function loadtfmtotree(p,d,node,wr,prs,obarray,inhname,first);//当如信息
begin
{**
@explan(说明) 导入tfm文件 %%
**}
if not ifarray(d) then exit;
if not d["type"]=p.TT_COMP then exit;
dcls := d["class"];
it := class(TDComponent).GetClassItem(dcls);
if not it then
begin
if ("tdcreateform" in inhname) then
begin
it := NEW TDForm();
end else
if "tdcreatepanel" in inhname then
begin
it := new TDPanelForm();
end else return ;
it.dclassname(d["class"]);
it.Imgs := fdimagelist.GetImageId("tdcreateform");
end
comp := it.ComponentCreater(node,wr);
if first then comp.Cwnd.Handle;
comp.isinherited := d["inherited"];
comp.inheritedparent := d["parent"];
comp.name := d["name"];
obarray[d["name"]] := comp;
FVariableSelecter.additem(comp);
//BindCwndMessage(comp.Cwnd);
pubs := comp.GetPublishProperties() union comp.GetPublishEvents();
dprop := d["property"];
ddp := array();
for i,v in dprop do
begin
ddp[v["name"]] :=v;
end
if comp.DefaultAlign() then
begin
if ifarray(ddp["align"]) and (ddp["align"]["value"]="alnone") then
begin
comp.Cwnd.align := alnone;
end
end
lazy := array();
for i,v in pubs do
begin
n := i;
ddpv := ddp[n];
if not ifarray(ddpv) then continue;
cls := v["class"];
et := GetComponentPropertyType(cls);//GetPropertyType(cls);
if not et then continue;
pp := ddpv["pp"];
setddpv := et.TmfToNode(p.SampleValue(ddpv));
if et.IfComponent() then
begin
prs[length(prs)]:= array(comp,n,setddpv,pp);
continue;
end
if et.LazyProperty() then
begin
lazy[length(lazy)] := array(n,setddpv,pp);
continue;
end
comp.SetComponentProperties(n,setddpv,pp);
end
for i,v in d["object"] do
begin
call(thisfunction,p,v,comp.TreeNode,comp.Cwnd,prs,obarray,inhname);
end
for i,v in lazy do
begin
comp.SetComponentProperties(v[0],v[1],v[2]);
end
BindCwndMessage(comp.Cwnd);
//comp.DoControlAlign();
end
function SetFunctionList(v); //设置函数信息
begin
{**
@explan(说明) 设置当前类使用的函数名称 %%
**}
FFunctionSelecter.clean();
FFunctionSelecter.additem("(none)");
for i,vi in v do
begin
if vi in array("(none)","create","destroy","recycling","loadfromtfm") then continue;
FFunctionSelecter.additem(vi);
end
end
function create(AOwner);
begin
inherited;
top := 10;
left := 10;
rect := _wapi.GetScreenRect();
twidth := (rect[2]-50);
width := twidth;
calcheight(twidth);
caption := "TVCL界面设计器";
FProjectsManager := new TProjectManagerForm(self);
ico := new tbitmap();
ico.Readvcon(HexFormatStrToTsl( GetHostroyBimp()));
FProjectsManager.FormICon := ico.ToIcon();
FProjectsManager.parent := self;
FProjectManager := new TProjectView(self);
FProjectManager.height := rect[3]-top-height-20;
FProjectManager.left := left;
FProjectManager.top := top+height;
ico := new tbitmap();
ico.Readvcon(HexFormatStrToTsl(GetWindowMgrBmp()));
FProjectManager.FormICon := ico.ToIcon();
FProjectManager.parent := self;
//FTempCanvas := new
//***********************************************
FObjInspector := initobjinspector();
FObjInspector.height := rect[3]-top-height-20;
tparent := new TPairSplitterSide(self);
tparent.border := false;
pparent := new TPairSplitterSide(self);
//**********树************************
//FTree := new TComponentTree(self);
//FTree.onselchanged := thisfunction(ClickTreeNode);
//FTree.align := alClient;
//*************属性修改器**********************
pedits := new TPageControl(self);
pedits.align := alclient;
FProp := new TTabSheet(self);
FProp.caption := "properties";
FEvent := new TTabSheet(self);
FEvent.caption := "events";
FPropGrid := new TPropEditGrid(self);
FPropGrid.border := false;
FPropGrid.Component := self;
FEventGrid := new TEventEditGrid(self);
FVariableSelecter := new TListVariableFilter(self);
FVariableSelecter.visible := false;
FVariableSelecter.parent := FPropGrid;
FFunctionSelecter := new TListStr(self);
FFunctionSelecter.visible := false;
FFunctionSelecter.parent := FEventGrid;
FEventGrid.EventEditer := FFunctionSelecter;
FPropGrid.VariabeEditer := FVariableSelecter;
//**************父窗口关系*********************
FObjInspector.parent := self;
tparent.parent := FObjInspector;
pparent.parent := FObjInspector;
//FTree.parent := tparent;
pedits.parent := pparent ;
FProp.parent := pedits;
FEvent.parent := pedits;
FPropGrid.align := alclient;
FEventGrid.align := alclient;
FPropGrid.parent := FProp;
FEventGrid.parent := FEvent;
Mobjinspect();
onactivate := thisfunction(OnDesignerActivate);
fdimagelist := new TDesigImageList(self);
//FTree.Imagelist := fdimagelist;
fwindowinfos := new tfilesinfo(self,thisfunction(ClickTreeNode),fdimagelist,tparent);
//******************toolbar ***************
tlbar := FProjectManager.FTslEditer.gettoolbar();
savebtn := FProjectManager.FTslEditer.gettoolbarbtn();
for i,v in savebtn do //处理一下保存工程
begin
v._tag := array(thisfunction(saveCurrentForm),v.onclick);
v.onclick := function(o,e)
begin
for i,v in o._tag do
begin
CallDataFunction(v,o,e);
end
end
end
ebtn := FProjectManager.FTslEditer.gettoolbarbtn(array(0) union (3->13));//处理其他的工具按钮
for i,v in ebtn do
begin
v._tag := array(function(o,e)begin FProjectManager.ShowEditor(); end ,v.onclick);
v.onclick := function(o,e)
begin
for i,v in o._tag do
begin
CallDataFunction(v,o,e);
end
end
end
tlbar.Align := alLeft;
tlbar.width :=450;
tlbar.parent := self;
tlbar.arrange :="0;1";
sp1 := new tsplitter(self);
sp1.Align := alLeft;
sp1.parent := self;
FToolBars := new TDesignertoolbars(self);
FToolBars.parent := self;
FToolBars.Imagelist := fdimagelist;
FToolBars.Font.width := 9;
FToolBars.Font.height := 18;
addtoolbuttons();
FToolBars.Align := alClient;
//************菜单******************************
createmainmenubyarray(mainmenus(),FMenu0,self);
Mainmenu := FMenu0;
self.onclose := thisfunction(DesignerClose);
ic := new Ticon();
ic.Readvcon(HexFormatStrToTsl(GetTsIconBitmapInfo()));
self.FormICon := ic;
//文件打窗口
FProjectFileOpener := new TSavefileADlg(self);
FProjectFileOpener.filter := array("tvcl工程":"*.tpj");
FProjectFileOpener.parent := self;
FProjectManager.FTslEditer.setdbugruncall(thisfunction(debugproject)); //设置调试回调
FProjectManager.newmenu.parent := ffilemenu;//
FProjectManager.goformmenu.parent := fviewmenu;//
//fnewmenu
end
property VariableSelecter read FVariableSelecter; //当前控件树的变量对象
private //其他资源函数
function showhltcolor();
begin
FProjectManager.showhltcolor();
end
function mgr_control();
begin
if not fmgr_ctl then
begin
fmgr_ctl := new textcompclassmgr(self);
fmgr_ctl.visible:= false;
fmgr_ctl.left := left+300;
fmgr_ctl.top := top+300;
fmgr_ctl.parent := self;
end
fmgr_ctl.showmgr();
end
function ViewBitmap(o,e);
begin
if not FViewBitmap then
begin
FViewBitmap := new TViewBitmap(self);
FViewBitmap.minmaxbox := FALSE;
FViewBitmap.visible := 0;
FViewBitmap.visible := false;
FViewBitmap.onclose := thisfunction(SpectorClose);
FViewBitmap.parent := self;
FViewBitmap._Tag := o;
//FViewBitmap.show(0);
end
FViewBitmap.visible := not FViewBitmap.visible;
if o then o.Checked := FViewBitmap.visible;
end
function StopProject(o,e); //停止运行,目前没用
begin
//FRounMenu.Enabled := true;
//FStopMenu.Enabled := false;
FProjectManager.StopProject();
end
function RunProject(o,e); //运行
begin
FRounMenu.Enabled := false;
FStopMenu.Enabled := true;
FProjectManager.RunProject();
FRounMenu.Enabled := true;
FStopMenu.Enabled := false;
end
function editcommandline();//执行命令行
begin
FProjectManager.ShowExeEditer();
end
function debugproject(o,e); //调试运行
begin
FProjectManager.debugproject();
end
function Mobjinspect(o,e); //切换属性展示器
begin
{**
@explan(说明) 属性修改器 %%
**}
FObjInspector.Visible := not FObjInspector.Visible;
if FObjInspector.Visible then
begin
FObjInspector.left := width+ Left-FObjInspector.width;
FObjInspector.top := top+height;
end
if o then
begin
FObjInspector._tag := o;
o.Checked := FObjInspector.Visible
end
end
function initobjinspector(); //初始化
begin
project := new TPairSplitter(self);
project.visible := false;
project.caption := "object inspector";
project.Onclose := thisfunction(spectorclose);
project.WsPopUp := true;
project.Visible := false;
project.Width := 300;//
project.height := 800;
project.WsCaption := true;
project.WsSysmenu := true;
project.WSSizebox := true;
project.SplitterType := pstVertical;
project.position := 250;
return project;
end
function GetWindowMgrBmp();
begin
return "0502000000060400000074797065000203000000696D670006040000006461746
10002DA01000089504E470D0A1A0A0000000D4948445200000010000000100806
0000001FF3FF61000000017352474200AECE1CE90000000467414D410000B18F0
BFC6105000000097048597300000EC300000EC301C76FA8640000016F49444154
384FA593EB4EC2401484F7790595702FC59710451451047C0C140C218410EA637
0BFDF2119CF54DA748DBFA0C964DBCDCC7732BBA9C2998F4A96DA48962C24DFBF
65A52C98450B89621BC65B0BF17C13B19706A2B93A22D91AC24F5FC7E8EF23000
B370C1F650A242100A3D0465C00B1D726A202883CD7255C43E8F11F8016161902
880B20966F212A8070AE8150B68EA00082993F005300FBFD1E87C3C115BF77BB1
D369B0D96CB25E6F33926930986C321020F55AD8E32A52BCD1483DEF07ABDB601
B3D9CC055CA72B5A1D9528B46CF376BB75E50D73FA743AC56834C26030C0E57D4
5ABA30C39651A57AB951DE2CA6F27CCE9E3F1D806F4FB7DF8EF3EB53A8A5744A3
A3C562E10639D909737AAFD783CF03601DC503E106CD14DF1D39619A39DD06A43
EB43A8AA7C90DAF18A0686290EA76BBE8743AF0DD966D8F5347F12A789A415120
53C5B5F4BA4A57E1173A0D9C485D1C575FAAACD5D1FE8553EA688053EA688053E
A9CF93B033F9EA579B5AA7EC4E00000000049454E44AE42608200";
end
FProjectFileOpener;
end
implementation
type tfileinfonode = class()
fnode; //文件节点
ftree; //窗口对应树
ffuncs; //函数名
fvars; //变量
fnames; //可用的变量名
fcomp; //选中的控件
fclk; //是否点击选择
end
type tfilesinfo = class() //控件树存储对象
private
fdesginer;
[weakref]fcompclick;
fimg;
fparent;
public
function create(dser,clk,img,fp);
begin
FData := new tnumindexarray();
fimg := img;
fcompclick := clk;
fdesginer := dser;
fparent := fp;
end
function getdata(id); //通文件节点获得信息
begin
if not id then return fdata;
for i,v in fdata.data do
begin
if v.fnode = id then return v;
end
end
function gettreebyid(id); //通过文件节点树获得树
begin
if not id then return fdata;
for i,v in fdata.data do
begin
if v.fnode = id then return v.FTree;
end
end
function getnodebytree(tr); //通过树获得文件节点
begin
for i,v in fdata.data do
begin
if v.ftree = tr then
begin
v.fclk := true;
return v.fnode;
end
end
end
function getorcreate(id,ifold); //如果存在返回,不存在构造并返回
begin
nd := getdata(id);
ifold := true ;
if not nd then
begin
tr := new TComponentTree(fdesginer);
img := fdesginer.ExecuteCommand("imglist");
tr.visible := false;
tr.ImageList := img;
tr.Align := tr.alClient;
tr.parent := fparent;
tr.onselchanged := fcompclick;
nd := add(id,tr,array(),array());
ifold := false;
end
return nd;
end
function add(nd,tr,fcs,vs);//添加一个
begin
for i,v in FData.data do
begin
if v.fnode=nd then return 0;
end
nnd := new tfileinfonode();
FData.Push(nnd);
nnd.fnode := nd;
nnd.ftree := tr;
nnd.ffuncs := fcs;
nnd.fvars := vs;
return nnd;
end
function deletedata(id); //删除
begin
for i,v in FData.data do
begin
if v.fnode = id then
begin
r := v;
FData.splice(i,1);
return r;
end
end
end
ftreeparnet;
fdata;
end
type TPropEditGrid = class(TPropGrid) //属性编辑
{**
@explan(说明) 属性编辑 %%
**}
protected
function SetComponent(v);override;
begin
if v=FComponent then exit;
if v is class(TDComponent) then
begin
TSLData := v.GetPublishProperties();
end else
begin
TSLData := array();//array(NIL);
end
inherited;
end
public
function Create(AOwner);
begin
inherited;
end
end
type TEventEditGrid = class(TPropGrid) //事件编辑器
{**
@explan(说明) 事件编辑 %%
**}
protected
function SetComponent(v);override;
begin
if v=FComponent then exit;
if v is class(TDComponent) then
begin
TSLData := v.GetPublishEvents();
//echo tostn(TSLData);
end else
begin
TSLData := array(NIL);
end
inherited;
end
public
function Create(AOwner);
begin
inherited;
OndblClick := thisfunction(GridCellDblClick);
end
function GridCellDblClick(o,e);override;//双击处理
begin
i := e.iitem;
j := e.isubitem;
cellid := array(i,j);
if not(i >= 0 and j >= 0)then
begin
exit;
end
d := getdata(i,j);
if ifarray(d)and d["type"]="object" then
begin
rd := GetRegCellRender(d["class"]);
if rd is class(TGCellRender)then //处理双击
begin
if FComponent then
begin
FDesigner.addandopeneventbyname(FComponent.TreeNode,getdata(i,0));//DBLClickComponent();
end
end
end
end
end
type TDesigImageList = class(TControlImageList)
{**
@explan(说明) 设计器imagelist %%
**}
private
FIconMaps;
public
function Create(AOwner);override;
begin
inherited;
Width := 24;
Height := 24;
FIconMaps := array();
end
function RegisterDitem(item);virtual;
begin
{**
@explan(说明) 注册图标 %%
@param(item)(TDComponent) %%
**}
if item is Class(TDComponent) then
begin
n := item.dclassname;
id := FIconMaps[n];
bmp := item.bitmap();
if (bmp is class(TcustomBitmap)) and bmp.HandleAllocated() then
begin
if id>=0 then
begin
Replaceimge(id,bmp) ;
end else
begin
addbmp(bmp);
FIconMaps[n] := ImageCount-1;
end
end
end
end
function GetImageId(v);
begin
if ifstring(v) then
begin
n := v;
end
if v is class(TDComponent) then
begin
n := V.dclassname;
end
r := FIconMaps[n];
return r?r:0;
end
end
type TDesignertoolbars = class(TPageControl) //设计器控件按钮
private
[weakref]FToolbars;
FLabels ;
fimg;
function SetImageList(im);
begin
fimg := im;
end
public
Flabelcharlen;
function Create(AOwner);override;
begin
inherited;
ftbs := array();
align := alClient;
FToolbars := array();
Flabelcharlen := 0;
end
Procedure Notification(AComponent,Operation);virtual;
begin
if Operation=opRemove then
begin
if AComponent=fimg then
begin
fimg := nil;
end else
begin
for i,v in FToolbars do
begin
if v=AComponent then
begin
idx := i;
end
end
if idx then
begin
reindex(FToolbars,array(idx:nil));
end
end
end
inherited;
end
function CrossCursor(f);
begin
for i,v in FToolbars do
begin
if f then
v.Cursor := OCR_CROSS;
else v.Cursor := OCR_NORMAL;
end
end
function addbtn(btn,t); //加入按钮
begin
if not(t and ifstring(t)) then
begin
t := "常用";
end
tb := FToolbars[t];
if not tb then
begin
st := new TTabSheet(self);
st.caption := t;
tb := new ttoolbar(self);
tb.align := alClient;
if t<>"隐藏" then
begin
st.parent := self;
tb.parent := st;
Flabelcharlen+= length(t)+2;
end
tb.imagelist := fimg;
FToolbars[t] := tb;
end
ftbs[btn._tag.dclassname()] := btn;
btn.parent := tb;
end
function delbtn(n);
begin
btn := ftbs[n];
if btn then btn.Recycling();
end
property ImageList write SetImageList;
private
[weakref]ftbs;
end
type TViewBitmap = class(TvcForm)
{**
@explan(说明) 图片信息采集%%
**}
private
FFileopen;
FBmp;
FText;
FOldSize;
Fimage;
FMU;
FMopen;
FMhelp;
FMCopy;
FClipBoard;
FLB;
public
function paint();override;
begin
if FBmp and FBmp.Handle then
begin
if FBmp.bmwidth<200 and FBmp.bmheight<300 then
FBmp.draw(self.canvas,650,100);
else
FBmp.StretchDraw(self.canvas,array(650,100,650+200,100+300));
end
end
function GetBimpOpenBmp();
begin
return getbitmapviewerbitmapinfo();
end
function Create(AOwner);override;
begin
inherited;
ico := new tbitmap();
ico.Readvcon(HexFormatStrToTsl( GetBimpOpenBmp()));
FormICon := ico.ToIcon();
caption := "图片信息提取,支持bmp,ico,png,jpg,jpeg格式";
FFileopen := new TOpenFileADlg(self);
FClipBoard := new TClipBoard(self);
FMU := new TMainmenu(self);
FMopen := new TMenu(self);
FMopen.caption := "打开图片";
FMhelp := new TMenu(self);
FMCopy := new TMenu(self);
FMhelp.caption := "帮助";
FMCopy.caption := "拷贝信息到粘贴板";
FMopen.parent := FMU;
FMCopy.parent := FMu;
FMhelp.parent := FMu;
FMhelp.OnClick := thisfunction(OnHelp);
FMCopy.OnClick := thisfunction(OnCopy);
FMopen.onclick := thisfunction(OpenBmp);
FFileopen.wndowner := self;
FFileopen.filter := array("all":"*.bmp;*.ico;*.png;*.jpg;*.jpeg","bmp":"*.bmp","ico":"*.ico","png":"*.png");
FBmp := new TBitmap();
FText := new TSynMemoNorm(self);
FText.border := true;
FText.readonly := true;
FText.parent := self;
FText.top := 15;
FText.width := 600;
FText.Height := 430;
lb := new TLabel(self);
FLB := lb;
lb.caption := "浏览图片:";
lb.left := 650;
lb.top := 20;
lb.width := 200;
lb.parent := self;
Fimage := new timage();
FOldSize := array(0,0);
Mainmenu := FMU;
end
function OnHelp(o,e);
begin
_wapi.MessageBoxA(self.Handle,"将图片信息转换为16进制字符串\r\nHexFormatStrToTsl 函数可以将该信息转换为tsl数组\r\n然后btmap对象通过Readvcon读入该数组得到bitmap","帮助",0);
end
function Oncopy(o,e);
begin
r := FText.text;
if r then
begin
FClipBoard.text := r;
_wapi.MessageBoxA(self.Handle,"拷贝到粘贴板成功!","提示",0);
end else _wapi.MessageBoxA(self.Handle,"数据为空!","提示",0);
end
function OpenBmp(o,e);virtual;
begin
IF FFileopen.ChooseDlg() then
begin
r := 3;
r := Fimage.LoadFromFile(FFileopen.FileName);
if r<>0 then
begin
_wapi.MessageBoxA(0,"打开失败","错误",0);
return ;
end
FBmp.Handle := Fimage.ToHBitmap();
size := array(FBmp.bmwidth,FBmp.bmheight);
Flb.caption := format("浏览图片:%d*%d",size[0],size[1]);
rsize := array(min(300,max(size[0],FOldSize[0])),min(300,max(size[1],FOldSize[1])));
FText.text := TSLToHexFormatStr(FBmp.TOvcon);
Invalidaterect(array(650,100,650+rsize[0],100+rsize[1]));
FOldSize := size;
end
end
end
type tdcompextmgr = class()
function create(AOwner);
begin
fini := new TIniFileExta("",ffile);
end
function getcomplist();
begin
class(TDComponent).GetClassItemext();
end
function addclass(f)
begin
end
private
fini;
ffile ;
end
function getdesignerpath();
begin
bpath := TS_GetUserProfileHome();
return bpath+"designer"+ioFileseparator();
end
function getdesginerini();
begin
vclini := static getdesignerpath()+"tslvcldesigner.ini";
CreateDirWithFileName(vclini);
ini := new TIniFileExta("",vclini);
ini.LowerKey := true;
return ini;
end
function addextdtypeclass(n,body);
begin
dir := static getdesignerpath()+"dcmps"+ioFileseparator();
nf := dir+n+".tsf";
CreateDirWithFileName(nf);
filedelete("",nf);
len := length(body);
p := 0;
writefile(rwraw(),"",nf,p,len,body);
end
function addexttypeclasstoini(n,dn);
begin
ini := static getdesginerini();
ini.WriteKey("components",n,dn);
end
function delexttypeclassini(n);
begin
ini := static getdesginerini();
kn := ini.ReadKey("components",n,"");
ini.DeleteKey("components",n);
if kn then
begin
dir := static getdesignerpath()+"dcmps"+ioFileseparator();
nf := dir+kn+".tsf";
sysclearfunc(kn,"system");
sysclearfunc(n,"system");
filedelete("",nf);
end
end
function addexttypeclasscomp(cmp);
begin
class(TDComponent).RegestorClassItemsext(array(cmp));
end
function delexttypeclasscomp(n);
begin
class(TDComponent).unregestorclassitemsext(n);
end
function staticInit();
begin
global g_orig_lib_path;
np := getdesignerpath()+"dcmps"+ioFileseparator();
CreateDirWithFileName(np+"1.txt");
g_orig_lib_path := tsl_getlibpath_();
tsl_setlibpath_( np+";"+g_orig_lib_path);
ini := static getdesginerini();
//class(TDSocketServer),class(TDSocketClient),
//注册的componet
its := array();
for i,v in ini.ReadSectionValues("components") do //控件
begin
if v then
begin
cv := findclass(v);
if cv then
begin
its[length(its)] := cv;
end
end
end
o := class(TDComponent);
o.RegestorClassItemsext(its);
its := array();
o := class(TPropGrid);
for i,v in ini.ReadSectionValues("properties") do //属性
begin
if v then
begin
cv := findclass(v);
if cv then
begin
it := createobject( cv,0);
o.RegCellRender(it);
end
end
end
end
////5108321
initialization
staticInit();
end.