[futurebasic] Paint or draw field

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : October 2009 : Group Archive : Group : All Groups

From: Ken Shmidheiser <kshmidheiser@...>
Date: Sat, 24 Oct 2009 08:47:12 -0400
Slow morning.

// Requires FB 5.4.1 or later

output file "Window Artist"

include "Tlbx MacApplication.incl"

_mainWnd = 1
_toolWnd = 2

_fileMenu  = 1
_resetMenu = 1
_printMenu = 3

begin enum
_colorPop = 1
end enum

local fn BuildMenus
'~'1
apple menu "About Window Artist"
menu _fileMenu, 0, _enable,  "File"
menu _fileMenu, _resetMenu, _enable, "Reset/R"
menu _fileMenu, 2, _disable, "-"
menu _fileMenu, _printMenu, _enable, "Print.../P"

end fn

local fn BuildPopMenu( id as Long )
'~'1
dim as MenuRef  mRef
dim as Str255   s

Menu id, 0, _enable, ""
s = "Black;Yellow;Green;Cyan;Blue;Magenta;Red"
Menu id, 1, _enable, s
mRef = fn GetMenuHandle( id )
DeleteMenu( id )
InsertMenu( mRef, -1 )

end fn

local fn BuildHIAboutBox
'~'1
dim as CFStringRef      keys(2), values(2)
dim as CFDictionaryRef  dict

keys(0)   = fn CFSTR( "HIAboutBoxName" )
values(0) = fn CFSTR( "Window Artist" )

keys(1)   = fn CFSTR( "HIAboutBoxVersion" )
values(1) = fn CFSTR( "Version 0.1" )

keys(2)   = fn CFSTR( "HIAboutBoxCopyright" )
values(2) = fn CFSTR( "© 2009 Ken Shmidheiser" )

dict = fn CFDictionaryCreate( 0, @keys(0), 
@values(0), 3, 
@kCFCopyStringDictionaryKeyCallBacks, 0 )
fn HIAboutBox( dict )
CFRelease( dict )

end fn

local fn BuildMainWindow
'~'1
dim as WindowAttributes  wa
dim as Rect r

wa = _kWindowCloseBoxAttribute¬
      _kWindowCollapseBoxAttribute

SetRect( r, 0, 0, 600, 400  )
Appearance Window -_mainWnd, "Window Artist", @r, _kDocumentWindowClass, wa
Color = _zBlack
PenSize( 2, 2 )

end fn

local fn BuildToolWindow
'~'1
dim as WindowAttributes    wa
dim as Rect                r
dim as Boolean           @ bool : bool = _true

wa = _kWindowToolbarButtonAttribute

SetRect( @r, 20, 60, 280, 140 )
Appearance Window -_toolWnd,¬
                   "Artist Tools", @r,¬
                   _kDocumentWindowClass, wa
fn SetWindowBackground( _kThemeActiveDialogBackgroundBrush, _false )


SetRect( @r, 20, 18, 240, 38 )
Appearance Button _colorPop,¬
                   ,, 101, -1,¬
                   "Select a pen color:", @r,¬
                   _kControlPopupButtonProc

end fn

local fn PollMouseScribble
'~'1
dim as Point mPt
begin globals
dim as Point sPrevPt
end globals

PenSize( 8, 8 )

long if ( fn Button )
GetMouse( @mPt )
long if ( sPrevPt.h% != _minInt )
plot sPrevPt.h%, sPrevPt.v% to mPt.h%, mPt.v%
end if
sPrevPt = mPt
xelse
sPrevPt.h% = _minInt
end if

end fn

local fn PrintWindow( whichWindow as Long )
'~'1
dim as Rect    r
dim as Pointer rgn, pict

Window whichWindow
SetRect( r, 0, 0, Window( _width ) - 1, Window( _height) - 1 )
rgn = fn NewRgn
GetClip( rgn )
ClipRect( r )
pict = fn GetPict( r)
long if ( pict )
Def Page
long if ( prcancel == _false )
Def LPrint
long if ( prcancel == _false )
Route _toPrinter
DrawPicture (  pict, r )
Route _toScreen
Close LPrint
end if
end if
KillPicture( pict )
xelse
stop "GetPict error"
end if
SetClip( rgn )
DisposeRgn( rgn )

end fn

local fn DoPopup( menuID as long )
'~'1
dim as Long     mItem
dim as Str255   txtStr
dim as MenuRef  mRef
dim as Long     outWnd

mItem = button( menuID )
mRef  = button( menuID, _FBgetControlMenuHandle )
call GetMenuItemText( mRef, mItem, @txtStr )

outWnd = window( _mainWnd )
window output _mainWnd
select case ( txtStr )
case "Black"  : Color = _zBlack
case "Yellow" : Color = _zYellow
case "Green"  : Color = _zGreen
case "Cyan"   : Color = _zCyan
case "Blue"   : Color = _zBlue
case "Magenta": Color = _zMagenta
case "Red"    : Color = _zRed
end select

if outWnd then window output outWnd

end fn

local fn DoDialog
'~'1
dim as Long evnt, id

evnt = Dialog( 0 )
id   = Dialog( evnt )

select case ( evnt )
case _wndClose
select id
case _mainWnd : gFBQuit = _zTrue
end select

case _btnClick
select id
case _colorPop : fn DoPopup( _colorPop )
end select

case _wndclick
select id
long if ( id == _mainWnd )
cursor _kThemeCrossCursor, _themeCursorStatic
xelse
cursor _kThemeArrowCursor, _themeCursorStatic
end if
end select

case _cursOverBtn
cursor _kThemeArrowCursor, _themeCursorStatic

end select

Window Output _mainWnd

end fn

local fn DoMenu
'~'1
dim as Long  menuID, itemID

menuID = menu( _menuID )
itemID = menu( _itemID )

select menuID
case _appleMenu : fn BuildHIAboutBox
case 1
select itemID
case _resetMenu : window output _mainWnd : cls
case _printMenu : fn PrintWindow( _mainWnd )
end select
end select
menu

end fn

on dialog fn DoDialog
on menu   fn DoMenu

fn BuildMenus
fn BuildPopMenu( 101 )
fn BuildMainWindow
fn BuildToolWindow
window _mainWnd
window _toolWnd
window output _mainWnd

poke long event - 8, 0
do
HandleEvents
fn PollMouseScribble
until ( gFBQuit )