diff --git a/designer/tediterform.tsf b/designer/tediterform.tsf index f0cd7ed..acf2a18 100644 --- a/designer/tediterform.tsf +++ b/designer/tediterform.tsf @@ -51,6 +51,7 @@ type TEditerForm = class(TVCform) // FCodeblockPath := basepath+"editer"+sp+"BlockManager.tsm"; FFindhistroypath := basepath+"editer"+sp+"findhistory.tsm"; FFormatpath := basepath+"editer"+sp+"tslformat.tsm"; + Fhighlightpath := basepath+"editer"+sp+"highlight.tsm"; Fremotepath := basepath+"editer"+sp; CreateDirWithFileName(basepath+"editer"+sp+"1.txt"); CreateDirWithFileName(basepath+"editer"+sp+"cmpCaches"+sp+"1.txt"); @@ -206,6 +207,8 @@ type TEditerForm = class(TVCform) // tbwidth := d; end FMTabContain :=new TMenu(self); + fmshowhltediter :=new TMenu(self); + fmshowhltediter.caption := "编辑器颜色"; FMTabs := array(); FMTabContain.Caption := "tab设置:"; for i:= 0 to 6 do @@ -220,6 +223,10 @@ type TEditerForm = class(TVCform) // tm.Parent := FMTabContain; end FMTabContain.parent := FMenuSet; + fmshowhltediter.Parent := FMenuSet; + fmshowhltediter.OnClick := function(o,e)begin + FEdter.showhltcolor(); + end mainmenu := m; FmTool.parent := m; FEnCodeMenu.parent := m; @@ -360,6 +367,11 @@ type TEditerForm = class(TVCform) // begin FEdter.SetFindHistroy(fds); end + if 1 = importfile(ftstream(),"",Fhighlightpath,fds) then + begin + FEdter.hltcolor := fds; + end + end if 1=Importfile(ftstream(),"",FexefileCmds,cmds) then begin @@ -562,6 +574,11 @@ type TEditerForm = class(TVCform) // begin Exportfile(ftstream(),"",FFindhistroypath,d); end + d := FEdter.hltcolor; + if ifarray(d) and d then + begin + Exportfile(ftstream(),"",Fhighlightpath,d); + end global g_dotsavehistory; if g_dotsavehistory then return ; d := FEdter.GetAllPagesInfo(); @@ -1480,6 +1497,7 @@ end FFindhistroypath; FFormatpath; Fremotepath; + Fhighlightpath; FEdter; FSearchDir; FCache; diff --git a/designer/tslvcldesigner.tsf b/designer/tslvcldesigner.tsf index 46444ac..c79da8f 100644 --- a/designer/tslvcldesigner.tsf +++ b/designer/tslvcldesigner.tsf @@ -495,7 +495,8 @@ type TVclDesigner = class(tvcform) )), ("type":"menu","caption":"工具","items":( - ("type":"menu","caption":"打开图片","checked":0,"onclick":thisfunction(ViewBitmap)) + ("type":"menu","caption":"打开图片","checked":0,"onclick":thisfunction(ViewBitmap)), + ("type":"menu","caption":"编辑器颜色","checked":0,"onclick":thisfunction(showhltcolor)) )), ("type":"menu","caption":"帮助","items":( ("type":"menu","caption":"使用手册","onclick":thisfunction(OpenHelp), @@ -1353,6 +1354,10 @@ type TVclDesigner = class(tvcform) end property VariableSelecter read FVariableSelecter; //当前控件树的变量对象 private //其他资源函数 + function showhltcolor(); + begin + FProjectManager.showhltcolor(); + end function ViewBitmap(o,e); begin if not FViewBitmap then diff --git a/designer/udesignerproject.tsf b/designer/udesignerproject.tsf index 0f30350..14339b7 100644 --- a/designer/udesignerproject.tsf +++ b/designer/udesignerproject.tsf @@ -199,6 +199,7 @@ type TProjectView = class(TVCForm) // FFilter; FFilterList; FFilterNodes; + Fhighlightpath; function ShowFilterList(d); begin if not FFilterList.visible then @@ -336,10 +337,15 @@ type TProjectView = class(TVCForm) // {$endif} FTslEditer.TslCacheDir := bpath+"designer"+fio+"cmpCaches"; FCodeblockPath := bpath+"editer"+fio+"BlockManager.tsm"; + Fhighlightpath := bpath+"editer"+fio+"highlight.tsm"; if 1=importfile(ftstream(),"",FCodeblockPath,blockd)and blockd and ifarray(blockd)then begin class(TTSLCompletion).FCodeBlocks := blockd; end + if importfile(ftstream(),"",Fhighlightpath,wdtd)=1 and ifarray(wdtd)then + begin + FTslEditer.hltcolor := wdtd; + end if importfile(ftstream(),"",bpath+"editer"+fio+"tabwidpath.tsm",wdtd)=1 and(wdtd>0)then begin FTslEditer.TabWidth := wdtd; @@ -1362,6 +1368,10 @@ end end FTslEditer.ShowExeEditer(); end + function showhltcolor(); + begin + FTslEditer.showhltcolor(); + end function RunProject(); //运行工程 begin if not FMainForm then @@ -1541,12 +1551,20 @@ end end function Recycling();override; begin + if Fhighlightpath then + begin + d := FTslEditer.hltcolor; + end inherited; FMoveMnus := nil; FMoveMenu := nil; FOpenMenu := nil; fnewmenu := nil; fgoformmenu := nil; + if d then + begin + exportfile(ftstream(),"",Fhighlightpath,d); + end end private FMoveMnus; diff --git a/designer/utslcodeeditor.tsf b/designer/utslcodeeditor.tsf index c264717..7d928ae 100644 --- a/designer/utslcodeeditor.tsf +++ b/designer/utslcodeeditor.tsf @@ -1629,6 +1629,9 @@ type TEditer=class(TCustomcontrol) // function Create(AOwner);override; begin inherited; + if not Fhightercolor then + Fhightercolor := new thighlitcolor(self); + FOpenHistory := new TMyarrayb(); FFistShows := array(); FSynHCS := New TMyArrayA(); @@ -2596,6 +2599,7 @@ type TEditer=class(TCustomcontrol) // it.FEditer.Parent := FPageEditer; it.FEditer.TabChar := FTabChar; it.FEditer.PageItem := it; + it.FEditer.hgcolor := Fhightercolor; it.FEditer.QuckKeys := Thisfunction(EditerQuckKeys); it.FEditer.OnTextSetFocus := function(o,e) begin @@ -3484,6 +3488,22 @@ type TEditer=class(TCustomcontrol) // end published //property 位置 FHistoryDir; + property hltcolor read gethclor write sethclor; + function showhltcolor(); + begin + if not fhltediter then + begin + fhltediter := new thighlightercoloredter(self); + fhltediter.Parent := self; + fhltediter.left := left+200; + fhltediter.top := top+200; + fhltediter.colorinfo := fhltediterdata; + end + if fhltediter.ShowModal() then + begin + Fhightercolor.colors := fhltediter.colorinfo; + end + end property OnPageEditerChanged read FOnPageEditerChanged write FOnPageEditerChanged; property OnPageItemSelChanged read FOnPageItemSelChanged write FOnPageItemSelChanged; property TslSearchDir read FTslSearchDir write SetTslSearchDir; @@ -3884,17 +3904,37 @@ type TEditer=class(TCustomcontrol) // public FExecuteEditer; private + function sethclor(cs); + begin + Fhightercolor.colors := cs; + fhltediterdata := cs; + end + function gethclor(); + begin + if fhltediter then return fhltediter.colorinfo; + end class function CreateASynObject(n,ow); begin c := FSynClasses[n]; //if not c then c := FSynClasses["txt"]; if c then begin - if ifobj(c[0])and ifobj(c[1])then return array(CreateObject(c[0],ow),CreateObject(c[1],ow)); + if ifobj(c[0])and ifobj(c[1])then + begin + h := CreateObject(c[0],ow);//Fhightercolor; + if n="tsl" then + begin + h.hightercolor := Fhightercolor; + end + return array(h,CreateObject(c[1],ow)); + end end end Fdbgbtns; + static Fhightercolor; + fhltediterdata; static FSynClasses; + fhltediter; FCodeFormatInfo; FTslChmHelp; FFistShows; @@ -4149,6 +4189,303 @@ AE40CC0000000049454E44AE42608200";//GetSaveFileBitmapInfo(); end end implementation +type thighlightercoloredter=class(tvcform) + uses tslvcl; + colorcombobox1:tcolorcombobox; + listbox1:tlistbox; + btn1:tbtn; + btn2:tbtn; + colorcombobox2:tcolorcombobox; + btn3:tbtn; + function Create(AOwner);override; //构造 + begin + fcolorindexname := array("字体","关键字","符号","注释","字符串","数字","系统函数"); + ffrontcolordefault := array(0,0x0000ff,0,0x228B22,0x8B008B,0x666666,0xcd0000); + fbkcolordefalut := zeros(7)+0xfafafa; + ffrontcolors := ffrontcolordefault; + fbkcols := fbkcolordefalut; + inherited; + Visible := false; + loader.LoadFromTfmScript(self,getscript()); + listbox1.Items := fcolorindexname; + listbox1.ItemIndex := 1; + listbox1.SelBkColor := listbox1.Color; + end + function edtcolormain1_close(o;e);virtual; + begin + EndModal(0); + end + function btn3_clk(o;e);virtual; + begin + ffrontcolors := ffrontcolordefault; + fbkcols := fbkcolordefalut; + listbox1_sel(listbox1,new tuieventbase(0,0,0,0)); + listbox1.InvalidateRect(nil,false); + end + function colorcombobox2_onselchanged(o;e);virtual; + begin + if flistboxchanging then return ; + idx := listbox1.ItemIndex; + if idx >=0 then + begin + cl := colorcombobox2.getcurrentColor(); + fbkcols[idx] := cl; + listbox1.InvalidateRect(nil,false); + end + end + + function btn1_clk(o;e);virtual; + begin + EndModal(0); + end + function btn2_clk(o;e);virtual; + begin + EndModal(1); + end + function colorcombobox1_onselchanged(o;e);virtual; + begin + if flistboxchanging then return ; + idx := listbox1.ItemIndex; + if idx >=0 then + begin + cl := colorcombobox1.getcurrentColor(); + ffrontcolors[idx] := cl; + listbox1.InvalidateRect(nil,false); + end + end + function listbox1_sel(o;e);virtual; + begin + {** + @explan(说明) item选择改变回调 %% + @param(o)(listbox) 列表控件 %% + @param(e)(tuieventbase) 消息对象 %% + **} + flistboxchanging := true; + if not(colorcombobox1 and colorcombobox2) then return flistboxchanging := false; + cl := colorcombobox1.getcurrentColor(); + id := listbox1.ItemIndex; + cc := ffrontcolors[id]; + stnil := true; + if cl<>cc then + begin + for i,v in ccols() do + begin + if i=0 then continue; + if v = cc then + begin + colorcombobox1.ItemIndex := i; + stnil := 0; + break; + end + end + end + if stnil then + begin + if ifnil(cc) then + begin + colorcombobox1.ItemIndex := 1; + end else + begin + colorcombobox1.customcolor := cc; + colorcombobox1.ItemIndex := 0; + end + end + cl := colorcombobox2.getcurrentColor(); + cc := fbkcols[id]; + stnil := true; + if cl<>cc then + begin + for i,v in ccols() do + begin + if i=0 then continue; + if v = cc then + begin + colorcombobox2.ItemIndex := i; + stnil := 0; + break; + end + end + end + if stnil then + begin + if ifnil(cc) then + begin + colorcombobox2.ItemIndex := 1; + end else + begin + colorcombobox2.customcolor := cc; + colorcombobox2.ItemIndex := 0; + end + end + flistboxchanging := false; + end + + function listbox1_draw(o;e);virtual; + begin + {** + @explan(说明) 自绘制 %% + @param(o)(listbox) 列表控件 %% + @param(e)(tlistdrawevent) 消息对象 %% + **} + id := e.idx; + cvs := e.canvas; + rec := e.rec; + rec2 := rec; + //rec2[0]+=100; + sel := e.sel; + cl := fbkcols[id]; + if cl>=0 or cl<0 then + begin + cvs.brush.Color := cl; + cvs.fillrect(rec2); + end + ftcl := ffrontcolors[id]; + if ftcl>0 or ftcl<=0 then + begin + cvs.font.Color := ftcl; + end + cvs.drawtext( o.getItemText(id),rec); + if sel then + begin + cvs.Pen.Width := 1; + cvs.pen.Color := 0x808080; + //cvs.pen.style := PS_DOT; + rec[0]+=1; + rec[1]+=1; + rec[2]-=1; + rec[3]-=1; + cvs.moveto(rec[array(0,1)]); + cvs.LineTo(rec[array(2,1)]); + cvs.LineTo(rec[array(2,3)]); + cvs.LineTo(rec[array(0,3)]); + cvs.LineTo(rec[array(0,1)]); + end + end + + function DoControlAlign();override;//对齐子控件 + begin + //当窗口大小改变时,该函数会被调用, + //可以通过 clientrect 获取客户区大小,设置子控件的位置以及大小 + //如果自己处理了子控件的对齐,就可以去掉 inherited + inherited; + end + function Recycling();override; //回收变量 + begin + inherited; + ci := self.classinfo(); //将成员变量赋值为nil避免循环引用 + for i,v in ci["members"] do + begin + if v["static"] then continue; + invoke(self,v["name"],nil); + end + end + + property colorinfo read getcolorinof write setcolorinfo; + private + function getcolorinof(); + begin + r := array(); + for i,v in fcolorindexname do + begin + r[v,"font"] := ffrontcolors[i]; + r[v,"back"] := fbkcols[i]; + end + return r; + end + function setcolorinfo(cs); + begin + if not ifarray(cs) then return ; + for i,v in fcolorindexname do + begin + ffrontcolors[i] := ifnumber(cs[v,"font"])?(cs[v,"font"]):ffrontcolordefault[i]; + fbkcols[i] := ifnumber(cs[v,"back"])?(cs[v,"back"]):fbkcolordefalut[i]; + end + end + function ccols(); + begin + if fccboxcolors then return fccboxcolors; + fccboxcolors := array(); + for i := 0 to colorcombobox1.ItemCount-1 do + begin + fccboxcolors[i] := colorcombobox1.getColorValue(i); + end + return fccboxcolors; + end + fccboxcolors; + ffrontcolors; + fcolorindexname; + fbkcolordefalut; + ffrontcolordefault; + flistboxchanging; + fbkcols; +end +function getscript(); +begin + return %% object edtcolormain1:edtcolormain + caption="编辑器配色" + height=389 + left=549 + minmaxbox=false + onclose=edtcolormain1_close + top=292 + width=360 + wssizebox=false + object colorcombobox1:tcolorcombobox + color=0xC08000 + height=23 + itemindex=0 + left=10 + onselchanged=colorcombobox1_onselchanged + top=18 + width=132 + end + object listbox1:tlistbox + caption="listbox1" + height=252 + itemindex=0 + items=["" ] + left=10 + ondrawlist=listbox1_draw + onselchanged=listbox1_sel + ownerdraw=true + top=52 + width=323 + end + object btn1:tbtn + caption="取消" + height=31 + left=187 + onclick=btn1_clk + top=311 + width=65 + end + object btn2:tbtn + caption="确定" + height=31 + left=269 + onclick=btn2_clk + top=312 + width=58 + end + object colorcombobox2:tcolorcombobox + height=23 + itemindex=0 + left=154 + onselchanged=colorcombobox2_onselchanged + top=18 + width=177 + end + object btn3:tbtn + caption="还原默认" + height=31 + left=103 + onclick=btn3_clk + top=310 + width=72 + end +end%%; + +end type TEditList=class(TComboBox) function Create(AOwner);override; diff --git a/designer/utslsynmemo.tsf b/designer/utslsynmemo.tsf index b6b8055..d8beb78 100644 --- a/designer/utslsynmemo.tsf +++ b/designer/utslsynmemo.tsf @@ -4,6 +4,105 @@ interface @explan(说明) tsl语法编辑器库 **} uses utslvclauxiliary,UTslMemo; +type thighlitcolor = class(tcomponent) + function Create(AOwner); + begin + inherited; + intitcolors(); + end + function bkcolor(); //背景 + begin + return FColors["back"]; + end + function fontcolor();//字体颜色 + begin + return FColors["字体"]; + end + function keycolor();//关键字 + begin + return FColors["关键字"]; + end + function symcolor();//符号 + begin + return FColors["符号"]; + end + function commentcolor();//注释 + begin + return FColors["注释"]; + end + function strcolor(); //字符串 + begin + return FColors["字符串"]; + end + + function numcolor();//数字 + begin + return FColors["数字"]; + end + function sysfunccolor();//系统函数 + begin + return FColors["系统函数"]; + end + property colors write setcolors; + private + function intitcolors(cls); + begin + if not FColors then + begin + FColors := array(); + for i,v in + array("字体": + ("font":0,"back":16448250),"关键字": + ("font":255,"back":16448250),"符号": + ("font":0,"back":16448250),"注释": + ("font":2263842,"back":16448250),"字符串": + ("font":9109643,"back":16448250),"数字": + ("font":6710886,"back":16448250),"系统函数": + ("font":13434880,"back":16448250)) do + begin + if i="字体" then + begin + FColors["back"] := new tcolor(v["back"]); + end + FColors[i] := new tcolor(v["font"]); + end + end + end + function setcolors(cls); + begin + cgd := false; + for i,v in FColors do + begin + if i="back" then + begin + v.changed := false; + v.color := cls["字体"]["back"]; + if v.changed then + begin + cgd .|= 2; + end + end else + begin + v.changed := false; + v.color := cls[i]["font"]; + if v.changed then + begin + if i="字体" then + begin + cgd .|= 4; + end else + cgd .|= 1; + end + end + end + if cgd then + begin + p := Owner; + if p then p.Notification(self,array("value":cgd,"editer":1)); + end + end + FColors; +end type TTSLCompletion= class(TSynCompletion) {** @explan(说明) tsl提示自动完成类 @@ -235,6 +334,7 @@ type TTslSynHighLighter = class(TSynHighLighter) private fpairbegin; public + hightercolor; function Create(AOwner); begin inherited; @@ -408,31 +508,38 @@ type TTslSynHighLighter = class(TSynHighLighter) donext := true; //if tp in array("'",'"') then if tp='"' or tp="'" or (tp=array("%%")) then - begin - d.FFcolor := 0x8B008B; + begin + if hightercolor then d.FFcolor := hightercolor.strcolor() ; + else d.FFcolor := 0x8B008B; donext := false; end else if tp="//" or tp="{" or tp="(*" then //if tp in array("//","{","(*") then begin - d.FFcolor := 0x228B22; + if hightercolor then d.FFcolor := hightercolor.commentcolor() ; + else + d.FFcolor := 0x228B22; donext := false; end else if FKeyWords[lwttk] then begin - d.FFcolor := 0x0000FF; + if hightercolor then d.FFcolor := hightercolor.keycolor() ; + else + d.FFcolor := 0x0000FF; end else if FBinFunc[lwttk] then begin - d.FFcolor := 0xcd0000; + if hightercolor then d.FFcolor := hightercolor.sysfunccolor() ; + else + d.FFcolor := 0xcd0000; //d.FFfacename := "MS Mincho"; //d["vtype"] := "function"; donext := false; end if donext then begin - if (tkl=1) and pos(ottk,";.`~!@#$%^&*-+,>=0 or cl<0) and cl<>fcolor then + begin + fcolor := cl; + changed := true; + end + end + fcolor; +end type TBBState =class(tpairstate) //括号状态 function Create(t); begin @@ -1833,4 +1959,5 @@ type TTsfFileParser = class() // return 0; end end +initialization end. \ No newline at end of file diff --git a/designer/utslvcldebuger.tsf b/designer/utslvcldebuger.tsf index f98612a..1cfd548 100644 --- a/designer/utslvcldebuger.tsf +++ b/designer/utslvcldebuger.tsf @@ -13,6 +13,31 @@ type TTslDebug = class(TTslDebuga) end end type TFTSLScriptcustomMemo=class(TSYNmemoNorm) + private + fhgcolor; + function sethgcolor(hc); + begin + fhgcolor := hc; + if hc then + begin + setbkc(hc.bkcolor().color); + setfc(hc.fontcolor().color); + end + end + function setbkc(bc); + begin + if bc>0 then color := bc; + else color := 0xfefefe; + + end + function setfc(bc); + begin + if bc>=0 then font.color := bc; + else font.color := 0; + + end + public + property hgcolor read fhgcolor write sethgcolor; function Create(AOwner);override; begin inherited; @@ -194,6 +219,28 @@ type TFTSLScriptcustomMemo=class(TSYNmemoNorm) inherited; SetChangeFlag(true); end + function Notification(a,op);override; + begin + if ifarray(op) and op["editer"] and a = fhgcolor then + begin + if op["value"] .& 2 then + begin + setbkc(a.bkcolor().color); + end + if op["value"] .& 4 then + begin + setfc(a.fontcolor().color); + end + if op["value"] .& 1 then + begin + if Visible then + InvalidateRect(nil,false); + end + return ; + end + inherited; + + end function Recycling();override; begin FQuckKeys := nil; diff --git a/funcext/tvclib/tslvcl.tsf b/funcext/tvclib/tslvcl.tsf index 63226b3..d3bd721 100644 --- a/funcext/tvclib/tslvcl.tsf +++ b/funcext/tvclib/tslvcl.tsf @@ -1147,7 +1147,7 @@ type tbtn = class(tcustombtn) // function publishs();override; begin return array("name","action","left","top","width","height", - "align","anchors","caption","font","enabled","visible","bkbitmap","color","parentcolor","parentfont","tabstop", + "align","anchors","caption","font","enabled","visible","bkbitmap","color","parentcolor","parentfont","tabstop","wsdlgmodalframe", "onclick","onmousemove","onsetfocus","onkillfocus","onkeyup","onkeydown","onkeypress","onnotification"); end @@ -1917,7 +1917,8 @@ type TColorbox=class(TcustomListBox) "onselchanged","onnotification" ); end - property customcolor read fcustomcolor write setcustomcolor; + property customcolor:color read fcustomcolor write setcustomcolor; + private function setcustomcolor(cl); begin if fcustomcolor<>cl and (cl>=0 or cl<0) then @@ -1927,7 +1928,7 @@ type TColorbox=class(TcustomListBox) r["color"] := cl; FitemData.splice(0,1,r); p := parent ; - if p then p.Notification(self,"customcolorchanged"); + if p is TColorCombobox then p.Notification(self,"customcolorchanged"); end end fcustomcolor; @@ -2059,7 +2060,7 @@ type TColorCombobox=class(TCustomComboBoxbase) "readonly","itemindex", "onselchanged","ondropdown","oncloseup","onnotification"); end - property customcolor read getcustomcolor write setcustomcolor; + property customcolor:Color read getcustomcolor write setcustomcolor; private function getcustomcolor(); begin diff --git a/funcext/tvclib/utslmemo.tsf b/funcext/tvclib/utslmemo.tsf index c781e66..c6150f6 100644 --- a/funcext/tvclib/utslmemo.tsf +++ b/funcext/tvclib/utslmemo.tsf @@ -782,7 +782,7 @@ type TCustomMemo = class(TCustomScrollControl,TCustomMemoCmd) // cvs := Canvas; iy := 0; cvs.Font := font; - cvs.Font.Color := 1; + //cvs.Font.Color := 1; for i := nL1 to nL2 do begin r := rc;//rcDraw; @@ -3791,6 +3791,7 @@ type TSynCustomMemo = class(TCustomMemo) if not Highlighter then return inherited; cvs := canvas; bfontname := cvs.font.facename; + bfc := cvs.Font.color; Highlighter.InsureTokenParserd(LastLine); cw := GetXScrollDelta(); @@ -3847,6 +3848,8 @@ type TSynCustomMemo = class(TCustomMemo) break; end c := V.FFColor; + if ifobj(c) then c := c.color; + if ifnil(c) then c := bfc; fn := v.FFfacename; //bfontname := cvs.font.facename; cvs.Font.bkmode := TRANSPARENT; @@ -3861,7 +3864,7 @@ type TSynCustomMemo = class(TCustomMemo) begin cvs.Font.Color := c; end - else cvs.Font.Color := 0; + else cvs.Font.Color := bfc; if (selt and selt = lowercase(val))or(seltcj and seltcj=v.FMate) then begin @@ -3873,7 +3876,7 @@ type TSynCustomMemo = class(TCustomMemo) end end cvs.font.facename := bfontname; - cvs.Font.Color := 0; + cvs.Font.Color := bfc; cvs.Font.bkmode := TRANSPARENT; end function GetCaretPos(x,y);//获得光标位置 diff --git a/funcext/tvclib/utslvclstdctl.tsf b/funcext/tvclib/utslvclstdctl.tsf index c2f4349..aee9020 100644 --- a/funcext/tvclib/utslvclstdctl.tsf +++ b/funcext/tvclib/utslvclstdctl.tsf @@ -448,14 +448,30 @@ type tcustombtn = class(TCustomControl) // end function paint();override;//绘制 - begin + begin + dc := Canvas; + cr := ClientRect; + if true then //绘制边框 + begin + C := 0x090909; + dc.pen.Color := max(0,Color-c); + dc.pen.Width := 1; + rec := cr; + rec[2]-=1; + rec[3]-=1; + dc.moveto(rec[array(0,1)]); + dc.LineTo(rec[array(2,1)]); + dc.LineTo(rec[array(2,3)]); + dc.LineTo(rec[array(0,3)]); + dc.LineTo(rec[array(0,1)]); + end if Fbtnstate then begin PaintMouseDown(); end else if FBtnfocused then begin - paintfocus(self.Canvas,self.ClientRect); + paintfocus(dc,cr); end rec := GetBtntextRect(); if not ifarray(rec) then return ; @@ -487,9 +503,7 @@ type tcustombtn = class(TCustomControl) // df := DT_CENTER .| DT_VCENTER .| DT_SINGLELINE; end end ; - dc := Canvas; - c := caption; - + c := caption; if ifstring(c) and c then begin dc.font := font;