MSHFlexGrid Paginado

[jorevale]

Saludos amigos

¿Alguien sabe como hacer un MSHFlexGrid Paginado?

Nota: Cuando creamos un MSHFlexGrid con el asistente en VB6, el código es el que abajo aparece, pero no sé que debo hacer para paginar esto.

Gracias



Private Const MARGIN_SIZE = 60 ' en twips
' variables para permitir el orden de columnas
Private m_iSortCol As Integer
Private m_iSortType As Integer

' variables para arrastrar columnas
Private m_bDragOK As Boolean
Private m_iDragCol As Integer
Private xdn As Integer, ydn As Integer

Private Sub Form_Load()

datPrimaryRS.Visible = False

With MSHFlexGrid1

.Redraw = False
' establecer anchos de columna de cuadrícula
.ColWidth(0) = -1
.ColWidth(1) = -1
.ColWidth(2) = -1
.ColWidth(3) = -1
.ColWidth(4) = -1
.ColWidth(5) = -1

' establecer tipo de cuadrícula
.AllowBigSelection = True
.FillStyle = flexFillRepeat

' encabezado en negrita
.Row = 0
.Col = 0
.RowSel = .FixedRows - 1
.ColSel = .Cols - 1
.CellFontBold = True

.AllowBigSelection = False
.FillStyle = flexFillSingle
.Redraw = True

End With

End Sub

Private Sub MSHFlexGrid1_DragDrop(Source As Control, X As Single, Y As Single)

If m_iDragCol = -1 Then Exit Sub ' no se estaba arrastrando
If MSHFlexGrid1.MouseRow <> 0 Then Exit Sub

With MSHFlexGrid1
.Redraw = False
.ColPosition(m_iDragCol) = .MouseCol
.Redraw = True
End With

End Sub

Private Sub MSHFlexGrid1_MouseDown(Button As Integer, shift As Integer, X As Single, Y As Single)

If MSHFlexGrid1.MouseRow <> 0 Then Exit Sub

xdn = X
ydn = Y
m_iDragCol = -1 ' borrar indicador de arrastre
m_bDragOK = True

End Sub

Private Sub MSHFlexGrid1_MouseMove(Button As Integer, shift As Integer, X As Single, Y As Single)

' probar si se debe iniciar el arrastre
If Not m_bDragOK Then Exit Sub
If Button <> 1 Then Exit Sub ' botón incorrecto
If m_iDragCol <> -1 Then Exit Sub ' ya se está arrastrando
If Abs(xdn - X) + Abs(ydn - Y) < 50 Then Exit Sub ' no se ha movido suficiente
If MSHFlexGrid1.MouseRow <> 0 Then Exit Sub ' hay que arrastrar el encabezado

' si se llega aquí, iniciar el arrastre
m_iDragCol = MSHFlexGrid1.MouseCol
MSHFlexGrid1.Drag vbBeginDrag

End Sub

Private Sub MSHFlexGrid1_MouseUp(Button As Integer, shift As Integer, X As Single, Y As Single)

m_bDragOK = False

End Sub

Private Sub MSHFlexGrid1_DblClick()

Dim i As Integer

' sólo ordena cuando se hace clic en una fila
If MSHFlexGrid1.MouseRow >= MSHFlexGrid1.FixedRows Then Exit Sub

i = m_iSortCol ' guarda la columna antigua
m_iSortCol = MSHFlexGrid1.Col ' establece la nueva columna

' incrementa el tipo de orden
If i <> m_iSortCol Then
' si hace clic en una columna nueva, inicia con orden ascendente
m_iSortType = 1
Else
' si hace clic en la misma columna, alterna entre orden ascendente y orden descendente
m_iSortType = m_iSortType + 1
If m_iSortType = 3 Then m_iSortType = 1
End If

DoColumnSort

End Sub

Sub DoColumnSort()
'-------------------------------------------------------------------------------------------
' orden de tipo intercambio en la columna m_iSortCol
'-------------------------------------------------------------------------------------------

With MSHFlexGrid1
.Redraw = False
.Row = 1
.RowSel = .Rows - 1
.Col = m_iSortCol
.Sort = m_iSortType
.Redraw = True
End With

End Sub

Private Sub Form_Resize()

Dim sngButtonTop As Single
Dim sngScaleWidth As Single
Dim sngScaleHeight As Single

On Error GoTo Form_Resize_Error
With Me
sngScaleWidth = .ScaleWidth
sngScaleHeight = .ScaleHeight

' mueve el botón Cerrar a la esquina superior derecha
With .cmdClose
sngButtonTop = sngScaleHeight - (.Height + MARGIN_SIZE)
.Move sngScaleWidth - (.Width + MARGIN_SIZE), sngButtonTop
End With

.MSHFlexGrid1.Move MARGIN_SIZE, _
MARGIN_SIZE, _
sngScaleWidth - (2 * MARGIN_SIZE), _
sngButtonTop - (2 * MARGIN_SIZE)

End With
Exit Sub

Form_Resize_Error:
' evita errores en valores negativos
Resume Next

End Sub
Private Sub cmdClose_Click()

Unload Me

End Sub

[GeoAvila]

ahh que pena que estos días ando corto de tiempo pero nada me gustaría mas que darle solución a esta duda....

el tiempo te queda mal el día de hoy...

nos vemos..

[jorevale]

Gracias Geovanny.

Como el asunto me apremia porque es un tema del trabajo, he optado por buscar por internet una solución a mi problema, y la he encontrado cambiando el MSHFlexGrid por un DataGrid, aunque con ello pierdo la belleza y la funcionalidad del primero.

Por si a alguien le interesa abajo pongo el código, que ha sido encontrado en internet en un sitio en portugués que, lamentablemente, ahora no recuerdo.

Lo he adecuado un poco porque - aparte de la paginación, también necesito que los usuarios puedan ordenar por más de un campo, por eso he incluído unos botones de opción y algo más. Aun no está completamente analizado.

De todas formas, si alguien logra hacerlo con el MSHFlexGrid, os lo agradecería.

Salu2

Option Explicit
Private conn As ADODB.Connection
Private rst As ADODB.Recordset
Private subRst As ADODB.Recordset
Const PAGE_SIZE = 1000
Dim reg As Integer
Dim sql As String
Dim VPrimerClick As Boolean

Private Sub Form_Load()

VPrimerClick = False
Set conn = New ADODB.Connection

With conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=Z:\AUTI\AST\HIST.mdb"
.Open
End With

Set subRst = New ADODB.Recordset
Set rst = New ADODB.Recordset

Command1(2).Caption = "Próximos >" & PAGE_SIZE
Command1(1).Caption = "Anteriores < " & PAGE_SIZE

sql = "SELECT AVI,NOM,FIJ FROM AVISOS order by AVI"

With rst
.CursorLocation = adUseClient
.PageSize = PAGE_SIZE
.Properties("Initial Fetch Size") = PAGE_SIZE
.Open sql, conn, adOpenKeyset, , adAsyncFetchNonBlocking
Set DataGrid1.DataSource = PaginarRecordset(rst)
End With

reg = PAGE_SIZE
lblreg.Caption = reg
End Sub

Private Sub Command1_Click(Index As Integer)

If Option1(0).Value = True Then
If VPrimerClick = True Then
sql = "SELECT AVI,NOM,FIJ FROM AVISOS order by NOM"
With rst
.Close
.CursorLocation = adUseClient
.PageSize = PAGE_SIZE
.Properties("Initial Fetch Size") = PAGE_SIZE
.Open sql, conn, adOpenKeyset, , adAsyncFetchNonBlocking
Set DataGrid1.DataSource = PaginarRecordset(rst)
End With
VPrimerClick = False
End If
Else
If Option1(1).Value = True Then
If VPrimerClick = True Then
sql = "SELECT AVI,NOM,FIJ FROM AVISOS order by NOM"
With rst
.Close
.CursorLocation = adUseClient
.PageSize = PAGE_SIZE
.Properties("Initial Fetch Size") = PAGE_SIZE
.Open sql, conn, adOpenKeyset, , adAsyncFetchNonBlocking
Set DataGrid1.DataSource = PaginarRecordset(rst)
End With
VPrimerClick = False
End If
Else
If VPrimerClick = True Then
sql = "SELECT AVI,NOM,FIJ FROM AVISOS order by FIJ"
With rst
.Close
.CursorLocation = adUseClient
.PageSize = PAGE_SIZE
.Properties("Initial Fetch Size") = PAGE_SIZE
.Open sql, conn, adOpenKeyset, , adAsyncFetchNonBlocking
Set DataGrid1.DataSource = PaginarRecordset(rst)
End With
VPrimerClick = False
End If
End If
End If

Dim novaPagina As Long

With rst
Select Case Index
Case 0
novaPagina = 1
reg = PAGE_SIZE
lblreg.Caption = reg
Case 1
novaPagina = .AbsolutePage - 1
reg = reg - PAGE_SIZE
If reg < PAGE_SIZE Then
reg = PAGE_SIZE
End If
lblreg.Caption = reg
Case 2
novaPagina = .AbsolutePage + 1
reg = reg + PAGE_SIZE
If reg > rst.RecordCount Then
reg = rst.RecordCount
End If
lblreg.Caption = reg
Case 3
novaPagina = .PageCount
reg = rst.RecordCount
lblreg.Caption = reg
End Select

If novaPagina < 1 Or novaPagina > .PageCount Then
Exit Sub
End If

.AbsolutePage = novaPagina
Set DataGrid1.DataSource = PaginarRecordset(rst)

End With
End Sub

Private Function PaginarRecordset(recset As ADODB.Recordset) As ADODB.Recordset

Dim x As Long
Dim fld As Field
Dim origPage As Long

origPage = IIf(recset.AbsolutePage > 0, recset.AbsolutePage, 1)

With subRst
If .State = adStateOpen Then .Close

For Each fld In recset.Fields
.Fields.Append fld.Name, fld.Type, fld.DefinedSize, fld.Attributes
Next fld

.Open
For x = 1 To PAGE_SIZE

If recset.EOF Then Exit For
.AddNew

For Each fld In recset.Fields
subRst(fld.Name) = fld.Value
Next fld

.Update
recset.MoveNext

Next x

.MoveFirst
recset.AbsolutePage = origPage

End With

Set PaginarRecordset = subRst

End Function

Private Sub Form_Unload(Cancel As Integer)
subRst.Close
Set subRst = Nothing
rst.Close
Set rst = Nothing
conn.Close
Set conn = Nothing
End Sub


Private Sub Option1_Click(Index As Integer)
VPrimerClick = True
End Sub