frmmain.frm

数据连接程序放到数据库里

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{7E74EDEC-DC77-4539-A9C9-E7DBC3106C8F}#3.1#0"; "bgrid.ocx"
Begin VB.Form frmMain 
   Caption         =   "查询窗口"
   ClientHeight    =   5010
   ClientLeft      =   4560
   ClientTop       =   3795
   ClientWidth     =   6645
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   5010
   ScaleWidth      =   6645
   Begin VB.CommandButton Command2 
      Caption         =   "退 出"
      Height          =   495
      Left            =   4680
      TabIndex        =   4
      Top             =   120
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "查 询"
      Height          =   495
      Left            =   3480
      TabIndex        =   2
      Top             =   120
      Width           =   1095
   End
   Begin MSComCtl2.DTPicker DTPicker1 
      Height          =   375
      Left            =   1440
      TabIndex        =   1
      Top             =   240
      Width           =   1575
      _ExtentX        =   2778
      _ExtentY        =   661
      _Version        =   393216
      Format          =   19660801
      CurrentDate     =   38232
   End
   Begin BeeGrid.BGrid BGrid 
      Height          =   4215
      Left            =   120
      TabIndex        =   0
      Top             =   720
      Width           =   6255
      _ExtentX        =   11033
      _ExtentY        =   7435
      OneCellOnly     =   0   'False
      MultiSelection  =   0   'False
      AllowSelectFRow =   -1  'True
      ShowZeroValues  =   0   'False
      Rows            =   6
      LockRow         =   0   'False
      LockCol         =   0   'False
      EnterGoVert     =   0   'False
      EnterDontGo     =   0   'False
      KeepEditState   =   0   'False
      SelectWhenEnter =   0   'False
      IgnoreCopyPasteKey=   0   'False
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "日 期"
      Height          =   180
      Left            =   720
      TabIndex        =   3
      Top             =   360
      Width           =   450
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim MySql As String
Dim RsBgrid As New ADODB.Recordset
Dim Rs1 As New ADODB.Recordset
Dim Rs2 As New ADODB.Recordset
Private Sub Command1_Click()
    Dim InDate As String
    Dim Wh As String
    Dim m, i, j As Integer
    InDate = Format(DTPicker1.Value, "yyyy-mm-dd")
    Wh = "accountbalance.FFundCode = accountmessage.ffundcode and accountbalance.FAccNum = accountmessage.faccnum where accountbalance.fdate = '" & InDate & "'"
    Set RsBgrid = Nothing
    Set RsBgrid = New ADODB.Recordset
    MySql = "select AccountBalance.*,AccountMessage.FAccName from accountmessage left outer join accountbalance on " & Wh
    
    RsBgrid.Open MySql, gcnnDataLink, adOpenStatic, adLockOptimistic
    For i = 1 To BGrid.Cols
        For j = 1 To BGrid.Rows
            BGrid.Text(j, i) = ""
        Next
    Next
    If RsBgrid.RecordCount < 1 Then
        MsgBox "所选日期各基金存款账户的余额均为空!"
        Exit Sub
    End If
    Do While Not RsBgrid.EOF
        For m = 1 To BGrid.Rows
            If Trim(BGrid.Text(m, 0)) = Trim(RsBgrid!ffundcode) Then
                i = m
                m = BGrid.Rows
            End If
        Next
        For m = 1 To BGrid.Cols
            If Trim(BGrid.Text(0, m)) = Trim(RsBgrid!faccname) Then
                j = m
                m = BGrid.Cols
            End If
        Next
        
        BGrid.Text(i, j) = RsBgrid!fbal
    RsBgrid.MoveNext
    Loop
End Sub
Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
On Error GoTo Err:
    Dim i As Integer
    Dim j As Integer
    Set Rs1 = Nothing
    Set Rs1 = New ADODB.Recordset
    Set Rs2 = Nothing
    Set Rs2 = New ADODB.Recordset
    
    MySql = "select distinct(faccname) from accountmessage"
    Rs1.Open MySql, gcnnDataLink, adOpenStatic, adLockReadOnly
    i = Rs1.RecordCount
    If i < 1 Then Exit Sub
    
    MySql = "select distinct(ffundcode) from accountmessage order by ffundcode"
    Rs2.Open MySql, gcnnDataLink, adOpenStatic, adLockBatchOptimistic

    With BGrid
        .ShowColHeader = False
        .ShowRowHeader = False
        .Cols = i + 1
        .Rows = Rs2.RecordCount + 1
        For j = 0 To i
            .FontBold(0, j) = True
        Next
        .FixedColsL = 1
        .FixedRowsT = 1
       .Text(0, 0) = " 基金代码 "
    End With
   
   j = 1
   With Rs1
       Do While Not .EOF
           BGrid.Text(0, j) = .Fields(0)
       .MoveNext
        j = j + 1
        Loop
        .Close
    End With

    If Rs2.RecordCount < 1 Then Exit Sub
    j = 1
    With Rs2
        Do While Not .EOF
            BGrid.Text(j, 0) = .Fields(0)
        .MoveNext
        j = j + 1
        Loop
        .Close
    End With
    Set Rs2 = Nothing
    
Err:
End Sub