Smooth Move

[balisteor]

Hopefully everyone is still using OpenDCL, there doesn't seem to be much going on anymore. I thought I would share a useful tool. to help keep it going. I hope OpenDCL never dies!


This program allows you to move objects smoothly (simply for program cosmetics); and to create menu's with labels or buttons and such.

So you can see what it does I have attached a video and set the button move speed at the lowest setting (1)  the video was set at minimal settings so that the file stays small, Just trust me that it will look a lot better on your computer when you actually use it. my apologies I am no good at making videos and posting in forums.

I'll paste the two main functions and a couple extra's hopefully they are simple enough to get you going. the possibilities are endless.

1. ;;step to target number
2. (defun sttn (tar cur ch / out)
3. (setq out ((if (minusp (- cur tar)) + -) cur ch))
4. (cond ((= cur tar) tar);; if current is equal to target, return target.
5.           ((minusp out) tar);; current value is larger than target, and change ends up negative (return target)
6.           ((> out tar)(if (> cur tar) out tar));if out is larger than target and current is also larger, number should be safely shrinking (return out), otherwise it has gone past into negative value therefore (return target)
7.           (T out); any other condition (most likely growing or same) return out
8. )
9. );d
10.  
11.  
12.  
13. ;; move objects func.
14. ;; use:   (odcl:slideobjects (list (object left top width height)) movespeed_as_int move_in_sync_or_in_order(as boolean) functiontoapplytoobjectoneachstep)
15. ;; example2:   (odcl:slideobjects (list (list MControl_Main_buttonrefreshjob 16 136 62 24) (list MControl_Main_Buttonrefreshdatagrid 935 136 88 24)) 5 T (lambda (x) (dcl_Control_SetCaption x (apply 'strcat (mapcar '(lambda (xx) (strcat (itoa xx) ", ")) (dcl_Control_Getpos x))))))
16. (defun odcl:slideobjects (objdlist smoothspeed sync objfunc / cform x1)
17. (setq cform (eval (read (strcat (vl-princ-to-string (car (setq cform (dcl_GetFocus)))) "_" (cadr cform)))));cant think of a better way to get the form of the object, so insead i get the focused form, therefore form must have focus for this to work.
18. ;(setq cform (strcat (setq x1 (substr (setq cform (car (car objdlist))) 1 (1- (vl-string-search "_" cform))))  (substr  (vl-string-subst "" x1 cform) 1 (1- (vl-string-search "_" cform)))))
19. (cond (sync (while (not (vl-every '(lambda (a) (equal (dcl_Control_GetPos (car a)) (cdr a))) objdlist))
20.                         (mapcar '(lambda (b) (apply 'dcl_Control_SetPos b) (if objfunc (objfunc (car b))) (dcl_Control_Redraw (car b)))
21.                          (mapcar '(lambda (c / nl pos) (mapcar '(lambda (d) (if (numberp d) (sttn d (nth (setq nl (if nl (1+ nl) 0)) pos) smoothspeed) (setq pos (dcl_Control_GetPos d) d d))) c))
22.                          objdlist
23.                          )
24.                         )
25.                     (dcl_Control_Redraw cform);;**** redraw entire form (little slower but looks much better)
26.                         );w
27.                 );cond sync
28.       (T (foreach o objdlist ;;any other cond than sync being true (move objects 1 at a time)
29.                         (while (not (equal (dcl_Control_GetPos (car o))(cdr o)))
30.                         (apply 'dcl_Control_SetPos
31.                           (mapcar (function (lambda (a) (if (numberp a) (sttn a (nth (setq nl (if nl (1+ nl) 0)) pos) smoothspeed) (setq pos (dcl_Control_GetPos a) a a))))
32.                                 o
33.                           )
34.                         );apply
35.                     (if objfunc (objfunc (car o)))
36.                     (dcl_Control_Redraw cform)
37.                         (setq nl nil pos nil)
38.                     );w
39.                    );fe
40.                 );cond sync nil
41. );cond
42. (mapcar '(lambda (x) (cons (car x) (dcl_Control_GetPos (car x)))) objdlist);return all items with new current data.
43. );d
44.  
45.  
46.  
47.  
48.  
49.  
50.  
51.  
52.  
53.  
54.  
55.  
56. ;extra's (stack objects together)
57. (defun odcl:stackobjects (objlist startpoint rowheight columnwidth maxrows padding smoothspeed sync func / rowcount columncount)
58. (setq rowcount 0
59.           columncount 0
60.           objlist
61. (mapcar '(lambda (x / xx)
62.          (setq xx (list x (+ (car startpoint) (+ (* columnwidth columncount) (* columncount padding))) (+ (cadr startpoint) (+ (* rowheight rowcount) (* rowcount padding))) columnwidth rowheight));; create object position list
63.                  (if (>= (1+ rowcount) maxrows)(setq rowcount 0 columncount (1+ columncount))(setq rowcount (1+ rowcount))) ;;set new points
64.                  xx ;return xx
65.                  )
66. objlist
67. );mapcar
68. )
69. (odcl:slideobjects objlist smoothspeed sync func)
70. )
71. ;(lambda (x) (dcl_Control_SetCaption x (apply 'strcat (mapcar '(lambda (xx) (strcat (itoa xx) ", ")) (dcl_Control_Getpos x)))))
72.  
73. ;;extra (swap object postion and size properties)
74. ;;swap object positions Left,Top,Width & Height
75. (defun odcl:swapobjects (obj1 obj2 smoothspeed) (odcl:slideobjects (list (cons obj1 (dcl_Control_GetPos obj2)) (cons obj2 (dcl_Control_GetPos obj1))) smoothspeed T nil));d
76.  
77.  
78.  

[owenwengerd]

I didn't run the code, but it looks very cool!

[balisteor]

Once I get the base program I get so many ideas, here is another cool one.
Now with just this simple code we can have it rotate each object in the list to the next objects properties and create a fancy scroll button list.

1. (defun odcl:revolveobjects (objlist smoothspeed) (odcl:slideobjects (associate-lists (reverse (cons (car objlist) (reverse (cdr objlist)))) (mapcar 'dcl_Control_GetPos objlist)) smoothspeed T nil))
2. ;(odcl:revolveobjects (list button0 button1 button2 button3 button4 button5) 2)
3.