diff --git a/designer/gettsleditorstart.tsf b/designer/gettsleditorstart.tsf index 8345082..13ff754 100644 --- a/designer/gettsleditorstart.tsf +++ b/designer/gettsleditorstart.tsf @@ -1,6 +1,7 @@ //启动tsl编辑器 //20230421 整理代码 uses tslvcl; +setprocessdpiawareness(2); deletefuncacheini(); //清空缓存 ops := ""; //待打开文件 GLobal G_OpenHostory; diff --git a/designer/gettslvcldesignerstart.tsf b/designer/gettslvcldesignerstart.tsf index 34c153b..7170a48 100644 --- a/designer/gettslvcldesignerstart.tsf +++ b/designer/gettslvcldesignerstart.tsf @@ -2,6 +2,7 @@ tsl界面设计器启动程序 } uses tslvcl,utslvclDesigner; +setprocessdpiawareness(2); deletefuncacheini(); isdebug := false; willopen := ""; diff --git a/designer/teditorform.tsf b/designer/teditorform.tsf index 1bb2dc1..e9c8e75 100644 --- a/designer/teditorform.tsf +++ b/designer/teditorform.tsf @@ -418,6 +418,8 @@ type teditorform = class(TVCform) // begin global g_editer_font_size := ginfo["font"]; FEdter.getpage().font := ginfo["font"]; + FEdter.getcodemap().font := ginfo["font"]; + //Fdirview.addrootdirs(dirs); end if importfile(ftstream(),"",fdirspath,dirs)=1 then diff --git a/designer/udesignerproject.tsf b/designer/udesignerproject.tsf index 069bf7a..52473b5 100644 --- a/designer/udesignerproject.tsf +++ b/designer/udesignerproject.tsf @@ -364,7 +364,7 @@ type TProjectView = class(TVCForm) // imgs := New TControlImageList(self); imgs.width := 24; imgs.height := 24; - imgs.DrawBimpFirst := true; + imgs.DrawBmpFirst := true; EditToolBmps := array(); for i,v in GetToolBtns() do begin @@ -385,7 +385,7 @@ type TProjectView = class(TVCForm) // FTreeTool.ImageList := imgs; //**************目录树筛选功能*********************************** FFilter := new TEdit(self); - FFilterList := new TListBox(self); + FFilterList := new TListBox(self); FFilterList.color := 0xdcF8ff; FFilterList.visible := false; FFilterList.WsPopUp := TRUE; @@ -1100,7 +1100,7 @@ type TProjectView = class(TVCForm) // sdir[idx++] := Getfuncextdir(); end ///////////////////////////////////// - FTslEditer.TslSearchDir := sdir;//array(p,Getfuncextdir()); + FTslEditer.TslSearchDir := sdir; FExecEntry := FprojName; if d["entryscript"]then begin @@ -1923,9 +1923,7 @@ end end function GetVCLdir(); begin - //return Getfuncextdir()+ioFileseparator()+"tvclib"; - return Getfuncextdir();//+ioFileseparator()+"tvclib"; - return tsl; + return Getfuncextdir()+ioFileseparator()+"tvclib"; //将vcl设置为只读 end function Getfuncextdir(); begin @@ -2449,6 +2447,7 @@ type TFileTree = class(TTreeCtl) fprojectpath := ""; fio := ioFileseparator(); ImageList := CreateaImageList(self,FImageIdName); + ImageList.DrawBmpFirst := true; hasline := true; nodecreator := class(TTNode); FPNode := CreateTreeNode(); diff --git a/designer/utslcodeeditor.tsf b/designer/utslcodeeditor.tsf index f83c0c7..35de95b 100644 --- a/designer/utslcodeeditor.tsf +++ b/designer/utslcodeeditor.tsf @@ -71,6 +71,7 @@ type TPage=class(TCustomControl) // function Create(AOwner) begin Inherited; + ParentFont := false; FCloseBtn := false; FPageItems := new TMyarrayB(); FMultiLine := 1; @@ -151,6 +152,7 @@ type TPage=class(TCustomControl) // end function Paint();override; //绘制 begin + if not FPageItems then return ; dc := Canvas; ps := PAINTSTRUCT().rcPaint; //dc.Pen.Color := rgb(180,180,100); @@ -494,6 +496,8 @@ type TPage=class(TCustomControl) // end function CalcPageItemRect(); //计算位置 begin + FLines := 1; + if not FPageitems then return ; li := 0; cw := Font.Width; r := class(TCustomControl).ClientRect; @@ -1924,7 +1928,7 @@ type TEditer=class(TCustomcontrol) // end end - FImages.DrawBimpFirst := true; + FImages.DrawBmpFirst := true; Fdbgbtns := dbgbtns; FTslDebug.addbtns(dbgbtns); //FToolbar.ImageList := FImages; @@ -3863,6 +3867,10 @@ type TEditer=class(TCustomcontrol) // begin return FPageEditer; end + function getcodemap(); + begin + return FinCodemap.ftree; + end protected class function Sinit();override; begin @@ -5134,6 +5142,7 @@ type tfincodemap = class(tcustomcontrol) FList.Parent := self; initbtn(); FTree := new TTreeView(self); + FTree.ParentFont := false; FTree.OnSelChanged := thisfunction(SynNodeSelected); FTree.Parent := self; FTree.onsyskeydown := function(o,e)begin @@ -5499,6 +5508,7 @@ type TFindListWnd=class(TListBox) // function Create(AOwner); begin inherited; + ParentFont := false; onnotification := function(o,e)begin ms := e.message; if ifarray(ms) and ms[0] ="font" then diff --git a/designer/utslsynmemo.tsf b/designer/utslsynmemo.tsf index 5f032c7..531789c 100644 --- a/designer/utslsynmemo.tsf +++ b/designer/utslsynmemo.tsf @@ -2164,8 +2164,8 @@ type TTsfFileParser = class() // FFileNames[fn] := pfn; if ifstring(d) and d=flt then begin - ReadParseredFile(fn); - return ; + if ReadParseredFile(fn,nil,pfn) then + return ; end if readFile(rwRaw(),"",pfn,0,sz,rdd) then begin @@ -2256,7 +2256,7 @@ type TTsfFileParser = class() // end end end - function ReadParseredFile(n,g); //读取解析的文件 + function ReadParseredFile(n,g,pfn); //读取解析的文件 begin if FCacheDir then begin @@ -2282,6 +2282,10 @@ type TTsfFileParser = class() // begin FCacheS[ln] := d;//new tparserdobject(d); FFilePaths[ln] := d["fullpath"]; + if pfn and ( pfn<>d["fullpath"]) then + begin + return 0; + end nns := d["nspace"]; if nns then begin diff --git a/designer/utslvcldcomponents.tsf b/designer/utslvcldcomponents.tsf index caf8fff..1799147 100644 --- a/designer/utslvcldcomponents.tsf +++ b/designer/utslvcldcomponents.tsf @@ -941,6 +941,7 @@ type TDVirutalWindow = class(TCustomControl) // @explan(说明) 非可视控件的窗口容器 %% **} private + fminusfileds; FBitmap; //图标 FBindComponent;//绑定的设计控件 FWindowFileds; //窗口的属性 @@ -976,6 +977,7 @@ type TDVirutalWindow = class(TCustomControl) // public function Create(AOwner);override; begin + fminusfileds := array(); inherited; width := 30; height := 30; @@ -1009,9 +1011,9 @@ type TDVirutalWindow = class(TCustomControl) // if r2 then begin deletefiled(r2); - return (r union r2); + r := (r union r2); end - return r; + return minus_fileds(r); end function GetPublishEvents();override; //获得消息处理函数 begin @@ -1033,6 +1035,7 @@ type TDVirutalWindow = class(TCustomControl) // deletefiled(r2); r union= r2; end + return minus_fileds(r); return r; end function SetPublish(n,v,pp);override; //设置属性 @@ -1057,10 +1060,25 @@ type TDVirutalWindow = class(TCustomControl) // end property BindComp read FBindComponent write SetBindComponent; property WindowFileds read FWindowFileds write FWindowFileds; + property minusfileds read fminusfileds write fminusfileds; {** @param(BindComp)(tcomponent) 绑定的控件 %% @param(WindowFileds)(array of string) 容器控件替代的属性 %% **} + private + function minus_fileds(r); + begin + ds := array(); + for i,v in fminusfileds do + begin + if ifstring(v) and v then ds[lowercase(v)] := nil; + end + if ds then + begin + reindex(r,ds); + end + return r; + end end //控件树节点 @@ -1461,13 +1479,20 @@ end type TGraphicLabelWindow = class(TDVirutalWindow) {** @explan(说明) label 控件替代窗口 %% -**} - +**} function paint();override; begin - canvas.Font := font; - al := BindComp.TextAlign; - BindComp.CanvasDrawAlignText(self.canvas,self.ClientRect,self.caption,al); + bd := BindComp; + cvs := canvas; + //if not bd.ParentFont then cvs.Font := bd.Font; + bd.canvas.Handle := cvs.Handle; + bd.Font := Font; + bd.width := width; + bd.height := height; + bd.paint(); + //canvas.Font := font; + //al := BindComp.TextAlign; + //BindComp.CanvasDrawAlignText(self.canvas,self.ClientRect,self.caption,al); end function SetPublish(n,v,pp);override; begin @@ -1479,12 +1504,49 @@ type TGraphicLabelWindow = class(TDVirutalWindow) function Create(AOwner);override; begin inherited; + Parentcolor := true; BindComp := new tlabel(self); width := BindComp.width; height := BindComp.Height; - WindowFileds := array("left","top","width","height","color","parentcolor","font","parentfont","border","caption","visible","align","anchors"); + WindowFileds := array("left","top","width","height","color","parentcolor","font","parentfont","border","visible","align","anchors"); end - + function DesigningSizer();override; + begin + return true; + end +end +type TGraphicbevelWindow = class(TDVirutalWindow) +{** + @explan(说明) tbevel 控件替代窗口 %% +**} + function paint();override; + begin + bd := BindComp; + bd.width := width; + bd.height := height; + bd.canvas.Handle := canvas.Handle; + bd.paint(); + end + function SetPublish(n,v,pp);override; + begin + r := inherited; + if n="bkbitmap" then bkbitmap := v; + if (n="font" or n="bkbitmap" or n="style" or n="shape") then InvalidateRect(nil,true); + return r; + end + function Create(AOwner);override; + begin + inherited; + Border := false; + Parentcolor := true; + bd := new tbevel(self); + bd.Caption := ""; + width := bd.width; + height := bd.Height; + BindComp := bd; + WindowFileds := array("left","top","width","height","color","parentcolor","font","parentfont","visible","align"); + minusfileds := array("caption","popupMenu","action","border","anchors"); + end function DesigningSizer();override; begin return true; @@ -1573,6 +1635,35 @@ type TDLabel = class(TDComponent) inherited; end end +type TDbevel = class(TDComponent) +{** + @explan(说明) tbevel控件 %% +**} + function HitTip();override; + begin + return inherited; + end + function IsContainer();override; + begin + return false; + end + function ComponentClass();override; + begin + return class(tbevel); + end + function WndClass();override; + begin + return Class(TGraphicbevelWindow); + end + function bitmapinfo();override; + begin + return getbevelbitmapinfo(); + end + function Create(AOwner);override; + begin + inherited; + end +end type tdsplitter = class(TDComponent) {** @explan(说明) label控件 %% @@ -3806,6 +3897,7 @@ begin class(TDmessagebox), class(TDBtn), class(TDLabel), + class(TDbevel), class(tdsplitter), class(TDEdit), class(TDpassword), diff --git a/designer/utslvcldebuger.tsf b/designer/utslvcldebuger.tsf index 0217290..e434d26 100644 --- a/designer/utslvcldebuger.tsf +++ b/designer/utslvcldebuger.tsf @@ -1336,7 +1336,7 @@ type TTslDebuga=class(TCustomControl) if ps then begin psi := ps[0]; - if fileexists("",psi)then + if ifstring(psi) and psi and fileexists("",psi)then begin cmdexe := psi; end else @@ -1345,7 +1345,7 @@ type TTslDebuga=class(TCustomControl) ExecuteCommand("showstr","当前指定的执行程序不存在!!"); end psi := ps[1]; - if psi and fileexists("",psi)then + if psi and ifstring(psi) and fileexists("",psi)then begin end else begin @@ -1369,7 +1369,7 @@ type TTslDebuga=class(TCustomControl) FDebugExe := cmdexe; ExecuteCommand("showstr","<当前执行程序(F9)做调试器>"); end else - if fileexists("",FDebugExe)then + if FDebugExe and ifstring(FDebugExe) and fileexists("",FDebugExe)then begin ExecuteCommand("showstr","<用配置文件给定的调试器>"); end else diff --git a/designer/utslvcldesigner.tsf b/designer/utslvcldesigner.tsf index 7dc88d7..2fcbb87 100644 --- a/designer/utslvcldesigner.tsf +++ b/designer/utslvcldesigner.tsf @@ -1000,13 +1000,69 @@ type TVclDesigner = class(tvcform) if (wnd is class(TVCForm)) then begin wnd.OnMinimize := thisfunction(CompClose); + wnd.onkeydown := thisfunction(toplevelwndkeydown); end end end + function get_mu_id(mus,id); + begin + for i,v in mus do + begin + if v["id"]=id then + begin + return true; + end + end + end + function toplevelwndkeydown(o,e); + begin + cd := e.CharCode; + if cd = VK_ESCAPE then return select_parent(); + c := e.char; + if not((c in array("X","V","C")) or cd=VK_DELETE) then return ; + if not ((nd := fselctlnode) and (ndc := nd.Component) and (mus := ndc.menus())) then return ; + if cd = VK_DELETE then + begin + if get_mu_id(mus,"delete") then return ndc.deleteclick(nd,nil); + return ; + end + if (ssCtrl in e.shiftstate()) then + begin + case c of + "X": + begin + if get_mu_id(mus,"cut") then return ndc.cutclick(nd,nil); + end + "C": + begin + if get_mu_id(mus,"copy") then return ndc.copyclick(nd,nil); + end + "V": + begin + if get_mu_id(mus,"paste") then return ndc.pasteclick(nd,nil); + end + end ; + end + end function isloadednode(wndnode); begin return fwindowinfos.getdata(wndnode); end + function select_parent(); //向上选择 + begin + nd := fselctlnode; + if nd then + begin + pnd := nd.parent; + if pnd and (cp :=pnd.Component) and( o := cp.Cwnd) and ifobj(o._tag) then + begin + ClickComponent(o,nil); + end + + end + //TreeNodeSelected(nd.parent); + + end function UnLoadTreeNode(wndnode); //卸载控件树 begin {** @@ -1748,7 +1804,7 @@ type TDesigImageList = class(TControlImageList) inherited; Width := 24; Height := 24; - DrawBimpFirst := true; + DrawBmpFirst := true; FIconMaps := array(); end function RegisterDitem(item);virtual; diff --git a/designer/utslvcldesignerresource.tsf b/designer/utslvcldesignerresource.tsf index 08a8932..aa9506f 100644 --- a/designer/utslvcldesignerresource.tsf +++ b/designer/utslvcldesignerresource.tsf @@ -59,6 +59,7 @@ function getunredobitmapinfo(); function gettslsyntaxcheckbitmapinfo(); function gettslcodemapbitmapinfo(); function getquickkeybitmapinfo(); +function getbevelbitmapinfo(); function getfindbitmapinfo(); function gettslcodeformatbitmapinfo(); function getformbitmapinfo(); //窗口图标 @@ -1177,6 +1178,30 @@ E99858BCF1C4A7FF5D6B5F83D9D58B5F822D02B141A91006E016ECBBF4E5BF613 E69966865DDFEFF1818D12003BD1A1EFCF70526D365073F404D8400B805B40234 B6E0FF7F00E32F1D353DB8EA960000000049454E44AE42608200"; end +function getbevelbitmapinfo(); +begin + return "9002000000000000000200000002000000010000009D0200003C0000000000000 +004000000040000000400000008000000030000000B0000005602000074797065 +64617461696D6789504E470D0A1A0A0000000D494844520000001800000018080 +6000000E0773DF8000000017352474200AECE1CE90000000467414D410000B18F +0BFC6105000000097048597300000EC300000EC301C76FA864000001EB4944415 +4484BBD95594EC3401044B915178003F10B3F91722BFED84212C7FBEE78B7633B +8B7385A21B3002E41921412869BE2CD52BD5F4B4CF7062FD1FE0F26685F3ABF99 +F1CF61AF401E00FEBB247D51E50367B149B1DF27A8BACEA90962D92A2793D71BE +C13AAB11262582B880BFCEE14519DC30851324589AF1ABD7A02F804DD7E3783CA +2EF7B1C0E07ECF77BEC763B6CB75B745D87B66DD1340DEABA46555528CB124551 +20CF736459863425882F01D4949ECD659299274902DB5B8B011555C3C95963C92 +79389D43C8E63984E280694D43BD7C21AAB850132F3288A60D8811850D0A57272 +D658E70C9099876108DDF2C5809C268693B3C62E940132F32008A0999E1890D13 +87272169B8D1D99B9EFFB500D570C4869CE7F328A2273CFF3B0D21D3120A147F4 +1B73D775A168B61810D30B95994FA7D3D1DA86E3380E96AA250644F4FC65C919C +049C792B36CDBC66265CA01B25A18C066DFCD3939CBB22CCC15430C086979C93A +1F00DFCD3939CB300C3C2F753120A0CD28BB5006C8A4EB3A660B4D0CF069ED8AC +CC76AE1E45C0B2767734DD3F03457C5008F76FA6FCC5555C5E3F3DB8F6BD01700 +FF2C2C5AB7A61B41A7A5C547A3DDA2D2F35FD10B55E8112D69CE17348A739A961 +9F5FD44953C52EA0732BE9F29B8BD1300FEF2977971ADBCBB7E029C4A2706002F +103EEEED1783B9280000000049454E44AE426082"; +end function getfindbitmapinfo(); begin return "0502000000060400000074797065000203000000696D670006040000006461746 diff --git a/designer/utslvcldpropertytypes.tsf b/designer/utslvcldpropertytypes.tsf index a6ce80f..81e5f0a 100644 --- a/designer/utslvcldpropertytypes.tsf +++ b/designer/utslvcldpropertytypes.tsf @@ -312,7 +312,7 @@ type TGridCellEditList = class(TGridCellEditWithButton) dlist.height := 250; dlist.left := dn[0]; dlist.top := dn[1]; - dlist.OnClickSelected := thisfunction(OnvSelected); + dlist.OnClickSelected := thisfunction(OnvSelected); dlist.SetSelectedByValue(d["value"]); //dlist.visible := true; dlist.show(); @@ -366,13 +366,17 @@ type TGridCellVariableEdit = class(TGridCellEditList,TPropertyVarible) end ; return v; end + //function CellDrawLabel(dc,rect,d);override; + //begin + // dc.DrawText("(none)",rect,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + //end end type TListVariable = class(TGridList) {** @explan(说明) 变量选择 %% **} private - FOnClickSelected; + [weakref]FOnClickSelected; public function show(f);override; begin @@ -394,18 +398,23 @@ type TListVariable = class(TGridList) ("text":"variable","width":180) ); end - function SetSelectedByValue(v);override; + function SetSelectedByValue(v_);override; begin - if ifnil(v) then return inherited; + if ifnil(v_) then return inherited; + v := v_; vi := nil; - for i := 0 to List.count-1 do - begin - if v=list[i].name then + if ifobj(v) then v := v.name; + if ifstring(v) then + begin + for i := 0 to List.count-1 do begin - vi := list[i]; - break; + if v=list[i].name then + begin + vi := list[i]; + break; + end end - end + end inherited SetSelectedByValue(vi); end function additem(v);override; @@ -1725,13 +1734,16 @@ type TGridCellColorEdit = class(TGridCellEditWithButton,TPropertyColor) Fcpok := true; if not(FColorChoose) then begin - FColorChoose := new TColorChooseADlg(grid); + FColorChoose := new t_colorbox(grid);//TColorChooseADlg(grid); FColorChoose.Parent := grid; end FColorChoose.Result := d["value"]; + rec := GetPopRect(0); + FColorChoose.top := rec[1]; + FColorChoose.left := rec[2]-400; if FColorChoose.OpenDlg() and Fcpok then begin - grid.CellChanged(e.iitem,e.isubitem,"value",FColorChoose.Result); + grid.CellChanged(e.iitem,e.isubitem,"value",FColorChoose.Result); end end function CellDrawLabel(dc,rect,d);override; @@ -1744,8 +1756,9 @@ type TGridCellColorEdit = class(TGridCellEditWithButton,TPropertyColor) end function CellLeave();override; begin - Fcpok := false; + Fcpok := false; inherited; + if FColorChoose.visible then FColorChoose.EndModal(0); end end type TGridCellDirectoryEdit = class(TGridCellEditWithButton,TPropertyDirectory) @@ -1755,9 +1768,7 @@ type TGridCellDirectoryEdit = class(TGridCellEditWithButton,TPropertyDirectory) private Fcpok ; FColorChoose; - public - function create(AOwner);override; begin inherited; @@ -3248,7 +3259,8 @@ type TMultiSelectCell = class(TGridCellEditWithButton) FPanel; FI; FJ; - FCellv; + FCellv; + FSelLock; function GetSelPanel();virtual; begin if not FPanel then @@ -3267,6 +3279,7 @@ type TMultiSelectCell = class(TGridCellEditWithButton) public function SelChanged(o,e); begin + if FSelLock then return ; if fi>=0 and fj>=0 and ifarray(FCellv) then begin o.visible := false; @@ -3287,12 +3300,14 @@ type TMultiSelectCell = class(TGridCellEditWithButton) fi := e.iitem; fj := e.isubitem; FCellv := array(); + FSelLock := true; GetSelPanel(); rec := GetPopRectByHeight(160); rec[3] := rec[1]+160; FPanel.SetBoundsRect(rec); FPanel.SetSelectData(FListSel); FPanel.Show(); + FSelLock := false; end function CellLeave(grid);override; begin @@ -3310,11 +3325,13 @@ type TOneSelectCell = class(TGridCellEditWithButton) FI; FJ; FCellv; + FSelLock; function GetSelPanel();virtual; begin if not FPanel then begin FPanel := new UniCheckList(Owner); + FPanel.visible := false; FPanel.wspopup := true; FPanel.SetList(SelPalRange()); FPanel.OnSelChanged := thisfunction(SelChanged); @@ -3325,6 +3342,7 @@ type TOneSelectCell = class(TGridCellEditWithButton) public function SelChanged(o,v); begin + if FSelLock then return ; if fi>=0 and fj>=0 and ifarray(FCellv) then begin o.visible := false; @@ -3341,14 +3359,17 @@ type TOneSelectCell = class(TGridCellEditWithButton) @explan(说明) 格子点击 %% **} inherited; + GetSelPanel(); fi := e.iitem; fj := e.isubitem; - FCellv := array(); - GetSelPanel(); + FCellv := array(); rec := GetPopRectByHeight(160); rec[3] := rec[1]+160; + FSelLock := true; + if ifarray(d) then FPanel.SetSelValue(d["value"]); FPanel.SetBoundsRect(rec); FPanel.Show(); + FSelLock := false; end end type TGridCellAnchorsEdit = class(TMultiSelectCell,TPropertyAnchors) @@ -3419,7 +3440,120 @@ type TGridCellTabAlignEdit = class(TOneSelectCell,TPropertyTabAlign) begin return SelRange; end +end +type TGridCellTabtvestypeEdit = class(TOneSelectCell,TPropertytvetype) + {** + @explan(说明)设置expandsigntype属性%% + **} + + function CellDrawLabel(dc,rect,d);override; + begin + if ifarray(d) then + begin + dc.drawtext(FormatTMF(d["value"]),rect,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + end + end + function create(AOwner);override; + begin + inherited; + class(TPropertytvetype).Create(); + end + private + function SelPalRange();virtual; + begin + return SelRange; + end end +type TGridCelllinestyleEdit = class(TOneSelectCell,TPropertylinestyle) + {** + @explan(说明)设置expandsigntype属性%% + **} + + function CellDrawLabel(dc,rect,d);override; + begin + if ifarray(d) then + begin + dc.drawtext(FormatTMF(d["value"]),rect,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + end + end + function create(AOwner);override; + begin + inherited; + class(TPropertylinestyle).Create(); + end + private + function SelPalRange();virtual; + begin + return SelRange; + end +end +type tgridcellbevelcutedit = class(TOneSelectCell,TPropertybevelcut) + {** + @explan(说明)设置beval属性%% + **} + function CellDrawLabel(dc,rect,d);override; + begin + if ifarray(d) then + begin + dc.drawtext(FormatTMF(d["value"]),rect,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + end + end + function create(AOwner);override; + begin + inherited; + class(TPropertybevelcut).Create(); + end + private + function SelPalRange();virtual; + begin + return SelRange; + end +end +type tgridcellbevelshapedit = class(TOneSelectCell,TPropertybevelshape) + {** + @explan(说明)设置bevalshape属性%% + **} + function CellDrawLabel(dc,rect,d);override; + begin + if ifarray(d) then + begin + dc.drawtext(FormatTMF(d["value"]),rect,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + end + end + function create(AOwner);override; + begin + inherited; + class(TPropertybevelshape).Create(); + end + private + function SelPalRange();virtual; + begin + return SelRange; + end +end +type tgridcellbevelstyledit = class(TOneSelectCell,TPropertybevelstyle) + {** + @explan(说明)设置bevalstyle属性%% + **} + function CellDrawLabel(dc,rect,d);override; + begin + if ifarray(d) then + begin + dc.drawtext(FormatTMF(d["value"]),rect,DT_VCENTER.|DT_LEFT .|DT_SINGLELINE); + end + end + function create(AOwner);override; + begin + inherited; + class(TPropertybevelstyle).Create(); + end + private + function SelPalRange();virtual; + begin + return SelRange; + end +end + type TtextEditor = class(tpanel) {** @explan(说明)memo编辑器%% @@ -4401,6 +4535,113 @@ type TListStatusEdit2 = class(TListStatusEdit) end end +type t_colorbox = class(tcustomcontrol) + function create(AOwner); + begin + inherited; + caption := "color 选择"; + visible := false; + WsPopUp := true; + wscaption := true; + width := 300; + height := 340; + cbox := new TColorbox(self); + for i,v in syscl() do + cbox.addColor(v["name"],v["value"]); + btok := new tbtn(self); + btcancel := new tbtn(self); + btok.caption := "确定"; + btcancel.caption := "取消"; + btok.parent := self; + btcancel.parent := self; + cbox.parent := self; + btok.onclick := function()begin + EndModal(1); + end + btcancel.onclick := function()begin + EndModal(0); + end + end + function OpenDlg(); + begin + return showmodal(); + end + function syscl(); + begin + return array( + ("name":"clDefault","value":0x20000000), + ("name":"clScrollBar","value":-2147483648), + ("name":"clBackground","value":-2147483647), + ("name":"clActiveCaption","value":-2147483646), + ("name":"clInactiveCaption","value":-2147483645), + ("name":"clMenu","value":-2147483644), + ("name":"clWindow","value":-2147483643), + ("name":"clWindowFrame","value":-2147483642), + ("name":"clMenuText","value":-2147483641), + ("name":"clWindowText","value":-2147483640), + ("name":"clCaptionText","value":-2147483639), + ("name":"clActiveBorder","value":-2147483638), + ("name":"clInactiveBorder","value":-2147483637), + ("name":"clAppWorkspace","value":-2147483636), + ("name":"clHighlight","value":-2147483635), + ("name":"clHighlightText","value":-2147483634), + ("name":"clBtnFace","value":-2147483633), + ("name":"clBtnShadow","value":-2147483632), + ("name":"clGrayText","value":-2147483631), + ("name":"clBtnText","value":-2147483630), + ("name":"clInactiveCaptionText","value":-2147483629), + ("name":"clBtnHighlight","value":-2147483628), + ("name":"cl3DDkShadow","value":-2147483627), + ("name":"cl3DLight","value":-2147483626), + ("name":"clInfoText","value":-2147483625), + ("name":"clInfoBk","value":-2147483624), + ("name":"clHotLight","value":-2147483622), + ("name":"clGradientActiveCaption","value":-2147483621), + ("name":"clGradientInactiveCaption","value":-2147483620), + ("name":"clMenuHighlight","value":-2147483619), + ("name":"clMenuBar","value":-2147483618) + //,("name":"clForm","value":-2147483617) + ); + end + function DoControlAlign();override; + begin + r := clientrect; + if btok and btcancel and cbox then + begin + r1 := r; + r1[3] := r[3]-btok.height-5; + cbox.BoundsRect := r1; + t1 := r[3]-btok.height-2; + btok.top := t1; + btok.left := r[2]-btok.width-5; + btcancel.top := t1; + btcancel.left := r[2]-btok.width-10-btcancel.width; + end + end + btok; + btcancel; + property Result read get_color write set_color; + private + cbox; + function set_color(v);// + begin + itc := cbox.ItemCount; + for i:= 0 to itc-1 do + begin + if cbox.getColor(i)=v then + begin + cbox.ItemIndex := i; + return ; + end + end + cbox.customcolor := v; + cbox.ItemIndex := 0; + end + function get_color(); + begin + return cbox.getColor(cbox.ItemIndex); + end +end type TIconsEditer = class(TListEidter) private FFileopen; @@ -4527,7 +4768,12 @@ begin class(TGridCellAlignEdit), class(TGridCellAnchorsEdit), class(TGridCellTabAlignEdit), + class(TGridCellTabtvestypeEdit), + class(tgridcellbevelcutedit), + class(tgridcellbevelstyledit), + class(tgridcellbevelshapedit), class(TGridCellStringsEdit), + class(TGridCelllinestyleEdit), class(TGridCellIntegersEdit), class(TGridCellColorBoxEdit), class(tGridCellMbbtnstyleEdit), diff --git a/editor-install.exe b/editor-install.exe index ac7b954..f38d459 100644 Binary files a/editor-install.exe and b/editor-install.exe differ diff --git a/funcext/tvclib/setprocessdpiawareness.tsf b/funcext/tvclib/setprocessdpiawareness.tsf new file mode 100644 index 0000000..76d3463 --- /dev/null +++ b/funcext/tvclib/setprocessdpiawareness.tsf @@ -0,0 +1,16 @@ +function setprocessdpiawareness(v); +begin +{** + @explan(说明)设置dpi感知,目前仅支持windows + @param(v) 0,1,2 +**} + SetProcessDpiAwareness_sub(v); +end +{$ifdef linux} +function SetProcessDpiAwareness_sub(v); +begin + +end +{$else} +function SetProcessDpiAwareness_sub(v:integer):pointer;stdcall; external "Shcore.dll" name "SetProcessDpiAwareness"; +{$endif} \ No newline at end of file diff --git a/funcext/tvclib/t_cairo_api.tsf b/funcext/tvclib/t_cairo_api.tsf index 4c6a28c..a6ccc55 100644 --- a/funcext/tvclib/t_cairo_api.tsf +++ b/funcext/tvclib/t_cairo_api.tsf @@ -9,6 +9,7 @@ type t_cairo_api = class() _f_ := static function(s:pointer):pointer;cdecl;external get_cairo_func(functionname()); return ##_f_(s); end + procedure cairo_save(c:pointer); begin _f_ := static procedure(c:pointer);cdecl;external get_cairo_func(functionname()); @@ -23,6 +24,11 @@ type t_cairo_api = class() begin _f_ := static procedure(cr:pointer;s:pointer);cdecl;external get_cairo_func(functionname()); return ##_f_(cr,s); + end + function cairo_get_target(cr:pointer):pointer; + begin + _f_ := static function(cr:pointer):pointer;cdecl;external get_cairo_func(functionname()); + return ##_f_(cr); end function cairo_get_source(cr:pointer):pointer; begin @@ -268,6 +274,11 @@ type t_cairo_api = class() _f_ := static function(fmt:integer;w:integer;h:integer):pointer;cdecl;external get_cairo_func(functionname()); return ##_f_(fmt,w,h); end + function cairo_surface_write_to_png(sf:pointer;fn:string):integer; + begin + _f_ := static function(sf:pointer;fn:string):integer;cdecl;external get_cairo_func(functionname()); + return ##_f_(sf,fn); + end function cairo_image_surface_create_for_data(data:string;fmt:integer;w:integer;h:integer;stride:integer):pointer; begin _f_ := static function(data:string;fmt:integer;w:integer;h:integer;stride:integer):pointer;cdecl;external get_cairo_func(functionname()); @@ -302,7 +313,13 @@ type t_cairo_api = class() begin _f_ := static function(f:string):pointer;cdecl;external get_cairo_func(functionname()); return ##_f_(f); - end + end + + function cairo_surface_reference(sf:pointer):pointer; + begin + _f_ := static function(sf:pointer):pointer;cdecl;external get_cairo_func(functionname()); + return ##_f_(sf); + end procedure cairo_surface_destroy(sf:pointer); begin _f_ := static procedure(sf:pointer);cdecl;external get_cairo_func(functionname()); @@ -339,9 +356,9 @@ type t_cairo_api = class() _f_ := static function(cr:pointer):integer;cdecl;external get_cairo_func(functionname()); return ##_f_(cr); end - procedure cairo_get_current_point(c:pointer;var x:integer;var y:integer); + procedure cairo_get_current_point(c:pointer;var x:double;var y:double); begin - _f_ := static procedure(c:pointer;var x:integer;var y:integer);cdecl;external get_cairo_func(functionname()); + _f_ := static procedure(c:pointer;var x:double;var y:double);cdecl;external get_cairo_func(functionname()); return ##_f_(c,x,y); end procedure cairo_new_path(c:pointer);//Clears the current path. After this call there will be no path and no current point diff --git a/funcext/tvclib/t_gdiplusflat_api.tsf b/funcext/tvclib/t_gdiplusflat_api.tsf index 1a21f3c..a724ec9 100644 --- a/funcext/tvclib/t_gdiplusflat_api.tsf +++ b/funcext/tvclib/t_gdiplusflat_api.tsf @@ -43,7 +43,7 @@ type t_gdiplusflat_api=class() //gdiplus Function GdipAddPathRectangles(path:pointer;rects:pointer;ct:integer):integer;stdcall;external "gdiplus.dll" name "GdipAddPathRectangles"; Function GdipAddPathEllipse(path:pointer;x:single;y:single;width:single;height:single):integer;stdcall;external "gdiplus.dll" name "GdipAddPathEllipse"; Function GdipAddPathPie(path:pointer;x:single;y:single;width:single;height:single;startAngle:single;sweepAngle:single):integer;stdcall;external "gdiplus.dll" name "GdipAddPathPie"; - Function GdipAddPathPolygon(path:pointer;points:pointer;ct:integer):integer;stdcall;external "gdiplus.dll" name "GdipAddPathPolygon"; + Function GdipAddPathPolygon(path:pointer;points:array of single;ct:integer):integer;stdcall;external "gdiplus.dll" name "GdipAddPathPolygon"; Function GdipAddPathPath(path:pointer;addingPath:pointer;connect:pointer):integer;stdcall;external "gdiplus.dll" name "GdipAddPathPath"; Function GdipAddPathString(path:pointer;string:string;length:integer;family:pointer;style:integer;emSize:single;layoutRect:pointer;format:pointer):integer;stdcall;external "gdiplus.dll" name "GdipAddPathString"; Function GdipAddPathStringI(path:pointer;string:string;length:integer;family:pointer;style:integer;emSize:single;layoutRect:pointer;format:pointer):integer;stdcall;external "gdiplus.dll" name "GdipAddPathStringI"; @@ -136,7 +136,7 @@ type t_gdiplusflat_api=class() //gdiplus Function GdipTransformRegion(region:pointer;matrix:pointer):integer;stdcall;external "gdiplus.dll" name "GdipTransformRegion"; Function GdipGetRegionBounds(region:pointer;graphics:pointer;rect:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetRegionBounds"; Function GdipGetRegionBoundsI(region:pointer;graphics:pointer;rect:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetRegionBoundsI"; - Function GdipGetRegionHRgn(region:pointer;graphics:pointer;hRgn:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetRegionHRgn"; + Function GdipGetRegionHRgn(region:pointer;graphics:pointer;var hRgn:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetRegionHRgn"; Function GdipIsEmptyRegion(region:pointer;graphics:pointer;result:pointer):integer;stdcall;external "gdiplus.dll" name "GdipIsEmptyRegion"; Function GdipIsInfiniteRegion(region:pointer;graphics:pointer;result:pointer):integer;stdcall;external "gdiplus.dll" name "GdipIsInfiniteRegion"; Function GdipIsEqualRegion(region:pointer;region2:pointer;graphics:pointer;result:pointer):integer;stdcall;external "gdiplus.dll" name "GdipIsEqualRegion"; @@ -189,7 +189,7 @@ type t_gdiplusflat_api=class() //gdiplus //---------------------------------------------------------------------------- // LineBrush APIs //---------------------------------------------------------------------------- - Function GdipCreateLineBrush(point1:pointer;point2:pointer;color1:integer;color2:integer;wrapMode:integer;var lineGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreateLineBrush"; + Function GdipCreateLineBrush(point1 : array of single;point2:array of single;color1:integer;color2:integer;wrapMode:integer;var lineGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreateLineBrush"; Function GdipCreateLineBrushI(point1:pointer;point2:pointer;color1:integer;color2:integer;wrapMode:integer;var lineGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreateLineBrushI"; Function GdipCreateLineBrushFromRect(rect:pointer;color1:integer;color2:integer;mode:pointer;wrapMode:integer;var lineGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreateLineBrushFromRect"; Function GdipCreateLineBrushFromRectI(rect:pointer;color1:integer;color2:integer;mode:pointer;wrapMode:integer;var lineGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreateLineBrushFromRectI"; @@ -221,13 +221,13 @@ type t_gdiplusflat_api=class() //gdiplus //---------------------------------------------------------------------------- // PathGradientBrush APIs //---------------------------------------------------------------------------- - Function GdipCreatePathGradient(points:pointer;ct:integer;wrapMode:integer;var polyGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreatePathGradient"; - Function GdipCreatePathGradientI(points:pointer;ct:integer;wrapMode:integer;var polyGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreatePathGradientI"; + Function GdipCreatePathGradient(points:array of single;ct:integer;wrapMode:integer;var polyGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreatePathGradient"; + Function GdipCreatePathGradientI(points:array of integer;ct:integer;wrapMode:integer;var polyGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreatePathGradientI"; Function GdipCreatePathGradientFromPath(path:pointer;var polyGradient:pointer):integer;stdcall;external "gdiplus.dll" name "GdipCreatePathGradientFromPath"; Function GdipGetPathGradientCenterColor(brush:pointer;var colors:integer):integer;stdcall;external "gdiplus.dll" name "GdipGetPathGradientCenterColor"; Function GdipSetPathGradientCenterColor(brush:pointer;colors:integer):integer;stdcall;external "gdiplus.dll" name "GdipSetPathGradientCenterColor"; - Function GdipGetPathGradientSurroundColorsWithCount(brush:pointer;var color:integer;ct:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetPathGradientSurroundColorsWithCount"; - Function GdipSetPathGradientSurroundColorsWithCount(brush:pointer;var color:integer;var ct:integer):integer;stdcall;external "gdiplus.dll" name "GdipSetPathGradientSurroundColorsWithCount"; + Function GdipGetPathGradientSurroundColorsWithCount(brush:pointer;var color: array of integer;var ct:integer):integer;stdcall;external "gdiplus.dll" name "GdipGetPathGradientSurroundColorsWithCount"; + Function GdipSetPathGradientSurroundColorsWithCount(brush:pointer;color:array of integer;var ct:integer):integer;stdcall;external "gdiplus.dll" name "GdipSetPathGradientSurroundColorsWithCount"; Function GdipGetPathGradientPath(brush:pointer;path:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetPathGradientPath"; Function GdipSetPathGradientPath(brush:pointer;path:pointer):integer;stdcall;external "gdiplus.dll" name "GdipSetPathGradientPath"; Function GdipGetPathGradientCenterPoint(brush:pointer;points:pointer):integer;stdcall;external "gdiplus.dll" name "GdipGetPathGradientCenterPoint"; diff --git a/funcext/tvclib/t_img_op_api.tsf b/funcext/tvclib/t_img_op_api.tsf index 45d2941..740b3ca 100644 --- a/funcext/tvclib/t_img_op_api.tsf +++ b/funcext/tvclib/t_img_op_api.tsf @@ -107,7 +107,7 @@ type t_img_op_api=class({$ifdef linux}t_cairo_api{$else}t_gdiplusflat_api{$endif case s of "image/png": begin - return gdk_pixbuf_save(image,filename,"png",nil,nil,nil,nil,nil,nil) + return gdk_pixbuf_save(image,filename,"png",nil,nil,nil,nil,nil,nil); end "image/jpeg": begin diff --git a/funcext/tvclib/tcomponent.tsf b/funcext/tvclib/tcomponent.tsf index 32ad204..26cd2ef 100644 --- a/funcext/tvclib/tcomponent.tsf +++ b/funcext/tvclib/tcomponent.tsf @@ -413,7 +413,7 @@ public // //fondestroy := nil; //fonnotification := nil; end - function Destroy();virtual; + function Destroy();override; begin inherited; end; diff --git a/funcext/tvclib/tcontrol.tsf b/funcext/tvclib/tcontrol.tsf index a9f2038..aedc32e 100644 --- a/funcext/tvclib/tcontrol.tsf +++ b/funcext/tvclib/tcontrol.tsf @@ -20,6 +20,7 @@ type tcontrol = class(tcomponent) FtagPAINTSTRUCT; //绘制区域 FAnchors; + fautosize; FAnchorBounds; FCaption;//标题 FCaptureMouseButtons;//鼠标样式 @@ -177,6 +178,13 @@ type tcontrol = class(tcomponent) FParent.DoControlAlign(); //调整位置 end end + function setautosize(v); + begin + nv := v?true:false; + if nv=fautosize then return ; + fautosize := nv; + if nv then AdjustSize(); + end procedure SetAnchors(Value);virtual; begin if not ifarray(Value)then exit; @@ -209,7 +217,7 @@ type tcontrol = class(tcomponent) return 1; end end - private //位置,大小,对齐等属性设置函数 + private //位置,大小,对齐等属性设置函数 function SetUnAlignBounds(Value); begin {** @@ -359,7 +367,7 @@ type tcontrol = class(tcomponent) end function SetControlFont(v);virtual; begin - if ParentFont then return ; //如果使用父节点的字体,那么字体无效 + //if ParentFont and Parent then return ; //如果使用父节点的字体,那么字体无效 if ifarray(v)then begin FFont.SetValues(v); @@ -544,7 +552,7 @@ type tcontrol = class(tcomponent) if NewParent=FParent then return; if NewParent is getparenttype() then begin - if FParent then + if FParent and (objectstate(fParent) in array(1,2,3)) then begin FParent.operatectrl(self(true),opRemove); end @@ -557,7 +565,7 @@ type tcontrol = class(tcomponent) NewParent.operatectrl(self(true),opInsert); end else begin - if Parent then FParent.operatectrl(self(true),opRemove); + if FParent and (objectstate(fParent) in array(1,2,3)) then FParent.operatectrl(self(true),opRemove); end end procedure SetParentComponent(NewParentComponent);override; //设置父窗口 @@ -853,8 +861,8 @@ type tcontrol = class(tcomponent) //begin SetBounds(e.left,e.top,e.width,max(2,ht)); //SetBoundsRect(array(e.left,e.top,e.width+e.left,e.top+ht)); - e.top += ht; - e.height -= ht; + e.top := e.top + ht; + e.height := e.height- ht; //end end alRight: @@ -874,7 +882,7 @@ type tcontrol = class(tcomponent) begin ht := min(e.height,bds[3]-bds[1]); SetBounds(e.left,e.top+e.height-ht,e.width,max(ht,2)); - e.height -= ht; + e.height := e.height - ht; end alClient: begin @@ -1108,9 +1116,11 @@ type tcontrol = class(tcomponent) begin return Fid; end - function create(Owner);override; //构造函数 + function create(aOwner);override; //构造函数 begin inherited; + FControlFlags := array(); + fautosize := false; if ifnil(FSIDC)then FSIDC := new tidcreater(100); FId := FSIDC.createid(); //init(); @@ -1122,7 +1132,7 @@ type tcontrol = class(tcomponent) FVisible := True; FParentBidiMode := True; FParentColor := false; - FParentFont := false; + FParentFont := true; //FDesktopFont := True; FParentShowHint := True; FIsControl := False; @@ -1408,7 +1418,7 @@ type tcontrol = class(tcomponent) return e.Result; end property ActionLink read FActionLink; //write FActionLink; - {public + public procedure AdjustSize;virtual; // smart calling DoAutoSize begin includestate(FControlFlags,cfAutoSizeNeeded); @@ -1416,7 +1426,15 @@ type tcontrol = class(tcomponent) begin Parent.AdjustSize(); // end - end } + end + function AutoSizeDelayed();virtual; + begin + + end + function AutoSizeDelayedHandle();virtual; + begin + return not(Parent); + end protected property UnAlignBounds read GetUnAlignBounds write SetUnAlignBounds; {** @@ -1428,8 +1446,9 @@ type tcontrol = class(tcomponent) published // standard properties, which should be supported by all descendants property Action:taction read GetAction write SetAction; - property Anchors:anchors read FAnchors write SetAnchors; + property Anchors read FAnchors write SetAnchors; //anchors 暂时屏蔽anchors property Align:align read FAlign write SetAlign; + property autosize read fautosize write setautosize; property ParentFont:bool read FParentFont write SetParentFont; property Parentcolor:bool read FParentcolor write SetParentcolor; property Caption:string read GetText write SetText ; diff --git a/funcext/tvclib/tcustomcontrol.tsf b/funcext/tvclib/tcustomcontrol.tsf index 31b209c..0a5fb27 100644 --- a/funcext/tvclib/tcustomcontrol.tsf +++ b/funcext/tvclib/tcustomcontrol.tsf @@ -10,15 +10,16 @@ type tcustomcontrol=class(TWinControl) procedure PaintWindow(DC:HDC);override; begin //odh := canvas.Handle; - Canvas.Handle := dc; - canvas.font := font; - canvas.brush.Color := Color; - Canvas.requiregdi(); - Canvas.rcpaint := PAINTSTRUCT().rcpaint(); + cvs := Canvas; + cvs.Handle := dc; + cvs.font := font; + cvs.brush.Color := Color; + cvs.requiregdi(); + cvs.rcpaint := PAINTSTRUCT().rcpaint(); try Paint(); finally - Canvas.Handle := 0; + cvs.Handle := 0; end; end procedure Paint();override; @@ -32,6 +33,7 @@ type tcustomcontrol=class(TWinControl) begin fhassplitter++; end + inherited; end function ControlDeleted(AControl);override; begin @@ -71,7 +73,13 @@ type tcustomcontrol=class(TWinControl) function DoHScroll(o,e);virtual; begin end + public + + function DoControlAlign();override; + begin + inherited; + end function WMVScroll(o,e):LM_VScroll;virtual; begin return DoVScroll(o,e); @@ -334,7 +342,10 @@ BFC6105000000097048597300000EC300000EC301C76FA8640000010D49444154 end fsplitercache := nil; end - end + end + + + private fsplitterdragimglist; fsplitterwilldrag; fsplitterdraging; @@ -342,5 +353,5 @@ BFC6105000000097048597300000EC300000EC301C76FA8640000010D49444154 fcursplitter; fcursplitterid; fsplitercache; - fhassplitter; + fhassplitter; end; \ No newline at end of file diff --git a/funcext/tvclib/tcustomscrollcontrol.tsf b/funcext/tvclib/tcustomscrollcontrol.tsf index 827535d..9266a3e 100644 --- a/funcext/tvclib/tcustomscrollcontrol.tsf +++ b/funcext/tvclib/tcustomscrollcontrol.tsf @@ -213,24 +213,24 @@ type tcustomscrollcontrol = class(TCustomControl) // 用户点击滚动条上边的三角形 SB_LINEUP: begin - FSI.nPos -= 1; + FSI.nPos := FSI.nPos - 1; end // 用户点击滚动条下边的三角形 SB_LINEDOWN: begin - FSI.nPos += 1; + FSI.nPos := FSI.nPos + 1; end // 用户点击滑块上边的滚动条轴 SB_PAGEUP: begin //return ; - FSI.nPos -= FSI.nPage; + FSI.nPos := FSI.nPos - FSI.nPage; end // 用户点击滑块下边的滚动条轴 SB_PAGEDOWN: begin //return ; - FSI.nPos += FSI.nPage; + FSI.nPos := FSI.nPos + FSI.nPage; end // 用户拖动滚动条 SB_THUMBTRACK: @@ -279,22 +279,22 @@ type tcustomscrollcontrol = class(TCustomControl) end SB_LINELEFT: begin - FSI.nPos -= 1; + FSI.nPos := FSI.nPos - 1; end // 用户点击滚动条右边的三角形 SB_LINERIGHT: begin - FSI.nPos += 1; + FSI.nPos := FSI.nPos + 1; end // 用户点击滑块左边的滚动条轴 SB_PAGELEFT: begin - FSI.nPos -= FSI.nPage; + FSI.nPos := FSI.nPos - FSI.nPage; end // 用户点击滑块右边的滚动条轴 SB_PAGERIGHT: begin - FSI.nPos += FSI.nPage; + FSI.nPos := FSI.nPos + FSI.nPage; end // 用户拖动滚动条 SB_THUMBTRACK: diff --git a/funcext/tvclib/tgraphiccontrol.tsf b/funcext/tvclib/tgraphiccontrol.tsf index e6ea6cc..3f3c3fc 100644 --- a/funcext/tvclib/tgraphiccontrol.tsf +++ b/funcext/tvclib/tgraphiccontrol.tsf @@ -102,23 +102,15 @@ type tgraphiccontrol = class(TControl) dc := Message.wparam; if dc then begin - //_wapi.ReleaseDC(Canvas.Handle); - //odh := canvas.Handle; Canvas.Handle := dc; try - _wapi.SetViewportOrgEx(dc,FLeft,FTop,nil); - //_send_(WM_ERASEBKGND,dc,1,1); - //Perform(new tuieventbase(WM_ERASEBKGND,dc,1)); - //Perform(messagecreater(nil,WM_ERASEBKGND,dc,1)); WMERASEBKGND(self(true),messagecreater(nil,WM_ERASEBKGND,dc,2)); Canvas.SaveDC(); Paint(); Canvas.RestoreDC(); - //Canvas. finally - Canvas.Handle := odh; + Canvas.Handle := 0; end; - //Canvas.Handle := _wapi.GetDC(self.Handle); end end function WMERASEBKGND(o,e):WM_ERASEBKGND;override; @@ -137,7 +129,7 @@ type tgraphiccontrol = class(TControl) begin if Enabled then cl := Color; - else cl := cl_disabled_brush; + else cl := cldisabledbk; if ifnumber(cl)then begin Canvas.Brush.Color := cl; @@ -159,12 +151,11 @@ type tgraphiccontrol = class(TControl) function Create(AOwner:TComponent);override; begin inherited; - //inherited Create(AOwner); FLeft := 10; FTop := 10; FWidth := 80; FHeight := 25; - ftransparent := false; + ftransparent := true; includestate(FControlState,csCustomPaint); end function Recycling();override; @@ -182,6 +173,7 @@ type tgraphiccontrol = class(TControl) InvalidateRect(); end end + published property OnPaint:eventhandler read FOnPaint write FOnPaint; property transparent:bool read ftransparent write settransparent; {** diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index a2f44e5..cf61b30 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/funcext/tvclib/tslvcl.tsf @@ -312,6 +312,8 @@ type tapplication=class(tcomponent) fexitdolist.Push(f); end end + property color read getcolor write setcolor; + property font read getfont write setfont; property Visible read FVisible write SetVisible; property handle read FHandle; property IfDebug read FDebug write FDebug; @@ -338,6 +340,26 @@ type tapplication=class(tcomponent) end fexitdolist := nil; end + function getcolor(); + begin + initialize(); + return FApplicationWindow.Color; + end + function SetColor(c); + begin + initialize(); + FApplicationWindow.Color := c; + end + function getfont(); + begin + initialize(); + return FApplicationWindow.font; + end + function Setfont(c); + begin + initialize(); + FApplicationWindow.font := c; + end end type TLabel = class(TcustomLabel) @@ -347,12 +369,21 @@ type TLabel = class(TcustomLabel) function create(AOwner);override; begin inherited; + Parentcolor := true; end {** @param(TextAlign)(member of TAlignStyle9) 文字对齐 %% **} end - +type tbevel = class(tcustombevel) + {** + @explan(说明)bevel控件 %% + **} + function create(AOwner);override; + begin + inherited; + end +end type TWinControlWraper=class(TWinControl) {** @explan(说明) 包裹window句柄类,继承该类,根据CreateWnd 注释的提示重写该函数 @@ -473,8 +504,10 @@ type TScrollingWinControl = class(TCustomScrollControl) begin continue; end - c.Top -= dy; - c.Left -= dx; + //c.Top -= dy; + c.Top :=c.Top - dy; + //c.Left -= dx; + c.Left := c.Left - dx; end end public @@ -505,6 +538,11 @@ type TPanel=class(TScrollingWinControl) // **} function create(AOwner);override; begin + fborderwidth := 0; + fbevelwidth := 0; + fbevelinner := bvLowered; + fbevelouter:= bvLowered; + fbevelcolor := 0x20000000; //160,160,160 inherited; end function AfterConstruction();override; @@ -528,7 +566,161 @@ type TPanel=class(TScrollingWinControl) // begin inherited; drawdesigninggrid(); + paint_Bevel(); end + function GetClientRect();override; + begin + calc_client(); + return frclient; + end + published + property borderwidth read fborderwidth write setborderwidth; + property bevelinner:tbevelcut read fbevelinner write setbevelinner; + property bevelouter:tbevelcut read fbevelouter write setbevelouter; + property bevelwidth:integer read fbevelwidth write setbevelwidth; + property bevelcolor:Color read fbevelcolor write setbevelcolor; + private //bevel + function rec_to_points(rec); + begin + return (array(rec[array(0,1)],rec[array(2,1)],rec[array(2,3)],rec[array(0,3)],rec[array(0,1)])); + end + function paint_Bevel(); + begin + if fbevelwidth<1 then return ; + cvs := Canvas; + c := fbevelcolor; + cvs.pen.Width := 1; + cvs.pen.color := c; + cvs.pen.Style := PS_SOLID; + if c .& 0x20000000 then // + begin + cc := cl3DShadow;// 0x8000000 .| COLOR_3DSHADOW ;//0xa0a0a0; + cb := cl3DLight;//0x8000000 .| COLOR_3DHILIGHT ; + if fbevelouter=bvLowered then + begin + paint_border(cvs,frobevel,fbevelwidth,cc,cb); + end else + if fbevelouter=bvRaised then + begin + paint_border(cvs,frobevel,fbevelwidth,cb,cc); + end + if fbevelinner=bvLowered then + begin + paint_border(cvs,fribevel,fbevelwidth,cc,cb); + end else + if fbevelinner=bvRaised then + begin + paint_border(cvs,fribevel,fbevelwidth,cb,cc); + end + + end else + begin + cc := c; + if fbevelinner=bvLowered or fbevelinner=bvRaised then paint_border(cvs,fribevel,fbevelwidth,cc,cc); + if fbevelouter=bvLowered or fbevelouter=bvRaised then paint_border(cvs,frobevel,fbevelwidth,cc,cc); + end + end + function paint_border(cvs,rec,wd,c1,c2); + begin + cvs.pen.Color := c1; + for i := 0 to wd-1 do + begin + ps := rec_to_points( rec_inc(rec,i)); + if c1=c2 then + begin + cvs.draw("polyline",ps); + end else + begin + cvs.pen.Color := c1; + cvs.moveto(ps[3]); + cvs.LineTo(ps[0]); + cvs.LineTo(ps[1]); + cvs.pen.Color := c2; + cvs.moveto(ps[1]); + cvs.LineTo(ps[2]); + cvs.LineTo(ps[3]); + end + end + + end + function calc_client();//计算边框，bevel的外层 + begin + frobevel := getwndclientrect(); + frborder := rec_inc(frobevel,(fbevelouter<>bvNone)?fbevelwidth:0); + fribevel := rec_inc(frborder,fborderwidth); + frclient := rec_inc(fribevel,(fbevelouter<>bvNone)?fbevelwidth:0); + end + function setbevelinner(v); + begin + if v>=0 and v<=3 then + begin + nv := int(v); + if nv<>fbevelinner then + begin + fbevelinner := nv; + if fbevelwidth>1 then InvalidateRect(nil,false); + end + end + end + function setbevelouter(v); + begin + if v>=0 and v<=3 then + begin + nv := int(v); + if nv<>fbevelouter then + begin + fbevelouter := nv; + if fbevelwidth>0 then InvalidateRect(nil,false); + end + end + end + function setbevelcolor(v); + begin + if v>=0 or v<0 then + begin + nv := int(v); + if nv<>fbevelcolor then + begin + fbevelcolor := nv; + if fbevelwidth>0 then InvalidateRect(nil,false); + end + end + end + function setbevelwidth(v); + begin + if v>=0 then + begin + nv := integer(v); + if nv<30 and (fbevelwidth<>nv) then + begin + fbevelwidth := nv; + doControlALign(); + end + end + end + function setborderwidth(v); + begin + if not(v>=0) then return ; + nv := integer(v); + if nv>30 then return ; + if fborderwidth<>nv then + begin + fborderwidth := nv; + DoControlAlign(); + end + end + private //bevel; + fborderwidth; //////////bevel + fbevelinner; + fbevelouter; + fbevelwidth; + fbevelcolor; + /////////////////////bevel 临时变量 + frobevel; + fribevel; + frborder; + frclient; + end //托盘 type TTray=class(TComponent) @@ -1892,7 +2084,7 @@ type TColorbox=class(TcustomListBox) fcustomcolor := nil; arr := array( ("value":"Custom","color":nil), - ("value":"None","color":nil), + ("value":"None","color":0x1fffffff), ("value":"Black","color":0), ("value":"Maroon","color":128), ("value":"Green","color":32768), @@ -2008,9 +2200,11 @@ type TColorbox=class(TcustomListBox) r["color"] := cl; FitemData.splice(0,1,r); p := parent ; - if p is class(TColorCombobox) then p.Notification(self,"customcolorchanged"); + if p is class(TColorCombobox) then p.Notification(self,"customcolorchanged"); + InvalidateRect(nil,false); end end + private fcustomcolor; FCdlg; multiSel; @@ -2451,6 +2645,8 @@ type TTreeView=class(TTreeCtl) border := true; HasLine := true; nodecreator := class(TTreeNode); + Border := true; + bordercolor := rgb(171,173,179); end function expand(item); begin @@ -4482,6 +4678,8 @@ type tapplicationwindow=class(TWinControl) begin //class(TWinControl).create(AOwner); inherited; + ParentFont := false; + Parentcolor := false; caption := "applicationwindow"; FLeft := 0; FTop := 0; diff --git a/funcext/tvclib/twincontrol.tsf b/funcext/tvclib/twincontrol.tsf index 6e04dbd..a3d3f5c 100644 --- a/funcext/tvclib/twincontrol.tsf +++ b/funcext/tvclib/twincontrol.tsf @@ -358,6 +358,7 @@ type TWinControl = class(tcontrol) {** @explan(说明)初始化 %% **} + if not _wapi then inherited; if ifnil(FDefaultProc)then FDefaultProc := _wapi.getDefWindowProcA() ; end function SetBorder(v);override; //type_twinctrol @@ -444,6 +445,7 @@ type TWinControl = class(tcontrol) begin p.ExStyle .|= WS_EX_DLGMODALFRAME; end + //if not fWsPopUp then p.ExStyle .|= WS_EX_LAYERED; //透明处理 if TabStop then p.Style .|= WS_TABSTOP; //op := parent; if not(Enabled)then p.Style .|= WS_DISABLED; @@ -755,58 +757,83 @@ type TWinControl = class(tcontrol) function ImageChanged();virtual; begin end - + function ncpaint(rec);virtual; + begin + return ; + ls := array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0)); + cvs := Canvas; + cvs.moveto(ls[0]); + for i:= 1 to length(ls) do + begin + cvs.LineTo(ls[i]); + end + end function WMNCPAINT(o,e):LM_NCPAINT;virtual; begin + hWnd := Handle; + rec := zeros(4); + cvs := Canvas; + pc := cvs.pen.Color; + ps := cvs.Pen.Style; + pw := cvs.Pen.width; if (csDesigning in ComponentState) and FDesignSelect then - begin - hWnd := Handle; - rec := zeros(4); - {$ifdef linux} - - cvs := Canvas; - cvs.Handle := e.lparam;; - pc := cvs.pen.Color; - cvs.Pen.Color := 244;//rgb(224,0,0); - ps := cvs.Pen.Style; - pw := cvs.Pen.width; + begin + {$ifdef gtkpaint} + cvs.Handle := e.lparam; + cvs.Pen.Color := 244;//rgb(224,0,0); cvs.Pen.Style := PS_SOLID; cvs.Pen.width := 2; _wapi.gtk_widget_get_allocation(hWnd,rec); - rec[0]:=0; - rec[1] := 0; - //rec[2]-=2; - //rec[3]-=2; - //cvs.FillRect(array(0,0,width,height)); //array(0,0,width,height) + rec[0]:=0;rec[1] := 0; cvs.Draw("Polyline",array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0))); - cvs.Pen.Color := pc; - cvs.Pen.width := pw; - cvs.Pen.Style := ps; - cvs.Handle := 0; + cvs.Pen.Color := pc; cvs.Pen.width := pw;cvs.Pen.Style := ps;cvs.Handle := 0; return ; {$endif} _wapi.GetWindowRect(hwnd,rec); region := new TRGNRECT(); region.Rect := rec; - if e.wparam =1 then - begin - end else - begin - _wapi.CombineRgn(region.Handle,e.wparam,nil,RGN_COPY); - end + if e.wparam <> 1 then _wapi.CombineRgn(region.Handle,e.wparam,nil,RGN_COPY); hdc := _wapi.GetDCEx(hWnd, region.Handle, DCX_WINDOW .| DCX_CACHE .| DCX_INTERSECTRGN .| DCX_LOCKWINDOWUPDATE); if hdc=0 then return ; - cvs := Canvas; cvs.Handle := hdc; cvs.Pen.Color := 244;//rgb(224,0,0); cvs.Pen.Style := PS_SOLID; cvs.Pen.width := 2; defaulthandler(e); - //cvs.FillRect(array(0,0,width,height)); //array(0,0,width,height) - cvs.Draw("Polyline",array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0))); + cvs.Draw("Polyline",array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0))); + cvs.Pen.Color := pc; cvs.Pen.width := pw;cvs.Pen.Style := ps;cvs.Handle := 0; _wapi.ReleaseDC(hWnd,hdc); - e.skip := true; - e.Result := 0; + e.skip := true;e.Result := 0; + end else + begin + if not Border then return ; + if WsCaption or WSSizebox or WSsysMenu then return ; + + {$ifdef gtkpaint} + _wapi.gtk_widget_get_allocation(hWnd,rec);rec[0]:=0;rec[1] := 0; + cvs.Handle := e.lparam; + {$else} + + _wapi.GetWindowRect(hwnd,rec); + region := new TRGNRECT(); + region.Rect := rec;//array(rec[0]-1,rec[1],rec[2],rec[3]); + if e.wparam <> 1 then _wapi.CombineRgn(region.Handle,e.wparam,nil,RGN_COPY); + hdc := _wapi.GetDCEx(hWnd, region.Handle, DCX_WINDOW .| DCX_CACHE .| DCX_INTERSECTRGN .| DCX_LOCKWINDOWUPDATE); + if hdc=0 then return ; + cvs.Handle := hdc; + defaulthandler(e); + {$endif} + cvs.pen.Color := 0; + cvs.Pen.Style := PS_SOLID; + cvs.Pen.width := 1; + ncpaint(rec); + cvs.Pen.Color := pc; cvs.Pen.width := pw;cvs.Pen.Style := ps;cvs.Handle := 0; + {$ifdef gtkpaint} + {$else} + _wapi.ReleaseDC(hWnd,hdc); + {$endif} + e.skip := true;e.Result := 0; + return ; end end procedure FontChanged(Sender:TObject);override; @@ -815,7 +842,7 @@ type TWinControl = class(tcontrol) for i := 0 to ControlCount-1 do begin it := Controls[i]; - if it.ParentFont then + if it and it.ParentFont then begin it.FontChanged(sender); end @@ -871,7 +898,7 @@ type TWinControl = class(tcontrol) for i := 0 to ControlCount-1 do begin it := Controls[i]; - it.Perform(new tuieventbase(CM_PARENTFONTCHANGED,hd,1,0)); + if it then it.Perform(new tuieventbase(CM_PARENTFONTCHANGED,hd,1,0)); end end function WMSETFONT(o,e):WM_SETFONT;virtual; @@ -890,13 +917,9 @@ type TWinControl = class(tcontrol) factivecontrol.SetFocus(); end end - function GetClientRect();override; + function getwndclientrect(); begin - {** - @explan(说明)获得客户区大小 %% - @return(array of integer) 客户区矩形 %% - **} - ret := inherited; + ret := array(0,0,FWidth,Height); if HandleAllocated()then begin if ifnumber(FClientWdith)and ifnumber(FClientHeight)then @@ -905,10 +928,16 @@ type TWinControl = class(tcontrol) end else _wapi.GetClientRect(self.Handle,ret); end - //else ret := array(0,0,FClientWdith,FClientHeight); return ret; + end + function GetClientRect();override; + begin + {** + @explan(说明)获得客户区大小 %% + @return(array of integer) 客户区矩形 %% + **} + return getwndclientrect(); end - #!begin //消息 function DoCNALIGN(o,e);override; begin @@ -976,10 +1005,10 @@ type TWinControl = class(tcontrol) wd := 1; hwd := wd; rc := new TCRect(e.lparam); - rc.top += hwd; - rc.left += wd; - rc.bottom -= wd; - rc.right -= wd; + rc.top := rc.top + hwd; + rc.left := rc.left + wd; + rc.bottom := rc.bottom - wd; + rc.right := rc.right - wd; end end function WMMOUSEHOVER(o,e):WM_MOUSEHOVER;virtual; @@ -1018,7 +1047,7 @@ type TWinControl = class(tcontrol) cl := Color; end else begin - cl := cl_disabled_brush; + cl := cldisabledbk; end rect := array(0,0,0,0); if e.lparam=2 then @@ -1185,7 +1214,7 @@ type TWinControl = class(tcontrol) for i := 0 to cts.Count-1 do begin ci := cts[i]; - if(ci is class(TWinControl))and ci.Enabled and ci.Visible and ci.TabStop and ci.HandleAllocated()then + if ci and (ci is class(TWinControl))and ci.Enabled and ci.Visible and ci.TabStop and ci.HandleAllocated()then begin if ci.Handle=cfoc then //找到了当前 begin @@ -1254,7 +1283,7 @@ type TWinControl = class(tcontrol) DC := _wapi.BeginPaint(hd,ps._getptr_); if DC=0 then exit; try - c := ClientRect; + c := getwndclientrect() ;//ClientRect; memdc := dc; {$ifdef gdipaint} mdc := _wapi.GetDC(0); @@ -1268,13 +1297,14 @@ type TWinControl = class(tcontrol) _wapi.SetGraphicsMode(memdc,2); {$else} - cr := ClientRect; + cr := getwndclientrect(); //rc := ps._getvalue_("rcpaint"); - img := _wapi.cairo_image_surface_create(1,cr[2]-cr[0]+100,cr[3]-cr[1]+100); - memdc := _wapi.cairo_create(img); - - rcpaint := ps.rcpaint; + img := _wapi.cairo_image_surface_create(1,cr[2]-cr[0]+1,cr[3]-cr[1]+1); + memdc := _wapi.cairo_create(img); _wapi.gtk_object_set_data(memdc,nil); + _wapi.gtk_object_set_data(memdc,"-surface-",img); + rcpaint := ps.rcpaint; + _wapi.cairo_reset_clip(memdc); rng := _wapi.CreateRectRgn(rcpaint[0],rcpaint[1],rcpaint[2],rcpaint[3]); _wapi.SelectClipRgn(memdc,rng); @@ -1291,6 +1321,32 @@ type TWinControl = class(tcontrol) {$ifdef gdipaint} _wapi.RestoreDC(memdc,-1); _wapi.BitBlt(dc,rc[0],rc[1],rc[2]-rc[0],rc[3]-rc[1],memdc,rc[0],rc[1],SRCCOPY); //_wapi.BitBlt(dc,c[0],c[1],c[2],c[3],memdc,0,0,SRCCOPY); + global g_save_wind; + if ifarray(g_save_wind) and g_save_wind["handle"]= hd then + begin + gsi := g_save_wind; + g_save_wind := nil; + fn := gsi["file"]; + if fn and ifstring(fn) then + begin + tp := gsi["type"]; + if not(tp in array("png","bmp")) then tp := "png"; + if parseregexpr("\\."$tp$"$",fn,"",m,mp,ml)<>1 then fn+="."$tp; + try + ndc := _wapi.CreateCompatibleDC(memdc); + bthandle := _wapi.CreateCompatibleBitmap(memdc,c[2]-c[0],c[3]-c[1]); + oldb := _wapi.SelectObject(ndc,bthandle); + _wapi.BitBlt(ndc,0,0,c[2]-c[0],c[3]-c[1],dc,0,0,SRCCOPY); + if oldb then _wapi.SelectObject(ndc,oldb); + nmg := new tcustomimage(); + nmg.FromHBitmap(bthandle); + nmg.SavetoFile(fn,tp); + finally + _wapi.DeleteDC(ndc); + _wapi.DeleteObject(bthandle); + end; + end + end {$else} _wapi.SelectClipRgn(memdc,0); _wapi.cairo_set_source_surface(dc, img, 0, 0); @@ -1308,7 +1364,7 @@ type TWinControl = class(tcontrol) _wapi.SelectObject(memdc,oldmp); _wapi.DeleteDC(memdc); _wapi.DeleteObject(mbit); - + {$else} {$endif} @@ -1323,7 +1379,7 @@ type TWinControl = class(tcontrol) for i := 0 to ctls.Count-1 do begin ci := ctls[i]; - if ci is class(TGraphicControl)then + if ci and (ci is class(TGraphicControl))then begin flag := false; break; @@ -1374,7 +1430,7 @@ type TWinControl = class(tcontrol) @explan(说明) key 按下 %% @param(o)(TWinControl) 控件自身 %% @Param(e)(TMKEY) 消息对象 %% - **} + **} end function keypress(o,e);virtual; begin @@ -1403,10 +1459,11 @@ type TWinControl = class(tcontrol) protected //样式相关 function SetColor(v);override; begin + if not ifnumber(v) then return ; oc := color; - if oc <> v and ifnumber(v)then + inherited; + if oc <> Color then begin - inherited; if HandleAllocated()then invalidaterect(nil,false); end end @@ -1443,30 +1500,27 @@ type TWinControl = class(tcontrol) begin it := FControls[i]; if it is class(TGraphicControl)then - begin + begin if not(it.Visible)then continue; itbounds := it.GetBoundsRect(); if not(intersectrect(itbounds,rcpaint,outrect))then begin continue; - end - //rgb := _wapi.CreateRectRgn(itbounds[0],itbounds[1],itbounds[2],itbounds[3]); //控件区域 + end rgb := _wapi.CreateRectRgn(outrect[0],outrect[1],outrect[2],outrect[3]); //控件区域 - //_wapi.CombineRgn(rgC,rga,rgb,RGN_AND); //控件绘画区域 - //bkrg := _wapi.SelectClipRgn(TheMessage.wparam,rgc); //裁剪区域 - //bkrg := - _wapi.SelectClipRgn(TheMessage.wparam,rgb); //裁剪区域 + bkrg := _wapi.SelectClipRgn(TheMessage.wparam,rgb); //裁剪区域 try pts := it.PaintStruct(); pts._setvalue_("rcpaint",array(outrect[0]-itbounds[0],outrect[1]-itbounds[1],outrect[2]-itbounds[0],outrect[3]-itbounds[1])); pts._setvalue_("hdc",TheMessage.wparam); ne := new tuieventbase(LM_PAINT,TheMessage.wparam,TheMessage.lparam,TheMessage.hwnd); + _wapi.SetViewportOrgEx(TheMessage.wparam,itbounds[0],itbounds[1],nil); it.Perform(ne); _wapi.SetViewportOrgEx(TheMessage.wparam,c[0],c[1],nil); //恢复基准点 finally - //_wapi.SelectClipRgn(TheMessage.wparam,bkrg); //恢复区域 + _wapi.SelectClipRgn(TheMessage.wparam,bkrg); //恢复区域 _wapi.DeleteObject(rgb); //销毁区域 - end; + end; end end finally @@ -1862,9 +1916,10 @@ type TWinControl = class(tcontrol) while(Control is class(TWinControl)) and(Control <> Self) do Control := Control.Parent; return Control=Self; end - function create(owner);override; //type_twinctrol + function create(aowner);override; //type_twinctrol begin inherited; + //fbordercolor := rgb(190,190,190); AfterConstruction(); if foncreated then begin @@ -1984,7 +2039,7 @@ type TWinControl = class(tcontrol) begin cv := canvas; if not(cv.HandleAllocated()) then return ; - rc := ClientRect; + rc := getwndclientrect(); dx := 20; dy := 20; x := 0; @@ -2009,7 +2064,7 @@ type TWinControl = class(tcontrol) for i:= 0 to len do begin vi := ctls[i]; - if vi is class(TWinControl) then + if vi and (vi is class(TWinControl)) then begin if vi.WsPopUp then continue; if not(vi.Visible) then continue; @@ -2530,12 +2585,12 @@ type TWinControl = class(tcontrol) e := new TMALIGN(CN_ALIGN,0,0,0); E.left := rect[0]; e.top := rect[1]; - e.width := rect[2]; - e.height := rect[3]; + e.width := rect[2]-rect[0]; + e.height := rect[3]-rect[1]; for i := 0 to ControlCount-1 do begin it := Controls[i]; - if it is class(tcontrol)then + if it and (it is class(tcontrol))then begin //if it.Align=alNone then continue; it.Dispatch(it,e); @@ -2593,9 +2648,13 @@ type TWinControl = class(tcontrol) **} for I := 0 to ControlCount-1 do begin - Controls[I].WindowProc(e); - if e.skip then Exit; - if not ifnil(e.Result)then Exit; + it := Controls[I]; + if it then + begin + it.WindowProc(e); + if e.skip then Exit; + if not ifnil(e.Result)then Exit; + end end; end; procedure NotifyControls(Msg); //type_twinctrol @@ -2649,6 +2708,7 @@ type TWinControl = class(tcontrol) end end published //对外property + /////////////////////////////////////////////// property MinWidth:natural read FMinWidth write SetMinWidth; property MinHeight:natural read FMinHeigt write SetMinHeight; //property MaxWidth:integer read FMaxWidth write SetMaxWidth; diff --git a/funcext/tvclib/ugtkinterface.tsf b/funcext/tvclib/ugtkinterface.tsf index 1c92244..d4a54fb 100644 --- a/funcext/tvclib/ugtkinterface.tsf +++ b/funcext/tvclib/ugtkinterface.tsf @@ -656,6 +656,13 @@ type tsgtkapi = class(tgtkapis) end function GetSysColor(idx:integer):integer; begin + cl := array(13158600,0,13743257,14405055,15790320,16777215,6579300,0,0,0, + 11842740,16578548,11250603,14120960,16777215,15790320, + 10526880,7171437,0,0,16777215,6908265,14935011,0,14811135,0, + 13395456,15389113,15918295,16750899,15790320); + r := cl[idx]; + if ifnil(r) then return 0xffffff; + return r; if idx = 0x5 then begin return 0xffffff; @@ -840,8 +847,8 @@ type tsgtkapi = class(tgtkapis) end "rgn": begin - x := gtk_object_get_data(dc,"viewport.x"); - y := gtk_object_get_data(dc,"viewport.y"); + x := 0;//gtk_object_get_data(dc,"viewport.x"); + y := 0;//gtk_object_get_data(dc,"viewport.y"); r := gtk_object_get_data(hdc,"rgn"); gtk_object_set_data(hdc,"rgn",gdiobj); if obj[2]="poly" then @@ -875,8 +882,8 @@ type tsgtkapi = class(tgtkapis) cl := gtk_object_get_data(hdc,"text.color"); // gtk_rgb_color_rgb(cl,r,g,b); // cairo_set_source_rgb(hdc, r, g, b); - xb := gtk_object_get_data(hdc,"viewport.x"); - yb := gtk_object_get_data(hdc,"viewport.y"); + xb := 0;//gtk_object_get_data(hdc,"viewport.x"); + yb := 0;//gtk_object_get_data(hdc,"viewport.y"); ft := gtk_object_get_data(hdc,"font"); global gtk_gdi_object_globals; if ft and ifarray(gtk_gdi_object_globals) then @@ -1028,10 +1035,10 @@ type tsgtkapi = class(tgtkapis) begin cairo_move_to(hdc,xx,yy-1); cairo_line_to(hdc,(xx+wid*vl),yy-1); + cairo_stroke(hdc); end cairo_move_to(hdc,xx,yy); cairo_show_text(hdc,TslStringToGtk(v0)); - cairo_stroke(hdc); end return 1; end @@ -1129,8 +1136,8 @@ type tsgtkapi = class(tgtkapis) end dht := max(ht-20,0)*0.08;//处理字体过大可能被覆盖的问题 20241012 cairo_save(hdc); - x := gtk_object_get_data(hdc,"viewport.x"); - y := gtk_object_get_data(hdc,"viewport.y"); + x := 0;//gtk_object_get_data(hdc,"viewport.x"); + y := 0;//gtk_object_get_data(hdc,"viewport.y"); reci := array(rec[0]+x,rec[1]+y,rec[2]+x,rec[3]+y); cairo_clip_rec(hdc,reci); r := TextOutexA(hdc,sx,sy-dht,txt,slen); @@ -1223,8 +1230,8 @@ type tsgtkapi = class(tgtkapis) brs := gtk_gdi_object_globals[inttostr(br)]; if not brs then return 0; cl := brs[0].Color; - x := gtk_object_get_data(dc,"viewport.x"); - y := gtk_object_get_data(dc,"viewport.y"); + x := 0;//gtk_object_get_data(dc,"viewport.x"); + y := 0;//gtk_object_get_data(dc,"viewport.y"); cairo_rectangle(dc, x+rec[0], y+rec[1], rec[2]-rec[0], rec[3]-rec[1]); gtk_rgb_color_rgb(cl,r,g,b); cairo_set_source_rgb(dc,r,g,b); @@ -1241,8 +1248,8 @@ type tsgtkapi = class(tgtkapis) brs := gtk_gdi_object_globals[inttostr(br)]; if not brs then return 0; cl := brs[0].Color; - x := gtk_object_get_data(dc,"viewport.x"); - y := gtk_object_get_data(dc,"viewport.y"); + x := 0;//gtk_object_get_data(dc,"viewport.x"); + y := 0;//gtk_object_get_data(dc,"viewport.y"); cairo_rectangle(dc, x+rec[0], y+rec[1], rec[2]-rec[0], rec[3]-rec[1]); gtk_rgb_color_rgb(cl,r,g,b); cairo_set_source_rgb(dc,1-r,1-g,1-b); @@ -1312,12 +1319,24 @@ type tsgtkapi = class(tgtkapis) function SetViewportOrgEx(dc:pointer;x:integer;y:integer;var pt:array of integer):integer; begin - if not dc then return 0; - gtk_object_set_data(dc,"viewport.x",x); - gtk_object_set_data(dc,"viewport.y",y); + if not getViewportOrgEx(dc,pt) then return 0; + if pt[0]<>0 or pt[1]<>0 then + begin + cairo_translate(dc,0-pt[0],0-pt[1]); + end + cairo_translate(dc,x,y); + gtk_object_set_data(dc,"viewport.x1",x); + gtk_object_set_data(dc,"viewport.y1",y); return 1; - end - + end + function getViewportOrgEx(dc:pointer;var pt:array of integer):integer; + begin + if not dc then return 0; + pt := array(); + pt[0] := gtk_object_get_data(dc,"viewport.x1"); + pt[1] := gtk_object_get_data(dc,"viewport.y1"); + return 1; + end function DeleteObject(gdiobj :pointer);//删除gdi对象 begin global gtk_gdi_object_globals,g_cairo_api; @@ -1398,8 +1417,8 @@ type tsgtkapi = class(tgtkapis) end Function MoveToEx(hdc :pointer;x:integer;y:integer;var point:array of integer):integer; begin - xb := gtk_object_get_data(hdc,"viewport.x"); - yb := gtk_object_get_data(hdc,"viewport.y"); + xb := 0;//gtk_object_get_data(hdc,"viewport.x"); + yb := 0;//gtk_object_get_data(hdc,"viewport.y"); //cairo_move_to(hdc,x+xb,y+yb); xy := gtk_object_get_data(hdc,"movepointto"); if xy then @@ -1410,8 +1429,8 @@ type tsgtkapi = class(tgtkapis) end Function LineTo(dc :pointer;x:integer;y:integer):integer; begin - xb := gtk_object_get_data(dc,"viewport.x"); - yb := gtk_object_get_data(dc,"viewport.y"); + xb := 0;//gtk_object_get_data(dc,"viewport.x"); + yb := 0;//gtk_object_get_data(dc,"viewport.y"); pw := gtk_object_get_data(dc,"pen.width"); if pw>0 then cairo_set_line_width(dc,pw); else cairo_set_line_width(dc,1); @@ -1637,8 +1656,8 @@ type tsgtkapi = class(tgtkapis) end Function Rectangle(dc :pointer;l:integer;t:integer;r:integer;b:integer):integer; begin - x := gtk_object_get_data(dc,"viewport.x"); - y := gtk_object_get_data(dc,"viewport.y"); + x := 0;//gtk_object_get_data(dc,"viewport.x"); + y := 0;//gtk_object_get_data(dc,"viewport.y"); pw := gtk_object_get_data(dc,"pen.width"); if pw>0 then cairo_set_line_width(dc,pw); else cairo_set_line_width(dc,1); @@ -1668,31 +1687,34 @@ type tsgtkapi = class(tgtkapis) begin //圆心 //长度 - x := gtk_object_get_data(dc,"viewport.x"); - y := gtk_object_get_data(dc,"viewport.y"); + x := 0;//gtk_object_get_data(dc,"viewport.x"); + y := 0;//gtk_object_get_data(dc,"viewport.y"); pw := gtk_object_get_data(dc,"pen.width"); if pw>0 then cairo_set_line_width(dc,pw); else cairo_set_line_width(dc,1); mx := (l+r)/2+x; my := (b+t)/2+y; + cairo_save(dc); cairo_translate(dc,mx,my); rx := (r-l)/2; ry := (b-t)/2; cairo_scale(dc,1,ry/rx); - cairo_applay_pen_style(dc); + cairo_applay_pen_style(dc); + cairo_move_to(dc,0,0); cairo_arc(dc, 0, 0, rx, 0, 2 * pi()); cairo_set_brush_color(dc); cairo_fill_preserve(dc); cairo_set_pen_color(dc); - cairo_stroke(dc); - cairo_scale(dc,1,rx/ry); - cairo_translate(dc,0-mx,0-my); + cairo_stroke(dc); + cairo_restore(dc); + //cairo_scale(dc,1,rx/ry); + //cairo_translate(dc,0-mx,0-my); return 1; end Function RoundRect(dc :pointer;l:integer;t:integer;r:integer;b:integer;wid:integer;ht:integer):integer; begin - xb := gtk_object_get_data(dc,"viewport.x"); - yb := gtk_object_get_data(dc,"viewport.y"); + xb := 0;//gtk_object_get_data(dc,"viewport.x"); + yb := 0;//gtk_object_get_data(dc,"viewport.y"); pw := gtk_object_get_data(dc,"pen.width"); if pw>0 then cairo_set_line_width(dc,pw); @@ -1707,14 +1729,15 @@ type tsgtkapi = class(tgtkapis) end Function Chord(hdc :pointer;l:integer;t:integer;r:integer;b:integer;wid:integer;ht:integer):integer; begin - x := gtk_object_get_data(dc,"viewport.x"); - y := gtk_object_get_data(dc,"viewport.y"); + x := 0;//gtk_object_get_data(dc,"viewport.x"); + y := 0;//gtk_object_get_data(dc,"viewport.y"); pw := gtk_object_get_data(dc,"pen.width"); direct := gtk_object_get_data(dc,"arcdirection"); if pw>0 then cairo_set_line_width(dc,pw); else cairo_set_line_width(dc,1); mx := (l+r)/2+x; my := (b+t)/2+y; + cairo_save(dc); cairo_translate(dc,mx,my); rx := (r-l)/2; ry := (b-t)/2; @@ -1726,6 +1749,7 @@ type tsgtkapi = class(tgtkapis) yy2 := (nYRadial2-my); arg1 := getargbyxy(xx1,yy1); arg2 := getargbyxy(xx2,yy2); + cairo_move_to(dc,0,0); if direct=2 then begin cairo_arc(dc, 0, 0, rx, arg1, arg2); @@ -1733,28 +1757,28 @@ type tsgtkapi = class(tgtkapis) else begin cairo_arc(dc, 0, 0, rx, arg2, arg1); - end - + end cairo_set_brush_color(dc); cairo_move_to(dc,cos(arg1)*rx,sin(arg1)*rx); cairo_line_to(dc,cos(arg2)*rx,sin(arg2)*rx); cairo_fill_preserve(dc); - cairo_set_pen_color(dc); - - cairo_stroke(dc); - cairo_scale(dc,1,rx/ry); - cairo_translate(dc,0-mx,0-my); + cairo_set_pen_color(dc); + cairo_stroke(dc); + cairo_restore(dc); + //cairo_scale(dc,1,rx/ry); + //cairo_translate(dc,0-mx,0-my); end Function Pie(dc :pointer;l:integer;t:integer;r:integer;b:integer;nXRadial1:integer;nYRadial1:integer;nXRadial2:integer;nYRadial2:integer):integer; begin - x := gtk_object_get_data(dc,"viewport.x"); - y := gtk_object_get_data(dc,"viewport.y"); + x := 0;//gtk_object_get_data(dc,"viewport.x"); + y := 0;//gtk_object_get_data(dc,"viewport.y"); pw := gtk_object_get_data(dc,"pen.width"); direct := gtk_object_get_data(dc,"arcdirection"); if pw>0 then cairo_set_line_width(dc,pw); else cairo_set_line_width(dc,1); mx := (l+r)/2+x; my := (b+t)/2+y; + cairo_save(dc); cairo_translate(dc,mx,my); rx := (r-l)/2; ry := (b-t)/2; @@ -1765,7 +1789,8 @@ type tsgtkapi = class(tgtkapis) xx2 := nXRadial2-mx; yy2 := (nYRadial2-my); arg1 := getargbyxy(xx1,yy1); - arg2 := getargbyxy(xx2,yy2); + arg2 := getargbyxy(xx2,yy2); + cairo_move_to(dc,0,0); if direct=2 then begin cairo_arc(dc, 0, 0, rx, arg1, arg2); @@ -1781,9 +1806,10 @@ type tsgtkapi = class(tgtkapis) cairo_fill_preserve(dc); cairo_set_pen_color(dc); - cairo_stroke(dc); - cairo_scale(dc,1,rx/ry); - cairo_translate(dc,0-mx,0-my); + cairo_stroke(dc); + cairo_restore(dc); + //cairo_scale(dc,1,rx/ry); + //cairo_translate(dc,0-mx,0-my); end Function SetArcDirection(dc :pointer;direct:integer):integer; begin @@ -1832,8 +1858,8 @@ type tsgtkapi = class(tgtkapis) //Function Arc(hdc :pointer;nLeftRect:integer;nTopRect:integer;nRightRect:integer;nBottomRect:integer;nXRadial1:integer;nYRadial1:integer;nXRadial2:integer;nYRadial2:integer):integer; Function Arc(dc :pointer;l:integer;t:integer;r:integer;b:integer;nXRadial1:integer;nYRadial1:integer;nXRadial2:integer;nYRadial2:integer):integer; begin - x := gtk_object_get_data(dc,"viewport.x"); - y := gtk_object_get_data(dc,"viewport.y"); + x := 0;//gtk_object_get_data(dc,"viewport.x"); + y := 0;//gtk_object_get_data(dc,"viewport.y"); pw := gtk_object_get_data(dc,"pen.width"); //brc := gtk_object_get_data(dc,"brush.color"); direct := gtk_object_get_data(dc,"arcdirection"); @@ -1841,6 +1867,7 @@ type tsgtkapi = class(tgtkapis) else cairo_set_line_width(dc,1); mx := (l+r)/2+x; my := (b+t)/2+y; + cairo_save(dc); cairo_translate(dc,mx,my); rx := (r-l)/2; ry := (b-t)/2; @@ -1870,24 +1897,26 @@ type tsgtkapi = class(tgtkapis) end cairo_fill_preserve(dc); } cairo_set_pen_color(dc); - cairo_stroke(dc); - cairo_scale(dc,1,rx/ry); - cairo_translate(dc,0-mx,0-my); + cairo_stroke(dc); + cairo_restore(dc); + //cairo_scale(dc,1,rx/ry); + //cairo_translate(dc,0-mx,0-my); end Function Polygon(dc :pointer;points:array of integer;n:integer):integer; begin if n<3 then return ; - x := gtk_object_get_data(dc,"viewport.x"); - y := gtk_object_get_data(dc,"viewport.y"); + x := 0;//gtk_object_get_data(dc,"viewport.x"); + y := 0;//gtk_object_get_data(dc,"viewport.y"); pw := gtk_object_get_data(dc,"pen.width"); if pw>0 then cairo_set_line_width(dc,pw); - else cairo_set_line_width(dc,1); - + else cairo_set_line_width(dc,1); //cairo_move_to(dc,points[0]+x,Points[1]+y); cairo_applay_pen_style(dc); for i := 0 to n-1 do begin - cairo_line_to(dc,Points[i,0]+x,Points[i,1]+y); + if i = 0 then cairo_move_to(dc,Points[i,0]+x,Points[i,1]+y); + else + cairo_line_to(dc,Points[i,0]+x,Points[i,1]+y); end cairo_line_to(dc,Points[0,0]+x,Points[0,1]+y); cairo_set_brush_color(dc); @@ -1898,8 +1927,8 @@ type tsgtkapi = class(tgtkapis) Function PolyBezier(dc :pointer;points:array of integer;n:integer):integer; begin if length(points)<4 then return 0; - x := gtk_object_get_data(dc,"viewport.x"); - y := gtk_object_get_data(dc,"viewport.y"); + x := 0;//gtk_object_get_data(dc,"viewport.x"); + y := 0;//gtk_object_get_data(dc,"viewport.y"); pw := gtk_object_get_data(dc,"pen.width"); if pw>0 then cairo_set_line_width(dc,pw); else cairo_set_line_width(dc,1); @@ -1920,8 +1949,8 @@ type tsgtkapi = class(tgtkapis) Function Polyline(dc :pointer;points:array of integer;n:integer):integer; begin if n<2 then return ; - x := gtk_object_get_data(dc,"viewport.x"); - y := gtk_object_get_data(dc,"viewport.y"); + x := 0;//gtk_object_get_data(dc,"viewport.x"); + y := 0;//gtk_object_get_data(dc,"viewport.y"); pw := gtk_object_get_data(dc,"pen.width"); if pw>0 then cairo_set_line_width(dc,pw); else cairo_set_line_width(dc,1); @@ -1929,7 +1958,9 @@ type tsgtkapi = class(tgtkapis) cairo_applay_pen_style(dc); for i := 0 to n-1 do begin - cairo_line_to(dc,Points[i,0]+x,Points[i,1]+y); + if i = 0 then cairo_move_to(dc,Points[i,0]+x,Points[i,1]+y); + else + cairo_line_to(dc,Points[i,0]+x,Points[i,1]+y); end cairo_stroke(dc); end @@ -1953,8 +1984,8 @@ type tsgtkapi = class(tgtkapis) DFCS_ADJUSTRECT := 0x2000;DFCS_FLAT := 0x4000;DFCS_MONO := 0x8000; } - x := gtk_object_get_data(dc,"viewport.x"); - y := gtk_object_get_data(dc,"viewport.y"); + x := 0;//gtk_object_get_data(dc,"viewport.x"); + y := 0;//gtk_object_get_data(dc,"viewport.y"); case dr1 of 0x4 : //DFC_BUTTON begin @@ -2000,6 +2031,7 @@ type tsgtkapi = class(tgtkapis) b := LPRECT[3]; mx := (l+r)/2+x; my := (b+t)/2+y; + cairo_save(dc); cairo_translate(dc,mx,my); rx := (r-l)/2; ry := (b-t)/2; @@ -2013,8 +2045,9 @@ type tsgtkapi = class(tgtkapis) cairo_arc(dc, 0, 0, max(rx-5,3), 0, 2 * 3.14); cairo_set_source_rgb(dc,100/255,100/255,100/255); cairo_fill(dc); - cairo_scale(dc,1,rx/ry); - cairo_translate(dc,0-mx,0-my); + cairo_restore(dc); + //cairo_scale(dc,1,rx/ry); + //cairo_translate(dc,0-mx,0-my); end else if dr2 = 0x4 then // DFCS_BUTTONRADIO begin @@ -2026,6 +2059,7 @@ type tsgtkapi = class(tgtkapis) b := LPRECT[3]; mx := (l+r)/2+x; my := (b+t)/2+y; + cairo_save(dc); cairo_translate(dc,mx,my); rx := (r-l)/2; ry := (b-t)/2; @@ -2035,8 +2069,9 @@ type tsgtkapi = class(tgtkapis) cairo_stroke_preserve(dc); cairo_set_source_rgb(dc,1,1,1); cairo_fill(dc); - cairo_scale(dc,1,rx/ry); - cairo_translate(dc,0-mx,0-my); + cairo_restore(dc); + //cairo_scale(dc,1,rx/ry); + //cairo_translate(dc,0-mx,0-my); end else begin cairo_set_line_width(dc,4); @@ -2234,8 +2269,8 @@ type tsgtkapi = class(tgtkapis) begin global g_cairo_api; if not hdc then return ; - xb := gtk_object_get_data(hdc,"viewport.x"); - yb := gtk_object_get_data(hdc,"viewport.y"); + xb := 0;//gtk_object_get_data(hdc,"viewport.x"); + yb := 0;//gtk_object_get_data(hdc,"viewport.y"); img := g_cairo_api.GdipGetbmpSurface(bm); //cairo_set_source(hdc, img); //cairo_pattern_set_extend(cairo_get_source(hdc),1); @@ -2262,8 +2297,8 @@ type tsgtkapi = class(tgtkapis) begin global g_cairo_api; if not hdc then return ; - xb := gtk_object_get_data(hdc,"viewport.x"); - yb := gtk_object_get_data(hdc,"viewport.y"); + xb := 0;//gtk_object_get_data(hdc,"viewport.x"); + yb := 0;//gtk_object_get_data(hdc,"viewport.y"); img := g_cairo_api.GdipGetbmpSurface(bm); if not img then return ; x := drect[0]; @@ -2271,35 +2306,49 @@ type tsgtkapi = class(tgtkapis) p1 := (drect[2]-drect[0])/(rc[2]-rc[0]); p2 := (drect[3]-drect[1])/(rc[3]-rc[1]); if p1<0 or p2<0 then return 0; + cairo_save(hdc); cairo_translate(hdc,xb+x,yb+y); cairo_scale(hdc,p1,p2); cairo_set_source_surface(hdc, img, 0, 0); - cairo_rectangle(hdc,0,0,rc[2]-rc[0],rc[3]-rc[1]); + cairo_rectangle(hdc,0,0,rc[2]-rc[0],rc[3]-rc[1]); + if flag = 0x8800c6 or flag = 0x4 then //添加alpha处理 begin //echo "\r\nset alopha*******+++****************"; - cairo_paint_with_alpha(hdc,0.5); - cairo_set_source_rgba(hdc, 0.6, 0.6, 0.6, 0.5); + alf := 0.5; + cairo_paint_with_alpha(hdc,alf); + cairo_set_source_rgba(hdc, 0.6, 0.6, 0.6, alf); end else begin - //cairo_paint_with_alpha(hdc,0); - cairo_paint_with_alpha(hdc,1); + alf := gtk_object_get_data(hdc,"alpha"); + if alf>0 then + begin + cairo_paint_with_alpha(hdc,(alf/255)); + end else cairo_paint_with_alpha(hdc,1); cairo_set_source_rgba(hdc, 1.0, 1.0, 1.0, 0); end cairo_fill(hdc); - cairo_scale(hdc,1/p1,1/p2); - cairo_translate(hdc,0-xb-x,0-yb-y); + cairo_restore(hdc); + //cairo_scale(hdc,1/p1,1/p2); + //cairo_translate(hdc,0-xb-x,0-yb-y); end function DrawIcon(hDC:pointer;X:integer;Y:integer;hIcon:pointer):integer; begin global g_cairo_api; if not hdc then return ; - xb := gtk_object_get_data(hdc,"viewport.x"); - yb := gtk_object_get_data(hdc,"viewport.y"); + xb := 0;//gtk_object_get_data(hdc,"viewport.x"); + yb := 0;//gtk_object_get_data(hdc,"viewport.y"); img := g_cairo_api.GdipGetbmpSurface(hIcon); if not img then return 0; + cairo_save(hdc); cairo_set_source_surface(hdc, img, x+xb, y+yb); + alf := gtk_object_get_data(hdc,"alpha"); + if alf>0 then + begin + cairo_paint_with_alpha(hdc,(alf/255)); + end else cairo_paint_with_alpha(hdc,1); cairo_paint(hdc); + cairo_restore(hdc); return true; end //////////////////////imagelist///////////////////////////////////////////////////////////////////////// @@ -3260,6 +3309,15 @@ type tmenuitemobject = class(tgtk_ctl_object) //gtk end end type tgtkapis = class(t_cairo_api) //gtk对象api接口 + procedure cairo_set_source_rgb(c:pointer;r:double;g:double;b:double); + begin + v := gtk_object_get_data(c,"alpha") ; + if v>0 and v<255 then + begin + return cairo_set_source_rgba(c,r,g,b,(v/255)); + end + return class(t_cairo_api).cairo_set_source_rgb(c,r,g,b); + end function gtk_object_set_data(h,n,v); //保存数据 begin if not(h>0 or h<0) then return 0; @@ -4943,6 +5001,11 @@ type tgtkapis = class(t_cairo_api) //gtk _f_ := static procedure(w:pointer;f:integer);cdecl;external getfuncptrbyname(0,functionname()); return ##_f_(w,f); end + procedure gtk_widget_set_opacity(w:pointer;f:double); + begin + _f_ := static procedure(w:pointer;f:double);cdecl;external getfuncptrbyname(0,functionname()); + return ##_f_(w,f); + end procedure gtk_window_set_transient_for(w:pointer;p:pointer); begin global g_applicaton_wnd_handle; @@ -5809,6 +5872,17 @@ type tgtkapis = class(t_cairo_api) //gtk _f_ := static function():pointer; cdecl;external getfuncptrbyname(0,functionname()); return ##_f_(); end + function gdk_pixbuf_get_from_window(wd:pointer;x:integer;y:integer;w:integer;h:integer):pointer; + begin + _f_ := static function(wd:pointer;x:integer;y:integer;w:integer;h:integer):pointer;cdecl;external getfuncptrbyname(0,functionname()); + return ##_f_(wd,x,y,w,h); + end + function gdk_window_create_similar_surface(wd:pointer;ctx:integer;w:integer;h:integer):pointer; + begin + _f_ := static function(wd:pointer;ctx:integer;w:integer;h:integer):pointer;cdecl;external getfuncptrbyname(0,functionname()); + return ##_f_(wd,ctx,w,h); + end + function gdk_pixbuf_get_width(src_pixbuf:pointer):integer; begin _f_ := static function(src_pixbuf:pointer):integer;cdecl;external getfuncptrbyname(0,functionname()); @@ -8300,7 +8374,7 @@ type tgtk_ctl_scroll_window = class(tgtk_ctl_object) //hd := a.handle; //r := zeros(4); //_wapi.gtk_widget_get_allocation(hd,r); - //cr := _wapi.gdk_cairo_create(_wapi.gtk_widget_get_window(hd)); + //cr := _wapi.gdk_cairo_create(_wapi.gtk_widget_get_window(hd)); //_wapi.cairo_destroy(cr); cr :=c;//rec := r; rec := zeros(4); _wapi.gdk_cairo_get_clip_rectangle(cr,rec); _Wapi.g_object_set_data(cr,nil); @@ -8316,17 +8390,18 @@ type tgtk_ctl_scroll_window = class(tgtk_ctl_object) _wapi.gtk_widget_get_allocation(hd,r); if (r[2]<=(rec[0]+rec[2])) or (r[3]<=(rec[1]+rec[3])) then begin + _wapi.gtk_object_set_data(cr,"alpha",nil); _wapi.cairo_set_dash(cr,array(4.0,0.0),2,0); if (FExdwstyle .& _const.WS_EX_DLGMODALFRAME)= _const.WS_EX_DLGMODALFRAME then begin - _wapi.cairo_set_source_rgb(cr, 225/255, 225/255, 225/255); - _wapi.cairo_set_line_width (cr, 2); + _wapi.cairo_set_source_rgb(cr, 220, 220, 220); + _wapi.cairo_set_line_width (cr, 1.5); _wapi.cairo_rectangle(cr,0,0,r[2]-1,r[3]-1); _wapi.cairo_stroke(cr); end if (Fdwstyle .& _const.WS_BORDER)= _const.WS_BORDER then begin - _wapi.cairo_set_source_rgb(cr, 100/255, 100/255, 100/255); + _wapi.cairo_set_source_rgb(cr, 210, 210, 210); _wapi.cairo_set_line_width(cr, 0.5); _wapi.cairo_rectangle(cr,1,1,r[2]-1,r[3]-1); _wapi.cairo_stroke(cr); @@ -8334,8 +8409,26 @@ type tgtk_ctl_scroll_window = class(tgtk_ctl_object) CallTslVclProc(_const.WM_NCPAINT,0,cr); //绘制 end end - //_wapi.cairo_destroy(cr); - _wapi.gtk_object_set_data(cr); + _wapi.gtk_object_set_data(cr);//清除标记 + + global g_save_wind; + if not ifarray(g_save_wind) then return ; + if g_save_wind["handle"] <> hwd then return ; + gsi := g_save_wind; + g_save_wind := nil; + fn := gsi["file"]; + if not(fn and ifstring(fn)) then return ; + fn := ansitoutf8(fn); + r := zeros(4); + hd := a.handle; + _wapi.gtk_widget_get_allocation(hd,r); + gwd := _wapi.gtk_widget_get_window(hd); + pix := _wapi.gdk_pixbuf_get_from_window(gwd,r[0],r[1],r[2],r[3]); + tp := gsi["type"]; + if not(tp in array("png","bmp")) then tp := "png"; + if parseregexpr("\\."$tp$"$",fn,"",m,mp,ml)<>1 then fn+="."$tp; + gdk_pixbuf_save(pix,fn,tp,nil,nil,nil,nil,nil,nil); + end; function CreateWnd(dwExStyle,lpClassName,lpWindowName,dwStyle,x,y,nwidth,nheight,hwndparent,hmenu,hinstance,lpParam);override; begin @@ -8817,6 +8910,11 @@ type tgtk_ctl_scroll_window = class(tgtk_ctl_object) FVBardown; //滚动条按下 FHBardown; FScroller; + function gdk_pixbuf_save(pixbuf:pointer;p:string;tp:string;gerr:string;p1:string; p2:string;p3:string;p4:string;p5:string):integer; + begin + _f_ := static function(pixbuf:pointer;p:string;tp:string;gerr:string;p1:string; p2:string;p3:string;p4:string;p5:string):integer;cdecl;external getdlsymaddress("libgtk-3.so.0",functionname()); + return ##_f_(pixbuf,p,tp,gerr,p1,p2,p3,p4,p5); + end end type tgtk_ctl_object_client = class(tgtk_ctl_object) diff --git a/funcext/tvclib/utslmemo.tsf b/funcext/tvclib/utslmemo.tsf index 861c164..983b631 100644 --- a/funcext/tvclib/utslmemo.tsf +++ b/funcext/tvclib/utslmemo.tsf @@ -492,7 +492,6 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) // FGutterCharCount; //gutter 字符个数 Fautogutterwidth; //自动设置gutter宽度 FGutter; //gutter - FMarginTop; FLines; fLastCaretY; //最新y位置 //fCaretLineNeedPaint; @@ -537,11 +536,13 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) // end} function GetClientXCapacity();override; //宽度容量 begin - return integer(ClientRect[2]/GetXScrollDelta()); + c := ClientRect; + return integer((c[2]-c[0])/GetXScrollDelta()); end function GetClientYCapacity();override; //高度容量 begin - return integer(ClientRect[3]/GetYScrollDelta()); + c := ClientRect; + return integer((c[3]-c[1])/GetYScrollDelta()); end function GetClientXCount();override; //宽度间隔 begin @@ -585,8 +586,8 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) // ps := PAINTSTRUCT().rcPaint; tp := ps[1]; bo := ps[3]; - FirstLine := integer(max(0,yPos+(tp-FMarginTop)/GetYScrollDelta())); - LastLine := integer(min(FLines.Length()-1,yPos+(bo-FMarginTop)/GetYScrollDelta())); + FirstLine := integer(max(0,yPos+(tp)/GetYScrollDelta())); + LastLine := integer(min(FLines.Length()-1,yPos+(bo)/GetYScrollDelta())); if FGutterCharCount>0 and(ps[0]0))+FGutterCharCount * FCharWidth+1; - FCharHeight := Font.Height; + FCharHeight := ft.Height; fTextHeight := FCharHeight+FLineInterval; ReCreateCaret(); UpDateScroll(); diff --git a/funcext/tvclib/utslvclauxiliary.tsf b/funcext/tvclib/utslvclauxiliary.tsf index 866c64c..2a9a95c 100644 --- a/funcext/tvclib/utslvclauxiliary.tsf +++ b/funcext/tvclib/utslvclauxiliary.tsf @@ -52,6 +52,7 @@ function TS_GetAppPath():string; function TS_GetIniPath(t:integer;iname:string):string; function gettslexefullpath(); function int_to_binary(d,n); //整数转换成字符串 +function rec_inc(rec,n); //挑战区域大小 //function tsl_str_head_at(s,n); function get_tsl_mem_ptr(s,n); type tuiglobaldata=class() //全局对象存储 @@ -4154,6 +4155,17 @@ begin end return r; end +function rec_inc(rec,n); +begin + r := rec; + r[0]+=n; + r[1]+=n; + r[2]-=n; + r[3]-=n; + if r[2]0 then r := ret[0:t/4]; return r; - end - + end function Toolhelp32Snapshot(); begin {** - @explan(说明) 获取所有进程信息 %% + @explan(说明) 获取所有进程信息，仅支持windows %% @param() @return(array) 进程信息 %% **} +{$ifdef linux} + return array(); +{$endif } currentProcess := new Ttagprocessentry32(); hProcess := CreateToolhelp32Snapshot(2,0); //给系统内的所有进程拍一个快照 r := array(); @@ -120,8 +128,11 @@ uses uwindowsinterface; function Toolhelp32Snapshotmodule(id); begin {** - @explan(说明) 获取所有module信息 + @explan(说明) 获取所有module信息，仅支持windows **} +{$ifdef linux} + return array(); +{$endif } if not(id >= 0)then id := 0; currentProcess := new TtagMODULEENTRY32(); hProcess := CreateToolhelp32Snapshot(8,id); //给系统内的所有进程拍一个快照 @@ -140,6 +151,9 @@ uses uwindowsinterface; end function Comctl32version(); //获取comctl32.dll版本 begin +{$ifdef linux} + return array(); +{$endif } o := tslcstructure(array( ("cbsize","int",0), ("dwmajorversion","int",0), @@ -152,6 +166,9 @@ uses uwindowsinterface; end function shell32Version(); //获取shell32.dll版本 begin +{$ifdef linux} + return array(); +{$endif } o := tslcstructure(array( ("cbsize","int",0), ("dwmajorversion","int",0), @@ -195,8 +212,7 @@ type TSLUIBASE=class(TSLUICONST) //图 {** @explan(说明)图像库基类,提供基本的底层操作和常量 %% **} - private - + private static const TSLRCS_NONE = 0; static const TSLRCS_BEGIN = 1; static const TSLRCS_END = 2; @@ -227,16 +243,19 @@ type TSLUIBASE=class(TSLUICONST) //图 {** @explan(说明)初始化win32接口对象_wapi **} - if not(_wapi)then + if not(_wapi is class(tswin32api))then begin global G_O_TSWIN32API_; if not G_O_TSWIN32API_ then G_O_TSWIN32API_ := new tswin32api(); _wapi := G_O_TSWIN32API_; - FTSLkeyWords := TSL_ReservedKeys2(); - FTSLkeyWordshash := array(); - for i,v in FTSLkeyWords do - begin - FTSLkeyWordshash[v] := true; + if not FTSLkeyWordshash then + begin + FTSLkeyWords := TSL_ReservedKeys2(); + FTSLkeyWordshash := array(); + for i,v in FTSLkeyWords do + begin + FTSLkeyWordshash[v] := true; + end end end if not FHAPP then @@ -244,13 +263,13 @@ type TSLUIBASE=class(TSLUICONST) //图 FHAPP := _wapi.GetModuleHandleA(0); end end - class Function isKeyWords(key); + class Function isKeyWords(k); begin {** @explan(说明) 判断是否为tsl关键字 %% - @param(key)(string) + @param(k)(string) **} - return ifstring(key)and ifarray(FTSLkeyWordshash) and( FTSLkeyWordshash[lowercase(key)]); + return ifstring(k)and ifarray(FTSLkeyWordshash) and( FTSLkeyWordshash[lowercase(k)]); return false; end @@ -406,10 +425,6 @@ type TWMNCHITTEST=class(TSLUICONST) // hittest return 0; end end - - implementation - initialization - end. \ No newline at end of file diff --git a/funcext/tvclib/utslvclcef.tsf b/funcext/tvclib/utslvclcef.tsf index b206f9e..043f563 100644 --- a/funcext/tvclib/utslvclcef.tsf +++ b/funcext/tvclib/utslvclcef.tsf @@ -24,6 +24,11 @@ type tcefowner = class(tcustomcontrol) finitcef := true; sinit(); fcefloop := new tcefproc(); + fcefapp.on_before_command_line_processing := function(o,u,cmd) + begin + //cmd.set_program(%% D:\Program Files\Tinysoft\AnalyseNG.NET\tsl_cef_main.exe%%); + cmd.append_argument("single-process"); + end app := initializeapplication(); app.addExitMessageLoopdo(thisfunction(cef_shutdown)); cef_initialize(fargs._getptr_(), fappsetting._getptr_(), fcefapp._getptr_(),0); @@ -71,7 +76,7 @@ type tcefowner = class(tcustomcontrol) width := 300; height := 300; fwinfo := new cef_window_info_t(); - fclient := new cef_client_t(); + fclient := new cef_client_t(); {frm := new cef_life_span_handler_t(); frm.on_after_created := function(o,b)begin echo "\r\n craeteted:",b.get_main_frame().get_url(),"<<"; @@ -107,7 +112,7 @@ type tcefowner = class(tcustomcontrol) muh := new cef_context_menu_handler_t(); muh.on_before_context_menu := function(o,b,f,pms,d)begin ppm := PopupMenu; - if d then d.remove(132); + if d then d.remove(0x84); if ppm then begin fpopupmenushine := array(); @@ -126,9 +131,10 @@ type tcefowner = class(tcustomcontrol) return 1; end end - fclient.context_menu_handler := muh; - fclient.download_handler := d; - fbrssetting := new cef_browser_settings_t(); + //fclient.context_menu_handler := muh; + //fclient.download_handler := d; + fbrssetting := new cef_browser_settings_t(); + ftimer := new TTimer(self); end function checknewchild(c);override; begin @@ -243,20 +249,22 @@ type tcefowner = class(tcustomcontrol) end end published + property client read fclient; + property appsetting read getappsetting; property url:string read furl write seturl; property oncandownload:eventhandler read FOncandownload write FOncandownload; property Ondownloadupdate:eventhandler read FOndownloadupdate write fOndownloadupdate; private - function seturl(url); //设置url + function seturl(u); //设置url begin - if furl<>url then + if furl<>u then begin - furl := url; + furl := u; if HandleAllocated() then begin - if fbrower and (fm := fbrower.get_main_frame()) then + if fbrower {and (fm := fbrower.get_main_frame())} then begin - fm.load_url(url); + add_lazy_load(); end else begin initbrowser(); @@ -277,9 +285,26 @@ type tcefowner = class(tcustomcontrol) fwinfo.bounds.y := r[1]; fwinfo.bounds.width := r[2]; fwinfo.bounds.height := r[3]; - fbrower := cef_browser_host_create_browser_sync_tsl(fwinfo, fclient,furl, fbrssetting, 0, 0); + fbrower := cef_browser_host_create_browser_sync_tsl(fwinfo, fclient,"", fbrssetting, 0, 0); + add_lazy_load(); end end + function lazy_load(); + begin + if not fneedload then return ; + if fbrower then + begin + fm := fbrower.get_main_frame(); + if fm then + fm.load_url(furl); + fneedload := false; + end + end + function add_lazy_load(); + begin + fneedload := true; + ftimer.timeout(thisfunction(lazy_load()),60); + end function createusrmenu(mu,d,idx); //构造菜单映射 begin if not mu then return ;// @@ -343,7 +368,9 @@ type tcefowner = class(tcustomcontrol) furl; fwinfo; fbrssetting; - fhandlebk; + fhandlebk; + ftimer; + fneedload; class function tslpath(); //tsl.exe 目录 begin p := pluginpath(); @@ -354,6 +381,10 @@ type tcefowner = class(tcustomcontrol) end return p; end + function getappsetting(); + begin + return fappsetting; + end end type tcandownevent = class(tuieventbase) //是否可以下载 function create(m,w,l,h);override; diff --git a/funcext/tvclib/utslvclcefinterface.tsf b/funcext/tvclib/utslvclcefinterface.tsf index 9ecd897..79f9e19 100644 --- a/funcext/tvclib/utslvclcefinterface.tsf +++ b/funcext/tvclib/utslvclcefinterface.tsf @@ -20,6 +20,9 @@ function cef_execute_process(arg:pointer;app:pointer;dow:pointer):integer; //function IsBadWritePtr(ptr:pointer;ucb:pointer):integer; function cef_command_line_get_global():pointer; function cef_command_line_create():pointer; +function cef_task_runner_get_for_current_thread(); +function cef_post_task(threadId,task); +function cef_currently_on(threadId); type t_cef_stc_base = class(tslcstructureobj) static const C_CEF_PACK = 8; function create(d,p); @@ -557,48 +560,7 @@ type cef_string_map_t = class() return r; end private - fptr; - private - function cef_string_map_alloc():pointer; - begin - _f_ := static function():pointer;cdecl;external getceffunction(functionname()); - return ##_f_(); - end - function cef_string_map_size(map:pointer):pointer; - begin - _f_ := static function(map:pointer):pointer;cdecl;external getceffunction(functionname()); - return ##_f_(map); - end - function cef_string_map_find(map:pointer;key:pointer;value:pointer):pointer; - begin - _f_ := static function(map:pointer;key:pointer;value:pointer):pointer;cdecl;external getceffunction(functionname()); - return ##_f_(map,key,value); - end - function cef_string_map_key(map:pointer;index:pointer;key:pointer):integer; - begin - _f_ := static function(map:pointer;index:pointer;key:pointer):integer;cdecl;external getceffunction(functionname()); - return ##_f_(map,index,key); - end - function cef_string_map_value(map:pointer;index:pointer;value:pointer):integer; - begin - _f_ := static function(map:pointer;index:pointer;value:pointer):integer;cdecl;external getceffunction(functionname()); - return ##_f_(map,index,value); - end - function cef_string_map_append(map:pointer;key:pointer;value:pointer):integer; - begin - _f_ := static function(map:pointer;key:pointer;value:pointer):integer;cdecl;external getceffunction(functionname()); - return ##_f_(map,key,value); - end - procedure cef_string_map_clear(map:pointer); - begin - _f_ := static procedure(map:pointer);cdecl;external getceffunction(functionname()); - return ##_f_(map); - end - procedure cef_string_map_free(map:pointer); - begin - _f_ := static procedure(map:pointer);cdecl;external getceffunction(functionname()); - return ##_f_(map); - end + fptr; end {$ifdef linux} type cef_main_args_t=class(t_cef_stc_base) @@ -782,12 +744,15 @@ type cef_contain_base = class(t_cef_stc_base) begin if flg then begin - base.size := memsize(); - base.add_ref := getinstance(thisfunction(addref)); - base.release := getinstance(thisfunction(release)); - base.has_one_ref := getinstance(thisfunction(has_one_ref)); - base.has_at_least_one_ref := getinstance(thisfunction(has_at_least_one_ref)); - end + b := base; + b.size := memsize(); + bflg := 0; + b.add_ref := getinstance(thisfunction(addref),bflg); + b.release := getinstance(thisfunction(release),bflg); + b.has_one_ref := getinstance(thisfunction(has_one_ref),bflg); + b.has_at_least_one_ref := getinstance(thisfunction(has_at_least_one_ref),bflg); + end + return true; end function savetoglobal();virtual; begin @@ -804,57 +769,49 @@ type cef_contain_base = class(t_cef_stc_base) end return 0; end - function getinstance(fn); + function getinstance(fn,md); begin if not fn then return 0; - if not ifobj(fn) then return 0; + if not ifobj(fn) then return 0; + if ifnil(md) then md :=0; r := makeweakref(fn,ok); - if ok then return makeinstance(r); - return makeinstance(fn); + if ok then return makeinstance(r,"stdcall",md); + return makeinstance(fn,"stdcall",md); end function create(ptr) begin FTSLCallbacks := array(); flg := (ptr>0 or ptr<0); - inherited create(getstruct(),ptr); - addref(_getptr_()); - aftercreate(not flg); - savetoglobal(); + inherited create(getstruct(),ptr); + //echo "\r\ncreate:", (self(true).classinfo())["classname"]," ",flg," ",_getptr_(); + fhasbase := aftercreate(not flg); + if fhasbase then + begin + b := getbase(); + cptr := b.add_ref; + crf := procedure(id:pointer);stdcall; external cptr; + pptr := _getptr_(); + ##crf(pptr); + end + //addref(_getptr_()); + savetoglobal(); end function destroy();override; begin - id := _getptr_(); - release(id); - inherited; - + if fhasbase then + begin + id := _getptr_(); + b := base; + crf := function(id:pointer):integer;stdcall; external b.release; + ##crf(id);//release(id); + end + inherited; end - property base read getbase; - procedure addref(id:pointer);stdcall;virtual; - begin - addcefref(id); - //echo "\r\n add base ref:",id,">>",getcefrefcount(id); - end - function release(id:pointer):integer;stdcall;virtual; - begin - remcefref(id); - ct := getcefrefcount(id); - //echo "\r\n release ref:",id,">>",getcefrefcount(id); - if ct<=0 then return 0; - return ct; - end - function has_one_ref(id:pointer):integer;stdcall;virtual; - begin - r := onecefref(id); - //echo "\r\n>>one ref:",id; - return r; - end - function has_at_least_one_ref(id:pointer):integer;stdcall;virtual; - begin - r := lastoneref(id); - //echo "\r\n>> last one ref:",id; - return r; - end + property base read getbase; + private + fhasbase; + end type cef_handler_base = class(cef_contain_base) function create(ptr) @@ -903,7 +860,7 @@ type cef_focus_handler_t = class(cef_handler_base) property on_take_focus index "on_take_focus" read getcallpropertybyindex write setcallpropertybyindex; procedure on_take_focus_i(s:pointer;b:pointer;nxt:integer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then call(c,self(true),cef_object_get(b,class(cef_browser_t)),nxt); end /// @@ -914,17 +871,50 @@ type cef_focus_handler_t = class(cef_handler_base) property on_set_focus index "on_set_focus" read getcallpropertybyindex write setcallpropertybyindex; function on_set_focus_i(s:pointer;b:pointer;source:integer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then return call(c,self(true),cef_object_get(b,class(cef_browser_t)),source); end /// Called when the browser component has received focus. property on_got_focus index "on_got_focus" read getcallpropertybyindex write setcallpropertybyindex; procedure on_got_focus(s:pointer;b:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then return call(c,self(true),cef_object_get(b,class(cef_browser_t))); end end +type cef_run_context_menu_callback_t=class(cef_contain_base) + private + function structdescribe();override; + begin + return array( + ("base","user",getbasestruct()), + ("cont","intptr",0), + ("cancel","intptr",0) + ); + end + public + function cont(id,event_flags); + begin + npr := _getvalue_(functionname()); + if not npr then return ; + f := procedure(s:pointer;id:integer;flg:integer);stdcall; external npr; + return ##f(_getptr_(),id,event_flags); + end + function cancel(); + begin + npr := _getvalue_(functionname()); + if not npr then return ; + f := procedure(s:pointer);stdcall; external npr; + return ##f(_getptr_()); + end +end +type cef_run_quick_menu_callback_t=class(cef_run_context_menu_callback_t) + public + function create(ptr) + begin + inherited ; + end +end type cef_context_menu_params_t=class(cef_contain_base) private function structdescribe();override; @@ -1338,7 +1328,7 @@ type cef_context_menu_handler_t=class(cef_handler_base) property on_before_context_menu index "on_before_context_menu" read getcallpropertybyindex write setcallpropertybyindex; procedure on_before_context_menu_i(sf:pointer;b:pointer;f:pointer;pms:pointer;md:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if not c then return 0; return call(c,cef_object_get(sf), cef_object_get(b,class(cef_browser_t)), @@ -1363,7 +1353,7 @@ type cef_context_menu_handler_t=class(cef_handler_base) property on_context_menu_command index "on_context_menu_command" read getcallpropertybyindex write setcallpropertybyindex; function on_context_menu_command_i(s:pointer;b:pointer;f:pointer;pms:pointer;id:integer;evtflg:integer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if not c then return 0; return call(c,cef_object_get(sf), cef_object_get(b,class(cef_browser_t)), @@ -1380,16 +1370,64 @@ type cef_context_menu_handler_t=class(cef_handler_base) property on_context_menu_dismissed index "on_context_menu_dismissed" read getcallpropertybyindex write setcallpropertybyindex; procedure on_context_menu_dismissed_i(s:pointer;b:pointer;f:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if not c then return 0; return call(c,cef_object_get(sf), cef_object_get(b,class(cef_browser_t)), cef_object_get(f,class(cef_frame_t))); end - property run_quick_menu index "run_quick_menu" read _getvalue_ write _setvalue_; + /// Called to allow custom display of the quick menu for a windowless browser. + /// |location| is the top left corner of the selected region. |size| is the + /// size of the selected region. |edit_state_flags| is a combination of flags + /// that represent the state of the quick menu. Return true (1) if the menu + /// will be handled and execute |callback| either synchronously or + /// asynchronously with the selected command ID. Return false (0) to cancel + /// the menu. + function run_quick_menu(b,f,location,size,edit_state_flags,callback); + begin + ptr := _getvalue_(functionname()); + if not ptr then return ; + //cef_run_quick_menu_callback_t + _f_ := function(s:pointer;b:pointer;f:pointer;location:array of integer ;size:array of integer;edit_state_flags:integer;callback:pointer);stdcall; external ptr; + return call(_f_,self,b._getptr_(),f._getptr_(),location,size,edit_state_flags,(callback?callback._getptr_():0)); + //return ##f(_getptr_(),index); + {recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if not c then return 0; + return call(c,cef_object_get(sf), + cef_object_get(b,class(cef_browser_t)), + cef_object_get(f,class(cef_frame_t)), + (new cef_point_t(location)), + (new cef_size_t(size)), + edit_state_flags, + cef_object_get(callback,class(cef_run_quick_menu_callback_t)), + ); } + end + /// Called to execute a command selected from the quick menu for a windowless + /// browser. Return true (1) if the command was handled or false (0) for the + /// default implementation. See cef_menu_id_t for command IDs that have + /// default implementations. property on_quick_menu_command index "on_quick_menu_command" read _getvalue_ write _setvalue_; + function on_quick_menu_command_i(s:pointer;b:pointer;f:pointer;id:integer;flg:integer):integer;stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if not c then return 0; + return call(c,cef_object_get(sf), + cef_object_get(b,class(cef_browser_t)), + cef_object_get(f,class(cef_frame_t)), + id,flg + ); + end + /// Called when the quick menu for a windowless browser is dismissed + /// irregardless of whether the menu was canceled or a command was selected. property on_quick_menu_dismissed index "on_quick_menu_dismissed" read _getvalue_ write _setvalue_; - + procedure on_quick_menu_dismissed_i(s:pointer;b:pointer;f:pointer);stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if not c then return 0; + return call(c,cef_object_get(sf), + cef_object_get(b,class(cef_browser_t)), + cef_object_get(f,class(cef_frame_t))); + end end type cef_download_handler_t=class(cef_handler_base) @@ -1417,7 +1455,7 @@ type cef_download_handler_t=class(cef_handler_base) property can_download index "can_download" read getcallpropertybyindex write setcallpropertybyindex; function can_download_i(sf:pointer;browser:pointer;url:pointer;request_method:pointer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if not c then return 0; u := new cef_string_t(url); m := new cef_string_t(request_method); @@ -1433,7 +1471,7 @@ type cef_download_handler_t=class(cef_handler_base) property on_before_download index "on_before_download" read getcallpropertybyindex write setcallpropertybyindex; procedure on_before_download_i(sf:pointer;browser:pointer;download_item:pointer;suggested_name:pointer;callback:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if not c then return; sn := new cef_string_t(suggested_name); call(c ,self(true), @@ -1454,7 +1492,7 @@ type cef_download_handler_t=class(cef_handler_base) property on_download_updated index "on_download_updated" read getcallpropertybyindex write setcallpropertybyindex; procedure on_download_updated_i(sf:pointer;browser:pointer;download_item:pointer;callback:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if not c then return; call(c,self(true), cef_object_get(browser), @@ -1482,6 +1520,183 @@ type cef_urlrequest_t=class(cef_contain_base) inherited; end end +type cef_response_t=class(cef_contain_base) + private + function structdescribe();override; + begin + return array( + ("base","user",getbasestruct()), + ("is_read_only","intptr",0), //(self) _cef_request_t + ("get_error","intptr",0), //(self) cef_urlrequest_client_t + ("set_error","intptr",0), //(self) int + ("get_status","intptr",0), //(self) int + ("set_status","intptr",0), //(self) cef_response_t + ("get_status_text","intptr",0), //(self) void + ("set_status_text","intptr",0), //(self) void + ("get_mime_type","intptr",0), //(self) void + ("set_mime_type","intptr",0), //(self) void + ("get_charset","intptr",0), //(self) void + ("set_charset","intptr",0), //(self) void + ("get_header_by_name","intptr",0), //(self) void + ("set_header_by_name","intptr",0), //(self) void + ("get_header_map","intptr",0), //(self) void + ("set_header_map","intptr",0), //(self) void + ("get_url","intptr",0), //(self) void + ("set_url","intptr",0), //(self) void + ); + end + public + function create(ptr) + begin + inherited; + end + function is_read_only(); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := function(sf:pointer):integer;cdecl;external ptr; + return ##f(_getptr_()); + end + function get_error(); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := function(sf:pointer):integer;cdecl;external ptr; + return ##f(_getptr_()); + end + function set_error(err); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := procedure(sf:pointer;err:integer);cdecl;external ptr; + return ##f(_getptr_(),err); + end + function get_status(); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := function(sf:pointer):integer;cdecl;external ptr; + return ##f(_getptr_()); + end + function set_status(err); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := procedure(sf:pointer;err:integer);cdecl;external ptr; + return ##f(_getptr_(),err); + end + function get_status_text(); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := function(sf:pointer):pointer;cdecl;external ptr; + r := ##f(_getptr_()); + if not r then return ""; + return (new cef_string_userfree_t(r)).str; + end + function set_status_text(txt:string); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := procedure(sf:pointer;err:pointer);cdecl;external ptr; + s := new cef_string_t(); + s.str := txt; + return ##f(_getptr_(),s._getptr_()); + end + function get_mime_type(); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := function(sf:pointer):pointer;cdecl;external ptr; + r := ##f(_getptr_()); + if not r then return ""; + return (new cef_string_userfree_t(r)).str; + end + function set_mime_type(txt:string); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := procedure(sf:pointer;err:pointer);cdecl;external ptr; + s := new cef_string_t(); + s.str := txt; + return ##f(_getptr_(),s._getptr_()); + end + function get_charset(); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := function(sf:pointer):pointer;cdecl;external ptr; + r := ##f(_getptr_()); + if not r then return ""; + return (new cef_string_userfree_t(r)).str; + end + function set_charset(txt:string); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := procedure(sf:pointer;txt:pointer);cdecl;external ptr; + s := new cef_string_t(); + s.str := txt; + return ##f(_getptr_(),s._getptr_()); + end + function get_header_by_name(n:string); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := function(sf:pointer;n:pointer):pointer;cdecl;external ptr; + s := new cef_string_t(); + s.str := n; + r := ##f(_getptr_(),s._getptr_()); + if not r then return ""; + return (new cef_string_userfree_t(r)).str; + end + function set_header_by_name(n:string;v:string;ow:integer); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := procedure(sf:pointer;n:pointer;v:pointer;ow:integer);cdecl;external ptr; + s := new cef_string_t(); + s.str := n; + s1 := new cef_string_t(); + s1.str := v; + return ##f(_getptr_(),s._getptr_(),s1._getptr_(),ow); + end + function get_header_map(); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := procedure(sf:pointer;headerMap:pointer);cdecl;external ptr; + hm := new cef_string_multimap_t(); + ##f(_getptr_(),hm._getptr_()); + return hm; + end + function set_header_map(hm); + begin + if not(hm is class(cef_string_map_t)) then return ; + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := procedure(sf:pointer;headerMap:pointer);cdecl;external ptr; + return ##f(_getptr_(),hm._getptr_()); + end + function get_url(); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := function(sf:pointer):pointer;cdecl;external ptr; + r := ##f(_getptr_()); + if not r then return ""; + return (new cef_string_userfree_t(r)).str; + end + function set_url(txt:string); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := procedure(sf:pointer;txt:pointer);cdecl;external ptr; + s := new cef_string_t(); + s.str := txt; + return ##f(_getptr_(),s._getptr_()); + end +end type cef_urlrequest_client_t=class(cef_contain_base) private function structdescribe();override; @@ -1794,7 +2009,7 @@ type cef_display_handler_t=class(cef_handler_base) property on_address_change index "on_address_change" read getcallpropertybyindex write setcallpropertybyindex; procedure on_address_change_i(sf:pointer;browser:pointer;frame:pointer;url:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -1807,7 +2022,7 @@ type cef_display_handler_t=class(cef_handler_base) property on_title_change index "on_title_change" read getcallpropertybyindex write setcallpropertybyindex; procedure on_title_change_i(sf:pointer;browser:pointer;title:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -1819,7 +2034,7 @@ type cef_display_handler_t=class(cef_handler_base) property on_favicon_urlchange index "on_favicon_urlchange" read getcallpropertybyindex write setcallpropertybyindex; procedure on_favicon_urlchange_i(sf:pointer;browser:pointer;icon_urls:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -1831,7 +2046,7 @@ type cef_display_handler_t=class(cef_handler_base) property on_fullscreen_mode_change index "on_fullscreen_mode_change" read getcallpropertybyindex write setcallpropertybyindex; procedure on_fullscreen_mode_change_i(sf:pointer;browser:pointer;fullscreen:integer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -1854,7 +2069,7 @@ type cef_display_handler_t=class(cef_handler_base) property on_tooltip index "on_tooltip" read getcallpropertybyindex write setcallpropertybyindex; function on_tooltip_i(sf:pointer;browser:pointer;text:pointer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -1873,7 +2088,7 @@ type cef_display_handler_t=class(cef_handler_base) property on_status_message index "on_status_message" read getcallpropertybyindex write setcallpropertybyindex; function on_status_message_i(sf:pointer;browser:pointer;value:pointer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -1895,7 +2110,7 @@ type cef_display_handler_t=class(cef_handler_base) property on_console_message index "on_console_message" read getcallpropertybyindex write setcallpropertybyindex; function on_console_message_i(sf:pointer;browser:pointer;level:integer;message:pointer;source:pointer;line:integer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -1918,7 +2133,7 @@ type cef_display_handler_t=class(cef_handler_base) property on_auto_resize index "on_auto_resize" read getcallpropertybyindex write setcallpropertybyindex; function on_auto_resize_i(sf:pointer;browser:pointer;new_size:pointer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -1942,7 +2157,7 @@ type cef_display_handler_t=class(cef_handler_base) property on_cursor_change index "on_cursor_change" read getcallpropertybyindex write setcallpropertybyindex; function on_cursor_change_i(sf:pointer;browser:pointer;cursor:pointer;ctype:integer;custom_cursor_info:pointer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -1966,7 +2181,7 @@ type cef_display_handler_t=class(cef_handler_base) property on_media_access_change index "on_media_access_change" read getcallpropertybyindex write setcallpropertybyindex; function on_media_access_change_i(sf:pointer;browser:pointer;has_video_access:integer;has_audio_access:integer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -2003,7 +2218,7 @@ type cef_frame_handler_t=class(cef_handler_base) property on_frame_created index "on_frame_created" read getcallpropertybyindex write setcallpropertybyindex; procedure on_frame_created_i(sf:pointer;browser:pointer;frame:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin call(c,self(true), @@ -2034,7 +2249,7 @@ type cef_frame_handler_t=class(cef_handler_base) property on_main_frame_changed index "on_main_frame_changed" read getcallpropertybyindex write setcallpropertybyindex; procedure on_main_frame_changed_i(sf:pointer;browser:pointer;old_frame:pointer;new_frame:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -2075,7 +2290,7 @@ type cef_find_handler_t=class(cef_handler_base) property on_find_result index "on_find_result" read getcallpropertybyindex write setcallpropertybyindex; function on_find_result_i(sf:pointer;browser:pointer;identifier:integer;count_:integer;selectionRect:pointer;activeMatchOrdinal:integer;finalUpdate:integer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -2124,7 +2339,7 @@ type cef_jsdialog_handler_t=class(cef_handler_base) property on_dialog_closed index "on_dialog_closed" read getcallpropertybyindex write setcallpropertybyindex; procedure on_dialog_closed_i(sf:pointer;browser:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -2163,7 +2378,7 @@ type cef_audio_handler_t=class(cef_handler_base) property get_audio_parameters index "get_audio_parameters" read getcallpropertybyindex write setcallpropertybyindex; function get_audio_parameters_i(sf:pointer;browser:pointer;pms:pointer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -2188,7 +2403,7 @@ type cef_audio_handler_t=class(cef_handler_base) property on_audio_stream_started index "on_audio_stream_started" read getcallpropertybyindex write setcallpropertybyindex; function on_audio_stream_started_i(sf:pointer;browser:pointer;pms:pointer;channels:integer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -2211,7 +2426,7 @@ type cef_audio_handler_t=class(cef_handler_base) property on_audio_stream_error index "on_audio_stream_error" read getcallpropertybyindex write setcallpropertybyindex; function on_audio_stream_error_i(sf:pointer;browser:pointer;message:pointer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -2309,7 +2524,7 @@ type cef_permission_handler_t=class(cef_handler_base) property on_request_media_access_permission index "on_request_media_access_permission" read getcallpropertybyindex write setcallpropertybyindex; function on_request_media_access_permission_i(sf:pointer;browser:pointer;frame:pointer;requesting_origin:pointer;requested_permissions:integer;callback:pointer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -2342,7 +2557,7 @@ type cef_permission_handler_t=class(cef_handler_base) property on_show_permission_prompt index "on_show_permission_prompt" read getcallpropertybyindex write setcallpropertybyindex; function on_show_permission_prompt_i(sf:pointer;browser:pointer;prompt_id:int64;requesting_origin:pointer;requested_permissions:integer;callback:pointer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -2371,7 +2586,7 @@ type cef_permission_handler_t=class(cef_handler_base) property on_dismiss_permission_prompt index "on_dismiss_permission_prompt" read getcallpropertybyindex write setcallpropertybyindex; procedure on_dismiss_permission_prompt_i(sf:pointer;browser:pointer;prompt_id:int64;result:integer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -2413,7 +2628,7 @@ type cef_drag_handler_t=class(cef_handler_base) property on_drag_enter index "on_drag_enter" read getcallpropertybyindex write setcallpropertybyindex; function on_drag_enter_i(sf:pointer;browser:pointer;dragData:pointer;mask:integer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -2438,7 +2653,7 @@ type cef_drag_handler_t=class(cef_handler_base) property on_draggable_regions_changed index "on_draggable_regions_changed" read getcallpropertybyindex write setcallpropertybyindex; procedure on_draggable_regions_changed_i(sf:pointer;browser:pointer;frame:pointer;regionsCount:pointer;regions:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -2450,6 +2665,60 @@ type cef_drag_handler_t=class(cef_handler_base) end end end + +type cef_stream_reader_t=class(cef_contain_base) + private + function structdescribe();override; + begin + return array( + ("base","user",getbasestruct()), + ("read","intptr",0), + ("seek","intptr",0), + ("tell","intptr",0), + ("eof","intptr",0), + ("may_block","intptr",0) + ); + end + public + function create(ptr) + begin + inherited ; + end + function read(ptr,size,n); + begin + fptr := _getvalue_(functionname()); + f := function(sf:pointer;ptr:string;size:pointer;n:pointer):pointer;cdecl;external fptr; + return ##f(_getptr_(),ptr,size,n); + end + function seek(offset,whence); + begin + ptr := _getvalue_(functionname()); + f := function(sf:pointer;offset:pointer;whence:integer):integer;cdecl;external ptr; + return ##f(_getptr_(),offset,whence); + end + function tell(); + begin + ptr := _getvalue_(functionname()); + f := function(sf:pointer):int64;cdecl;external ptr; + return ##f(_getptr_()); + end + function eof(); + begin + ptr := _getvalue_(functionname()); + f := function(sf:pointer):integer;cdecl;external ptr; + return ##f(_getptr_()); + end + /// + /// Returns true (1) if this writer performs work like accessing the file + /// system which may block. Used as a hint for determining the thread to + /// access the writer from. + function may_block(); + begin + ptr := _getvalue_(functionname()); + f := function(sf:pointer):integer;cdecl;external ptr; + return ##f(_getptr_()); + end +end type cef_stream_writer_t=class(cef_contain_base) private function structdescribe();override; @@ -2762,7 +3031,7 @@ type cef_command_handler_t=class(cef_handler_base) property on_chrome_command index "on_chrome_command" read getcallpropertybyindex write setcallpropertybyindex; function on_chrome_command_i(sf:pointer;browser:pointer;command_id:integer;disposition:integer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -2796,7 +3065,7 @@ type cef_keyboard_handler_t=class(cef_handler_base) property on_pre_key_event index "on_pre_key_event" read getcallpropertybyindex write setcallpropertybyindex; function on_pre_key_event_i(sf:pointer;b:pointer;event:pointer;os_event:pointer;var is_keyboard_shortcut:integer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin shortcut := is_keyboard_shortcut; @@ -2816,7 +3085,7 @@ type cef_keyboard_handler_t=class(cef_handler_base) property on_key_event index "on_key_event" write setcallpropertybyindex; function on_key_event_i(sf:pointer;b:pointer;event:pointer;os_event:pointer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin r := call(c,self(true), @@ -2893,7 +3162,7 @@ type cef_life_span_handler_t=class(cef_handler_base) target_disposition:integer;user_gesture:integer;popupFeatures:pointer;windowInfo:pointer; var client:pointer;settings:pointer;var extra_info:pointer;var no_javascript_access:integer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin url := new cef_string_t(target_url); @@ -2977,7 +3246,7 @@ type cef_life_span_handler_t=class(cef_handler_base) property on_after_created index "on_after_created" read getcallpropertybyindex write setcallpropertybyindex; procedure on_after_created_i(sf:pointer;browser:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then call(c,self(true), cef_object_get(browser,class(cef_browser_t)) @@ -3077,7 +3346,7 @@ type cef_life_span_handler_t=class(cef_handler_base) property do_close index "do_close" read getcallpropertybyindex write setcallpropertybyindex; function do_close_i(sf:pointer;browser:pointer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then return call(c,self(true),cef_object_get(browser,class(cef_browser_t))); end /// @@ -3096,7 +3365,7 @@ type cef_life_span_handler_t=class(cef_handler_base) property on_before_close index "on_before_close" read getcallpropertybyindex write setcallpropertybyindex; procedure on_before_close_i(sf:pointer;browser:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then return call(c,self(true), cef_object_get(browser,class(cef_browser_t)) ); @@ -3187,7 +3456,7 @@ type cef_v8handler_t = class(cef_contain_base) function execute_i(sf:pointer;n:pointer;obj:pointer;argc:pointer;argv:pointer;var r:pointer;excp:pointer):integer;stdcall; ///////需要扩展 begin n1 := new cef_string_t(n); - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return true; @@ -3250,19 +3519,53 @@ type cef_render_process_handler_t=class(cef_handler_base) //render begin inherited; end - property on_web_kit_initialized index "on_web_kit_initialized" read getcallpropertybyindex write setcallpropertybyindex; - function on_web_kit_initialized_i(sf:pointer;browser:pointer;mode:integer;title:pointer;default_file_path:pointer;accept_filters:pointer;callback:pointer):integer;stdcall; + property on_web_kit_initialized index "on_web_kit_initialized" read getcallpropertybyindex write setcallpropertybyindex; + procedure on_web_kit_initialized_i(sf:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true)); end end - property on_context_created index "on_context_created" read getcallpropertybyindex write setcallpropertybyindex; - function on_context_created_i(sf:pointer;browser:pointer;frame:pointer;ctx:pointer):integer;stdcall; + property on_browser_created index "on_browser_created" read getcallpropertybyindex write setcallpropertybyindex; + procedure on_browser_created_i(sf:pointer;b:pointer;ext:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + begin + return call(c,self(true),cef_object_get(b,class(cef_browser_t)),cef_object_get(ext,class(cef_dictionary_value_t))); + end + end + property on_browser_destroyed index "on_browser_destroyed" read getcallpropertybyindex write setcallpropertybyindex; + procedure on_browser_destroyed_i(sf:pointer;b:pointer);stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + begin + return call(c,self(true),cef_object_get(b,class(cef_browser_t))); + end + end + property get_load_handler index "get_load_handler" read getcallpropertybyindex write setcallpropertybyindex; + function get_load_handler_i(sf:pointer):pointer;stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + begin + r := call(c,self(true)) ; + if r is class(cef_load_handler_t) then return r._getptr_(); + end + end + /// Called immediately after the V8 context for a frame has been created. To + /// retrieve the JavaScript 'window' object use the + /// cef_v8context_t::get_global() function. V8 handles can only be accessed + /// from the thread on which they are created. A task runner for posting tasks + /// on the associated thread can be retrieved via the + /// cef_v8context_t::get_task_runner() function. + property on_context_created index "on_context_created" read getcallpropertybyindex write setcallpropertybyindex; + procedure on_context_created_i(sf:pointer;browser:pointer;frame:pointer;ctx:pointer);stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true),cef_object_get(browser,class(cef_browser_t)), @@ -3271,6 +3574,43 @@ type cef_render_process_handler_t=class(cef_handler_base) //render ); end end + property on_context_released index "on_context_released" read getcallpropertybyindex write setcallpropertybyindex; + procedure on_context_released_i(sf:pointer;browser:pointer;frame:pointer;ctx:pointer);stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + begin + return call(c,self(true),cef_object_get(browser,class(cef_browser_t)), + cef_object_get(frame,class(cef_frame_t)), + cef_object_get(ctx,class(cef_v8context_t)) + ); + end + end + property on_focused_node_changed index "on_focused_node_changed" read getcallpropertybyindex write setcallpropertybyindex; + procedure on_focused_node_changed_i(sf:pointer;browser:pointer;frame:pointer;node:pointer);stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + begin + return call(c,self(true),cef_object_get(browser,class(cef_browser_t)), + cef_object_get(frame,class(cef_frame_t)), + cef_object_get(node,class(cef_domnode_t)) + ); + end + end + + property on_process_message_received index "on_process_message_received" read getcallpropertybyindex write setcallpropertybyindex; + function on_process_message_received_i(sf:pointer;browser:pointer;frame:pointer;source_process:integer;message:pointer):integer;stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + begin + return call(c,self(true),cef_object_get(browser,class(cef_browser_t)), + cef_object_get(frame,class(cef_frame_t)), source_process , + cef_object_get(message,class(cef)) + ); + end + end end type cef_dialog_handler_t=class(cef_handler_base) private @@ -3303,7 +3643,7 @@ type cef_dialog_handler_t=class(cef_handler_base) property on_file_dialog index "on_file_dialog" read getcallpropertybyindex write setcallpropertybyindex; function on_file_dialog_i(sf:pointer;browser:pointer;mode:integer;title:pointer;default_file_path:pointer;accept_filters:pointer;callback:pointer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -3381,7 +3721,7 @@ type cef_load_handler_t=class(cef_handler_base) property on_loading_state_change index "on_loading_state_change" read getcallpropertybyindex write setcallpropertybyindex; procedure on_loading_state_change_i(sf:pointer;browser:pointer;isLoading:integer;canGoBack:integer;canGoForward:integer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -3409,7 +3749,7 @@ type cef_load_handler_t=class(cef_handler_base) property on_load_start index "on_load_start" write setcallpropertybyindex; procedure on_load_start_i(sf:pointer;browser:pointer;frame:pointer;transition_type:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -3435,7 +3775,7 @@ type cef_load_handler_t=class(cef_handler_base) property on_load_end index "on_load_end" read getcallpropertybyindex write setcallpropertybyindex; procedure on_load_end_i(sf:pointer;browser:pointer;frame:pointer;httpStatusCode:integer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -3459,7 +3799,7 @@ type cef_load_handler_t=class(cef_handler_base) property on_load_error index "on_load_error" write setcallpropertybyindex; procedure on_load_error_i(sf:pointer;browser:pointer;frame:pointer;errorCode:integer;errorText:pointer;failedUrl:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -3668,6 +4008,7 @@ type cef_task_runer_t=class(cef_contain_base) return ##_f_(ptr,task,delay_ms); end end + type cef_request_t=class(cef_contain_base) //cef_request_capi.h private function structdescribe();override; @@ -3715,6 +4056,7 @@ type cef_request_t=class(cef_contain_base) //cef_request_capi.h function get_url(); begin ptr := _getvalue_(functionname()); + if not ptr then return 0; f := function(s:pointer):pointer;stdcall;external ptr; s := new cef_string_userfree_t(##f(_getptr_())); return s.str; @@ -3749,6 +4091,15 @@ type cef_request_t=class(cef_contain_base) //cef_request_capi.h ##f(_getptr_(),s._getptr_()); end //property set_referrer index "set_referrer" read _getvalue_ write _setvalue_; + function set_referrer(url); + begin + if not ifstring(url) then return; + ptr := _getvalue_(functionname()); + f := procedure(s:pointer;str:pointer);stdcall;external ptr; + s := new cef_string_t(); + s.str := url; + ##f(_getptr_(),s._getptr_()); + end //property get_referrer_url index "get_referrer_url" read _getvalue_ write _setvalue_; function get_referrer_url(); begin @@ -3758,15 +4109,85 @@ type cef_request_t=class(cef_contain_base) //cef_request_capi.h return s.str; end //property get_referrer_policy index "get_referrer_policy" read _getvalue_ write _setvalue_; + function get_referrer_policy(); + begin + ptr := _getvalue_(functionname()); + f := function(s:pointer):integer;stdcall;external ptr; + return ##f(_getptr_()); + end //property get_post_data index "get_post_data" read _getvalue_ write _setvalue_; + function get_post_data(); + begin + ptr := _getvalue_(functionname()); + f := function(s:pointer):pointer;stdcall;external ptr; + return new cef_post_data_t( ##f(_getptr_())); + end //property set_post_data index "set_post_data" read _getvalue_ write _setvalue_; + function set_post_data(d); + begin + if not(d is class(cef_post_data_t)) then return 0; + ptr := _getvalue_(functionname()); + f := procedure(s:pointer;d:pointer);stdcall;external ptr; + ##f(_getptr_(),d._getptr_()); + end //property get_header_map index "get_header_map" read _getvalue_ write _setvalue_; + function get_header_map(); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := procedure(sf:pointer;headerMap:pointer);cdecl;external ptr; + hm := new cef_string_multimap_t(); + ##f(_getptr_(),hm._getptr_()); + return hm; + end //property set_header_map index "set_header_map" read _getvalue_ write _setvalue_; + function set_header_map(hm); + begin + if not(hm is class(cef_string_map_t)) then return ; + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := procedure(sf:pointer;headerMap:pointer);cdecl;external ptr; + return ##f(_getptr_(),hm._getptr_()); + end //property get_header_by_name index "get_header_by_name" read _getvalue_ write _setvalue_; + function get_header_by_name(n:string); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := function(sf:pointer;n:pointer):pointer;cdecl;external ptr; + s := new cef_string_t(); + s.str := n; + r := ##f(_getptr_(),s._getptr_()); + if not r then return ""; + return (new cef_string_userfree_t(r)).str; + end //property set_header_by_name index "set_header_by_name" read _getvalue_ write _setvalue_; + function set_header_by_name(n:string;v:string;ow:integer); + begin + ptr := _getvalue_(functionname()); + if not ptr then return 0; + f := procedure(sf:pointer;n:pointer;v:pointer;ow:integer);cdecl;external ptr; + s := new cef_string_t(); + s.str := n; + s1 := new cef_string_t(); + s1.str := v; + return ##f(_getptr_(),s._getptr_(),s1._getptr_(),ow); + end //property set index "set" read _getvalue_ write _setvalue_; //property get_flags index "get_flags" read _getvalue_ write _setvalue_; + function get_flags(); + begin + ptr := _getvalue_(functionname()); + f := function(s:pointer):integer;stdcall;external ptr; + return ##f(_getptr_()); + end //property set_flags index "set_flags" read _getvalue_ write _setvalue_; + function set_flags(flg); + begin + ptr := _getvalue_(functionname()); + f := procedure(s:pointer;flg:integer);stdcall;external ptr; + return ##f(_getptr_(),flg); + end //property get_first_party_for_cookies index "get_first_party_for_cookies" read _getvalue_ write _setvalue_; function get_first_party_for_cookies(); begin @@ -3786,8 +4207,26 @@ type cef_request_t=class(cef_contain_base) //cef_request_capi.h ##f(_getptr_(),s._getptr_()); end //property get_resource_type index "get_resource_type" read _getvalue_ write _setvalue_; + function get_resource_type(); + begin + ptr := _getvalue_(functionname()); + f := function(s:pointer):integer;stdcall;external ptr; + return ##f(_getptr_()); + end //property get_transition_type index "get_transition_type" read _getvalue_ write _setvalue_; + function get_transition_type(); + begin + ptr := _getvalue_(functionname()); + f := function(s:pointer):integer;stdcall;external ptr; + return ##f(_getptr_()); + end //property get_identifier index "get_identifier" read _getvalue_ write _setvalue_; + function get_identifier(); + begin + ptr := _getvalue_(functionname()); + f := function(s:pointer):int64;stdcall;external ptr; + return ##f(_getptr_()); + end end type cef_request_context_handler_t=class(cef_contain_base) private @@ -3798,36 +4237,183 @@ type cef_request_context_handler_t=class(cef_contain_base) ("on_request_context_initialized","intptr",0), ("get_resource_request_handler","intptr",0) ); - end + end public function create(ptr) begin inherited ; end property on_request_context_initialized index "on_request_context_initialized" read getcallpropertybyindex write setcallpropertybyindex; - procedure on_request_context_initialized_i(s:pointer;request_context:pointer );stdcall; + procedure on_request_context_initialized_i(s:pointer;rc:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then - call(c,self(true),cef_object_get(request_context,class(cef_request_context_t))); + call(c,self(true),cef_object_get(rc,class(cef_request_context_t))); end + /// + /// Called on the browser process IO thread before a resource request is + /// initiated. The |browser| and |frame| values represent the source of the + /// request, and may be NULL for requests originating from service workers or + /// cef_urlrequest_t. |request| represents the request contents and cannot be + /// modified in this callback. |is_navigation| will be true (1) if the + /// resource request is a navigation. |is_download| will be true (1) if the + /// resource request is a download. |request_initiator| is the origin (scheme + /// + domain) of the page that initiated the request. Set + /// |disable_default_handling| to true (1) to disable default handling of the + /// request, in which case it will need to be handled via + /// cef_resource_request_handler_t::GetResourceHandler or it will be canceled. + /// To allow the resource load to proceed with default handling return NULL. + /// To specify a handler for the resource return a + /// cef_resource_request_handler_t object. This function will not be called if + /// the client associated with |browser| returns a non-NULL value from + /// cef_request_handler_t::GetResourceRequestHandler for the same request + /// (identified by cef_request_t::GetIdentifier). + /// property get_resource_request_handler index "get_resource_request_handler" read getcallpropertybyindex write setcallpropertybyindex; function get_resource_request_handler_i(s:pointer;b:pointer;f:pointer;r:pointer; - is_navigation:integer;is_download:integer; - request_initiator:pointer;var disable_default_handling:integer ):pointer;stdcall; + is_navigation:integer;is_download:integer;request_initiator:pointer; var disable_default_handling:integer):pointer;stdcall; begin - return 0; - c := getcallback(functionname()); - if c then - call(c,self(true),cef_object_get(b,class(cef_browser_t)),cef_object_get(f,class(cef_frame_t)), - cef_object_get(r,class(cef_request_t)) - ,is_navigation - ,is_download - ,new cef_string_t(request_initiator) - ,disable_default_handling - ); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + begin + r := call(c,self(true),cef_object_get(b,class(cef_browser_t)),cef_object_get(f,class(cef_frame_t)), + cef_object_get(r,class(cef_request_t)),is_navigation,is_download,new cef_string_t(request_initiator),disable_default_handling); + if r is class(cef_resource_request_handler_t) then + begin + cef_object_save(r); + return r._getptr_(); + end + if r then + begin + raise "cef_request_handler_t:get_resource_request_handler err!"; + end + end end end +type cef_resource_handler_t=class(cef_contain_base) + private + function structdescribe();override; + begin + return array( + ("base","user",getbasestruct()), + ("open","intptr",0), + ("process_request","intptr",0), + ("get_response_headers","intptr",0), + ("skip","intptr",0), + ("read","intptr",0), + ("read_response","intptr",0), + ("cancel","intptr",0) + ); + end + public + function create(ptr) + begin + inherited ; + end + /// Open the response stream. To handle the request immediately set + /// |handle_request| to true (1) and return true (1). To decide at a later + /// time set |handle_request| to false (0), return true (1), and execute + /// |callback| to continue or cancel the request. To cancel the request + /// immediately set |handle_request| to true (1) and return false (0). This + /// function will be called in sequence but not from a dedicated thread. For + /// backwards compatibility set |handle_request| to false (0) and return false + /// (0) and the ProcessRequest function will be called. + property open index "open" read getcallpropertybyindex write setcallpropertybyindex; + function open_i(s:pointer;r:pointer;var handle_request:integer;callback:pointer):integer;stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + return call(c,self(true),cef_object_get(r,class(cef_request_t)),handle_request,cef_object_get(callback,class(cef_callback_t))); + end + /// + /// Begin processing the request. To handle the request return true (1) and + /// call cef_callback_t::cont() once the response header information is + /// available (cef_callback_t::cont() can also be called from inside this + /// function if header information is available immediately). To cancel the + /// request return false (0). + /// + /// WARNING: This function is deprecated. Use Open instead. + property process_request index "process_request" read getcallpropertybyindex write setcallpropertybyindex; + function process_request_i(s:pointer;r:pointer;callback:pointer):integer;stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + return call(c,self(true),cef_object_get(r,class(cef_request_t)),cef_object_get(callback,class(cef_callback_t))); + end + /// Retrieve response header information. If the response length is not known + /// set |response_length| to -1 and read_response() will be called until it + /// returns false (0). If the response length is known set |response_length| + /// to a positive value and read_response() will be called until it returns + /// false (0) or the specified number of bytes have been read. Use the + /// |response| object to set the mime type, http status code and other + /// optional header values. To redirect the request to a new URL set + /// |redirectUrl| to the new URL. |redirectUrl| can be either a relative or + /// fully qualified URL. It is also possible to set |response| to a redirect + /// http status code and pass the new URL via a Location header. Likewise with + /// |redirectUrl| it is valid to set a relative or fully qualified URL as the + /// Location header value. If an error occured while setting up the request + /// you can call set_error() on |response| to indicate the error condition. + property get_response_headers index "get_response_headers" read getcallpropertybyindex write setcallpropertybyindex; + procedure get_response_headers_i(s:pointer;r:pointer;var response_length:int64;redirectUrl:pointer);stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + return call(c,self(true),cef_object_get(r,class(cef_response_t)),response_length,new cef_string_t(redirectUrl)); + end + /// Skip response data when requested by a Range header. Skip over and discard + /// |bytes_to_skip| bytes of response data. If data is available immediately + /// set |bytes_skipped| to the number of bytes skipped and return true (1). To + /// read the data at a later time set |bytes_skipped| to 0, return true (1) + /// and execute |callback| when the data is available. To indicate failure set + /// |bytes_skipped| to < 0 (e.g. -2 for ERR_FAILED) and return false (0). This + /// function will be called in sequence but not from a dedicated thread. + property skip index "skip" read getcallpropertybyindex write setcallpropertybyindex; + function skip_i(s:pointer;r:pointer;bytes_to_skip:int64;var bytes_skipped:int64;callback:pointer):integer;stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + return call(c,self(true),cef_object_get(r,class(cef_response_t)),response_length,cef_object_get(callback,class(cef_resource_skip_callback_t))); + end + /// Read response data. If data is available immediately copy up to + /// |bytes_to_read| bytes into |data_out|, set |bytes_read| to the number of + /// bytes copied, and return true (1). To read the data at a later time keep a + /// pointer to |data_out|, set |bytes_read| to 0, return true (1) and execute + /// |callback| when the data is available (|data_out| will remain valid until + /// the callback is executed). To indicate response completion set + /// |bytes_read| to 0 and return false (0). To indicate failure set + /// |bytes_read| to < 0 (e.g. -2 for ERR_FAILED) and return false (0). This + /// function will be called in sequence but not from a dedicated thread. For + /// backwards compatibility set |bytes_read| to -1 and return false (0) and + /// the ReadResponse function will be called. + property read_ index "read" read getcallpropertybyindex write setcallpropertybyindex; + function read_i(s:pointer;dout:pointer;bytes_to_read:integer;var bytes_read:integer;callback:pointer):integer;stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + return call(c,self(true),dout,bytes_to_read,bytes_read,cef_object_get(callback,class(cef_resource_read_callback_t))); + end + /// Read response data. If data is available immediately copy up to + /// |bytes_to_read| bytes into |data_out|, set |bytes_read| to the number of + /// bytes copied, and return true (1). To read the data at a later time set + /// |bytes_read| to 0, return true (1) and call cef_callback_t::cont() when + /// the data is available. To indicate response completion return false (0). + /// + /// WARNING: This function is deprecated. Use Skip and Read instead. + property read_response index "read_response" read getcallpropertybyindex write setcallpropertybyindex; + function read_response_i(s:pointer;dout:pointer;bytes_to_read:integer;var bytes_read:integer;callback:pointer):integer;stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + return call(c,self(true),dout,bytes_to_read,bytes_read,cef_object_get(callback,class(cef_callback_t))); + end + property cancel index "cancel" read getcallpropertybyindex write setcallpropertybyindex; + function cancel_i(s:pointer);stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + return call(c,self(true)); + end +end type cef_resource_request_handler_t=class(cef_contain_base) private function structdescribe();override; @@ -3835,7 +4421,13 @@ type cef_resource_request_handler_t=class(cef_contain_base) return array( ("base","user",getbasestruct()), ("get_cookie_access_filter","intptr",0), - ("get_resource_request_handler","intptr",0) + ("on_before_resource_load","intptr",0), + ("get_resource_handler","intptr",0), + ("on_resource_redirect","intptr",0), + ("on_resource_response","intptr",0), + ("get_resource_response_filter","intptr",0), + ("on_resource_load_complete","intptr",0), + ("on_protocol_execution","intptr",0) ); end public @@ -3843,35 +4435,81 @@ type cef_resource_request_handler_t=class(cef_contain_base) begin inherited ; end - /// Called on the IO thread before a resource request is loaded. The |browser| - /// and |frame| values represent the source of the request, and may be NULL - /// for requests originating from service workers or cef_urlrequest_t. To - /// optionally filter cookies for the request return a - /// cef_cookie_access_filter_t object. The |request| object cannot not be - /// modified in this callback. - property on_request_context_initialized index "on_request_context_initialized" read getcallpropertybyindex write setcallpropertybyindex; - procedure on_request_context_initialized_i(s:pointer;request_context:pointer );stdcall; + property get_cookie_access_filter index "get_cookie_access_filter" read getcallpropertybyindex write setcallpropertybyindex; + procedure get_cookie_access_filter_i(s:pointer;b:pointer;f:pointer;r:pointer );stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then - call(c,self(true),cef_object_get(request_context,class(cef_request_context_t))); + return call(c,self(true),cef_object_get(b,class(cef_browser_t)),cef_object_get(f,class(cef_frame_t)), + cef_object_get(r,class(cef_request_t))); end - property get_resource_request_handler index "get_resource_request_handler" read getcallpropertybyindex write setcallpropertybyindex; - function get_resource_request_handler_i(s:pointer;b:pointer;f:pointer;r:pointer; - is_navigation:integer;is_download:integer; - request_initiator:pointer;var disable_default_handling:integer ):pointer;stdcall; + property on_before_resource_load index "on_before_resource_load" read getcallpropertybyindex write setcallpropertybyindex; + function on_before_resource_load_i(s:pointer;b:pointer;f:pointer;r:pointer;cbk:pointer );stdcall; begin - return 0; - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + return call(c,self(true),cef_object_get(b,class(cef_browser_t)),cef_object_get(f,class(cef_frame_t)), + cef_object_get(r,class(cef_request_t)),cbk); + end + property get_resource_handler index "get_resource_handler" read getcallpropertybyindex write setcallpropertybyindex; + procedure get_resource_handler_i(s:pointer;b:pointer;f:pointer;r:pointer );stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + begin + r := call(c,self(true),cef_object_get(b,class(cef_browser_t)),cef_object_get(f,class(cef_frame_t)), + cef_object_get(r,class(cef_request_t))); + if r is class(cef_resource_handler_t) then + begin + cef_object_save(r); + return r._getptr_(); + end + if r then + begin + raise "cef_resource_request_handler_t:get_resource_handler err!"; + end + end + end + property on_resource_redirect index "on_resource_redirect" read getcallpropertybyindex write setcallpropertybyindex; + procedure on_resource_redirect_i(s:pointer;b:pointer;f:pointer;r:pointer;rsp:pointer;ul:pointer );stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then call(c,self(true),cef_object_get(b,class(cef_browser_t)),cef_object_get(f,class(cef_frame_t)), - cef_object_get(r,class(cef_request_t)) - ,is_navigation - ,is_download - ,new cef_string_t(request_initiator) - ,disable_default_handling - ); - end + cef_object_get(r,class(cef_request_t)),cef_object_get(rsp,class(cef_response_t)),new cef_string_t(ul)); + end + property on_resource_response index "on_resource_response" read getcallpropertybyindex write setcallpropertybyindex; + procedure on_resource_response_i(s:pointer;b:pointer;f:pointer;r:pointer;rsp:pointer );stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + call(c,self(true),cef_object_get(b,class(cef_browser_t)),cef_object_get(f,class(cef_frame_t)), + cef_object_get(r,class(cef_request_t)),cef_object_get(rsp,class(cef_response_t))); + end + property get_resource_response_filter index "get_resource_response_filter" read getcallpropertybyindex write setcallpropertybyindex; + procedure get_resource_response_filter_i(s:pointer;b:pointer;f:pointer;r:pointer;rsp:pointer );stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + return call(c,self(true),cef_object_get(b,class(cef_browser_t)),cef_object_get(f,class(cef_frame_t)), + cef_object_get(r,class(cef_request_t)),cef_object_get(rsp,class(cef_response_t))); + end + property on_resource_load_complete index "on_resource_load_complete" read getcallpropertybyindex write setcallpropertybyindex; + procedure on_resource_load_complete_i(s:pointer;b:pointer;f:pointer;r:pointer;rsp:pointer;status:integer;received_content_length:int64 );stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + call(c,self(true),cef_object_get(b,class(cef_browser_t)),cef_object_get(f,class(cef_frame_t)), + cef_object_get(r,class(cef_request_t)),cef_object_get(rsp,class(cef_response_t)),status,received_content_length); + end + property on_protocol_execution index "on_protocol_execution" read getcallpropertybyindex write setcallpropertybyindex; + procedure on_protocol_execution_i(s:pointer;b:pointer;f:pointer;r:pointer;rsp:pointer;var allow_os_execution:integer );stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + call(c,self(true),cef_object_get(b,class(cef_browser_t)),cef_object_get(f,class(cef_frame_t)), + cef_object_get(r,class(cef_request_t)),cef_object_get(rsp,class(cef_response_t)),allow_os_execution); + end end type cef_request_handler_t=class(cef_handler_base) private @@ -3917,7 +4555,7 @@ type cef_request_handler_t=class(cef_handler_base) property on_before_browse index "on_before_browse" read getcallpropertybyindex write setcallpropertybyindex; function on_before_browse_i(sf:pointer;browser:pointer;frame:pointer;request:pointer;user_gesture:integer;is_redirect:integer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -3954,7 +4592,7 @@ type cef_request_handler_t=class(cef_handler_base) property on_open_urlfrom_tab index "on_open_urlfrom_tab" read getcallpropertybyindex write setcallpropertybyindex; function on_open_urlfrom_tab_i(sf:pointer;browser:pointer;frame:pointer;target_url:pointer;target_disposition:integer;user_gesture:integer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -3967,6 +4605,30 @@ type cef_request_handler_t=class(cef_handler_base) end end property get_resource_request_handler index "get_resource_request_handler" write setcallpropertybyindex; + function get_resource_request_handler_i(s:pointer;b:pointer;f:pointer;r:pointer; + is_navigation:integer;is_download:integer;request_initiator:pointer; var disable_default_handling:integer):pointer;stdcall; + begin + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); + if c then + begin + r := call(c,self(true), + cef_object_get(b,class(cef_browser_t)), + cef_object_get(f,class(cef_frame_t)), + cef_object_get(r,class(cef_request_t)), + is_navigation,is_download, + (new cef_string_t(request_initiator)), + disable_default_handling); + if r is class(cef_resource_request_handler_t) then + begin + cef_object_save(r); + return r._getptr_(); + end + if r then + begin + raise "cef_request_handler_t:get_resource_request_handler err!"; + end + end + end property get_auth_credentials index "get_auth_credentials" write setcallpropertybyindex; property on_quota_request index "on_quota_request" write setcallpropertybyindex;; property on_certificate_error index "on_certificate_error" write setcallpropertybyindex; @@ -3976,7 +4638,7 @@ type cef_request_handler_t=class(cef_handler_base) property on_document_available_in_main_frame index "on_document_available_in_main_frame" read getcallpropertybyindex write setcallpropertybyindex; function on_document_available_in_main_frame_i(sf:pointer;browser:pointer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -4149,7 +4811,7 @@ type cef_app_t=class(cef_contain_hander) //cef_app_capi.h protected function aftercreate(flg);override; begin - inherited; + return inherited; end public function create(ptr) @@ -4159,7 +4821,7 @@ type cef_app_t=class(cef_contain_hander) //cef_app_capi.h property on_before_command_line_processing index "on_before_command_line_processing" read getcallpropertybyindex write setcallpropertybyindex; procedure on_before_command_line_processing_i(sf:pointer;process:pointer;cmd:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -4596,7 +5258,7 @@ type cef_client_t=class(cef_contain_hander) //cef_client_capi.h protected function aftercreate(flg);override; begin - inherited; + return inherited; end public function create(ptr) @@ -4713,7 +5375,7 @@ type cef_client_t=class(cef_contain_hander) //cef_client_capi.h property on_process_message_received index "on_process_message_received" read getcallpropertybyindex write setcallpropertybyindex; function on_process_message_received_i(sf:pointer;browser:pointer;frame:pointer;source_process:integer;message:pointer):pointer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin return call(c,self(true), @@ -4748,7 +5410,7 @@ type cef_string_visitor_t=class(cef_contain_base) property visit index "visit" read getcallpropertybyindex write setcallpropertybyindex; procedure visit_i(sf:pointer;cs:pointer);stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin s := new cef_string_userfree_t(cs); @@ -4790,8 +5452,7 @@ type cef_preference_manager_t=class(cef_contain_base) //property set_preference index "set_preference" read _getvalue_ write _setvalue_; end type cef_request_context_t=class(cef_contain_base) - private - + private function getpms(); begin return array( @@ -4801,8 +5462,13 @@ type cef_request_context_t=class(cef_contain_base) ("get_all_preferences","intptr",0), ("can_set_preference","intptr",0), ("set_preference","intptr",0)); - end - function structdescribe();override; + end + function structdescribe();override; + begin + if cef_version_info(0)>119 then structdescribe1(); + return structdescribe2(); + end + function structdescribe1();override; begin return array( ("base","user",getpms()), @@ -4825,33 +5491,73 @@ type cef_request_context_t=class(cef_contain_base) ("get_extension","intptr",0), ("get_media_router","intptr",0)); return SSTRUCT; + end + function structdescribe2();override; + begin + return array( + ("base","user",getbasestruct()), + ("is_same","intptr",0), + ("is_sharing_with","intptr",0), + ("is_global","intptr",0), + ("get_handler","intptr",0), + ("get_cache_path","intptr",0), + ("get_cookie_manager","intptr",0), + ("register_scheme_handler_factory","intptr",0), + ("clear_scheme_handler_factories","intptr",0), + /////////////////////////////////////////////////////////// + ("has_preference","intptr",0), + ("get_preference","intptr",0), + ("get_all_preferences","intptr",0), + ("can_set_preference","intptr",0), + ("set_preference","intptr",0), + ////////////////////////////////////////////////////// + ("clear_certificate_exceptions","intptr",0), + ("clear_http_auth_credentials","intptr",0), + ("close_all_connections","intptr",0), + ("resolve_host","intptr",0), + ("load_extension","intptr",0), + ("did_load_extension","intptr",0), + ("has_extension","intptr",0), + ("get_extensions","intptr",0), + ("get_extension","intptr",0), + ("get_media_router","intptr",0)); end protected function getbasecalss();override; begin + return inherited; + if cef_version_info(0)>119 then return inherited; return class(cef_preference_manager_t); end function aftercreate(flg);override; begin - + return inherited; end public function create(ptr) begin inherited ; - //base.base.size := memsize(); end - //property is_same index "is_same" read _getvalue_ write _setvalue_; - //property is_sharing_with index "is_sharing_with" read _getvalue_ write _setvalue_; - //property is_global index "is_global" read _getvalue_ write _setvalue_; + function is_same(other); + begin + ptr := _getvalue_(functionname()); + f := function(sf:pointer;other:pointer):integer;stdcall;external ptr; + return ##f(_getptr_(),other); + end + /// Returns true (1) if this object is sharing the same storage as |that| + function is_sharing_with(other); + begin + ptr := _getvalue_(functionname()); + f := function(sf:pointer;other:pointer):integer;stdcall;external ptr; + return ##f(_getptr_(),other); + end function is_global(); begin ptr := _getvalue_(functionname()); f := function(sf:pointer):integer;stdcall;external ptr; - return ##f(_getptr_()); - + return ##f(_getptr_()); end - //property get_handler index "get_handler" read _getvalue_ write _setvalue_; + /// Returns the handler for this context if any. function get_handler(); begin ptr := _getvalue_(functionname()); @@ -4859,17 +5565,15 @@ type cef_request_context_t=class(cef_contain_base) s := ##f(_getptr_()); return s; end - //property get_cache_path index "get_cache_path" read _getvalue_ write _setvalue_; + function get_cache_path(); begin ptr := _getvalue_(functionname()); f := function(sf:pointer):pointer;stdcall;external ptr; - echo "{- ",ptr," -}"; s := ##f(_getptr_()); - echo "{{",s,"}}"; if s then begin - echo ">>>:",s; + echo ">>>:",s; p := new cef_string_userfree_t(s); return p.str; end @@ -4932,7 +5636,7 @@ type cef_domvisitor_t=class(cef_contain_base) procedure visit_i(sf:pointer;dom:pointer);stdcall; begin echo "\r\ninvisit====="; - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin call(c,self(true),cef_object_get( dom,class(cef_domdocument_t))); @@ -4967,10 +5671,10 @@ type cef_cookie_visitor_t=class(cef_contain_base) /// Return false (0) to stop visiting cookies. This function may never be /// called if no cookies are found. ///int(CEF_CALLBACK* visit)(struct _cef_cookie_visitor_t* self,const struct _cef_cookie_t* cookie,int count,int total,int* deleteCookie); - property visit read getcallpropertybyindex write setcallpropertybyindex; + property visit index "visit" read getcallpropertybyindex write setcallpropertybyindex; function visit_i(sf:pointer;cookie:pointer;ct:integer;total:integer;var deleteCookie:integer):integer;stdcall; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then begin del := deleteCookie ; @@ -5005,6 +5709,129 @@ type cef_run_file_dialog_callback_t=class(cef_contain_base) //procedure on_file_dialog_dismissed(sf;cef_string_list_t file_paths); property on_file_dialog_dismissed index "on_file_dialog_dismissed" write setcallpropertybyindex; end +////////////////////////////////////////////////////////////////// +type cef_resource_skip_callback_t=class(cef_contain_base) + private + function structdescribe();override; + begin + return array( + ("base","user",getbasestruct()), + ("cont","intptr",0) + ); + end + public + function create(ptr) + begin + inherited ; + end + function cont(bytes_read); + begin + ptr := _getvalue_(functionname()); + if not ptr then return ; + f := procedure(sf:pointer;bytes_read:int64);stdcall;external ptr; + return ##f(_getptr_(),bytes_read); + end +end +type cef_task_runner_t=class(cef_contain_base) + private + function structdescribe();override; + begin + return array( + ("base","user",getbasestruct()), + ("is_same","intptr",0), + ("belongs_to_current_thread","intptr",0), + ("belongs_to_thread","intptr",0), + ("post_task","intptr",0), + ("post_delayed_task","intptr",0) + ); + end + public + function create(ptr) + begin + inherited ; + end + function is_same(that); //相同 + begin + if that is class(cef_task_runner_t) then + begin + h := that._getptr_(); + end else + if that>0 or that<0 then + begin + h := that; + end else return 0; + ptr := _getvalue_(functionname()); + if not ptr then return ; + f := function(sf:pointer;h:pointer):pointer;stdcall;external ptr; + return ##f(_getptr_(),h); + end + function belongs_to_current_thread(); + begin + ptr := _getvalue_(functionname()); + if not ptr then return ; + f := function(sf:pointer):integer;stdcall;external ptr; + return ##f(_getptr_()); + end + function belongs_to_thread(thd); //属于 + begin + ptr := _getvalue_(functionname()); + if not ptr then return ; + f := function(sf:pointer;h:pointer):pointer;stdcall;external ptr; + return ##f(_getptr_(),thd); + end + function post_task(tsk); //post + begin + if tsk is class(cef_task_runner_t) then + begin + h := tsk._getptr_(); + end else + if tsk>0 or tsk<0 then + begin + h := tsk; + end else return 0; + ptr := _getvalue_(functionname()); + if not ptr then return ; + f := function(sf:pointer;h:pointer):pointer;stdcall;external ptr; + return ##f(_getptr_(),h); + end + function post_delayed_task(tsk,delay); //post delay + begin + if tsk is class(cef_task_runner_t) then + begin + h := tsk._getptr_(); + end else + if tsk>0 or tsk<0 then + begin + h := tsk; + end else return 0; + ptr := _getvalue_(functionname()); + if not ptr then return ; + f := function(sf:pointer;h:pointer;delay:integer):pointer;stdcall;external ptr; + return ##f(_getptr_(),h,((delay>0)?delay:100)); + end +end +type cef_resource_read_callback_t=class(cef_contain_base) + private + function structdescribe();override; + begin + return array( + ("base","user",getbasestruct()), + ("cont","intptr",0) + ); + end + public + function create(ptr) + begin + inherited ; + end + function cont(bytes_read); + begin + ptr := _getvalue_(functionname()); + if not ptr then return ; + f := procedure(sf:pointer;bytes_read:integer);stdcall;external ptr; + return ##f(_getptr_(),bytes_read); + end +end type cef_callback_t=class(cef_contain_base) private function structdescribe();override; @@ -5020,8 +5847,20 @@ type cef_callback_t=class(cef_contain_base) begin inherited ; end - property cont index "cont" write setcallpropertybyindex; - property cancel index "cancel" write setcallpropertybyindex; + function cont(); + begin + ptr := _getvalue_(functionname()); + if not ptr then return ; + f := procedure(sf:pointer);stdcall;external ptr; + return ##f(_getptr_()); + end + function cancel(); + begin + ptr := _getvalue_(functionname()); + if not ptr then return ; + f := procedure(sf:pointer);stdcall;external ptr; + return ##f(_getptr_()); + end end type cef_jsdialog_callback_t=class(cef_contain_base) private @@ -5036,19 +5875,26 @@ type cef_jsdialog_callback_t=class(cef_contain_base) begin inherited ; end + function cont(success,user_input); + begin + ptr := _getvalue_(functionname()); + if not ptr then return ; + f := procedure(sf:pointer;success:integer;user_input:pointer);stdcall;external ptr; + return ##f(_getptr_(),success,user_input); + end /// Continue the JS dialog request. Set |success| to true (1) if the OK button /// was pressed. The |user_input| value should be specified for prompt /// dialogs. - property cont index "cont" read getcallpropertybyindex write setcallpropertybyindex; + {property cont index "cont" read getcallpropertybyindex write setcallpropertybyindex; procedure cont_i(sf:pointer;success:integer;user_input:pointer);stdcall;virtual; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then call(c,self(true), success, (new cef_string_t(user_input)).str ); - end + end } end type cef_completion_callback_t=class(cef_contain_base) private @@ -5067,7 +5913,7 @@ type cef_completion_callback_t=class(cef_contain_base) property on_complete index "on_complete" read getcallpropertybyindex write setcallpropertybyindex; procedure on_complete_i(sf:pointer);stdcall;virtual; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then call(c,self(true)); end end @@ -5080,7 +5926,7 @@ type cef_set_cookie_callback_t=class(cef_completion_callback_t) //procedure on_complete(sf:pointer;success:integer);stdcall; procedure on_complete_i(sf:pointer;success:integer);stdcall;override; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then call(c,self(true),success); end end @@ -5091,14 +5937,13 @@ type cef_delete_cookies_callback_t=class(cef_set_cookie_callback_t) begin inherited ; end - //procedure on_complete(sf:pointer;num_deleted:integer);stdcall; procedure on_complete_i(sf:pointer;num_deleted:integer);stdcall;override; begin - c := getcallback(functionname()); + recoder := new cef_in_out_recoder(functionname(),s);c := getcallback(functionname()); if c then call(c,self(true),num_deleted); end end - +///////////////////////////////////////////////////////////////////////////////////////// type cef_cookie_t=class(cef_contain_base) private function structdescribe();override; @@ -5446,7 +6291,7 @@ type cef_browser_t=class(cef_contain_base) protected function aftercreate(flg);override; begin - inherited; + return inherited; end public function create(ptr) @@ -6199,14 +7044,12 @@ type cef_browser_host_t=class(cef_contain_base) /// close_browser() and cef_life_span_handler_t::do_close() documentation for /// additional usage information. This function must be called on the browser /// process UI thread. - //property try_close_browser index "try_close_browser" read _getvalue_ write _setvalue_; function try_close_browser(); begin ptr := _getvalue_(functionname()); f := function(sf:pointer):integer;stdcall; external ptr; return ##f(_getptr_()); end - //property set_focus index "set_focus" read _getvalue_ write _setvalue_; function set_focus(fc); begin if not(fc=0 or fc=1) then return ; @@ -6420,120 +7263,405 @@ type cef_browser_host_t=class(cef_contain_base) return ##f(_getptr_()); end end -type cef_MainMessageLoopStd_t=class +type cef_MainMessageLoopStd_t=class() function run(); begin - _f_ := static procedure();stdcall;external getceffunction("cef_run_message_loop"); - return ##_f_(); + return cef_run_message_loop(); + //_f_ := static procedure();stdcall;external getceffunction("cef_run_message_loop"); + //return ##_f_(); end function quit(); begin - _f_ := static procedure();stdcall;external getceffunction("cef_quit_message_loop"); - return ##_f_(); + return cef_quit_message_loop(); + //_f_ := static procedure();stdcall;external getceffunction("cef_quit_message_loop"); + //return ##_f_(); end function PostTask(task); begin - _f_ := static function(id:integer;task:pointer):integer;stdcall;external getceffunction("cef_post_task"); - return ##_f_(0,task); + return cef_post_task(0,task); + //_f_ := static function(id:integer;task:pointer):integer;stdcall;external getceffunction("cef_post_task"); + //return ##_f_(0,task); end function RunsTasksOnCurrentThread(); begin - _f_ := static function(id:integer):integer;stdcall;external getceffunction("cef_currently_on"); - return ##_f_(0); + return cef_currently_on(0); + //_f_ := static function(id:integer):integer;stdcall;external getceffunction("cef_currently_on"); + //return ##_f_(0); end end -implementation -type cef_thread_id_t = class - // BROWSER PROCESS THREADS -- Only available in the browser process. - /// The main thread in the browser. This will be the same as the main - /// application thread if CefInitialize() is called with a - /// CefSettings.multi_threaded_message_loop value of false. Do not perform - /// blocking tasks on this thread. All tasks posted after - /// CefBrowserProcessHandler::OnContextInitialized() and before CefShutdown() - /// are guaranteed to run. This thread will outlive all other CEF threads. - static const TID_UI =0; - /// Used for blocking tasks like file system access where the user won't - /// notice if the task takes an arbitrarily long time to complete. All tasks - /// posted after CefBrowserProcessHandler::OnContextInitialized() and before - /// CefShutdown() are guaranteed to run. - static const TID_FILE_BACKGROUND=1; - /// Used for blocking tasks like file system access that affect UI or - /// responsiveness of future user interactions. Do not use if an immediate - /// response to a user interaction is expected. All tasks posted after - /// CefBrowserProcessHandler::OnContextInitialized() and before CefShutdown() - /// are guaranteed to run. - /// Examples: - /// - Updating the UI to reflect progress on a long task. - /// - Loading data that might be shown in the UI after a future user - /// interaction. - static const TID_FILE_USER_VISIBLE=2; - /// Used for blocking tasks like file system access that affect UI - /// immediately after a user interaction. All tasks posted after - /// CefBrowserProcessHandler::OnContextInitialized() and before CefShutdown() - /// are guaranteed to run. - /// Example: Generating data shown in the UI immediately after a click. - static const TID_FILE_USER_BLOCKING=3; - /// Used to launch and terminate browser processes. - static const TID_PROCESS_LAUNCHER=4; - /// Used to process IPC and network messages. Do not perform blocking tasks on - /// this thread. All tasks posted after - /// CefBrowserProcessHandler::OnContextInitialized() and before CefShutdown() - /// are guaranteed to run. - static const TID_IO=5; - // RENDER PROCESS THREADS -- Only available in the render process. - /// The main thread in the renderer. Used for all WebKit and V8 interaction. - /// Tasks may be posted to this thread after - /// CefRenderProcessHandler::OnWebKitInitialized but are not guaranteed to - /// run before sub-process termination (sub-processes may be killed at any - /// time without warning). - static const TID_RENDERER=6; +type cef_string_multimap_t = class() // + function create(ptr); + begin + if ptr>0 or ptr<0 then + begin + FHandle := ptr; + fneeddestroy := true; + end else + begin + FHandle := cef_string_multimap_alloc(); + fneeddestroy := false; + end + end + function destroy(); //销毁 + begin + if fneeddestroy and FHandle then + begin + cef_string_multimap_free(FHandle); + end + end + function size(); + begin + return cef_string_multimap_size(FHandle); + end + function find_count(k); + begin + s := new cef_string_t(k); + return cef_string_multimap_find_count(FHandle,s._getptr_()); + end + function enumerate(k,value_index,v); + begin + s := new cef_string_t(k); + vs := new cef_string_t(v); + return cef_string_multimap_enumerate(FHandle,s._getptr_(),value_index,vs._getptr_()); + end + function key(idx,k); + begin + s := new cef_string_t(k); + return cef_string_multimap_key(FHandle,idx,s._getptr_()); + end + function value(idx,v); + begin + s := new cef_string_t(v); + return cef_string_multimap_value(FHandle,idx,s._getptr_()); + end + function append(k,v); + begin + s1 := new cef_string_t(k); + s2 := new cef_string_t(v); + return cef_string_multimap_append(FHandle,s1._getptr_(),s2._getptr_()); + end + function clear(); + begin + return cef_string_multimap_clear(FHandle); + end + property needdestroy read fneeddestroy write fneeddestroy; + function _getptr_(); + begin + return FHandle; + end + private + fneeddestroy; + FHandle; end -type cef_log_severity_t = class() - /// Default logging (currently INFO logging). - static const LOGSEVERITY_DEFAULT = 0; - /// Verbose logging. - static const LOGSEVERITY_VERBOSE =1; - /// DEBUG logging. - static const LOGSEVERITY_DEBUG = 1; - /// INFO logging. - static const LOGSEVERITY_INFO =2; - /// WARNING logging. - static const LOGSEVERITY_WARNING = 3; - /// ERROR logging. - static const LOGSEVERITY_ERROR = 4; - /// FATAL logging. - static const LOGSEVERITY_FATAL = 5; - /// Disable logging to file for all messages, and to stderr for messages with - /// severity less than FATAL. - static const LOGSEVERITY_DISABLE = 99; +type cef_const_value = class + //cef_focus_source_t; + static const FOCUS_SOURCE_NAVIGATION = 0;/// The source is explicit navigation via the API (LoadURL(), etc). + static const FOCUS_SOURCE_SYSTEM = 1;/// The source is a system-generated focus event. + + ////cef_navigation_type_t + static const NAVIGATION_LINK_CLICKED = 0; + static const NAVIGATION_FORM_SUBMITTED = 1; + static const NAVIGATION_BACK_FORWARD = 2; + static const NAVIGATION_RELOAD = 3; + static const NAVIGATION_FORM_RESUBMITTED = 4; + static const NAVIGATION_OTHER = 5; + //////cef_xml_encoding_type_t + static const XML_ENCODING_NONE = 0;/// + static const XML_ENCODING_UTF8 = 1; + static const XML_ENCODING_UTF16LE = 2; + static const XML_ENCODING_UTF16BE = 3; + static const XML_ENCODING_ASCII = 4; + /////cef_xml_node_type_t/////////// + static const XML_NODE_UNSUPPORTED = 0; + static const XML_NODE_PROCESSING_INSTRUCTION = 1; + static const XML_NODE_DOCUMENT_TYPE = 2; + static const XML_NODE_ELEMENT_START = 3; + static const XML_NODE_ELEMENT_END = 4; + static const XML_NODE_ATTRIBUTE = 5; + static const XML_NODE_TEXT = 6; + static const XML_NODE_CDATA = 7; + static const XML_NODE_ENTITY_REFERENCE = 8; + static const XML_NODE_WHITESPACE = 9; + static const XML_NODE_COMMENT = 10; + //cef_thread_id_t + // BROWSER PROCESS THREADS -- Only available in the browser process. + /// The main thread in the browser. This will be the same as the main + /// application thread if CefInitialize() is called with a + /// CefSettings.multi_threaded_message_loop value of false. Do not perform + /// blocking tasks on this thread. All tasks posted after + /// CefBrowserProcessHandler::OnContextInitialized() and before CefShutdown() + /// are guaranteed to run. This thread will outlive all other CEF threads. + static const TID_UI =0; + /// Used for blocking tasks like file system access where the user won't + /// notice if the task takes an arbitrarily long time to complete. All tasks + /// posted after CefBrowserProcessHandler::OnContextInitialized() and before + /// CefShutdown() are guaranteed to run. + static const TID_FILE_BACKGROUND=1; + /// Used for blocking tasks like file system access that affect UI or + /// responsiveness of future user interactions. Do not use if an immediate + /// response to a user interaction is expected. All tasks posted after + /// CefBrowserProcessHandler::OnContextInitialized() and before CefShutdown() + /// are guaranteed to run. + /// Examples: + /// - Updating the UI to reflect progress on a long task. + /// - Loading data that might be shown in the UI after a future user + /// interaction. + static const TID_FILE_USER_VISIBLE=2; + /// Used for blocking tasks like file system access that affect UI + /// immediately after a user interaction. All tasks posted after + /// CefBrowserProcessHandler::OnContextInitialized() and before CefShutdown() + /// are guaranteed to run. + /// Example: Generating data shown in the UI immediately after a click. + static const TID_FILE_USER_BLOCKING=3; + /// Used to launch and terminate browser processes. + static const TID_PROCESS_LAUNCHER=4; + /// Used to process IPC and network messages. Do not perform blocking tasks on + /// this thread. All tasks posted after + /// CefBrowserProcessHandler::OnContextInitialized() and before CefShutdown() + /// are guaranteed to run. + static const TID_IO=5; + // RENDER PROCESS THREADS -- Only available in the render process. + /// The main thread in the renderer. Used for all WebKit and V8 interaction. + /// Tasks may be posted to this thread after + /// CefRenderProcessHandler::OnWebKitInitialized but are not guaranteed to + /// run before sub-process termination (sub-processes may be killed at any + /// time without warning). + static const TID_RENDERER=6; + ///////////////cef_log_severity_t//////////////////// + /// Default logging (currently INFO logging). + static const LOGSEVERITY_DEFAULT = 0; + /// Verbose logging. + static const LOGSEVERITY_VERBOSE =1; + /// DEBUG logging. + static const LOGSEVERITY_DEBUG = 1; + /// INFO logging. + static const LOGSEVERITY_INFO =2; + /// WARNING logging. + static const LOGSEVERITY_WARNING = 3; + /// ERROR logging. + static const LOGSEVERITY_ERROR = 4; + /// FATAL logging. + static const LOGSEVERITY_FATAL = 5; + /// Disable logging to file for all messages, and to stderr for messages with + /// severity less than FATAL. + static const LOGSEVERITY_DISABLE = 99; + ///////////cef_dom_document_type_t////////////////////////// + static const DOM_DOCUMENT_TYPE_UNKNOWN = 0; + static const DOM_DOCUMENT_TYPE_HTML = 1; + static const DOM_DOCUMENT_TYPE_XHTML = 2; + static const DOM_DOCUMENT_TYPE_PLUGIN = 3; + /////////cef_dom_event_category_t////////////////// + static const DOM_EVENT_CATEGORY_UNKNOWN = 0x0; + static const DOM_EVENT_CATEGORY_UI = 0x1; + static const DOM_EVENT_CATEGORY_MOUSE = 0x2; + static const DOM_EVENT_CATEGORY_MUTATION = 0x4; + static const DOM_EVENT_CATEGORY_KEYBOARD = 0x8; + static const DOM_EVENT_CATEGORY_TEXT = 0x10; + static const DOM_EVENT_CATEGORY_COMPOSITION = 0x20; + static const DOM_EVENT_CATEGORY_DRAG = 0x40; + static const DOM_EVENT_CATEGORY_CLIPBOARD = 0x80; + static const DOM_EVENT_CATEGORY_MESSAGE = 0x100; + static const DOM_EVENT_CATEGORY_WHEEL = 0x200; + static const DOM_EVENT_CATEGORY_BEFORE_TEXT_INSERTED = 0x400; + static const DOM_EVENT_CATEGORY_OVERFLOW = 0x800; + static const DOM_EVENT_CATEGORY_PAGE_TRANSITION = 0x1000; + static const DOM_EVENT_CATEGORY_POPSTATE = 0x2000; + static const DOM_EVENT_CATEGORY_PROGRESS = 0x4000; + static const DOM_EVENT_CATEGORY_XMLHTTPREQUEST_PROGRESS = 0x8000; + /////////cef_dom_event_phase_t///////////////////////////////// + static const DOM_EVENT_PHASE_UNKNOWN = 0; + static const DOM_EVENT_PHASE_CAPTURING = 1; + static const DOM_EVENT_PHASE_AT_TARGET = 2; + static const DOM_EVENT_PHASE_BUBBLING = 3; + //////////////////cef_dom_node_type_t///////////////////////////////////// + static const DOM_NODE_TYPE_UNSUPPORTED = 0; + static const DOM_NODE_TYPE_ELEMENT = 1; + static const DOM_NODE_TYPE_ATTRIBUTE = 2; + static const DOM_NODE_TYPE_TEXT = 3; + static const DOM_NODE_TYPE_CDATA_SECTION = 4; + static const DOM_NODE_TYPE_PROCESSING_INSTRUCTIONS = 5; + static const DOM_NODE_TYPE_COMMENT = 6; + static const DOM_NODE_TYPE_DOCUMENT = 7; + static const DOM_NODE_TYPE_DOCUMENT_TYPE = 8; + static const DOM_NODE_TYPE_DOCUMENT_FRAGMENT = 9; + //////////////cef_file_dialog_mode_t///////////////////////////////////// + static const FILE_DIALOG_OPEN = 0; + static const FILE_DIALOG_OPEN_MULTIPLE = 1; + static const FILE_DIALOG_OPEN_FOLDER = 2; + static const FILE_DIALOG_SAVE = 3; + //////////////////cef_color_model_t///////////////////////////////////// + static const COLOR_MODEL_UNKNOWN = 0; + static const COLOR_MODEL_GRAY = 1; + static const COLOR_MODEL_COLOR = 2; + static const COLOR_MODEL_CMYK = 3; + static const COLOR_MODEL_CMY = 4; + static const COLOR_MODEL_KCMY = 5; + static const COLOR_MODEL_CMY_K = 6; + static const COLOR_MODEL_BLACK = 7; + static const COLOR_MODEL_GRAYSCALE = 8; + static const COLOR_MODEL_RGB = 9; + static const COLOR_MODEL_RGBA = 10; + static const COLOR_MODEL_COLORMODE_COLOR = 11; + static const COLOR_MODEL_COLORMODE_MONOCHROME = 12; + static const COLOR_MODEL_HP_COLOR_COLOR = 13; + static const COLOR_MODEL_HP_COLOR_BLACK = 14; + static const COLOR_MODEL_PRINTOUTMODE_NORMAL = 15; + static const COLOR_MODEL_PRINTOUTMODE_NORMAL_GRAY = 16; + static const COLOR_MODEL_PROCESSCOLORMODEL_CMYK = 17; + static const COLOR_MODEL_PROCESSCOLORMODEL_GREYSCALE = 18; + static const COLOR_MODEL_PROCESSCOLORMODEL_RGB = 19; + ///////////cef_duplex_mode_t////////////////////// + static const DUPLEX_MODE_UNKNOWN = -1; + static const DUPLEX_MODE_SIMPLEX = 0; + static const DUPLEX_MODE_LONG_EDGE = 1; + static const DUPLEX_MODE_SHORT_EDGE = 2; + /////////////////cef_cursor_type_t///////////////////////////////// + static const CT_POINTER = 0; + static const CT_CROSS = 1; + static const CT_HAND = 2; + static const CT_IBEAM = 3; + static const CT_WAIT = 4; + static const CT_HELP = 5; + static const CT_EASTRESIZE = 6; + static const CT_NORTHRESIZE = 7; + static const CT_NORTHEASTRESIZE = 8; + static const CT_NORTHWESTRESIZE = 9; + static const CT_SOUTHRESIZE = 10; + static const CT_SOUTHEASTRESIZE = 11; + static const CT_SOUTHWESTRESIZE = 12; + static const CT_WESTRESIZE = 13; + static const CT_NORTHSOUTHRESIZE = 14; + static const CT_EASTWESTRESIZE = 15; + static const CT_NORTHEASTSOUTHWESTRESIZE = 16; + static const CT_NORTHWESTSOUTHEASTRESIZE = 17; + static const CT_COLUMNRESIZE = 18; + static const CT_ROWRESIZE = 19; + static const CT_MIDDLEPANNING = 20; + static const CT_EASTPANNING = 21; + static const CT_NORTHPANNING = 22; + static const CT_NORTHEASTPANNING = 23; + static const CT_NORTHWESTPANNING = 24; + static const CT_SOUTHPANNING = 25; + static const CT_SOUTHEASTPANNING = 26; + static const CT_SOUTHWESTPANNING = 27; + static const CT_WESTPANNING = 28; + static const CT_MOVE = 29; + static const CT_VERTICALTEXT = 30; + static const CT_CELL = 31; + static const CT_CONTEXTMENU = 32; + static const CT_ALIAS = 33; + static const CT_PROGRESS = 34; + static const CT_NODROP = 35; + static const CT_COPY = 36; + static const CT_NONE = 37; + static const CT_NOTALLOWED = 38; + static const CT_ZOOMIN = 39; + static const CT_ZOOMOUT = 40; + static const CT_GRAB = 41; + static const CT_GRABBING = 42; + static const CT_MIDDLE_PANNING_VERTICAL = 43; + static const CT_MIDDLE_PANNING_HORIZONTAL = 44; + static const CT_CUSTOM = 45; + static const CT_DND_NONE = 46; + static const CT_DND_MOVE = 47; + static const CT_DND_COPY = 48; + static const CT_DND_LINK = 49; end - +implementation +type cef_in_out_recoder = class + function create(s,id); + begin + //fdata := id $" "$s; + //echo "\r\n in: ",fdata; + end + //function destroy(); + //begin + //echo "\r\n out: ",fdata; + //end + //private + //fdata; +end +type cef_global_cache = class() + function set_value(k,v,life); + begin + if not ifnil(life) then life := now()+2; + setglobalcache(format_key(k),v,life); + end + function get_value(k); + begin + if getglobalcache(format_key(k),d) then return d; + return nil; + end + function atom(k); //原子锁 + begin + return new cef_atom(format_key(k)); + end + private + function format_key(k); + begin + return Cef_pref $ k; + end + static const Cef_pref = "CEF_CACHE-"; +end +type cef_atom = class() + function create(k); + begin + fmutex := syscreatemutex(k); + SysWaitForSingleObject(fmutex,-1); + end + function destroy() + begin + sysreleasemutex(fmutex); + end + fkey; + fmutex; +end //function IsBadReadPtr(ptr:pointer;ucb:pointer):integer;stdcall;external "Kernel32.dll" name "IsBadReadPtr"; //function IsBadWritePtr(ptr:pointer;ucb:pointer):integer;stdcall;external "Kernel32.dll" name "IsBadWritePtr"; + function addcefref(id); begin + cg := new cef_global_cache(); + cgm := cg.atom(id); + v := cg.get_value(id); + if not(v>=0) then v := 0; + cg.set_value(id,v+1); + return v+1; global g_cef_counter_; return g_cef_counter_.addref(id); end function getcefrefcount(id); begin + cg := new cef_global_cache(); + return cg.get_value(id); global g_cef_counter_; return g_cef_counter_.refcount(id); end function remcefref(id); begin + cg := new cef_global_cache(); + cgm := cg.atom(id); + v := cg.get_value(id); + if ifnil(v) then v := 1; + cg.set_value(id,max(v-1,-1)); + return v; global g_cef_counter_; return g_cef_counter_.remref(id); end function onecefref(id); begin + cg := new cef_global_cache(); + return (cg.get_value(id)>=0); global g_cef_counter_; return (g_cef_counter_.refcount(id)>=0); end function lastonecefref(id); begin + cg := new cef_global_cache(); + return (cg.get_value(id)=0); + global g_cef_counter_; return (g_cef_counter_.refcount(id)=0); end @@ -6576,11 +7704,10 @@ end function cef_object_get(ptr,cls); //获得 begin global g_cef_objects_; - if not(ptr>0 or ptr<0) then return ; - + if not(ptr>0 or ptr<0) then return 0; sptr := inttostr(ptr); r := g_cef_objects_[sptr]; - if not( r) and (ptr>0 or ptr<0) and (cls is class(cef_contain_base)) then + if not(r) and (cls is class(cef_contain_base)) then begin r := createobject(cls,ptr); end else @@ -6641,6 +7768,46 @@ begin g_cef_objects_[sptr] := obj; end end +////////////////////////////////////////////////////////////////////////////////////////////// +function cef_stream_reader_create_for_file(f:pointer):pointer; // +begin + _f_ := static function(f:pointer):pointer;stdcall;external getceffunction(functionname()); + return ##_f_(f); +end +function cef_stream_reader_create_for_data(d:pointer;sz:pointer):pointer; // +begin + _f_ := static function(d:pointer;sz:pointer):pointer;stdcall;external getceffunction(functionname()); + return ##_f_(d,sz); +end +/// +/// Create a new cef_stream_reader_t object from a custom handler. +function cef_stream_reader_create_for_handler(f:pointer):pointer; // +begin + _f_ := static function(f:pointer):pointer;stdcall;external getceffunction(functionname()); + return ##_f_(f); +end +/// Create a new cef_stream_writer_t object for a file. +//CEF_EXPORT cef_stream_writer_t* cef_stream_writer_create_for_file(const cef_string_t* fileName); +function cef_stream_writer_create_for_file(name:pointer):pointer; +begin + _f_ := static function(name:pointer):pointer;cdecl;external getceffunction(functionname()); + return ##_f_(name); +end +/// +/// Create a new cef_stream_writer_t object for a custom handler. +function cef_stream_writer_create_for_handler(h:pointer):pointer; +begin + _f_ := static function(h:pointer):pointer;cdecl;external getceffunction(functionname()); + return ##_f_(h); +end +//////////////////////////////////////////////////////////////////////////////////// +/// +/// Create a new cef_response_t object. +function cef_response_create():pointer; //cef_response_t +begin + _f_ := static function():pointer;stdcall;external getceffunction(functionname()); + return ##_f_(); +end /// Create a new URL request that is not associated with a specific browser or /// frame. Use cef_frame_t::CreateURLRequest instead if you want the request to /// have this association, in which case it may be handled differently (see @@ -6659,7 +7826,7 @@ begin _f_ := static function(r:pointer;c:pointer;rct:pointer):pointer;stdcall;external getceffunction(functionname()); return ##_f_(r,c,rct); end -/// +////////////////// thread ////////////////////////////////////// /// Returns the task runner for the current thread. Only CEF threads will have /// task runners. An NULL reference will be returned if this function is called /// on an invalid thread. @@ -6669,10 +7836,7 @@ begin _f_ := static function():pointer;stdcall;external getceffunction(functionname()); return ##_f_(); end - -/// /// Returns the task runner for the specified CEF thread. -/// function cef_task_runner_get_for_thread(threadId); begin _f_ := static function(threadId:integer):pointer;stdcall;external getceffunction(functionname()); @@ -6701,6 +7865,7 @@ begin _f_ := static function(threadId:integer;task:pointer;delay_ms:int64):integer;stdcall;external getceffunction(functionname()); return ##_f_(threadId,task,delay_ms); end +/////////////////////////////////////////////////////////////////////////////////////////////////////////// /// Create a new cef_drag_data_t object. //CEF_EXPORT cef_drag_data_t* cef_drag_data_create(void); function cef_drag_data_create():pointer; @@ -6708,13 +7873,6 @@ begin _f_ := static function():pointer;cdecl;external getceffunction(functionname()); return ##_f_(); end -/// Create a new cef_stream_writer_t object for a file. -//CEF_EXPORT cef_stream_writer_t* cef_stream_writer_create_for_file(const cef_string_t* fileName); -function cef_stream_writer_create_for_file(name:pointer):pointer; -begin - _f_ := static function(name:pointer):pointer;cdecl;external getceffunction(functionname()); - return ##_f_(name); -end //CEF_EXPORT cef_process_message_t* cef_process_message_create(const cef_string_t* name); function cef_process_message_create(name:pointer):pointer; begin @@ -6810,8 +7968,48 @@ begin _f_ := static function(list:pointer):pointer;cdecl;external getceffunction(functionname()); return ##_f_(list); end - - +//////////cef_string_map_t/////////////////////////////////// +function cef_string_map_alloc():pointer; +begin + _f_ := static function():pointer;cdecl;external getceffunction(functionname()); + return ##_f_(); +end +function cef_string_map_size(map:pointer):pointer; +begin + _f_ := static function(map:pointer):pointer;cdecl;external getceffunction(functionname()); + return ##_f_(map); +end +function cef_string_map_find(map:pointer;key:pointer;value:pointer):pointer; +begin + _f_ := static function(map:pointer;key:pointer;value:pointer):pointer;cdecl;external getceffunction(functionname()); + return ##_f_(map,key,value); +end +function cef_string_map_key(map:pointer;index:pointer;key:pointer):integer; +begin + _f_ := static function(map:pointer;index:pointer;key:pointer):integer;cdecl;external getceffunction(functionname()); + return ##_f_(map,index,key); +end +function cef_string_map_value(map:pointer;index:pointer;value:pointer):integer; +begin + _f_ := static function(map:pointer;index:pointer;value:pointer):integer;cdecl;external getceffunction(functionname()); + return ##_f_(map,index,value); +end +function cef_string_map_append(map:pointer;key:pointer;value:pointer):integer; +begin + _f_ := static function(map:pointer;key:pointer;value:pointer):integer;cdecl;external getceffunction(functionname()); + return ##_f_(map,key,value); +end +procedure cef_string_map_clear(map:pointer); +begin + _f_ := static procedure(map:pointer);cdecl;external getceffunction(functionname()); + return ##_f_(map); +end +procedure cef_string_map_free(map:pointer); +begin + _f_ := static procedure(map:pointer);cdecl;external getceffunction(functionname()); + return ##_f_(map); +end + //cef_string_multimap_t function cef_string_multimap_alloc():pointer; begin @@ -6936,6 +8134,12 @@ begin _f_ := static procedure();cdecl;external getceffunction(functionname()); return ##_f_(); end +procedure cef_quit_message_loop(); +begin + _f_ := static procedure();cdecl;external getceffunction(functionname()); + return ##_f_(); +end + procedure cef_do_message_loop_work(); begin _f_ := static procedure();cdecl;external getceffunction(functionname()); @@ -6961,8 +8165,6 @@ begin _f_ := static function(entry:integer):integer;cdecl;external getceffunction(functionname()); return ##_f_(entry); end - - function getcefboundsstruct(); begin return array(("x","int",0), @@ -6988,9 +8190,9 @@ begin end function init(); begin - global g_cef_counter_; + //global g_cef_counter_; global g_cef_objects_; - g_cef_counter_ := new tcefcounter(); + //g_cef_counter_ := new tcefcounter(); g_cef_objects_ := array(); end function getceffunction(n); @@ -7000,6 +8202,33 @@ begin {$endif} return getdlsymaddress("libcef.dll",n); end +procedure addref(id:pointer);stdcall; +begin + //echo "\r\n:addref:",systhreadid(); + ct := addcefref(id); + //echo "\r\n addref ",id," ",ct," ",systhreadid(); +end +function release(id:pointer):integer;stdcall; +begin + remcefref(id); + ct := getcefrefcount(id); + //echo "\r\n release ",id," ",ct," ",systhreadid(); + if ct<=0 then return 0; + return ct; +end +function has_one_ref(id:pointer):integer;stdcall; +begin + r := onecefref(id); + //echo "\r\n>>one ref:",id; + return r; +end +function has_at_least_one_ref(id:pointer):integer;stdcall; +begin + r := lastoneref(id); + //echo "\r\n>> last one ref:",id; + return r; +end + initialization init(); end. \ No newline at end of file diff --git a/funcext/tvclib/utslvclconstant.tsf b/funcext/tvclib/utslvclconstant.tsf index 42eacf4..f17dfb0 100644 --- a/funcext/tvclib/utslvclconstant.tsf +++ b/funcext/tvclib/utslvclconstant.tsf @@ -145,6 +145,20 @@ type TDockOrientation=class() static const doNoOrient=0x0;static const doHorizontal=0x1; static const doVertical=0x2;static const doPages=0x3; end +type tbevelstyle = class() + static const bsLowered=0x0;static const bsRaised=0x1; +end +type tbevelshape = class() + static const bsbox=0x0; + static const bsframe=0x1; + static const bsTopLine=2; static const bsBottomLine=3; + static const bsLeftLine=4;static const bsRightLine=5;static const bsSpacer=6; +end +type tbevelcut = class() + static const bvNone=0x0; + static const bvLowered=0x1; + static const bvRaised=0x2;static const bvSpace=0x3; +end type TDragKind=class() static const dkDrag=0x0;static const dkDock=0x1; end @@ -385,7 +399,13 @@ type TSystemBitmap=class static OBM_OLD_ZOOM; static OBM_OLD_RESTORE; end - +type tvexpandsigntype = class() + static const tvestTheme = 0; // use themed sign + static const tvestPlusMinus=1; // use +/- sign + static const tvestArrow=2; // use blank arrow + static const tvestArrowFill=3; // use filled arrow + //tvestAngleBracket // use > symbol +end type TSystemCursor=class {** @explan(说明) 鼠标常量类,作为参考ocr_ 开头 %% @@ -411,17 +431,16 @@ type TSystemCursor=class static OCR_APPSTARTING; //126 static OCR_IBEAM; //152 end -type tmacroconst=class(_commctrldef_,_tvclmsageid_,_shellapi_,_gdiflatconst_) +type tmacroconst=class(_commctrldef_,_tvclmsageid_,_shellapi_) //static const tmacroconstinit=0x1; end -type tconstant=class(talign,TAnchorKind,TFormStyle,TComponentState,TComponentStyle,TWinControlFlag,TControlStyleType,TMouseButton,TShiftStateEnum,TControlFlag,TDockOrientation,TDragKind,TDragMode,TDragState,TDragMessage,TCanvasStates,TFPPenMode,TFPPenEndCap,TFPPenJoinStyle,TControlStateType,TFormBorderStyle,TAlignStyle9,TAlignStyleH3,TSysCursor,TActionListState,TToolButtonStyle,TPairSplitterType) +type tconstant=class(tvexpandsigntype,talign,TAnchorKind,TFormStyle,TComponentState,TComponentStyle,TWinControlFlag,TControlStyleType,TMouseButton,TShiftStateEnum,TControlFlag,TDockOrientation,tbevelcut,tbevelstyle,tbevelshape,TDragKind,TDragMode,TDragState,TDragMessage,TCanvasStates,TFPPenMode,TFPPenEndCap,TFPPenJoinStyle,TControlStateType,TFormBorderStyle,TAlignStyle9,TAlignStyleH3,TSysCursor,TActionListState,TToolButtonStyle,TPairSplitterType) end type TSLUICONST=class(tmacroconst,tconstant) static const WM_TRAY=0x464;static const opInsert="opInsert+"; - static const opRemove="opRemove-";static const opRecycling="opRecycling-";static const opclosemainwnd="~closemianwnd~"; - static const cl_disabled_pen=0xafafaf;static const cl_disabled_brush=0xf9f9f9; + static const opRemove="opRemove-";static const opRecycling="opRecycling-";static const opclosemainwnd="~closemianwnd~"; end type ws2def_h=class() static const AF_UNSPEC=0x0;static const AF_UNIX=0x1; @@ -1130,7 +1149,85 @@ type _gdi_h_=class() static const WGL_SWAP_UNDERLAY13=0x10000000;static const WGL_SWAP_UNDERLAY14=0x20000000;static const WGL_SWAP_UNDERLAY15=0x40000000; static const WGL_SWAPMULTIPLE_MAX=0x10; end -type _winuserdef_=class() +type t_sys_color_v = class() + static const SYS_COLOR_BASE = 0x80000000; + static const COLOR_SCROLLBAR=0x0; + static const COLOR_BACKGROUND=0x1;static const COLOR_ACTIVECAPTION=0x2;static const COLOR_INACTIVECAPTION=0x3; + static const COLOR_MENU=0x4;static const COLOR_WINDOW=0x5;static const COLOR_WINDOWFRAME=0x6; + static const COLOR_MENUTEXT=0x7;static const COLOR_WINDOWTEXT=0x8;static const COLOR_CAPTIONTEXT=0x9; + static const COLOR_ACTIVEBORDER=0xA;static const COLOR_INACTIVEBORDER=0xB;static const COLOR_APPWORKSPACE=0xC; + static const COLOR_HIGHLIGHT=0xD;static const COLOR_HIGHLIGHTTEXT=0xE;static const COLOR_BTNFACE=0xF; + static const COLOR_BTNSHADOW=0x10;static const COLOR_GRAYTEXT=0x11;static const COLOR_BTNTEXT=0x12; + static const COLOR_INACTIVECAPTIONTEXT=0x13;static const COLOR_BTNHIGHLIGHT=0x14;static const COLOR_3DDKSHADOW=0x15; + static const COLOR_3DLIGHT=0x16;static const COLOR_INFOTEXT=0x17;static const COLOR_INFOBK=0x18; + static const COLOR_HOTLIGHT=0x1A;static const COLOR_GRADIENTACTIVECAPTION=0x1B;static const COLOR_GRADIENTINACTIVECAPTION=0x1C; + static const COLOR_MENUHILIGHT=0x1D;static const COLOR_MENUBAR=0x1E;static const COLOR_DESKTOP=0x1; + static const COLOR_3DFACE=0xF;static const COLOR_3DSHADOW=0x10;static const COLOR_3DHIGHLIGHT=0x14; + static const COLOR_3DHILIGHT=0x14;static const COLOR_BTNHILIGHT=0x14; + static const clNone=0x1FFFFFFF;static const clDefault=0x20000000; + static const clScrollBar = SYS_COLOR_BASE .| COLOR_SCROLLBAR; + static const clBackground = SYS_COLOR_BASE .| COLOR_BACKGROUND; + static const clActiveCaption = SYS_COLOR_BASE .| COLOR_ACTIVECAPTION; + static const clInactiveCaption = SYS_COLOR_BASE .| COLOR_INACTIVECAPTION; + static const clMenu = SYS_COLOR_BASE .| COLOR_MENU; + static const clWindow = SYS_COLOR_BASE .| COLOR_WINDOW; + static const clWindowFrame = SYS_COLOR_BASE .| COLOR_WINDOWFRAME; + static const clMenuText = SYS_COLOR_BASE .| COLOR_MENUTEXT; + static const clWindowText = SYS_COLOR_BASE .| COLOR_WINDOWTEXT; + static const clCaptionText = SYS_COLOR_BASE .| COLOR_CAPTIONTEXT; + static const clActiveBorder = SYS_COLOR_BASE .| COLOR_ACTIVEBORDER; + static const clInactiveBorder = SYS_COLOR_BASE .| COLOR_INACTIVEBORDER; + static const clAppWorkspace = SYS_COLOR_BASE .| COLOR_APPWORKSPACE; + static const clHighlight = SYS_COLOR_BASE .| COLOR_HIGHLIGHT; + static const clHighlightText = SYS_COLOR_BASE .| COLOR_HIGHLIGHTTEXT; + static const clBtnFace = SYS_COLOR_BASE .| COLOR_BTNFACE; + static const clBtnShadow = SYS_COLOR_BASE .| COLOR_BTNSHADOW; + static const clGrayText = SYS_COLOR_BASE .| COLOR_GRAYTEXT; + static const clBtnText = SYS_COLOR_BASE .| COLOR_BTNTEXT; + static const clInactiveCaptionText = SYS_COLOR_BASE .| COLOR_INACTIVECAPTIONTEXT; + static const clBtnHighlight = SYS_COLOR_BASE .| COLOR_BTNHIGHLIGHT; + static const cl3DDkShadow = SYS_COLOR_BASE .| COLOR_3DDKSHADOW; + static const cl3DLight = SYS_COLOR_BASE .| COLOR_3DLIGHT; + static const clInfoText = SYS_COLOR_BASE .| COLOR_INFOTEXT; + static const clInfoBk = SYS_COLOR_BASE .| COLOR_INFOBK; + static const clHotLight = SYS_COLOR_BASE .| COLOR_HOTLIGHT; + static const clGradientActiveCaption = SYS_COLOR_BASE .| COLOR_GRADIENTACTIVECAPTION; + static const clGradientInactiveCaption = SYS_COLOR_BASE .| COLOR_GRADIENTINACTIVECAPTION; + static const clMenuHighlight = SYS_COLOR_BASE .| COLOR_MENUHILIGHT; + static const clMenuBar = SYS_COLOR_BASE .| COLOR_MENUBAR; + static const clColorDesktop = SYS_COLOR_BASE .| COLOR_DESKTOP; + static const cl3DFace = SYS_COLOR_BASE .| COLOR_3DFACE; + static const cl3DShadow = SYS_COLOR_BASE .| COLOR_3DSHADOW; + static const cl3DHiLight = SYS_COLOR_BASE .| COLOR_3DHIGHLIGHT; + static const clBtnHiLight = SYS_COLOR_BASE .| COLOR_BTNHILIGHT; + static const clFirstSpecialColor = clBtnHiLight; + static const cldisabledtext=0xafafaf;static const cldisabledbk=0xf9f9f9; + // standard colors + static const clBlack = 0x000000; + static const clMaroon = 0x000080; + static const clGreen = 0x008000; + static const clOlive = 0x008080; + static const clNavy = 0x800000; + static const clPurple = 0x800080; + static const clTeal = 0x808000; + static const clGray = 0x808080; + static const clSilver = 0xC0C0C0; + static const clRed = 0x0000FF; + static const clLime = 0x00FF00; + static const clYellow = 0x00FFFF; + static const clBlue = 0xFF0000; + static const clFuchsia = 0xFF00FF; + static const clAqua = 0xFFFF00; + static const clLtGray = 0xC0C0C0; // clSilver alias + static const clDkGray = 0x808080; // clGray alias + static const clWhite = 0xFFFFFF; + static const clMoneyGreen = 0xC0DCC0; + static const clSkyBlue = 0xF0CAA6; + static const clCream = 0xF0FBFF; + static const clMedGray = 0xA4A0A0; + +end +type _winuserdef_=class(t_sys_color_v) static const WINUSERAPI=0x0;static const WINABLEAPI=0x0; static const WINVER=0x500;static const MAKEINTRESOURCE=0x0;static const DIFFERENCE=0xB; static const RT_MANIFEST=0x18;static const CREATEPROCESS_MANIFEST_RESOURCE_ID=0x1;static const ISOLATIONAWARE_MANIFEST_RESOURCE_ID=0x2; @@ -1678,19 +1775,7 @@ type _winuserdef_=class() static const CWP_SKIPINVISIBLE=0x1;static const CWP_SKIPDISABLED=0x2;static const CWP_SKIPTRANSPARENT=0x4; static const CTLCOLOR_MSGBOX=0x0;static const CTLCOLOR_EDIT=0x1;static const CTLCOLOR_LISTBOX=0x2; static const CTLCOLOR_BTN=0x3;static const CTLCOLOR_DLG=0x4;static const CTLCOLOR_SCROLLBAR=0x5; - static const CTLCOLOR_STATIC=0x6;static const CTLCOLOR_MAX=0x7;static const COLOR_SCROLLBAR=0x0; - static const COLOR_BACKGROUND=0x1;static const COLOR_ACTIVECAPTION=0x2;static const COLOR_INACTIVECAPTION=0x3; - static const COLOR_MENU=0x4;static const COLOR_WINDOW=0x5;static const COLOR_WINDOWFRAME=0x6; - static const COLOR_MENUTEXT=0x7;static const COLOR_WINDOWTEXT=0x8;static const COLOR_CAPTIONTEXT=0x9; - static const COLOR_ACTIVEBORDER=0xA;static const COLOR_INACTIVEBORDER=0xB;static const COLOR_APPWORKSPACE=0xC; - static const COLOR_HIGHLIGHT=0xD;static const COLOR_HIGHLIGHTTEXT=0xE;static const COLOR_BTNFACE=0xF; - static const COLOR_BTNSHADOW=0x10;static const COLOR_GRAYTEXT=0x11;static const COLOR_BTNTEXT=0x12; - static const COLOR_INACTIVECAPTIONTEXT=0x13;static const COLOR_BTNHIGHLIGHT=0x14;static const COLOR_3DDKSHADOW=0x15; - static const COLOR_3DLIGHT=0x16;static const COLOR_INFOTEXT=0x17;static const COLOR_INFOBK=0x18; - static const COLOR_HOTLIGHT=0x1A;static const COLOR_GRADIENTACTIVECAPTION=0x1B;static const COLOR_GRADIENTINACTIVECAPTION=0x1C; - static const COLOR_MENUHILIGHT=0x1D;static const COLOR_MENUBAR=0x1E;static const COLOR_DESKTOP=0x1; - static const COLOR_3DFACE=0xF;static const COLOR_3DSHADOW=0x10;static const COLOR_3DHIGHLIGHT=0x14; - static const COLOR_3DHILIGHT=0x14;static const COLOR_BTNHILIGHT=0x14;static const GETWINDOWLONG=0x0; + static const CTLCOLOR_STATIC=0x6;static const CTLCOLOR_MAX=0x7;static const GETWINDOWLONG=0x0; static const SETWINDOWLONG=0x0;static const GETWINDOWLONGPTR=0x0;static const SETWINDOWLONGPTR=0x0; static const GETCLASSLONG=0x0;static const SETCLASSLONG=0x0;static const GETCLASSLONGPTR=0x0; static const SETCLASSLONGPTR=0x0;static const FINDWINDOW=0x0;static const FINDWINDOWEX=0x0; @@ -3145,331 +3230,6 @@ type _shellapi_=class() static const shil_last=0x4;static const wc_netaddress="msctls_netaddress";static const ncm_getaddress=0x401; static const ncm_setallowtype=0x402;static const ncm_getallowtype=0x403;static const ncm_displayerrortip=0x404; end -type _gdiflatconst_ = class() //gdiplusflat - //FillMode - static const FillModeAlternate = 0; - static const FillModeWinding = 1; - //QualityMode - static const QualityModeInvalid = -1; - static const QualityModeDefault = 0; - static const QualityModeLow = 1; - static const QualityModeHigh = 2; - //CompositingMode - static const CompositingModeSourceOver = 0; - static const CompositingModeSourceCopy = 1; - //CompositingQuality - static const CompositingQualityInvalid = QualityModeInvalid; - static const CompositingQualityDefault = QualityModeDefault; - static const CompositingQualityHighSpeed = QualityModeLow; - static const CompositingQualityHighQuality = QualityModeHigh; - static const CompositingQualityGammaCorrected = 3; - static const CompositingQualityAssumeLinear = 4; - //Unit - static const UnitWorld = 0; - static const UnitDisplay = 1; - static const UnitPixel = 2; - static const UnitPoint = 3; - static const UnitInch = 4; - static const UnitDocument = 5; - static const UnitMillimeter = 6; - //MetafileFrameUnit - static const MetafileFrameUnitPixel = UnitPixel; - static const MetafileFrameUnitPoint = UnitPoint; - static const MetafileFrameUnitInch = UnitInch; - static const MetafileFrameUnitDocument = UnitDocument; - static const MetafileFrameUnitMillimeter = UnitMillimeter; - static const MetafileFrameUnitGdi = 7; - ///CoordinateSpace - static const CoordinateSpaceWorld = 0; - static const CoordinateSpacePage = 1; - static const CoordinateSpaceDevice = 2; - //////WrapMode/////// - static const WrapModeTile = 0; - static const WrapModeTileFlipX = 1; - static const WrapModeTileFlipY = 2; - static const WrapModeTileFlipXY = 3; - static const WrapModeClamp = 4; - ///////HatchStyle////////////////// - static const HatchStyleHorizontal = 0 ; - static const HatchStyleVertical = 1 ; - static const HatchStyleForwardDiagonal = 2 ; - static const HatchStyleBackwardDiagonal = 3 ; - static const HatchStyleCross = 4 ; - static const HatchStyleDiagonalCross = 5 ; - static const HatchStyle05Percent = 6 ; - static const HatchStyle10Percent = 7 ; - static const HatchStyle20Percent = 8 ; - static const HatchStyle25Percent = 9 ; - static const HatchStyle30Percent = 10; - static const HatchStyle40Percent = 11; - static const HatchStyle50Percent = 12; - static const HatchStyle60Percent = 13; - static const HatchStyle70Percent = 14; - static const HatchStyle75Percent = 15; - static const HatchStyle80Percent = 16; - static const HatchStyle90Percent = 17; - static const HatchStyleLightDownwardDiagonal = 18; - static const HatchStyleLightUpwardDiagonal = 19; - static const HatchStyleDarkDownwardDiagonal = 20; - static const HatchStyleDarkUpwardDiagonal = 21; - static const HatchStyleWideDownwardDiagonal = 22; - static const HatchStyleWideUpwardDiagonal = 23; - static const HatchStyleLightVertical = 24; - static const HatchStyleLightHorizontal = 25; - static const HatchStyleNarrowVertical = 26; - static const HatchStyleNarrowHorizontal = 27; - static const HatchStyleDarkVertical = 28; - static const HatchStyleDarkHorizontal = 29; - static const HatchStyleDashedDownwardDiagonal = 30; - static const HatchStyleDashedUpwardDiagonal = 31; - static const HatchStyleDashedHorizontal = 32; - static const HatchStyleDashedVertical = 33; - static const HatchStyleSmallConfetti = 34; - static const HatchStyleLargeConfetti = 35; - static const HatchStyleZigZag = 36; - static const HatchStyleWave = 37; - static const HatchStyleDiagonalBrick = 38; - static const HatchStyleHorizontalBrick = 39; - static const HatchStyleWeave = 40; - static const HatchStylePlaid = 41; - static const HatchStyleDivot = 42; - static const HatchStyleDottedGrid = 43; - static const HatchStyleDottedDiamond = 44; - static const HatchStyleShingle = 45; - static const HatchStyleTrellis = 46; - static const HatchStyleSphere = 47; - static const HatchStyleSmallGrid = 48; - static const HatchStyleSmallCheckerBoard = 49; - static const HatchStyleLargeCheckerBoard = 50; - static const HatchStyleOutlinedDiamond = 51; - static const HatchStyleSolidDiamond = 52; - static const HatchStyleTotal = 53; - static const HatchStyleLargeGrid = HatchStyleCross ; - static const HatchStyleMin = HatchStyleHorizontal ; - static const HatchStyleMax = HatchStyleTotal - 1 ; - //DashStyle - static const DashStyleSolid = 0; - static const DashStyleDash = 1; - static const DashStyleDot = 2; - static const DashStyleDashDot = 3; - static const DashStyleDashDotDot = 4; - static const DashStyleCustom = 5; - //DashCap - static const DashCapFlat = 0; - static const DashCapRound = 2; - static const DashCapTriangle = 3; - //LineCap - static const LineCapFlat = 0; - static const LineCapSquare = 1; - static const LineCapRound = 2; - static const LineCapTriangle = 3; - static const LineCapNoAnchor = 0x10; // corresponds to flat cap - static const LineCapSquareAnchor = 0x11; // corresponds to square cap - static const LineCapRoundAnchor = 0x12; // corresponds to round cap - static const LineCapDiamondAnchor = 0x13; // corresponds to triangle cap - static const LineCapArrowAnchor = 0x14; // no correspondence - static const LineCapCustom = 0xff; // custom cap - static const LineCapAnchorMask = 0xf0; // mask to check for anchor or not. - /////CustomLineCapType///// - static const CustomLineCapTypeDefault = 0; - static const CustomLineCapTypeAdjustableArrow = 1; - ////LineJoin - static const LineJoinMiter = 0; - static const LineJoinBevel = 1; - static const LineJoinRound = 2; - static const LineJoinMiterClipped = 3; - ////PathPointType////////// - static const PathPointTypeStart = 0; // move - static const PathPointTypeLine = 1; // line - static const PathPointTypeBezier = 3; // default Bezier (= cubic Bezier) - static const PathPointTypePathTypeMask = 0x07; // type mask (lowest 3 bits). - static const PathPointTypeDashMode = 0x10; // currently in dash mode. - static const PathPointTypePathMarker = 0x20; // a marker for the path. - static const PathPointTypeCloseSubpath = 0x80; // closed flag - //Path types used for advanced path. - static const PathPointTypeBezier3 = 3; // cubic Bezier - ///////////WarpMode/////// - static const WarpModePerspective = 0; - static const WarpModeBilinear = 1; - //LinearGradientMode - static const LinearGradientModeHorizontal = 0; - static const LinearGradientModeVertical = 1; - static const LinearGradientModeForwardDiagonal = 2; - static const LinearGradientModeBackwardDiagonal = 3; - ///CombineMode - static const CombineModeReplace = 0 ; - static const CombineModeIntersect = 1 ; - static const CombineModeUnion = 2 ; - static const CombineModeXor = 3 ; - static const CombineModeExclude = 4 ; - static const CombineModeComplement = 5 ; - //ImageType - static const ImageTypeUnknown = 0; - static const ImageTypeBitmap = 1; - static const ImageTypeMetafile = 2; - ///InterpolationMode - static const InterpolationModeInvalid = QualityModeInvalid; - static const InterpolationModeDefault = QualityModeDefault; - static const InterpolationModeLowQuality = QualityModeLow; - static const InterpolationModeHighQuality = QualityModeHigh; - static const InterpolationModeBilinear = 3; - static const InterpolationModeBicubic = 4; - static const InterpolationModeNearestNeighbor = 5; - static const InterpolationModeHighQualityBilinear = 6; - static const InterpolationModeHighQualityBicubic = 7; - ///////PenAlignment////////////// - static const PenAlignmentCenter = 0; - static const PenAlignmentInset = 1; - //BrushType - static const BrushTypeSolidColor = 0; - static const BrushTypeHatchFill = 1; - static const BrushTypeTextureFill = 2; - static const BrushTypePathGradient = 3; - static const BrushTypeLinearGradient = 4; - //PenType - static const PenTypeSolidColor = 0; - static const PenTypeHatchFill = 1; - static const PenTypeTextureFill = 2; - static const PenTypePathGradient = 3; - static const PenTypeLinearGradient = 4; - static const PenTypeUnknown = -1; - //MatrixOrder - static const MatrixOrderPrepend = 0; - static const MatrixOrderAppend = 1; - //////GenericFontFamily - static const GenericFontFamilySerif = 0; - static const GenericFontFamilySansSerif = 1; - static const GenericFontFamilyMonospace = 2; - ////FontStyle - static const FontStyleRegular = 0; - static const FontStyleBold = 1; - static const FontStyleItalic = 2; - static const FontStyleBoldItalic = 3; - static const FontStyleUnderline = 4; - static const FontStyleStrikeout = 8; - ////SmoothingMode - static const SmoothingModeInvalid = QualityModeInvalid; - static const SmoothingModeDefault = QualityModeDefault; - static const SmoothingModeHighSpeed = QualityModeLow; - static const SmoothingModeHighQuality = QualityModeHigh; - static const SmoothingModeNone = 3 ; - static const SmoothingModeAntiAlias = 4; - ////PixelOffsetMode - static const PixelOffsetModeInvalid = QualityModeInvalid; - static const PixelOffsetModeDefault = QualityModeDefault; - static const PixelOffsetModeHighSpeed = QualityModeLow; - static const PixelOffsetModeHighQuality = QualityModeHigh; - static const PixelOffsetModeNone = 3 ; - static const PixelOffsetModeHalf = 4; - ///TextRenderingHint - static const TextRenderingHintSystemDefault = 0; // Glyph with system default rendering hint - static const TextRenderingHintSingleBitPerPixelGridFit = 1; // Glyph bitmap with hinting - static const TextRenderingHintSingleBitPerPixel = 2; // Glyph bitmap without hinting - static const TextRenderingHintAntiAliasGridFit = 3; // Glyph anti-alias bitmap with hinting - static const TextRenderingHintAntiAlias = 4; // Glyph anti-alias bitmap without hinting - static const TextRenderingHintClearTypeGridFit = 5; // Glyph CT bitmap with hinting - //MetafileType - static const MetafileTypeInvalid = 0; // Invalid metafile - static const MetafileTypeWmf = 1; // Standard WMF - static const MetafileTypeWmfPlaceable = 2; // Placeable WMF - static const MetafileTypeEmf = 3; // EMF (not EMF+) - static const MetafileTypeEmfPlusOnly = 4; // EMF+ without dual = ; down-level records - static const MetafileTypeEmfPlusDual = 5; // EMF+ with dual = ; down-level records - //EmfType - static const EmfTypeEmfOnly = MetafileTypeEmf; - static const EmfTypeEmfPlusOnly = MetafileTypeEmfPlusOnly; - static const EmfTypeEmfPlusDual = MetafileTypeEmfPlusDual; - ///ObjectType - static const ObjectTypeInvalid = 0 ; - static const ObjectTypeBrush = 1 ; - static const ObjectTypePen = 2 ; - static const ObjectTypePath = 3 ; - static const ObjectTypeRegion = 4 ; - static const ObjectTypeImage = 5 ; - static const ObjectTypeFont = 6 ; - static const ObjectTypeStringFormat = 7 ; - static const ObjectTypeImageAttributes = 8 ; - static const ObjectTypeCustomLineCap = 9 ; - //////////////// - - ///StringFormatFlags///////////////// - static const StringFormatFlagsDirectionRightToLeft = 0x00000001; - static const StringFormatFlagsDirectionVertical = 0x00000002; - static const StringFormatFlagsNoFitBlackBox = 0x00000004; - static const StringFormatFlagsDisplayFormatControl = 0x00000020; - static const StringFormatFlagsNoFontFallback = 0x00000400; - static const StringFormatFlagsMeasureTrailingSpaces = 0x00000800; - static const StringFormatFlagsNoWrap = 0x00001000; - static const StringFormatFlagsLineLimit = 0x00002000; - static const StringFormatFlagsNoClip = 0x00004000; - static const StringFormatFlagsBypassGDI = 0x80000000; - /////StringTrimming//////// - static const StringTrimmingNone = 0; - static const StringTrimmingCharacter = 1; - static const StringTrimmingWord = 2; - static const StringTrimmingEllipsisCharacter = 3; - static const StringTrimmingEllipsisWord = 4; - static const StringTrimmingEllipsisPath = 5; - //--------------------------------------------------------------------------- - // National language digit substitution - //--------------------------------------------------------------------------- - static const StringDigitSubstituteUser = 0; // As NLS setting - static const StringDigitSubstituteNone = 1; - static const StringDigitSubstituteNational = 2; - static const StringDigitSubstituteTraditional = 3; - //--------------------------------------------------------------------------- - // Hotkey prefix interpretation - //--------------------------------------------------------------------------- - static const HotkeyPrefixNone = 0; - static const HotkeyPrefixShow = 1; - static const HotkeyPrefixHide = 2; - //--------------------------------------------------------------------------- - // String alignment flags - //--------------------------------------------------------------------------- - // Left edge for left-to-right text; - // right for right-to-left text; - // and top for vertical - static const StringAlignmentNear = 0; - static const StringAlignmentCenter = 1; - static const StringAlignmentFar = 2; - ////////////DriverStringOptions///// - static const DriverStringOptionsCmapLookup = 1; - static const DriverStringOptionsVertical = 2; - static const DriverStringOptionsRealizedAdvance = 4; - static const DriverStringOptionsLimitSubpixel = 8; - /////FlushIntention/////// - static const FlushIntentionFlush = 0; - static const FlushIntentionSync = 1; - //EncoderParameterValueType - static const EncoderParameterValueTypeByte = 1; // 8-bit unsigned int - static const EncoderParameterValueTypeASCII = 2; // 8-bit byte containing one 7-bit ASCII - // code. NULL terminated. - static const EncoderParameterValueTypeShort = 3; // 16-bit unsigned int - static const EncoderParameterValueTypeLong = 4; // 32-bit unsigned int - static const EncoderParameterValueTypeRational = 5; // Two Longs. The first Long is the - // numerator; the second Long expresses the - // denomintor. - static const EncoderParameterValueTypeLongRange = 6; // Two longs which specify a range of - // integer values. The first Long specifies - // the lower end and the second one - // specifies the higher end. All values - // are inclusive at both ends - static const EncoderParameterValueTypeUndefined = 7; // 8-bit byte that can take any value - // depending on field definition - static const EncoderParameterValueTypeRationalRange = 8; // Two Rationals. The first Rational - // specifies the lower end and the second - // specifies the higher end. All values - // are inclusive at both ends - //----------GpTestControlEnum----------------------------------------------------------------- - static const TestControlForceBilinear = 0; - static const TestControlNoICM = 1; - static const TestControlGetBuildNumber = 2; - //EmfToWmfBitsFlags// - static const EmfToWmfBitsFlagsDefault = 0x00000000; - static const EmfToWmfBitsFlagsEmbedEmf = 0x00000001; - static const EmfToWmfBitsFlagsIncludePlaceable = 0x00000002; - static const EmfToWmfBitsFlagsNoXORClip = 0x00000004; -end implementation initialization end. \ No newline at end of file diff --git a/funcext/tvclib/utslvclgdi.tsf b/funcext/tvclib/utslvclgdi.tsf index 3fc6b48..5298d4a 100644 --- a/funcext/tvclib/utslvclgdi.tsf +++ b/funcext/tvclib/utslvclgdi.tsf @@ -99,6 +99,21 @@ type TGdi = class(TSLUIBASE) property Canvas read FCanvas write SetCanvas; property Handle read HandleNeeded; end +type tpenbushbase = class(tgdi) //alpha 通道的画刷 + function create(); + begin + inherited; + end + protected + function trans_syscolor(c); + begin + if (c .& 0xff000000) then + begin + return _wapi.GetSysColor(c .& 0x00ffffff); + end + return c; + end +end type Tcustomfont = class(tgdi) private fdwfacename; @@ -481,7 +496,7 @@ type TFontControl=class(Tcustomfont) function Onchange();override; begin inherited; - if FControl then + if FControl and not(FControl.ParentFont) then begin FControl.FontChanged(); end @@ -498,7 +513,7 @@ type TFontControl=class(Tcustomfont) end property Control read FControl write SetControl; end -type tcustompen=class(tgdi) +type tcustompen=class(tpenbushbase) private FStyle; FColor; @@ -521,6 +536,9 @@ type tcustompen=class(tgdi) begin if not HandleAllocated()then begin + {$ifndef linux} + if FColor=0x1FFFFFFF then return NULL_PEN; + {$endif} hp := reference(); if not hp then begin @@ -529,7 +547,8 @@ type tcustompen=class(tgdi) w := FWidth; end else w := 0; - hp := _wapi.CreatePen(FStyle,w,FColor); + c := trans_syscolor(FColor); + hp := _wapi.CreatePen(FStyle,w,c); addsource(hp); end FHandle := hp; @@ -545,6 +564,7 @@ type tcustompen=class(tgdi) if Canvas then Canvas.OnPenChange(); DestroyHandle(); end + function SetColor(c); begin if ifnumber(c)and c <> FColor then @@ -601,7 +621,7 @@ type tcustompen=class(tgdi) property Width read FWidth write SetWidth; property Style read FStyle write SetStyle; end -type tcustombrush=class(tgdi) +type tcustombrush=class(tpenbushbase) private FStyle; FColor; @@ -646,11 +666,15 @@ type tcustombrush=class(tgdi) begin if not HandleAllocated()then begin + {$ifndef linux} + if FColor = 0x1fffffff then return NULL_BRUSH; + {$endif} hp := reference(); if not hp then begin + c := trans_syscolor(FColor); LOGSTRUCT._setvalue_("lbstyle",FStyle); - LOGSTRUCT._setvalue_("lbcolor",FColor); + LOGSTRUCT._setvalue_("lbcolor",c); //LOGSTRUCT._setvalue_("lbhatch",FHatch); hp := _wapi.CreateBrushIndirect(LOGSTRUCT._getptr_); //hp := _wapi.CreateSolidBrush(FColor); @@ -1347,9 +1371,7 @@ type TcustomBitmap = class(TPicturebase) end function CopyRect(x,y,w,h); begin - {** - @explan(说明) 拷贝位图 %% - **} + return nil; r := nil; if HandleAllocated()then begin @@ -1396,7 +1418,7 @@ type TcustomBitmap = class(TPicturebase) return Image.ImageToString("bmp"); end return ""; - end + end function ToIcon(); begin {** @@ -1713,7 +1735,7 @@ type TCustomImageList=class(tcomponent) FChanged; FBKColor; FImages; - FDrawBimpFirst; + FDrawBmpFirst; FBmpItems; FBmpAdding; function inDesigning(); @@ -1870,7 +1892,7 @@ type TCustomImageList=class(tcomponent) FimageCount := 0; FBKColor :=0xffffff ;//rgb(255,255,255); FBmpItems := new tnumindexarray(); - //FDrawBimpFirst := true; + FDrawBmpFirst := true; inherited; end function HandleAllocated(); @@ -1983,7 +2005,7 @@ type TCustomImageList=class(tcomponent) if indexvalidate(i)then begin if not(flag >= 0)then flag := ILD_NORMAL; - if DrawBimpFirst then + if fDrawBmpFirst then begin bmp := FBmpItems[i]; if bmp then @@ -2101,7 +2123,7 @@ type TCustomImageList=class(tcomponent) property OnChange read FOnChange write FOnChange; property BkColor:COLORREF read FBKColor write setbkcolor; property Images:imagesdata read GetImages write SetImages; - property DrawBimpFirst read FDrawBimpFirst write FDrawBimpFirst; + property DrawBmpFirst read FDrawBmpFirst write FDrawBmpFirst; {** @param(Handle)(HIMAGELIS) imagelist句柄 %% @param(AutoDestroy)(bool) 是否销毁句柄 %% @@ -2169,7 +2191,14 @@ type TcustomCanvas = class(TSLUIBASE) @explan(说明) 画布对象 %% **} private + fdcwidth; + fdcheight; + falpha; FHandle; + FAlphahandle; + falphasaveid; + falphabm; + fhandleback; FFont; FBrush; FPen; @@ -2178,6 +2207,7 @@ type TcustomCanvas = class(TSLUIBASE) FSaveGdi; FRgn; FCounter; + FalphaCounter; FTabLength; FTabLenParam; _xformobj; @@ -2214,6 +2244,120 @@ type TcustomCanvas = class(TSLUIBASE) FTabLenParam.itablength := nv; end end + function setalpha(v);//透明度 + begin + if not HandleAllocated() then return ; + if not ifnumber(v) then return ; + nv := integer(v); + if nv>=0 and nv<=255 and nv<>falpha then + begin + oalpha := falpha; + if oalpha<>255 then //透明度改变 + begin + copyalphahandle(); + flashhandle(); + end + falpha := nv; + end + end + function createalphahandle(); //透明度构造临时句柄 + begin + {$ifdef linux} + if HandleAllocated() then + begin + if falpha<>255 then _wapi.g_object_set_data(FHandle,"alpha",falpha); + return 0; + end + {$endif} + if not(FAlphahandle) and (falpha<>255) then + begin + ///////////////////旋转判断 并且还原///////////////////////////////////// + hast := _wapi.getWorldTransform(FHandle,_xformobj._getptr_); + ts := _xformobj._getdata_(); + if not(hast and (ts<>array(1.0,0.0,0.0,1.0,0.0,0.0))) then + begin + ts := nil; + end + if ts then + begin + _xformobj.em11 := 1; + _xformobj.em12 := 0; + _xformobj.em21 := 0; + _xformobj.em22 := 1; + _xformobj.edx := 0; + _xformobj.edy := 0; + _wapi.SetWorldTransform(FHandle,_xformobj._getptr_); + end + //////////////////////////////////////////// + fhandleback := FHandle; + ps := array(0,0); + _wapi.GetCurrentPositionEx(FHandle,ps); + fdcwidth := _wapi.GetDeviceCaps(FHandle,8); + fdcheight := _wapi.GetDeviceCaps(FHandle,10); + + FAlphahandle := _wapi.CreateCompatibleDC(fhandleback); + falphabm := _wapi.CreateCompatibleBitmap(fhandleback,fdcwidth,fdcheight); + falphabmold := _wapi.SelectObject(FAlphahandle,falphabm); + _wapi.BitBlt(FAlphahandle,0,0,fdcwidth,fdcheight,fhandleback,0,0,SRCCOPY); + falphasaveid := _wapi.SaveDC(FAlphahandle); + ////////////////////旋转当前的画布/////////////////////////////////////// + _wapi.SetGraphicsMode(FAlphahandle,2); + if ts then + begin + _xformobj.em11 := ts[0]; + _xformobj.em12 := ts[1]; + _xformobj.em21 := ts[2]; + _xformobj.em22 := ts[3]; + _xformobj.edx := ts[4]; + _xformobj.edy := ts[5]; + _wapi.SetWorldTransform(FAlphahandle,_xformobj._getptr_); + end + //////////////////////////////////////////////// + _wapi.MoveToEx(FAlphahandle,ps[0],ps[1],ps); + FHandle := FAlphahandle; + FalphaCounter := new TCounter(); + flashhandle(); + end + end + function copyalphahandle();//透明度取消临时句柄 + begin + {$ifdef linux} + if HandleAllocated() then + begin + falpha := 255; + return _wapi.g_object_set_data(FHandle,"alpha",nil); + end + {$endif} + if FAlphahandle then + begin + FalphaCounter := nil; + ////////////////////当前旋转判断////////////////////////////////////////////////// + hast := _wapi.getWorldTransform(FAlphahandle,_xformobj._getptr_); + ts := _xformobj._getdata_(); + if not(hast and (ts<>array(1.0,0.0,0.0,1.0,0.0,0.0))) then + begin + ts := nil; + end + /////////////////////////////////////////////// + _wapi.RestoreDC(FAlphahandle,falphasaveid); + _wapi.AlphaBlend(fhandleback,0,0,fdcwidth,fdcheight,FAlphahandle,0,0,fdcwidth,fdcheight,(_shl(falpha,16))); + ////////////////////旋转原有的画布////////////////////// + if ts then + begin + _wapi.SetWorldTransform(fhandleback,_xformobj._getptr_); + end + FHandle := fhandleback; + fhandleback := 0; + ps := array(0,0); + _wapi.GetCurrentPositionEx(FAlphahandle,ps); + _wapi.SelectObject(FAlphahandle, falphabmold); + _wapi.DeleteDC(FAlphahandle); + _wapi.DeleteObject(falphabm); + FAlphahandle := 0; + falpha := 255; + _wapi.MoveToEx(FHandle,ps[0],ps[1],ps); + end + end function SetPen(p); begin FPen.copypen(p); @@ -2237,15 +2381,30 @@ type TcustomCanvas = class(TSLUIBASE) return _wapi.SelectObject(FHandle,hgdi); end end + function gethandle(); + begin + if fhandleback then return fhandleback; + return FHandle; + end + function getchandle(); + begin + return FHandle; + end function SetHandle(h); begin if ifnumber(h)then - begin - flashhandle(); - if FHandle <> h then - begin - FCounter.clean(); - end + begin + flashhandle(); + if GetHandle()=h then return ; + copyalphahandle(); + if HandleAllocated() then + begin + if FCounter.CurrenId>0 then + begin + FCounter.DeCrease(); + _wapi.RestoreDC(FHandle,-1); + end + end FHandle := h; if h then begin @@ -2343,6 +2502,7 @@ type TcustomCanvas = class(TSLUIBASE) function create();override; begin inherited; + falpha := 255; FTabLength := 0; FCounter := new TCounter(); FHandle := 0; @@ -2387,6 +2547,7 @@ type TcustomCanvas = class(TSLUIBASE) **} if HandleAllocated()then begin + createalphahandle(); if FState .& 1 then begin SelectObject(FPen.Handle); @@ -2442,19 +2603,19 @@ type TcustomCanvas = class(TSLUIBASE) begin FState .|= 16; end - function SetViewportOrg(xy); - begin - {** - @explan(说明)设置选择基准点 %% - @param(xy)(array) array(x,y)%% - @return(integer) %% - **} - if HandleAllocated()then - begin - if not ifarray(xy)then return 0; - return _wapi.SetViewportOrgEx(FHandle,xy[0],xy[1],nil); - end - end +// function SetViewportOrg(xy); +// begin +// {** +// @explan(说明)设置选择基准点 %% +// @param(xy)(array) array(x,y)%% +// @return(integer) %% +// **} +// if HandleAllocated()then +// begin +// if not ifarray(xy)then return 0; +// return _wapi.SetViewportOrgEx(FHandle,xy[0],xy[1],nil); +// end +// end function SetPixel(xy,colr); begin {** @@ -2484,6 +2645,7 @@ type TcustomCanvas = class(TSLUIBASE) **} if HandleAllocated()then begin + createalphahandle(); return _wapi.FillRect(FHandle,(ifrect(rec)?rec:zeros(4)),FBrush.Handle); end end @@ -2496,7 +2658,7 @@ type TcustomCanvas = class(TSLUIBASE) if not HandleAllocated()then exit; return _wapi.InvertRect(FHandle,rec,FBrush.Handle); end - function moveto(pos); + function moveto(pos);overload; begin {** @explan(说明)移动当前点%% @@ -2511,7 +2673,11 @@ type TcustomCanvas = class(TSLUIBASE) end return ret; end - function lineto(pos); //画线 + function moveto(x,y);overload; + begin + if ifnumber(x) and ifnumber(y) then return moveto(array(x,y)); + end + function lineto(pos);overload; //画线 begin {** @explan(说明)画线到点%% @@ -2524,6 +2690,10 @@ type TcustomCanvas = class(TSLUIBASE) return _wapi.LineTo(FHandle,pos[0],pos[1]); end end + function lineto(x,y);overload; + begin + if ifnumber(x) and ifnumber(y) then return lineto(array(x,y)); + end function textout(str,pos); //输出文字,str文字,pos开始位置 begin {** @@ -2577,6 +2747,7 @@ type TcustomCanvas = class(TSLUIBASE) @param(bmp)(tcustombitmap) 位图 %% **} if not(bmp is class(tcustombitmap))then exit; + createalphahandle(); bmp.StretchDraw(self,rec); end function DrawBitmap(bmp,p); @@ -2588,6 +2759,7 @@ type TcustomCanvas = class(TSLUIBASE) **} if not(bmp is class(tcustombitmap))then return-1; if not ifarray(p)then p := array(0,0); + createalphahandle(); bmp.draw(self,p[0],p[1]); end function DrawIcon(ico,p); @@ -2599,6 +2771,7 @@ type TcustomCanvas = class(TSLUIBASE) **} if HandleAllocated()then begin + createalphahandle(); if not(ifarray(p)and ifnumber(p[1])and ifnumber(p[0]))then p := array(0,0); if(ico is class(tcustomicon))and ico.Handle then return _wapi.DrawIcon(FHandle,p[0],p[1],ico.Handle); end @@ -2732,27 +2905,40 @@ type TcustomCanvas = class(TSLUIBASE) return ret; end - function CopyBitmap(rect); + function CopyBitmap(rec); begin {** @explan(说明) 获取canvas区域到位图 %% @param(array of integer) 区域 array(左,上,右,下); @return(tcustombitmap|nil) 成功返回位图 %% **} - r := nil; + R := new tcustombitmap(); {$ifdef linux} + sf := _wapi.gtk_object_get_data(FHandle,"-surface-"); + if sf then + begin + fn := temppath()+"/-tempsurface-.png"; + CreateDirWithFileName(fn); + if 0=_wapi.cairo_surface_write_to_png(sf,(fn)) then r.id := fn; + else return 0; + end return r; {$endif} - if not(ifarray(rect)and rect[2]>rect[0]and rect[3]>rect[1])then return r; if not HandleAllocated()then return r; + rect := rec; + if not(ifarray(rect)and rect[2]>rect[0]and rect[3]>rect[1])then + begin + dcw := _wapi.GetDeviceCaps(FHandle,8); + dch := _wapi.GetDeviceCaps(FHandle,10); + rect := array(0,0,dcw,dch); + end if not FHDC then FHDC := _wapi.CreateCompatibleDC(0); if not FHDC then return r; - bthandle := _wapi.CreateCompatibleBitmap(_wapi.GetDC(0),w,h); + bthandle := _wapi.CreateCompatibleBitmap(FHDC,rect[2]-rect[0],rect[3]-rect[1]); if not bthandle then return r; oldb := _wapi.SelectObject(FHDC,bthandle); _wapi.BitBlt(FHDC,0,0,rect[2]-rect[0],rect[3]-rect[1],FHandle,rect[0],rect[1],SRCCOPY); if oldb then _wapi.SelectObject(FHDC,oldb); - R := new tcustombitmap(); R.handle := bthandle; return r; end @@ -2761,16 +2947,18 @@ type TcustomCanvas = class(TSLUIBASE) {** @explan(说明)文本旋转%% @param(t)(array) array(cos,-sin,sin,cos,x,y)%% - **} - {$ifdef linux} - return r; - {$endif} + **} _xformobj.em11 := t[0]; _xformobj.em12 := t[1]; _xformobj.em21 := t[2]; _xformobj.em22 := t[3]; _xformobj.edx := t[4]; _xformobj.edy := t[5]; + {$ifdef linux} + _wapi.cairo_identity_matrix(FHandle); + _wapi.cairo_transform(FHandle,_xformobj._getptr_); + return true; + {$endif} return _wapi.SetWorldTransform(FHandle,_xformobj._getptr_); end function trans(ag,x,y,clockwise); @@ -2779,11 +2967,12 @@ type TcustomCanvas = class(TSLUIBASE) @explan(说明)文本旋转%% @param(ag)(double) 角度%% **} - {$ifdef linux} - _wapi.cairo_translate(FHandle,x,y); - _wapi.cairo_rotate(FHandle,clockwise?ag:(-ag)); - return 1; - {$endif} +// {$ifdef linux} +// //tm := Ttagxform(nil); +// _wapi.cairo_translate(FHandle,x,y); +// _wapi.cairo_rotate(FHandle,clockwise?ag:(-ag)); +// return 1; +// {$endif} if clockwise then return trans(-ag,x,y); _xformobj.em11 := cos(ag); _xformobj.em12 := -sin(ag); @@ -2791,6 +2980,11 @@ type TcustomCanvas = class(TSLUIBASE) _xformobj.em22 := cos(ag); _xformobj.edx := ifnumber(x)?x:0; _xformobj.edy := ifnumber(y)?y:0; + {$ifdef linux} + _wapi.cairo_identity_matrix(FHandle); + _wapi.cairo_transform(FHandle,_xformobj._getptr_); + return true; + {$endif} return _wapi.SetWorldTransform(FHandle,_xformobj._getptr_); end function SetPolyFillMode(md); //设置填充样式 @@ -2858,12 +3052,12 @@ type TcustomCanvas = class(TSLUIBASE) begin requiregdi(); if HandleAllocated() then return _wapi.StrokeAndFillPath(FHandle); - end} + end function DeleteDC(); begin if HandleAllocated()then _wapi.DeleteDC(FHandle); FHandle := 0; - end + end} function SaveDC(); begin {** @@ -2871,7 +3065,9 @@ type TcustomCanvas = class(TSLUIBASE) **} if HandleAllocated()then begin - FCounter.InCrease(); + if FalphaCounter then FCounter.InCrease(); + else + FCounter.InCrease(); _wapi.SaveDC(FHandle); end end @@ -2882,15 +3078,19 @@ type TcustomCanvas = class(TSLUIBASE) **} if HandleAllocated()then begin - if FCounter.CurrenId>0 then + ct := FalphaCounter?FalphaCounter:FCounter; + if ct.CurrenId>0 then begin - FCounter.DeCrease(); + ct.DeCrease(); _wapi.RestoreDC(FHandle,-1); FState := 1+2+4+8+16+32; + return 1; end end end - property Handle read FHandle write SetHandle; + property alpha read falpha write setAlpha; //透明度0（完全透明） 到255（不透明） + property Handle read gethandle write SetHandle; //原始句柄 + property chandle read getchandle; //当前绘制的画布 property pen read FPen write SetPen; property font read FFont write SetFont; property brush read FBrush write SetBrush; @@ -2905,6 +3105,110 @@ type TcustomCanvas = class(TSLUIBASE) @param(TextMetric)(ttagTEXTMETRICA) 文本样式信息 %% **} end +type tcustommemcanvas = class(tcustomcanvas) + {** + @explan(说明) 内存画布，支持保存png文件 %% + **} + function create(w,h); + begin + {** + @explan(说明) 构造内存画布 %% + @param(w)(integer) 宽度 %% + @param(h)(integer) 高度 %% + **} + inherited create(); +{$ifdef linux} + get_w_h(w,h,wo,ho); + fimg := _wapi.cairo_image_surface_create(1,wo,ho); + fcurhdc := _wapi.cairo_create(fimg); + _wapi.gtk_object_set_data(fcurhdc,nil); + _wapi.gtk_object_set_data(fcurhdc,"-surface-",fimg); +{$else} + folddc := _wapi.GetDC(0); + get_w_h(w,h,wo,ho); + fimg := _wapi.CreateCompatibleBitmap(folddc,wo,ho); + fcurhdc := _wapi.CreateCompatibleDC(folddc); + foimg := _wapi.SelectObject(fcurhdc,fimg); + fsaveid := _wapi.SaveDC(fcurhdc); + _wapi.SetGraphicsMode(fcurhdc,2); +{$endif} + handle := fcurhdc; + end + function destroy();override; + begin +{$ifdef linux} + _wapi.cairo_surface_destroy(fimg); + _wapi.cairo_destroy(fcurhdc); + +{$else} + _wapi.ReleaseDC(0,folddc); + _wapi.SelectObject(fcurhdc,foimg); + _wapi.DeleteDC(fcurhdc); + _wapi.DeleteObject(fimg); +{$endif} + handle := 0; + inherited; + end + function savepng(fn); //保存png + begin + {** + @explan(说明) 保存为png文件 %% + @param(fb)(string) 文件名，非.png结尾会自动添加.png后缀 %% + **} + fn_ := fn; + if ifstring(fn_) and fn_ then + begin + hd := handle; + ba := alpha; + if ba<>255 then alpha := 255; + if parseregexpr("\\.png$",fn_,"",m,mp,ml)<>1 then fn_+=".png"; +{$ifdef linux} + sf := _wapi.gtk_object_get_data(hd,"-surface-"); + if sf then + begin + fn_ := ansitoutf8(fn_); + CreateDirWithFileName(fn_); + r := ( 0=_wapi.cairo_surface_write_to_png(sf,(fn_))); + end +{$else} + nmg := new tcustomimage(); + nmg.FromHBitmap(fimg); + r := nmg.SavetoFile(fn_,"png"); +{$endif} + if ba<>255 then alpha := ba; + return r; + end + end + property width read FWidth; + property height read fheight; + private + function get_w_h(w,h,wo,ho); + begin +{$ifdef linux} + if w>0 then wo := int(w); + else + wo := _wapi.gdk_screen_width()-50; + if h>0 then ho := int(w); + else ho := _wapi.gdk_screen_height()-50; + +{$else} + if w>0 then wo := int(w); + else + wo := _wapi.GetDeviceCaps(folddc,8); + if h>0 then ho := int(w); + else ho := _wapi.GetDeviceCaps(folddc,10); +{$endif} + FWidth := wo; + fheight := ho; + end + private + FWidth; + fheight; + fimg; + foimg; + fcurhdc; + folddc; +end type TControlCanvs=class(TcustomCanvas) function Create(); begin @@ -3117,7 +3421,7 @@ type tshapeEllipse = class(tshape,tshaperect) begin if fcanvas and fcanvas.HandleAllocated() and frect then begin - fcanvas._wapi.Ellipse(fcanvas.handle,frect[0],frect[1],frect[2],frect[3]); + fcanvas._wapi.Ellipse(fcanvas.chandle,frect[0],frect[1],frect[2],frect[3]); end return inherited; end @@ -3133,7 +3437,7 @@ type tshapeRectangle = class(tshape,tshaperect) begin if fcanvas and fcanvas.HandleAllocated() and frect then begin - fcanvas._wapi.Rectangle(fcanvas.handle,frect[0],frect[1],frect[2],frect[3]); + fcanvas._wapi.Rectangle(fcanvas.chandle,frect[0],frect[1],frect[2],frect[3]); end return inherited; end @@ -3147,7 +3451,7 @@ type tshaperoundrect = class(tshape,tshaperect) begin if fcanvas and fcanvas.HandleAllocated() and frect then begin - fcanvas._wapi.RoundRect(fcanvas.handle,frect[0],frect[1],frect[2],frect[3],froundw,froundh); + fcanvas._wapi.RoundRect(fcanvas.chandle,frect[0],frect[1],frect[2],frect[3],froundw,froundh); end return inherited; end @@ -3170,7 +3474,7 @@ type tshapeframe = class(tshape,tshaperect) begin if fcanvas and fcanvas.HandleAllocated() and frect then begin - fcanvas._wapi.DrawFrameControl(fcanvas.handle,frect,ftype,fstyle); + fcanvas._wapi.DrawFrameControl(fcanvas.chandle,frect,ftype,fstyle); end return inherited; end @@ -3197,8 +3501,8 @@ type tshapearc = class(tshape,tshaperect,tsepoint) begin if fcanvas and fcanvas.HandleAllocated() and fsp and fep and frect then begin - if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.Handle,fdir); - fcanvas._wapi.arc(fcanvas.handle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]); + if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.cHandle,fdir); + fcanvas._wapi.arc(fcanvas.Chandle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]); end return inherited; end @@ -3212,8 +3516,8 @@ type tshapepie = class(tshape,tshaperect,tsepoint) begin if fcanvas and fcanvas.HandleAllocated() and fsp and fep and frect then begin - if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.Handle,fdir); - fcanvas._wapi.pie(fcanvas.handle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]); + if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.CHandle,fdir); + fcanvas._wapi.pie(fcanvas.Chandle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]); end return inherited; end @@ -3227,8 +3531,8 @@ type tshapechord = class(tshape,tshaperect,tsepoint) begin if fcanvas and fcanvas.HandleAllocated() and fsp and fep and frect then begin - if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.Handle,fdir); - fcanvas._wapi.chord(fcanvas.handle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]); + if fdir=1 or fdir = 2 then FCanvas._wapi.SetArcDirection(FCanvas.CHandle,fdir); + fcanvas._wapi.chord(fcanvas.Chandle,frect[0],frect[1],frect[2],frect[3],fsp[0],fsp[1],fep[0],fep[1]); end return inherited; end @@ -3242,7 +3546,7 @@ type tshapepolygon = class(tshapepolyline) begin if fcanvas and fcanvas.HandleAllocated() and fbpoints then begin - fcanvas._wapi.Polygon(fcanvas.handle,fbpoints,length(fbpoints)); + fcanvas._wapi.Polygon(fcanvas.Chandle,fbpoints,length(fbpoints)); end return inherited; end @@ -3283,7 +3587,7 @@ type tshapepolyline = class(tshape) begin if fcanvas and fcanvas.HandleAllocated() and fbpoints then begin - fcanvas._wapi.polyline(fcanvas.handle,fbpoints,length(fbpoints)); + fcanvas._wapi.polyline(fcanvas.Chandle,fbpoints,length(fbpoints)); end return self(true); end @@ -3300,7 +3604,7 @@ type tshapeBezier = class(tshape) begin if fcanvas and fcanvas.HandleAllocated() and fbpoints then begin - fcanvas._wapi.PolyBezier(fcanvas.handle,fbpoints,length(fbpoints)); + fcanvas._wapi.PolyBezier(fcanvas.Chandle,fbpoints,length(fbpoints)); end return inherited; end @@ -3462,6 +3766,7 @@ begin end return r; end + function get_imagecodec_(n); begin r := array(); diff --git a/funcext/tvclib/utslvclmemstruct.tsf b/funcext/tvclib/utslvclmemstruct.tsf index efeae0e..9066797 100644 --- a/funcext/tvclib/utslvclmemstruct.tsf +++ b/funcext/tvclib/utslvclmemstruct.tsf @@ -1436,11 +1436,22 @@ type tagCOMPOSITIONFORM=class(tslcstructureobj) private FPonter; end -type Ttagxform=class(tslcstructureobj) +type Ttagxform=class(tslcstructureobj) //兼容cairo 和 gdi private static SSTRUCT; class function getstruct() begin +{$ifdef linux} + if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array( + (0,"double",0), + (1,"double",0), + (2,"double",0), + (3,"double",0), + (4,"double",0), + (5,"double",0) + ) + ); +{$else} if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array( (0,"float",0), (1,"float",0), @@ -1450,6 +1461,7 @@ type Ttagxform=class(tslcstructureobj) (5,"float",0) ) ); +{$endif} return SSTRUCT; end public diff --git a/funcext/tvclib/utslvclpage.tsf b/funcext/tvclib/utslvclpage.tsf index 72b7795..d50dcd2 100644 --- a/funcext/tvclib/utslvclpage.tsf +++ b/funcext/tvclib/utslvclpage.tsf @@ -155,12 +155,12 @@ type tcustompagecontrol = class(TCustomControl) begin FirstViewIndex := 0; end - ybase := 0; + ybase := rec[1]; for i,v in FTabItemswidth do begin if i>=FirstViewIndex then begin - FTabRects[i] := array(0,ybase,FTabHeight,ybase+FTabItemswidth[i]-1); + FTabRects[i] := array(rec[0],ybase,FTabHeight+rec[0],ybase+FTabItemswidth[i]-1); ybase+=FTabItemswidth[i]; if xbase>(rec[3]-FTabHeight-FTabHeight) then break; end @@ -180,7 +180,7 @@ type tcustompagecontrol = class(TCustomControl) Fnextrect := array(rec[2]-FTabHeight,rec[3]-FTabHeight,rec[2],rec[3]); end else FirstViewIndex := 0; - ybase := 0; + ybase := rec[1]; for i,v in FTabItemswidth do begin if i>=FirstViewIndex then @@ -211,12 +211,12 @@ type tcustompagecontrol = class(TCustomControl) Fnextrect := array(rec[2]-FTabHeight,rec[1],rec[2],rec[1]+FTabHeight); Fprevrect := array(rec[2]-FTabHeight*2,rec[1],rec[2]-FTabHeight,rec[1]+FTabHeight); end else FirstViewIndex := 0; - xbase := 0; + xbase := rec[0]; for i,v in FTabItemswidth do begin if i>=FirstViewIndex then begin - FTabRects[i] := array(xbase,0,xbase+FTabItemswidth[i]-1,FTabHeight); + FTabRects[i] := array(xbase,rec[1],xbase+FTabItemswidth[i]-1,FTabHeight+rec[1]); xbase+=FTabItemswidth[i]; if xbase>(rec[2]-FTabHeight-FTabHeight) then break; end else @@ -235,7 +235,7 @@ type tcustompagecontrol = class(TCustomControl) Fnextrect := array(rec[2]-FTabHeight,rec[3]-FTabHeight,rec[2],rec[3]); Fprevrect := array(rec[2]-FTabHeight*2,rec[3]-FTabHeight,rec[2]-FTabHeight,rec[3]); end else FirstViewIndex := 0; - xbase := 0; + xbase := rec[0]; for i,v in FTabItemswidth do begin if i>=FirstViewIndex then diff --git a/funcext/tvclib/utslvclstdctl.tsf b/funcext/tvclib/utslvclstdctl.tsf index 4c738df..6fb2d20 100644 --- a/funcext/tvclib/utslvclstdctl.tsf +++ b/funcext/tvclib/utslvclstdctl.tsf @@ -331,7 +331,11 @@ type tcustombtn = class(TCustomControl) // **} function Create(aowner); begin + FtextPosition := 0; inherited; + Parentcolor := false; + //Border := true; + //bordercolor := rgb(200,200,200); fbtntimer := new TCustomTimer(self); fbtntimer.Ontimer := thisfunction(judgestate); end @@ -456,7 +460,8 @@ type tcustombtn = class(TCustomControl) // if true then //绘制边框 begin C := 0x090909; - dc.pen.Color := max(0,Color-c); + bc := Color; + dc.pen.Color := max(0,bc-c); dc.pen.Width := 1; rec := cr; rec[2]-=1; @@ -1185,7 +1190,7 @@ type teditable=class(TSLUIBASE) // else dc.pen.color := 11842740;//rgb(180,180,180); if fhost.Enabled then dc.brush.Color := FHost.Color; - else dc.brush.color := cl_disabled_brush; + else dc.brush.color := cldisabledbk; dc.draw("RoundRect",array(rbc[0:1],rbc[2:3],array(3,3))); end end @@ -2374,6 +2379,124 @@ type tVirtualCalender=class(TSLUIBASE) FCellWidth; FCellHeight; end +type tcustombevel = class(TGraphicControl) +{** + @explan(说明)bevel控件 %% +**} + function create(AOwner); + begin + inherited; + caption := ""; + fshape := bsbox; + fstyle := bsLowered; + end + function paint();override; + begin + if iffuncptr(OnPaint) then call(OnPaint,self(true)); + cvs := Canvas; + cvs.pen.Width := 1; + aleft := 0; + atop := 0; + AWidth := Width; + AHeight := Height; + if fstyle=bsRaised then + begin + Colora := cl3DHilight; + Colorb := cl3DShadow; + end else + begin + Colora := cl3DShadow; + Colorb := cl3DHilight; + end + case fshape of + bsbox: + begin + cvs.Pen.Color:=Colora; + cvs.MoveTo(array(ALeft, ATop + AHeight - 1)); + cvs.LineTo(array(ALeft, ATop)); + cvs.LineTo(array(ALeft + AWidth - 1, ATop)); + cvs.Pen.Color:=Colorb; + cvs.LineTo(array(ALeft + AWidth - 1, ATop + AHeight - 1)); + cvs.LineTo(array(ALeft , ATop + AHeight - 1)); + end + bsframe: + begin + cvs.Pen.Color:=Colora; + cvs.MoveTo(array(ALeft, ATop + AHeight - 1)); + cvs.LineTo(array(ALeft, ATop)); + cvs.LineTo(array(ALeft + AWidth - 1, ATop)); + cvs.MoveTo(array(ALeft + AWidth - 2, ATop + 1)); + cvs.LineTo(array(ALeft + AWidth - 2, ATop + AHeight - 2)); + cvs.LineTo(array(ALeft + 1, ATop + AHeight - 2)); + cvs.Pen.Color:=Colorb; + cvs.MoveTo(array(ALeft + 1, ATop + AHeight - 2)); + cvs.LineTo(array(ALeft + 1, ATop + 1)); + cvs.LineTo(array(ALeft + AWidth - 2, ATop + 1)); + cvs.MoveTo(array(ALeft + AWidth - 1, ATop)); + cvs.LineTo(array(ALeft + AWidth - 1, ATop + AHeight - 1)); + cvs.LineTo(array(ALeft, ATop + AHeight - 1)); + end + bsTopLine: + begin + cvs.Pen.Color:=Colora; + cvs.MoveTo(array(ALeft, ATop)); + cvs.LineTo(array(ALeft + AWidth - 1, ATop)); + cvs.Pen.Color:=Colorb; + cvs.MoveTo(array(ALeft, ATop + 1)); + cvs.LineTo(array(ALeft + AWidth - 1, ATop + 1)); + end + bsBottomLine: + begin + cvs.Pen.Color:=Colorb; + cvs.MoveTo(array(ALeft, ATop + AHeight - 1)); + cvs.LineTo(array(ALeft + AWidth - 1, ATop + AHeight - 1)); + cvs.Pen.Color:=Colora; + cvs.MoveTo(array(ALeft, ATop + AHeight - 2)); + cvs.LineTo(array(ALeft + AWidth - 1, ATop + AHeight - 2)); + end + bsLeftLine: + begin + cvs.Pen.Color:=Colora; + cvs.MoveTo(array(ALeft, ATop)); + cvs.LineTo(array(ALeft, ATop + AHeight - 1)); + cvs.Pen.Color:=Colorb; + cvs.MoveTo(array(ALeft + 1, ATop)); + cvs.LineTo(array(ALeft + 1, ATop + AHeight - 1)); + end + bsRightLine: + begin + cvs.Pen.Color:=Colorb; + cvs.MoveTo(array(ALeft + AWidth - 1, ATop)); + cvs.LineTo(array(ALeft + AWidth - 1, ATop + AHeight - 1)); + cvs.Pen.Color:=Colora; + cvs.MoveTo(array(ALeft + AWidth - 2, ATop)); + cvs.LineTo(array(ALeft + AWidth - 2, ATop + AHeight)); + end + + end + end + published + property shape:tbevelshape read fshape write setshape; + property style:tbevelstyle read fstyle write setstyle; + protected + private + function setshape(v); + begin + if not( v in array(0,1,2,3,4,5,6)) then return ; + if v=fshape then return ; + fshape := v; + InvalidateRect(nil,false); + end + function setstyle(v); + begin + if not( v in array(0,1)) then return ; + if v=fstyle then return ; + fstyle := v; + InvalidateRect(nil,false); + end + fshape; + fstyle; +end type TcustomLabel = class(TGraphicControl) {** @explan(说明)标签控件 %% @@ -2473,14 +2596,28 @@ type tcustomedit=class(TCustomControl) function AfterConstruction();override; begin inherited; + Border := true; Left := 10; Top := 10; //Ftextalign := 0; Width := 80; Height := 25; FEditable := new TEntryEditable(); + FEditable.Border := false; FEditable.host := self(true); end + function ncpaint(rec);override; + begin + dc := Canvas; + ls := array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0)); + dc.moveto(ls[3]); + dc.pen.color := rgb(236,236,236); + dc.LineTo(ls[0]); + dc.LineTo(ls[1]); + dc.LineTo(ls[2]); + dc.pen.color := rgb(131,131,131); + dc.LineTo(ls[3]); + end function ExecuteCommand(cmd,pm);override; begin if FEditable then return FEditable.ExecuteCommand(cmd,pm); @@ -2599,7 +2736,7 @@ type tcustomedit=class(TCustomControl) property limitlength:integer read getlimitlength write setLimitLength; property LineWrap:bool read getLineWrap write setLineWrap; property placeholder:string read getplaceholder write Setplaceholder; - property Border:bool read getBorder write SetBorder; + //property Border:bool read getBorder write SetBorder; {** @param(LineWrap)(bool)自动换行,默认为false不自动换行%% @param(onmaxtext)(fpointer)达到文本最大回调%% @@ -2616,14 +2753,14 @@ type tcustomedit=class(TCustomControl) r[3]-=1; return r; end - function getBorder(); + {function getBorder(); begin if FEditable then return FEditable.Border; end function setBorder(s);override; begin if FEditable then return FEditable.Border := s; - end + end} function getentrytext(); begin if FEditable then return FEditable.text; @@ -3033,12 +3170,14 @@ type TCustomListBoxbase=class(TCustomScrollControl) protected /////////////////滚动条相关////////////////////////////////////////// function GetClientXCapacity();virtual; //宽度容量 begin - r := integer(ClientRect[2]/GetXScrollDelta()); + c := ClientRect; + r := integer(c[2]/GetXScrollDelta()); return r; end function GetClientYCapacity();virtual; //高度容量 begin - return integer(ClientRect[3]/GetYScrollDelta()); + c := ClientRect; + return integer(c[3]/GetYScrollDelta()); end function GetClientXCount();virtual; //宽度间隔 begin @@ -3085,7 +3224,16 @@ type TCustomListBoxbase=class(TCustomScrollControl) autoscroll := 1; ThumbTrack := true; FScroolChanged := false; + Border := true; + //bordercolor := rgb(130,135,144); end + function ncpaint(rec);override; + begin + dc := Canvas; + ls := array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0)); + dc.pen.color := rgb(130,135,144); + dc.draw("polyline",ls); + end function UpDateScrollBar(); //滚动条改变 begin DoControlAlign(); @@ -3116,8 +3264,9 @@ type TCustomListBoxbase=class(TCustomScrollControl) ypos := GetYPos(); // 计算需要重绘的区域 ps := PAINTSTRUCT().rcPaint; - tp := ps[1]; - bo := ps[3]; + c := ClientRect; + tp := max(ps[1],c[1]); + bo := min(ps[3],c[3]); FirstLine := integer(max(0,yPos+(tp)/GetYScrollDelta())); LastLine := integer(min(FItemCount-1,yPos+(bo)/GetYScrollDelta())); cvs := Canvas; @@ -3193,7 +3342,7 @@ type TCustomListBoxbase=class(TCustomScrollControl) xp := GetXpos(); DY := GetYScrollDelta(); rc[1]:=(idx-yp) * DY; - rc[0]:=(0-xp) * GetXScrollDelta(); + rc[0]:=(0-xp) * GetXScrollDelta()+rc[0]; rc[3]:= rc[1]+DY; return rc; end @@ -3271,6 +3420,7 @@ type TCustomListBoxbase=class(TCustomScrollControl) function FontChanged(o);override; begin ft := Font; + if not ft then return ; wd := ft.width; h := ft.Height; if h <> FFontHeight or wd <> FFontWidth then @@ -4307,7 +4457,7 @@ type TcustomComboBox=class(TCustomComboBoxbase) CallMessgeFunction(Foneditchanged,o,e); if FMultisel then return feditischanging:=false; t := o.Text; - if t = getCurrentItemText() then return ; + if t = getCurrentItemText() then return feditischanging:=false; for i,v in items do begin if t = v then @@ -6060,7 +6210,10 @@ end type tcustomgroupbox=class(TCustomControl) function create(owner);override; begin + ftwidth := 7; + ftheight := 15; inherited; + Parentcolor := false; Left := 10; Top := 10; Width := 185; @@ -6072,23 +6225,18 @@ type tcustomgroupbox=class(TCustomControl) function Paint();override; begin c := caption; - if Parent and ParentFont then - begin - ft := Parent.Font; - end else - ft := Font; - wf := ft.width; - hf := ft.height+2; + wf := ftwidth; + hf := ftheight+2; cvs := Canvas; - cvs.font := ft; - cvs.pen.color := 11184810;//rgb(170,170,170); + cvs.font := Font; + cvs.pen.color := rgb(210,210,210);//rgb(170,170,170); cvs.pen.width := 1; cwd := 0; if c then begin cwd := wf * length(c)+1; end - rc := ClientRect; + rc := class(TWinControl).GetClientRect(); hf2 := integer(hf/2); /////////////////////////////////////// cvs.moveto(array(3,hf2)); @@ -6122,6 +6270,25 @@ type tcustomgroupbox=class(TCustomControl) drawdesigninggrid(); ///////////////////////////////// end + function FontChanged(o);override; + begin + inherited; + ft := Font; + ftwidth := ft.Width; + ftheight := ft.Height; + doControlALign(); + end + function GetClientRect();override; + begin + r := inherited; + r[0]+=4; + r[1]+=ftheight+4; + r[2]-=4; + r[3]-=4; + if r[2]5 then ItemHeight := FBKItemHeight; - end + changeitemheight(); inherited; end function CreateTreeNode();virtual; @@ -1764,15 +1819,33 @@ type TcustomTreeCtl = class(ttreelistwnd) //fnodecreator := nil; inherited; end + procedure FontChanged(Sender:TObject);override; + begin + //if parent then parent.FontChanged(Sender); + changeitemheight(); + inherited; + end + function ncpaint(rec);override; + begin + dc := Canvas; + ls := array((0,0),(rec[2]-rec[0]-1,0),(rec[2]-rec[0]-1,rec[3]-rec[1]-1),(0,rec[3]-rec[1]-1),(0,0)); + dc.pen.color := rgb(171,173,179); + dc.draw("polyline",ls); + end published //属性 property CurrentNode read FCurrentNode write setcurrentnode; //20221118 加上写 + property selectionColor:color read FselectionColor write SetselectionColor; property CheckBox:bool read FCheckBox write SetCheckBox; property HasLine:bool read FHasLine write SetHasLine; + property LineColor:color read Flinecolor write Setlinecolor; + property Linestyle:linestyle read fLinestyle write Setlinestyle; property OnlyLeafNodeCheckMark read FOnlyLeafNodeCheckMark write FOnlyLeafNodeCheckMark; //property NodeHierarchyWidth read FNodeHierarchyWidth write SetNodeHierarchyWidth; property RootNode read GetRootNode; //property MulSelected read FMulSelected write FMulSelected; property SingleExpand read FSingleExpand write FSingleExpand; + property expandsigntype:tvexpandsigntype read fexpandsigntype write setexpandsigntype; + property expandsigncolor:color read fexpandsigncolor write setexpandsigncolor; property OnSelChanged:eventhandler read FOnSelChanged write FOnSelChanged; property OnSelChanging:eventhandler read FOnSelChanging write FOnSelChanging; property onEmptyNodeExapanding read FonEmptyNodeExapanding write FonEmptyNodeExapanding; @@ -1787,8 +1860,14 @@ type TcustomTreeCtl = class(ttreelistwnd) //echo FRootItem.Owner,"\r\n"; return FRootItem; end + private //成员变量 fcountlocker; //锁定changed回调 + fexpandsigntype; + fexpandsigncolor; + flinecolor; + fLinestyle; + FselectionColor; weakref fnodecreator; FOnlyLeafNodeCheckMark; @@ -1801,12 +1880,66 @@ type TcustomTreeCtl = class(ttreelistwnd) FMulSelected; FMulSelects; FSingleExpand; - FBKItemHeight; FRootItem; FCheckBox; FHasLine; FPaintArray; private //成员方法 + + function SetselectionColor(v); + begin + if not ifnumber(v) then return ; + vn := int(v); + if (vn<>FselectionColor) then + begin + FselectionColor := nv; + InvalidateRect(nil,false); + end + end + function Setlinestyle(v); + begin + if (v<>fLinestyle) and (v in array(0,1,2,3,4,5,6)) then + begin + fLinestyle := v; + InvalidateRect(nil,false); + end + end + function Setlinecolor(v); + begin + if not ifnumber(v) then return ; + vn := int(v); + if vn=flinecolor then return ; + flinecolor := vn; + InvalidateRect(nil,false); + end + function setexpandsigntype(v); + begin + if not(v in array(0,1,2,3)) then return ; + if v=fexpandsigntype then return ; + fexpandsigntype := v; + InvalidateRect(nil,false); + end + function setexpandsigncolor(v); + begin + if not ifnumber(v) then return ; + vn := int(v); + if vn=fexpandsigncolor then return ; + fexpandsigncolor := vn; + InvalidateRect(nil,false); + end + + function changeitemheight(); + begin + ft := font; + if not ft then return ; + if imageList is class(TCustomImageList)then + begin + ItemHeight := max(imageList.Height,ft.height) +2; + end else + begin + ItemHeight := max(5,ft.height) +2; + end + end function setcurrentnode(nd); begin setsel(nd); diff --git a/funcext/tvclib/uvcpropertytypespersistence.tsf b/funcext/tvclib/uvcpropertytypespersistence.tsf index 7f693ad..0c155fe 100644 --- a/funcext/tvclib/uvcpropertytypespersistence.tsf +++ b/funcext/tvclib/uvcpropertytypespersistence.tsf @@ -1902,6 +1902,87 @@ type TPropertyAlign=class(UniObjectMember) return new TAlign123(); end end +type TPropertybevelcut=class(UniObjectMember) + function EditType();override; + begin + return "tbevelcut"; + end + function Create(); + begin + inherited; + end + function CreateInfoOBJ();override; + begin + return new unit(utslvclconstant).tbevelcut(); + end +end +type TPropertybevelshape=class(UniObjectMember) + function EditType();override; + begin + return "tbevelshape"; + end + function Create(); + begin + inherited; + end + function CreateInfoOBJ();override; + begin + r := new unit(utslvclconstant).tbevelshape(); + return r; + end +end +type TPropertybevelstyle=class(UniObjectMember) + function EditType();override; + begin + return "tbevelstyle"; + end + function Create(); + begin + inherited; + end + function CreateInfoOBJ();override; + begin + return new unit(utslvclconstant).tbevelstyle(); + end +end +type TPropertylinestyle=class(UniObjectMember) + type tlinestyledata=class + static const PS_SOLID=0x0;static const PS_DASH=0x1;static const PS_DOT=0x2; + static const PS_DASHDOT=0x3;static const PS_DASHDOTDOT=0x4;static const PS_NULL=0x5; + end + function EditType();override; + begin + return "linestyle"; + end + function Create(); + begin + inherited; + end + function CreateInfoOBJ();override; + begin + return new tlinestyledata(); + end +end +type TPropertytvetype=class(UniObjectMember) + type tvetype=class + static const tvestTheme = 0; // use themed sign + static const tvestPlusMinus=1; // use +/- sign + static const tvestArrow=2; // use blank arrow + static const tvestArrowFill=3; // use filled arrow + end + function EditType();override; + begin + return "tvexpandsigntype"; + end + function Create(); + begin + inherited; + end + function CreateInfoOBJ();override; + begin + return new tvetype(); + end +end type TPropertyText=class(TPropertyString) function EditType();override; begin @@ -2401,6 +2482,11 @@ begin "tpropertyesalign", "tpropertymbbtnstyle", "tpropertymbicostyle", + "TPropertytvetype", + "TPropertylinestyle", + "TPropertybevelstyle", + "TPropertybevelshape", + "TPropertybevelcut", "tpropertycolorlist"); for i,v in types do begin diff --git a/funcext/tvclib/uwindowsinterface.tsf b/funcext/tvclib/uwindowsinterface.tsf index e7505e3..e9fc9a1 100644 --- a/funcext/tvclib/uwindowsinterface.tsf +++ b/funcext/tvclib/uwindowsinterface.tsf @@ -502,7 +502,7 @@ type twindowsapi = class() Function LoadIconA(hd:pointer;n:string):pointer;stdcall;external "User32.dll" name "LoadIconA"; Function LoadIconA2(hd:pointer;n:pointer):pointer;stdcall;external "User32.dll" name "LoadIconA"; Function DrawTextA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer):integer;stdcall;external "User32.dll" name "DrawTextA"; - Function DrawTextExA(hdc :pointer;txt:string;len:integer;rec:array of integer;fmt:integer;lpdtp:pointer):integer;stdcall;external "User32.dll" name "DrawTextExA"; + Function DrawTextExA(hdc :pointer;txt:string;len:integer;var rec:array of integer;fmt:integer;lpdtp:pointer):integer;stdcall;external "User32.dll" name "DrawTextExA"; Function DrawFrameControl(DC:pointer; LPRECT: array of integer ; dr1 :integer;dr2:integer):integer;stdcall;external "User32.dll" name "DrawFrameControl"; function DrawEdge(hdc:pointer;var qrc:array of integer;edge:integer;grfFlags:integer):integer;;stdcall;external "User32.dll" name "DrawEdge"; function DrawFocusRect(hDC:pointer; var rect:array of integer):integer;stdcall;external "User32.dll" name "DrawFocusRect"; @@ -574,7 +574,9 @@ type twindowsapi = class() { https://msdn.microsoft.com/query/dev14.query?appId=Dev14IDEF1&l=ZH-CN&k=k(WINGDI%2FGetTextMetrics);k(GetTextMetrics);k(DevLang-C%2B%2B);k(TargetOS-Windows)&rd=true } + Function GetTextMetricsA(hdc :pointer;TM:pointer):integer;stdcall;external "Gdi32.dll" name "GetTextMetricsA"; + Function GetCurrentPositionEx(hdc :pointer;var point:array of integer):integer;stdcall;external "Gdi32.dll" name "GetCurrentPositionEx" keepresident; Function MoveToEx(hdc :pointer;x:integer;y:integer;var point:array of integer):integer;stdcall;external "Gdi32.dll" name "MoveToEx" keepresident; Function LineTo(hdc :pointer;x:integer;y:integer):integer;stdcall;external "Gdi32.dll" name "LineTo" keepresident; Function TextOutA(hdc :pointer;X:integer;y:integer;txt:string;len:integer):integer;stdcall;external "Gdi32.dll" name "TextOutA"; @@ -631,15 +633,18 @@ type twindowsapi = class() function CreatePolygonRgn(ps:array of integer;len:integer;md:integer):pointer;stdcall;external "Gdi32.dll" name "CreatePolygonRgn"; function CombineRgn(hrgnDest:pointer;hrgnSrc1:pointer;hrgnSrc2:pointer; fnCombineMode:integer):integer;stdcall;external "Gdi32.dll" name "CombineRgn"; function SelectClipRgn(dc:pointer;rgn:pointer):integer;stdcall;external "Gdi32.dll" name "SelectClipRgn"; + function GetClipRgn(dc:pointer;var rgn:pointer):integer;stdcall;external "Gdi32.dll" name "GetClipRgn"; function PtVisible(dc:pointer;x:integer;y:integer):integer;stdcall;external "Gdi32.dll" name "PtVisible"; function RectVisible(dc:pointer;rect:array of integer):integer;stdcall;external "Gdi32.dll" name "RectVisible"; function ExcludeClipRect(hdc:pointer;nLeftRect:integer;nTopRect:integer;nRightRect:integer;nBottomRect:integer;):integer;stdcall;external "Gdi32.dll" name "ExcludeClipRect"; function SetWindowOrgEx(hdc:pointer;x:integer;y:integer;var lppt: array of integer):integer;stdcall;external "Gdi32.dll" name "SetWindowOrgEx"; function SetViewportOrg(dc:pointer;x:integer;y:integer):integer;stdcall;external "Gdi32.dll" name "SetViewportOrg"; function SetViewportOrgEx(dc:pointer;x:integer;y:integer;var pt:array of integer):integer;stdcall;external "Gdi32.dll" name "SetViewportOrgEx"; + function GetViewportOrgEx(dc:pointer;var pt:array of integer):integer;stdcall;external "Gdi32.dll" name "GetViewportOrgEx"; Function FillRgn(dc:pointer;rgn:pointer;br:pointer):integer;stdcall;external "Gdi32.dll" name "FillRgn"; Function SetTextAlign(dc:pointer;fMode:integer):integer;stdcall;external "Gdi32.dll" name "SetTextAlign"; Function SetWorldTransform(dc:pointer;lpXform:pointer):integer;stdcall;external "Gdi32.dll" name "SetWorldTransform"; + Function GetWorldTransform(dc:pointer;lpXform:pointer):integer;stdcall;external "Gdi32.dll" name "GetWorldTransform"; Function SetGraphicsMode(dc:pointer;iMode:integer):integer;stdcall;external "Gdi32.dll" name "SetGraphicsMode"; Function GetGraphicsMode(dc:pointer):integer;stdcall;external "Gdi32.dll" name "GetGraphicsMode"; Function SetMapMode(dc:pointer;iMode:integer):integer;stdcall;external "Gdi32.dll" name "SetMapMode"; @@ -733,11 +738,7 @@ begin if not g_windows_proc_handle then begin g_windows_proc_handle := makeinstance(thisfunction(tslvclproc)); - end - try - SetProcessDpiAwareness(2); //shez dpi感知 - except - end + end end function uninit();//卸载 begin @@ -748,7 +749,6 @@ begin g_windows_proc_handle := nil; end end -function SetProcessDpiAwareness(v:integer):pointer;stdcall; external "Shcore.dll" name "SetProcessDpiAwareness"; initialization init(); finalization diff --git a/tsleditor.exe b/tsleditor.exe index 0bd063d..b50b639 100644 Binary files a/tsleditor.exe and b/tsleditor.exe differ diff --git a/tslvcltool.exe b/tslvcltool.exe index 750d47c..1195889 100644 Binary files a/tslvcltool.exe and b/tslvcltool.exe differ