（XD::Odcl:Infobox）ODCL信息框

Lispboy · 发表于 2018-10-23 16:24:48

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun xd::odcl:infobox
(title content width height txtheight button-caption)
(setq xd-odcl-info-box-data
'("YWt6A5IKAAAkewxqBuK7KzUxLS9ugFCxbRZy7hYmZ3pyOtcobldQci89nH2P686u+1NTcd8T3Nbz"
"ZejsxgnfgHrh9/G62xAK2QUB/vdcZR3yVovlrbVDiTA8yw8/EbDDjeNHTRkYsALZU9vLbIIvxepV"
"ImTjj37CEXrkhuuXkHKIHewx/KF6eG45QeEfsLpHzXE94vNds+d/sLlP+z+wGoZrE/yN/erNmxM0"
"nA/0lUzKNq25bnAmQTe0gyhkiNtKLOot6vj2bYrsyyzs5H+cehRv7RaXynrKvQbW/4GdSIvdVp50"
"DHK8wjulxLghHLDccN/hJ/rJUAHcPQ1hc0CKWgyNJZ+VdMlHhW80mN2sofae4DdiOu8r9k22ck3g"
"2eod+CmH2k4zN1QunmTXFkfvUPJd8R1izSaeNq8UaEnHqMIKxaUS4FWCPJ8ZdNHUFvV0SQYvgrUr"
"MWLnJRZyNFGrlfRiO/PK6AfzhO538i9AoTsSpNXT8JdzmzoxzyQAHWiLl6AWQDFpO2iPTtCPwz5p"
"h3OE2nhY1qzGpT88SXOvUo27xWkyw7RUaNcaGUuZIL7iAZg5kjcxbBkXG+DWoAPUjh0LBPFqANaO"
"ffvlqpeYXQe4uA5wY2JN8hjgMXnwjENzDUfOVeEOP58iLkGRxQq34qyxVdJFWLrPCL8JKuIl4wA7"
"jhf5JfvtySvgGeKA/dIhDYUlASErQrU/Y7SI4V0L/ycPh6eLIXwo6g/JzKGXiJHqhjBHwiOo4S5S"
"Q9eO5ry5a/hp0zHqH6XUlz2t3RRjHKV2OTJUpRKfX7NInaZYcIGwzcMU0fq838WE2YovI65ZGwP2"
"2cP8S1lVjrmkEdfsQeRR01BgNxStho20qx8nqFkroGuGq5w7hxuLxSMgaFHXRNpr4C5GujEPapiZ"
"1JKp2YRJ0M6YESifI1SgSXShpeaBPCoNL5cJVgCRD5UBUhCQAx+FVAohWtsALVSAgcNB+C+XgIaZ"
"AZZ74YDrkO4RwIp5rT4iow=="
)
)
(defun c:xd-odcl-message-box-form#OnInitialize (/)
(dcl-Control-SetText xd-odcl-message-box-text content)
(dcl-Control-SetTitleBarText xd-odcl-message-box-form title)
(if (or (not title) (= "" title))
(setq button-caption "晓东提示")
)
(if (or (not button-caption) (= "" button-caption))
(setq button-caption "确定")
)
(if (not txtheight)
(setq txtheight 12)
)
(if (not height)
(setq height 320)
)
(if (not width)
(setq width 512)
)
(dcl-Control-SetCaption
xd-odcl-message-box-ok
button-caption
)
(dcl-Control-SetHeight xd-odcl-message-box-form height)
(dcl-Control-SetWidth xd-odcl-message-box-form width)
(dcl-Control-SetLeft
xd-odcl-message-box-ok
(- (fix (/ width 2.0)) 32)
)
(dcl-Control-SetHeight
xd-odcl-message-box-text
(fix (- height 8 40))
)
(dcl-Control-SetWidth
xd-odcl-message-box-text
(fix (- width 8 8))
)
(dcl-Control-SetFontSize xd-odcl-message-box-text txtheight)
(dcl-Control-SetLeft xd-odcl-message-box-text 8)
(dcl-Control-SetTop xd-odcl-message-box-ok (- height 30))
)
(defun c:xd-odcl-message-box-ok#OnClicked (/)
(dcl-form-close xd-odcl-message-box-form)
)
(dcl-project-import xd-odcl-info-box-data)
(dcl-form-show xd-odcl-message-box-form)
t
)

(defun xd::odcl:infobox 
       (title content width height txtheight button-caption) 
  (setq        xd-odcl-info-box-data 
         '("YWt6A5IKAAAkewxqBuK7KzUxLS9ugFCxbRZy7hYmZ3pyOtcobldQci89nH2P686u+1NTcd8T3Nbz" 
           "ZejsxgnfgHrh9/G62xAK2QUB/vdcZR3yVovlrbVDiTA8yw8/EbDDjeNHTRkYsALZU9vLbIIvxepV" 
           "ImTjj37CEXrkhuuXkHKIHewx/KF6eG45QeEfsLpHzXE94vNds+d/sLlP+z+wGoZrE/yN/erNmxM0" 
           "nA/0lUzKNq25bnAmQTe0gyhkiNtKLOot6vj2bYrsyyzs5H+cehRv7RaXynrKvQbW/4GdSIvdVp50" 
           "DHK8wjulxLghHLDccN/hJ/rJUAHcPQ1hc0CKWgyNJZ+VdMlHhW80mN2sofae4DdiOu8r9k22ck3g" 
           "2eod+CmH2k4zN1QunmTXFkfvUPJd8R1izSaeNq8UaEnHqMIKxaUS4FWCPJ8ZdNHUFvV0SQYvgrUr" 
           "MWLnJRZyNFGrlfRiO/PK6AfzhO538i9AoTsSpNXT8JdzmzoxzyQAHWiLl6AWQDFpO2iPTtCPwz5p" 
           "h3OE2nhY1qzGpT88SXOvUo27xWkyw7RUaNcaGUuZIL7iAZg5kjcxbBkXG+DWoAPUjh0LBPFqANaO" 
           "ffvlqpeYXQe4uA5wY2JN8hjgMXnwjENzDUfOVeEOP58iLkGRxQq34qyxVdJFWLrPCL8JKuIl4wA7" 
           "jhf5JfvtySvgGeKA/dIhDYUlASErQrU/Y7SI4V0L/ycPh6eLIXwo6g/JzKGXiJHqhjBHwiOo4S5S" 
           "Q9eO5ry5a/hp0zHqH6XUlz2t3RRjHKV2OTJUpRKfX7NInaZYcIGwzcMU0fq838WE2YovI65ZGwP2" 
           "2cP8S1lVjrmkEdfsQeRR01BgNxStho20qx8nqFkroGuGq5w7hxuLxSMgaFHXRNpr4C5GujEPapiZ" 
           "1JKp2YRJ0M6YESifI1SgSXShpeaBPCoNL5cJVgCRD5UBUhCQAx+FVAohWtsALVSAgcNB+C+XgIaZ" 
           "AZZ74YDrkO4RwIp5rT4iow==" 
          ) 
  ) 
  (defun c:xd-odcl-message-box-form#OnInitialize (/) 
    (dcl-Control-SetText xd-odcl-message-box-text content) 
    (dcl-Control-SetTitleBarText xd-odcl-message-box-form title) 
    (if        (or (not title) (= "" title)) 
      (setq button-caption "晓东提示") 
    ) 
    (if        (or (not button-caption) (= "" button-caption)) 
      (setq button-caption "确定") 
    ) 
    (if        (not txtheight) 
      (setq txtheight 12) 
    ) 
    (if        (not height) 
      (setq height 320) 
    ) 
    (if        (not width) 
      (setq width 512) 
    ) 
    (dcl-Control-SetCaption 
      xd-odcl-message-box-ok 
      button-caption 
    ) 
    (dcl-Control-SetHeight xd-odcl-message-box-form height) 
    (dcl-Control-SetWidth xd-odcl-message-box-form width) 
    (dcl-Control-SetLeft 
      xd-odcl-message-box-ok 
      (- (fix (/ width 2.0)) 32) 
    ) 
    (dcl-Control-SetHeight 
      xd-odcl-message-box-text 
      (fix (- height 8 40)) 
    ) 
    (dcl-Control-SetWidth 
      xd-odcl-message-box-text 
      (fix (- width 8 8)) 
    ) 
    (dcl-Control-SetFontSize xd-odcl-message-box-text txtheight) 
    (dcl-Control-SetLeft xd-odcl-message-box-text 8) 
    (dcl-Control-SetTop xd-odcl-message-box-ok (- height 30)) 
  ) 
  (defun c:xd-odcl-message-box-ok#OnClicked (/) 
    (dcl-form-close xd-odcl-message-box-form) 
  ) 
  (dcl-project-import xd-odcl-info-box-data) 
  (dcl-form-show xd-odcl-message-box-form) 
  t 
)

测试代码：

(defun c:tt ()
(if (and (setq fns (xdrx_system_selectfiles "选取文件" ""
"txt"
)
)
(setq a (xd::list:fromfile (car fns))))
(progn (xd::odcl:infobox
"温馨提示"
(xdrx_string_join a "\r\n")
nil
nil
10
"确定"
)
)
)
(princ)
)

账号		自动登录	找回密码
密码			立即注册

[OPENDCL] （XD::Odcl:Infobox）ODCL信息框

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。