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 )