|
Marko Binic
Član broj: 24442
Poruke: 3
*.ptt.yu
|
Hvala, malo sam modifikovao ovo i upotrebio AnsiReplaceStr umesto ReplaceString i uspelo je. Imam jos jedan problem, nasao sam skript za menjanje velicine pojedinacnih celija DHTMLEdit tabele, ali je napisan u VisualBasic-u. Moze li neko da ga prevede u Delphi sors (ja sam pokusao, ali nisam imao mnogo uspeha)?
Code:
Private m_CursorOverriden As Boolean = False
Private m_Resizing As Boolean = False
Private m_ResizingRow As Boolean = False
Private m_Column As Integer
Private m_ResizeColumn As Integer
Private m_ColumnAdjust As Integer
Private m_Row As Integer
Private m_ResizeRow As Integer
Private m_RowAdjust As Integer
Private m_CapturedElement As mshtml.IHTMLElement
Private Const IDM_OVERRIDE_CURSOR As Integer = 2420
Private Enum MouseLocation
None
Vertical
Horizontal
Border
End Enum
Public Sub onmousedown(ByVal pEvtObj As mshtml.IHTMLEventObj) Implements
mshtml.HTMLDocumentEvents2.onmousedown
If m_CursorOverriden Then
Dim elem As mshtml.IHTMLElement
Dim mloc As MouseLocation
mloc = GetMouseLoc(pEvtObj)
If mloc = MouseLocation.Vertical Then
' This is the column to resize
m_ResizeColumn = m_Column - m_ColumnAdjust
m_ResizingRow = False
Else
' This is the row to resize
m_ResizeRow = m_Row - m_RowAdjust
m_ResizingRow = True
End If
' Find the table and capture mouse events
elem = DirectCast(pEvtObj.srcElement, mshtml.IHTMLElement)
Do Until elem.tagName = "TABLE"
elem = elem.parentElement
Loop
DirectCast(elem, mshtml.IHTMLElement2).setCapture()
m_CapturedElement = elem
m_Resizing = True
End If
End Sub
' Custom handler
Public Sub onmousemove(ByVal pEvtObj As mshtml.IHTMLEventObj) Implements
mshtml.HTMLDocumentEvents2.onmousemove
Static s_MouseLocation As MouseLocation = MouseLocation.None
Dim elem As mshtml.IHTMLElement
Dim mloc As MouseLocation
elem = pEvtObj.srcElement
If Not m_Resizing Then
' We are not resizing, so we just have
' to determine the cursor to show
mloc = GetMouseLoc(pEvtObj)
If m_CursorOverriden Then
If elem.tagName = "TD" Then
m_Column = GetColumn(DirectCast(elem,
mshtml.IHTMLTableCell))
m_Row = GetRow(DirectCast(elem, mshtml.IHTMLTableCell))
End If
End If
If s_MouseLocation <> mloc Then
s_MouseLocation = mloc
Select Case mloc
Case MouseLocation.Border
Case MouseLocation.Horizontal
SetCursor(Cursors.HSplit)
Case MouseLocation.Vertical
SetCursor(Cursors.VSplit)
Case MouseLocation.None
SetCursor(Cursors.Default)
Case Else
End Select
End If
Else
' We are resizing a row or column
Dim tbl As mshtml.IHTMLTable
' The table is always the captured element
tbl = DirectCast(m_CapturedElement, mshtml.IHTMLTable)
If m_ResizingRow Then
' Set the height of the row we are resizing
Dim row2 As mshtml.IHTMLTableRow2
Dim height As Integer
elem = DirectCast(tbl.rows.item(m_ResizeRow - 1),
mshtml.IHTMLElement)
height = pEvtObj.y - elem.offsetTop -
m_CapturedElement.offsetTop
If height > 0 Then
row2 = DirectCast(elem, mshtml.IHTMLTableRow2)
row2.height = height
End If
Else
' We are resizing a column
Dim cell As mshtml.IHTMLTableCell
Dim row As mshtml.IHTMLTableRow
Dim colIndex As Integer
Dim width As Integer
' Set the width of every cell in this column
For Each row In tbl.rows
colIndex = 0
' Find the cell in this row that we are resizing
For Each cell In row.cells
colIndex += cell.colSpan
If colIndex = m_ResizeColumn Then
' Found it
elem = DirectCast(cell, mshtml.IHTMLElement)
width = pEvtObj.x - elem.offsetLeft -
m_CapturedElement.offsetLeft
If width > 0 Then
cell.width = width
End If
Exit For
ElseIf colIndex > m_ResizeColumn Then
' Overshot, so just get out
Exit For
End If
Next cell
Next row
End If
End If
End Sub
Public Sub onmouseout(ByVal pEvtObj As mshtml.IHTMLEventObj) Implements
mshtml.HTMLDocumentEvents2.onmouseout
End Sub
Public Sub onmouseover(ByVal pEvtObj As mshtml.IHTMLEventObj) Implements
mshtml.HTMLDocumentEvents2.onmouseover
End Sub
' Custom handler
Public Sub onmouseup(ByVal pEvtObj As mshtml.IHTMLEventObj) Implements
mshtml.HTMLDocumentEvents2.onmouseup
If m_Resizing Then
DirectCast(m_CapturedElement,
mshtml.IHTMLElement2).releaseCapture()
m_Resizing = False
End If
End Sub
Public Sub onmouseup(ByVal pEvtObj As mshtml.IHTMLEventObj) Implements
mshtml.HTMLDocumentEvents2.onmouseup
If m_Resizing Then
DirectCast(m_CapturedElement,
mshtml.IHTMLElement2).releaseCapture()
m_Resizing = False
End If
End Sub
Private Function GetMouseLoc(ByVal pEvtObj As mshtml.IHTMLEventObj) As
MouseLocation
Const tol As Integer = 3
Static s_MouseLocation As MouseLocation = MouseLocation.None
Dim elem2 As mshtml.IHTMLElement2
Dim rects As mshtml.IHTMLRectCollection
Dim rect As mshtml.IHTMLRect
Dim mloc As MouseLocation
Dim tag As String
Dim x As Integer
Dim y As Integer
Dim left As Integer
Dim right As Integer
Dim top As Integer
Dim bottom As Integer
tag = pEvtObj.srcElement.tagName
If tag = "TD" Then
elem2 = DirectCast(pEvtObj.srcElement, mshtml.IHTMLElement2)
' Get the client Rects collection ...
rects = elem2.getClientRects()
' ... and then the first (and only) rect in the collection
rect = DirectCast(rects.item(0), mshtml.IHTMLRect)
left = rect.left
right = rect.right
top = rect.top
bottom = rect.bottom
x = pEvtObj.x
y = pEvtObj.y
' Detect if cursor is on vertical cell border
If y >= top + tol And y <= bottom - tol Then
' We are inside the top and bottom borders
If x >= left - tol And x <= left + tol Then
' We are on the vertical to the left of the cell
mloc = MouseLocation.Vertical
m_ColumnAdjust = DirectCast(elem2,
mshtml.IHTMLTableCell).colSpan
ElseIf x >= right - tol And x <= right + tol Then
' We are on the vertical to the right of the cell
mloc = MouseLocation.Vertical
m_ColumnAdjust = 0
Else
mloc = MouseLocation.None
End If
Else
If y < top + tol Then
' We are above the cell
m_RowAdjust = DirectCast(elem2,
mshtml.IHTMLTableCell).rowSpan
Else
' We are below the cell
m_RowAdjust = 0
End If
' We are outside the top or bottom border
mloc = MouseLocation.Horizontal
End If
ElseIf tag = "TABLE" Then
mloc = s_MouseLocation
Else
mloc = MouseLocation.None
End If
s_MouseLocation = mloc
Return mloc
End Function
Private Sub SetCursor(ByVal NewCursor As Cursor)
Dim cmdt As IOleCommandTarget
Dim oIn As New OLEVARIANT
Dim oOut As OLEVARIANT
Dim bOverride As Boolean
' If the new cursor is the default then do not override
bOverride = Not NewCursor Is Cursors.Default
If m_CursorOverriden = bOverride Then
' Already done
Else
oIn.vt = CType(oIn.vt Or VarEnum.VT_BOOL, Short)
oIn.lVal = CType(bOverride, Integer)
cmdt = DirectCast(AxWebBrowser1.Document, IOleCommandTarget)
cmdt.Exec(CGID_MSHTML, IDM_OVERRIDE_CURSOR,
OLECMDEXECOPT_DODEFAULT, oIn, oOut)
' Set the new cursor
AxWebBrowser1.Cursor = NewCursor
' Flag that we have done it
m_CursorOverriden = bOverride
End If
End Sub
Private Function GetColumn(ByVal cellCurrent As mshtml.IHTMLTableCell)
As Integer
Dim elem As mshtml.IHTMLElement
Dim tbl As mshtml.IHTMLTable
Dim row As mshtml.IHTMLTableRow
Dim index As Integer
Dim column As Integer
' Find the row we are in
elem = DirectCast(cellCurrent, mshtml.IHTMLElement)
Do Until elem.tagName = "TR"
elem = elem.parentElement
Loop
row = DirectCast(elem, mshtml.IHTMLTableRow)
' Find the column we are resizing
For index = 0 To cellCurrent.cellIndex
column += DirectCast(row.cells.item(index),
mshtml.IHTMLTableCell).colSpan
Next index
Return column
End Function
Private Function GetRow(ByVal cellCurrent As mshtml.IHTMLTableCell) As
Integer
Dim elem As mshtml.IHTMLElement
Dim tbl As mshtml.IHTMLTable
Dim row As mshtml.IHTMLTableRow
Dim index As Integer
Dim column As Integer
' Find the row we are in
elem = DirectCast(cellCurrent, mshtml.IHTMLElement)
Do Until elem.tagName = "TR"
elem = elem.parentElement
Loop
row = DirectCast(elem, mshtml.IHTMLTableRow)
Return row.rowIndex + 1
End Function
|
HTML i DHTMLEdit komponenta - Delphi 7
