Ensure Visible Cell

Date: 02-16-2022

Return to Index

 
'Compilable Exmaple:
'Compilable Example:  (Jose Includes)
#Compiler PBWin 10
#Compile Exe
#Dim All
%Unicode=1
#Include "win32api.inc"
 
%IDC_ListView = 500
%IDM_GoTo     = 501
 
Global hDlg, hListView As Dword
 
Function PBMain() As Long
   Dialog New Pixels, 0, "ListView GoTo", , , 300,220, %WS_OverlappedWindow,, To hDlg
   Control Add ListView, hDlg, %IDC_ListView, "", 0, 0, 300,220
   Control Handle hDlg, %IDC_ListView To hListView                   'handle to ListView
   FillListView
   BuildAcceleratorTable
   Dialog Show Modal hDlg, Call DlgProc
End Function
 
CallBack Function DlgProc
   Static iCol, iRow As Long, temp$
   Select Case Cb.Msg
      Case %WM_Command
         Select Case Cb.Ctl
            Case %IDM_GoTO
               temp$ = InputBox$("Enter R,C","GoTo Cell", Trim$(Str$(iRow)) + "," + Trim$(Str$(iCol)))
               If Len(temp$) Then
                  iRow = Min(Val(Parse$(temp$,",",1)),10000)
                  iCol = Min(Val(Parse$(temp$,",",2)),30)
                  EnsureVisibleCell hDlg, %IDC_ListView, iRow, iCol
                  Dialog Set Text hDlg, "ListView GoTo: " + Trim$(Str$(iRow)) + "," + Trim$(Str$(iCol))
               End If
         End Select
   End Select
End Function
 
Sub BuildAcceleratorTable
   Local cc As Long, ac() As ACCELAPI, hAccelerator As Dword  ' for keyboard accelator table values
   Dim ac(0)
   ac(cc).fvirt = %FVIRTKEY Or %FCONTROL : ac(cc).key   = %VK_G : ac(cc).cmd  = %IDM_GoTo : Incr cc
   Accel Attach hDlg, AC() To hAccelerator
End Sub
 
Sub FillListview
   Local i,j As Long
   For i = 1 To 30
      ListView Insert Column hDlg, %IDC_Listview, i, "Col" + Trim$(Str$(i)), 70,0
   Next i
   For i = 1 To 10000
      ListView Insert Item hDlg, %IDC_ListView, i, 0, "R" + Trim$(Str$(j)) + " C1"
      For j = 1 To 30
         ListView Set Text hDlg, %IDC_ListView, i,j, "R" + Trim$(Str$(i)) + " C" + Trim$(Str$(j))
      Next j
   Next i
End Sub
 
Sub EnsureVisibleCell(hParent As Dword, cID As Long, RowTarget As Long, ColTarget As Long)
    Local i,w,h As Long, rc As Rect
    'ensure row is visible
    ListView Visible hParent, cID, RowTarget
    'width of listview
    Control Get Client hParent, cID To w,h
    'if cell right of client area, scroll back
    ListView_GetSubItemRect GetDlgItem(hParent,cID), RowTarget-1, ColTarget-1, %LVIR_Bounds, rc
    If rc.nRight > w Then Control Send hParent, cID, %LVM_Scroll,  rc.nRight-w , 0
    'if cell is left of client area, scroll forward
    ListView_GetSubItemRect GetDlgItem(hParent,cID), RowTarget-1, ColTarget-1, %LVIR_Bounds, rc
    If rc.nLeft < 0 Then Control Send hParent, cID, %LVM_Scroll,  rc.nLeft, 0
End Sub
 
'gbs_01396
'Date: 10-17-2014

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm