编辑器

自定义颜色

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;

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 

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;

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;

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 
+        begin              
-             d.FFcolor := 0x8B008B;
+             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,";.`~!@#$%^&*-+,><?/|:") then 
+            if (tkl=1) and pos(ottk,";.`~!@#$%^&*-+,><?/|:=") then 
             begin
-            
+                if hightercolor then d.FFcolor := hightercolor.symcolor() ;
             end else 
             if lwttk="end" then 
             begin 
@@ -441,7 +548,9 @@ type TTslSynHighLighter = class(TSynHighLighter)
             end else
             if StrIsANumber(ottk) then 
             begin
-                 d.FFcolor := 0x666666;
+                if hightercolor then d.FFcolor := hightercolor.numcolor() ;
+                else 
+                    d.FFcolor := 0x666666;
             end else 
             if tp = array("(") then 
             begin
@@ -451,7 +560,6 @@ type TTslSynHighLighter = class(TSynHighLighter)
             begin
                 D.FMate := FCMBState.GetSate();
             end else 
-
             if fpairbegin[lwttk] then 
             begin 
                 FCBEState.GetLeft();
@@ -1276,6 +1384,24 @@ type ttfmhighlighter = class(tcustomsynhighlighter)
 end 
 
 implementation
+type tcolor = class()
+    function create(c);
+    begin
+        fcolor := c;
+    end
+    changed;
+    property color read fcolor write setcolor;
+    private
+    function setcolor(cl);
+    begin
+        if (cl>=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.

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;

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

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);//»ñµÃ¹â±êλÖÃ

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;