[futurebasic] Repost: [FB] Scroll Large GWorld Deluxe ( FB 3 demo)

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : November 2001 : Group Archive : Group : All Groups

From: Robert Covington <artlythere@...>
Date: Thu, 8 Nov 2001 09:38:48 -0500
>rc:
>
>How about a url with a complete working version? This fix numerous
>errors thing is tedious and I'm lazy.
>
>tedd
>--
>http://sperling.com

Don't be lazy.

Takes all of 2 minutes to fix...start at the bottom, work your way up.
Mostly it's wrapped comments that are the show stoppers.

The below should fix  all or most wrap problems though.

rc

/*  Scroll Large GWorld Deluxe Example, an FB 3 demo, by Robert Covington

using Robert Purves marvy basic Scroll GWorld method, previously posted.

Requires FB 3 Standard or FB II runtime, Call Not Required prefs set.

This is a demo is based one the one previously posted, Scroll Large GWorld.bas
which is itself is built on Robert Purves' nice scroll GWorld techniques. See
the notes there at top regarding the complete genesis.

However this demo builds further on that demo and adds 3 additions
of my own to the scheme: Arrows Scroll, Move Tool Scroll, and AutoScroll.

** Arrow Keys: Scroll image in 4 pixel steps.

** Move Tool mode: Drag in the image to move the image around, and scroll
buttons. This operation can be reversed by changing the sign where noted.

** AutoScroll mode: Drag in the image, but allow the drag to go beyond the
window bound to initiate an autoscroll. Used for autodragging more image
into the window.Easily adapted to an Edit field I would think.

NOTE: Resize any smaller image window to be smaller than the image if the
scroll bars are not enabled at Image Open.

The include "Subs Image Files.Incl" is necessary for the Quicktime
image routines here. One can substitute a standard image loading routine
easily.

One can dispose of a GWorld manually using:
If GWorld Then DisposeGWorld(GWorld):GWorld = 0.

Otherwise they are cleared out at program end.

Robert Covington, Nov 2001.

*/

_scrollV        = 1
_scrollH        = 2
_pictScrollStep = 1
_scrollWndID    = 1

dim gFiltGW as ^CGrafPort, gWindowGW as ^CGrafPort
dim gImageRect        as rect

// RC Additions for This Demo :
_Autoscroll = 1// Mode flag
_MoveTool     = 0 // Mode flag
_arrowScrollStep = 4 // lil' bit faster this way.

DIM ScrollType as int

end globals



register on

include "Subs Image Files.Incl" // needed for this type of image import.

// Load an image directly into a GWorld, using QuickTime routines
local
dim as GraphicsImportComponent @ ci
dim as FSSpec                    myFileSpec
dim as ComponentResult           crslt
dim as OSErr                     err
local fn DrawImageToGWorld( fName as str31, wdRefNum, theGW as ptr )
'~'1
err = fn FSMakeFSSpec( wdRefNum, 0, fName, myFileSpec )
if err then stop "FSMakeFSSpec error"
crslt = fn GetGraphicsImporterForFile( myFileSpec, ci )
if crslt then stop "GetGraphicsImporterForFile error"
crslt = fn GraphicsImportSetGWorld( ci, theGW, 0 )
if crslt then stop "GraphicsImportSetGWorld error"
crslt = fn GraphicsImportDraw( ci )
if crslt then stop "GraphicsImportDraw error"
err = fn CloseComponent( ci )
end fn

local fn CopyGW2GW( srcGW as ^CGrafPort, srcR as ^rect, ¬
destGW as ^CGrafPort, destR as ^rect, cMode )
'~'1
long if ( fn LockPixels( fn GetGWorldPixMap( srcGW ) ) )
ForeColor( _blackColor )
BackColor( _whiteColor )
CopyBits( srcGW.portPixMap, destGW.portPixMap, #srcR, #destR, cMode, 0)
UnlockPixels( fn GetGWorldPixMap( srcGW ) )
end if
end fn


'~Scrolling

// AdjustScrollBars and DrawImageAtScrollBarPos work the scrolling of
// GWorld images bigger than window size
// See also HandleDialog

local fn AdjustScrollBars( theRect as ^rect, setHalfWay as boolean )
'~'1
dim as short   horzSize, vertSize
horzSize = (theRect.right - theRect.left - window(_width))/_pictScrollStep
if ( horzSize < 0 ) then horzSize = 0
vertSize = (theRect.bottom - theRect.top - window(_height))/_pictScrollStep
if ( vertSize < 0 ) then vertSize = 0
long if setHalfWay
scroll button _scrollV, vertSize/2,, vertSize, vertSize/8
// max and page of scroll bar
scroll button _scrollH, horzSize/2,, horzSize, horzSize/8
xelse
scroll button _scrollV,,, vertSize, vertSize/8
scroll button _scrollH,,, horzSize, horzSize/8
end if
end fn

// This method gives very fast smooth scrolling as thumb is dragged,
// even for huge images
local fn DrawImageAtScrollBarPos( theGWorld as ^CGrafPort )
'~'1
dim as short   vertPos, horzPos
dim as rect    srcRect, destRect
vertPos = button(_scrollV) * _pictScrollStep
horzPos = button(_scrollH) * _pictScrollStep
SetRect( destRect, 0, 0, window(_width), window(_height) )
srcRect = destRect
OffsetRect( srcRect, horzPos, vertPos )
fn CopyGW2GW( theGWorld, srcRect, gWindowGW, destRect, _srcCopy )
end fn


local fn HandleMenu
dim as short  menuNum, itemID
dim as long   ticks
menuNum = menu( 0 )
itemID  = menu( 1 )
select menuNum
case 1
end
case 3 // Scroll Action type
select itemID
case 1
ScrollType = _MoveTool
case 2
ScrollType = _Autoscroll
End select
Def Checkoneitem(3,itemId)
end select
menu
end fn

'~'2
'~Mouse Initiated Scroll Actions
'~'2
// RC: This enables mouse drag scroll actions.
// 2 modes here: Move Tool, or  Autoscroll by drag out of window bounds

Local FN HandleMouse
DIM pRect as Rect
DIM as short xlim,ylim,xDif,yDif
DIM as short vertPos ,horzPos
DIM pt as Point
DIM pt1 as point

pRect;8 = Window(_wndPointer) + _PortRect

// Account for Scroll bar dimensions in window rect.

pRect.right%  -= 15
pRect.bottom% -= 15

getmouse(pt) // initial mousedown
pt1 = pt

// Easily tightened up, this is for clarity...

Long if scrollType = _Autoscroll // Autoscroll going on now...
While FN Stilldown // Drag is going on...
getmouse(pt1) // new point
yDif = 0
xDif = 0
// Mouse in drag is below window area
Long if pt1.v% > pRect.bottom%
yDif = pt1.v% - pRect.bottom%
vertPos = button(_scrollV) * _pictScrollStep
scroll button _scrollV, vertPos  + yDif
fn DrawImageAtScrollBarPos( gFiltGW ) // redraw picture
End if
// Mouse in drag is above window area
Long if pt1.v% < pRect.top%
yDif = pt1.v% - pRect.top%
vertPos = button(_scrollV) * _pictScrollStep
scroll button _scrollV, vertPos  + yDif
fn DrawImageAtScrollBarPos( gFiltGW ) // redraw picture
End if
// Mouse in drag is to right of window area
Long if pt1.h% > pRect.right%
xDif = pt1.h% - pRect.right%
horzPos = button(_scrollH) * _pictScrollStep
scroll button _scrollH, horzPos  + xDif
fn DrawImageAtScrollBarPos( gFiltGW ) // redraw picture
End if
// Mouse in drag is to left of window area
Long if pt1.h% < pRect.left%
xDif = pt1.h% - pRect.left%
horzPos = button(_scrollH) * _pictScrollStep
scroll button _scrollH, horzPos  + xDif
fn DrawImageAtScrollBarPos( gFiltGW ) // redraw picture
End if
Wend
Xelse // MOVE TOOL type situation.
While FN Stilldown
getmouse(pt1) // new point
// Mouse in drag is below window area
Long if FN EqualPt(pt,pt1) = _False // moved? (nice Call , huh? :) )
vertPos = button(_scrollV) * _pictScrollStep
horzPos = button(_scrollH) * _pictScrollStep
// This is set for a Move Tool operation.
// use horzPos + , vertPos + for scroll button operation.
scroll button _scrollH, horzPos - (pt1.h%-pt.h%)
scroll button _scrollV, vertPos - (pt1.v%-pt.v%)
fn DrawImageAtScrollBarPos( gFiltGW ) // redraw picture
pt = pt1
end if
Wend
End if

end FN

'~'2
// RC: This handles arrow key scroll actions.
Local FN MoveThings(direction)
dim as short   vertPos, horzPos
vertPos = button(_scrollV) * _pictScrollStep
horzPos = button(_scrollH) * _pictScrollStep
Select direction
case 28 // Left
scroll button _scrollH, horzPos - _arrowScrollStep
case 29// Right
scroll button _scrollH, horzPos + _arrowScrollStep
case 30 // up
scroll button _scrollV, vertPos - _arrowScrollStep
case 31 // down
scroll button _scrollV, vertPos + _arrowScrollStep
End select
End FN

'~'2
'~'2

local fn HandleDialog
dim evnt, id, wndOut
evnt = dialog (0)
id   = dialog (evnt)
select evnt
case _wndClose
if ( id == _scrollWndID ) then end
case _wndClick
window id
case _wndRefresh
select id
case _scrollWndID
wndOut = window( _outputWnd )
window output _scrollWndID
fn DrawImageAtScrollBarPos( gFiltGW )
window output wndOut
end select
case _evKey // RC Addition
Long if id >= 28 and id <= 31 // arrow keys
FN MoveThings(id)
fn DrawImageAtScrollBarPos( gFiltGW )
End if
case _btnClick// click in scroll btn
fn DrawImageAtScrollBarPos( gFiltGW ) // redraw picture
case _preview
select case id
case _wndSized
if ( window (_activeWnd) == _scrollWndID ) then¬
 fn AdjustScrollBars(gImageRect, _false )
end select
end select
end fn


'~Main Program

dim as str31     fName
dim as short   @ wdRefnum
dim as handle  @ currDevice
dim as rect      wRect
dim as short     fits

on dialog fn HandleDialog
On Mouse  FN HandleMouse // RC Addition.

menu 1, 0, 1, "File"
menu 1, 1, 1, "Quit/Q"

// RC Addition
menu 3, 0, 1, "Scroll Type"
menu 3, 1, _CheckMark, "Move Tool Style"
menu 3, 2, 1, "Bounds Scroll Style"

on menu fn HandleMenu

ScrollType = _MoveTool // RC: Init Scroll mode.

fName = files$( _fOpen, "JPEGPICT", "", wdRefnum )
if ( fName[0] == 0 ) then end
SetRect( wRect,  0, 0, system( _scrnWidth ) - 25 - 15,¬
 system( _scrnHeight) - 50 - 15 )

// how big to make theGWorld
def GetImageFileRect( fName, wdRefnum, @gImageRect )

if ( wRect.bottom > gImageRect.bottom - gImageRect.top ) then ¬
 wRect.bottom= gImageRect.bottom
if ( wRect.right  > gImageRect.right - gImageRect.left ) then ¬
wRect.right= gImageRect.right

wRect.bottom += 15
wRect.right += 15

window _scrollWndID, fname, @wRect, _docZoom_KeepInBack
maxwindow wRect.right, wRect.bottom
setzoom _scrollWndID, @wRect

GetGWorld( gWindowGW, currDevice )

// RC: 4 bytes x H x W, 32 Bit GWorld in operation here.
dim system 4*1024*1024// or whatever your biggest image needs

if fn NewGWorld( gFiltGW,         32, gImageRect, 0, 0, 0 ) then stop
"NewGWorld error"

SetGWorld( gFiltGW, 0 ) // RC: Set to target GWorld
EraseRect( gFiltGW ) // RC: Clear out Image noise.
SetGWorld( gWindowGW, currDevice ) // RC: back to main window destination.

fn DrawImageToGWorld( fName, wdRefNum, gFiltGW ) // load image

scroll button _scrollV, 0,0,1,0,, _scrollVert
scroll button _scrollH, 0,0,1,0,, _scrollHorz

fn AdjustScrollBars( gImageRect, _False )//_zTrue // centre a large image
//with scroll bars half-way

do
HandleEvents
until 0