frame.zc

实现树形结构

	title (m) = new string (empty string)
	is dialog (m) = false
	running (m) = true
	parent frame (m) = parent: frame box
	parent proc (m) = ^ DefWindowProcA (HWND, UINT, WPARAM ,LPARAM )

	create window ex (
		m,
		0,
		frame box class name,
		title(m),
		get style (m),
		use default,
		use default,
		use default,
		use default,
		(not nil (parent) -> hwnd (parent), nil),
		NULL: HMENU,
		hinstance,
		nil)
	
	// set icon
	def hicon = hicon (m)
	while is nil (hicon) && not nil (parent)
		hicon = hicon (parent: frame box)
		parent = parent frame (parent: frame box)
	end
	send message (
		m, 
		WM_SETICON, 
		ICON_BIG : WPARAM, 
		hicon : LPARAM)

end
//[cf]
//[c]
//[of]:actual release
public func actual release (m: frame box)

	delete (title (m))
	if not nil (menu (m))
		delete (menu (m))
	end

	actual release (super (m))

end
//[cf]
//[of]:actual compute min size
public func actual compute min size (m: frame box)

	def rect: local LPRECT
	left (rect) = 0
	top (rect) = 0
	right (rect) = 100
	bottom (rect) = 100
	
	def first child = first child (m)
	if not nil (first child)
		right (rect) = min width (first child)
		bottom (rect) = min height (first child)
	end

	def has menu = not nil (menu (m)):BOOL
	AdjustWindowRect (rect, get style (m), has menu)
	set min size(m, width (rect), height (rect))

end
//[cf]
//[of]:actual adjust
public func actual adjust (m: frame box)
	
	def rect : local LPRECT
	GetWindowRect (hwnd (m), rect)

	if width (rect) < min width (m) | height (rect) < min height (m)
		def r := rectangle (client rect (m))
		left (r) = left (rect)
		top (r) = top (rect)
		width (r) = max (width (rect), min width (m))
		height (r) = max (height (rect), min height (m))
		move (m, r)
	elsif not nil (first child (m))
		move (first child (m), client rect (m))	
	end

end
//[cf]
//[c]
//[of]:handle focus (event)
public func handle focus (m: frame box, e: event)

	if not nil (active (m))
		// restore focus
		set focus (active (m))
	else
		// first focus
		transfer focus (m, false)
	end
	return true

end
//[cf]
//[of]:handle child event (child, event)
public func handle child event (m: frame box, src: box, evt: event)

	def t = type (evt)

	if t == focus event type
		active (m) = src

	elsif t == key down event type
		equ e = evt : key event
		if key (e) == VK TAB
			transfer focus (active (m), (status (e) & SHIFT)<>0)
			return true
		end
		
	elsif t == destroy event type
		if src == active (m)
			active (m) = nil
		end
	
	end

	return handle child event (super (m), src, evt)

end
//[cf]
//[of]:handle activation (activated)
public func handle activation (m: frame box, activated: bool)
	// empty
end
//[cf]
//[of]:handle message (string)
public func handle message (m: frame box, s: string)
	// empty
end
//[cf]
//[of]:handle close
public func handle close (m: frame box)

	// by default: accept close
	return false

end
//[cf]
//[cf]
//[of]:private
//[of]:constants
//[c]
private def frame box class name := "zc-frame"
//[c]
private equ use default = CW_USEDEFAULT
//[cf]
//[c]
//[of]:class
//[c]
private equ class (m: frame box) = 
	class (super (m)) : frame box class
//[cf]
//[of]:translate accelerator (msg)
//[c]
private func translate accelerator (f: frame box, msg: LPMSG)

	if (
		message (msg) <> WM_KEYDOWN && 
		message (msg) <> WM_SYSKEYDOWN )
		return false
	end

	def status = get key flags
	def key = wParam (msg): int

	return scan menu (menu (f), status : byte, key)

end
//[c]
private func scan menu (menu: menu, flags: byte, key: int): bool

	if is nil (menu)
		return false
	end

	each (menu) ? child
		if is menu (child)
			def processed = scan menu (child: menu, flags, key)
			if processed
				return processed
			end
		elsif ~ is separator (child)
			equ menu item = child : menu item
			def cmd = cmd (menu item)
			if match (accelerator (cmd), flags, key)
				run (cmd)
				return true
			end
		end
	end

	return false

end
//[cf]
//[of]:on activation (activated)
//[c]
private func on activation (m: frame box, activated: bool)
	on activation (class (m)) {m, activated}
end
//[cf]
//[of]:on close
//[c]
private func on close (m: frame box)
	return on close (class (m)) {m}
end
//[cf]
//[of]:on message (string)
private func on message (m: frame box, s: string)
	on message (class (m)) {m, s}
end
//[cf]
//[of]:get style
//[c]
private func get style (m: frame box)

	if is dialog (m)
		/*return WS_OVERLAPPED | 
			WS_CLIPSIBLINGS |
			WS_CLIPCHILDREN |
			WS_CAPTION |
			WS_THICKFRAME |
			WS_POPUPWINDOW  |
			WS_DLGFRAME*/
		return (WS_OVERLAPPEDWINDOW | WS_CLIPCHILDREN) & 
			~ (WS_MINIMIZEBOX | WS_MAXIMIZEBOX)
	else	
		return WS_OVERLAPPEDWINDOW | WS_CLIPCHILDREN
	end

end
//[cf]
//[c]
//[of]:wm destroy
//[c]Handle WM_DESTROY
//[c]
//[c]Post a message to exit from the message loop. 
//[c]Set a flag to prevent reassigning focus while destroying window
//[c]and re-opening windows.
//[c]
public func wm destroy (m: frame box, msg: UINT, wParam: WPARAM, lParam: LPARAM)

	PostQuitMessage (0)
	running (m) = false
	return 0

end
//[cf]
//[of]:wm close
//[c]Handle WM_CLOSE
//[c]
private func wm close (m: frame box, msg: UINT, wParam: WPARAM, lParam: LPARAM)

	// Activate the parent before destroying window
	// Otherwise another window could be activated
	// and it would result flicking.
	if not nil (parent frame (m))
		enable (parent frame (m))
		SetActiveWindow (hwnd (parent frame (m)))
	end

	if ~ on close (m)
		// by default, destroy the window
		default window proc (m, WM_CLOSE, 0, 0)
	end
	return 0

end
//[cf]
//[of]:wm activate
//[c]Handle WM_DELAY_ACTIVATE
//[c]
private func wm activate (m: frame box, msg: UINT, wParam: WPARAM, lParam: LPARAM)

	// custom code can be executed now
	def active  = (LOWORD (wParam) <> 0:word)
	on activation (m, active)
	return 0

end
//[cf]
//[of]:wm copy data
//[c]
private func wm copy data (m: frame box, msg: UINT, wParam: WPARAM, lParam: LPARAM)

	equ data = lParam:PCOPYDATASTRUCT
	def message = new string (lpData (data): string, cbData (data))
	on message (m, message)
	delete (message)

	return 0

end
//[cf]
//[cf]
//[cf]
//[of]:frame box class
//[of]:type
public struct frame box class : local box class
	on close : {box} bool
	on activation : {box, bool} void
	on message: {box, string} void
end
//[cf]
//[of]:frame box class
public func frame box class

	def c = the frame box class
	if ~ initialized
		initialized = true
		c . copy (box class)
		c . mem size = sizeof local frame box class
		c . release = ^actual release (frame box)
		c . compute min size = ^actual compute min size (frame box)
		c . adjust = ^actual adjust (frame box)
		c . on size = ^handle single child size (box)
		c . on focus = ^handle focus (frame box, event)
		c . on child event = ^handle child event (frame box, box, event)
		c . on close = ^handle close (frame box)
		c . on message = ^handle message (frame box, string)
		c . on activation = ^handle activation (frame box, bool)

		c . wm size = ^wm size (box, UINT, WPARAM, LPARAM)
		c . wm command = ^wm command (box, UINT, WPARAM, LPARAM)
		c . wm notify = ^wm notify (box, UINT, WPARAM, LPARAM)
		c . wm close = ^wm close (frame box, UINT, WPARAM, LPARAM)
		c . wm activate = ^wm activate (frame box, UINT, WPARAM, LPARAM)
		c . wm copy data = ^wm copy data (frame box, UINT, WPARAM, LPARAM)
		c . wm destroy = ^wm destroy (frame box, UINT, WPARAM, LPARAM)
	
		def wc: local WNDCLASSA
		wc . hInstance = hinstance
		wc . hIcon = nil
		wc . hCursor = LoadCursorA (nil, IDC_ARROW)
		wc . style = 0
		wc . lpfnWndProc = ^ route window proc (HWND, UINT, WPARAM, LPARAM)
		wc . cbClsExtra = 0
		wc . cbWndExtra = 0
		wc . hbrBackground = nil
		wc . lpszMenuName = nil
		wc . lpszClassName = frame box class name
		wc . RegisterClassA
	end
	return c

end

private def initialized = false
private def the frame box class: local frame box class
//[cf]
//[cf]