Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Grid activity for object under mouse
Message
From
16/04/2008 11:42:01
 
General information
Forum:
Visual FoxPro
Category:
Forms & Form designer
Miscellaneous
Thread ID:
01211777
Message ID:
01311145
Views:
35
>>>I once sent Fred Taylor my version of it (basically at that point I only translated the comments). Later I tried to modify this a bit, but unfortunately I don't have the code anymore.
>>
>>I'm pretty sure I still have that code somewhere, but IIRC, it didn't work in VFP9/SP2.
>
>Thanks. Well, in such case it may be pretty useless then, but if you have it and can post it here (from Class Browser) it may be good anyway. I needed it for VFP8...

I'm pretty sure this is it:
PUBLIC oform1

oform1=NEWOBJECT("form1")
oform1.Show
RETURN


**************************************************

DEFINE CLASS form1 AS form
   Top = 0
   Left = 0
   Height = 323
   Width = 337
   DoCreate = .T.
   ShowTips = .T.
   Caption = " Grid with Tooltip"
   browser = .NULL.
   columnbold = ""
   nrow = 0
   ncol = 0
   ncol2 = 0
   nrow2 = 0
   nrec = 0
   ctooltip = ""
   lEditMode = .T.
   Name = "Form1"

   ADD OBJECT grid1 AS grid WITH ;
      ColumnCount = 3, HeaderHeight = 35, ;
      Left = 0, Top = 0, ;
      Height = 323, Width = 318, ;
      Panel = 1, RowHeight = 24, ;
      RecordSource = "test_data", ;
      TabIndex = 11, ;
      Name = "Grid1", ;
      Column1.ControlSource = "test_data.usercode", ;
      Column1.Width = 59, ;
      Column1.Visible = .T., ;
      Column1.Name = "Column1", ;
      Column2.ControlSource = "test_data.prod_code", ;
      Column2.Width = 87, ;
      Column2.Visible = .T., ;
      Column2.Name = "Column2", ;
      Column3.ControlSource = "test_data.prod_name", ;
      Column3.Width = 126, ;
      Column3.Name = "Column3"

   PROCEDURE Resize
      This.grid1.Height = This.Height
      This.grid1.Width = This.Width
   ENDPROC

   PROCEDURE Unload
      Close databases all
      Wait clear
   ENDPROC

   PROCEDURE Init

   ENDPROC

   PROCEDURE Load
      Create cursor Test_Data ;
         (UserCode C(3), UserName C(15), Prod_Code C(3), Prod_Name C(15), Prod_Info C(15))
      Insert into Test_Data Values ;
         ('001', 'My Name', '001', 'Product #1', 'InfoTip #1')
      Insert into Test_Data Values ;
         ('002', 'Your Name', '002', 'Product #2', 'InfoTip #2')
      Insert into Test_Data Values ;
         ('003', 'His Name', '003', 'Product #3', 'InfoTip #3')
      Insert into Test_Data Values ;
         ('004', 'Her Name', '004', 'Product #4', 'InfoTip #4')
      Insert into Test_Data Values ;
         ('005', 'Whatever', '005', 'Product #5', 'InfoTip #5')
      Insert into Test_Data Values ;
         ('006', 'Blah!', '006', 'Product #6', 'InfoTip #6')
      Go top
   ENDPROC


   PROCEDURE grid1.Init
      With This
         .Column1.Header1.Caption = "User"
         .Column2.Header1.Caption = "Product Code"
         .Column3.Header1.Caption = "Product Name"
         .Column1.RemoveObject('Text1')
         .Column2.RemoveObject('Text1')
         .Column3.RemoveObject('Text1')
         .Column1.AddObject('Text1', 'GridText')
         .Column2.AddObject('Text1', 'GridText')
         .Column3.AddObject('Text1', 'GridText')

         .SetAll('Alignment', 2, 'Header')
         .SetAll('DynamicBackColor', ;
            'iif(ThisForm.nRec == recno(), RGB(0,0,160), ' + ;
            'This.BackColor)', 'Column')
         .SetAll('DynamicForeColor', ;
            'iif(ThisForm.nRec == recno(), RGB(255,255,0), ' + ;
            'This.ForeColor)', 'Column')
      EndWith
      ThisForm.Height = This.Height
      ThisForm.Width = This.Width
   ENDPROC

   PROCEDURE grid1.MouseMove
   LPARAMETERS nButton, nShift, nXCoord, nYCoord
      Local lnWhere, lnRelRow, lnRelCol, lnX, lcColumn
      Store 0 to lnWhere, lnRelRow, lnRelCol

      This.GridHitTest(nXCoord, nYCoord, @lnWhere, @lnRelRow, @lnRelCol)
      With ThisForm
         If .lEditMode
            This.ToolTipText = ''
            If ((lnRelRow != .nrow) or (lnRelCol != .ncol) or ;
                empty(.ctooltip)) and (lnWhere == 3) and ;
                between(lnRelCol, 1, This.ColumnCount)

               .nrow = lnRelRow
               .ncol = lnRelCol
               .LockScreen = .T.
               This.ActivateCell(lnRelRow, lnRelCol)
               Go recno()
               .nrec = recno()
               Do case
                  Case (lnRelCol == 1)
                     .ctooltip = ' ' + alltrim(UserName) + ' '
                  Case between(lnRelCol, 2, 3)
                     .ctooltip = ' ' + alltrim(Prod_Info) + ' '
               EndCase
               This.Columns[lnRelCol].Text1.ToolTipText = .ctooltip
               This.Refresh()
               .LockScreen = .F.
               NoDefault
            endif
         else
            If ((lnRelRow != .nrow2) or (lnRelCol != .ncol2)) and ;
                (lnWhere = 3) and between(lnRelCol, 1, This.ColumnCount)

               .nrow2 = lnRelRow
               .ncol2 = lnRelCol
               lnRec = recno()
               .LockScreen = .T.
               This.ActivateCell(lnRelRow, lnRelCol)
               Go recno()
               .nrec = recno()
               This.ActivateCell(.nrow, .ncol)
               This.Refresh()
               .LockScreen = .F.
               NoDefault
            endif

         endif
      EndWith
   ENDPROC

   PROCEDURE grid1.Column1.MouseMove
   LPARAMETERS nButton, nShift, nXCoord, nYCoord
      This.Parent.MouseMove(nButton, nShift, nXCoord, nYCoord)
   ENDPROC

   PROCEDURE grid1.Column2.MouseMove
   LPARAMETERS nButton, nShift, nXCoord, nYCoord
      This.Parent.MouseMove(nButton, nShift, nXCoord, nYCoord)
   ENDPROC

   PROCEDURE grid1.Column3.MouseMove
   LPARAMETERS nButton, nShift, nXCoord, nYCoord
      This.Parent.MouseMove(nButton, nShift, nXCoord, nYCoord)
   ENDPROC
ENDDEFINE

**************************************************

DEFINE CLASS GridText AS textbox
   Height = 23
   Width = 100
   Name = "Text"
   Visible = .T.
   BorderStyle = 1
   Margin = 2

   PROCEDURE Click
      With ThisForm
         If .lEditMode
            Keyboard '{Home}' clear
            .lEditMode = .F.
         else
            .nrow = .nrow2
            .ncol = .ncol2
         endif
         .nrec = recno()
      EndWith
   ENDPROC

   PROCEDURE MouseMove
   LPARAMETERS nButton, nShift, nXCoord, nYCoord
      This.Parent.MouseMove(nButton, nShift, nXCoord, nYCoord)
   ENDPROC

   PROCEDURE KeyPress
   LPARAMETERS nKeyCode, nShiftAltCtrl
      ThisForm.lEditMode = .F.
   ENDPROC

   PROCEDURE LostFocus
      If inlist(lastkey(), 5, 9, 13, 15, 24, 27)
         ThisForm.lEditMode = .T.
      endif
   ENDPROC
ENDDEFINE
Fred
Microsoft Visual FoxPro MVP

foxcentral.net
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform