论坛 › A/VLISP › 一个进度条的实现代码

Lisphk 发表于 2018-7-23 02:07:01

一个进度条的实现代码

(defun progress_lgx (current_pcs      tatoal             current1_pcs
                     tatoal1              /
                     lgx_screenmin_point
                     lgx_screenmax_point             width-x_lgx
                     height-y_lgx   half-y_lgx       grve_lgx
                     min-x_lgx              max-x_lgx             y_zl_lgx
                     x_zl_lgx
                  )
;;;By: Liu new
(redraw)
(setq        lgx_screenmin_point
       (list (- (car (getvar "viewctr"))
                  (/ (*        (/ (getvar "viewsize")
                           (cadr (getvar "screensize"))
                        )
                        (car (getvar "screensize"))
                     )
                     2
                  )
             )
             (- (cadr (getvar "viewctr"))
                  (/ (getvar "viewsize") 2)
             )
       )
)
(setq        lgx_screenmax_point
       (list (+ (car (getvar "viewctr"))
                  (/ (*        (/ (getvar "viewsize")
                           (cadr (getvar "screensize"))
                        )
                        (car (getvar "screensize"))
                     )
                     2
                  )
             )
             (+ (cadr (getvar "viewctr"))
                  (/ (getvar "viewsize") 2)
             )
       )
)
(setq        width-x_lgx
       (- (car lgx_screenmax_point) (car lgx_screenmin_point))
)
(setq        height-y_lgx
       (- (cadr lgx_screenmax_point)
          (cadr lgx_screenmin_point)
       )
)
(setq half-y_lgx (+ (cadr lgx_screenmin_point) (* height-y_lgx 0.5)))
(if (and (/= tatoal nil) (> tatoal 0))
    (progn
      (setq grve_lgx nil)
      (setq
        min-x_lgx (+ (car lgx_screenmin_point) (* width-x_lgx 0.25))
      )
      (setq
        max-x_lgx (- (car lgx_screenmax_point) (* width-x_lgx 0.25))
      )
      (if (and (/= tatoal1 nil) (> tatoal1 0))
        (progn (setq min-y_lgx (+ half-y_lgx (* height-y_lgx 0.005)))
             (setq max-y_lgx (+ half-y_lgx (* height-y_lgx 0.025)))
        )
        (progn (setq min-y_lgx (- half-y_lgx (* height-y_lgx 0.01)))
             (setq max-y_lgx (+ half-y_lgx (* height-y_lgx 0.01)))
        )
      )
      (setq grve_lgx (list (list min-x_lgx min-y_lgx)
                           (list min-x_lgx max-y_lgx)
                           (list min-x_lgx min-y_lgx)
                           (list max-x_lgx min-y_lgx)
                           (list min-x_lgx max-y_lgx)
                           (list max-x_lgx max-y_lgx)
                           (list max-x_lgx max-y_lgx)
                           (list max-x_lgx min-y_lgx)
                     )
      )
      (grvecs (cons 98 grve_lgx))
      (setq grve_lgx nil)
      (setq y_zl_lgx (/ (* height-y_lgx 0.02) 11.0))
      (if (/= current_pcs 0)
        (setq x_zl_lgx (* width-x_lgx
                          0.5
                          (/ (float current_pcs) (float tatoal))
                     )
        )
        (setq x_zl_lgx 0)
      )
      (setq max-x_lgx (+ min-x_lgx x_zl_lgx))
      (repeat 10
        (setq min-y_lgx (+ min-y_lgx y_zl_lgx))
        (setq max-y_lgx min-y_lgx)
        (setq grve_lgx (list (list min-x_lgx min-y_lgx)
                             (list min-x_lgx max-y_lgx)
                             (list min-x_lgx min-y_lgx)
                             (list max-x_lgx min-y_lgx)
                             (list min-x_lgx max-y_lgx)
                             (list max-x_lgx max-y_lgx)
                             (list max-x_lgx max-y_lgx)
                             (list max-x_lgx min-y_lgx)
                     )
        )
        (grvecs (cons 1 grve_lgx))
      )
    )
)
(if (and (/= tatoal1 nil) (> tatoal1 0))
    (progn (setq grve_lgx nil)
           (setq
             min-x_lgx (+ (car lgx_screenmin_point) (* width-x_lgx 0.25))
           )
           (setq
             max-x_lgx (- (car lgx_screenmax_point) (* width-x_lgx 0.25))
           )
           (setq min-y_lgx (- half-y_lgx (* height-y_lgx 0.025)))
           (setq max-y_lgx (- half-y_lgx (* height-y_lgx 0.005)))
           (setq grve_lgx (list        (list min-x_lgx min-y_lgx)
                                (list min-x_lgx max-y_lgx)
                                (list min-x_lgx min-y_lgx)
                                (list max-x_lgx min-y_lgx)
                                (list min-x_lgx max-y_lgx)
                                (list max-x_lgx max-y_lgx)
                                (list max-x_lgx max-y_lgx)
                                (list max-x_lgx min-y_lgx)
                          )
           )
           (grvecs (cons 98 grve_lgx))
           (setq grve_lgx nil)
           (setq y_zl_lgx (/ (* height-y_lgx 0.02) 11.0))
           (if (/= current1_pcs 0)
             (setq x_zl_lgx (* width-x_lgx
                             0.5
                             (/ (float current1_pcs) (float tatoal1))
                          )
             )
             (setq x_zl_lgx 0)
           )
           (setq max-x_lgx (+ min-x_lgx x_zl_lgx))
           (repeat 10
             (setq min-y_lgx (+ min-y_lgx y_zl_lgx))
             (setq max-y_lgx min-y_lgx)
             (setq grve_lgx (list (list min-x_lgx min-y_lgx)
                                  (list min-x_lgx max-y_lgx)
                                  (list min-x_lgx min-y_lgx)
                                  (list max-x_lgx min-y_lgx)
                                  (list min-x_lgx max-y_lgx)
                                  (list max-x_lgx max-y_lgx)
                                  (list max-x_lgx max-y_lgx)
                                  (list max-x_lgx min-y_lgx)
                          )
             )
             (grvecs (cons 1 grve_lgx))
           )
    )
)
)


**** Hidden Message *****

HLCAD 发表于 2018-7-23 08:20:58

感谢楼主的程序！！！

lj524917100 发表于 2018-7-23 08:40:10

怎么使用呀？？？

434939575 发表于 2018-7-23 08:54:36

楼主真是大好人一个，谢谢！

434939575 发表于 2018-7-23 08:56:33

楼主真是大好人一个，谢谢！

aimisiyou 发表于 2018-7-23 08:59:06

对程序的运行效率更直观了。

Smile_小窑 发表于 2018-7-23 09:11:47

下载看看，感谢分享

Smile_小窑 发表于 2018-7-23 09:14:15

下载看看，感谢分享

hejiho 发表于 2018-7-23 09:15:53

非常花哨，无敌

huangpc27 发表于 2018-7-23 09:43:29

看起来很不错啊，用用看

小陶 发表于 2018-7-23 10:33:02

创意不错！学习下

tzyzxjh 发表于 2018-7-23 11:27:22

下载看看，感谢分享

ynhh 发表于 2018-7-23 11:44:25

显示在命令行才直观吧

ynhh 发表于 2018-7-23 11:52:07

显示在命令行才直观吧

lw5297590 发表于 2018-7-23 13:18:49

看起来很不错啊，用用看

查看完整版本: 一个进度条的实现代码