box.zc

来自「实现树形结构」· ZC 代码 · 共 2,624 行 · 第 1/4 页

//[of]:description
//[c]The base object for the user interface
//[cf]
//[of]:license
//[c]Code Browser - a folding text editor for programmers
//[c]Copyright (C) 2003-07 Marc Kerbiquet
//[c]
//[c]This program is free software; you can redistribute it and/or modify
//[c]it under the terms of the GNU General Public License as published by
//[c]the Free Software Foundation; either version 2 of the License, or
//[c](at your option) any later version.
//[c]
//[c]This program is distributed in the hope that it will be useful,
//[c]but WITHOUT ANY WARRANTY; without even the implied warranty of
//[c]MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
//[c]GNU General Public License for more details.
//[c]
//[c]You should have received a copy of the GNU General Public License
//[c]along with this program; if not, write to the Free Software
//[c]Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
//[cf]
//[of]:imports
import "base/types"
import "base/memory"
import "base/memory-allocator"
import "collection/linked-collection"
import "text/string"
import "text/string-buffer"
//[c]
import "graphics/geometry"
import "graphics/graphics"
import "toolbox/clipboard"
import "toolbox/timer"
import "user/keyboard"
import "user/command"
//[c]
import "win32/windows"
import "win32/winerror"
import "win32/commctrl"
import "private/sys-graphics"
import "private/sys-command"
//[cf]
//[c]
//[of]:win32
//[of]:description
//[c]This part contains win32 specific code.
//[c]
//[c]The definitions of this part must only be used by the win32 specific
//[c]components.
//[cf]
//[of]:sys box class
private typedef proc = {->void, UINT, WPARAM, LPARAM} LRESULT
//[c]
public struct sys box class

	// first level: entry point
	window proc: proc

	// second level: message type decoded
	wm create: proc
	wm destroy: proc
	wm command: proc
	wm notify: proc
	wm size: proc
	wm paint: proc
	wm close: proc
	wm hscroll: proc
	wm vscroll: proc
	wm set cursor: proc
	wm activate: proc
	wm key down: proc
	wm key up: proc
	wm char: proc
	wm copy data: proc

	// third level: arguments decoded
	command: {object, WORD} void
	notify: {object, LPNMHDR} LRESULT
	hscroll: {object, int, int} bool
	vscroll: {object, int, int} bool
	
	move: {box, rectangle, bool} void
	set read only: {box, bool} void
	set enable: {box, bool} void
	                    
end
//[c]
//[cf]
//[of]:sys box
//[of]:type
public struct sys box

	// Handle to window 
	hwnd: HWND
	
	// parent procedure
	parent proc: WNDPROC

	// cursor for this window	
	cursor: object

	visible: bool
	read only: bool
	enabled: bool
	accept drop files: bool
	last key event processed: bool

end
//[cf]
//[c]
//[of]:send messages
//[of]:send message (msg, wparam, lparam)
public func send message (box: box, msg: UINT, wParam: WPARAM, lParam: LPARAM)
	return SendMessageA (hwnd (box), msg, wParam, lParam)
end
//[cf]
//[of]:send message (msg, wParam)
public func send message (box: box, msg: UINT, wParam: WPARAM)
	return send message (box, msg, wParam, 0:LPARAM)
end
//[cf]
//[of]:send message (msg)
public func send message (box: box, msg: UINT)
	return send message (box, msg, 0:WPARAM, 0:LPARAM)
end
//[cf]
//[cf]
//[of]:create window
//[of]:create managed window ex (...)
//[c]
public func create managed window ex (
		m: box, 
		dwExStyle: DWORD,
		lpClassName: LPCTSTR,
		lpWindowName: LPCTSTR,
		dwStyle: DWORD,
		hMenu: HMENU,
		lpParam: LPVOID)

	def hwnd = create window ex(
		m,
		dwExStyle,
		lpClassName,
		lpWindowName,
		dwStyle,
		hMenu,
		lpParam)
	
	parent proc (m) = GetWindowLongA (hwnd, GWL_WNDPROC):WNDPROC
	SetWindowLongA (hwnd, GWL_WNDPROC, ^route window proc (HWND, UINT, WPARAM, LPARAM):LONG)
	return hwnd

end
//[cf]
//[of]:create window ex (...)
//[c]
public func create window ex (
		m: box,
		dwExStyle: DWORD,
		lpClassName: LPCTSTR,
		lpWindowName: LPCTSTR,
		dwStyle: DWORD,
		hMenu: HMENU,
		lpParam: LPVOID)

	def parent = parent (m)
	def hwnd parent = nil:HWND
	if not nil (parent)
		hwnd parent = hwnd (parent)
	end
	
	return create window ex(
		m,
		dwExStyle,
		lpClassName,
		lpWindowName,
		dwStyle,
		CW_USEDEFAULT,
		CW_USEDEFAULT,
		CW_USEDEFAULT,
		CW_USEDEFAULT,
		hwnd parent,
		hMenu,
		hinstance,
		lpParam)

end
//[cf]
//[of]:create window ex (...)
//[c]
public func create window ex (
		m: box, 
		dwExStyle: DWORD,
		lpClassName: LPCTSTR,
		lpWindowName: LPCTSTR,
		dwStyle: DWORD,
		x: int,
		y: int,
		nWidth: int,
		nHeight: int,
		hWndParent: HWND,
		hMenu: HMENU,
		hInstance: HINSTANCE,
		lpParam: LPVOID)

	// set global boc being created to self
	def old = box being created
	box being created = m

	def hwnd = CreateWindowExA (
		dwExStyle,
		lpClassName,
		lpWindowName,
		dwStyle,
		x,
		y,
		nWidth,
		nHeight,
		hWndParent,
		hMenu,
		hInstance,
		lpParam)

	hwnd (m) = hwnd
	
	// the user data should be set when invoking
	// the first time the RouteWndProc, but controls
	// that does not invoke this procedure need
	// to update user data now.
	SetWindowLongA (hwnd, GWL_USERDATA, m:LONG)
	
	// restore previous state
	box being created = old

	return hwnd

end
//[cf]
//[c]
//[of]:route window proc (hwnd, msg, wparam, lparam)
//[c]All windows events for all widget classes arrive here.
//[c]
public [call="__stdcall"] func route window proc (
	hwnd: HWND, 
	msg: UINT, 
	wParam: WPARAM, 
	lParam: LPARAM)
						
	// Redirect the WindowProc messages

	def m = box from hwnd (hwnd)
	
	if is nil (m)
		SetWindowLongA (hwnd, GWL_USERDATA, box being created:LONG)
		if is nil (box being created)
			return 0
		end
		m = box being created
		hwnd (m) = hwnd
	end
	
	return window proc (class (m)) {m, msg, wParam, lParam}
end
//[cf]
//[cf]
//[of]:catch events
//[of]:actual command (notify code)
public func actual command (b: box, wNotifyCode: WORD)
end
//[cf]
//[of]:actual notify (pnmh)
//[c]
public func actual notify (b: box, pnmh: LPNMHDR) : int

	// in some case the notification is sent to the wrong control
	// e.g. notebook sent notif to parent but with 'from' as
	// child page
	// to fix that (we want the notebook receives the event),
	// the notif is propagated trough parents

	def parent = parent (b)
	if is nil (parent)
		return 0
	else
		return notify (class (parent)) {parent, pnmh}
	end

end
//[cf]
//[of]:actual create (msg, wParam, lParam)
//[c]The control is beeing activated
//[c]
public func actual create (m: box, msg:UINT, wParam: WPARAM, lParam: LPARAM)

	if accept drop files (m)
		DragAcceptFiles (hwnd (m), 1)
	end
	return default window proc (m, WM_CREATE, wParam, lParam)

end
//[cf]
//[of]:ignore scroll (int, int)
//[c]Default handling for hscroll and vscroll
//[c]
public func ignore scroll (m: box, code: int, pos: int)
	return false
end
//[cf]
//[cf]
//[of]:window procedures
//[of]:default window proc
//[c]Default procedures
//[c]
public func default window proc (m: box, message: UINT, wParam: WPARAM, lParam: LPARAM)

	return CallWindowProcA (
		parent proc (m), 
		hwnd (m), 
		message, 
		wParam, 
		lParam)
	
end
//[cf]
//[c]
//[of]:wm key down
//[c]Standard key-down procedure
//[c]
public func wm key down (m: box, msg: UINT, wParam: WPARAM, lParam: LPARAM)

	def processed = on key down (m, key event (key down event type, wParam: int, get key flags))
	last key event processed (m) = processed
	if processed
		return 0
	end
	
	return default window proc (m, msg, wParam, lParam)

end
//[cf]
//[of]:wm key up
//[c]Standard key-up procedure
//[c]
public func wm key up (m: box, msg: UINT, wParam: WPARAM, lParam: LPARAM)

	if on key up (m, key event (key up event type, wParam: int, get key flags))
		return 0
	end

	return default window proc (m, msg, wParam, lParam)

end
//[cf]
//[of]:wm char
//[c]Standard char  procedure
//[c]
public func wm char (m: box, msg: UINT, wParam: WPARAM, lParam: LPARAM)

	if last key event processed (m)
		last key event processed (m) = false
		return 0
	end

	if on char (m, char event (wParam: TCHAR, get key flags))
		return 0
	end
	
	return default window proc (m, msg, wParam, lParam)

end
//[cf]
//[of]:wm size
//[c]Standard size procedure
//[c]- replicate the window's size into the box's size
//[c]- send notification
//[c]
public func wm size (m: box, msg: UINT, wParam: WPARAM, lParam: LPARAM)

	// compare with current size
	def r = client rect (m)
	def w = LOWORD (lParam) : int
	def h = HIWORD (lParam) : int
	if w (r) <> w || h (r) <> h

		// replicate the window's size into the box's size
		left (r) = 0
		top (r) = 0
		width (r) = w
		height (r) = h
		
		// send notification
		on size (m)

		// on size has been invoked, no need to invoke
		// adjust () anymore
		valid size (m) = true
	end

	return default window proc (m, msg, wParam, lParam)

end
//[cf]
//[of]:wm command
//[c]Standard command procedure
//[c]
public func wm command (m: box, msg: UINT, wParam: WPARAM, lParam: LPARAM)

	def hwnd src = lParam : HWND
	if not nil (hwnd src)
		def t = box from hwnd (hwnd src)
		if not nil (t)
			// widget command: send the command 
			// back to the child
			command (class (t)) {t, HIWORD (wParam)}
		end
	else
		// it is a menu command
		def cmd = system command from id (LOWORD (wParam)):command
		if not nil (cmd)
			run (cmd)
		end
	end

	return 0

end
//[cf]
//[of]:wm notify
//[c]Standard notify procedure
//[c]
public func wm notify (m: box, msg: UINT, wParam: WPARAM, lParam: LPARAM)

	def pnmh = lParam:LPNMHDR
	def hwndFrom = hwndFrom (pnmh)
	def receiver = box from hwnd (hwndFrom)

	// The notification can be emitted by a non managed child control.
	// For instance the scroll buttons in the tab bar of a notebook.
	if is nil (receiver)
		return 0
	end

	return notify (class (receiver)) {receiver, pnmh}

end
//[cf]
//[of]:wm hscroll
//[c]
public func wm hscroll (m: box, msg: UINT, wParam: WPARAM, lParam: LPARAM)

	def hwnd src = lParam : HWND
	if not nil (hwnd src)
		def t = box from hwnd (hwnd src)
		if not nil (t)
			def code = LOWORD (wParam) : int
			def pos = HIWORD (wParam) : int
			if hscroll (class (t)) {t, code, pos}
				return 0
			end
		end
	end
	return default window proc (m, msg, wParam, lParam)
	
end
//[cf]
//[of]:wm vscroll
//[c]
public func wm vscroll (m: box, msg: UINT, wParam: WPARAM, lParam: LPARAM)

	def hwnd src = lParam : HWND
	if not nil (hwnd src)
		def t = box from hwnd (hwnd src)
		if not nil (t)
			def code = LOWORD (wParam) : int
			def pos = HIWORD (wParam) : int
			if vscroll (class (t)) {t, code, pos}
				return 0
			end
		end
	end
	return default window proc (m, msg, wParam, lParam)
	
end
//[cf]
//[of]:wm set cursor
//[c]
public func wm set cursor (m: box, msg: UINT, wParam: WPARAM, lParam: LPARAM)

	def c = cursor (m) : cursor
	if not nil (c)
		SetCursor (hCursor (c))
		return TRUE
	end

	return default window proc (m, msg, wParam, lParam)
	
end
//[cf]
//[c]
//[of]:window proc
//[c]All windows events for all widget classes arrive here.
//[c]
private equ WM_DELAY_ACTIVATE = WM_USER+1
//[c]
public func window proc (m: box, msg: UINT, wParam: WPARAM, lParam: LPARAM)
						
	switch msg
	case WM_CREATE
		return wm create (class (m)) {m, msg, wParam, lParam}
	case WM_DESTROY
		return wm destroy (class (m)) {m, msg, wParam, lParam}
	case WM_SIZE
		return wm size (class (m)) {m, msg, wParam, lParam}
	case WM_COMMAND
		return wm command (class (m)) {m, msg, wParam, lParam}
	case WM_PAINT
		return wm paint (class (m)) {m, msg, wParam, lParam}
	case WM_CLOSE
		return wm close (class (m)) {m, msg, wParam, lParam}
	case WM_NOTIFY
		return wm notify (class (m)) {m, msg, wParam, lParam}
	case WM_HSCROLL
		return wm hscroll (class (m)) {m, msg, wParam, lParam}
	case WM_VSCROLL
		return wm vscroll (class (m)) {m, msg, wParam, lParam}
	case WM_SETCURSOR
		return wm set cursor (class (m)) {m, msg, wParam, lParam}
	case WM_DELAY_ACTIVATE
		return wm activate (class (m)) {m, msg, wParam, lParam}
	case WM_KEYDOWN, WM_SYSKEYDOWN
		return wm key down (class (m)) {m, msg, wParam, lParam}
	case WM_KEYUP, WM_SYSKEYUP
		return wm key up (class (m)) {m, msg, wParam, lParam}
	case WM_CHAR, WM_SYSCHAR
		return wm char (class (m)) {m, msg, wParam, lParam}
	case WM_COPYDATA
		return wm copy data (class (m)) {m, msg, wParam, lParam}

//[of]:	WM_SETFOCUS
	case WM_SETFOCUS
		if on focus (m)
			return 0
		end
//[cf]
//[of]:	WM_KILLFOCUS
	case WM_KILLFOCUS
		if on blur (m)
			return 0
		end
//[cf]
//[of]:	WM_ENTERMENULOOP
	case WM_ENTERMENULOOP
		def active box = get focus box
		if not nil (active box)
			on enter menu (active box)
		end
//[cf]
//[of]:	WM_EXITMENULOOP
	case WM_EXITMENULOOP
		def active box = get focus box
		if not nil (active box)
			on leave menu (active box)
		end
//[cf]
//[of]:	WM_CUT
	case WM_CUT	
	
		cut (m)
  		return 0
//[cf]
//[of]:	WM_COPY
	case WM_COPY

		def copied = copy (m)
		
		// The edit control seems to expect the number of char copied
		// in clipboard (>0 value seems sufficient)
		if copied
			return 1
		else
			return 0
		end
//[cf]
//[of]:	WM_PASTE
	case WM_PASTE

		paste (m)
  		return 0
//[cf]
//[of]:	WM_CLEAR
	case WM_CLEAR

		clear (m)
		return 0
//[cf]
//[c]
//[of]:	WM_MOUSEMOVE
	case WM_MOUSEMOVE
		def e: local mouse move event
		type (e) = mouse move event type
		status (e) = get key flags
		x (position (e)) = LOWORD (lParam) : short : int
		y (position (e)) = HIWORD (lParam) : short : int
		if on mouse move (m, e)
			return 0
		end
//[cf]
//[of]:	WM_MOUSEWHEEL
	case WM_MOUSEWHEEL
		def e: local mouse wheel event
		type (e) = mouse wheel event type
		status (e) = get key flags
		x (position (e)) = LOWORD (lParam) : short : int
		y (position (e)) = HIWORD (lParam) : short : int
		delta (e) = HIWORD (wParam) : short : int / 120
		if on mouse wheel (m, e)
			return 0
		end
//[cf]
//[of]:	WM_CANCELMODE
	case WM_CANCELMODE
		def active box = get focus box
		if not nil (active box)
			if on mouse cancel (active box)
				return 0
			end
		end
//[cf]
//[of]:	WM_LBUTTONDOWN
	case WM_LBUTTONDOWN
		def e: local mouse button event
		type (e) = mouse down event type
		button (e) = left mouse button
		status (e) = get key flags
		x (position (e)) = LOWORD (lParam) : short : int
		y (position (e)) = HIWORD (lParam) : short : int
		if on mouse down (m, e)
			return 0
		end
//[cf]
//[of]:	WM_LBUTTONUP
	case WM_LBUTTONUP
		def e: local mouse button event
		type (e) = mouse up event type
		button (e) = left mouse button
		status (e) = get key flags
		x (position (e)) = LOWORD (lParam) : short : int
		y (position (e)) = HIWORD (lParam) : short : int
		if on mouse up (m, e)
			return 0
		end
//[cf]
//[of]:	WM_LBUTTONDBLCLK
	case WM_LBUTTONDBLCLK
		def e: local mouse button event
		type (e) = mouse double click  event type