******************************************************************** * Description.......: myHeader.Definition * Calling Samples...: * Parameter List....: tcCaption * Ideas by..........: Cetin Basoz & David Frankenbach & Vlad Grynchyshyn * Modified by.......: Nadya Nosonovsky 09/14/2001 10:50:09 AM ******************************************************************** define class MyHeader as header mcArrowName = "" && name of the arrow used for all headers of the grid mlAscending = .f. && flag for sort order mlColumnMoved = .f. && flag indicating column was moved mnColumnOrder = 0 && original column order mlColumnSized = .f. && flag indicating column was resized mnColumnWidth = 0 && original size of column nOriginalForeColor = 0 && original ForeColor nCurForeColor = 0 && current ForeColor nForeColorAsc = 16711935 && Fore Color, when the column is in ASC order nForeColorDesc = 8388863 && Fore Color, when the column is in DESC order nNormalForeColor = 0 && Black nActiveColumnForeColor = 16777215 && White lDontChangeOthers = .f. && Flag, which tells to not change other headers forecolor lSorted = .f. && Logical property, what this column was sorted cTagName = '' && Tag Name, which should be used for sorting, if not specified, use the column source instead statusbartext = "" && Status Bar Text for the Header tooltiptext = "" && Tool Tip Text property for the Header lFirstTime = .t. && If ToolTipText was already assigned procedure init lparameters tcCaption local ix, lcProperty with this if vartype(m.tcCaption) # "C" ; or empty(m.tcCaption) tcCaption = .caption endif .caption = m.tcCaption .alignment = 2 .nOriginalForeColor=.forecolor .nCurForeColor = .forecolor if !pemstatus(.parent.parent,"nCurOrderedColumnIndex",5) .parent.parent.addproperty("nCurOrderedColumnIndex",0) endif if !pemstatus(.parent.parent,"nCurActiveColumnIndex",5) .parent.parent.addproperty("nCurActiveColumnIndex",0) endif endwith endproc procedure ForeColor_assign lparameters vNewVal *To do: Modify this routine for the Assign method with this if m.vNewVal <> .forecolor && Color is supposed to change if inlist(m.vNewVal, .nForeColorAsc, .nForeColorDesc) .parent.parent.nCurOrderedColumnIndex=.GetColumnIndex() else .nCurForeColor= m.vNewVal .nOriginalForeColor = m.vNewVal .parent.parent.nCurActiveColumnIndex=.GetColumnIndex() endif .forecolor = m.vNewVal endif endwith *!* procedure ToolTipText_assign *!* lparameters vNewVal *!* *To do: Modify this routine for the Assign method *!* with this *!* *!* if .lFirstTime *!* *!* && Add shape to a parent of the grid, if it does not exist already *!* *!* if not pemstatus(.parent.parent.parent,'shape'+.parent.parent.name,5) *!* *!* .parent.parent.parent.newobject('shape'+.parent.parent.name,'shape') *!* *!* with evaluate('this.parent.parent.parent.shape'+this.parent.parent.name) *!* *!* .height = this.parent.parent.headerheight *!* *!* .width = this.parent.parent.width *!* *!* .top = this.parent.parent.top *!* *!* .left = this.parent.parent.left *!* *!* .backstyle = 0 *!* *!* .tooltiptext = m.vNewVal *!* *!* .visible = .t. *!* *!* .zorder(1) && put it behind the header *!* *!* endwith *!* *!* endif *!* *!* endif *!* .tooltiptext = m.vNewVal *!* .lFirstTime = .f. && Now it's not the first time *!* endwith procedure GetColumnIndex local lnI, lnIndex lnIndex=0 with this.parent for lnI=1 to .parent.columncount if .parent.columns[m.lnI].columnorder=.columnorder lnIndex=m.lnI exit endif next endwith return m.lnIndex endproc procedure Order_Highlight lparameter toColumn if vartype(toColumn)<>'O' local lnOldIndex, lnIndex, loColumn, lnActiveColumn lnActiveColumn = this.parent.parent.activecolumn for each loColumn in this.parent.parent.columns if type('loColumn.Header1.caption')='C' ; and pemstatus(loColumn.Header1,'nOriginalForeColor',5) loColumn.Header1.lSorted = .f. if loColumn.columnorder <> m.lnActiveColumn or this.lDontChangeOthers loColumn.Header1.forecolor = this.nNormalForeColor else loColumn.Header1.forecolor = this.nActiveColumnForeColor endif endif next endif *!* lnOldIndex = this.parent.parent.nCurOrderedColumnIndex *!* with this.parent.parent *!* if m.lnOldIndex > 0 *!* wait window time 2 transform(m.lnOldIndex) *!* .columns[m.lnOldIndex].Header1.forecolor= ; *!* .columns[m.lnOldIndex].Header1.nOriginalForeColor *!* endif *!* endwith with this .lSorted = .t. if descending() .forecolor = .nForeColorDesc && Red else .forecolor = .nForeColorAsc endif endwith endproc procedure click local nTempCurRec, lcTagName with this if ! .mlColumnMoved and ! .mlColumnSized * sortable column that was clicked .mlAscending = ! .mlAscending thisform.lockscreen = .t. lcTagName=iif(!empty(.cTagName),.cTagName,justext(.parent.controlsource)) select (.parent.parent.recordsource) if tagno(m.lcTagName)> 0 nTempCurRec = recno(.parent.parent.recordsource) if .mlAscending set order to tag (m.lcTagName) ; in (.parent.parent.recordsource) ascending else set order to tag (m.lcTagName) ; in (.parent.parent.recordsource) descending endif .Order_Highlight() && Show color .parent.parent.refresh() if type('thisform.navstand.name')='C' thisform.navstand.lstOrders.refresh() thisform.navstand.navUpdate() endif if between(m.nTempCurRec,1,reccount(.parent.parent.recordsource)) go m.nTempCurRec in (.parent.parent.recordsource) endif endif thisform.lockscreen = .f. endif endwith endproc procedure mousemove && Mouse moves over control lparameters nButton, nShift, nXCoord, nYCoord with this set message to .statusbartext &&evaluate('this.parent.parent.parent.shape'+this.parent.parent.name) .parent.parent.tooltiptext = .tooltiptext .parent.parent.statusbartext = .statusbartext * .MouseDownToolTip(nButton, nShift, nXCoord, nYCoord) * .parent.parent.MouseMove(nButton, nShift, nXCoord, nYCoord) * mouse at mrow(), mcol() *!* endif endwith endproc procedure mousedown lparameters nButton, nShift, nXCoord, nYCoord with this * initialize items that will be tested in MouseUp .mnColumnOrder = this.parent.columnorder .mnColumnWidth = this.parent.width endwith endproc procedure mouseup lparameters nButton, nShift, nXCoord, nYCoord with this * check to see if this was a resize or move .mlColumnMoved = ( this.parent.columnorder != .mnColumnOrder ) .mlColumnSized = ( this.parent.width != .mnColumnWidth ) endwith endproc procedure dblclick this.click() *this.parent.parent.SetOrder(this.parent.controlsource) endproc procedure dWordStringToNumber parameter tcDWord local lnReturn, lnI if (vartype(m.tcDWord) <> "C") or (len(m.tcDWord) < 4) return 0 endif lnReturn = 0 for lnI = 1 to 4 lnReturn = asc( substr(m.tcDWord, 5-m.lnI, 1)) + m.lnReturn if lnI <> 4 lnReturn = m.lnReturn * 256 endif endfor return m.lnReturn endproc procedure MouseDownToolTip lparameters nButton, nShift, nXCoord, nYCoord * !!!! NOTE: * The code below is used to forward mouse clicks from this control to the * control below it. The code it copied from * the source of the Fancy ToolTip control by Paul-Vlad Tatavu * from the www.levelextreme.com site, downloads section. * Fancy ToolTip control provided for free, as described in the Readme.TXT * file in the download file. local lnMouseX, lnMouseY local lcPointStructure local lnFormHandle, lnTopParentHandle, lnHandle local lnPressedKeys local lnButtonDown, lnButtonUp, lnMKButton local lnWM_MOUSEACTIVATE, lnWM_SETCURSOR, lnWM_MOUSEMOVE, ; lnWM_LBUTTONDOWN, lnWM_RBUTTONDOWN, lnWM_MBUTTONDOWN, ; lnWM_LBUTTONUP, lnWM_RBUTTONUP, lnWM_MBUTTONUP, ; lnHTCLIENT, lnMK_LBUTTON, lnMK_RBUTTON, ; lnMK_MBUTTON, lnMK_SHIFT, lnMK_CONTROL *-- Declare Win32 API functions declare integer GetCursorPos ; in Win32API ; as __GetCursorPos__ ; string @lcPointStructure declare integer WindowFromPoint ; in Win32API ; as __WindowFromPoint__ ; integer lnX, ; integer lnY declare integer GetParent ; in Win32API ; as __GetParent__ ; integer lnWindowHandle declare integer SendMessage ; in Win32API ; as __SendMessage__ ; integer lnWindowHandle, ; integer lnMessage, ; integer lnWParam, ; integer lnLParam declare integer PostMessage ; in Win32API ; as __PostMessage__ ; integer lnWindowHandle, ; integer lnMessage, ; integer lnWParam, ; integer lnLParam declare integer ScreenToClient ; in Win32API ; as __ScreenToClient__ ; integer lnWindowHandle, ; string @lcPointStructure *-- Get the cursor position relative to screen lcPointStructure = replicate(chr(0), 8) = __GetCursorPos__(@lcPointStructure) *-- Extract the mouse coordinates from * the structure returned by GetCursorPosition() lnMouseX = this.dWordStringToNumber(; left(lcPointStructure, 4)) lnMouseY = this.dWordStringToNumber(; right(lcPointStructure, 4)) *-- Get a handle to the window under mouse * (a handle to the current form, in this case) lnFormHandle = __WindowFromPoint__(lnMouseX, lnMouseY) *-- Get a handle to the desktop window * that is a (grand)parent of the current form lnHandle = lnFormHandle do while lnHandle != 0 lnHandle = __GetParent__(lnHandle) if lnHandle != 0 lnTopParentHandle = lnHandle endif enddo *-- Declare constants used by mouse messages lnWM_MOUSEACTIVATE = 0x0021 lnWM_SETCURSOR = 0x0020 lnWM_MOUSEMOVE = 0x0200 lnWM_LBUTTONDOWN = 0x0201 lnWM_RBUTTONDOWN = 0x0204 lnWM_MBUTTONDOWN = 0x0207 lnWM_LBUTTONUP = 0x0202 lnWM_RBUTTONUP = 0x0205 lnWM_MBUTTONUP = 0x0208 lnHTCLIENT = 0x0001 lnMK_LBUTTON = 0x0001 lnMK_RBUTTON = 0x0002 lnMK_MBUTTON = 0x0010 lnMK_SHIFT = 0x0004 lnMK_CONTROL = 0x0008 lnPressedKeys = 0 if bitand(nShift, 1) = 1 *-- The Shift key was pressed when * mouse was clicked lnPressedKeys = bitor(lnPressedKeys, lnMK_SHIFT) endif if bitand(nShift, 2) = 2 *-- The Ctrl key was pressed when * mouse was clicked lnPressedKeys = bitor(lnPressedKeys, lnMK_CONTROL) endif do case case nButton = 0 && Nothing was pressed lnButtonDown = 0 lnButtonUp = 0 lnMKButton = 0 case nButton = 1 *-- Left button lnButtonDown = lnWM_LBUTTONDOWN lnButtonUp = lnWM_LBUTTONUP lnMKButton = lnMK_LBUTTON case nButton = 2 *-- Right button lnButtonDown = lnWM_RBUTTONDOWN lnButtonUp = lnWM_RBUTTONUP lnMKButton = lnMK_RBUTTON case nButton = 4 *-- Middle button lnButtonDown = lnWM_MBUTTONDOWN lnButtonUp = lnWM_MBUTTONUP lnMKButton = lnMK_MBUTTON endcase *-- Convert mouse coordinates from screen coordinates * to form's client area coordinates = __ScreenToClient__(lnFormHandle, @lcPointStructure) lnMouseX = this.dWordStringToNumber(; left(lcPointStructure, 4)) lnMouseY = this.dWordStringToNumber(; right(lcPointStructure, 4)) *-- Simulate a mouse up message(s) * (Will be received by the behind control) lnLParam = lnMouseY * 256 * 256 + lnMouseX = __SendMessage__( ; lnFormHandle, ; lnButtonUp, ; lnMKButton + lnPressedKeys, ; lnLParam) lnLParam = lnWM_MOUSEMOVE * 256 * 256 + lnHTCLIENT = __SendMessage__( ; lnFormHandle, ; lnWM_SETCURSOR, ; lnFormHandle, ; lnLParam) lnLParam = lnMouseY * 256 * 256 + lnMouseX = __PostMessage__( ; lnFormHandle, ; lnWM_MOUSEMOVE, ; lnPressedKeys, ; lnLParam) *-- Hide the control * this.visible = .f. *-- Simulate a mouse down message(s) * (Will be received by the control under mouse) lnLParam = lnButtonDown * 256 * 256 + lnHTCLIENT = __SendMessage__( ; lnFormHandle, ; lnWM_MOUSEACTIVATE, ; lnTopParentHandle, ; lnLParam) = __SendMessage__( ; lnFormHandle, ; lnWM_SETCURSOR, ; lnFormHandle, ; lnLParam) lnLParam = lnMouseY * 256 * 256 + lnMouseX = __PostMessage__( ; lnFormHandle, ; lnButtonDown, ; lnMKButton, ; lnLParam) * this.visible = .t. endproc enddefine