Yoshiyuki Hasegawa a e'crit :
> Hi all,
> 
> Please teach the change in the code from which the image file is 
> compulsorily saved to desktop by the test code below.
> 

Yoshiyuki,

I'm not totally clear on what you are asking for, I just guess that you
try to find the Desktop folder since your code seems to work OK at my
side. Find below a slight modification of your program in order to make
the picture files land in that folder.

toolbox fn CreateNewPort() = CGrafPtr
toolbox DisposePort( CGrafPtr port )

#define GraphicsExportComponent as ComponentInstance

begin globals
dim as CGrafPtr @ myGW
end globals

//format = _"PICT" _"TIFF" _"JPEG" _"GIFf" _"PNGf" etc
local mode
local fn WriteGWorldToImageFile( gw as CGrafPtr, f as ^FSSpec, format as
OSType )
'~'1
dim as GraphicsExportComponent @ ge
dim as ComponentResult err

err = fn OpenADefaultComponent( _"grex", format, @ge )
long if ( err == _noErr )
err = fn GraphicsExportSetInputGWorld( ge, gw )
if ( err == _noErr ) then err = fn GraphicsExportSetOutputFile( ge, #f )
if ( err == _noErr ) then err = fn GraphicsExportDoExport( ge, #_nil )
call CloseComponent( ge )
end if
end fn = err

local fn CopyScreenToPort( r as ^Rect )
'~'1
dim as Rect @ theRect
dim as CGrafPtr globalPort, @ savePort

GetPort( @savePort )
globalPort = fn CreateNewPort()

theRect = r

SetPort( myGW )
CopyBits( # fn GetPortBitMapForCopyBits( globalPort ), ¬
# fn GetPortBitMapForCopyBits( myGW ), theRect, theRect, _srcCopy, 0 )
SetPort( savePort )
DisposePort( globalPort )
end fn

Local Fn GetSpecialFolder( type As Long, f as .FSSpec )
'~'9
Dim where      As Long
Dim err        As Short
Dim @ DirID    As Long
Dim @ vRefNum  As Short
Dim @ response As Long



where = _kOnSystemDisk
err = Fn Gestalt( _gestaltFindFolderAttr, response )
Long If err == _noErr
Long If response And (1 << _gestaltFolderMgrSupportsDomains)
where = _kUserDomain
Xelse
If response And (1 << _gestaltFolderMgrSupportsExtendedCalls)¬
  Then where = _kOnAppropriateDisk
End If
End If

err = Fn FindFolder( where, type, _kDontCreateFolder, vRefNum, DirID )

Long If err = _noErr
f.vRefnum = vRefNum
f.parId = DirID
Xelse
Stop "Unable to find that folder. error #" + Str$( err )
End If

End Fn

local fn SnapScreen( r as ^Rect )
'~'1
dim as Rect @ screenR

screenR = r

long if ( fn NewGWorld( @myGW, 8, screenR, 0, 0, 0 ) != _noErr )
stop "NewGWorld error"
end if

fn CopyScreenToPort( screenR )
end fn

local fn SaveSnap( Name$ as Str255 )
'~'1
dim as FSSpec f
Fn GetSpecialFolder( _kDesktopFolderType, f )

f.name = Name$ + ".png"

long if ( fn WriteGWorldToImageFile( myGW, f, _"PNGf" ) != _noErr )
stop "WriteGWorldToImageFile error"
end if

DisposeGWorld( myGW )
end fn

local fn BuildSnapWnd
dim as Rect r

SetRect(r, 0, 0, 200, 200)
appearance window -1, "Snap Window", @r, _kDocumentWindowClass

SetRect(r, 50, 90, 150, 110)
button 1, _activeBtn, "Snap Shot", @r, _push

appearance window 1
end fn

local fn BuildApplyNameWnd
dim as Rect r

SetRect(r, 0, 0, 300, 200)
appearance window -2, "Name Wnd", @r, _kDocumentWindowClass

SetRect(r, 20, 20, 250, 36)
appearance button 11, _activeBtn,,,,, @r, _kControlStaticTextProc
def SetButtonTextString(11, "Apply the name to this image.")

SetRect(r, 23, 47, 277, 63)
appearance button 21, _activeBtn,,,,, @r, _kControlEditTextProc
def SetButtonTextString(21, "Snap1")
def SetButtonFocus(21)

SetRect(r, 210, 160, 280, 180)
button 1, _activeBtn, "OK", @r, _push

SetRect(r, 120, 160, 190, 180)
button 2, _activeBtn, "Cancel", @r, _push

appearance window 2
end fn

local fn DoDialog
dim as Rect r
dim as long ev, id
dim as Str255 Name$
'~'<
ev = dialog(0)
id = dialog(ev)
select ev
case _btnClick
select window(_outputWnd)
case 1
select id
case 1
call GetWindowBounds( window(_wndRef), _kWindowStructureRgn, @r )
fn SnapScreen( r )
fn BuildApplyNameWnd
end select
case 2
select id
case 1
Name$ = fn ButtonTextString$ (21)
fn SaveSnap( Name$ )
end
case 2
DisposeGWorld( myGW )
end
end select
end select
end select
end fn

fn BuildSnapWnd

on dialog fn DoDialog

do
HandleEvents
until gFBQuit


Alain