ASM

CONTROLS

Make a 3D progress bar

Morrison Softdesign did a 3D progress bar some time ago that was sent to the list. I hope John doesn't mind me reposting the code here.

'______________________________________________
'3D Progress Bar
'John Morrison, Morrison SoftDesign
'______________________________________________

CLEAR LOCAL
LOCAL FN do3DProgress(current,total)
  DIM position
  DIM percent!

  'position bar in window
  left% = 25
  top% = 25
  wide% = 200

  'set bar color (this uses the _addOver color mode, so color results may vary)
  red = 60000
  green = 65000
  blue = 65000

  percent! = current/total
  position = (left%+2)+((wide%-3)*percent!)
  wide% = wide% + left%

  AUTOCLIP _false

  LONG IF current =< 1 'draw start progress frame
    LONG COLOR 65000,55000,55000
    BOX FILL left%,top% TO wide%,(top%+15)
    COLOR=_ZBlack
    BOX (left%+1),(top%+1) TO (wide%+1),(top%+16)
  END IF

  FOR bar = 1 TO 6 'blends
    LONG COLOR bar*10000,bar*10000,bar*10000
    PLOT (left%+2),(top%+1)+bar TO position,(top%+1)+bar
    LONG COLOR (6*1000)-(bar*10000),(6*10000)-(bar*10000),(6*10000)-(bar*10000)
    PLOT (left%+2),(top%+8)+bar TO position,(top%+8)+bar
  NEXT bar

  COLOR _zWhite
  PLOT (left%+2),(top%+8) TO position,(top%+8) 'white center line

  CALL PENMODE (34)
  LONG COLOR blue,green,red 'addOver layer of
  COLOR
  BOX FILL (left%+2),(top%+4) TO position,(top%+11)
  CALL PENNORMAL
  COLOR=_zBlack

  LONG IF current=>total 'finish up, reset bar
    DELAY 120
    LONG COLOR 65000,55000,55000
    BOX FILL left%,top% TO wide%,(top%+15)
    COLOR=_ZBlack
    BOX (left%+1),(top%+1) TO wide%+1,(top%+16)
  XELSE
    PLOT position+1,(top%+1) TO position+1,(top%+14)' black end-tip line
  END IF

  COLOR=_zBlack ' QD to normal before EXIT
  CALL PENNORMAL
  AUTOCLIP _true
END FN

WINDOW 1
FOR count = 1 TO 100
  DELAY 20
  FN do3dprogress (count,100)
NEXT count

PRINT "Click mouse to exit..."

DO
UNTIL FN BUTTON

DIM gProgH&
DIM gProgressWindowNumber%
END GLOBALS

LOCAL FN buildProgressWindow (winTitle$,itemMsg$,minProgress%,maxProgress%)
  DIM wPtr&
  DIM barRect.8

  CALL SETRECT(barRect,13,40,200,60)
  WINDOW gProgressWindowNumber%,winTitle$,(0,0)-(282,88),_docNoGrow+_noGoAway
  GET WINDOW gProgressWindowNumber%,wPtr&

  gProgH& = FN NEWCONTROL(wPtr&,barRect,"",_zTrue,1,minProgress%,maxProgress%,82,0)
  BUTTON 1,1,"Stop",(213,37)-(271,57),_push
  TEXT _sysFont,12
  EDIT FIELD 1,itemMsg$,(10,12)-(213,32),_statNoFramed
  EDIT FIELD 2,,(218,12)-(268,32),_statNoFramed, _rightJust
END FN

CLEAR LOCAL
LOCAL FN doProgress
  gProgressWindowNumber% = 1
  minProgress% = 1
  maxProgress% = 100
  FN buildProgressWindow ("Delete Files","Erasing Disk",minProgress%,maxProgress%)
  FOR count = 1 TO maxProgress%
    DELAY 30
    IF gProgH& CALL SETCTLVALUE(gProgH&,count)
  NEXT
  DELAY 180
  IF gProgH& THEN CALL DISPOSECONTROL(gProgH&)
  WINDOW CLOSE gProgressWindowNumber%

END FN

FN doProgress