diff --git a/designer/tslvcldesigner.tsf b/designer/tslvcldesigner.tsf index fbd21a8..dd85b2b 100644 --- a/designer/tslvcldesigner.tsf +++ b/designer/tslvcldesigner.tsf @@ -885,9 +885,9 @@ type TVclDesigner = class(tvcform) end mx := 0; for i,v in clc do mx := max(mx,v); - height := (integer(mx*32/twidth)+1)*32+60+30; + height := (integer(mx*32/twidth)+1)*32+60+30+24; end else - height := 90+32; + height := 90+32+24; end function TreeNode2tfmsub(lib,node,itemnames);//tmf文件字符串 @@ -1147,21 +1147,18 @@ type TVclDesigner = class(tvcform) ("type":"menu","caption":"新建工程","onclick":thisfunction(CreateTpjFomFile), "bitmap":getcreateprojectbmpinfo()), ("type":"menu","caption":"打开历史","onclick":thisfunction(OpenProjectFromtpj), - "bitmap":GetHostroyBimp()) - , - ("type":"menu","caption":"打包到","onclick":thisfunction(WrapProjectTo), - "bitmap":getwrapprojectbmpinfo() - ) + "bitmap":GetHostroyBimp()), + //("type":"menu","caption":"打包到","onclick":thisfunction(WrapProjectTo),"bitmap":getwrapprojectbmpinfo()) ) ), ("type":"menu","caption":"运行","items":( ("type":"menu","caption":"配置命令行","onclick":thisfunction(editcommandline)), - ("type":"menu","caption":"运行","onclick":thisfunction(RunProject),"filed":"FRounMenu", - "bitmap":getrunbmpinfo() - ), - ("type":"menu","caption":"停止","onclick":thisfunction(StopProject),"enabled":false,"filed":"FStopMenu", - "bitmap":getstopbmpinfo()), - ("type":"menu","caption":"调试运行","onclick":thisfunction(debugproject)), + {$ifdef linux} + ("type":"menu","caption":"运行","onclick":thisfunction(RunProject),"filed":"FRounMenu","bitmap":getrunbmpinfo()), + ("type":"menu","caption":"停止","onclick":thisfunction(StopProject),"enabled":false,"filed":"FStopMenu","bitmap":getstopbmpinfo()), + {$else} + ("type":"menu","caption":"运行","bitmap":getrunbmpinfo(),"onclick":thisfunction( debugproject)), //之前的调试运行 + {$endif} )), ("type":"menu","caption":"工具","items":( @@ -1850,9 +1847,46 @@ type TVclDesigner = class(tvcform) FImageList := new TDesigImageList(self); FTree.Imagelist := FImageList; //******************toolbar *************** + {fdebugtoolbar := new TToolBar(self); + btns := FProjectManager.FTslEditer.getdbugtoolbtns(); + idx := 0; + for i,v in btns do + begin + if idx = 0 then fdebugtoolbar.ImageList := v.parent.ImageList; + idx++; + if v.caption = "添加/删除断点F5" then continue; + v.parent := fdebugtoolbar; + v._tag := v.onclick; + + v.onclick := function(o,e)begin + cp := o.caption; + CallMessgeFunction(o._tag,o,e); + if cp<>"终止" then + begin + FProjectManager.ShowEditor(); + end + end; + end } + tlbar := FProjectManager.FTslEditer.gettoolbar(); + savebtn := array( tlbar.getbtnbyindex(1),tlbar.getbtnbyindex(2)); + for i,v in savebtn do //处理一下保存工程 + begin + v._tag := array(thisfunction(saveCurrentForm),v.onclick); + v.onclick := function(o,e) + begin + for i,v in o._tag do + begin + CallDataFunction(v,o,e); + end + end + end + tlbar.parent := self; FToolBars := new TDesignertoolbars(self); FToolBars.parent := self; FToolBars.Imagelist := FImageList; + FToolBars.Font.width := 9; + FToolBars.Font.height := 18; + addtoolbuttons(); //************菜单****************************** createmainmenubyarray(mainmenus(),FMenu0,self); @@ -1861,6 +1895,10 @@ type TVclDesigner = class(tvcform) ic := new Ticon(); ic.Readvcon(HexFormatStrToTsl(GetTsIconBitmapInfo())); self.FormICon := ic; + {fdebugtoolbar.Align := alnone; + fdebugtoolbar.left := FToolBars.Flabelcharlen* 10; + fdebugtoolbar.top := 0; + fdebugtoolbar.parent := FToolBars;} //文件打窗口 @@ -7307,16 +7345,19 @@ type TDesignertoolbars = class(TPageControl) FToolbars; FLabels ; fimg; + function SetImageList(im); begin fimg := im; end public + Flabelcharlen; function Create(AOwner);override; begin inherited; align := alClient; FToolbars := array(); + Flabelcharlen := 0; end Procedure Notification(AComponent,Operation);virtual; begin @@ -7362,13 +7403,13 @@ type TDesignertoolbars = class(TPageControl) begin st := new TTabSheet(self); st.caption := t; - tb := new ttoolbar(self); tb.align := alClient; if t<>"非点击添加控件" then begin st.parent := self; tb.parent := st; + Flabelcharlen+= length(t)+2; end tb.imagelist := fimg; FToolbars[t] := tb; diff --git a/designer/udesignerproject.tsf b/designer/udesignerproject.tsf index fd23ba9..ca1ad87 100644 --- a/designer/udesignerproject.tsf +++ b/designer/udesignerproject.tsf @@ -1469,7 +1469,7 @@ type TProjectView = class(TVCForm) // FOpenBtn; FInput; FScriptHandle; - FTslEditer; + FTmfParser; FTslParser; FTreeTool; @@ -1487,6 +1487,8 @@ type TProjectView = class(TVCForm) // FAddMenuTsf; FAddMenuTsl; FOpenMenu; + public + FTslEditer; end type TTslEditer = class(TEditer) diff --git a/designer/utslcodeeditor.tsf b/designer/utslcodeeditor.tsf index 3ed4f68..d6c0163 100644 --- a/designer/utslcodeeditor.tsf +++ b/designer/utslcodeeditor.tsf @@ -1748,21 +1748,29 @@ type TEditer=class(TCustomcontrol) // dbgbtns := array(); for i,v in imgs do begin - bmp.Readvcon(HexFormatStrToTsl(v)); - FImages.addbmp(bmp); bt := new TToolButton(self); FToolbtns[i]:= bt; - bt.OnClick := thisfunction(ToolClick); - bt.Caption := i; - bt.imageid := id; - id++; + if v=0 then + begin + bt.stylesep := true; + end else + begin + bmp.Readvcon(HexFormatStrToTsl(v)); + FImages.addbmp(bmp); + bt.OnClick := thisfunction(ToolClick); + bt.Caption := i; + bt.imageid := id; + id++; + end BT.parent := FToolbar; if i in array("添加/删除断点F5","暂停","继续","进入","跳出","单步","下一行(F8)","终止","刷新符号表","刷新当前符号")then begin dbgbtns[i]:= bt; end end + FImages.DrawBimpFirst := true; + Fdbgbtns := dbgbtns; FTslDebug.addbtns(dbgbtns); FToolbar.ImageList := FImages; FInfoShowWnd.Visible := false; @@ -2111,6 +2119,14 @@ type TEditer=class(TCustomcontrol) // begin return FFindWnd.GetHistory(); end + function getdbugtoolbtns(); + begin + return Fdbgbtns; + end + function gettoolbar(); + begin + return FToolbar; + end function ShowLogWnd(flg); begin n :=(ifnil(flg)or flg)?true:false; @@ -2598,13 +2614,14 @@ type TEditer=class(TCustomcontrol) // begin if filenameIsTheSame(v,vi)then begin - fcadd := false; + //fcadd := false; + FOpenHistory.Splice(i,1); //删除原来的记录 break; end end if fcadd then begin - FOpenHistory.Push(v); + FOpenHistory.push(v); if FOpenHistory.Length()>30 then FOpenHistory.shift(); end end @@ -2651,7 +2668,8 @@ type TEditer=class(TCustomcontrol) // end if FOpenHistory.Length()>0 then begin - FHistoryWnd.SetData(FOpenHistory.Data); + d := FOpenHistory.Data; + FHistoryWnd.SetData(d); InitShowWndPos(FHistoryWnd,"history",100,100); FHistoryWnd.ShowModal(); end @@ -2924,15 +2942,24 @@ type TEditer=class(TCustomcontrol) // if not(FPageEditer and FPageEditer.parent=self)then return; rr := ClientRect; r := rr; + if FToolbar.Parent = self then + begin + htoolbar := true; + end + if htoolbar then + begin th := FToolbar.CalcHeightFixWidth(rr[2]-rr[0]); - //FToolbar.Height := th; r[3]:= r[0]+th; FToolBar.SetBoundsRect(r); + end r := rr; r[1]:= r[3]-FStatus.Height; FStatus.SetBoundsRect(r); rr := rr; + if htoolbar then + begin rr[1]:= FToolbar.Height+1; + end rr[3]:= rr[3]-FStatus.Height-1; {if ffolderdlg and ffolderdlg.Visible then begin @@ -2946,7 +2973,7 @@ type TEditer=class(TCustomcontrol) // begin r := rr; - r[1]:= r[3]-min(FInfoShowWnd.Height,integer(r[3] * 0.6)); + r[1]:= r[3]-min(FInfoShowWnd.Height,integer(r[3] * 0.8)); //0.6 靠扩大到 0.8 rr[3]:= r[1]-1; {fwd := min(FInfoShowWnd.Width,integer(r[2] * 0.6)); //右侧 @@ -3825,6 +3852,7 @@ type TEditer=class(TCustomcontrol) // if ifobj(c[0])and ifobj(c[1])then return array(CreateObject(c[0],ow),CreateObject(c[1],ow)); end end + Fdbgbtns; static FSynClasses; FCodeFormatInfo; FTslChmHelp; @@ -4979,7 +5007,7 @@ type TMouseMoveList=class(TListBox) function getItemText(i);override; begin r := inherited; - return " "+r; + return "["$ i $"]" $ r; end function PaintIdx(idx,rc_,cvs);virtual; begin @@ -5068,6 +5096,7 @@ B85C4055CF250DD2251015779AC1ABF4E121390D3FE5BFF436D9BA680DFE3B533 AE42608200"; r["快捷键说明"]:= getquickkeybitmapinfo(); r["代码地图(alt+m)"]:= gettslcodemapbitmapinfo(); + r["分隔符"] := 0; return r union dbugicos(); end function dbugicos(); diff --git a/designer/utslvcldebuger.tsf b/designer/utslvcldebuger.tsf index 618fa42..033bb0d 100644 --- a/designer/utslvcldebuger.tsf +++ b/designer/utslvcldebuger.tsf @@ -262,10 +262,12 @@ type tagCOMPOSITIONFORM=class(tslcstructureobj) end type TTslDebuga=class(TCustomControl) private //成员变量 + //Frundirect; FRuningfile; //执行脚本文件名 FRuningItem; //执行的pageitem FCurrentgotoitem; //当前运行到的pageitem - FDebughandle; //调试的句柄 + FDebughandle; //调试的句柄 + Fdebugedwhandle ;//调试的窗口 FDebugExe; //调试功能的exe FConnectchannel; //调试的 通道 FDebugaddr; //地址 @@ -577,7 +579,7 @@ type TTslDebuga=class(TCustomControl) getdebuger(pms); exestr := format('"%s" "%s" -DEBUGSERVER -DEBUGLOGIN 0 -WAITATTACH -DEBUGPORT %d -libpath "%s" ',FDebugExe,FRuningfile,FDebugport,dirs); exestr += pms; - FDebughandle := sysexec(FDebugExe,exestr,nil,0,rcode,0); + FDebughandle := sysexec(FDebugExe,exestr,nil,0,rcode,0); if FDebughandle then begin ExecuteCommand("dbgcreatechannel"); @@ -617,6 +619,7 @@ type TTslDebuga=class(TCustomControl) function Create(AOwner); begin inherited; + //Frundirect := false; FCmdHistory := array(); FCmdHistoryid := 0; FCmdHistorycount := 10; @@ -678,6 +681,26 @@ type TTslDebuga=class(TCustomControl) dbgunsetbreak(FConnectchannel,usr,n,idx+1); end end + function GetWindowHandleByPID(dwProcessID,api) //通过进程ID获取窗口句柄 + begin + h := api.GetTopWindow(0); + while(h) do + begin + pid := 0; + dwTheardId := api.GetWindowThreadProcessId(h,pid); + if(dwTheardId <> 0)then + begin + if(pid=dwProcessID)then + begin + // here h is the handle to the window + while(api.GetParent(h)<> 0) do h := api.GetParent(h); + return h; + end + end + h := api.GetNextWindow(h,2); + end + return 0; + end function Dbgtooldo(o,e) begin cp := o.Caption; @@ -699,6 +722,10 @@ type TTslDebuga=class(TCustomControl) "暂停": begin ExecuteCommand("dbgpause"); + if Fdebugedwhandle then + begin + _Wapi.postmessagea(Fdebugedwhandle,WM_NULL,0,0); + end end "进入": begin @@ -721,6 +748,15 @@ type TTslDebuga=class(TCustomControl) toolbtnState("继续"); if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil); ExecuteCommand("dbgrun"); + {$ifdef linux} + {$else} + if not Fdebugedwhandle then + Fdebugedwhandle := GetWindowHandleByPID(_wapi.GetProcessId(FDebughandle),_wapi); + if Fdebugedwhandle then + begin + _wapi.SetForegroundWindow(Fdebugedwhandle); + end + {$endif} end "终止": begin @@ -757,7 +793,7 @@ type TTslDebuga=class(TCustomControl) FConnectchannel := 0; g_tsldbgcallback_handle := nil; if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil); - FDebughandle := 0; + FDebughandle := 0;Fdebugedwhandle := 0; toolbtnState("停止"); return; end @@ -841,6 +877,7 @@ type TTslDebuga=class(TCustomControl) FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",stk[0,"LINE"]-1); end end + //_wapi.SetForegroundWindow(self.Handle); //移动到前端 SetForegroundWindow BringWindowToTop return; end "detached": @@ -1116,6 +1153,7 @@ type TTslDebuga=class(TCustomControl) g_tsldbgcallback_handle := nil; fdbgselwnd := nil; end + //property rundirect read Frundirect write Frundirect; private function getdefaultdbger(); begin @@ -1403,7 +1441,7 @@ type TTslDebuga=class(TCustomControl) if FDebughandle then begin SysTerminate(-1,FDebughandle); - FDebughandle := 0; + FDebughandle := 0; Fdebugedwhandle := 0; end end function parseriteminfo(item,idx,n,usr); diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index beba936..c467e18 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/funcext/tvclib/tslvcl.tsf @@ -892,6 +892,11 @@ type TPanel=class(TScrollingWinControl) // p.cstyle := CS_HREDRAW .| CS_VREDRAW .| CS_OWNDC .| CS_DBLCLKS; //p.exstyle := 0x101; end + function paint();override; + begin + inherited; + drawdesigninggrid(); + end function publishs();override; begin return array("name","align","anchors","caption","enabled","cursor","font", @@ -1280,10 +1285,11 @@ type TVCForm = class(TScrollingWinControl) if cd is class(TComponent)then return Controls.indexof(cd)<0; return true; end - function paint();override; + function Paint();override; begin inherited; - end + drawdesigninggrid(); + end function WMSYSCOMMAND(o,e):WM_SYSCOMMAND;override; begin {** @@ -1503,6 +1509,11 @@ type TpanelForm=class(tpanel) FWidth := wd; wspopup := true; end + function Paint();override; + begin + inherited; + drawdesigninggrid(); + end function SetDesigning(f,fc);override; begin if f then wspopup := true; @@ -1522,6 +1533,7 @@ type TDCreatePanel=class(TpanelForm) inherited; Loader.LoadFromTfm(self(true)); end + end //按钮 @@ -2139,8 +2151,8 @@ type tmemo = class(TSynMemoNorm) function publishs();override; begin return array("name","font", - "popupmenu","visible", - "height","width","anchors","left","top", + "popupmenu","visible","anchors","align", + "height","width","left","top", "text","readonly", "tabspace","onmousewheel","onmousemove","onpopupmenu", "onmousedown","onmouseup", @@ -3526,7 +3538,7 @@ type TTabSheet = class(TCustomControl) public function paint();override; begin - + drawdesigninggrid(); end function DesigningMove();override; begin @@ -4163,6 +4175,11 @@ type TPairSplitterSide=class(TCustomControl) begin return false; end + function paint();override; + begin + inherited; + drawdesigninggrid(); + end function DesigningSizer();override; begin return false; diff --git a/funcext/tvclib/twincontrol.tsf b/funcext/tvclib/twincontrol.tsf index b4a6adf..7e799da 100644 --- a/funcext/tvclib/twincontrol.tsf +++ b/funcext/tvclib/twincontrol.tsf @@ -1830,6 +1830,30 @@ end if HandleAllocated()then ControlCreateWnd(); end protected + function drawdesigninggrid(); + begin + if csDesigning in ComponentState then + begin + cv := canvas; + if not(cv.HandleAllocated()) then return ; + rc := ClientRect; + dx := 20; + dy := 20; + x := 0; + y := 0; + c := 0; + while yrect[0]and rect[3]>rect[1])then return r; if not HandleAllocated()then return r; if not FHDC then FHDC := _wapi.CreateCompatibleDC(0); if not FHDC then return r; - bthandle := _wapi.CreateCompatibleBitmap(FSHDC2,w,h); + bthandle := _wapi.CreateCompatibleBitmap(_wapi.GetDC(0),w,h); 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); @@ -2679,6 +2683,9 @@ type TcustomCanvas = class(TSLUIBASE) @explan(说明)文本旋转%% @param(trans)(array) array(cos,-sin,sin,cos,x,y)%% **} + {$ifdef linux} + return r; + {$endif} _xformobj._setvalue_("em11",trans[0]); _xformobj._setvalue_("em12",trans[1]); _xformobj._setvalue_("em21",trans[2]); @@ -2996,6 +3003,22 @@ begin cv.handle := cv._wapi.CreateCompatibleDC(0); return cv; end +function getdrawablebitmap(w,h,bmp); +begin + {$ifdef linux} + return 0; + {$endif} + if w>1 and h>1 then + begin + cv := static GetOneCanvas(); + api := cv._wapi; + bmp := new TcustomBitmap(); + bhd :=api.CreateCompatibleBitmap(api.GetDC(0),w,h); + bmp.handle := bhd; + api.SelectObject(cv.handle,bhd); + return cv; + end +end initialization sinitgidplus(); class(tcustomimage).sinit(); diff --git a/funcext/tvclib/utslvclstdctl.tsf b/funcext/tvclib/utslvclstdctl.tsf index b65ed63..e8432b4 100644 --- a/funcext/tvclib/utslvclstdctl.tsf +++ b/funcext/tvclib/utslvclstdctl.tsf @@ -2569,9 +2569,9 @@ type TcustomListBox=class(TCustomListBoxbase) end function MouseUp(o,e);override; begin - if FIsMouseDown then + if FIsMouseDown then //已经按下过 begin - _wapi.clipcursor(ps); + _wapi.clipcursor(ps); //解锁光标 FIsMouseDown := false; selchange := 0; case FMultisel of @@ -3552,6 +3552,7 @@ type TcustomToolButton=class(tcomponent) FImageId :=-1; //imageid FEnabled := true; //有效 可以点击 FVisible := true; //可见 + FStylesep := false; end function ExecuteCommand(cmd,d);override; begin @@ -3598,7 +3599,7 @@ type TcustomToolButton=class(tcomponent) end function publishs();override; begin - return array("name","caption","enabled","imageid","visible","onclick","popupmenu"); + return array("name","caption","enabled","stylesep","imageid","visible","onclick","popupmenu"); end function Recycling();override; begin @@ -3631,6 +3632,7 @@ type TcustomToolButton=class(tcomponent) property Action:taction read GetAction write SetAction; property ShortCut read getShortCut write SetShortCut; property PopupMenu:tpopupmenu read FPopupMenu write FPopupMenu; + property stylesep:bool read FStylesep write setstylesep; {** @param(OnClick)(function[o:TToolButton;e:tuieventbase]) 点击消息 %% @param(Caption)(string) 标题 %% @@ -3639,7 +3641,17 @@ type TcustomToolButton=class(tcomponent) @param(Visible)(bool) 是否可见 %% **} private + FStylesep; FShortCut; + function setstylesep(v); + begin + nv := v?true:false; + if nv<>FStylesep then + begin + FStylesep := nv; + if FToolbar then FToolbar.BtnChanged(); + end + end function getShortCut(); begin return formatshortcut(FShortCut); @@ -3913,6 +3925,10 @@ type TcustomToolBar=class(TCustomControl) **} InsertButton(btn); end + function getbtnbyindex(idx); + begin + return FButtons[idx]; + end function SetBtnIndex(btn,idx); begin {** @@ -4018,6 +4034,50 @@ type TcustomToolBar=class(TCustomControl) **} EndUpdate(); end + + function Paint();override; + begin + c := canvas; + for i := 0 to FButtons.length()-1 do + begin + bi := FButtons[i]; + if not(bi.Visible)then continue; + ci := FBtnRects[i]; + if not ifarray(ci)then return; + if FMouseDownIdx=i then + begin + c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONCHECK); + end else + c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONPUSH); + igslist := ImageList; + if igslist is class(TCustomImageList)then + begin + igid := bi.ImageId; + if igid >= 0 and igid0)?(integer(nt)+1):(nt)) * (imgw+1)+bw; return(integer(bct/rct)+1) * (imgw+1)+bw; end - function Paint();override; - begin - c := canvas; - for i := 0 to FButtons.length()-1 do - begin - bi := FButtons[i]; - if not(bi.Visible)then continue; - ci := FBtnRects[i]; - if not ifarray(ci)then return; - if FMouseDownIdx=i then - begin - c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONCHECK); - end else - c.draw("framecontrol",array(ci[0:1],ci[2:3]),DFC_BUTTON,DFCS_BUTTONPUSH); - igslist := ImageList; - if igslist is class(TCustomImageList)then - begin - igid := bi.ImageId; - if igid >= 0 and igid