MSHFlexGridに対する一連の一般的な方法-プロジェクトにおける実践コードの共有

16807 ワード

1.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

2.より効率的な方法の取得は、今日のプロジェクトで速度の問題を解決する必要があるため、簡単で迅速です.
Dim rsConstitute As ADODB.Recordset



txtsql = "select SSFXDM,KCWPDM,XTDWDM,SSZJYL from tabv "

     Set rsConstitute = Query(txtsql, msgtext)

    

     Set FGridCheck.DataSource = rsConstitute

 
3.MSHFlexGridに対する一連の一般的な方法:
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

 
作者:王春2013.1.14住所:http://www.cnblogs.com/spring_wang/p/3423182.html