针对MSHFlexGrid的一系列通用方法-项目中实践代…

'自定义报表填充程序 fgrid
Public Function ShowformfData(Resultset As ADODB.Recordset, ary As Variant, fg As MSHFlexGrid) As Variant
   Dim cl As field
   Static GridSetup As Boolean
   Dim MaxL As Long
   Dim Op As Long
   Dim rsl As ADODB.Recordset
   Dim rows, sl, field_value As Variant
   Dim i As Long
   Dim j, k As Long


   
'On Error GoTo ShowDataEH
   Set rsl = Resultset
 '------------------------------------------
 '等ERP系统全部导入到SQL SERVER 中才可用下面两行代码
 '如果不连AS400 ，则直接用下面函数
   If rsl.EOF Then
    Exit Function
   End If
 
   ShowMSHFlexGrid fg, rsl, ary
   Exit Function
 '
fg.Clear
fg.Cols = 0
fg.rows = 2
fg.ScrollTrack = True
'fg.ScrollTrack = False
Op = 1
fg.Enabled = True
If rsl.EOF Then
  MsgBox ("没有满足条件的记录,请重新修改您的查询条件")
  fg.rows = 0
  fg.Enabled = False
  Exit Function
Else
   fg.Visible = True
    For i = 0 To rsl.Fields.count
        fg.Cols = fg.Cols + 1
         If i = 0 Then
         fg.colwidth(0) = 800
         Else
            
               fg.Col = Op
               If rsl.Fields(Op - 1).DefinedSize > 255 Then
               MaxL = 1
               Else
               MaxL = rsl.Fields(Op - 1).ActualSize + 2
               End If
               If MaxL > 17 Then MaxL = 17
                   If MaxL < 9 Then MaxL = 9
                      fg.colwidth(fg.Col) = MaxL * 100
                      Op = Op + 1
          End If
         fg.TextMatrix(0, i) = ary(i)
      'FG.TextMatrix(0, i) = rsl.Fields(i).Name
       
 
     Next i
      'Cols = fg.Cols + 1
      'For I = 0 To rsl.Fields.Count
      'fg.TextMatrix(0, I) = ary(I)
      'Next I
    fg.rows = 2
    k = 1
    If Not (rsl.BOF And rsl.EOF) Then
     i = 0
     Do While Not rsl.EOF
      
       
       For j = 0 To rsl.Fields.count
         If j = 0 Then
         fg.TextMatrix(fg.rows - 1, j) = k
         Else
            
            If Not IsNull(rsl.Fields(j - 1).Value) Then
                 fg.TextMatrix(fg.rows - 1, j) = Trim(rsl.Fields(j - 1).Value)
            End If
            If rsl.Fields(j - 1).Type = adChar Then
                  fg.ColAlignment(j) = 0
            End If
            
          End If
       Next j
         fg.rows = fg.rows + 1
         fg.TopRow = fg.TopRow + 1
         fg.Refresh
         
         
         rsl.MoveNext
        k = k + 1
     Loop
    fg.rows = fg.rows - 1
    
    
    End If
      
End If
If fg.rows > 4 Then
    fg.TopRow = 1
    fg.Refresh
  End If

  SetRowColor fg
  fg.FixedRows = 1
  fg.row = 1
  fg.Col = 0

'b:
    Exit Function
    
'ShowDataEH:
'    MsgBox err & vbCrLf & Error$
'    fg.Visible = False
'    Resume b
    
     
End Function

Dim rsConstitute As ADODB.Recordset

txtsql = "select SSFXDM,KCWPDM,XTDWDM,SSZJYL from tabv "
     Set rsConstitute = Query(txtsql, msgtext)
    
     Set FGridCheck.DataSource = rsConstitute

Public Function fgclear(fg As MSHFlexGrid)
'20060728
    fg.Clear
    fg.rows = 2
    fg.Cols = 2
    fg.FixedRows = 1
    fg.FixedCols = 1
    fg.colwidth(0) = 1000
    fg.colwidth(1) = 1000
    fg.row = 0
    fg.Col = 0
End Function


' 设置MSHFlexGrid每列的颜色
Public Function SetColColor(fg As MSHFlexGrid)
'20060728
Dim i
fg.FillStyle = 1
For i = 2 To fg.Cols - 1
    fg.Col = i
    If i Mod 2 <> 0 Then
        fg.row = 0
        fg.RowSel = fg.rows - 1
        fg.CellBackColor = &HC0FFFF
    End If
Next i

fg.FillStyle = 0
fg.row = 0
fg.Col = 0

End Function

' 设置MSHFlexGrid每列的颜色
Public Function colw(fg As MSHFlexGrid) As String
'20060728
Dim i
Dim S
S = ""
For i = 0 To fg.Cols - 1
    S = S & "fg.ColWidth(" & i & ")=" & fg.colwidth(i) & " '" & fg.TextMatrix(0, i) & "   " & Chr(13) & Chr(10)
Next i
colw = S

End Function

Public Sub markfg1(ByRef fg As MSHFlexGrid, lb As Label, countlb As Label, delbutton As CommandButton)
Dim r, c
Dim markdgcount As Integer
r = fg.row
c = fg.Col

If r <> 0 Then
    If InStr(fg.TextMatrix(r, 0), "√") = 0 Then
        fg.TextMatrix(r, 0) = "√ " & fg.TextMatrix(r, 0)
        fg.Col = 0
        fg.CellAlignment = 7
        
        For i = 0 To fg.Cols - 1
        fg.Col = i
        fg.CellBackColor = &HFF&  '红色      '蓝色&H8000000D
        Next
        
        If countlb.Caption = "" Then
            markdgcount = 1
        Else
            markdgcount = CInt(countlb.Caption) + 1
        End If
    Else
        fg.TextMatrix(r, 0) = Right(fg.TextMatrix(r, 0), Len(fg.TextMatrix(r, 0)) - 2)
    If Trim(fg.TextMatrix(fg.row, 15)) = "N" Then
    If r Mod 2 = 0 Then
        For i = 0 To fg.Cols - 1
            fg.Col = i
            fg.CellBackColor = &HE0E0E0
        Next
    Else
        For i = 0 To fg.Cols - 1
            fg.Col = i
            fg.CellBackColor = &HFFFFFF
        Next
    End If
    Else
    For i = 0 To fg.Cols - 1
    fg.Col = i
    fg.CellBackColor = &H80FF80
    Next
    End If
        If countlb.Caption = "" Then
            markdgcount = 0
        Else
            markdgcount = CInt(countlb.Caption) - 1
        End If
    End If
If markdgcount <> 0 Then
    countlb.Caption = markdgcount
    lb.Caption = "已选择了 " & CStr(countlb.Caption) & " 条记录！"
    delbutton.Enabled = True
Else
    countlb.Caption = ""
    lb.Caption = ""
    delbutton.Enabled = False
End If
End If
End Sub