Hi Ian,

One for "The Book".  Thanks, works fine on my iMac/333.  The one used for scrolling
credits in "The Book", based on one of Matt Beedle/Stazs routines scrolls vertically;
whereas this one scrolls horizontally.

Joe Wilkins

Ian Mann wrote:

> Herewith code for scrolling G Worlds
>
> Hope it helps someone
>
> I am sure it can be improved.
>
> I normally maintain a gworld for each window I have open, I all the
> things I want to do to the Gworld, and then copy this to the window.
> This avoids flicker.
>
> Best Regards
>
> Ian
>
> Code Starts here - beware of wrapped lines - check preferences to make
> sure toolboxes do NOT require CALL
>
> begin globals
>
> '~Stack (Delayed Action) Constants and Variables
>
> /*
> _DelActChangeState = 1
> _DelActCycleIcon = 2
> _DelActFlashIcon = 3
> _DelActMovieFrame = 4
> */
>
> _InsertItem = 1
> _DeleteItem = 2
> _MoveItem = 3
>
> DIM RECORD MovieAction
> DIM mHandl&
> dim doWnd%
> DIM doWhen&
> DIM END RECORD _mvActRecLen
>
> DIM DelHandle&
> DIM DelCount&
> dim gProgramEnds%
>
> '~Movie Constants and Variables
>
> _mvMovieScroll = 1
> _mvMovieAction = 2
>
> _mvRunLeftRight = 1
> _mvRunTopBottom = 2
>
> _mvLoopMovie = 1
> _mvBounceMovie = 2
> _mvStopMovie = 3
>
> dim Record MyMovie
> dim mvRect as rect' Position in Window
> dim mvWindNum%' Which WIndow is it in
> dim mvMovieIsOK%' Hopefully True
> dim mvMovieRun%' True if Frames Changing
> dim mvMovieDirection%' Left To Right or Top to Bottom
> dim mvMovieTicks%' Ticks between 'Frames'
> dim mvMoviePage%' Positive if L>R or T>B Neg if R>L or B>T
> dim mvMovieCycle%' Bounce = Reverse dir at end, Loop = feed in from
> beginning, Stop = Stop
> dim mvPictGW&' Original Pict
> dim mvPictDev&
> dim mvPictRect as rect
> dim mvCopyGW&' Chunk of pict to be copied to screen
> dim mvCopyDev&
> dim mvCopyRect as rect
> dim mvCutRect as rect'
> dim end record _MyMovieRecLen
>
> dim gMovieHandle&
> dim gMovieHandle2&
> DIM gDestGW& 'AS Handle
> DIM gDestDev&
> end globals
>
> 'DataHandle& - The Handle Holding the Data
> 'ItemSelected& - The Item we are working on ( Greater than NumItems& if
> Insertion = Add)
> 'NewPosition& - Where to stick it if Move.
> 'NumItems& - The Number of Items before this operation.
> 'RecAddress& - The address of the data block holding the record to be
> inserted.
> 'RecBytes% - Record Length
> 'Action% - What to do
>
> 'OutPut - returns the new number of items.
> '       - Note also that ItemSelected& is changed inside the fn.
>
> LOCAL MODE
> DIM HPtr&
> DIM IPtr&
> DIM NextPtr&,DestPtr&,CPtr&
> DIM NewSize&,BlockSize&
> DIM @ ItemSelected&
> LOCAL FN HandleMangle&
> (DataHandle&,ItemSelAddr&,NewPosition&,NumItems&,RecAddress&,RecBytes%,Action%)
>
> LONG IF DataHandle&
> BLOCKMOVE ItemSelAddr&,@ItemSelected&,sizeof(LONG)
> SELECT CASE Action%
> CASE _InsertItem
> NewSize& = (NumItems& + 2) * RecBytes%
> FN SETHANDLESIZE(DataHandle&,NewSize&)
> HPtr& = [DataHandle&]
> NextPtr& = HPtr& + (ItemSelected& + 1) * RecBytes%
> LONG IF ItemSelected& < NumItems&
> DestPtr& = HPtr& + (ItemSelected& + 2) * RecBytes%
> BlockSize& = (NumItems& - ItemSelected&) * RecBytes%
> BLOCKMOVE NextPtr&,DestPtr&,BlockSize&
> END IF
> BLOCKMOVE RecAddress&,NextPtr&,RecBytes%
> INC (NumItems&)
> INC (ItemSelected&)
> CASE _DeleteItem
> LONG IF ItemSelected& < NumItems&
> HPtr& = [DataHandle&]
> IPtr& = HPtr& + ItemSelected& * RecBytes%
> NextPtr& = HPtr& + (ItemSelected& + 1) * RecBytes%
> BlockSize& = (NumItems& - ItemSelected&) * RecBytes%
> BLOCKMOVE NextPtr&,IPtr&,BlockSize&
> BLOCKMOVE NextPtr&,RecAddress&,RecBytes%
> END IF
> NewSize& = (NumItems&) * RecBytes%
> FN SETHANDLESIZE(DataHandle&,NewSize&)
> DEC (NumItems&)
> IF ItemSelected& > NumItems& THEN ItemSelected& = NumItems&
> CASE _MoveItem
> LONG IF NewPosition& <> ItemSelected&
> LONG IF NewPosition& <= NumItems& AND NewPosition& >= 1
> HPtr& = [DataHandle&]
> BlockSize& = ABS(NewPosition& - ItemSelected&) * RecBytes%
> LONG IF NewPosition& < ItemSelected&
> IPtr& = HPtr& + NewPosition& * RecBytes%
> NextPtr& = HPtr& + (NewPosition& + 1) * RecBytes%
> BLOCKMOVE IPtr&,NextPtr&,BlockSize&
> XELSE
> IPtr& = HPtr& + ItemSelected& * RecBytes%
> NextPtr& = HPtr& + (ItemSelected& + 1) * RecBytes%
> BLOCKMOVE NextPtr&,IPtr&,BlockSize&
> END IF
> IPtr& = HPtr& + NewPosition& * RecBytes%
> BLOCKMOVE RecAddress&,IPtr&,RecBytes%
> ItemSelected& = NewPosition&
> END IF
> END IF
> END SELECT
> BLOCKMOVE @ItemSelected&,ItemSelAddr&,sizeof(LONG)
> end if
> END FN = NumItems&
>
> LOCAL FN stickOnMovieStack (lHndl&,Del&,Wnd%)
> MovieAction.doWhen& = FN TICKCOUNT + Del&
> MovieAction.mHandl& = lHndl&
> MovieAction.doWnd% = Wnd%
> DelCount& = FN HandleMangle&
> (DelHandle&,@DelCount&,DelCount&,DelCount&,@MovieAction,_mvActRecLen,_InsertItem)
>
> END FN
>
> clear local
> dim err%, Result%, ht%, NewHt%
> dim Rect0 as rect
> dim tRect as rect
> dim bRect as rect
> dim @ PixMapHndl&, OldGW&, OldDev&
> dim MPtr&, CPtr&
> dim a$
> LOCAL FN RollMovie (MovHandle&)
> fn HLock (MovHandle&)
> MPtr& = [MovHandle&]
> select case MPtr&.mvMovieDirection%
> case _mvRunTopBottom
> offsetrect (MPtr&.mvCutRect,0,MPtr&.mvMoviePage%)
> case _mvRunLeftRight
> offsetrect (MPtr&.mvCutRect,MPtr&.mvMoviePage%,0)
> end select
> err% = fn sectrect (MPtr&.mvCutRect, MPtr&.mvPictRect,Rect0)
> Result% = fn equalrect (Rect0,MPtr&.mvCutRect)
> long if Result% = _False and (MPtr&.mvMovieCycle% = _mvBounceMovie or
> MPtr&.mvMovieCycle% = _mvStopMovie)
> select case MPtr&.mvMovieDirection%
> case _mvRunTopBottom
> offsetrect (MPtr&.mvCutRect,0,-MPtr&.mvMoviePage%)
> case _mvRunLeftRight
> offsetrect (MPtr&.mvCutRect,-MPtr&.mvMoviePage%,0)
> end select
> select case MPtr&.mvMovieCycle%
> case _mvBounceMovie
> MPtr&.mvMoviePage% = MPtr&.mvMoviePage% * (-1)
> case _mvStopMovie
> MPtr&.mvMovieRun% = _False
> end select
> end if
> long if fn emptyrect (Rect0)' its popped off the edge
> MPtr&.mvCutRect;8 = MPtr&.mvCopyRect
> Result% = _True
> end if
> CALL GETGWORLD(OldGW&,OldDev&)
> CALL SETGWORLD(MPtr&.mvCopyGW&,MPtr&.mvCopyDev&)
> if (fn LockPixels (fn GetGWorldPixmap (MPtr&.mvPictGW&)) <> _true) then
> stop "Error in Pixel Lock"
> if (fn LockPixels (fn GetGWorldPixmap (MPtr&.mvCopyGW&)) <> _true) then
> stop "Error in Pixel Lock"
> eraserect (MPtr&.mvCopyRect)
> long if Result% = _True' everything is OK
> CALL COPYBITS(#MPtr&.mvPictGW&+2,#MPtr&.mvCopyGW&+2,MPtr&.mvCutRect
> ,MPtr&.mvCopyRect,_srcCopy,0)
> xelse' hard labour
> tRect;8 = @Rect0
> offsetrect (tRect,-tRect.left%, -tRect.top%)
> CALL
> COPYBITS(#MPtr&.mvPictGW&+2,#MPtr&.mvCopyGW&+2,Rect0,tRect,_srcCopy,0)
> select case MPtr&.mvMovieDirection%
> case _mvRunTopBottom
> Rect0.bottom% = MPtr&.mvCopyRect.bottom% - (tRect.bottom% - tRect.top%)
> Rect0.top% = 0
> tRect.bottom% = MPtr&.mvCopyRect.bottom%' - tRect.bottom%
> tRect.top% = tRect.bottom% - Rect0.bottom%
> case _mvRunLeftRight
> Rect0.right% = MPtr&.mvCopyRect.right% - (tRect.right% - tRect.left%)
> Rect0.left% = 0
> tRect.right% = MPtr&.mvCopyRect.right%' - tRect.bottom%
> tRect.left% = tRect.right% - Rect0.right%
> end select
> CALL
> COPYBITS(#MPtr&.mvPictGW&+2,#MPtr&.mvCopyGW&+2,Rect0,tRect,_srcCopy,0)
> end if
> CALL SETGWORLD(gDestGW&,gDestDev&)
> CALL COPYBITS(#MPtr&.mvCopyGW&+2,#gDestGW&+2,MPtr&.mvCopyRect
> ,MPtr&.mvRect,_srcCopy,0)
> 'framerect (MPtr&.mvRect)
> call unLockPixels (fn GetGWorldPixmap (MPtr&.mvPictGW&))
> call unLockPixels (fn GetGWorldPixmap (MPtr&.mvCopyGW&))
> CALL sETGWORLD(OldGW&,OldDev&)
> END FN = MPtr&.mvMovieRun%
>
> clear local
> dim @ OldGW&, OldDev&, CPtr&,MPtr&
> dim osErr%
> local fn StopStartMovie (MovHandle&,MovieRun%)
> fn HLOCK (MovHandle&)
> MPtr& = [MovHandle&]
> tron break
> long if MPtr&.mvMovieIsOK% = _True
> MPtr&.mvMovieRun% = MovieRun%
> long if MovieRun% = _True
> MPtr&.mvCutRect;8 = MPtr&.mvCopyRect
> CALL GETGWORLD(OldGW&, OldDev&)
> CALL SETGWORLD(MPtr&.mvCopyGW&,MPtr&.mvCopyDev&)
> osErr% = fn LockPixels (fn GetGWorldPixmap (MPtr&.mvPictGW&))
> osErr% = fn LockPixels (fn GetGWorldPixmap (MPtr&.mvCopyGW&))
> CALL COPYBITS(#MPtr&.mvPictGW&+2,#MPtr&.mvCopyGW&+2,MPtr&.mvCopyRect
> ,MPtr&.mvCopyRect,_srcCopy,0)
> call UnlockPixels (fn GetGWorldPixmap (MPtr&.mvPictGW&))
> call UnlockPixels (fn GetGWorldPixmap (MPtr&.mvCopyGW&))
> CALL SETGWORLD(OldGW&, OldDev&)
> FN stickOnMovieStack (MovHandle&,MPtr&.mvMovieTicks%,1)
> end if
> end if
> fn HunLOCK (MovHandle&)
> end fn
>
> clear local
> dim @ Count&, xCount&
> dim DPtr&
> dim KeepRolling%
> LOCAL FN CheckMovieActions
> Count& = 1
> DO
> DPtr& = [DelHandle&] + Count& * _mvActRecLen
> LONG IF DPtr&.doWhen& <= FN TICKCOUNT
> LONG IF WINDOW (-DPtr&.doWnd%) <> 0
> MovieAction;_mvActRecLen = DPtr&
> KeepRolling% = fn RollMovie (gMovieHandle&)
> long if KeepRolling% = _True
> 'MPtr& = [gMovieHandle&]
> MovieAction.doWhen& = FN TICKCOUNT + gMovieHandle&..mvMovieTicks%
> DelCount& = FN HandleMangle&
> (DelHandle&,@DelCount&,DelCount&,DelCount&,@MovieAction,_mvActRecLen,_InsertItem)
>
> end if
> END IF
> xCount& = Count&
> DelCount& = FN HandleMangle&
> (DelHandle&,@xCount&,0,DelCount&,@MovieAction,_mvActRecLen,_DeleteItem)
> END IF
> INC(Count&)
> UNTIL Count& > DelCount&
> END FN = KeepRolling%
>
> register off
> clear local
> dim PHandle&
> dim a$
> dim Count%, Col%
> dim Rect0 as Rect
> local fn MakePicture
> picture on
> Col% = rnd(7)
> color Col%
> setrect (Rect0,10,50,390,300)
> a$ = "Back Off Boogaloo"
> text 3,48,0,0
> TEXTBOX(VARPTR(a$)+1,LEN(a$),Rect0,_teJustLeft)
> for Count% = 20 to 400 step 20
> def cycle (1,7,Col%)
> Color Col%
> moveto (Count%,0)
> lineto (Count%,400)
> next
> for Count% = 20 to 400 step 20
> def cycle (1,7,Col%)
> Color Col%
> moveto (0,Count%)
> lineto (400,Count%)
> next
> picture off , PHandle&
> color _zBlack
> end fn = PHandle&
> register on
>
> clear Local
> dim osErr%
> dim MPtr&, PHandle&
> Local fn SetUpMovie (RPtr&, ResNum%, cDepth%, Direction%, mPage%,
> mCycle%,movieHndl&,ticks&)
> def disposeh (movieHndl&)
> movieHndl& = FN NEWHANDLEclear (_MyMovieRecLen)
> fn HLOCK (movieHndl&)
> MPtr& = [movieHndl&]
> MPtr&.mvCopyRect;8 = RPtr&
> MPtr&.mvRect;8 = RPtr&
> MPtr&.mvMovieDirection% = Direction%
> MPtr&.mvMoviePage% = mPage%
> MPtr&.mvMovieCycle% = mCycle%
> MPtr&.mvMovieTicks% = ticks&
>
> offsetrect (MPtr&.mvCopyRect,-MPtr&.mvCopyRect.left%,
> -MPtr&.mvCopyRect.top%)
> MPtr&.mvCutRect;8 = MPtr&.mvCopyRect
> IF ResNum% > 127 then PHandle& = FN GET1RESOURCE (_"PICT",ResNum%) else
> PHandle& = fn MakePicture
> MPtr&.mvMovieIsOK% = _True
> MPtr&.mvMovieRun% = _True
> long if PHandle& <> 0
> MPtr&.mvPictRect;8 = [PHandle&] + _picframe
> CALL GETGWORLD(gDestGW&,gDestDev&)
> osErr% = FN
> NEWGWORLD(MPtr&.mvPictGW&,cDepth%,#@MPtr&.mvPictRect,0,MPtr&.mvPictDev&,_keepLocal)
>
> if osErr% <> _noErr then MPtr&.mvMovieIsOK% = _False
> osErr% = fn LockPixels (fn GetGWorldPixmap (MPtr&.mvPictGW&))
> CALL SETGWORLD(MPtr&.mvPictGW&,MPtr&.mvPictDev&)
> CALL FORECOLOR(_blackColor)
> CALL BACKCOLOR(_whiteColor)
> CALL ERASERECT(MPtr&.mvPictRect)
> PICTURE (0,0),PHandle&
> osErr% = FN
> NEWGWORLD(MPtr&.mvCopyGW&,cDepth%,#@MPtr&.mvCopyRect,0,MPtr&.mvCopyDev&,_keepLocal)
>
> if osErr% <> _noErr then MPtr&.mvMovieIsOK% = _False
> osErr% = fn LockPixels (fn GetGWorldPixmap (MPtr&.mvCopyGW&))
> CALL SETGWORLD(MPtr&.mvCopyGW&,MPtr&.mvCopyDev&)
> CALL FORECOLOR(_blackColor)
> CALL BACKCOLOR(_whiteColor)
> CALL ERASERECT(MPtr&.mvCopyRect)
> CALL COPYBITS(#MPtr&.mvPictGW&+2,#MPtr&.mvCopyGW&+2,MPtr&.mvCopyRect
> ,MPtr&.mvCopyRect,_srcCopy,0)'assumes PictGW bigger than CopyGW
> CALL SETGWORLD(gDestGW&,gDestDev&)
> CALL COPYBITS(#MPtr&.mvCopyGW&+2,#gDestGW&+2,MPtr&.mvCopyRect
> ,MPtr&.mvRect,_srcCopy,0)
> call UnlockPixels (fn GetGWorldPixmap (MPtr&.mvPictGW&))
> call UnlockPixels (fn GetGWorldPixmap (MPtr&.mvCopyGW&))
> xelse
> MPtr&.mvMovieIsOK% = _False
> END IF
>
> fn HunLOCK (movieHndl&)
> end fn = movieHndl&
>
> local fn doMenu
> gProgramEnds% = _True
> end fn
>
> clear local
> dim Rect0 as rect
> local fn Startup
> DelHandle& = FN NEWHANDLE (_mvActRecLen)
> setrect (Rect0,0,0,400,400)
> window 1,"Movie", @Rect0
>
> MENU 1,0,_enable,"File"
> MENU 1,1,_enable,"Quit/Q"
> insetrect (Rect0,100,100)
> 'Local fn SetUpMovie (RPtr&, ResNum%, cDepth%, Direction%, mPage%,
> mCycle%,movieHndl&,ticks&)
> 'gMovieHandle& = fn SetUpMovie (@Rect0, 0, 8, _mvRunTopBottom, 1,
> _mvBounceMovie,gMovieHandle&,3)
> gMovieHandle& = fn SetUpMovie (@Rect0, 0, 8, _mvRunLeftRight, 1,
> _mvLoopMovie,gMovieHandle&,3)'Switch around for different effects
>  fn StopStartMovie (gMovieHandle&,_True)
> end fn
>
> fn Startup
> 'resources "Mex.rsrc"'Create a resource file and pass the PICT ResNumto
> SetUpMovie
> on menu fn doMenu
> do
> IF DelCount& > 0 then FN CheckMovieActions
> handleEvents
> until gProgramEnds%
>
> --
> To unsubscribe, send ANY message to <futurebasic-unsubscribe@...>