// **************************************************************************** // // ** ** // // ** Class : cGridBox ** // // ** ** // // ** Purpose : Wrapper class for ListBox control ** // // ** ** // // ** Author : Ulbe Stellema ** // // ** Data Access Europe ** // // ** ** // // ** Date : july 1, 2002 ** // // ** ** // // **************************************************************************** // Use user32.hdr Use cGrid.hdr Class cGridBox Is A cWinControl // Procedure : Construct_Object // Purpose : Object constructor Procedure Construct_Object // No need for a message dispatcher, the most important // message WM_DRAWITEM is recieved by this window. // WM_MEASUREITEM is send to the owner window but can // be replaced by a LB_SETITEMHEIGHT message. Set External_Class_Name "DFGridBox" To "listbox" Forward Send Construct_Object // Public properties Property Boolean pbPartialItem False Property Boolean pbMultipleSelections False Property Boolean pbSelectOnClick False Property Boolean pbNoSelections False Property Handle phCursorNo Property Handle phCursorCross Property Handle phCursorArrow // Private properties Property Integer Private.piTime Property String Private.psSearch Property Integer Private.piRow 0 Property Integer Private.piColumn 0 Property Integer Private.piSubColumn 0 // Drag and drop properties Property Boolean Private.pbDragging Property Integer Private.piFromRow Property Integer Private.piFromColumn Property Integer Private.piFromSubColumn Set phCursorNo To (LoadCursor(0,IDC_NO)) Set phCursorCross To (LoadCursor(0,IDC_CROSS)) Set phCursorArrow To (LoadCursor(0,IDC_ARROW)) Set External_Message WM_DRAWITEM To msg_OnDrawItem Set External_Message WM_LBUTTONDBLCLK To msg_OnLButtonDoubleClick Set External_Message WM_MOUSEWHEEL To msg_OnMouseWheel // Window styles Set Window_Style To WS_CHILDWINDOW True Set Window_Style To WS_VISIBLE True Set Window_Style To WS_CLIPSIBLINGS True Set Window_Style To WS_CLIPCHILDREN True Set Window_Style To WS_BORDER True Set Window_Style To WS_TABSTOP True // ListBox styles Set Window_Style To LBS_OWNERDRAWVARIABLE True Set Window_Style To LBS_NOTIFY True Set Window_Style To LBS_WANTKEYBOARDINPUT True //Set Window_Style To LBS_EXTENDEDSEL True //Set Window_Style To LBS_MULTIPLESEL True // Extended styles Set Extended_Window_Style To WS_EX_ACCEPTFILES True End_Procedure // Construct_Object // Procedure : Activate // Purpose : Calls ChildEntering // Procedure Activate Returns Integer // Boolean bOk // Get ChildEntering True To bOk // If bOk Forward Send Activate // Else Procedure_Return 1 // error entering // End_Procedure // Activate // Function : piRow // Purpose : Returns current row Function piRow Returns Integer Function_Return (Private.piRow(Self)) End_Function // piRow // Procedure : Set piRow // Purpose : Sets current row Procedure Set piRow Integer iRow Set Private.piRow To iRow Send RepaintGrid End_Procedure // Set piRow // Function : piColumn // Purpsoe : Returns current column Function piColumn Returns Integer Function_Return (Private.piColumn(Self)) End_Function // piColumn // Procedure : Set piColumn // Purpose : Sets current column Procedure Set piColumn Integer iColumn Set Private.piColumn To iColumn Send RepaintGrid End_Procedure // Set piColumn // Function : piSubColumn // Purpose : Returns current subcolumn Function piSubColumn Returns Integer Function_Return (Private.piSubColumn(Self)) End_Function // piSubColumn // Procedure : Set piSubColumn // Purpose : Sets current subcolumn Procedure Set piSubColumn Integer iSubColumn Set Private.piSubColumn To iSubColumn Send RepaintGrid End_Procedure // Set piSubColumn // Procedure : OnKillFocus // Purpose : Remove selected items from list Procedure OnKillFocus Integer iResult If (Not(pbRetainSelectedItem(Self))) ; Else Move (SendMessage(Window_Handle(Self),LB_SETCURSEL,-1,0)) To iResult End_Procedure // OnKillFocus // Procedure : OnFocusChange // Purpose : Hook procedure Procedure OnFocusChange Integer iItem // If (piRow(Self) <> Private.piFromRow(Self) Or piColumn(Self) <> Private.piFromColumn(Self) Or piSubColumn(Self) <> Private.piFromSubColumn(Self)) Begin // Set Private.piFromRow To (piRow(Self)) // Set Private.piFromColumn To (piColumn(Self)) // Set Private.piFromSubColumn To (piSubColumn(Self)) // Send RepaintGrid // Send AdjustThumb // End // End_Procedure // OnFocusChange // Function : ColumnFromPoint // Purpose : Returns column number from the passed coordinate Function 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(oHorizontalBar(Self)),SB_CTL,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 // ColumnFromPoint // Function : SubColumnFromPoint // Purpose : Returns sub-column number for the passed coordinate Function SubColumnFromPoint Integer lParam Returns Integer Integer iResult iCount iWidth iPos iSubColumns iRow iX Handle hoColumn String sInfo Move (SendMessage(Window_Handle(Self),LB_ITEMFROMPOINT,0,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(oHorizontalBar(Self)),SB_CTL,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 (Low(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) End // If (iWidth > iX) Begin Loop // For iCount From 0 To (ColumnCount(Self) - 1) Function_Return -1 End_Function // SubColumnFromPoint // Procedure : Page // Purpose : Sets window styles Procedure Page Integer iState If (pbPartialItem(Self)) Set Window_Style To LBS_NOINTEGRALHEIGHT True If (pbMultipleSelections(Self)) Set Window_Style To LBS_EXTENDEDSEL True If (pbSelectOnClick(Self)) Set Window_Style To LBS_MULTIPLESEL True If (pbNoSelections(Self)) Set Window_Style To LBS_NOSEL True Forward Send Page iState End_Procedure // Page // Procedure : Command // Purpose : Handles WM_COMMAND Procedure Command Integer wParam Integer lParam Returns Integer Integer iItem iData If (Hi(wParam) = LBN_DBLCLK) Begin Move (SendMessage(Window_Handle(Self),LB_GETCURSEL,0,0)) To iItem Move (SendMessage(Window_Handle(Self),LB_GETITEMDATA,iItem,0)) To iData //Send OnDoubleClick iData Procedure_Return False End // If (Low(wParam) = LBN_DBLCLK) Begin If (Hi(wParam) = LBN_SELCHANGE) Begin Move (SendMessage(Window_Handle(Self),LB_GETCURSEL,0,0)) To iItem Move (SendMessage(Window_Handle(Self),LB_GETITEMDATA,iItem,0)) To iData End // If (Hi(wParam) = LBN_SELCHANGE) Begin If (Hi(wParam) = LBN_KILLFOCUS) Begin Send RepaintGrid Send OnKillFocus End // If (Hi(wParam) = LBN_SETFOCUS) Begin Send RepaintGrid Send OnSetFocus End //If (Hi(wParam) = LBN_SELCANCEL) Send OnSelectionCancel Procedure_Return False // True End_Procedure // Command // Procedure : OnWmRButtonDown // Purpose : Handles WM_RBUTTONDOWN Procedure OnWmRButtonDown Integer wParam Integer lParam Integer iResult iRow iColumn iSubColumn Boolean bOk // Get ChildEntering False To bOk If (Not(bOk)) Procedure_Return Move (SendMessage(Window_Handle(Self),LB_ITEMFROMPOINT,0,lParam)) To iRow Set Private.piRow To (Low(iRow)) // Move (SendMessage(Window_Handle(Self),LB_SETCURSEL,iItem,0)) To iResult Move (ColumnFromPoint(Self,lParam)) To iColumn Set Private.piColumn To iColumn Move (SubColumnFromPoint(Self,lParam)) To iSubColumn Set Private.piSubColumn To iSubColumn // Send RepaintRow iRow Send RepaintGrid // Send OnRButtonDown End_Procedure // OnWmRButtonDown // Procedure : OnWmLButtonDown // Purpose : Handles WM_LBUTTONDOWN Procedure OnWmLButtonDown Integer wParam Integer lParam Integer iResult iRow iColumn iSubColumn iCount iData Handle hoSet Boolean bOk // Get Create U_Set To hoSet // Create set of invalid rows // Move (Private.piRow(Self)) To iRow // Move (Private.piColumn(Self)) To iColumn // Move (Private.piSubColumn(Self)) To iSubColumn // Move (SubColumnData(Self,iRow,iColumn,iSubColumn)) To iData // If (iData = 0) Send Add_Element To hoSet iRow // Else Begin // // Find Begin // Move (iRow-1) To iCount // While (SubColumnData(Self,iCount,iColumn,iSubColumn) = iData) // Send Add_Element To hoSet iCount // Decrement iCount // Loop // While (SubColumnData(Self,iCount,iColumn,iSubColumn) = iData) // // Find end // Move (iRow+1) To iCount // While (SubColumnData(Self,iCount,iColumn,iSubColumn) = iData) // Send Add_Element To hoSet iCount // Increment iCount // Loop // While (SubColumnData(Self,iCount,iColumn,iSubColumn) = iData) // End // Else Begin // Get ChildEntering False To bOk If (Not(bOk)) Procedure_Return Move (SendMessage(Window_Handle(Self),LB_ITEMFROMPOINT,0,lParam)) To iRow Set Private.piRow To (Low(iRow)) Move (ColumnFromPoint(Self,lParam)) To iColumn Set Private.piColumn To iColumn Move (SubColumnFromPoint(Self,lParam)) To iSubColumn Set Private.piSubColumn To iSubColumn // Create set of invalid rows // Move (SubColumnData(Self,iRow,iColumn,iSubColumn)) To iData // If (iData = 0) Send Add_Element To hoSet iRow // Else Begin // // Find Begin // Move (iRow-1) To iCount // While (SubColumnData(Self,iCount,iColumn,iSubColumn) = iData) // Send Add_Element To hoSet iCount // Decrement iCount // Loop // While (SubColumnData(Self,iCount,iColumn,iSubColumn) = iData) // // Find end // Move (iRow+1) To iCount // While (SubColumnData(Self,iCount,iColumn,iSubColumn) = iData) // Send Add_Element To hoSet iCount // Increment iCount // Loop // While (SubColumnData(Self,iCount,iColumn,iSubColumn) = iData) // End // Else Begin // Which rows should be painted? // Move 0 To iCount // While (iCount < Item_Count(hoSet)) // Get Value of hoSet Item iCount To iRow // Send RepaintRow iRow // Increment iCount // Loop // While (iCount < Item_Count(hoSet)) // Send Destroy of hoSet Send RepaintGrid //Send RepaintRow iRow If (wParam Iand MK_CONTROL Or wParam Iand MK_SHIFT) Procedure_Return If (SubColumnData(Self,iRow,iColumn,iSubColumn) = 0) Procedure_Return Move (SetCapture(Window_Handle(Self))) To iResult Set Private.piFromRow To iRow Set Private.piFromColumn To iColumn Set Private.piFromSubColumn To iSubColumn Set Private.pbDragging To True Send OnDragStart iRow iColumn iSubColumn End_Procedure // OnWmLButtonDown // Procedure : OnWmMouseMove // Purpose : Handles WM_MOUSEMOVE Procedure OnWmMouseMove Integer wParam Integer lParam Integer iResult iX iY iRow iColumn iSubColumn Handle hWindow String sPoint If (Private.pbDragging(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 (SendMessage(Window_Handle(Self),LB_ITEMFROMPOINT,0,lParam)) To iRow Move (ColumnFromPoint(Self,lParam)) To iColumn Move (SubColumnFromPoint(Self,lParam)) To iSubColumn // hilight column If (iSubColumn <> piSubColumn(Self) Or iColumn <> piColumn(Self) Or iRow <> piRow(Self)) Send RepaintRow iRow If (iSubColumn = Private.piFromSubColumn(Self) And iColumn = Private.piFromColumn(Self) And iRow = Private.piFromRow(Self)) ; Move (SetCursor(phCursorArrow(Self))) To iResult Else Begin If (APIIsValidDropTarget(Self,iRow,iColumn,iSubColumn)) Move (SetCursor(phCursorCross(Self))) To iResult Else Move (SetCursor(phCursorNo(Self))) To iResult End // Else Begin Set Private.piRow To iRow Set Private.piColumn To iColumn Set Private.piSubColumn To iSubColumn Send RepaintGrid 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 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 Integer iRow iColumn iSubColumn Handle hWindow String sPoint Boolean bOk //Get ChildEntering False To bOk //If (Not(bOk)) Procedure_Return If (Private.pbDragging(Self)) Begin Set Private.pbDragging To False 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 (SendMessage(Window_Handle(Self),LB_ITEMFROMPOINT,0,lParam)) To iRow Move (ColumnFromPoint(Self,lParam)) To iColumn Move (SubColumnFromPoint(Self,lParam)) To iSubColumn If (iRow <> Private.piFromRow(Self) Or iColumn <> Private.piFromColumn(Self) Or iSubColumn <> Private.piFromSubColumn(Self)) Begin //If (SubColumnData(Self,iRow,iColumn,iSubColumn) <> SubColumnData(Self,Private.piFromRow(Self),Private.piFromColumn(Self),Private.piFromSubColumn(Self))) ; If (APIIsValidDropTarget(Self,iRow,iColumn,iSubColumn)) Send OnDrop iRow iColumn iSubColumn End // If (iRow <> Private.piFromRow(Self) Or iColumn <> Private.piFromColumn(Self) Or iSubColumn <> Private.piFromSubColumn(Self)) Begin // Release mouse capture Move (ReleaseCapture()) To iResult End // If (iResult iAnd WS_EX_ACCEPTFILES) Begin // Reset mouse cursor Move (SetCursor(phCursorArrow(Self))) To iResult End // If (Private.pbDragging(Self)) Begin End_Procedure // OnWmLButtonUp // Procedure : OnLButtonDoubleClick // Purpose : Handles WM_LBUTTONDBLCLK Procedure OnLButtonDoubleClick Integer wParam Integer lParam Integer iRow iColumn iSubColumn Boolean bOk // Get ChildEntering False To bOk If (Not(bOk)) Procedure_Return Move (Low(SendMessage(Window_Handle(Self),LB_ITEMFROMPOINT,0,lParam))) To iRow Move (ColumnFromPoint(Self,lParam)) To iColumn Move (SubColumnFromPoint(Self,lParam)) To iSubColumn 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 OnVerticalScroll SB_LINEDOWN 0 If (iDelta > 0) Send OnVerticalScroll SB_LINEUP 0 Send 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 iItems iCount String sInfo sValue Handle hWindow 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 Move (Window_Handle(oVerticalBar(Self))) To hWindow ZeroType SCROLLINFO To sInfo Put SCROLLINFO_Size To sInfo At SCROLLINFO.cbSize Put SIF_ALL To sInfo At SCROLLINFO.fMask Move (GetScrollInfo(hWindow,SB_CTL,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 (SendMessage(Window_Handle(Self),LB_GETCARETINDEX,0,0)) To iItem Move (SendMessage(Window_Handle(Self),LB_GETTOPINDEX,0,0)) To iTop If (iVirtualKey = VK_END) Begin If (iItem = iMax) Procedure_Return Send OnVerticalScroll SB_BOTTOM 0 Move (SendMessage(Window_Handle(Self),LB_SETCARETINDEX,iMax,True)) To iResult Move (SendMessage(Window_Handle(Self),LB_SETCURSEL,iMax,0)) To iResult Set piRow To (SendMessage(Window_Handle(Self),LB_GETCARETINDEX,0,0)) //Send AdjustThumb //Send OnSelectionChanged iItem iMax Set Windows_Override_State To True Procedure_Return End // If (iVirtualKey = VK_END) Begin If (iVirtualKey = VK_HOME) Begin If (iItem = iMin) Procedure_Return Send OnVerticalScroll SB_TOP 0 Move (SendMessage(Window_Handle(Self),LB_SETCARETINDEX,iMin,True)) To iResult Move (SendMessage(Window_Handle(Self),LB_SETCURSEL,iMin,0)) To iResult Set piRow To (SendMessage(Window_Handle(Self),LB_GETCARETINDEX,0,0)) //Send AdjustThumb //Send OnSelectionChanged iItem iMin 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 OnVerticalScroll SB_LINEDOWN 0 Move (SendMessage(Window_Handle(Self),LB_SETCARETINDEX,iItem+1,True)) To iResult Move (SendMessage(Window_Handle(Self),LB_SETCURSEL,iItem+1,0)) To iResult Set piRow To (SendMessage(Window_Handle(Self),LB_GETCARETINDEX,0,0)) //Send RepaintRow (CurrentRow(Self)) Send AdjustThumb //Send OnSelectionChanged iItem (iItem+1) 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 OnVerticalScroll SB_LINEUP 0 Move (SendMessage(Window_Handle(Self),LB_SETCARETINDEX,iItem-1,True)) To iResult Move (SendMessage(Window_Handle(Self),LB_SETCURSEL,iItem-1,0)) To iResult Set piRow To (SendMessage(Window_Handle(Self),LB_GETCARETINDEX,0,0)) //Send RepaintRow (CurrentRow(Self)) Send AdjustThumb //Send OnSelectionChanged iItem (iItem-1) Set Windows_Override_State To True Procedure_Return End // If (iVirtualKey = VK_UP) Begin If (iVirtualKey = VK_NEXT) Begin If (iItem = LastVisibleRow(Self)-1) Send OnVerticalScroll SB_PAGEDOWN 0 Move (SendMessage(Window_Handle(Self),LB_SETCARETINDEX,LastVisibleRow(Self)-1,True)) To iResult Move (SendMessage(Window_Handle(Self),LB_SETCURSEL,LastVisibleRow(Self)-1,0)) To iResult Set piRow To (SendMessage(Window_Handle(Self),LB_GETCARETINDEX,0,0)) Send AdjustThumb //Send OnSelectionChanged iItem (LastVisibleRow(Self)-1) Set Windows_Override_State To True Procedure_Return End // If (iVirtualKey = VK_NEXT) Begin If (iVirtualKey = VK_PRIOR) Begin If (iItem = iTop) Send OnVerticalScroll SB_PAGEUP 0 Move (SendMessage(Window_Handle(Self),LB_GETTOPINDEX,0,0)) To iTop Move (SendMessage(Window_Handle(Self),LB_SETCARETINDEX,iTop,False)) To iResult Move (SendMessage(Window_Handle(Self),LB_SETCURSEL,iTop,0)) To iResult Set piRow To (SendMessage(Window_Handle(Self),LB_GETCARETINDEX,0,0)) Send AdjustThumb //Send OnSelectionChanged iItem iTop 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) ; Set piSubColumn To (SubColumnCount(Self,piRow(Self),piColumn(Self)-1)-1) If (piColumn(Self) = 0) Procedure_Return Set piColumn To (piColumn(Self)-1) End // Else Begin Send OnHorizontalScroll SB_LINELEFT 0 //Send RepaintRow (CurrentRow(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 OnHorizontalScroll SB_LINERIGHT 0 //Send RepaintRow (CurrentRow(Self)) Set Windows_Override_State To True Procedure_Return End // If (iVirtualKey = VK_RIGHT) Begin If (iVirtualKey = VK_DELETE) Begin //Move (SendMessage(Window_Handle(Self),LB_GETCARETINDEX,0,0)) To iResult 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 // OnKeyDown // Function : ItemHeight // Purpose : Calculates the height of an item Function 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 (FormatMessage(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)) To iSubItems If (iSubItems = 0) Move 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_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 // Draw text (single line) 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 Function_Return (iHeight) End_Function // ItemHeight // Procedure : OnDrawItem // Purpose : Handles WM_DRAWITEM Procedure OnDrawItem Integer wParam Integer lParam Returns Integer Integer iResult iRow iData iState iAction iLines iCount iBegin iPos iFormat iSubColumn iSubItems Integer iTop iBottom iLeft iRight iWidth iDC iImage iImageList iColumn iOldColor Integer iBackColor iTextColor iSelected String sDrawItem sRect sText sInfo sArray Handle hDC hBrush hFont hPen hImageList Handle hOldBrush hOldFont hOldPen Handle hoColumn ZeroType RdsDRAWITEMSTRUCT To sDrawItem Move (CopyMemory(AddressOf(sDrawItem),lParam,RdsDRAWITEMSTRUCT_Size)) To iResult GetBuff From sDrawItem At RdsDRAWITEMSTRUCT.itemID To iRow GetBuff From sDrawItem At RdsDRAWITEMSTRUCT.itemData To iData GetBuff From sDrawItem At RdsDRAWITEMSTRUCT.itemState To iState GetBuff From sDrawItem At RdsDRAWITEMSTRUCT.itemAction To iAction GetBuff From sDrawItem At RdsDRAWITEMSTRUCT.hDC To hDC GetBuff From sDrawItem At RdsDRAWITEMSTRUCT.rcItem.top To iTop GetBuff From sDrawItem At RdsDRAWITEMSTRUCT.rcItem.bottom To iBottom GetBuff From sDrawItem At RdsDRAWITEMSTRUCT.rcItem.Left To iLeft GetBuff From sDrawItem At RdsDRAWITEMSTRUCT.rcItem.Right To iRight // By default, the DefWindowProc function draws the focus rectangle for an owner-drawn list box item. // For column based lists, the focus rectangle should NOT be drawn by DefWindowProc, let's trick // DefWindowProc into thinking it doesn't need to paint the focus If (iAction Iand ODA_FOCUS) Put (iAction - ODA_FOCUS) To sDrawItem At RdsDRAWITEMSTRUCT.itemAction //If (iState iAnd ODS_FOCUS) Put (iState - ODS_FOCUS) To sDrawItem at RdsDRAWITEMSTRUCT.itemState Move (CopyMemory(lParam,AddressOf(sDrawItem),RdsDRAWITEMSTRUCT_Size)) To iResult If (Not(iAction Iand ODA_DRAWENTIRE)) Procedure_Return True // And Not(iAction iAnd ODA_FOCUS)) Procedure_Return True // Adjust rect for current horizontal scroll 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(oHorizontalBar(Self)),SB_CTL,AddressOf(sInfo))) To iResult GetBuff From sInfo At SCROLLINFO.nPos To iPos Move (iLeft-iPos) To iLeft // 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 // Draw text for all columns Move (iLeft) To iBegin For iCount From 0 To (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)) To iSubItems If (iSubItems = 0) Move 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 (SubColumnData(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) Begin If (iState Ior ODS_SELECTED And iSubColumn = CurrentSubColumn(Self) And iColumn = CurrentColumn(Self) And iRow = CurrentRow(Self)) ; Move (APISubColumnSelectedBackColor(Self,iRow,iColumn,iSubColumn)) To iBackColor Else If (SubColumnData(Self,CurrentRow(Self),CurrentColumn(Self),CurrentSubColumn(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 Move (SetBkMode(hDC,OPAQUE)) To iResult Move (PatBlt(hDC,iBegin,iTop,iWidth,(iBottom-iTop),PATCOPY)) To iResult Move (SelectObject(hDC,hOldBrush)) To iResult // Delete brush Move (DeleteObject(hBrush)) To iResult If (iResult = 0) Error 500 "Can't delete brush" // Get subcolumn text color If (Focus(Desktop) = Self) Begin If (iState Ior ODS_SELECTED And iSubColumn = CurrentSubColumn(Self) And iColumn = CurrentColumn(Self) And iRow = CurrentRow(Self)) ; Move (APISubColumnSelectedTextColor(Self,iRow,iColumn,iSubColumn)) To iTextColor Else If (SubColumnData(Self,CurrentRow(Self),CurrentColumn(Self),CurrentSubColumn(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 iImageList If iImageList Get Window_Handle Of iImageList 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 //If (iSelected) Move (CreatePen(PS_SOLID,ItemVerticalLineThickness(Self,iRow,iColumn),ItemSelectedBackColor(Self,iRow,iColumn))) To hPen //Else Move (CreatePen(PS_SOLID,ItemVerticalLineThickness(Self,iRow,iColumn),ItemVerticalLineColor(Self,iRow,iColumn))) To hPen 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 SubColumnData(Self,iRow,iColumn,iSubColumn) = 0 And SubColumnData(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 (APISubColumnSelectedBackColor(Self,iRow,iColumn,iSubColumn) = iBackColor) ; Move (CreatePen(PS_SOLID,0,iBackColor)) To hPen Else Move (CreatePen(PS_SOLID,0,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,iLeft,iBottom-1,0)) To iResult //Move (LineTo(hDC,iRight,iBottom-1)) To iResult For iLines From 1 To (APISubColumnHorizontalLineThickness(Self,iRow,iColumn,iSubColumn)) Move (MoveToEx(hDC,iBegin,iBottom-iLines,0)) To iResult Move (LineTo(hDC,iBegin+iWidth,iBottom-iLines)) To iResult //Move (LineTo(hDC,iBegin+iWidth-1,iBottom-iLines)) To iResult Loop //Move (MoveToEx(hDC,iBegin,iBottom-1,0)) To iResult //Move (LineTo(hDC,iBegin+iWidth-2,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-1 To sRect At tRECT.Right Put iBottom To sRect At tRECT.bottom Move (APISubColumnTextColor(Self,iRow,iColumn,iSubColumn)) To iTextColor Move (SetTextColor(hDC,iTextColor)) To iResult // If (iState = ODS_SELECTED And piColumn(Self) = iColumn And piSubColumn(Self) = iSubColumn) ; If (Focus(Desktop) = Self) Begin If (iState Ior ODS_SELECTED And iSubColumn = CurrentSubColumn(Self) And iColumn = CurrentColumn(Self) And iRow = CurrentRow(Self)) ; Move (DrawFocusRect(hDC,AddressOf(sRect))) To iResult 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) // Restore complete DC state //Move (RestoreDC(hDC,iDC)) To iDC Procedure_Return True End_Procedure // OnDrawItem End_Class // cGridBox