ultragrid.htc

具备表头拖拽、交换列、排序、添加 、修改、删除、选择等等功能的。NET GRID

	dim intScrollLeft
	dim intScrollTop
	with parentElement.document.body
		intRightEdge = .clientWidth - x
		intBottomEdge = .clientHeight - y
		intScrollLeft = .scrollLeft + x
		intScrollTop = .scrollTop + y
	end with
	with elMenu
		if not .menuSized then .sizeMenu
		if (intRightEdge < elMenu.offsetWidth) then
			.style.left = intScrollLeft - .offsetWidth
		else
			.style.left = intScrollLeft
		end if
		if (intBottomEdge < elMenu.offsetHeight) then
			.style.top = intScrollTop - .offsetHeight
		else
			.style.top = intScrollTop
		end if
		.style.zIndex = 50
		.filters.blendTrans.apply()
		.style.visibility = "visible"
		.filters.blendTrans.play()
	end with
	inMenu = true
	window.document.attachEvent "onmousedown", mnuProcRef
end sub

sub hideMenu()
	window.document.detachEvent "onmousedown", mnuProcRef
	objHeadMenu.style.visibility = "hidden"
	inMenu = false
end sub


'col routines

sub showColumn(iCol)
	dim iRow
	if iCol <> -1 then
		gridHeadRow.children(iCol).style.display = ""
		for iRow = 0 to gridBody.children.length - 1
			with gridBody.children(iRow)
				if .id <> "cellEdit" then
					.children(iCol).style.display = ""
				end if
			end with
		next
	end if
	getGridRowWidth()
	elementOnResize()
end sub

sub removeColumn()
	dim iRow
	if getVisibleCount = 1 then
		msgbox "必须至少有一列可见", vbInformation, "移除列"
		writeFieldChooserHTML()
		exit sub
	end if
	gridHeadRow.children(menuHeadIndex).style.display = "none"
	for iRow = 0 to gridBody.children.length - 1
		with gridBody.children(iRow)
			if .id <> "cellEdit" then
				.children(menuHeadIndex).style.display = "none"
			end if
		end with
	next
	getGridRowWidth()
	elementOnResize()
end sub

sub sizeCol(iCol, iAmount)
	dim newWidth
	with gridHeadRow.children(iCol)
		newWidth = .offsetWidth + iAmount
		.style.width =	newWidth
		newWidth = .offsetWidth
	end with
	setColWidth iCol, newWidth
	getGridRowWidth()
	elementOnResize()
end sub

sub moveCols(fCol, tCol)
	dim i
	dim elTextSave
	if fCol = tCol then exit sub
	if prevMenuHeadIndex <> -1 then elTextSave = gridHeadRow.children(prevMenuHeadIndex).innerText
	moveHeaderCols cint(fCol), cint(tCol)
	for i = 0 to gridBody.children.length - 1
		if gridBody.children(i).id <> "cellEdit" then
			moveBodyCols i, cint(fCol), cint(tCol)
		end if
	next
	for i = 0 to gridHeadRow.children.length - 3
		if not elTextSave = "" then
			if elTextSave = gridHeadRow.children(i).innerText then
				prevMenuHeadIndex = i
				elTextSave = ""
			end if
		end if
	next
	getGridRowWidth()
	elementOnResize()
end sub

sub moveHeaderCols(fCol, tCol)
	dim i, nCol, dCol
	dim saveHTML, saveWidth
	if fCol > tCol then
		dCol = -1
		nCol = fCol - tCol
	else
		dCol = 1
		nCol = tCol - fCol
	end if
	with gridHeadRow.children(fCol)
		saveHTML = .innerHTML
		saveWidth = .offsetWidth
	end with
	for i = 0 to nCol - 1
		with gridHeadRow
			.children(fCol).innerHTML = .children(fCol + dCol).innerHTML
			.children(fCol).style.width = .children(fCol + dCol).offsetWidth
		end with
		fCol = fCol + dCol
	next
	with gridHeadRow.children(tCol)
		.innerHTML = saveHTML
		.style.width = saveWidth
	end with
end sub

sub moveBodyCols(iRow, fCol, tCol)
	dim i, nCol, dCol, idx, isLast
	dim saveHTML, saveWidth, saveColor, saveBorder, saveIndex, isLastAddedObject
	if fCol > tCol then
		dCol = -1
		nCol = fCol - tCol
	else
		dCol = 1
		nCol = tCol - fCol
	end if
	with gridBody.children(iRow)
		if cint(selectionStyle) = 1 then
			isLastAddedObject = cbool(.children(fCol) is cSelectedCells.lastobject)
			saveIndex = cSelectedCells.getItemIndex(.children(fCol))
			if saveIndex <> -1 then set cSelectedCells.colItems(saveIndex) = nothing
		end if
		with .children(fCol)
			saveColor = .runtimeStyle.backgroundColor
			saveBorder = .style.border
			saveHTML = .innerText
			saveWidth = .offsetWidth
		end with
	end with
	for i = 0 to nCol - 1
		with gridBody.children(iRow)
			if cint(selectionStyle) = 1 then
				isLast =  cbool(.children(fCol + dCol) is cSelectedCells.lastobject)
				idx = cSelectedCells.getItemIndex(.children(fCol + dCol))
			end if
			.children(fCol).runtimeStyle.backgroundColor = .children(fCol + dCol).runtimeStyle.backgroundColor
			.children(fCol).style.border = .children(fCol + dCol).style.border
			.children(fCol).innerText = .children(fCol + dCol).innerText
			.children(fCol).style.width = .children(fCol + dCol).offsetWidth
			if cint(selectionStyle) = 1 then
				if idx <> -1 then set cSelectedCells.colItems(idx) = .children(fCol)
				if isLast then cSelectedCells.setLastObject .children(fCol)
			end if
		end with
		fCol = fCol + dCol
	next
	with gridBody.children(iRow)
		if cint(selectionStyle) = 1 then
			if saveIndex <> -1 then set cSelectedCells.colItems(saveIndex) = .children(tCol)
			if isLastAddedObject then cSelectedCells.setLastObject .children(tCol)
		end if
		with .children(tCol)
			.runtimeStyle.backgroundColor = saveColor
			.style.border = saveBorder
			.innerText = saveHTML
			.style.width = saveWidth
		end with
	end with
end sub


'sort routines

sub sortTable(iCol, currentSort)
	dim i, s
	dim strRowCurrent, strRowInsert
	dim bReverse
	bReverse = (currentSort = "UP")
	for i = 0 to gridBody.children.length - 1
		if gridBody.children(i).id <> "cellEdit" then
     		strRowInsert = lcase(gridBody.children(i).children(iCol).innerText)
			if isnumeric(replace(strRowInsert, ".", "")) then strRowInsert = clng(replace(strRowInsert, ".", ""))
			if isdate(strRowInsert) then strRowInsert = cdate(strRowInsert)
			for s = 0 to i
				strRowCurrent = lcase(gridBody.children(s).children(iCol).innerText)
				if isnumeric(replace(strRowCurrent, ".", "")) then strRowCurrent = clng(replace(strRowCurrent, ".", ""))
				if isdate(strRowCurrent) then strRowCurrent = cdate(strRowCurrent)
				if (((not bReverse and strRowInsert < strRowCurrent) or _
						 (bReverse and strRowInsert > strRowCurrent)) and _
						 (i <> s)) then
			        gridBody.insertBefore gridBody.children(i), gridBody.children(s)
			        exit for
			    end if
			next
		end if
	next
	setRowColors()
end sub

sub sortAscending()
	if prevMenuHeadIndex <> -1 then
		gridHeadRow.children(prevMenuHeadIndex).children(0).src = sortNoneImageUrl
	end if
	gridHeadRow.children(menuHeadIndex).children(0).src = sortDownImageUrl
	sortTable menuHeadIndex, "DOWN"
	prevMenuHeadIndex = menuHeadIndex
end sub

sub sortDescending()
	if prevMenuHeadIndex <> -1 then
		gridHeadRow.children(prevMenuHeadIndex).children(0).src = sortNoneImageUrl
	end if
	gridHeadRow.children(menuHeadIndex).children(0).src = sortUpImageUrl
	sortTable menuHeadIndex, "UP"
	prevMenuHeadIndex = menuHeadIndex
end sub


'drag routines

dim lastHeadIndex
lastHeadIndex = -1
sub hiliteHeader(headIndex, offset_x, offset_y)
	dim o1Style, o2Style
	if (headIndex = lastHeadIndex) then exit sub
	set o1Style = objDragToItem1.style
	set o2Style = objDragToItem2.style
	if (headIndex = -1) then
		if o1Style.visibility <> "hidden" then o1Style.visibility = "hidden"
		if o2Style.visibility <> "hidden" then o2Style.visibility = "hidden"
		if ie6 then
			if element.style.cursor <> "no-drop" then element.style.cursor = "no-drop"
		else
			if element.style.cursor <> "wait" then element.style.cursor = "wait"
		end if
		lastHeadIndex = -1
		set o1Style = nothing
		set o2Style = nothing
		exit sub
	end if
	if element.style.cursor <> "hand" then element.style.cursor = "hand"
	if headIndex > gridHeadRow.children.length - 3 then
		o1Style.posTop = offset_y - o1Style.posHeight
		o1Style.posLeft = gridHeadRow.children(headIndex - 1).offsetLeft + gridHeadRow.children(headIndex - 1).offsetWidth - posOffset + offset_x + cint(replace(gridHeadRow.style.marginLeft, "px", ""))
	else
		o1Style.posTop = offset_y - o1Style.posHeight
		o1Style.posLeft = gridHeadRow.children(headIndex).offsetLeft - posOffset + offset_x + cint(replace(gridHeadRow.style.marginLeft, "px", ""))
	end if
	o2Style.posTop = gridHeadRow.children(0).offsetHeight + offset_y
	o2Style.posLeft = o1Style.posLeft
	if o1Style.visibility <> "visible" then o1Style.visibility = "visible"
	if o2Style.visibility <> "visible" then o2Style.visibility = "visible"
	lastHeadIndex = headIndex
	set o1Style = nothing
	set o2Style = nothing
end sub

function hitTest(x, y)
	dim i, iHit, offset_x, offset_y
	setOffsets offset_x, offset_y
	with gridHeadRow.children(0)
		if y - offset_y > (.offsetTop + ((.offsetHeight - 3) * 2)) or y - offset_y < .offsetTop - 3 then
			hiliteHeader -1, offset_x, offset_y
			hitTest = -1
			exit function
		end if
	end with
	for i = 0 to gridHeadRow.children.length - 3
		with gridHeadRow.children(i)
			if x - offset_x > .offsetLeft + cint(replace(gridHeadRow.style.marginLeft, "px", "")) and x - offset_x < .offsetLeft + .offsetWidth + cint(replace(gridHeadRow.style.marginLeft, "px", "")) then
				if x - offset_x <= .offsetLeft + cint(replace(gridHeadRow.style.marginLeft, "px", "")) + (.offsetWidth \ 2) then
					hiliteHeader i, offset_x, offset_y
					if menuHeadIndex > i then
						iHit = i
					elseif menuHeadIndex = i then
						iHit = i
					elseif menuHeadIndex < i then
						iHit = i - 1
					end if
				elseif x - offset_x => .offsetLeft + cint(replace(gridHeadRow.style.marginLeft, "px", "")) + (.offsetWidth \ 2) then
					hiliteHeader i + 1, offset_x, offset_y
					if menuHeadIndex > i then
						iHit = i + 1
					elseif menuHeadIndex = i then
						iHit = i
					elseif menuHeadIndex < i then
						iHit = i
					end if
				end if
				if iHit < 0 then iHit = 0
				if iHit > gridHeadRow.children.length - 3 then iHit = gridHeadRow.children.length - 3
				hitTest = iHit
				exit function
			end if
		end with
	next
	hitTest = -1
end function


'objEditItem routines

function intShowEditObject()
	showEditObject gridBody.children(menuRowIndex).children(menuCellIndex)
end function

dim currentEditCell
sub showEditObject(el)
	dim offset_x, offset_y
	if el is nothing then set el = currentEditCell
	if el is nothing then exit sub
	setElementOffsets el, gridBody, offset_x, offset_y
	with objEditItem
		with .style
			.left = offset_x
			.top = offset_y
			.height = el.offsetHeight
			.width = el.offsetWidth
			.visibility = "visible"
		end with
		set currentEditCell = el
		inEdit = true
		with element.document.all("cellEdit")
			.realValue = el.innerText
			.focus()
			.select()
		end with
		with window.document
			.attachEvent "onkeydown", editProcRef
			.attachEvent "onmousedown", mnuProcRef
		end with
	end with
end sub

sub hideEditObject(blnReplaceValue)
	with window.document
		.detachEvent "onkeydown", editProcRef
		.detachEvent "onmousedown", mnuProcRef
	end with
	if blnReplaceValue then
		if not currentEditCell is nothing then
			if objEditHeadItem.style.visibility <> "hidden" then
				currentEditCell.innerHTML = replace(currentEditCell.innerHTML, currentEditCell.innerText, element.document.all("headCellEdit").value)
			else
				currentEditCell.innerText = element.document.all("cellEdit").value
			end if
		end if
	end if
	if objEditHeadItem.style.visibility <> "hidden" then
		with objEditHeadItem.style
			.visibility = "hidden"
			.top = "-100px"
			.left = "-100px"
		end with
	else
		with objEditItem.style
			.visibility = "hidden"
			.top = "-100px"
			.left = "-100px"
		end with
	end if
	set currentEditCell = nothing
	inEdit = false
end sub

sub beginEdit
	if cint(selectionStyle) = 1 then
		if not cSelectedCells.LastObject is nothing then
			showEditObject cSelectedCells.LastObject
		end if
	end if
end sub

sub endEdit(blnReplaceValue)
	if cint(selectionStyle) = 1 then
		hideEditObject blnReplaceValue
	end if
end sub

function intShowEditHeadObject()
	dim el, offset_x, offset_y
	set el = gridHeadRow.children(menuHeadIndex)
	if el is nothing then exit function
	setElementOffsets el, gridHeadRow, offset_x, offset_y
	with objEditHeadItem
		with .style
			.left = offset_x
			.top = offset_y
			.height = el.offsetHeight
			.width = el.offsetWidth
			.visibility = "visible"
		end with
		set currentEditCell = el
		inEdit = true
		with element.document.all("headCellEdit")
			.realValue = el.innerText
			.focus()
			.select()
		end with
		with window.document
			.attachEvent "onkeydown", editProcRef
			.attachEvent "onmousedown", mnuProcRef
		end with
	end with
	set el = nothing
end function

sub showFieldChooser()
	writeFieldChooserHTML
	with window.document.getElementById(element.id & "_fcWindow")
		.left = objHeadMenu.offsetLeft
		.top = objHeadMenu.offsetTop
		.width = 160
		.height = 170
		.style.visibility = "visible"
	end with
end sub

sub doAction(iCol)
	if gridHeadRow.children(iCol).style.display = "none" then
		showColumn iCol
	else
		menuHeadIndex = iCol
		removeColumn
	end if
end sub

function buildFieldChooserHTML()
	dim i, windowHTML
	windowHTML = "<html><head><title>字段选择</title><style>body {padding: 0px; margin: 0px;} .small {font: menu;} </style></head><body>"
	for i = 0 to gridHeadRow.children.length - 3
		with gridHeadRow.children(i)
			windowHTML = windowHTML & "<input type='checkbox' class='small' id='check_" & i & "' onclick='vbscript: parent." & element.id & ".doAction " & i & "'"
			if cbool(.style.display <> "none") then
				windowHTML = windowHTML & " checked=TRUE"
			end if
			windowHTML = windowHTML & "><label class='small' for='check_" & i & "'>" & replace(.innerText, " ", "&nbsp;") & "</label><br>"
		end with
	next
	buildFieldChooserHTML = windowHTML & "</body></html>"
end function

sub writeFieldChooserHTML()
	dim strHTML, winContentDoc
	strHTML = buildFieldChooserHTML
	set winContentDoc = window.document.getElementById(element.id & "_winContent")
	with winContentDoc.contentWindow.document
		.open()
		.write strHTML
		.close()
	end with
	set winContentDoc = nothing
end sub

</script>

</PUBLIC:COMPONENT>