// **************************************************************************** // // ** ** // // ** Class : cGrid ** // // ** ** // // ** Purpose : Variable height, static grid ** // // ** ** // // ** Author : Ulbe Stellema ** // // ** Data Access Europe ** // // ** ** // // ** Date : november 24, 2002 ** // // ** ** // // **************************************************************************** // Use cPopupMenu.h Use user32.h Use cGrid.h Use cHeader.pkg Use cGridColumn.pkg // Function : FormatWinError // Purpose : Creates error string from passed error number. Defined in VDF8, but not in VDF7 #IFNDEF get_FormatWinError Function FormatWinError Global Integer iError Returns String Integer iFlags iBytes iResult Pointer pAddress String sBuffer // Initialize pAddress, just to make sure AddressOf() works Move 0 To pAddress // Set the flags... Move (FORMAT_MESSAGE_ALLOCATE_BUFFER iOr FORMAT_MESSAGE_FROM_SYSTEM iOr FORMAT_MESSAGE_IGNORE_INSERTS) To iFlags // If FormatMessage fails iBytes will be 0, therefore no bytes will be copied and the error will only // display the error code returned from GetLastError... Move (FormatMessage(iFlags,0,iError,0,AddressOf(pAddress),0,0)) To iBytes // Allocate the buffer... Move (Repeat(Character(0),iBytes)) To sBuffer If (iBytes > 0) Move (CopyMemory(AddressOf(sBuffer),pAddress,iBytes)) To iResult // Display the error code and message, if no message is available use 'No error text available'. If (Trim(sBuffer) = "") Move "No error text available" To sBuffer // Free memory used by the buffer... Move (Free(pAddress)) To iResult Function_Return (sBuffer +" (Error code = "+String(iError)+")") End_Function // FormatWinError #ENDIF // Visual DataFlex 12.0 Migration Utility, added March 28, 2007: 15:13:24 #IF (!@ >= 120) { OverrideProperty=Location InitialValue=0,0 } { OverrideProperty=Size InitialValue=28,50 } { OverrideProperty=Color InitialValue=clWindow } #ENDIF Class cGrid is a cWinControl // **************************************************************************** // // ** Private interface ** // // **************************************************************************** // // Procedure : Construct_Object // Purpose : Object constructor Procedure Construct_Object Set External_Class_Name "cGrid" To "static" Forward Send Construct_Object Set External_Message WM_ERASEBKGND To msg_Private.EraseBkgnd Set External_Message WM_PAINT To msg_Private.Paint Set External_Message WM_NCHITTEST To msg_Private.ncHitTest Set External_Message WM_NCLBUTTONDOWN To msg_Private.ncLButtonDown Set External_Message WM_HSCROLL To msg_Private.HScroll Set External_Message WM_VSCROLL To msg_Private.VScroll Set External_Message WM_SETFOCUS To msg_Private.SetFocus Set External_Message WM_KILLFOCUS To msg_Private.KillFocus Set External_Message WM_LBUTTONDBLCLK To msg_OnLButtonDoubleClick Set External_Message WM_MOUSEWHEEL To msg_OnMouseWheel Set Border_Style To Border_ClientEdge Set Focus_Mode To Focusable // Public properties // Visual DataFlex 12.0 Migration Utility, added March 28, 2007: 15:13:25 #IF (!@ >= 120) { InitialValue=glBoth } #ENDIF Property Integer peGridlines glBoth // Visual DataFlex 12.0 Migration Utility, added March 28, 2007: 15:13:25 #IF (!@ >= 120) { InitialValue=omVertical } #ENDIF Property Integer peOrientation omVertical // Visual DataFlex 12.0 Migration Utility, added March 28, 2007: 15:13:25 #IF (!@ >= 120) { InitialValue=False } #ENDIF Property Boolean pbRetainSelectedItem False Property Integer piRow 0 Property Integer piColumn 0 Property Integer piSubColumn 0 Property Handle phCursorNo Property Handle phCursorCross Property Handle phCursorArrow Property Handle phCursorResize // TODO: make these private Property Handle phoColumns Property Handle phoHeader // Drag and drop properties Property Integer Private.piDragging 0 // This property is set the length of the dragged item Property Integer Private.peResize rsNone // Used by drag and resize Property Integer Private.piFromRow Property Integer Private.piFromColumn Property Integer Private.piFromSubColumn // Wrapped private properties Property Boolean Private.pbReOrderColumns False Property Handle Private.phoImageList // Private properties Property Handle Private.phData Property Integer Private.piRowCount Property Integer Private.piColumnCount Property Integer Private.piFirstRow Property Integer Private.piFirstColumn //Property Integer Private.piTime //Property String Private.psSearch Set phCursorNo To (LoadCursor(0,IDC_NO)) Set phCursorCross To (LoadCursor(0,IDC_CROSS)) Set phCursorArrow To (LoadCursor(0,IDC_ARROW)) // Create child objects Object oColumns Is A cCollection End_Object // oColumns Object oHeader Is A cHeader End_Object // oHeader Set phoColumns To (oColumns(Self)) Set phoHeader To (oHeader(Self)) Set Window_Style To WS_HSCROLL True Set Window_Style To WS_VSCROLL True Set Window_Style To WS_BORDER True Set Window_Style To WS_TABSTOP True Set Window_Style To WS_CLIPCHILDREN True //Set Window_Style To WS_CLIPSIBLINGS True Set Window_Style To SS_NOTIFY True Set Extended_Window_Style To WS_EX_ACCEPTFILES True End_Procedure // Construct_Object // Procedure : Destroy_Object // Purpose : Object destructor Procedure Destroy_Object Integer iResult iRows iColumns Pointer pSubColumn // Free subcolumn data For iRows From 0 To (Private.piRowCount(Self)-1) For iColumns From 0 To (Private.piColumnCount(Self)-1) Get Private.piColumnData iRows iColumns To pSubColumn Move (Free(pSubColumn)) To iResult Loop // For iColumns From 0 To (Private.piColumnCount(Self)-1) Loop // For iRows From 0 To (Private.piRowCount(Self)-1) // Free row and column data Move (Free(Private.phData(Self))) To iResult Set Private.phData To 0 Set Private.piRowCount To 0 Set Private.piColumnCount To 0 Forward Send Destroy_Object End_Procedure // Destroy_Object // Function : ContainerFocusWillNotChange // Purpose : Handles navigation Function ContainerFocusWillNotChange Returns Integer Function_Return False End_Function // ContainerFocusWillNotChange // Function : ContainsFocus // Purpose : Handles navigation Function ContainsFocus Returns Integer Function_Return True End_Function // ContainsFocus // Procedure : Set GUISize // Purpose : Handles resize (anchors) Procedure Set GUISize Integer iY Integer iX Integer iXY Get GUISize To iXY Forward Set GUISize To iY iX If (BuildingObjectId = 0 And Window_Handle(Self) And (Hi(iXY)<>iY Or Low(iXY)<>iX)) Send Private.Resize End_Procedure // Set GUISize // Procedure : Add_Focus // Purpose : Automatically add children to focus tree Procedure Add_Focus Integer iBase Returns Integer Integer iResult Forward Get msg_Add_Focus iBase To iResult If (iResult = 0) Broadcast No_Stop Send Add_Focus Self End_Procedure // Add_Focus // Procedure : Activate // Purpose : Calls APIIsFocusable Procedure Activate Returns Integer If (APIIsFocusable(Self) = False) Procedure_Return 1 // error entering Forward Send Activate End_Procedure // Activate // Function : Private.FindPage // Purpose : Finds first row based on passed last row Function Private.FindPage Integer iItem Returns Integer Integer iSize iHeight Move (Hi(GUISize(Self))) To iSize Move (iSize-Hi(GUISize(phoHeader(Self)))) To iSize Move (iSize-GetSystemMetrics(SM_CYHSCROLL)) To iSize While (iHeight <= iSize And iItem >= 0) Move (iHeight+piRowHeight(Self,iItem)) To iHeight Decrement iItem Loop // While (iHeight < iSize And iItem > 0) Increment iItem // Don't include partial item If (iHeight > iSize) Increment iItem Function_Return iItem End_Function // Private.FindPage // Procedure : Private.ncHitTest // Purpose : Handles WM_NCHITTEST by passing it to DefWindowProc() Procedure Private.ncHitTest Integer wParam Integer lParam Integer iResult Set Windows_Override_State To True Move (DefWindowProc(Window_Handle(Self),WM_NCHITTEST,wParam,lParam)) To iResult Procedure_Return iResult End_Procedure // Private.ncHitTest // Procedure : Private.ncLButtonDown // Purpose : Handles WM_NCLBUTTONDOWN by passing it to DefWindowProc() Procedure Private.ncLButtonDown Integer wParam Integer lParam Integer iResult Set Windows_Override_State To True Move (DefWindowProc(Window_Handle(Self),WM_NCLBUTTONDOWN,wParam,lParam)) To iResult Procedure_Return iResult End_Procedure // Private.ncLButtonDown // Procedure : OnWmRButtonDown // Purpose : Handles WM_RBUTTONDOWN Procedure OnWmRButtonDown Integer wParam Integer lParam Integer iResult iRow iColumn iSubColumn iOldRow iOldColumn iOldSubColumn Move (piRow(Self)) To iOldRow Move (piColumn(Self)) To iOldColumn Move (piSubColumn(Self)) To iOldSubColumn // First try to activate Get msg_Activate To iResult If (iResult <> 0) Begin Set Windows_Override_State To True Procedure_Return False End // If (iResult = 0) Begin Move (Private.RowFromPoint(Self,lParam)) To iRow Move (Private.ColumnFromPoint(Self,lParam)) To iColumn Move (Private.SubColumnFromPoint(Self,lParam)) To iSubColumn If (iRow = -1 Or iColumn = -1 Or iSubColumn = -1) Begin Set Windows_Override_State To True Procedure_Return False End // If (iRow = -1 Or iColumn = -1 Or iSubColumn = -1) Begin Set piRow To iRow Set piColumn To iColumn Set piSubColumn To iSubColumn // Repaint old and new item Send RepaintSubColumn iOldRow iOldColumn iOldSubColumn Send RepaintSubColumn (piRow(Self)) (piColumn(Self)) (piSubColumn(Self)) Send OnRightButtonDown (piRow(Self)) (piColumn(Self)) (piSubColumn(Self)) End_Procedure // OnWmRButtonDown // Procedure : OnWmLButtonDown // Purpose : Handles WM_LBUTTONDOWN Procedure OnWmLButtonDown Integer wParam Integer lParam Integer iResult iRow iColumn iSubColumn iOldRow iOldColumn iOldSubColumn iTop iBottom iData iCount String sRect Move (piRow(Self)) To iOldRow Move (piColumn(Self)) To iOldColumn Move (piSubColumn(Self)) To iOldSubColumn // First try to activate Get msg_Activate To iResult If (iResult <> 0) Begin Set Windows_Override_State To True Procedure_Return False End // If (iResult <> 0) Begin Move (Private.RowFromPoint(Self,lParam)) To iRow Move (Private.ColumnFromPoint(Self,lParam)) To iColumn Move (Private.SubColumnFromPoint(Self,lParam)) To iSubColumn If (iRow = -1 Or iColumn = -1 Or iSubColumn = -1) Begin Set Windows_Override_State To True Procedure_Return False End // If (iRow = -1 Or iColumn = -1 Or iSubColumn = -1) Begin Set piRow To iRow Set piColumn To iColumn Set piSubColumn To iSubColumn // Get data Move (piSubColumnData(Self,iRow,iColumn,iSubColumn)) To iData // Repaint old and new item Send RepaintSubColumn iOldRow iOldColumn iOldSubColumn Send RepaintSubColumn (piRow(Self)) (piColumn(Self)) (piSubColumn(Self)) Send OnLeftButtonDown (piRow(Self)) (piColumn(Self)) (piSubColumn(Self)) If (wParam iAnd MK_CONTROL Or wParam iAnd MK_SHIFT) Procedure_Return If (iData = 0) Procedure_Return Set Private.piFromRow To iRow Set Private.piFromColumn To iColumn Set Private.piFromSubColumn To iSubColumn // Check resize operation If (APICanResizeSubColumn(Self,iRow,iColumn,iSubColumn)) Begin ZeroType tRECT To sRect // Get SubColumn rect Move (Private.SubColumnRect(Self,iRow,iColumn,iSubColumn,AddressOf(sRect))) To iResult If (peOrientation(Self) = omVertical) Begin Set phCursorResize To (LoadCursor(0,IDC_SIZENS)) GetBuff From sRect at tRECT.top To iTop GetBuff From sRect at tRECT.bottom To iBottom If (Hi(lParam) >= (iTop-2) And Hi(lParam) <= (iTop+2) And piSubColumnData(Self,iRow-1,iColumn,iSubColumn) <> iData) Begin Move (SetCapture(Window_Handle(Self))) To iResult Move (SetCursor(phCursorResize(Self))) To iResult // Mark as resize Move iRow To iCount While (piSubColumnData(Self,iCount,iColumn,iSubColumn) = iData) Set piSubColumnExtra iCount iColumn iSubColumn To (AddBitValue(seResize,piSubColumnExtra(Self,iCount,iColumn,iSubColumn))) Increment iCount Loop // While (piSubColumnData(Self,iCount,iColumn,iSubColumn) = iData) Set Private.peResize To rsTop Procedure_Return End // If (Hi(lParam) >= (iTop-2) And Hi(lParam) <= (iTop+2) And piSubColumnData(Self,iRow-1,iColumn,iSubColumn) <> iData) Begin If (Hi(lParam) >= (iBottom-2) And Hi(lParam) <= (iBottom+2) And piSubColumnData(Self,iRow+1,iColumn,iSubColumn) <> iData) Begin Move (SetCapture(Window_Handle(Self))) To iResult Move (SetCursor(phCursorResize(Self))) To iResult // Mark as resize Move iRow To iCount While (piSubColumnData(Self,iCount,iColumn,iSubColumn) = iData) Set piSubColumnExtra iCount iColumn iSubColumn To (AddBitValue(seResize,piSubColumnExtra(Self,iCount,iColumn,iSubColumn))) Decrement iCount Loop // While (piSubColumnData(Self,iCount,iColumn,iSubColumn) = iData) Set Private.peResize To rsBottom Procedure_Return End // If (Hi(lParam) >= (iBottom-2) And Hi(lParam) <= (iBottom+2) And piSubColumnData(Self,iRow+1,iColumn,iSubColumn) <> iData) Begin End // If (peOrientation(Self) = omVertical If (peOrientation(Self) = omHorizontal) Begin Set phCursorResize To (LoadCursor(0,IDC_SIZEWE)) GetBuff From sRect at tRECT.left To iTop GetBuff From sRect at tRECT.right To iBottom If (Low(lParam) >= (iTop-2) And Low(lParam) <= (iTop+2) And piSubColumnData(Self,iRow,iColumn-1,iSubColumn) <> iData) Begin Move (SetCapture(Window_Handle(Self))) To iResult Move (SetCursor(phCursorResize(Self))) To iResult // Mark as resize Move iColumn To iCount While (piSubColumnData(Self,iRow,iCount,iSubColumn) = iData) Set piSubColumnExtra iRow iCount iSubColumn To (AddBitValue(seResize,piSubColumnExtra(Self,iRow,iCount,iSubColumn))) Increment iCount Loop // While (piSubColumnData(Self,iRow,iCount,iSubColumn) = iData) Set Private.peResize To rsTop Send OnResizeStart iRow iColumn iSubColumn Procedure_Return End // If (Low(lParam) >= (iTop-2) And Low(lParam) <= (iTop+2) And piSubColumnData(Self,iRow,iColumn-1,iSubColumn) <> iData) Begin If (Low(lParam) >= (iBottom-2) And Low(lParam) <= (iBottom+2) And piSubColumnData(Self,iRow,iColumn+1,iSubColumn) <> iData) Begin Move (SetCapture(Window_Handle(Self))) To iResult Move (SetCursor(phCursorResize(Self))) To iResult // Mark as resize Move iColumn To iCount While (piSubColumnData(Self,iRow,iCount,iSubColumn) = iData) Set piSubColumnExtra iRow iCount iSubColumn To (AddBitValue(seResize,piSubColumnExtra(Self,iRow,iCount,iSubColumn))) Decrement iCount Loop // While (piSubColumnData(Self,iRow,iCount,iSubColumn) = iData) Set Private.peResize To rsBottom Send OnResizeStart iRow iColumn iSubColumn Procedure_Return End // If (Low(lParam) >= (iBottom-2) And (Low(lParam) <= (iBottom+2) And piSubColumnData(Self,iRow,iColumn+1,iSubColumn) <> iData) Begin End // If (peOrientation(Self) = omHorizontal) Begin End // If (APICanResizeSubColumn(Self,iRow,iColumn,iSubColumn)) Begin // Check drag operation If (APICanDragSubColumn(Self,iRow,iColumn,iSubColumn)) Begin If (peOrientation(Self) = omVertical) Begin If (piSubColumnData(Self,iRow-1,iColumn,iSubColumn) <> iData) Begin Move (SetCapture(Window_Handle(Self))) To iResult // Mark as dragging Move iRow To iCount While (piSubColumnData(Self,iCount,iColumn,iSubColumn) = iData) Increment iCount Loop // While (piSubColumnData(Self,iCount,iColumn,iSubColumn) = iData) Set Private.piDragging To (iCount-iRow) Send OnDragStart iRow iColumn iSubColumn End // If (piSubColumnData(Self,iRow-1,iColumn,iSubColumn) <> iData) Begin End // If (peOrientation(Self) = omVertical) Begin If (peOrientation(Self) = omHorizontal) Begin If (piSubColumnData(Self,iRow,iColumn-1,iSubColumn) <> iData) Begin Move (SetCapture(Window_Handle(Self))) To iResult // Mark as dragging Move iColumn To iCount While (piSubColumnData(Self,iRow,iCount,iSubColumn) = iData) Increment iCount Loop // While (piSubColumnData(Self,iRow,iCount,iSubColumn) = iData) Set Private.piDragging To (iCount-iColumn) Send OnDragStart iRow iColumn iSubColumn End // If (piSubColumnData(Self,iRow,iColumn-1,iSubColumn) <> iData) Begin End // If (peOrientation(Self) = omHorizontal) Begin End // If (APICanDragSubColumn(Self,iRow,iColumn,iSubColumn)) Begin End_Procedure // OnWmLButtonDown // Procedure : OnWmMouseMove // Purpose : Handles WM_MOUSEMOVE Procedure OnWmMouseMove Integer wParam Integer lParam Integer iResult iX iY iRow iColumn iSubColumn iData iCount iLength iExtra Integer iOldRow iOldColumn iOldSubColumn iWidth iHeight Integer iTop iBottom iLeft iRight Handle hWindow String sPoint sRect // Drag operation If (Private.piDragging(Self)) Begin If (wParam = MK_LBUTTON) Begin ZeroType tPOINT To sPoint Move (GetCursorPos(AddressOf(sPoint))) To iResult GetBuff From sPoint at tPOINT.x To iX GetBuff From sPoint at tPOINT.y To iY // Where is the cursor now Move (WindowFromPoint(iX,iY)) To hWindow Move (GetWindowLong(hWindow,GWL_EXSTYLE)) To iResult If (iResult iAnd WS_EX_ACCEPTFILES) Begin If (hWindow = Window_Handle(Self)) Begin Move (Private.RowFromPoint(Self,lParam)) To iRow Move (Private.ColumnFromPoint(Self,lParam)) To iColumn Move (Private.SubColumnFromPoint(Self,lParam)) To iSubColumn If (iRow = -1 Or iColumn = -1 Or iSubColumn = -1) Begin Move (SetCursor(phCursorNo(Self))) To iResult Procedure_Return End // If (iRow = -1 Or iColumn = -1 Or iSubColumn = -1) Begin Move (piRow(Self)) To iOldRow Move (piColumn(Self)) To iOldColumn Move (piSubColumn(Self)) To iOldSubColumn If (iRow = iOldRow And iColumn = iOldColumn And iSubColumn = iOldSubColumn) Procedure_Return // Get length of item Move (Private.piDragging(Self)) To iLength // Dragging in a vertical oriented view If (peOrientation(Self) = omVertical) Begin // Unmark old ZeroType tRECT To sRect Move (Private.ColumnRect(Self,iOldRow,iOldColumn,AddressOf(sRect))) To iResult Move 0 To iHeight For iCount From 0 To (iLength-1) Set piSubColumnExtra (iOldRow+iCount) iOldColumn iOldSubColumn To (RemoveBitValue(seDrag,piSubColumnExtra(Self,iOldRow+iCount,iOldColumn,iOldSubColumn))) Move (iHeight+piRowHeight(Self,iOldRow+iCount)) To iHeight Loop // For iCount From 0 To (iLength-1) GetBuff From sRect at tRECT.top To iTop Put (iTop+iHeight) To sRect at tRECT.bottom Move (InvalidateRect(Window_Handle(Self),AddressOf(sRect),False)) To iResult // Change mouse cursor If (iSubColumn = FromSubColumn(Self) And iColumn = FromColumn(Self) And iRow = FromRow(Self)) Move (SetCursor(phCursorArrow(Self))) To iResult Else If (APIIsValidDropTarget(Self,iRow,iColumn,iSubColumn) = False) Move (SetCursor(phCursorNo(Self))) To iResult Else Begin // Valid drop target Move (SetCursor(phCursorCross(Self))) To iResult // Mark for drag ZeroType tRECT To sRect Move (Private.ColumnRect(Self,iRow,iColumn,AddressOf(sRect))) To iResult Move 0 To iHeight For iCount From 0 To (iLength-1) Set piSubColumnExtra (iRow+iCount) iColumn iSubColumn To (AddBitValue(seDrag,piSubColumnExtra(Self,iRow+iCount,iColumn,iSubColumn))) Move (iHeight+piRowHeight(Self,iRow+iCount)) To iHeight Loop // For iCount From 0 To (iLength-1) GetBuff From sRect at tRECT.top To iTop Put (iTop+iHeight) To sRect at tRECT.bottom Move (InvalidateRect(Window_Handle(Self),AddressOf(sRect),False)) To iResult End // Else Begin End // If (peOrientation(Self) = omVertical) Begin // Dragging in a horizontal oriented view If (peOrientation(Self) = omHorizontal) Begin // Unmark old ZeroType tRECT To sRect Move (Private.ColumnRect(Self,iOldRow,iOldColumn,AddressOf(sRect))) To iResult Move 0 To iWidth For iCount From 0 To (iLength-1) Set piSubColumnExtra iOldRow (iOldColumn+iCount) iOldSubColumn To (RemoveBitValue(seDrag,piSubColumnExtra(Self,iOldRow,iOldColumn+iCount,iOldSubColumn))) Move (iWidth+piColumnWidth(Self,iOldColumn+iCount)) To iWidth Loop // For iCount From 0 To (iLength-1) GetBuff From sRect at tRECT.left To iLeft Put (iLeft+iWidth) To sRect at tRECT.right Move (InvalidateRect(Window_Handle(Self),AddressOf(sRect),False)) To iResult // Change mouse cursor If (iSubColumn = FromSubColumn(Self) And iColumn = FromColumn(Self) And iRow = FromRow(Self)) Move (SetCursor(phCursorArrow(Self))) To iResult Else If (APIIsValidDropTarget(Self,iRow,iColumn,iSubColumn) = False) Move (SetCursor(phCursorNo(Self))) To iResult Else Begin // Valid drop target Move (SetCursor(phCursorCross(Self))) To iResult // Mark for drag ZeroType tRECT To sRect Move (Private.ColumnRect(Self,iRow,iColumn,AddressOf(sRect))) To iResult Move 0 To iWidth For iCount From 0 To (iLength-1) Set piSubColumnExtra iRow (iColumn+iCount) iSubColumn To (AddBitValue(seDrag,piSubColumnExtra(Self,iRow,iColumn+iCount,iSubColumn))) Move (iWidth+piColumnWidth(Self,iColumn+iCount)) To iWidth Loop // For iCount From 0 To (iLength-1) GetBuff From sRect at tRECT.left To iLeft Put (iLeft+iWidth) To sRect at tRECT.right Move (InvalidateRect(Window_Handle(Self),AddressOf(sRect),False)) To iResult End // Else Begin End // If (peOrientation(Self) = omHorizontal) Begin Set piRow To iRow Set piColumn To iColumn Set piSubColumn To iSubColumn // Redraw old and new column Send RepaintSubColumn iOldRow iOldColumn iOldSubColumn Send RepaintSubColumn iRow iColumn iSubColumn End // If (hWindow = Window_Handle(Self)) Begin Else Move (SetCursor(phCursorCross(Self))) To iResult End // If (iResult iAnd WS_EX_ACCEPTFILES) Begin Else Move (SetCursor(phCursorNo(Self))) To iResult End // If (wParam = MK_LBUTTON) Begin Procedure_Return End // If (Private.pbDragging(Self)) Begin If (Private.peResize(Self)) Begin If (wParam = MK_LBUTTON) Begin ZeroType tPOINT To sPoint Move (GetCursorPos(AddressOf(sPoint))) To iResult GetBuff From sPoint at tPOINT.x To iX GetBuff From sPoint at tPOINT.y To iY // Where is the cursor now Move (WindowFromPoint(iX,iY)) To hWindow Move (GetWindowLong(hWindow,GWL_EXSTYLE)) To iResult If (iResult iAnd WS_EX_ACCEPTFILES) Begin If (hWindow = Window_Handle(Self)) Begin Move (Private.RowFromPoint(Self,lParam)) To iRow Move (Private.ColumnFromPoint(Self,lParam)) To iColumn Move (Private.SubColumnFromPoint(Self,lParam)) To iSubColumn If (iRow = -1 Or iColumn = -1 Or iSubColumn = -1) Begin Move (SetCursor(phCursorNo(Self))) To iResult Procedure_Return End // If (iRow = -1 Or iColumn = -1 Or iSubColumn = -1) Begin // Get data Move (piRow(Self)) To iOldRow Move (piColumn(Self)) To iOldColumn Move (piSubColumn(Self)) To iOldSubColumn Move (piSubColumnData(Self,iOldRow,iOldColumn,iOldSubColumn)) To iData If (peOrientation(Self) = omVertical) Begin // User is trying to drag in a different column If (iColumn <> FromColumn(Self)) Begin Move (SetCursor(phCursorNo(Self))) To iResult Procedure_Return End // If (iColumn <> FromColumn(Self)) Begin // User is trying to drag the cell from top past the bottom If (Private.peResize(Self) = rsTop And iOldRow < iRow And piSubColumnExtra(Self,iRow,iColumn,iSubColumn) = 0) Begin Move (SetCursor(phCursorNo(Self))) To iResult Procedure_Return End // If (Private.peResize(Self) = rsTop And iOldRow < iRow And piSubColumnData(Self,iRow,iColumn,iSubColumn) = 0) Begin // User is trying to drag the cell from bottom past the top If (Private.peResize(Self) = rsBottom And iOldRow > iRow And piSubColumnExtra(Self,iRow,iColumn,iSubColumn) = 0) Begin Move (SetCursor(phCursorNo(Self))) To iResult Procedure_Return End // If (Private.peResize(Self) = rsBottom And iOldRow > iRow And piSubColumnData(Self,iRow,iColumn,iSubColumn) = 0) Begin // New focus Set piRow To iRow Set piColumn To iColumn Set piSubColumn To iSubColumn If (Private.peResize(Self) = rsTop And iOldRow < iRow) Begin // top down For iCount From iOldRow To (iRow-1) Set piSubColumnExtra iCount iColumn iOldSubColumn To (RemoveBitValue(seResize,piSubColumnExtra(Self,iCount,iColumn,iOldSubColumn))) Send RepaintSubColumn iCount iColumn iSubColumn Loop // For iCount From iOldRow To iRow End // If (Private.peResize(Self) = rsTop And iOldRow < iRow) Begin Else If (Private.peResize(Self) = rsTop And iOldRow > iRow) Begin // top up For iCount From iRow To iOldRow Set piSubColumnExtra iCount iColumn iSubColumn To (AddBitValue(seResize,piSubColumnExtra(Self,iCount,iColumn,iSubColumn))) Send RepaintSubColumn iCount iColumn iOldSubColumn Loop // For iCount From iRow To iOldRow End // Else If (Private.peResize(Self) = rsTop And iOldRow > iRow) Begin If (Private.peResize(Self) = rsBottom And iOldRow > iRow) Begin // bottom up For iCount From (iRow+1) To iOldRow Set piSubColumnExtra iCount iColumn iOldSubColumn To (RemoveBitValue(seResize,piSubColumnExtra(Self,iCount,iColumn,iOldSubColumn))) Send RepaintSubColumn iCount iColumn iSubColumn Loop // For iCount From iRow To iOldRow End // If (Private.peResize(Self) = rsBottom And iOldRow > iRow) Begin Else If (Private.peResize(Self) = rsBottom And iOldRow < iRow) Begin // bottom down For iCount From (iOldRow+1) To iRow Set piSubColumnExtra iCount iColumn iSubColumn To (AddBitValue(seResize,piSubColumnExtra(Self,iCount,iColumn,iSubColumn))) Send RepaintSubColumn iCount iColumn iSubColumn Loop // For iCount From iOldRow To iRow End // Else If (Private.peResize(Self) = rsBottom And iOldRow < iRow) Begin End // If (peOrientation(Self) = omVertical) Begin If (peOrientation(Self) = omHorizontal) Begin // User is trying to drag in a different row If (iRow <> FromRow(Self)) Begin Move (SetCursor(phCursorNo(Self))) To iResult Procedure_Return End // If (iRow <> FromRow(Self)) Begin // User is trying to drag the cell from left past the right If (Private.peResize(Self) = rsTop And iOldColumn < iColumn And piSubColumnExtra(Self,iRow,iColumn,iSubColumn) = 0) Begin Move (SetCursor(phCursorNo(Self))) To iResult Procedure_Return End // If (Private.peResize(Self) = rsTop And iOldColumn < iColumn And piSubColumnExtra(Self,iRow,iColumn,iSubColumn) = 0) Begin // User is trying to drag the cell from right past the left If (Private.peResize(Self) = rsBottom And iOldColumn > iColumn And piSubColumnExtra(Self,iRow,iColumn,iSubColumn) = 0) Begin Move (SetCursor(phCursorNo(Self))) To iResult Procedure_Return End // If (Private.peResize(Self) = rsBottom And iOldColumn > iColumn And piSubColumnExtra(Self,iRow,iColumn,iSubColumn) = 0) Begin // New focus Set piRow To iRow Set piColumn To iColumn Set piSubColumn To iSubColumn If (Private.peResize(Self) = rsTop And iOldColumn < iColumn) Begin // top down For iCount From iOldColumn To (iColumn-1) Set piSubColumnExtra iRow iCount iSubColumn To (RemoveBitValue(seResize,piSubColumnExtra(Self,iRow,iCount,iSubColumn))) Send RepaintSubColumn iRow iCount iSubColumn Loop // For iCount From iOldColumn To (iColumn-1) End // If (Private.peResize(Self) = rsTop And iOldColumn < iColumn) Begin Else If (Private.peResize(Self) = rsTop And iOldColumn > iColumn) Begin // top up For iCount From iColumn To iOldColumn Set piSubColumnExtra iRow iCount iSubColumn To (AddBitValue(seResize,piSubColumnExtra(Self,iRow,iCount,iSubColumn))) Send RepaintSubColumn iRow iCount iOldSubColumn Loop // For iCount From iColumn To iOldColumn End // Else If (Private.peResize(Self) = rsTop And iOldColumn > iColumn) Begin If (Private.peResize(Self) = rsBottom And iOldColumn > iColumn) Begin // bottom up For iCount From (iColumn+1) To iOldColumn Set piSubColumnExtra iRow iCount iSubColumn To (RemoveBitValue(seResize,piSubColumnExtra(Self,iRow,iCount,iSubColumn))) Send RepaintSubColumn iRow iCount iSubColumn Loop // For iCount From (iColumn+1) To iOldColumn End // If (Private.peResize(Self) = rsBottom And iOldColumn > iColumn) Begin Else If (Private.peResize(Self) = rsBottom And iOldColumn < iColumn) Begin // bottom down For iCount From (iOldColumn+1) To iColumn Set piSubColumnExtra iRow iCount iSubColumn To (AddBitValue(seResize,piSubColumnExtra(Self,iRow,iCount,iSubColumn))) Send RepaintSubColumn iRow iCount iSubColumn Loop // For iCount From iOldColumn To iColumn End // Else If (Private.peResize(Self) = rsBottom And iOldColumn < iColumn) Begin End // If (peOrientation(Self) = omHorizontal) Begin Send RepaintSubColumn iOldRow iOldColumn iOldSubColumn Send RepaintSubColumn iRow iColumn iSubColumn Move (SetCursor(phCursorResize(Self))) To iResult Procedure_Return End // If (hWindow = Window_Handle(Self)) Begin End // If (iResult iAnd WS_EX_ACCEPTFILES) Begin End // If (wParam = MK_LBUTTON) Begin Move (SetCursor(phCursorNo(Self))) To iResult Procedure_Return End // If (Private.peResize(Self)) Begin Move (Private.RowFromPoint(Self,lParam)) To iRow Move (Private.ColumnFromPoint(Self,lParam)) To iColumn Move (Private.SubColumnFromPoint(Self,lParam)) To iSubColumn Move (piSubColumnData(Self,iRow,iColumn,iSubColumn)) To iData // Set standard cursor If (APICanResizeSubColumn(Self,iRow,iColumn,iSubColumn) And wParam = 0) Begin If (iData <> 0) Begin ZeroType tRECT To sRect // Get SubColumn rect Move (Private.SubColumnRect(Self,iRow,iColumn,iSubColumn,AddressOf(sRect))) To iResult If (peOrientation(Self) = omVertical) Begin Set phCursorResize To (LoadCursor(0,IDC_SIZENS)) GetBuff From sRect at tRECT.top To iTop GetBuff From sRect at tRECT.bottom To iBottom If (Hi(lParam) >= (iTop-2) And Hi(lParam) <= (iTop+2) And piSubColumnData(Self,iRow-1,iColumn,iSubColumn) <> iData) ; Move (SetCursor(phCursorResize(Self))) To iResult If (Hi(lParam) >= (iBottom-2) And Hi(lParam) <= (iBottom+2) And piSubColumnData(Self,iRow+1,iColumn,iSubColumn) <> iData) ; Move (SetCursor(phCursorResize(Self))) To iResult End // If (peOrientation(Self) = omVertical) Begin If (peOrientation(Self) = omHorizontal) Begin Set phCursorResize To (LoadCursor(0,IDC_SIZEWE)) GetBuff From sRect at tRECT.left To iTop GetBuff From sRect at tRECT.right To iBottom If (Low(lParam) >= (iTop-2) And Low(lParam) <= (iTop+2) And piSubColumnData(Self,iRow,iColumn-1,iSubColumn) <> iData) ; Move (SetCursor(phCursorResize(Self))) To iResult If (Low(lParam) >= (iBottom-2) And Low(lParam) <= (iBottom+2) And piSubColumnData(Self,iRow,iColumn+1,iSubColumn) <> iData) ; Move (SetCursor(phCursorResize(Self))) To iResult End // If (peOrientation(Self) = omHorizontal) Begin End // If (iData <> 0) Begin End // If (APICanResizeSubColumn(Self,iRow,iColumn,iSubColumn) And wParam = 0) Begin Else Move (SetCursor(phCursorArrow(Self))) To iResult // If Windows_Override_State is set to true, the selected item // doesn't change if user moves mouse Set Windows_Override_State To True End_Procedure // OnWmMouseMove // Procedure : OnWmLButtonUp // Purpose : Handles WM_LBUTTONUP Procedure OnWmLButtonUp Integer wParam Integer lParam Integer iResult iX iY iObject iFrom iCount Integer iRow iColumn iSubColumn Handle hWindow String sPoint If (Private.piDragging(Self)) Begin // Move (piRow(Self)) To iRow // Move (piColumn(Self)) To iColumn // Move (piSubColumn(Self)) To iSubColumn // // Remove drag marking // If (peOrientation(Self) = omVertical) Begin // For iCount From 0 To (Private.piDragging(Self)) // Set piSubColumnExtra (iRow+iCount) iColumn (SubColumnCount(Self,iRow+iCount,iColumn)-1) To seNone // Send RepaintSubColumn (iRow+iCount) iColumn 0 // Loop // For iCount From 0 To (Private.piDragging(Self)) // End // If (peOrientation(Self) = omVertical) Begin // If (peOrientation(Self) = omHorizontal) Begin // For iCount From 0 To (Private.piDragging(Self)) // Set piSubColumnExtra iRow (iColumn+iCount) iSubColumn // Send RepaintSubColumn iRow (iColumn+iCount) 0 // Loop // For iCount From 0 To (Private.piDragging(Self)) // End // If (peOrientation(Self) = omHorizontal) Begin Set Private.piDragging To 0 ZeroType tPOINT To sPoint Move (GetCursorPos(AddressOf(sPoint))) To iResult GetBuff From sPoint at tPOINT.x To iX GetBuff From sPoint at tPOINT.y To iY // Where is the cursor now Move (WindowFromPoint(iX,iY)) To hWindow Move (GetWindowLong(hWindow,GWL_EXSTYLE)) To iResult If (iResult iAnd WS_EX_ACCEPTFILES) Begin Move (Private.RowFromPoint(Self,lParam)) To iRow Move (Private.ColumnFromPoint(Self,lParam)) To iColumn Move (Private.SubColumnFromPoint(Self,lParam)) To iSubColumn If (iRow <> FromRow(Self) Or iColumn <> FromColumn(Self) Or iSubColumn <> FromSubColumn(Self)) Begin If (APIIsValidDropTarget(Self,iRow,iColumn,iSubColumn)) Send OnDrop iRow iColumn iSubColumn End // If (iRow <> FromRow(Self) Or iColumn <> FromColumn(Self) Or iSubColumn <> FromSubColumn(Self)) Begin End // If (iResult iAnd WS_EX_ACCEPTFILES) Begin // Release mouse capture Move (ReleaseCapture()) To iResult // Reset mouse cursor Move (SetCursor(phCursorArrow(Self))) To iResult Send RebuildGrid End // If (Private.pbDragging(Self)) Begin If (Private.peResize(Self)) Begin // Move (piRow(Self)) To iRow // Move (piColumn(Self)) To iColumn // Move (piSubColumn(Self)) To iSubColumn // // Remove resize mark // If (peOrientation(Self) = omVertical) Begin // Move iRow To iCount // While (piSubColumnData(Self,iCount,iColumn,SubColumnCount(Self,iCount,iColumn)-1) = iData) // Set piSubColumnExtra iCount iColumn (SubColumnCount(Self,iCount,iColumn)-1) To seNone // If (Private.peResize(Self) = rsTop) Increment iCount // If (Private.peResize(Self) = rsBottom) Decrement iCount // Send RepaintSubColumn iCount iColumn 0 // Loop // While (piSubColumnData(Self,iCount,iColumn,SubColumnCount(Self,iCount,iColumn)-1) = iData) // End // If (peOrientation(Self) = omVertical) Begin // If (peOrientation(Self) = omHorizontal) Begin // Move iColumn To iCount // While (piSubColumnData(Self,iRow,iCount,iSubColumn) = iData) // Set piSubColumnExtra iRow iCount iSubColumn To seNone // If (Private.peResize(Self) = rsTop) Increment iCount // If (Private.peResize(Self) = rsBottom) Decrement iCount // Send RepaintSubColumn iRow iCount 0 // Loop // While (piSubColumnData(Self,iRow,iCount,iSubColumn) = iData) // End // If (peOrientation(Self) = omHorizontal) Begin ZeroType tPOINT To sPoint Move (GetCursorPos(AddressOf(sPoint))) To iResult GetBuff From sPoint at tPOINT.x To iX GetBuff From sPoint at tPOINT.y To iY // Where is the cursor now Move (WindowFromPoint(iX,iY)) To hWindow Move (GetWindowLong(hWindow,GWL_EXSTYLE)) To iResult If (iResult iAnd WS_EX_ACCEPTFILES) Begin Move (Private.RowFromPoint(Self,lParam)) To iRow Move (Private.ColumnFromPoint(Self,lParam)) To iColumn Move (Private.SubColumnFromPoint(Self,lParam)) To iSubColumn If (iRow <> FromRow(Self) Or iColumn <> FromColumn(Self) Or iSubColumn <> FromSubColumn(Self)) Begin Send OnResize iRow iColumn iSubColumn (Private.peResize(Self) = rsTop) End // If (iRow <> FromRow(Self) Or iColumn <> FromColumn(Self) Or iSubColumn <> FromSubColumn(Self)) Begin End // If (iResult iAnd WS_EX_ACCEPTFILES) Begin Set Private.peResize To rsNone // Release mouse capture Move (ReleaseCapture()) To iResult // Reset mouse cursor Move (SetCursor(phCursorArrow(Self))) To iResult // Rebuild grid Send RebuildGrid End // If (Private.peResize(Self)) Begin End_Procedure // OnWmLButtonUp // Procedure : OnLButtonDoubleClick // Purpose : Handles WM_LBUTTONDBLCLK Procedure OnLButtonDoubleClick Integer wParam Integer lParam Integer iResult iRow iColumn iSubColumn // Release mouse capture Move (ReleaseCapture()) To iResult // First try to activate Get msg_Activate To iResult If (iResult <> 0) Procedure_Return Move (Private.RowFromPoint(Self,lParam)) To iRow Move (Private.ColumnFromPoint(Self,lParam)) To iColumn Move (Private.SubColumnFromPoint(Self,lParam)) To iSubColumn If (iRow = -1 Or iColumn = -1 Or iSubColumn = -1) Procedure_Return Send OnDoubleClick iRow iColumn iSubColumn End_Procedure // OnLButtonDoubleClick // Procedure : OnMouseWheel // Purpose : Handles WM_MOUSEWHEEL Procedure OnMouseWheel Integer wParam Integer lParam Integer iParam Short iDelta Move (Hi(wParam)) To iParam Move (Cast(iParam,short)) To iDelta If (iDelta < 0) Send Private.VScroll SB_LINEDOWN 0 If (iDelta > 0) Send Private.VScroll SB_LINEUP 0 Send Private.AdjustThumb Procedure_Return False End_Procedure // OnMouseWheel // Procedure : Key // Purpose : Handles navigation and searching in the list Procedure Key Integer iKey Returns Integer Integer iResult iPos iMax iMin iPage iVirtualKey iShift iCapslock iChar iItem iTop Integer iOldRow iOldColumn iOldSubColumn Integer iItems iCount String sInfo sValue Get Virtual_Key To iVirtualKey Get Shift_State To iShift Get_Key_State VK_CAPITAL To iCapslock Get To_Ascii iVirtualKey (iShift iAnd KEY_SHIFT <> 0) (iCapslock = 1) To iChar ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put SIF_ALL To sInfo at SCROLLINFO.fMask Move (GetScrollInfo(Window_Handle(Self),SB_VERT,AddressOf(sInfo))) To iResult GetBuff From sInfo at SCROLLINFO.nPos To iPos GetBuff From sInfo at SCROLLINFO.nMax To iMax GetBuff From sInfo at SCROLLINFO.nMin To iMin GetBuff From sInfo at SCROLLINFO.nPage To iPage Move (piRow(Self)) To iOldRow Move (piColumn(Self)) To iOldColumn Move (piSubColumn(Self)) To iOldSubColumn Move (piRow(Self)) To iItem Move (Private.piFirstRow(Self)) To iTop If (iVirtualKey = VK_END) Begin If (iItem = iMax) Procedure_Return If (piSubColumn(Self) >= SubColumnCount(Self,iMax,piColumn(Self))) ; Set piSubColumn To (SubColumnCount(Self,iMax,piColumn(Self))-1) Send Private.VScroll SB_BOTTOM 0 If (piRow(Self) <> iMax) Begin Set piRow To iMax Send RepaintGrid // Optimize! End // If (piRow(Self) <> iMax) Begin Set Windows_Override_State To True Procedure_Return End // If (iVirtualKey = VK_END) Begin If (iVirtualKey = VK_HOME) Begin If (iItem = iMin) Procedure_Return If (piSubColumn(Self) >= SubColumnCount(Self,iMin,piColumn(Self))) ; Set piSubColumn To (SubColumnCount(Self,iMin,piColumn(Self))-1) Send Private.VScroll SB_TOP 0 If (piRow(Self) <> iMin) Begin Set piRow To iMin Send RepaintGrid // Optimize! End // If (piRow(Self) <> iMin) Begin Set Windows_Override_State To True Procedure_Return End // If (iVirtualKey = VK_HOME) Begin If (iVirtualKey = VK_DOWN) Begin If (iItem = iMax) Procedure_Return If (piSubColumn(Self) >= SubColumnCount(Self,piRow(Self)+1,piColumn(Self))) ; Set piSubColumn To (SubColumnCount(Self,piRow(Self)+1,piColumn(Self))-1) //If (LastVisibleRow(Self)-1 < iItem + 1) Send Private.VScroll SB_LINEDOWN 0 Set piRow To (iItem+1) If (iItem+1 > LastVisibleRow(Self)) Begin Move (Private.FindPage(Self,piRow(Self))) To iItem If (iItem <> Private.piFirstRow(Self)) Send Private.vScroll SB_THUMBTRACK iItem Set Private.piFirstRow To iItem End // If (iItem+1 > LastVisibleRow(Self)) Begin Send RepaintSubColumn iOldRow iOldColumn iOldSubColumn Send RepaintSubColumn (piRow(Self)) (piColumn(Self)) (piSubColumn(Self)) Set Windows_Override_State To True Procedure_Return End // If (iVirtualKey = VK_DOWN) Begin If (iVirtualKey = VK_UP) Begin If (iItem = iMin) Procedure_Return If (piSubColumn(Self) >= SubColumnCount(Self,piRow(Self)-1,piColumn(Self))) ; Set piSubColumn To (SubColumnCount(Self,piRow(Self)-1,piColumn(Self))-1) //If (iTop > (iItem - 1)) Send Private.VScroll SB_LINEUP 0 Set piRow To (iItem-1) If (iItem-1 < Private.piFirstRow(Self)) Send Private.vScroll SB_LINEUP 0 Send RepaintSubColumn iOldRow iOldColumn iOldSubColumn Send RepaintSubColumn (piRow(Self)) (piColumn(Self)) (piSubColumn(Self)) Set Windows_Override_State To True Procedure_Return End // If (iVirtualKey = VK_UP) Begin If (iVirtualKey = VK_NEXT) Begin If (iItem = LastVisibleRow(Self)) Send Private.VScroll SB_PAGEDOWN 0 If (piSubColumn(Self) >= SubColumnCount(Self,LastVisibleRow(Self),piColumn(Self))) ; Set piSubColumn To (SubColumnCount(Self,LastVisibleRow(Self),piColumn(Self))-1) Set piRow To (LastVisibleRow(Self)) Send Private.AdjustThumb Send RepaintGrid // Optimize! Set Windows_Override_State To True Procedure_Return End // If (iVirtualKey = VK_NEXT) Begin If (iVirtualKey = VK_PRIOR) Begin If (iItem = FirstVisibleRow(Self)) Send Private.VScroll SB_PAGEUP 0 If (piSubColumn(Self) >= SubColumnCount(Self,FirstVisibleRow(Self),piColumn(Self))) ; Set piSubColumn To (SubColumnCount(Self,FirstVisibleRow(Self),piColumn(Self))-1) Set piRow To (FirstVisibleRow(Self)) Send Private.AdjustThumb Send RepaintGrid // Optimize! Set Windows_Override_State To True Procedure_Return End // If (iVirtualKey = VK_PRIOR) Begin // Horizontal scrolling If (iVirtualKey = VK_LEFT) Begin If (piSubColumn(Self) > 0) ; Set piSubColumn To (piSubColumn(Self)-1) Else Begin //If (piSubColumn(Self) > 0) ; If (piColumn(Self) = 0) Procedure_Return Set piColumn To (piColumn(Self)-1) Set piSubColumn To (SubColumnCount(Self,piRow(Self),piColumn(Self))-1) End // Else Begin Send Private.HScroll SB_COLLEFT 0 Send RepaintSubColumn iOldRow iOldColumn iOldSubColumn Send RepaintSubColumn (piRow(Self)) (piColumn(Self)) (piSubColumn(Self)) Set Windows_Override_State To True Procedure_Return End // If (iVirtualKey = VK_LEFT) Begin If (iVirtualKey = VK_RIGHT) Begin If (piSubColumn(Self) < SubColumnCount(Self,piRow(Self),piColumn(Self))-1) ; Set piSubColumn To (piSubColumn(Self)+1) Else Begin Set piSubColumn To 0 If (piColumn(Self) = ColumnCount(Self)-1) Procedure_Return Set piColumn To (piColumn(Self)+1) End // Else Begin Send Private.HScroll SB_COLRIGHT 0 Send RepaintSubColumn iOldRow iOldColumn iOldSubColumn Send RepaintSubColumn (piRow(Self)) (piColumn(Self)) (piSubColumn(Self)) Set Windows_Override_State To True Procedure_Return End // If (iVirtualKey = VK_RIGHT) Begin If (iVirtualKey = VK_DELETE) Begin Send OnDelete (piRow(Self)) (piColumn(Self)) (piSubColumn(Self)) End // If (iVirtualKey = VK_DEL) Begin // Handle incremental search // If (iChar <> 0) Begin // If (Private.piTime(Self) = 0) Set Private.psSearch To (Character(iChar)) // Else If (GetMessageTime() - Private.piTime(Self) < 1000) Set Private.psSearch To (Private.psSearch(Self)+Character(iChar)) // Else Set Private.psSearch To (Character(iChar)) // Set Private.piTime To (GetMessageTime()) // // Search item based on key pressed // Get RowCount To iItems // Move (SendMessage(Window_Handle(Self),LB_GETCARETINDEX,0,0)+1) To iCount // For iCount From iCount To (iItems-1) // Get APISubColumnText iCount (piColumn(Self)) (piSubColumn(Self)) To sValue // If (UpperCase(Left(sValue,Length(Private.psSearch(Self)))) = Private.psSearch(Self)) Begin // Move (SendMessage(Window_Handle(Self),LB_SETCARETINDEX,iCount,False)) To iResult // Move (SendMessage(Window_Handle(Self),LB_SETCURSEL,iCount,0)) To iResult // Procedure_Return // End // If (UpperCase(Left(sValue,Length(Private.psSearch(Self)))) = Private.psSearch(Self)) Begin // Loop // For iCount From 0 To (iItems-1) // Move (SendMessage(Window_Handle(Self),LB_GETCARETINDEX,0,0)+1) To iItems // For iCount From 0 To (iItems-1) // Get APISubColumnText iCount (piColumn(Self)) (piSubColumn(Self)) To sValue // If (UpperCase(Left(sValue,Length(Private.psSearch(Self)))) = Private.psSearch(Self)) Begin // Move (SendMessage(Window_Handle(Self),LB_SETCARETINDEX,iCount,False)) To iResult // Move (SendMessage(Window_Handle(Self),LB_SETCURSEL,iCount,0)) To iResult // Procedure_Return // End // If (UpperCase(Left(sValue,Length(Private.psSearch(Self)))) = Private.psSearch(Self)) Begin // Loop // For iCount From 0 To (iItems-1) // End // If (iChar <> 0) Begin End_Procedure // Key // Procedure : Private.EraseBkgnd // Purpose : Handles WM_ERASEBKGND Procedure Private.EraseBkgnd Integer wParam Integer lParam Handle hDC Integer iResult Move wParam To hDC Move (SelectObject(hDC,GetStockObject(NULL_PEN))) To iResult Move (SelectObject(hDC,GetStockObject(WHITE_BRUSH))) To iResult Move (Rectangle(hDC,0,Hi(GUISize(phoHeader(Self))),Low(GUISize(Self))+1,Hi(GUISize(Self))+1)) To iResult End_Procedure // Private.EraseBkgnd // Function : Private.ItemHeight // Purpose : Calculates the height of an item Function Private.ItemHeight Integer iRow Returns Integer Integer iResult iBottom iTop iHeight iFormat iImage iWidth iBegin iColumn iSubColumn iSubItems Handle hDC hFont hOldFont hoColumn String sText sRect // Get the device context for the entire screen Move (GetWindowDC(0)) To hDC If (hDC = 0) Error 103 (FormatWinError(GetLastError())) // Only on NT/XP For iColumn From 0 To (ColumnCount(Self)-1) Move (ObjectFromIndex(Self,iColumn)) To hoColumn Move 0 To iBegin Move (piWidth(hoColumn)) To iWidth Move (SubColumnCount(Self,iRow,iColumn) max 1) To iSubItems Move (iWidth / iSubItems) To iWidth For iSubColumn From 0 To (iSubItems-1) If (iSubColumn = iSubItems - 1 And iSubItems <> 1) Begin Move (piWidth(hoColumn) - (iSubItems-1 * iWidth)) To iWidth End // If (iSubColumn = iSubItems - 1) Begin // Get item font Move (APISubColumnFont(Self,iRow,iColumn,iSubColumn)) To hFont // Select the font Move (SelectObject(hDC,hFont)) To hOldFont If (hOldFont = 0) Error 500 "Can't select font" // Create a RECT ZeroType tRECT To sRect Put iBegin+4 To sRect at tRECT.left Put (iBegin+iWidth-4) To sRect at tRECT.right // Get item text Move (APISubColumnText(Self,iRow,iColumn,iSubColumn)) To sText If (sText <> "") Begin Move (ToAnsi(sText)) To sText // Substract image area If (APISubColumnImage(Self,iRow,iColumn,iSubColumn) <> -1) Put (iBegin+4+16+(CXBUTTONMARGIN*2)) To sRect at tRECT.left // right If (peWrapStyle(hoColumn) = wsWrap) Move (DT_CALCRECT iOr DT_WORD_ELLIPSIS iOr DT_WORDBREAK) To iFormat If (peWrapStyle(hoColumn) = wsEllipsis) Move (DT_CALCRECT iOr DT_WORD_ELLIPSIS) To iFormat If (peWrapStyle(hoColumn) = wsClip) Move (DT_CALCRECT) To iFormat If (peAlignment(hoColumn) = alLeft) Move (iFormat iOr DT_LEFT) To iFormat If (peAlignment(hoColumn) = alRight) Move (iFormat iOr DT_RIGHT) To iFormat If (peAlignment(hoColumn) = alCenter) Move (iFormat iOr DT_CENTER) To iFormat // Calculate height Move (DrawText(hDC,AddressOf(sText),-1,AddressOf(sRect),iFormat)) To iResult End // If (sText <> "") Begin // Calculate new left Move (iBegin+iWidth) To iBegin // Select the old font Move (SelectObject(hDC,hOldFont)) To iResult If (iResult = 0) Error 500 "Can't select font" // Delete the font Move (DeleteObject(hFont)) To iResult If (iResult = 0) Error 500 "Can't delete font" // Calculate item height GetBuff From sRect At tRECT.bottom To iBottom GetBuff From sRect At tRECT.top To iTop If ((iBottom-iTop+4) > iHeight) Move (iBottom-iTop+4) To iHeight If (APISUbColumnImage(Self,iRow,iColumn,iSubColumn) <> -1 And 16+(CYBUTTONMARGIN*2) > iHeight) Move (16+(CYBUTTONMARGIN*2)) To iHeight Loop // For iSubColumn From 0 To (iSubItems-1) Loop // For iColumn From 0 To (ColumnCount(Self)-1) // Release the device context Move (ReleaseDC(0,hDC)) To iResult If (iResult = 0) Error 500 "Can't release DC" Function_Return (iHeight+1) End_Function // Private.ItemHeight // Procedure : Private.Paint // Purpose : Handles WM_PAINT Procedure Private.Paint Integer wParam Integer lParam Integer iResult iLeft iTop iRight iBottom iBegin iEnd iCount iWidth iSubItems iData iX Integer iRow iColumn iSubColumn iPos iLines Integer iBackColor iTextColor iOldColor iImage iFormat Integer iFirstRow iLastRow iFirstColumn iLastColumn String sPaint sInfo sArray sText sRect Handle hoColumn hoImageList Handle hDC hWnd hFont hBrush hOldBrush hOldFont hImageList hPen hOldPen Move (Window_Handle(Self)) To hWnd If (hWnd = 0) Procedure_Return ZeroType tRECT To sRect Move (GetUpdateRect(hWnd,AddressOf(sRect),True)) To iResult If (iResult = 0) Procedure_Return // Start paint operation ZeroType PAINTSTRUCT To sPaint Move (BeginPaint(hWnd,AddressOf(sPaint))) To hDC // Get rectangle GetBuff From sPaint at PAINTSTRUCT.rcPaint.left To iLeft GetBuff From sPaint at PAINTSTRUCT.rcPaint.top To iTop GetBuff From sPaint at PAINTSTRUCT.rcPaint.right To iRight GetBuff From sPaint at PAINTSTRUCT.rcPaint.bottom To iBottom // Fix iTop If (iTop < Hi(GUISize(phoHeader(Self)))) Begin Move (Hi(GUISize(phoHeader(Self)))) To iTop Move (iBottom+Hi(GUISize(phoHeader(Self))) Min Hi(GUISize(Self))-Hi(GUISize(phoHeader(Self)))-GetSystemMetrics(SM_CYHSCROLL)) To iBottom End // If (iTop < Hi(GUISize(phoHeader(Self)))) Begin // Calculate first row Move (Private.piFirstRow(Self)) To iFirstRow Move (Hi(GUISize(phoHeader(Self)))) To iPos While (iPos < iTop) Move (iPos+piRowHeight(Self,iFirstRow)) To iPos Increment iFirstRow If (iFirstRow >= RowCount(Self)) Break Loop // While (iPos < iTop) If (iFirstRow > 0 And iPos > iTop) Begin Decrement iFirstRow If (iPos <> iTop) Move (iPos-piRowHeight(Self,iFirstRow)) To iTop End // If (iFirstRow > 0 And iPos > iTop) Begin // Calculate last row Move iFirstRow To iLastRow While (iPos < iBottom) Move (iPos+piRowHeight(Self,iLastRow)) To iPos Increment iLastRow If (iLastRow >= RowCount(Self)) Break Loop // While (iPos < iBottom) Move (iFirstRow Min (RowCount(Self)-1)) To iFirstRow Move (iLastRow Min (RowCount(Self)-1)) To iLastRow Move (Private.ColumnFromPoint(Self,iLeft)) To iFirstColumn Move (Private.ColumnFromPoint(Self,iRight)) To iLastColumn If (iLastColumn = -1) Move (ColumnCount(Self)-1) To iLastColumn If (iFirstColumn = -1) Move (ColumnCount(Self)) To iFirstColumn // Adjust rect for current horizontal scrolling position ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put SIF_POS To sInfo at SCROLLINFO.fMask Move (GetScrollInfo(Window_Handle(Self),SB_HORZ,AddressOf(sInfo))) To iResult GetBuff From sInfo at SCROLLINFO.nPos To iPos Move (iLeft+iPos) To iX For iCount From 0 To (ColumnCount(Self) - 1) // Get column width Move (ObjectFromIndex(Self,iCount)) To hoColumn Move (iWidth + piWidth(hoColumn)) To iWidth If (iWidth > iX) Begin Move (ColumnCount(Self)) To iCount Move (iWidth-piWidth(hoColumn)-iPos) To iLeft Break End // If (iWidth > iX) Begin Loop // For iCount From 0 To (ColumnCount(Self) - 1) If (iFirstRow >= 0 And iLastRow >= 0) Begin For iRow From iFirstRow To iLastRow // Get order of header items Move (Repeat(Character(0),ColumnCount(Self)*4)) To sArray Move (SendMessage(Window_Handle(phoHeader(Self)),HDM_GETORDERARRAY,ColumnCount(Self),AddressOf(sArray))) To iResult Move (iTop+piRowHeight(Self,iRow)) To iBottom // Draw text for all columns Move (iLeft) To iBegin //For iCount From 0 To (ColumnCount(Self)-1) For iCount From iFirstColumn To iLastColumn // (ColumnCount(Self)-1) Move (BytesToDWord(sArray,iCount*4+1)) To iColumn Move (ObjectFromIndex(Self,iColumn)) To hoColumn // Get column width Move (piWidth(hoColumn)) To iWidth Move (SubColumnCount(Self,iRow,iColumn) max 1) To iSubItems Move (iWidth / iSubItems) To iWidth For iSubColumn From 0 To (iSubItems-1) If (iSubColumn = iSubItems - 1 And iSubItems <> 1) Begin Move (piWidth(hoColumn) - (iSubItems-1 * iWidth)) To iWidth End // If (iSubColumn = iSubItems - 1) Begin // Get subcolumn data Move (piSubColumnData(Self,iRow,iColumn,iSubColumn)) To iData // Get subcolumn font Move (APISubColumnFont(Self,iRow,iColumn,iSubColumn)) To hFont // Select the font Move (SelectObject(hDC,hFont)) To hOldFont If (hOldFont = 0) Error 500 "Can't select font" // Get subcolumn background color If (Focus(Desktop) = Self Or pbRetainSelectedItem(Self)) Begin If (iSubColumn = piSubColumn(Self) And iColumn = piColumn(Self) And iRow = piRow(Self)) ; Move (APISubColumnSelectedBackColor(Self,iRow,iColumn,iSubColumn)) To iBackColor Else If (piSubColumnData(Self,piRow(Self),piColumn(Self),piSubColumn(Self)) = iData And iData <> 0) ; Move (APISubColumnSelectedBackColor(Self,iRow,iColumn,iSubColumn)) To iBackColor Else Move (APISubColumnBackColor(Self,iRow,iColumn,iSubColumn)) To iBackColor End // If (Focus(Desktop) = Self) Begin Else Move (APISubColumnBackColor(Self,iRow,iColumn,iSubColumn)) To iBackColor // Draw background Move (CreateSolidBrush(iBackColor)) To hBrush If (hBrush = 0) Error 500 "Can't create brush" // Select brush into DC Move (SelectObject(hDC,hBrush)) To hOldBrush If (iResult = 0) Error 500 "Can't select background brush" Move (SetBkMode(hDC,OPAQUE)) To iResult Move (PatBlt(hDC,iBegin,iTop,iWidth,(iBottom-iTop),PATCOPY)) To iResult Move (SelectObject(hDC,hOldBrush)) To iResult If (iResult = 0) Error 500 "Can't select old background brush" // Delete brush Move (DeleteObject(hBrush)) To iResult If (iResult = 0) Error 500 "Can't delete brush" // Get subcolumn text color If (Focus(Desktop) = Self Or pbRetainSelectedItem(Self)) Begin If (iSubColumn = piSubColumn(Self) And iColumn = piColumn(Self) And iRow = piRow(Self)) ; Move (APISubColumnSelectedTextColor(Self,iRow,iColumn,iSubColumn)) To iTextColor Else If (piSubColumnData(Self,piRow(Self),piColumn(Self),piSubColumn(Self)) = iData And iData <> 0) ; Move (APISubColumnSelectedTextColor(Self,iRow,iColumn,iSubColumn)) To iTextColor Else Move (APISubColumnTextColor(Self,iRow,iColumn,iSubColumn)) To iTextColor End // If (Focus(Desktop) = Self) Begin Else Move (APISubColumnTextColor(Self,iRow,iColumn,iSubColumn)) To iTextColor // Get item image Move (APISubColumnImage(Self,iRow,iColumn,iSubColumn)) To iImage If (iImage <> -1) Begin // Draw image Get phoImageList To hoImageList If hoImageList Get Window_Handle Of hoImageList To hImageList Move (ImageList_Draw(hImageList,iImage,hDC,iBegin+4,iTop+2,ILD_TRANSPARENT)) To iResult End // If (iImage <> -1) Begin // Get item text Move (APISubColumnText(Self,iRow,iColumn,iSubColumn)) To sText If (sText <> "") Begin Move (ToAnsi(sText)) To sText // Draw text Move (SetBkMode(hDC,TRANSPARENT)) To iResult Move (SetTextColor(hDC,iTextColor)) To iResult If (peWrapStyle(hoColumn) = wsWrap) Move (DT_WORDBREAK) To iFormat If (peWrapStyle(hoColumn) = wsEllipsis) Move (DT_WORD_ELLIPSIS) To iFormat If (peWrapStyle(hoColumn) = wsClip) Move (0) To iFormat If (peAlignment(hoColumn) = alLeft) Move (iFormat iOr DT_LEFT) To iFormat If (peAlignment(hoColumn) = alRight) Move (iFormat iOr DT_RIGHT) To iFormat If (peAlignment(hoColumn) = alCenter) Move (iFormat iOr DT_CENTER) To iFormat // Check readonly If (APISubColumnReadOnly(Self,iRow,iColumn,iSubColumn)) Begin If (iBackColor = APISubColumnBackColor(Self,iRow,iColumn,iSubColumn)) Begin ZeroType tRECT To sRect Put iBegin+5 To sRect At tRECT.Left Put iTop+3 To sRect At tRECT.top Put iBegin+iWidth-4 To sRect At tRECT.Right Put iBottom-2 To sRect At tRECT.bottom If (iImage <> -1) Put (iBegin+5+16+(CXBUTTONMARGIN*2)) To sRect at tRECT.left // Draw text 1 pixel down and to the right of actuall text to get shadow Move (SetTextColor(hDC,GetSysColor(COLOR_3DHILIGHT))) To iOldColor Move (DrawText(hDC,AddressOf(sText),-1,AddressOf(sRect),iFormat)) To iResult // Select readonly text color Move (SetTextColor(hDC,clDkGray)) To iResult End // If (iBackColor = APISubColumnBackColor(Self,iRow,iColumn,iSubColumn)) Begin Else Begin Move clDkGray To iTextColor Move (SetTextColor(hDC,clLtGray)) To iResult End // Else Begin End // If (APISubColumnReadOnly(Self,iRow,iColumn,iSubColumn)) Begin // Create rect ZeroType tRECT To sRect Put iBegin+4 To sRect At tRECT.left Put iTop+2 To sRect At tRECT.top Put iBegin+iWidth-4 To sRect At tRECT.right Put iBottom-2 To sRect At tRECT.bottom If (iImage <> -1) Put (iBegin+4+16+(CXBUTTONMARGIN*2)) To sRect at tRECT.left Move (DrawText(hDC,AddressOf(sText),-1,AddressOf(sRect),iFormat)) To iResult End // If (sText <> "") Begin // Draw column line If (peGridLines(Self) iAnd glVertical) Begin // Create pen for item and column separators Move (CreatePen(PS_SOLID,APISubColumnVerticalLineThickness(Self,iRow,iColumn,iSubColumn),APISubColumnVerticalLineColor(Self,iRow,iColumn,iSubColumn))) To hPen If (hPen = 0) Error 500 "Can't create pen" // Select pen into DC Move (SelectObject(hDC,hPen)) To hOldPen If (hOldPen = 0) Error 500 "Can't select pen" If (SubColumnCount(Self,iRow,iColumn) > (iSubColumn+1) And piSubColumnData(Self,iRow,iColumn,iSubColumn) = 0 And piSubColumnData(Self,iRow,iColumn,iSubColumn+1) = 0) Else Begin Move (MoveToEx(hDC,iBegin+iWidth-1,iTop,0)) To iResult Move (LineTo(hDC,iBegin+iWidth-1,iBottom)) To iResult End // Else Begin // Select the old pen Move (SelectObject(hDC,hOldPen)) To iResult If (iResult = 0) Error 500 "Can't select pen" // Delete the pen Move (DeleteObject(hPen)) To iResult If (iResult = 0) Error 500 "Can't delete pen" End // If (peGridLines(Self) iAnd glVertical) Begin // Draw item line If (peGridLines(Self) iAnd glHorizontal) Begin // Create pen for item and column separators If (piSubColumnExtra(Self,iRow,iColumn,iSubColumn) <> 0 And peOrientation(Self) = omHorizontal) ; Move (CreatePen(PS_SOLID,APISubColumnHorizontalLineThickness(Self,iRow,iColumn,iSubColumn),APISubColumnHorizontalLineColor(Self,iRow,iColumn,iSubColumn))) To hPen Else If (APISubColumnSelectedBackColor(Self,iRow,iColumn,iSubColumn) = iBackColor) ; Move (CreatePen(PS_SOLID,APISubColumnHorizontalLineThickness(Self,iRow,iColumn,iSubColumn),iBackColor)) To hPen // Else If (piSubColumnData(Self,piRow(Self),piColumn(Self),piSubColumn(Self)) = iData And iData <> 0) ; // Move (CreatePen(PS_SOLID,APISubColumnHorizontalLineThickness(Self,iRow,iColumn,iSubColumn),APISubColumnSelectedBackColor(Self,iRow,iColumn,iSubColumn))) To hPen Else Move (CreatePen(PS_SOLID,APISubColumnHorizontalLineThickness(Self,iRow,iColumn,iSubColumn),APISubColumnHorizontalLineColor(Self,iRow,iColumn,iSubColumn))) To hPen If (hPen = 0) Error 500 "Can't create pen" // Select pen into DC Move (SelectObject(hDC,hPen)) To hOldPen If (hOldPen = 0) Error 500 "Can't select pen" Move (MoveToEx(hDC,iBegin,iBottom-1,0)) To iResult Move (LineTo(hDC,iBegin+iWidth,iBottom-1)) To iResult // Select the old pen Move (SelectObject(hDC,hOldPen)) To iResult If (iResult = 0) Error 500 "Can't select pen" // Delete the pen Move (DeleteObject(hPen)) To iResult If (iResult = 0) Error 500 "Can't delete pen" End // If (peGridLines(Self) iAnd glHorizontal) Begin // Draw focus rectangle ZeroType tRECT To sRect Put iBegin To sRect At tRECT.left Put iTop To sRect At tRECT.top Put (iBegin+iWidth-APISubColumnVerticalLineThickness(Self,iRow,iColumn,iSubColumn)) To sRect At tRECT.right Put (iBottom-APISubColumnHorizontalLineThickness(Self,iRow,iColumn,iSubColumn)) To sRect At tRECT.bottom Move (APISubColumnTextColor(Self,iRow,iColumn,iSubColumn)) To iTextColor Move (SetTextColor(hDC,iTextColor)) To iResult If (Focus(Desktop) = Self) Begin If (iSubColumn = piSubColumn(Self) And iColumn = piColumn(Self) And iRow = piRow(Self)) Begin Move (SetTextColor(hDC,clBlack)) To iResult Move (DrawFocusRect(hDC,AddressOf(sRect))) To iResult End // If (iSubColumn = piSubColumn(Self) And iColumn = piColumn(Self) And iRow = piRow(Self)) Begin End // If (Focus(Desktop) = Self) Begin // Calculate new left Move (iBegin+iWidth) To iBegin // Select the old font Move (SelectObject(hDC,hOldFont)) To iResult If (iResult = 0) Error 500 "Can't select font" // Delete the font Move (DeleteObject(hFont)) To iResult If (iResult = 0) Error 500 "Can't delete font" Loop // For iSubColumn From 0 To (iSubItems-1) Loop // For iCount From 0 To (ColumnCount(Self)-1) // Select white brush into DC Move (SelectObject(hDC,GetStockObject(WHITE_BRUSH))) To hOldBrush If (iResult = 0) Error 500 "Can't select white brush" Move (SetBkMode(hDC,OPAQUE)) To iResult Move (PatBlt(hDC,iBegin,iTop,iRight-iBegin,(iBottom-iTop),PATCOPY)) To iResult Move (SelectObject(hDC,hOldBrush)) To iResult If (iResult = 0) Error 500 "Can't select old white brush" // Adjust rect Move (iTop+piRowHeight(Self,iRow)) To iTop Loop // For iRow From iFirstRow To iLastRow End // For iCount From iFirstColumn To iLastColumn // Select brush into DC Move (SelectObject(hDC,GetStockObject(WHITE_BRUSH))) To hOldBrush If (iResult = 0) Error 500 "Can't select white brush" Move (SetBkMode(hDC,OPAQUE)) To iResult GetBuff From sPaint at PAINTSTRUCT.rcPaint.bottom To iBottom Move (PatBlt(hDC,0,iTop,iRight,iBottom,PATCOPY)) To iResult Move (SelectObject(hDC,hOldBrush)) To iResult If (iResult = 0) Error 500 "Can't select old white brush" // End paint operation Move (EndPaint(hWnd,AddressOf(sPaint))) To iResult Procedure_Return False // handled End_Procedure // Private.Paint // Procedure : Private.HScroll // Purpose : Handles WM_HSCROLL Procedure Private.HScroll Integer wParam Integer lParam Integer iResult iOld iPos iMax iMin iPage iWidth iCounter String sInfo sRect If (Low(wParam) = SB_ENDSCROLL) Procedure_Return ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put SIF_ALL To sInfo at SCROLLINFO.fMask Move (GetScrollInfo(Window_Handle(Self),SB_HORZ,AddressOf(sInfo))) To iResult GetBuff From sInfo at SCROLLINFO.nPos To iPos GetBuff From sInfo at SCROLLINFO.nPos To iOld GetBuff From sInfo at SCROLLINFO.nMax To iMax GetBuff From sInfo at SCROLLINFO.nMin To iMin GetBuff From sInfo at SCROLLINFO.nPage To iPage If (Low(wParam) = SB_LINERIGHT) Begin If (iPos = iMax) Procedure_Return Move (iPos+1) To iPos End // If (Low(wParam) = SB_LINERIGHT) Begin If (Low(wParam) = SB_COLRIGHT) Begin If (piColumn(Self) >= FirstVisibleColumn(Self) And piColumn(Self) <= LastVisibleColumn(Self)) Else Begin Move (iPos+piColumnWidth(Self,piColumn(Self))) To iPos // For iCounter From 0 To (piColumn(Self)) // Move (iWidth+piColumnWidth(Self,iCounter)) To iWidth // Loop // For iCounter From 0 To (piColumn(Self)-1) // If (iWidth > iMax) Move iMax To iPos // Else Move iWidth To iPos End // Else Begin End // If (Low(wParam) = SB_COLRIGHT) Begin If (Low(wParam) = SB_LINELEFT) Begin If (iPos = iMin) Procedure_Return Move (iPos-1) To iPos End // If (Low(wParam) = SB_LINELEFT) Begin If (Low(wParam) = SB_COLLEFT) Begin If (piColumn(Self) >= FirstVisibleColumn(Self) And piColumn(Self) <= LastVisibleColumn(Self)) Else Begin For iCounter From 0 To (piColumn(Self)-1) Move (iWidth+piColumnWidth(Self,iCounter)) To iWidth Loop // For iCounter From 0 To (piColumn(Self)-1) If (iWidth > iMax) Move iMax To iPos Else Move iWidth To iPos End // Else Begin End // If (Low(wParam) = SB_COLLEFT) Begin If (Low(wParam) = SB_PAGERIGHT) Begin If (iPos = iMax) Procedure_Return If (iPos+iPage >= iMax) Move (iMax-iPage) To iPos Move (iPos+iPage) To iPos End // If (Low(wParam) = SB_PAGERIGHT) Begin If (Low(wParam) = SB_PAGELEFT) Begin If (iPos = iMin) Procedure_Return If (iPos-iPage <= iMin) Move (iMin+iPage) To iPos Move (iPos-iPage) To iPos End // If (Low(wParam) = SB_PAGELEFT) Begin If (Low(wParam) = SB_RIGHT) Move iMax To iPos If (Low(wParam) = SB_LEFT) Move iMin To iPos If (Low(wParam) = SB_THUMBPOSITION) Move (Hi(wParam)) To iPos If (Low(wParam) = SB_THUMBTRACK) Move (Hi(wParam)) To iPos // Set scrollbar properties Put (SIF_POS iOr SIF_DISABLENOSCROLL) To sInfo at SCROLLINFO.fMask Put iPos To sInfo at SCROLLINFO.nPos Move (SetScrollInfo(Window_Handle(Self),SB_HORZ,AddressOf(sInfo),True)) To iResult // Get the ScrollInfo again because Windows may adjust the values Move (GetScrollInfo(Window_Handle(Self),SB_HORZ,AddressOf(sInfo))) To iResult GetBuff From sInfo at SCROLLINFO.nPos To iPos // Scroll header control //Move (SetWindowPos(Window_Handle(phoHeader(Self)),0,(iPos*-1),0,0,0,SWP_NOSENDCHANGING+SWP_NOSIZE+SWP_NOZORDER+SWP_NOACTIVATE)) To iResult ZeroType tRECT To sRect Put 0 To sRect at tRECT.top Put 0 To sRect at tRECT.left Put (Hi(GUISize(Self))-GetSystemMetrics(SM_CYHSCROLL)) To sRect at tRECT.bottom Put (Low(GUISize(Self))-GetSystemMetrics(SM_CXVSCROLL)) To sRect at tRECT.right Move (ScrollWindowEx(Window_Handle(Self),iOld-iPos,0,AddressOf(sRect),AddressOf(sRect),0,0,SW_INVALIDATE+SW_SCROLLCHILDREN)) To iResult End_Procedure // Private.HScroll // Procedure : Private.VScroll // Purpose : Handles WM_VSCROLL Procedure Private.VScroll Integer wParam Integer lParam Integer iResult iPos iMax iMin iItem iScroll String sInfo sRect If (Low(wParam) = SB_ENDSCROLL) Procedure_Return ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put SIF_ALL To sInfo at SCROLLINFO.fMask Move (GetScrollInfo(Window_Handle(Self),SB_VERT,AddressOf(sInfo))) To iResult GetBuff From sInfo at SCROLLINFO.nPos To iPos GetBuff From sInfo at SCROLLINFO.nMax To iMax GetBuff From sInfo at SCROLLINFO.nMin To iMin If (Low(wParam) = SB_BOTTOM) Begin If (LastVisibleRow(Self) = iMax) Procedure_Return Move (Private.FindPage(Self,iMax)) To iPos Set Private.piFirstRow To iPos End // If (Low(wParam) = SB_BOTTOM) Begin If (Low(wParam) = SB_TOP) Begin If (FirstVisibleRow(Self) = iMin) Procedure_Return Move iMin To iPos Set Private.piFirstRow To iMin End // If (Low(wParam) = SB_TOP) Begin If (Low(wParam) = SB_LINEUP) Begin If (FirstVisibleRow(Self) = iMin) Procedure_Return Move (Private.piFirstRow(Self)-1) To iPos Set Private.piFirstRow To iPos Move (piRowHeight(Self,iPos)) To iScroll End // If (Low(wParam) = SB_LINEUP) Begin If (Low(wParam) = SB_LINEDOWN) Begin If (LastVisibleRow(Self) = iMax) Procedure_Return Move (Private.piFirstRow(Self)+1) To iPos Set Private.piFirstRow To iPos Move (piRowHeight(Self,iPos-1)*-1) To iScroll End // If (Low(wParam) = SB_LINEDOWN) Begin If (Low(wParam) = SB_PAGEUP) Begin If (FirstVisibleRow(Self) = iMin) Procedure_Return Move (Private.FindPage(Self,Private.piFirstRow(Self))) To iPos If (iPos = Private.piFirstRow(Self)) Move (iPos-1) To iPos Set Private.piFirstRow To iPos End // If (Low(wParam) = SB_PAGEUP) Begin If (Low(wParam) = SB_PAGEDOWN) Begin If (LastVisibleRow(Self) = iMax) Procedure_Return If (iPos = LastVisibleRow(Self)) Move (iPos+1) To iPos Else Move (LastVisibleRow(Self)) To iPos Set Private.piFirstRow To iPos End // If (Low(wParam) = SB_PAGEDOWN) Begin If (Low(wParam) = SB_THUMBPOSITION) Begin Move (Hi(wParam)) To iPos Set Private.piFirstRow To iPos // Optimize! using iScroll Send Private.AdjustThumb End // If (Low(wParam) = SB_THUMBPOSITION) Begin If (Low(wParam) = SB_THUMBTRACK) Begin Move (Hi(wParam)) To iPos Set Private.piFirstRow To iPos // Optimize! using iScroll Send Private.AdjustThumb End // If (Low(wParam) = SB_THUMBTRACK) Begin // Set ScrollBar properties Put (SIF_POS iOr SIF_DISABLENOSCROLL) To sInfo at SCROLLINFO.fMask Put iItem To sInfo at SCROLLINFO.nPos Move (SetScrollInfo(Window_Handle(Self),SB_VERT,AddressOf(sInfo),True)) To iResult If (iScroll) Begin ZeroType tRECT To sRect Put (Hi(GUISize(phoHeader(Self)))) To sRect at tRECT.top Put 0 To sRect at tRECT.left Put (Hi(GUISize(Self))-GetSystemMetrics(SM_CYHSCROLL)) To sRect at tRECT.bottom Put (Low(GUISize(Self))-GetSystemMetrics(SM_CXVSCROLL)) To sRect at tRECT.right Move (ScrollWindowEx(Window_Handle(Self),0,iScroll,AddressOf(sRect),AddressOf(sRect),0,0,SW_INVALIDATE)) To iResult //Move (ScrollWindowEx(Window_Handle(Self),0,iScroll,0,0,0,0,SW_INVALIDATE)) To iResult End // If (iScroll) Begin Else If (Low(wParam) = SB_THUMBTRACK Or Low(wParam) = SB_THUMBPOSITION) Move (InvalidateRect(Window_Handle(Self),0,False)) To iResult Else Move (InvalidateRect(Window_Handle(Self),0,True)) To iResult Send Private.AdjustThumb End_Procedure // Private.VScroll // Procedure : Private.AdjustThumb // Purpose : Adjusts the thumb size based on currently displayed page Procedure Private.AdjustThumb Integer iResult iRows iTop iCounter iHeight iSize String sInfo // Calculate new page size Get RowCount To iRows Move (Hi(GUISize(Self))) To iSize Move (iSize-Hi(GUISize(phoHeader(Self)))) To iSize Move (iSize-GetSystemMetrics(SM_CYHSCROLL)) To iSize Move (Private.piFirstRow(Self)) To iTop Move iTop To iCounter While (iCounter < iRows And iHeight < iSize) Move (iHeight + piRowHeight(Self,iCounter)) To iHeight Increment iCounter Loop // While (iCounter < iItems And iHeight < iSize) // Substract partially visible item If (iHeight > iSize) Decrement iCounter // Set vertical scrollbar info ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put (SIF_PAGE iOr SIF_POS iOr SIF_DISABLENOSCROLL) To sInfo at SCROLLINFO.fMask Put (iCounter - iTop) To sInfo at SCROLLINFO.nPage Put iTop To sInfo at SCROLLINFO.nPos Move (SetScrollInfo(Window_Handle(Self),SB_VERT,AddressOf(sInfo),True)) To iResult End_Procedure // Private.AdjustThumb // Procedure : Private.AdjustHorizontalBar // Purpose : Adjust the thumb for the horizontal scrollbar Procedure Private.AdjustHorizontalBar Integer iResult iCounter iWidth iPos String sInfo For iCounter From 0 To (ColumnCount(Self)-1) Move (iWidth+piColumnWidth(Self,iCounter)) To iWidth Loop // For iCounter From 0 To (ColumnCount(Self)-1) // Set horizontal scrollbar info ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put (SIF_ALL iOr SIF_DISABLENOSCROLL) To sInfo at SCROLLINFO.fMask Move (GetScrollInfo(Window_Handle(Self),SB_HORZ,AddressOf(sInfo))) To iResult GetBuff From sInfo at SCROLLINFO.nPos To iPos Put (SIF_ALL iOr SIF_DISABLENOSCROLL) To sInfo at SCROLLINFO.fMask Put 0 To sInfo at SCROLLINFO.nMin Put iWidth To sInfo at SCROLLINFO.nMax Put (Low(GUISize(Self))-20) To sInfo at SCROLLINFO.nPage Put iPos To sInfo at SCROLLINFO.nPos Move (SetScrollInfo(Window_Handle(Self),SB_HORZ,AddressOf(sInfo),True)) To iResult End_Procedure // Private.AdjustHorizontalBar // Procedure : Private.AdjustVerticalBar // Purpose : Adjusts the thumb for the vertical scrollbar Procedure Private.AdjustVerticalBar Integer iResult iCounter iTop iPage iSize Number nHeight String sInfo // This uses integers for the calculation, and therefore we loose precision Move (Private.piFirstRow(Self)) To iTop For iCounter From 0 To (RowCount(Self)-1) Move (nHeight+piRowHeight(Self,iCounter)) To nHeight Loop // For iCounter From iTop To (iItems - 1) Move (nHeight / RowCount(Self)) To nHeight Move (Hi(GUISize(Self))) To iSize Move (iSize-Hi(GUISize(phoHeader(Self)))) To iSize Move (iSize-GetSystemMetrics(SM_CYHSCROLL)) To iSize Move (iSize / (nHeight + 0.5)) To iPage // Set vertical scrollbar info ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put (SIF_ALL iOr SIF_DISABLENOSCROLL) To sInfo at SCROLLINFO.fMask Put 0 To sInfo at SCROLLINFO.nMin Put (RowCount(Self)-1) To sInfo at SCROLLINFO.nMax Put iPage To sInfo at SCROLLINFO.nPage Put iTop To sInfo at SCROLLINFO.nPos Move (SetScrollInfo(Window_Handle(Self),SB_VERT,AddressOf(sInfo),True)) To iResult End_Procedure // Private.AdjustVerticalBar // Procedure : Private.AdjustHeader // Purpose : Sets the location of the header Procedure Private.AdjustHeader Integer iResult iCounter iColumns iWidth iPos iPage String sInfo Move (CountOfObjects(phoColumns(Self))) To iColumns For iCounter From 0 To (iColumns-1) Move (iWidth+piWidth(ObjectFromIndex(Self,iCounter))) To iWidth Loop // For iCounter From 0 To (iColumns-1) // Set horizontal position ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put SIF_ALL To sInfo at SCROLLINFO.fMask Move (GetScrollInfo(Window_Handle(Self),SB_HORZ,AddressOf(sInfo))) To iResult GetBuff From sInfo at SCROLLINFO.nPos To iPos GetBuff From sInfo at SCROLLINFO.nPage To iPage Set GUISize Of (phoHeader(Self)) To (Hi(GUISize(phoHeader(Self)))) (iWidth+1 Max Low(GUISize(Self))+1) Set GUILocation Of (phoHeader(Self)) To (Hi(GUILocation(phoHeader(Self)))) (iPos*-1) End_Procedure // Private.AdjustHeader // Procedure : Private.Resize // Purpose : Repositions the grid controls after resize Procedure Private.Resize Integer iResult iX iY iColumns iCounter iWidth Handle hFont // Header control Set GUILocation Of (phoHeader(Self)) To 0 0 Set GUISize Of (phoHeader(Self)) To 20 (Low(GUISize(Self))-20) // Set font of header control Get APISubColumnFont 0 0 0 To hFont Move (SendMessage(Window_Handle(phoHeader(Self)),WM_SETFONT,hFont,False)) To iResult // Add columns to Header control Move (CountOfObjects(phoColumns(Self))) To iColumns For iCounter From 0 To (iColumns - 1) Move (piColumnWidth(Self,iCounter)+iWidth) To iWidth Loop // For iCounter From 0 To (iColumns - 1) Set GUISize Of (phoHeader(Self)) To (Hi(GUISize(phoHeader(Self)))) (iWidth+1 Max Low(GUISize(Self))) Send RepaintGrid End_Procedure // Private.Resize // Procedure : Page_Object // Purpose : Page and position child objects Procedure Page_Object Integer iState Integer iResult iColumns iCounter Forward Send Page_Object iState If (iState) Begin // The order in which these objects are paged is important! The header object must be // paged before the scrollbars for WS_CLIPSIBLINGS to work. // Header control Send Page_Object To (phoHeader(Self)) True Move (SetParent(Window_Handle(phoHeader(Self)),Window_Handle(Self))) To iResult If (Private.phoImageList(Self)) Set phoImageList To (Private.phoImageList(Self)) Move (SetClassLong(Window_Handle(phoHeader(Self)),GCL_STYLE,$0083)) To iResult // Add columns to Header control Move (CountOfObjects(phoColumns(Self))) To iColumns For iCounter From 0 To (iColumns - 1) Send Private.InsertHeaderColumn To (ObjectFromIndex(Self,iCounter)) -1 Loop // For iCounter From 0 To (iColumns - 1) Send Private.InitGrid Send OnFillGrid Send Private.Resize End // If (iState) Begin End_Procedure // Page_Object // Procedure : Private.SetFocus // Purpose : Handles WM_SETFOCUS Procedure Private.SetFocus Send RepaintSubColumn (piRow(Self)) (piColumn(Self)) (piSubColumn(Self)) Send Private.AdjustVerticalBar Send OnSetFocus End_Procedure // Private.SetFocus // Procedure : Private.KillFocus // Purpose : Handles WM_KILLFOCUS Procedure Private.KillFocus Send RepaintSubColumn (piRow(Self)) (piColumn(Self)) (piSubColumn(Self)) Send OnKillFocus End_Procedure // Private.KillFocus // Procedure : Private.RegisterItem // Purpose : Registers a header item in the oItems collection Procedure Private.RegisterItem Handle hoObject If (phoColumns(Self)) Send DoAppendObject To (phoColumns(Self)) hoObject End_Procedure // Private.RegisterItem // Procedure : Private.UnregisterItem // Purpose : Un-registers a header item in the oItems collection Procedure Private.UnregisterItem Handle hoObject If (Object_Id(phoColumns(Self))) Send DoRemoveObject To (phoColumns(Self)) hoObject End_Procedure // Private.UnregisterItem // Procudure : Private.InitGrid // Purpose : Allocates memory for grid Procedure Private.InitGrid Integer iResult iRows iColumns iSubColumns iData iWidth iCount Pointer pGrid pColumn pSubColumn // Free subcolumn data For iRows From 0 To (Private.piRowCount(Self)-1) For iColumns From 0 To (Private.piColumnCount(Self)-1) Get Private.piColumnData iRows iColumns To pSubColumn Move (Free(pSubColumn)) To iResult Loop // For iColumns From 0 To (Private.piColumnCount(Self)-1) Loop // For iRows From 0 To (Private.piRowCount(Self)-1) // Free row and column data Move (Free(Private.phData(Self))) To iResult Set Private.piRowCount To 0 Set Private.piColumnCount To 0 // Allocate row and column data Move (Alloc(APIRowCount(Self)*(ColumnCount(Self)+2)*4)) To pGrid Set Private.phData To pGrid Set Private.piRowCount To (APIRowCount(Self)) Set Private.piColumnCount To (ColumnCount(Self)) // Allocate subcolumn data For iRows From 0 To (APIRowCount(Self)-1) For iColumns From 0 To (ColumnCount(Self)-1) // Determine how many subcolumns we should create Move (APISubColumnCount(Self,iRows,iColumns) Max 1) To iSubColumns // Allocate memory for the subcolumns Move (Alloc(iSubColumns*8+4)) To pSubColumn Set Private.piColumnData iRows iColumns To pSubColumn Set Private.piSubColumnCount iRows iColumns To iSubColumns // Set data for the subcolumns For iSubColumns From 0 To (SubColumnCount(Self,iRows,iColumns)-1) Set piSubColumnData iRows iColumns iSubColumns To (APISubColumnData(Self,iRows,iColumns,iSubColumns)) Set piSubColumnExtra iRows iColumns iSubColumns To 0 Loop // For iSubColumns From 0 To (SubColumnCount(Self,iRows,iColumns)-1) Loop // For iColumns From 0 To (ColumnCount(Self)-1) Set piRowHeight iRows To 0 Loop // For iRows From 0 To (APIRowCount(Self)-1) End_Procedure // Private.InitGrid // Function : Private.ColumnRect // Purpose : Returns string containing a RECT structure //Function Private.ColumnRect Integer iRow Integer iColumn Pointer pRect Returns Integer Function Private.ColumnRect Integer iRow Integer iColumn Address sRect Returns Integer Integer iResult iCount iPos iWidth iHeight String sInfo Handle hoColumn // Calculate left ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put SIF_POS To sInfo at SCROLLINFO.fMask Move (GetScrollInfo(Window_Handle(Self),SB_HORZ,AddressOf(sInfo))) To iResult GetBuff From sInfo at SCROLLINFO.nPos To iPos For iCount From 0 To (iColumn-1) Move (ObjectFromIndex(Self,iCount)) To hoColumn Move (iWidth+piWidth(hoColumn)) To iWidth Loop // For iCount From 0 To (iColumn-1) Move (StoreDW(sRect,0,iWidth-iPos)) To iResult // Calculate top Move (Hi(GUISize(phoHeader(Self)))) To iHeight For iCount From (Private.piFirstRow(Self)) To (iRow-1) Move (iHeight+piRowHeight(Self,iCount)) To iHeight Loop // For iCount From (Private.piFirstRow(Self)) To iRow Move (StoreDW(sRect,4,iHeight)) To iResult // Calculate right Move (StoreDW(sRect,8,iWidth-iPos+piColumnWidth(Self,iColumn))) To iResult // Calculate bottom Move (StoreDW(sRect,12,iHeight+piRowHeight(Self,iRow))) To iResult Function_Return True End_Function // Private.ColumnRect // Function : Private.SubColumnRect // Purpose : Returns string containing a RECT structure Function Private.SubColumnRect Integer iRow Integer iColumn Integer iSubColumn Address sRect Returns Integer Integer iResult iCount iPos iWidth iHeight iSubItems iLeft String sInfo Handle hoColumn // Calculate left ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put SIF_POS To sInfo at SCROLLINFO.fMask Move (GetScrollInfo(Window_Handle(Self),SB_HORZ,AddressOf(sInfo))) To iResult GetBuff From sInfo at SCROLLINFO.nPos To iPos For iCount From 0 To (iColumn-1) Move (ObjectFromIndex(Self,iCount)) To hoColumn Move (iLeft+piWidth(hoColumn)) To iLeft Loop // iCount From 0 To (iColumn-1) // Calculate left Move (SubColumnCount(Self,iRow,iColumn) max 1) To iSubItems Move (ObjectFromIndex(Self,iColumn)) To hoColumn Move (piWidth(hoColumn)) To iWidth Move (iWidth / iSubItems) To iWidth Move (StoreDW(sRect,0,iLeft-iPos+(iWidth*iSubColumn))) To iResult // Calculate top Move (Hi(GUISize(phoHeader(Self)))) To iHeight For iCount From (Private.piFirstRow(Self)) To (iRow-1) Move (iHeight+piRowHeight(Self,iCount)) To iHeight Loop // For iCount From (Private.piFirstRow(Self)) To (iRow-1) Move (StoreDW(sRect,4,iHeight)) To iResult // Calculate right Move (ObjectFromIndex(Self,iColumn)) To hoColumn If (hoColumn) Move (StoreDW(sRect,8,iLeft-iPos+(iWidth*(iSubColumn+1)))) To iResult // Calculate bottom Move (StoreDW(sRect,12,iHeight+piRowHeight(Self,iRow))) To iResult Function_Return True End_Function // Private.SubColumnRect // Function : Private.RowFromPoint // Purpose : Returns row number from the passed coordinate Function Private.RowFromPoint Integer lParam Returns Integer Integer iResult iCurrent iCount iX iPos Move (Private.piFirstRow(Self)) To iCurrent Move (Hi(GUISize(phoHeader(Self)))) To iPos Move (Hi(lParam)) To iX For iCount From iCurrent To (RowCount(Self)-1) // Get row height Move (iPos + piRowHeight(Self,iCount)) To iPos If (iPos > iX) Function_Return iCount Loop // For iCount From 0 To (RowCount(Self)-1) Function_Return -1 End_Function // Private.RowFromPoint // Function : Private.ColumnFromPoint // Purpose : Returns column number from the passed coordinate Function Private.ColumnFromPoint Integer lParam Returns Integer Integer iResult iCount iWidth iPos iX Handle hoColumn String sInfo ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put (SIF_POS) To sInfo at SCROLLINFO.fMask Move (GetScrollInfo(Window_Handle(Self),SB_HORZ,AddressOf(sInfo))) To iResult GetBuff From sInfo at SCROLLINFO.nPos To iPos Move (Low(lParam)+iPos) To iX For iCount From 0 To (ColumnCount(Self) - 1) // Get column width Move (ObjectFromIndex(Self,iCount)) To hoColumn Move (iWidth + piWidth(hoColumn)) To iWidth If (iWidth > iX) Function_Return iCount Loop // For iCount From 0 To (ColumnCount(Self) - 1) Function_Return -1 End_Function // Private.ColumnFromPoint // Function : Private.SubColumnFromPoint // Purpose : Returns sub-column number for the passed coordinate Function Private.SubColumnFromPoint Integer lParam Returns Integer Integer iResult iCount iWidth iPos iSubColumns iRow iX Handle hoColumn String sInfo Move (Private.RowFromPoint(Self,lParam)) To iRow ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put (SIF_POS) To sInfo at SCROLLINFO.fMask Move (GetScrollInfo(Window_Handle(Self),SB_HORZ,AddressOf(sInfo))) To iResult GetBuff From sInfo at SCROLLINFO.nPos To iPos Move (Low(lParam)+iPos) To iX For iCount From 0 To (ColumnCount(Self) - 1) // Get column width Move (ObjectFromIndex(Self,iCount)) To hoColumn Move (iWidth + piWidth(hoColumn)) To iWidth If (iWidth > iX) Begin // Found column, now find sub-column Move (iWidth - piWidth(hoColumn)) To iWidth Get SubColumnCount iRow iCount To iSubColumns For iCount From 0 To (iSubColumns-1) Move (iWidth + (piWidth(hoColumn) / iSubColumns)) To iWidth If (iWidth > iX) Function_Return iCount Loop // For iCount From 0 To (iSubColumns-1) Function_Return -1 End // If (iWidth > iX) Begin Loop // For iCount From 0 To (ColumnCount(Self) - 1) Function_Return -1 End_Function // Private.SubColumnFromPoint // Function : Private.piColumnData // Purpose : Returns column data Function Private.piColumnData Integer iRow Integer iColumn Returns Integer Integer iColumns Pointer pData Move (Private.phData(Self)) To pData Move (Private.piColumnCount(Self)) To iColumns If (pData) Function_Return (DerefDW(pData,iRow*(iColumns+2)*4+(iColumn+2*4))) End_Function // Private.piColumnData // Procedure : Set Private.piColumnData // Purpose : Sets colummn data Procedure Set Private.piColumnData Integer iRow Integer iColumn Integer iData Integer iResult iColumns Pointer pData If (iRow >= RowCount(Self) Or iColumn >= ColumnCount(Self)) Procedure_Return Move (Private.phData(Self)) To pData Move (Private.piColumnCount(Self)) To iColumns If (pData) Move (StoreDW(pData,iRow*(iColumns+2)*4+(iColumn+2*4),iData)) To iResult End_Procedure // Set Private.piColumnData // Procedure : Set Private.piSubColumnCount // Purpose : Sets the subcolumn count Procedure Set Private.piSubColumnCount Integer iRow Integer iColumn Integer iCount Integer iResult Pointer pRow pColumn If (iRow >= RowCount(Self) Or iColumn >= ColumnCount(Self)) Procedure_Return Move (Private.piColumnData(Self,iRow,iColumn)) To pColumn If (pColumn) Move (StoreDW(pColumn,0,iCount)) To iResult End_Procedure // Set Private.piSubColumnCount // Procedure : Private.ReallocSubColumns // Purpose : Sets new number of subcolumns Procedure Private.ReallocSubColumns Integer iRow Integer iColumn Integer iSubColumns Integer iResult iCount Pointer pColumn Move (Private.piColumnData(Self,iRow,iColumn)) To pColumn Move (Realloc(pColumn,iSubColumns*8+4)) To pColumn Set Private.piColumnData iRow iColumn To pColumn // Store new subcolumn count and set to zero Set Private.piSubColumnCount iRow iColumn To iSubColumns For iCount From 0 To (iSubColumns-1) Set piSubColumnData iRow iColumn iCount To 0 Loop // For iCount From 0 To (iSubColumns-1) End_Procedure // Private.ReallocSubColumns // **************************************************************************** // // ** Public interface ** // // **************************************************************************** // // Function : FromRow // Purpose : Returns the row from which an appointment was dragged Function FromRow Returns Integer Function_Return (Private.piFromRow(Self)) End_Function // FromRow // Function : FromColumn // Purpose : Returns the column from which an appointment was dragged Function FromColumn Returns Integer Function_Return (Private.piFromColumn(Self)) End_Function // FromColumn // Function : FromSubColumn // Purpose : Returns the subcolumn from which an appointment was dragged Function FromSubColumn Returns Integer Function_Return (Private.piFromSubColumn(Self)) End_Function // FromSubColumn // Function : FirstVisibleRow // Purpose : Returns the (zero-based) row number of the first visible row in the grid Function FirstVisibleRow Returns Integer Function_Return (Private.piFirstRow(Self)) End_Function // FirstVisibleRow // Function : LastVisibleRow // Purpose : Returns the (zero-based) row number of the last fully visible row in the grid Function LastVisibleRow Returns Integer Integer iRows iSize iCounter iHeight Move (RowCount(Self)) To iRows Move (Hi(GUISize(Self))) To iSize Move (iSize-Hi(GUISize(phoHeader(Self)))) To iSize Move (iSize-GetSystemMetrics(SM_CYHSCROLL)) To iSize Move (FirstVisibleRow(Self)) To iCounter While (iCounter < iRows And iHeight < iSize) Move (iHeight + piRowHeight(Self,iCounter)) To iHeight Increment iCounter Loop // While (iHeight < iSize) Decrement iCounter // Substract partial visible item If (iHeight > iSize) Decrement iCounter Function_Return iCounter End_Function // LastVisibleRow // Function : FirstVisibleColumn // Purpose : Returns the (zero-based) column number of the first full visible column in the grid Function FirstVisibleColumn Returns Integer Integer iColumns iSize iPos iCounter iResult String sInfo Get ColumnCount To iColumns Move (Low(GUISize(Self))) To iSize // Get horizontal scrollbar info ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put (SIF_POS) To sInfo at SCROLLINFO.fMask Move (GetScrollInfo(Window_Handle(Self),SB_HORZ,AddressOf(sInfo))) To iResult GetBuff From sInfo at SCROLLINFO.nPos To iPos Move (iPos * -1) To iPos While (iCounter <= iColumns-1 And iPos <= 0) Move (iPos + piColumnWidth(Self,iCounter)) To iPos Increment iCounter Loop // While (iCounter < iColumns And iPos < 0) Decrement iCounter // Substract partial visible column If (iPos-piColumnWidth(Self,iCounter) < 0) Increment iCounter Function_Return iCounter End_Function // FirstVisibleColumn // Function : LastVisibleColumn // Purpose : Returns the (zero-based) column number of the last full visible column in the grid Function LastVisibleColumn Returns Integer Integer iColumns iSize iPos iCounter iResult String sInfo Get ColumnCount To iColumns Move (Low(GUISize(Self))) To iSize Move (iSize-GetSystemMetrics(SM_CXVSCROLL)) To iSize // Get horizontal scrollbar info ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo at SCROLLINFO.cbSize Put (SIF_POS) To sInfo at SCROLLINFO.fMask Move (GetScrollInfo(Window_Handle(Self),SB_HORZ,AddressOf(sInfo))) To iResult GetBuff From sInfo at SCROLLINFO.nPos To iPos Move (iPos * -1) To iPos While (iCounter <= iColumns-1 And iPos < iSize) Move (iPos + piColumnWidth(Self,iCounter)) To iPos Increment iCounter Loop // While (iCounter < iColumns And iPos < iSize) Decrement iCounter // Substract partial visible column If (iPos > iSize) Decrement iCounter Function_Return iCounter End_Function // LastVisibleColumn // Procedure : RepaintGrid // Purpose : Forces the complete grid to be repainted Procedure RepaintGrid Integer iResult //String sRect //ZeroType tRECT To sRect //Put 0 To sRect at tRECT.left //Put (Hi(GUISize(phoHeader(Self)))) To sRect at tRECT.top //Put (Low(GUISize(Self))) To sRect at tRECT.right //Put (Hi(GUISize(Self))) To sRect at tRECT.bottom //Move (InvalidateRect(Window_Handle(Self),AddressOf(sRect),False)) To iResult Move (InvalidateRect(Window_Handle(Self),0,False)) To iResult Send Private.AdjustHorizontalBar // Is this needed? Send Private.AdjustVerticalBar // Is this needed? Send Private.AdjustHeader End_Procedure // RepaintGrid // Procedure : RebuildGrid // Purpose : Rebuilds the complete grid (reading data and painting) Procedure RebuildGrid Integer iCount // Allocate memory Send Private.InitGrid // Trigger event (user can use this event to fill the grid) Send OnFillGrid // Calculate row height For iCount From 0 To (RowCount(Self)-1) Set piRowHeight iCount To (Private.ItemHeight(Self,iCount)) Loop // For iCount From 0 To (RowCount(Self)-1) // Force WM_PAINT Send RepaintGrid End_Procedure // RebuildGrid // Procedure : RepaintSubColumn // Purpose : Repaints a subcolumn Procedure RepaintSubColumn Integer iRow Integer iColumn Integer iSubColumn Integer iResult iCount iData iLeft iTop iRight iBottom Pointer pRect String sRect ZeroType tRECT To sRect Move (Private.ColumnRect(Self,iRow,iColumn,AddressOf(sRect))) To iResult If (piSubColumnData(Self,iRow,iColumn,iSubColumn) <> 0) Begin Move (piSubColumnData(Self,iRow,iColumn,iSubColumn)) To iData Move (iRow-1) To iCount While (piSubColumnData(Self,iCount,iColumn,iSubColumn) = iData And iCount >= 0) GetBuff From sRect at tRECT.top To iTop Put (iTop-piRowHeight(Self,iCount)) To sRect at tRECT.top Decrement iCount Loop // While (piSubColumnData(Self,iRow-1,iColumn,iSubColumn) = iData) Move (iRow+1) To iCount While (piSubColumnData(Self,iCount,iColumn,iSubColumn) = iData And iCount < RowCount(Self)) GetBuff From sRect at tRECT.bottom To iBottom Put (iBottom+piRowHeight(Self,iCount)) To sRect at tRECT.bottom Increment iCount Loop // While (piSubColumnData(Self,iCount,iColumn,iSubColumn) = iData And iCount < RowCount(Self)) Move (iColumn-1) To iCount While (piSubColumnData(Self,iRow,iCount,iSubColumn) = iData And iCount >= 0) GetBuff From sRect at tRECT.left To iLeft Put (iLeft-piColumnWidth(Self,iCount)) To sRect at tRECT.left Decrement iCount Loop // While (piSubColumnData(Self,iRow,iCount,iSubColumn) = iData And iCount >= 0) Move (iColumn+1) To iCount While (piSubColumnData(Self,iRow,iCount,iSubColumn) = iData And iCount < ColumnCount(Self)) GetBuff From sRect at tRECT.right To iRight Put (iRight+piColumnWidth(Self,iCount)) To sRect at tRECT.right Increment iCount Loop // While (piSubColumnData(Self,iRow,iCount,iSubColumn) = iData And iCount < ColumnCount(Self)) End // If (piSubColumnData(Self,iRow,iColumn,iSubColumn) <> 0) Begin Move (InvalidateRect(Window_Handle(Self),AddressOf(sRect),False)) To iResult Send Private.AdjustHorizontalBar // Is this needed? Send Private.AdjustVerticalBar // Is this needed? Send Private.AdjustHeader End_Procedure // RepaintSubColumn // TODO: mark as private // Function : ObjectFromIndex // Purpose : Returns object id for passed zero based index Function ObjectFromIndex Integer iIndex Returns Handle Function_Return (ObjectFromIndex(phoColumns(Self),iIndex)) End_Function // ObjectFromIndex // TODO: mark as private // Function : IndexFromObject // Purpose : Returns zero based index for passed object id Function IndexFromObject Handle hoObject Returns Integer Function_Return (IndexFromObject(phoColumns(Self),hoObject)) End_Function // IndexFromObject // Procedure : Set phoImageList // Purpose : Sets imagelist for cGrid (cHeader and cGrid) Procedure Set phoImageList Handle hoObject Handle hImageList Integer iResult Set Private.phoImageList To hoObject If (Window_Handle(phoHeader(Self))) Begin Move (Window_Handle(hoObject)) To hImageList If (hImageList) Move (SendMessage(Window_Handle(phoHeader(Self)),HDM_SETIMAGELIST,0,hImageList)) To iResult End // If (Window_Handle(phoHeader(Self))) Begin End_Procedure // Set phoImageList // Function : phoImageList // Purpose : Returns handle to ImageList object Function phoImageList Returns Handle Function_Return (Private.phoImageList(Self)) End_Function // phoImageList // Procedure : Set pbReorderColumns // Purpose : Allows re-ordering of columns using the header control // Visual DataFlex 12.0 Migration Utility, added March 28, 2007: 15:13:25 #IF (!@ >= 120) { InitialValue=False } #ENDIF Procedure Set pbReorderColumns Boolean bState Integer iStyle iResult Handle hHeader Set Private.pbReorderColumns To bState Move (Window_Handle(phoHeader(Self))) To hHeader If (hHeader) Begin Move (GetWindowLong(hHeader,GWL_STYLE)) To iStyle If (bState) Move (SetWindowLong(hHeader,GWL_STYLE,iStyle iOr HDS_DRAGDROP)) To iResult Else Move (SetWindowLong(hHeader,GWL_STYLE,iStyle-(iStyle iAnd HDS_DRAGDROP))) To iResult End // If (hHeader) Begin End_Procedure // Set pbReorderColumns // Function : pbReorderColumns // Purpose : Returns whether the columns can be re-ordered using the header control Function pbReorderColumns Returns Boolean Function_Return (Private.pbReOrderColumns(Self)) End_Function // pbReorderColumns // Function : RowCount // Purpose : Returns number of rows Function RowCount Returns Integer Function_Return (Private.piRowCount(Self)) End_Function // RowCount // Function : piRowHeight // Purpose : Returns row height in pixels Function piRowHeight Integer iRow Returns Integer Integer iColumns Pointer pData Move (Private.phData(Self)) To pData Move (Private.piColumnCount(Self)) To iColumns If (pData) Function_Return (DerefDW(pData,iRow*(iColumns+2)*4+4)) End_Function // piRowHeight // Procedure : Set piRowHeight // Purpose : Sets height of a row in pixels Procedure Set piRowHeight Integer iRow Integer iHeight Integer iResult iColumns Pointer pData If (iRow >= RowCount(Self)) Procedure_Return Move (Private.phData(Self)) To pData Move (Private.piColumnCount(Self)) To iColumns If (pData) Move (StoreDW(pData,iRow*(iColumns+2)*4+4,iHeight)) To iResult End_Procedure // Set piRowHeight // Function : piRowId // Purpose : Returns row id Function piRowId Integer iRow Returns Integer Integer iColumns Pointer pData Move (Private.phData(Self)) To pData Move (Private.piColumnCount(Self)) To iColumns If (pData) Function_Return (DerefDW(pData,iRow*(iColumns+2)*4)) End_Function // piRowId // Procedure : Set piRowId // Purpose : Sets row id Procedure Set piRowId Integer iRow Integer iId Integer iResult iColumns Pointer pData If (iRow >= RowCount(Self)) Procedure_Return Move (Private.phData(Self)) To pData Move (Private.piColumnCount(Self)) To iColumns If (pData) Move (StoreDW(pData,iRow*(iColumns+2)*4,iId)) To iResult End_Procedure // piRowId // Function : ColumnCount // Purpose : Returns number of columns Function ColumnCount Returns Integer Function_Return (CountOfObjects(phoColumns(Self))) End_Function // ColumnCount // Function : piColumnWidth // Purpose : Returns column width Function piColumnWidth Integer iColumn Returns Integer Function_Return (piWidth(ObjectFromIndex(phoColumns(Self),iColumn))) End_Function // piColumnWidth // Procedure : Set piColumnWidth // Purpose : Sets column width Procedure Set piColumnWidth Integer iColumn Integer iWidth Set piWidth Of (ObjectFromIndex(phoColumns(Self),iColumn)) To iWidth End_Procedure // Set piColumnWidth // Function : piColumnId // Purpose : Returns column id Function piColumnId Integer iColumn Returns Integer Integer iResult Handle hoColumn String sArray Move (Repeat(Character(0),ColumnCount(Self)*4)) To sArray Move (SendMessage(Window_Handle(phoHeader(Self)),HDM_GETORDERARRAY,ColumnCount(Self),AddressOf(sArray))) To iResult Move (BytesToDWord(sArray,iColumn*4+1)) To iColumn Move (ObjectFromIndex(Self,iColumn)) To hoColumn Function_Return (piData(hoColumn)) End_Function // piColumnId // Procedure : Set piColumnId // Purpose : Sets column id Procedure Set piColumnId Integer iColumn Integer iId Integer iResult Handle hoColumn String sArray Move (Repeat(Character(0),ColumnCount(Self)*4)) To sArray Move (SendMessage(Window_Handle(phoHeader(Self)),HDM_GETORDERARRAY,ColumnCount(Self),AddressOf(sArray))) To iResult If (iResult <> 0) Move (BytesToDWord(sArray,iColumn*4+1)) To iColumn Move (ObjectFromIndex(Self,iColumn)) To hoColumn Set piData of hoColumn To iId End_Procedure // Set piColumnId // Function : piSubColumnData // Purpose : Returns subcolumn data for a cell in the grid Function piSubColumnData Integer iRow Integer iColumn Integer iSubColumn Returns Integer Pointer pRow pColumn If (iRow < 0) Function_Return 0 Move (Private.piColumnData(Self,iRow,iColumn)) To pColumn If (pColumn) Function_Return (DerefDW(pColumn,iSubColumn*8+4)) End_Function // piSubColumnData // Procedure : Set piSubColumnData // Purpose : Sets subcolumn data Procedure Set piSubColumnData Integer iRow Integer iColumn Integer iSubColumn Integer iData Integer iResult Pointer pColumn // Check bounds If (iRow < 0 Or iColumn < 0 Or iSubColumn < 0) Procedure_Return If (iRow >= RowCount(Self) Or iColumn >= ColumnCount(Self) Or iSubColumn >= SubColumnCount(Self,iRow,iColumn)) Procedure_Return Move (Private.piColumnData(Self,iRow,iColumn)) To pColumn If (pColumn) Move (StoreDW(pColumn,iSubColumn*8+4,iData)) To iResult End_Procedure // Set piSubColumnData // Function : piSubColumnExtra // Purpose : Returns extra data for a subcolumn Function piSubColumnExtra Integer iRow Integer iColumn Integer iSubColumn Returns Integer Pointer pRow pColumn If (iRow < 0) Function_Return 0 Move (Private.piColumnData(Self,iRow,iColumn)) To pColumn If (pColumn) Function_Return (DerefDW(pColumn,iSubColumn*8+8)) End_Function // piSubColumnExtra // Procedure : Set piSubColumnExtra // Purpose : Sets extra data for a subcolumn Procedure Set piSubColumnExtra Integer iRow Integer iColumn Integer iSubColumn Integer iData Integer iResult Pointer pColumn // Check bounds If (iRow < 0 Or iColumn < 0 Or iSubColumn < 0) Procedure_Return If (iRow >= RowCount(Self) Or iColumn >= ColumnCount(Self) Or iSubColumn >= SubColumnCount(Self,iRow,iColumn)) Procedure_Return Move (Private.piColumnData(Self,iRow,iColumn)) To pColumn If (pColumn) Move (StoreDW(pColumn,iSubColumn*8+8,iData)) To iResult End_Procedure // Set piSubColumnExtra // Function : SubColumnCount // Purpose : Returns number of subcolumns for a cell in the grid Function SubColumnCount Integer iRow Integer iColumn Returns Integer Pointer pColumn If (iRow < 0) Function_Return 0 Move (Private.piColumnData(Self,iRow,iColumn)) To pColumn If (pColumn) Function_Return (DerefDW(pColumn,0)) End_Function // SubColumnCount // Procedure : AddSubColumn // Purpose : Adds a subcolumn Procedure AddSubColumn Integer iRow Integer iColumn Integer iSubColumns iResult Pointer pColumn // Get current subcolumn count Move (SubColumnCount(Self,iRow,iColumn)+1) To iSubColumns Move (Private.piColumnData(Self,iRow,iColumn)) To pColumn Move (Realloc(pColumn,iSubColumns*8+4)) To pColumn Set Private.piColumnData iRow iColumn To pColumn // Store new subcolumn count and set to zero Set Private.piSubColumnCount iRow iColumn To iSubColumns Set piSubColumnData iRow iColumn (iSubColumns-1) To 0 Set piSubColumnExtra iRow iColumn (iSubColumns-1) To 0 End_Procedure // AddSubColumn // Procedure : DeleteSubColumn // Purpose : Deletes a subcolumn Procedure DeleteSubColumn Integer iRow Integer iColumn Integer iSubColumns iResult Pointer pColumn // Get current subcolumn count Move (SubColumnCount(Self,iRow,iColumn)-1) To iSubColumns Move (Private.piColumnData(Self,iRow,iColumn)) To pColumn Move (Realloc(pColumn,iSubColumns*8+4)) To pColumn Set Private.piColumnData iRow iColumn To pColumn // Store new subcolumn count Set Private.piSubColumnCount iRow iColumn To iSubColumns End_Procedure // DeleteSubColumn // **************************************************************************** // // ** API functions ** // // **************************************************************************** // // Function : APIRowCount // Purpose : Returns row count Function APIRowCount Returns Integer Function_Return 0 End_Function // APIRowCount // Function : APISubColumnCount // Purpose : Returns subcolumn count Function APISubColumnCount Integer iRow Integer iColumn Returns Integer Function_Return 0 End_Function // APISubColumnCount // Function : APISubColumnData // Purpose : Returns sub-column data Function APISubColumnData Integer iRow Integer iColumn Integer iSubColumn Returns Integer Function_Return 0 End_Function // APISubColumnData // Function : APISubColumnReadOnly // Purpose : Returns subcolumn readonly state Function APISubColumnReadOnly Integer iRow Integer iColumn Integer iSubColumn Returns Boolean Function_Return False End_Function // APISubColumnReadOnly // Fucntion : APISubColumnText // Purpose : Returns subcolumn text Function APISubColumnText Integer iRow Integer iColumn Integer iSubColumn Returns String Function_Return "" End_Function // APISubColumnText // Function : APISubColumnImage // Purpose : Returns subcolumn image Function APISubColumnImage Integer iRow Integer iColumn Integer iSubColumn Returns Integer Function_Return -1 End_Function // APISubColumnImage // Function : APISubColumnAlignment // Purpose : Returns subcolumn alignment Function APISubColumnAlignment Integer iRow Integer iColumn Integer iSubColumn Returns Integer Function_Return DT_LEFT End_Function // APISubColumnAlignment // Function : APISubColumnBackColor // Purpose : Returns subcolumn background color Function APISubColumnBackColor Integer iRow Integer iColumn Integer iSubColumn Returns Integer Function_Return (GetSysColor(COLOR_WINDOW)) End_Function // APISubColumnBackColor // Function : APISubColumnSelectedBackColor // Purpose : Returns subcolumn selected background color Function APISubColumnSelectedBackColor Integer iRow Integer iColumn Integer iSubColumn Returns Integer Function_Return (GetSysColor(COLOR_HIGHLIGHT)) End_Function // APISubColumnSelectedBackColor // Function : APISubColumnTextColor // Purpose : Returns subcolumn text color Function APISubColumnTextColor Integer iRow Integer iColumn Integer iSubColumn Returns Integer Function_Return (GetSysColor(COLOR_MENUTEXT)) End_Function // APISubColumnTextColor // Function : APISubColumnSelectedTextColor // Purpose : Returns subcolumn selected text color Function APISubColumnSelectedTextColor Integer iRow Integer iColumn Integer iSubColumn Returns Integer Function_Return (GetSysColor(COLOR_HIGHLIGHTTEXT)) End_Function // APISubColumnSelectedTextColor // Function : APISubColumnHorizontalLineColor // Purpose : Returns subcolumn horizontal line color Function APISubColumnHorizontalLineColor Integer iRow Integer iColumn Integer iSubColumn Returns Integer Function_Return 0 End_Function // APISubColumnHorizontalLineColor // Function : APISubColumnVerticalLineColor // Purpose : Returns subcolumn vertical line color Function APISubColumnVerticalLineColor Integer iRow Integer iColumn Integer iSubColumn Returns Integer Function_Return 0 End_Function // APISubColumnVerticalLineColor // Function : APISubColumnHorizontalLineThickness // Purpose : Returns subcolumn horizontal line thickness Function APISubColumnHorizontalLineThickness Integer iRow Integer iColumn Integer iSubColumn Returns Integer Function_Return 1 End_Function // APISubColumnHorizontalLineThickness // Function : APISubColumnVerticalLineThickness // Purpose : Returns subcolumn vertical line thickness Function APISubColumnVerticalLineThickness Integer iRow Integer iColumn Integer iSubColumn Returns Integer Function_Return 1 End_Function // APISubColumnVerticalLineThickness // Function : APISubColumnFont // Purpose : Returns subcolumn font Function APISubColumnFont Integer iRow Integer iColumn Integer iSubColumn Returns Handle String sNonClientMetrics sLogFont Integer iResult iLogFont Handle hLogFont // Get the menu font ZeroType NONCLIENTMETRICS To sNonClientMetrics Put NONCLIENTMETRICS_Size To sNonClientMetrics At NONCLIENTMETRICS.cbSize Move (SystemParametersInfo(SPI_GETNONCLIENTMETRICS,NONCLIENTMETRICS_Size,AddressOf(sNonClientMetrics),0)) To iResult If (iResult = 0) Error 103 (FormatWinError(GetLastError())) // Now we must pass the address of the lfMenuFont member to CreateFontIndirect ZeroType LogFont To sLogFont Offset_Of_Field NONCLIENTMETRICS.lfMessageFont To iLogFont Move (CopyMemory(AddressOf(sLogFont),AddressOf(sNonClientMetrics)+iLogFont-1,LogFont_Size)) To iResult // Create the menu font Move (CreateFontIndirect(AddressOf(sLogFont))) To hLogFont If (hLogFont = 0) Error 103 (FormatWinError(GetLastError())) Function_Return hLogFont End_Function // APISubColumnFont // Function : APICanDragSubColumn // Purpose : Returns value indicating if a subcolumn can be dragged Function APICanDragSubColumn Integer iRow Integer iColumn Integer iSubColumn Returns Boolean Function_Return (True) End_Function // APICanDragSubColumn // Function : APICanResizeSubColumn // Purpose : Returns value indicating if a subcolumn can be resized Function APICanResizeSubColumn Integer iRow Integer iColumn Integer iSubColumn Returns Boolean Function_Return (True) End_Function // APICanResizeSubColumn // Function : APIIsValidDropTarget // Purpose : Returns value indicating if a valid drop target Function APIIsValidDropTarget Integer iRow Integer iColumn Integer iSubColumn Returns Boolean Function_Return (True) End_Function // APIIsValidDropTarget // Function : APIIsFocusable // Purpose : Returns value indicating if the grid is focusable (may be activated) Function APIIsFocusable Returns Boolean Function_Return (True) End_Function // APIIsFocusable // **************************************************************************** // // ** Events ** // // **************************************************************************** // // Procedure : OnFillGrid // Purpose : This event is send when the grid is filled Procedure OnFillGrid End_Procedure // OnFillGrid // Procedure : OnDragStart // Purpose : This event is send when a drag operation starts Procedure OnDragStart Integer iRow Integer iColumn Integer iSubColumn End_Procedure // OnDragStart // Procedure : OnResizeStart // Purpose : This event is send when a resize operation starts Procedure OnResizeStart Integer iRow Integer iColumn Integer iSubColumn End_Procedure // OnResizeStart // Procedure : OnDrop // Purpose : This event is send when an item is dropped Procedure OnDrop Integer iRow Integer iColumn Integer iSubColumn End_Procedure // OnDrop // Procedure : OnResize // Purpose : This event is send when an item is resized Procedure OnResize Integer iRow Integer iColumn Integer iSubColumn Boolean bTop End_Procedure // OnResize // Procedure : OnDoubleClick // Purpsoe : This event is send when an item is double-clicked Procedure OnDoubleClick Integer iRow Integer iColumn Integer iSubColumn End_Procedure // OnDoubleClick // Procedure : OnRightButtonDown // Purpose : This event is send when an item is clicked with the right mouse button Procedure OnRightButtonDown Integer iRow Integer iColumn Integer iSubColumn End_Procedure // OnRightButtonDown // Procedure : OnLeftButtonDown // Purpose : This event is send when an item is clicked with the left mouse button Procedure OnLeftButtonDown Integer iRow Integer iColumn Integer iSubColumn End_Procedure // OnLeftButtonDown // Procedure : OnDelete // Purpose : This event is send when an item is deleted Procedure OnDelete Integer iRow Integer iColumn Integer iSubColumn End_Procedure // OnDelete // Procedure : OnSetFocus // Purpose : This event is send when the grid gains the focus Procedure OnSetFocus End_Procedure // OnSetFocus // Procedure : OnKillFocus // Purpose : This event is send when the grid loses the focus Procedure OnKillFocus End_Procedure // OnKillFocus End_Class // cGrid