www.pudn.com > CADtool.rar > 通用对话框生成库.lsp, change:2009-12-20,size:18059b


;;;如果要使用本程序源码,请保留个人信息及声明,并公开修改后的源码 
;;;作者:梁伯全 
;;;QQ:32774362 
;;;2009年11月3日 
 
;;;---------------------------------------------------------------------------------------------- 
;;;检查输入的原始参数表是否使用了组件的别名,如果使用了,便把别名改成组件全名。无论是否已使用组件的别名,都返回可供后续程序使用的参数表。 
(defun listFormatInputList (listInput             /                     listComponentAlias    listFormatedInput     listMemberOfInput 
                            boolIsAlias           intDefinedAliasNumber k                     strInputComponentName strAlias 
                           ) 
;;;---------------------------------------------------------------------------------------------- 
;;;定义组件别名表,形式为  ( (  组件别名 组件原名) ) 
 (setq listComponentAlias '(("bt" "button") 
                            ("edit" "edit_box") 
                            ("edit12" "edit12_box") 
                            ("edit32" "edit32_box") 
                            ("listbox" "list_box") 
                            ("ComboBox" "popup_list") 
                            ("btRadio" "radio_button") 
                            ("tg" "toggle") 
                            ("btOK" "ok_only") 
                            ("btCancel" "cancel_button") 
                            ("btErrer" "errtile") 
                            ("btHelp" "help_button") 
                            ("btInfo" "info_button") 
                            ("btOC" "ok_cancel") 
                            ("btOCH" "ok_cancel_help") 
                            ("btOCHE" "ok_cancel_help_errtile") 
                            ("btOCHI" "ok_cancel_help_info") 
                            ("color17" "color_palette_1_7") 
                            ("color19" "color_palette_1_9") 
                            ("color09" "color_palette_0_9") 
                            ("color250255" "color_palette_250_255") 
                            ("stdColor" "std_rq_color") 
                           ) 
 ) 
;;;---------------------------------------------------------------------------------------------- 
 (setq listFormatedInput nil) 
 (foreach listMemberOfInput listInput 
  (setq k 0 
        boolIsAlias "No" 
  ) 
  (setq strInputComponentName (strcase (car listMemberOfInput) T)) 
  (setq intDefinedAliasNumber (length listComponentAlias)) 
  (while (and (< k intDefinedAliasNumber) (= boolIsAlias "No")) 
   (setq strAlias (strcase (car (nth k listComponentAlias)) T)) 
   (if (= strInputComponentName strAlias) 
    (progn (setq boolIsAlias "Yes") 
           (setq listFormatedInput (append listFormatedInput 
                                           (list (cons (cadr (nth k listComponentAlias)) 
                                                       (cdr listMemberOfInput) 
                                                 ) 
                                           ) 
                                   ) 
           ) 
    ) 
   ) 
   (setq k (1+ k)) 
  ) 
  (if (= boolIsAlias "No") 
   (setq listFormatedInput (append listFormatedInput 
                                   (list (cons (strcase (car listMemberOfInput) T) 
                                               (cdr listMemberOfInput) 
                                         ) 
                                   ) 
                           ) 
   ) 
  ) 
 ) 
 listFormatedInput 
) 
;;;---------------------------------------------------------------------------------------------- 
;;;把输入的参数表转换为字符串表 
(defun listInputToString (listInput                /                        listMemberOfInput        listCdrMemberOfInput 
                          listMemberOfComponentParameters                   listComponentParameters  listCadrMemberOfComponentParameters 
                          listResult               k                        j                        boolDefinementFound 
                          strTmp                   test1                    test2 
                         ) 
;;;---------------------------------------------------------------------------------------------- 
;;;组件定义参数表,形式为 ( ( 组件名列表) ( 对应参数名列表) ) 
;;; 无属性控件,生成dcl文件时,在组件名后添加" ; “即可;如为“end”,在dcl文件里加上"}"字符即可 
;;; 容器控件及带属性控件,需要在名前添加” : ",名后加 "{" 
 (setq listComponentParameters '((("容器控件" "dialog") 
                                  ("label"               "key"                 "value"               "initial_focus" 
                                   "height"              "width"               "children_alignment"  "children_fixed_height" 
                                   "children_fixed_width" 
                                  ) 
                                 ) 
                                 (("容器控件"          "boxed_column"      "boxed_row"         "boxed_radio_column" 
                                   "boxed_radio_row"   "column"            "row"               "radio_row"         "radio_column" 
                                   "concatenation"     "paragraph" 
                                  ) 
                                  ("label"               "key"                 "is_enabled"          "alignment" 
                                   "height"              "width"               "fixed_height"        "fixed_width" 
                                   "children_alignment"  "children_fixed_height"                     "children_fixed_width" 
                                  ) 
                                 ) 
                                 (("带属性控件" "button") 
                                  ("label"         "key"           "action"        "alignment"     "height"        "width" "horizontal_margin" 
                                   "vertical_margin" "fixed_height"  "fixed_width"   "is_cancel"     "is_default"    "is_enabled"    "is_tab_stop" 
                                   "mnemonic" 
                                  ) 
                                 ) 
                                 (("带属性控件" "edit_box" "edit12_box" "edit32_box" "fcf_ebox" "fcf_ebox1") 
                                  ("label"          "key"            "value"          "action"         "alignment"      "height" 
                                   "width"          "fixed_height"   "fixed_width"    "allow_accept"   "edit_limit"     "edit_width" 
                                   "is_enabled"     "is_tab_stop"    "mnemonic"       "password_char" 
                                  ) 
                                 ) 
                                 (("带属性控件" "image" "image_block" "icon_image") 
                                  ("key"           "value"         "action"        "alignment"     "height"        "width" 
                                   "fixed_height"  "fixed_width"   "is_enabled"    "is_tab_stop"   "mnemonic"      "aspect_ratio" 
                                   "color" 
                                  ) 
                                 ) 
                                 (("带属性控件" "image_button" "swatch" "fcf_ibut" "fcf_ibut1") 
                                  ("key"            "action"         "alignment"      "height"         "width"          "fixed_height" 
                                   "fixed_width"    "is_enabled"     "is_tab_stop"    "mnemonic"       "allow_accept"   "aspect_ratio" 
                                   "color" 
                                  ) 
                                 ) 
                                 (("带属性控件" "list_box") 
                                  ("label"          "key"            "value"          "action"         "alignment"      "height" 
                                   "width"          "fixed_height"   "fixed_width"    "allow_accept"   "fixed_width_font" 
                                   "is_enabled"     "is_tab_stop"    "list"           "mnemonic"       "multiple_select" 
                                   "tabs"           "tab_truncate" 
                                  ) 
                                 ) 
                                 (("带属性控件" "popup_list") 
                                  ("label"         "key"           "value"         "action"        "alignment"     "height" 
                                   "width"         "fixed_height"  "fixed_width"   "edit_width"    "fixed_width_font" 
                                   "is_enabled"    "is_tab_stop"   "list"          "mnemonic"      "tabs"          "tab_truncate" 
                                  ) 
                                 ) 
                                 (("带属性控件" "radio_button") 
                                  ("label"         "key"           "value"         "action"        "is_enabled"    "is_tab_stop" 
                                   "mnemonic"      "alignment"     "height"        "width"         "fixed_height"  "fixed_width" 
                                  ) 
                                 ) 
                                 (("带属性控件" "slider") 
                                  ("label"         "key"           "value"         "action"        "alignment"     "height" 
                                   "width"         "fixed_height"  "fixed_width"   "big_increment" "layout"        "max_value" 
                                   "min_value"     "mnemonic"      "small_increment" 
                                  ) 
                                 ) 
                                 (("带属性控件" "spacer") 
                                  ("value" "height" "width" "fixed_height" "fixed_width") 
                                 ) 
                                 (("带属性控件" "text" "text_part" "text_25") 
                                  ("label" "key" "value" "alignment" "height" "width" "fixed_height" "fixed_width" "is_bold") 
                                 ) 
                                 (("带属性控件" "toggle") 
                                  ("label" "key" "value" "action" "alignment" "height" "width" "fixed_height" "fixed_width" "is_enabled" 
                                   "is_tab_stop") 
                                 ) 
                                 (("无属性控件"           "cancel_button"        "errtile"              "help_button" 
                                   "info_button"          "ok_cancel"            "ok_cancel_help"       "ok_cancel_help_errtile" 
                                   "ok_cancel_help_info"  "ok_only"              "spacer"               "spacer_0" 
                                   "spacer_1"             "color_palette_1_7"    "color_palette_1_9"    "color_palette_0_9" 
                                   "color_palette_250_255"                       "std_rq_color" 
                                  ) 
                                 ) 
                                 (("无属性控件" "end")) ;以"end"作为单个组件定义的结束,生成dcl文件时,以“}“代替 
                                ) 
 ) 
;;;----------------------------------------------------------------------------------------------         
 (setq listResult nil) 
 (setvar "dimzin" 8) 
 (foreach listMemberOfInput listInput 
  (setq k 0 
        boolDefinementFound "NotYet" 
  ) 
  (while (and (= boolDefinementFound "NotYet") 
              (< k (length listComponentParameters)) 
         ) ;未找到组件参数名列表且未搜索完组件预定义列表时循环 
   (setq listMemberOfComponentParameters (nth k listComponentParameters)) 
   (if (and (member (car listMemberOfInput) 
                    (car listMemberOfComponentParameters) 
            ) 
            (if (= "spacer" (car listMemberOfInput)) 
             (>= (length listMemberOfInput) 
                 (length listMemberOfComponentParameters) 
             ) 
             T 
            ) ;因spacer既可为无属性控件也可为带属性控件,故特别处理 
       ) 
    (progn (setq boolDefinementFound  "Found" 
                 listCdrMemberOfInput (cdr listMemberOfInput) 
           ) 
           (cond ((or (= "容器控件" (car (car listMemberOfComponentParameters))) 
                      (= "带属性控件" (car (car listMemberOfComponentParameters))) 
                  ) 
                  listCdrMemberOfInput ;组件参数值有数据时 
                  (setq listResult (append listResult 
                                           (list (strcat ":" (car listMemberOfInput) "{\n")) 
                                   ) 
                  ) 
                  (setq j                                   0 
                        listCadrMemberOfComponentParameters (cadr listMemberOfComponentParameters) 
                  ) 
                  (while (< j (length listCdrMemberOfInput)) 
                   (if (not (= "" (nth j listCdrMemberOfInput))) 
                    (progn ;参数值非空时 
                     (if (numberp (nth j listCdrMemberOfInput)) 
                      (setq strTMP (strcat (nth j listCadrMemberOfComponentParameters) 
                                           "=" 
                                           (rtos (nth j listCdrMemberOfInput) 2 3) 
                                           ";\n" 
                                   ) 
                      ) ;参数为数值时 
                      (setq strTMP (strcat (nth j listCadrMemberOfComponentParameters) 
                                           "=\"" 
                                           (nth j listCdrMemberOfInput) 
                                           "\";\n" 
                                   ) 
                      ) ;参数非数值时 
                     ) 
                     (setq listResult (append listResult (list strTMP))) 
                    ) 
                   ) 
                   (setq j (1+ j)) 
                  ) 
                  (if (= "带属性控件" (car (car listMemberOfComponentParameters))) 
                   (setq listResult (append listResult (list "}\n"))) 
                  ) ;带属性控件时,在字符串末尾加上组件结束标志 "}" 
                 ) 
                 ((= (car listMemberOfInput) "end") 
                  (setq listResult (append listResult (list "}\n"))) 
                 ) 
                 (T ;(= "无属性控件" (car (car listMemberOfComponentParameters))) ,默认为无属性控件 
                  (setq listResult (append listResult 
                                           (list (strcat (car listMemberOfInput) ";\n")) 
                                   ) 
                  ) 
                 ) 
           ) 
    ) 
    (setq k (1+ k)) 
   ) 
  ) 
 ) 
 listResult 
) 
;;;---------------------------------------------------------------------------------------------- 
;;;生成并显示输入对话框 
;;;调用形式 ( listGenerateDCL  DCL文件名(无路径及后缀) 
;;;                 表( ( ( "组件名或别名")  ( 参数值表 )  )   ...) 
;;;                 表( (  "组件编号"  "组件初始值"  )   ...)    ;组件显示值初始化 
;;;                 表( (  "组件编号"  "动作代码"  )   ...)      ;需设置动作的组件及对应的动作 
;;;                 表("组件编号"  ...)   )    ;用户点“确定”键时,需获取输入值的组件名 
;;;注意,调用参数均为字符串形式 
;;;返回值为表,形式为 ( 关闭对话框的整数代码       指定组件返回值列表) 
(defun listGenerateDCL (strDCLFileName      listInputDefinements                    listKeysAndValues   listKeysAndActions 
                        listKeysToGetValue  /                   listFormatedInput   intDialogCloseType  listKeysValue 
                        listResult          fStream             strFileFullName     objectFile          fileStream 
                        templist            i                   dclid 
                       ) 
;;;---------------------------------------------------------------------------------------------- 
;;;按 ( ( “组件名”  “值"  ) ) 表,设置各组件的值 
 (defun SetDCLValues (listKeysAndValues / listEachKeyAndValue) 
  (foreach listEachKeyAndValue listKeysAndValues 
   (set_tile (car listEachKeyAndValue) 
             (cadr listEachKeyAndValue) 
   ) 
  ) 
 ) 
;;;---------------------------------------------------------------------------------------------- 
;;;按 ( ( “组件名”  “动作"  ) ) 表,把组件与动作关联 
 (defun SetDCLActions (listKeysAndActions / listEachKeyAndAction) 
  (foreach listEachKeyAndAction listKeysAndActions 
   (action_tile (car listEachKeyAndAction) 
                (cadr listEachKeyAndAction) 
   ) 
  ) 
 ) 
;;;---------------------------------------------------------------------------------------------- 
;;;按 ( “组件名” ) 表,查询各组件值并返回值表 
 (defun listGetDCLValues (listKeys / listEachKey listValues) 
  (setq listValues nil) 
  (foreach listEachKey listKeys 
   (setq listValues (append listValues (list (get_tile listEachKey)))) 
  ) 
  listValues 
 ) 
;;;----------------------------------------------------------------------------------------------                  
 (setq strFileFullName (vl-filename-mktemp (strcat strDCLFileName ".dcl"))) 
 (setq objectFile (open strFileFullName "w")) 
 (setq listFormatedInput (listFormatInputList listInputDefinements)) 
 (setq fileStream (append (list strDCLFileName) 
                          (listInputToString listFormatedInput) 
                  ) 
 ) 
 (foreach fStream fileStream (princ fStream objectFile)) 
 (close objectFile) 
 ;;以上生成dcl文件,以下调用DCL,设置组件值、关联动作,获取返回值 
 (setq listResult nil) 
 (setq dclid (load_dialog strFileFullName)) 
 (if (not (new_dialog strDCLFileName dclid "")) 
  (progn (alert "对话框加载失败!") (exit)) 
 ) 
 (if listKeysAndValues 
  (SetDCLValues listKeysAndValues) 
 ) 
 (if listKeysAndActions 
  (SetDCLActions listKeysAndActions) 
 ) 
 
 (if listKeysToGetValue 
  (action_tile "accept"  "(setq listKeysValue (listGetDCLValues listKeysToGetValue)) (done_dialog 1)" ) 
 ) 
 (setq intDialogCloseType (start_dialog)) 
 (unload_dialog dclid) 
 (vl-file-delete strFileFullName) 
 (setq listResult (append (list intDialogCloseType) listKeysValue)) 
 listResult 
) 
;;;----------------------------------------------------------------------------------------------