@lisp Editor dcl:cell

用法

建议

(defun dcl:cell (key rows columns show-line-number? show-column-number? show-scrollbar? header-title? / tbl-widths *error*)
  "创建 DCL 可编辑表格.\n参数: 1. key: 标识\n      2. rows:显示行数，\n      3. columns 显示列数(不大于26), \n      4. show-line-number? : 是否显示行号， \n      5. show-column-number?  : 是否显示列号A~Z，\n      6. show-scrollbar? : 是否显示竖向滚动条. \n      7. fixed-title? ,在第一行固定显示标题。\n\ntile-key: scrollbar header1 header2 headern, A1 B1 ... Z1 , A2 B2 ... Z2 , A99 B99 ... Z99 ......\nModel部: tbl-widths: 列宽表;cell-data 列表数据;\nControl部: (cb-scrollbar)"
  "DCL格式字符串"
  "(dcl:cell \"cell1\"
    10 8 t t t t)"
  (defun *error* (msg)
    (if (/= (quote file)
        (type dcl-fp))
      (alert "请先运行 (dcl:dialog  ...)"))
    (@:*error* msg))
  (defun dcl:get-celldata (key /)
    "返回cell 表格的结果，会参照原始表进行数据转换。"
    ""
    ""
    (set (read (strcat key "-data"))
      (mapcar (quote (lambda (x type1)
            (mapcar (quote (lambda (y ty)
                  (if (p:stringp y)
                    (@:to-type y (type ty))
                    y)))
              x type1)))
        (dcl:save-celldata key)
        lst-cellraw)))
  (defun dcl:save-celldata (key / lst-dcl per-page% curr-page% tmp-data% tmp-data-pre tmp-data-last)
    "保存 cell 表的结果到临时表 *key*tmp-data 中。未进行类型转换，查看过的均为字符串类型。"
    ""
    ""
    (setq per-page% (eval (read (strcat key "per-page")))
      curr-page% (eval (read (strcat key "curr-page")))
      tmp-data% (eval (read (strcat key "tmp-data"))))
    (setq lst-dcl nil r% 0)
    (repeat (min per-page% (- (length (cdr tmp-data%))
          (* curr-page% per-page%)))
      (setq c% 64)
      (setq r% (1+ r%))
      (setq lst-r% (quote nil))
      (repeat (length (car tmp-data%))
        (setq lst-r% (cons (vl-string-left-trim (chr 32)
              (get_tile (strcat key (chr (setq c% (1+ c%)))
                  (itoa r%))))
            lst-r%)))
      (setq lst-dcl (cons (reverse lst-r%)
          lst-dcl)))
    (setq lst-dcl (reverse lst-dcl))
    (setq i% 0)
    (setq tmp-data-pre nil)
    (repeat (min (* curr-page% per-page%)
        (length (cdr tmp-data%)))
      (setq tmp-data-pre (cons (nth (setq i% (1+ i%))
            tmp-data%)
          tmp-data-pre)))
    (setq i% (* (1+ curr-page%)
        per-page%))
    (setq tmp-data-last (quote nil))
    (if (> (- (length (cdr tmp-data%))
          (* (1+ curr-page%)
            per-page%))
        0)
      (repeat (- (length (cdr tmp-data%))
          (* (1+ curr-page%)
            per-page%))
        (setq tmp-data-last (cons (nth (setq i% (1+ i%))
              tmp-data%)
            tmp-data-last))))
    (set (read (strcat key "tmp-data"))
      (setq tmp-data% (append (list (car tmp-data%))
          (reverse tmp-data-pre)
          lst-dcl (reverse tmp-data-last)))))
  (defun dcl:show-celldata (key / tmp-unit curr-page% tmp-data% per-page%)
    (setq per-page% (eval (read (strcat key "per-page")))
      curr-page% (eval (read (strcat key "curr-page")))
      tmp-data% (eval (read (strcat key "tmp-data"))))
    (setq i% 0)
    (repeat (length (car tmp-data%))
      (set_tile (strcat key "header"
          (itoa (setq i% (1+ i%))))
        (nth (1- i%)
          (car tmp-data%))))
    (setq c% 64)
    (repeat (length (car tmp-data%))
      (setq r% 0 c% (1+ c%))
      (repeat (min per-page% (- (length (cdr tmp-data%))
            (* per-page% curr-page%)))
        (setq tmp-unit (nth (- c% 65)
            (nth (1- (+ (setq r% (1+ r%))
                  (* per-page% curr-page%)))
              (cdr tmp-data%))))
        (set_tile (strcat key (chr c%)
            (itoa r%))
          (cond ((or (p:intp tmp-unit)
                (and (= (quote str)
                    (type tmp-unit))
                  (string:intp tmp-unit)))
              (string:number-format (vl-string-left-trim (chr 32)
                  (@:to-string tmp-unit))
                5 0 (chr 32)))
            ((or (numberp tmp-unit)
                (and (= (quote str)
                    (type tmp-unit))
                  (string:numberp tmp-unit)))
              (string:number-format (vl-string-left-trim (chr 32)
                  (@:to-string tmp-unit))
                5 3 (chr 32)))
            (t (@:to-string tmp-unit))))
        (mode_tile (strcat key (chr c%)
            (itoa r%))
          0)
        (set_tile (strcat key "rno"
            (itoa r%))
          (string:number-format (@:to-string (+ r% (* per-page% curr-page%)))
            7 0 (chr 32))))
      (while (< r% per-page%)
        (repeat (length (car tmp-data%))
          (set_tile (strcat key (chr c%)
              (itoa (setq r% (1+ r%))))
            "")
          (mode_tile (strcat key (chr c%)
              (itoa r%))
            1)
          (set_tile (strcat key "rno"
              (itoa r%))
            "")))))
  (setq dcl:accept-hook (cons (list key (quote dcl:get-celldata)
        key)
      dcl:accept-hook))
  (set (read (strcat key "per-page"))
    rows)
  (set (read (strcat key "total-page"))
    (fix (1+ (/ (1- (length (cdr (eval (read (strcat key "tmp-data"))))))
          (eval (read (strcat key "per-page")))))))
  (set (read (strcat "cb-"
        key "scrollbar"))
    (lambda (key)
      "滚动条事件的回调函数"
      (dcl:save-celldata key)
      (set (read (strcat key "curr-page"))
        (- (1- (eval (read (strcat key "total-page"))))
          (atoi (get_tile (strcat key "scrollbar")))))
      (print (eval (read (strcat key "curr-page"))))
      (dcl:show-celldata key)))
  (if (and ui:*table-widths* (apply (quote and)
        (mapcar (quote numberp)
          ui:*table-widths*))
      (> (apply (quote min)
          ui:*table-widths*)
        0)
      (= (length ui:*table-widths*)
        columns))
    (setq tbl-widths ui:*table-widths*)
    (progn (repeat rows (setq tbl-widths (cons 10 tbl-widths)))))
  (write-line ":row{:column{"
    dcl-fp)
  (if show-column-number? (progn (write-line (strcat ": row { ")
        dcl-fp)
      (if show-line-number? (write-line (strcat ":edit_box{value=\"No.\";width=2;fixed_width=true;horizontal_margin=none;vertical_margin=none;is_enabled=false;}")
          dcl-fp))
      (setq c% 64)
      (repeat columns (write-line (strcat ":edit_box{value=\""
            (chr (setq c% (1+ c%)))
            "\";width="
            (itoa (nth (- c% 65)
                tbl-widths))
            ";fixed_width=true;horizontal_margin=none;vertical_margin=none;is_enabled=false;}")
          dcl-fp))
      (write-line (strcat "}")
        dcl-fp)))
  (if header-title? (progn (write-line (strcat ": row { ")
        dcl-fp)
      (if show-line-number? (write-line (strcat ":edit_box{value=\"\";width=2;fixed_width=true;horizontal_margin=none;vertical_margin=none;is_enabled=false;}")
          dcl-fp))
      (setq i% 0)
      (repeat columns (write-line (strcat ":edit_box{key=\""
            key "header"
            (itoa (setq i% (1+ i%)))
            "\";value=\"\";width="
            (itoa (nth (1- i%)
                tbl-widths))
            ";fixed_width=true;horizontal_margin=none;vertical_margin=none;is_enabled=false;}")
          dcl-fp))
      (write-line (strcat "}")
        dcl-fp)))
  (setq r% 0)
  (repeat rows (write-line (strcat ":row{")
      dcl-fp)
    (setq r% (1+ r%)
      c% 64)
    (if show-line-number? (write-line (strcat ":edit_box{key=\""
          key "rno"
          (itoa r%)
          "\";value=\"\";width=2;fixed_width=true;horizontal_margin=none;vertical_margin=none;is_enabled=false;}")
        dcl-fp))
    (repeat columns (write-line (strcat ":edit_box{key=\""
          key (chr (setq c% (1+ c%)))
          (itoa r%)
          "\";value=\"\";width="
          (itoa (nth (- c% 65)
              tbl-widths))
          ";fixed_width=true;horizontal_margin=none;vertical_margin=none;}")
        dcl-fp))
    (write-line (strcat "}")
      dcl-fp))
  (write-line (strcat "}")
    dcl-fp)
  (if show-scrollbar? (write-line (strcat ":slider{action=\"(cb-"
          key "scrollbar \\\""
          key "\\\")\";key=\""
        key "scrollbar\";layout=vertical;value="
        (itoa (1- (eval (read (strcat key "total-page")))))
        ";max_value="
        (itoa (1- (eval (read (strcat key "total-page")))))
        ";min_value=0;small_increment=1;}")
      dcl-fp))
  (write-line "}"
    dcl-fp))

统计信息

上传记录

统计信息

上传记录 刷新

上传记录