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%