编辑器

优化细节

designer/utslcodeeditor.tsf

@@ -168,7 +168,7 @@ type TPage=class(TCustomControl) //
                     dc.Brush.Color := 0xFa901E;
                 end else
                 begin
-                    dc.Brush.Color := 0xe4eeee;
+                    dc.Brush.Color := 0xe4eeee;//rgb(228,228,228);//
                 end
                 dc.draw("roundrect",array(rc[0:1],rc[2:3],array(5,5)));
                 ny := integer(rc[1]+(rc[3]-rc[1]-16)/2);
@@ -1615,6 +1615,34 @@ type TPageEditer=class(TPage) //
         FMenu := nil;
         FPageItemOnRClick := nil;
     end
+    function DoMouseWheel(o,e);override;
+    begin
+        IF ssCtrl in e.shiftstate then
+        begin
+            fw := font.Width;
+            if e.delta<0 then
+            begin
+                if fw>8 then
+                begin
+                    finfo := array("width":fw-1,"height":font.height-2);                    
+                end
+            end else
+            begin
+                if fw<15 then
+                begin
+                    finfo := array("width":fw+1,"height":font.height+2);
+                end
+            end
+            if finfo then 
+            begin 
+                font := finfo;
+                callMessgeFunction(onscrollfont,o,finfo);
+                InValidateRect(nil,false);
+            end 
+            return;
+        end
+    end
+    [weakref] onscrollfont;
     function DoControlAlign();override;
     begin
         inherited;
@@ -1696,6 +1724,10 @@ type TEditer=class(TCustomcontrol) //
         fcoolbar.autosize := true;
         FInfoShowWnd := new TEditerAuxiliary(self);
         FPageEditer := new TPageEditer(self);
+        FPageEditer.onscrollfont := function(o,ft)begin
+        
+            FinCodemap.FTree.font := ft;
+        end 
         //FPageEditer.CloseBtn := true;  
         FPageEditer.Onbmpbclick := function(o,e)
         begin
@@ -4078,6 +4110,7 @@ type TEditer=class(TCustomcontrol) //
         end
     end
     public
+    static Fhightercolor;
     FExecuteEditer;
     private
     function sethclor(cs);
@@ -4107,7 +4140,6 @@ type TEditer=class(TCustomcontrol) //
         end
     end
     Fdbgbtns;
-    static Fhightercolor;
     fhltediterdata;
     static FSynClasses;
     fhltediter;
@@ -4392,6 +4424,9 @@ type thighlightercoloredter=class(tvcform)
     btn2:tbtn;
     colorcombobox2:tcolorcombobox;
     btn3:tbtn;
+    btn4:tbtn;
+    btn5:tbtn;
+    openfileadlg1:topenfileadlg;
     function Create(AOwner);override; //构造
     begin	
         fcolorindexname := array("字体","关键字","符号","注释","字符串","数字","系统函数","选中背景","当前行背景");
@@ -4410,6 +4445,26 @@ type thighlightercoloredter=class(tvcform)
     begin     
         EndModal(0);
     end
+    function import_clk(o;e);virtual;
+    begin
+        if openfileadlg1.OpenDlg() then 
+        begin
+            importfile(ftstream(),"",openfileadlg1.filename,d);
+            if d and ifarray(d) then 
+            begin
+                colorinfo := d;
+                listbox1.InvalidateRect(nil,false); 
+            end 
+        end 
+    end 
+    function export_clk(o;e);virtual;
+    begin
+        d := colorinfo;
+        if openfileadlg1.OpenDlg() then 
+        begin
+            exportfile(ftstream(),"",openfileadlg1.filename,d);
+        end         
+    end 
     function btn3_clk(o;e);virtual;
     begin
         ffrontcolors := ffrontcolordefault;	
@@ -4656,7 +4711,7 @@ begin
    end
    object btn1:tbtn
       caption="取消"
-      height=31
+      height=25
       left=187
       onclick=btn1_clk
       top=311
@@ -4664,7 +4719,7 @@ begin
    end
    object btn2:tbtn
       caption="确定"
-      height=31
+      height=25
       left=269
       onclick=btn2_clk
       top=312
@@ -4680,12 +4735,39 @@ begin
    end
    object btn3:tbtn
       caption="还原默认"
-      height=31
+      height=25
       left=103
       onclick=btn3_clk
       top=310
       width=72
    end
+   object btn4:tbtn
+      caption="µ¼Èë"
+      height=25
+      left=3
+      onclick=import_clk;
+      top=310
+      width=30
+   end
+   object btn5:tbtn
+      caption="µ¼³ö"
+      height=25
+      left=35
+      onclick=export_clk;
+      top=310
+      width=30
+   end
+   object openfileadlg1:topenfileadlg
+      left=314
+      top=36
+      height=30
+      width=30
+      caption="openfileadlg1"
+      filter=<
+         stm="*.stm"
+         "ËùÓÐ"="*"
+      >
+   end
 end%%;
 
 end 
@@ -4946,6 +5028,9 @@ type tfincodemap = class(tcustomcontrol)
         begin
             ontimerdo();
             FTree.SetFocus();
+            hg := owner.Fhightercolor;
+            FTree.Color := hg.bkcolor().Color;
+            FTree.font.Color := hg.fontcolor().Color;
         end else 
         begin
             et := geteditor();
@@ -5164,7 +5249,7 @@ EA5E0BB7C5850E4063EDA83420076B5E10000000049454E44AE42608200";
     fisloading;
     ffbtn;
     FTempNodes; //节点
-    FTree;
+    
     fcbtn;
     FList;
     flistv;
@@ -5173,6 +5258,8 @@ EA5E0BB7C5850E4063EDA83420076B5E10000000049454E44AE42608200";
     FString;   
     fcaretya; //开始位置记录
     fcaretyb; //截止位置记录
+    public 
+    FTree;
 end 
 (*
 type TTslCodeMap=class(TTreeView) //tsl代码地图

funcext/tvclib/utslmemo.tsf

@@ -4257,21 +4257,29 @@ type TSynMemoNorm = class(TsynCustomMemo) //
         IF ssCtrl in e.shiftstate then
         begin
             fw := font.Width;
+            flg := false;
             if e.delta<0 then
             begin
                 if fw>8 then
                 begin
-                    font := array("width":fw-2,"height":font.height-4);
+                    flg := true;
+                    font := array("width":fw-1,"height":font.height-2);
                 end
             end else
             begin
                 if fw<18 then
                 begin
-                    font := array("width":fw+2,"height":font.height+4);
+                    flg := true;
+                    font := array("width":fw+1,"height":font.height+2);
                 end
             end
+            if flg then 
+            begin 
                 ReCreateCaret();
+            end 
+            e.skip := true;
             return;
+            
         end
         inherited;
     end

funcext/tvclib/utslvclcef.tsf

@@ -613,7 +613,7 @@ type cef_contain_base = class(tslcstructureobj)
                 ("base","user",getbasestruct()));
     end 
     protected
-    [weakref]FTSLCallbacks;
+    FTSLCallbacks;
     function getbasecalss();virtual;
     begin
         return class(cef_base_ref_counted_t);
@@ -3119,7 +3119,80 @@ type cef_request_handler_t=class(cef_contain_base)
         end    
     end 
 end
+type cef_command_line_t=class(cef_contain_base)
+    private
+    function structdescribe();override;
+    begin
+        return  array(
+                ("base","user",getbasestruct()),
+                ("is_valid","intptr",0),
+                ("is_read_only","intptr",0),
+                ("copy","intptr",0),
+                ("init_from_argv","intptr",0),
+                ("init_from_string","intptr",0),
+                ("reset","intptr",0),
+                ("get_argv","intptr",0),
+                ("get_command_line_string","intptr",0),
+                ("get_program","intptr",0),
+                ("set_program","intptr",0),
+                ("has_switches","intptr",0),
+                ("has_switch","intptr",0),
+                ("get_switch_value","intptr",0),
+                ("get_switches","intptr",0),
+                ("append_switch","intptr",0),
+                ("append_switch_with_value","intptr",0),
+                ("has_arguments","intptr",0),
+                ("get_arguments","intptr",0),
+                ("append_argument","intptr",0),
+                ("prepend_wrapper","intptr",0)
                 
+                );
+    end
+    public
+    function create(ptr)
+    begin
+        inherited ;
+    end
+    ///
+    /// Method executed for visiting the DOM. The document object passed to this
+    /// function represents a snapshot of the DOM at the time this function is
+    /// executed. DOM objects are only valid for the scope of this function. Do
+    /// not keep references to or attempt to access any DOM objects outside the
+    /// scope of this function.
+    function  get_program();
+    begin
+        ptr := _getvalue_(functionname());
+        f := function(sf:pointer):pointer;stdcall; external ptr;
+        s := new cef_string_userfree_t(##f(_getptr_()));
+        return s.str;
+    end 
+    function set_program(exe);
+    begin
+        if not (exe and  ifstring(exe)) then return 0;
+        ptr := _getvalue_(functionname());
+        f := procedure(sf:pointer;exe:pointer);stdcall; external ptr;
+        u := new cef_string_t();
+        u.str := exe;
+        ##f(_getptr_(),u._getptr_());
+    end 
+    function append_argument(s);
+    begin
+        if not( s and ifstring(s)) then return 0;
+        ptr := _getvalue_(functionname());
+        f := procedure(sf:pointer;argument:pointer);stdcall; external ptr;
+        u := new cef_string_t();
+        u.str := s;
+        ##f(_getptr_(),u._getptr_());
+    end 
+    function get_arguments();
+    begin
+        ptr := _getvalue_(functionname());
+        f := procedure(sf:pointer;arguments:pointer);stdcall; external ptr;
+        u := new cef_string_list_t();
+        ##f(_getptr_(),u._getptr_());
+        return u.get_values();
+    end 
+end
 type cef_app_t=class(cef_contain_base)    
     private
     function structdescribe();override;
@@ -3142,7 +3215,19 @@ type cef_app_t=class(cef_contain_base)
     begin
         inherited;
     end
-//    property on_before_command_line_processing index "on_before_command_line_processing" read _getvalue_ write _setvalue_;
+    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
+        echo "\r\non_before_command_line_processing_i";
+        c := getcallback(functionname());
+        if c then 
+        begin
+            return call(c,self(true),
+                        (new cef_string_t(process)).str,
+                        new cef_command_line_t(cmd)                       
+                        );
+        end 
+    end 
 //    property on_register_custom_schemes index "on_register_custom_schemes" read _getvalue_ write _setvalue_;
 //    property get_resource_bundle_handler index "get_resource_bundle_handler" read _getvalue_ write _setvalue_;
 //    property get_browser_process_handler index "get_browser_process_handler" read _getvalue_ write _setvalue_;
@@ -3333,7 +3418,7 @@ type cef_browser_settings_t=class(cef_contain_base)
                 ("minimum_logical_font_size","int",0),
                 ("default_encoding","user",getcefstr16struct()),
                 ("remote_fonts","int",0),
-                ("javascript","int",0),
+                ("javascript","int",1),//0
                 ("javascript_close_windows","int",0),
                 ("javascript_access_clipboard","int",0),
                 ("javascript_dom_paste","int",0),
@@ -3386,7 +3471,7 @@ type cef_browser_settings_t=class(cef_contain_base)
     property webgl index "webgl" read _getvalue_ write _setvalue_;
     property background_color index "background_color" read _getvalue_ write _setvalue_;
     property accept_language_list index "accept_language_list" read _getvalue_ write _setvalue_;
-    //property chrome_status_bubble index "chrome_status_bubble" read _getvalue_ write _setvalue_;
+    property chrome_status_bubble index "chrome_status_bubble" read _getvalue_ write _setvalue_;
 end
 type cef_client_t=class(cef_contain_base)
     private
@@ -3554,7 +3639,6 @@ type cef_client_t=class(cef_contain_base)
     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
-        echo ">>>>>>>>>>>>>><<<<<<<<\r\n";
         c := getcallback(functionname());
         if c then 
         begin
@@ -3738,6 +3822,15 @@ type cef_request_context_t=class(cef_contain_base)
     //property did_load_extension index "did_load_extension" read _getvalue_ write _setvalue_;
     //property has_extension index "has_extension" read _getvalue_ write _setvalue_;
     //property get_extensions index "get_extensions" read _getvalue_ write _setvalue_;
+    function get_extensions();
+    begin
+        ptr := (_getvalue_(functionname()));
+        echo "\r\nget_extensions:";
+        f := function(sf:pointer;ats:pointer):pointer;stdcall;external ptr; 
+        ats := new cef_string_list_t();
+        r :=  ##f(_getptr_(),ats._getptr_());
+        return ats.get_values();
+    end 
     //property get_extension index "get_extension" read _getvalue_ write _setvalue_;
     //property get_media_router index "get_media_router" read _getvalue_ write _setvalue_;
 end
@@ -3760,9 +3853,10 @@ type cef_domvisitor_t=class(cef_contain_base)
     /// executed. DOM objects are only valid for the scope of this function. Do
     /// not keep references to or attempt to access any DOM objects outside the
     /// scope of this function.
-    property  visit read getcallpropertybyindex write setcallpropertybyindex; 
+    property  visit index "visit" read getcallpropertybyindex write setcallpropertybyindex; 
     procedure visit_i(sf:pointer;dom:pointer);stdcall;
     begin
+        echo "\r\ninvisit=====";
         c := getcallback(functionname());
         if c then 
         begin
@@ -4664,6 +4758,17 @@ type cef_domdocument_t=class(cef_contain_base)
             return (new cef_string_userfree_t(r)).str;
         end 
     end 
+    function get_complete_url();
+    begin
+        ptr := _getvalue_(functionname());
+        f:= function(s:pointer):pointer;stdcall; external ptr;
+        r :=  ##f(_getptr_());
+        if r then
+        begin
+            return (new cef_string_userfree_t(r)).str;
+        end 
+    end 
+    
 end 
 type cef_frame_t=class(cef_contain_base)
     private
@@ -4712,7 +4817,7 @@ type cef_frame_t=class(cef_contain_base)
     //property undo index "undo" read _getvalue_ write _setvalue_;
     function undo();
     begin
-        ptr := _getvalue_("undo");
+        ptr := _getvalue_(functionname());
         if ptr then 
         begin 
             f:= procedure(s:pointer);stdcall; external ptr;
@@ -4722,35 +4827,36 @@ type cef_frame_t=class(cef_contain_base)
     //property redo index "redo" read _getvalue_ write _setvalue_;
     function redo();
     begin
-        ptr := _getvalue_("redo");
+        ptr := _getvalue_(functionname());
         f:= procedure(s:pointer);stdcall; external ptr;
         ##f(_getptr_()); 
     end
     //property cut index "cut" read _getvalue_ write _setvalue_;
     function cut();
     begin
-        ptr := _getvalue_("cut");
+        ptr := _getvalue_(functionname());
         f:= procedure(s:pointer);stdcall; external ptr;
         ##f(_getptr_());
     end
     //property copy index "copy" read _getvalue_ write _setvalue_;
     function copy();
     begin
-        ptr := _getvalue_("copy");
+        ptr := _getvalue_(functionname());
         f:= procedure(s:pointer);stdcall; external ptr;
         ##f(_getptr_());
     end
     //property paste index "paste" read _getvalue_ write _setvalue_;
     function paste();
     begin
-        ptr := _getvalue_("paste");
+        ptr := _getvalue_(functionname());
         f:= procedure(s:pointer);stdcall; external ptr;
         ##f(_getptr_());
     end
+    /// Execute delete in this frame.
     //property del index "del" read _getvalue_ write _setvalue_;
     function del();
     begin
-        ptr := _getvalue_("del");
+        ptr := _getvalue_(functionname());
         if ptr then 
         begin 
             f:= procedure(s:pointer);stdcall; external ptr;
@@ -4760,7 +4866,7 @@ type cef_frame_t=class(cef_contain_base)
     //property select_all index "select_all" read _getvalue_ write _setvalue_;
     function select_all();
     begin
-        ptr := _getvalue_("select_all");
+        ptr := _getvalue_(functionname());
         if ptr then 
         begin 
             f:= procedure(s:pointer);stdcall; external ptr;
@@ -4781,7 +4887,7 @@ type cef_frame_t=class(cef_contain_base)
     function get_source(visit);
     begin
         if not (visit is class(cef_string_visitor_t)) then return 0;
-        ptr := _getvalue_("get_source");
+        ptr := _getvalue_(functionname());
         f:= procedure(s:pointer;vt:pointer);stdcall; external ptr;
         ##f(_getptr_(),visit._getptr_());
         return 1;
@@ -4809,6 +4915,19 @@ type cef_frame_t=class(cef_contain_base)
         end      
     end 
     //property execute_java_script index "execute_java_script" read _getvalue_ write _setvalue_;
+    function execute_java_script(code,url,start_line);
+    begin
+        if ifstring(url) and ifstring(code) and (start_line>=0)  then 
+        begin 
+            ptr := _getvalue_(functionname());
+            f:= procedure(s:pointer;c:pointer;u:pointer;sl:integer);stdcall; external ptr;
+            u := new cef_string_t();
+            u.str := url;
+            c := new cef_string_t();
+            c.str := code;
+            ##f(_getptr_(),c._getptr_(),u._getptr_(),start_line);    
+        end      
+    end 
     //property is_main index "is_main" read _getvalue_ write _setvalue_;    
     function is_main();
     begin
@@ -4879,7 +4998,21 @@ type cef_frame_t=class(cef_contain_base)
         return ##f(_getptr_());   
     end 
     //property get_v8context index "get_v8context" read _getvalue_ write _setvalue_;
+    function get_v8context();
+    begin
+        ptr := _getvalue_(functionname());
+        f:= function(s:pointer):pointer;stdcall; external ptr;
+        r :=  ##f(_getptr_()); 
+        return r;
+    end 
     //property visit_dom index "visit_dom" read _getvalue_ write _setvalue_;
+    function visit_dom(visit);
+    begin
+        if not(visit is class(cef_domvisitor_t)) then return 0;
+        ptr := _getvalue_(functionname());
+        f:=  procedure(s:pointer;visitor:pointer);stdcall; external ptr;
+        return ##f(_getptr_(),visit._getptr_());   
+    end 
     //property create_urlrequest index "create_urlrequest" read _getvalue_ write _setvalue_;
     //property send_process_message index "send_process_message" read _getvalue_ write _setvalue_;
 end