frmtable.frm

本系统是一个报表分析查询系统

VERSION 5.00
Object = "{709F7AE3-E049-11D2-9362-00403332E72F}#1.0#0"; "LEDGER50.OCX"
Begin VB.Form frmTable 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "选择编辑的数据表"
   ClientHeight    =   6525
   ClientLeft      =   45
   ClientTop       =   450
   ClientWidth     =   7230
   Icon            =   "frmTable.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6525
   ScaleWidth      =   7230
   StartUpPosition =   2  '屏幕中心
   Begin LEDGER50Lib.Ledger50 frmRpt 
      Height          =   3615
      Left            =   720
      TabIndex        =   0
      Top             =   1680
      Width           =   3255
      _Version        =   65536
      _ExtentX        =   5741
      _ExtentY        =   6376
      _StockProps     =   237
      ForeColor       =   0
      BackColor       =   16777215
   End
End
Attribute VB_Name = "frmTable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private frmCn As New ADODB.Connection
Private frmRs As New ADODB.Recordset
Private TxtSql As String
Private SelSign As Boolean

Private Sub Form_Load()
 With frmRpt
  .Left = 0
  .Top = 0
  .Width = Me.ScaleWidth
  .Height = Me.ScaleHeight
 End With
 '//
 SelSign = False
 '//
 Call LoadRpt
 Call RefreshLdg
End Sub

'//
Private Sub LoadRpt()
 With frmRpt
  .Face.Rows = 1
  .Face.FixedRows = 1
  .Face.Cols = 2
  .col(1).Width = 0
  .col(1).Switch(E_LDG_ColFlag_Hide) = True
  .col(2).Width = frmRpt.Width * 0.9
 End With
 frmCn.ConnectionString = meObj.BaseInfo.getConStr
 frmCn.Open
 TxtSql = "select js_tablename,js_tabledesc from Js_Table order by js_tabledesc asc"
End Sub

Private Sub RefreshLdg()
 On Error GoTo Errhandler
 Dim Sql As String
 Sql = TxtSql
 If frmRs.State = adStateOpen Then frmRs.Close
 frmRs.CursorLocation = adUseClient
 frmRs.Open Sql, frmCn, adOpenStatic, adLockReadOnly
 frmRpt.Merge.UnMergeAll
 frmRpt.Face.Rows = frmRs.RecordCount + frmRpt.Face.FixedRows
 frmRpt.Face.ForceRefresh
 Exit Sub
Errhandler:
 MsgBox "错误，编号：" & Err.Number & "-->信息：" & Err.Description, vbCritical + vbOKOnly, meObj.BaseInfo.getMsgInfo
End Sub

Private Sub Form_Unload(Cancel As Integer)
 If frmRs.State = adStateOpen Then frmRs.Close
 If frmCn.State = adStateOpen Then frmCn.Close
 Set frmRs = Nothing
 Set frmCn = Nothing
 If SelSign = False Then
  selTableName = ""
 End If
End Sub

Private Sub frmRpt_DblClick()
 selTableName = Trim(frmRpt.Cell(frmRpt.Sel.row, 1).Text)
 SelSign = True
 Unload Me
End Sub

Private Sub frmRpt_FillRow(ByVal lRow As Long, strRowData As String, clrBack As stdole.OLE_COLOR, clrFore As stdole.OLE_COLOR)
 Dim iLoop As Integer
 If lRow = 1 Then
  strRowData = "表内码|数据表名称|"
  Exit Sub
 End If
 frmRs.AbsolutePosition = lRow - frmRpt.Face.FixedRows
 strRowData = frmRs(0) & "|" & frmRs(1) & "|"
End Sub