|
[x]
Posted via EE Mobile
|
||
Search, ask, and monitor your questions on the go with EE Mobile. Visit Experts Exchange from your mobile device and never be out of touch again. |
||
| Question |
|
[x]
Attachment Details
|
||
|
[x]
The Solution Rating System
|
||
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: |
Option Explicit
Private Const CURSOR_PRECISION = 2
Private Const RESIZE_CURSOR = vbSizeNS
Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hwnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private m_bIsResizing As Boolean
Private m_lRowToResize As Long
Private m_lOrigRowHeight As Long
Private m_lYMouseDown As Long
Private m_lCursorX As Long
Private m_lCursorY As Long
Private Sub Form_Load()
TimerGridMouseLeave.Enabled = False
TimerGridMouseLeave.Interval = 20
With iGrid1
.ColCount = 5
.RowCount = 15
' Some sample data for testing
.CellValue(1, 1) = "The quick brown fox jumps over the lazy dog"
.CellTextFlags(1, 1) = igTextWordBreak
With .CellFont(3, 1)
.Bold = True
.Size = 16
End With
.CellValue(3, 1) = "Some text"
End With
End Sub
' The sub checks whether we need to indicate with the special mouse pointer
' that there is a row's bottom edge under the cursor and thus the row can be resized
Private Sub CheckResizePossible(ByVal pxCursor As Long, ByVal pyCursor As Long, _
ByVal plRowUnderCursor As Long, ByVal plColUnderCursor As Long)
Dim lLeft As Long, lTop As Long, lWidth As Long, lHeight As Long
If plRowUnderCursor = 0 Or plColUnderCursor = 0 Then
' No row under the cursor.
' Check for the last row taking into account our precision.
If iGrid1.RowCount > 0 Then
iGrid1.CellBoundary iGrid1.RowCount, 1, lLeft, lTop, lWidth, lHeight
Dim lDelta As Long
lDelta = pyCursor - (lTop + lHeight - 1)
If lDelta >= 0 And lDelta <= CURSOR_PRECISION Then
m_lRowToResize = iGrid1.RowCount
GoTo AllowResizing
End If
End If
Else
' The cursor is over a row.
iGrid1.CellBoundary plRowUnderCursor, plColUnderCursor, lLeft, lTop, lWidth, lHeight
If (lTop + lHeight - 1) - pyCursor <= CURSOR_PRECISION Then
m_lRowToResize = plRowUnderCursor
GoTo AllowResizing
End If
If plRowUnderCursor > 1 Then
If pyCursor - lTop <= CURSOR_PRECISION Then
m_lRowToResize = plRowUnderCursor - 1
GoTo AllowResizing
End If
End If
End If
' No resizing
SetNoResizePossible
Exit Sub
AllowResizing:
Me.MousePointer = RESIZE_CURSOR ' this will also indicate for our code that the row can be resized
m_lOrigRowHeight = iGrid1.RowHeight(m_lRowToResize)
TimerGridMouseLeave.Enabled = True
End Sub
Private Sub SetNoResizePossible()
Me.MousePointer = vbDefault
TimerGridMouseLeave.Enabled = False
End Sub
Private Sub iGrid1_DblClick(ByVal lRow As Long, ByVal lCol As Long, bRequestEdit As Boolean)
If Me.MousePointer = RESIZE_CURSOR Then
' Auto-height the row instead of editing
bRequestEdit = False
iGrid1.AutoHeightRow m_lRowToResize
CheckResizePossible m_lCursorX, m_lCursorY, lRow, lCol
End If
End Sub
Private Sub iGrid1_MouseDown(Button As Integer, Shift As Integer, ByVal x As Single, ByVal y As Single, ByVal lRow As Long, ByVal lCol As Long, bDoDefault As Boolean, ByVal bOverCellCtrl As Boolean)
If Me.MousePointer = RESIZE_CURSOR Then
m_lYMouseDown = y
m_bIsResizing = True
bDoDefault = False ' do not select the cell in this mode
End If
End Sub
Private Sub iGrid1_MouseUp(Button As Integer, Shift As Integer, ByVal x As Single, ByVal y As Single, ByVal lRow As Long, ByVal lCol As Long, bDoDefault As Boolean)
If Me.MousePointer = RESIZE_CURSOR Then
m_bIsResizing = False
End If
End Sub
Private Sub iGrid1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single, ByVal lRow As Long, ByVal lCol As Long)
m_lCursorX = x: m_lCursorY = y
If m_bIsResizing Then
Dim lNewHeight As Long
lNewHeight = m_lOrigRowHeight + y - m_lYMouseDown
If lNewHeight < 0 Then lNewHeight = 0
iGrid1.RowHeight(m_lRowToResize) = lNewHeight
Exit Sub
End If
CheckResizePossible x, y, lRow, lCol
End Sub
' Here we check whether we need to set the mouse pointer to the default value
' when the user moves it outside of the cell area.
Private Sub TimerGridMouseLeave_Timer()
If Not m_bIsResizing Then
' We do not receive the VB MouseMove event outsideof the cell area,
' so we should use WinAPI to get the mouse coordinates inside our control
Dim pt As POINTAPI
GetCursorPos pt ' in the screen coordinate system
ScreenToClient iGrid1.hwnd, pt
' Now the pt structure conatins what we need
If pt.x < 0 Or pt.x >= iGrid1.Sys(igSysCellsAreaWidth) Or _
pt.y < 0 Or pt.y >= iGrid1.Sys(igSysCellsAreaHeight) + iGrid1.Header.Height Then
SetNoResizePossible
End If
End If
End Sub
|
Advertisement
| Hall of Fame |