frmbookcommonselectresult.frm

来自「通用书店管理系统」· FRM 代码 · 共 701 行 · 第 1/2 页

FRM
701
字号
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{DEF7CADD-83C0-11D0-A0F1-00A024703500}#7.0#0"; "TODG7.OCX"
Begin VB.Form frmBookCommonSelectResult 
   BackColor       =   &H00C0C0C0&
   Caption         =   "查询结果"
   ClientHeight    =   7110
   ClientLeft      =   675
   ClientTop       =   375
   ClientWidth     =   8535
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   7110
   ScaleWidth      =   8535
   Begin VB.CommandButton Command1 
      BackColor       =   &H00C0C0C0&
      Caption         =   "新增图书资料"
      Height          =   375
      Left            =   960
      TabIndex        =   4
      Top             =   6240
      Width           =   1335
   End
   Begin VB.CommandButton cmdClose 
      Height          =   495
      Left            =   7410
      Picture         =   "frmBookCommonSelectResult.frx":0000
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   6165
      Width           =   945
   End
   Begin VB.CommandButton cmdOk 
      Height          =   495
      Left            =   6120
      Picture         =   "frmBookCommonSelectResult.frx":14E4
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   6165
      Width           =   975
   End
   Begin VB.CommandButton cmdPrint 
      Height          =   375
      Left            =   360
      Picture         =   "frmBookCommonSelectResult.frx":29C8
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   6225
      Visible         =   0   'False
      Width           =   495
   End
   Begin TrueOleDBGrid70.TDBGrid grdQryResult 
      Height          =   6000
      Left            =   120
      TabIndex        =   3
      Top             =   0
      Width           =   8295
      _ExtentX        =   14631
      _ExtentY        =   10583
      _LayoutType     =   0
      _RowHeight      =   -2147483647
      _WasPersistedAsPixels=   0
      Columns(0)._VlistStyle=   0
      Columns(0)._MaxComboItems=   5
      Columns(0).DataField=   ""
      Columns(0)._PropDict=   "_MaxComboItems,516,2;_VlistStyle,514,3"
      Columns(1)._VlistStyle=   0
      Columns(1)._MaxComboItems=   5
      Columns(1).DataField=   ""
      Columns(1)._PropDict=   "_MaxComboItems,516,2;_VlistStyle,514,3"
      Columns.Count   =   2
      Splits(0)._UserFlags=   0
      Splits(0).RecordSelectorWidth=   503
      Splits(0)._SavedRecordSelectors=   0   'False
      Splits(0).DividerColor=   13160660
      Splits(0).SpringMode=   0   'False
      Splits(0)._PropDict=   "_ColumnProps,515,0;_UserFlags,518,3"
      Splits(0)._ColumnProps(0)=   "Columns.Count=2"
      Splits(0)._ColumnProps(1)=   "Column(0).Width=3281"
      Splits(0)._ColumnProps(2)=   "Column(0).DividerColor=0"
      Splits(0)._ColumnProps(3)=   "Column(0)._WidthInPix=3175"
      Splits(0)._ColumnProps(4)=   "Column(0)._ColStyle=260"
      Splits(0)._ColumnProps(5)=   "Column(0).Order=1"
      Splits(0)._ColumnProps(6)=   "Column(1).Width=3281"
      Splits(0)._ColumnProps(7)=   "Column(1).DividerColor=0"
      Splits(0)._ColumnProps(8)=   "Column(1)._WidthInPix=3175"
      Splits(0)._ColumnProps(9)=   "Column(1)._ColStyle=260"
      Splits(0)._ColumnProps(10)=   "Column(1).Order=2"
      Splits.Count    =   1
      PrintInfos(0)._StateFlags=   0
      PrintInfos(0).Name=   "piInternal 0"
      PrintInfos(0).PageHeaderFont=   "Size=9,Charset=134,Weight=400,Underline=0,Italic=0,Strikethrough=0,Name=宋体"
      PrintInfos(0).PageFooterFont=   "Size=9,Charset=134,Weight=400,Underline=0,Italic=0,Strikethrough=0,Name=宋体"
      PrintInfos(0).PageHeaderHeight=   0
      PrintInfos(0).PageFooterHeight=   0
      PrintInfos.Count=   1
      DataMode        =   4
      DefColWidth     =   0
      HeadLines       =   1
      FootLines       =   1
      MultipleLines   =   0
      CellTipsWidth   =   0
      DataView        =   2
      GroupByCaption  =   "把分组列头拖到这里"
      DeadAreaBackColor=   13160660
      RowDividerColor =   13160660
      RowSubDividerColor=   13160660
      DirectionAfterEnter=   1
      MaxRows         =   250000
      ViewColumnCaptionWidth=   0
      ViewColumnWidth =   0
      _PropDict       =   "_ExtentX,2003,3;_ExtentY,2004,3;_LayoutType,512,2;_RowHeight,16,3;_StyleDefs,513,0;_WasPersistedAsPixels,516,2"
      _StyleDefs(0)   =   "_StyleRoot:id=0,.parent=-1,.alignment=3,.valignment=0,.bgcolor=&H80000005&"
      _StyleDefs(1)   =   ":id=0,.fgcolor=&H80000008&,.wraptext=0,.locked=0,.transparentBmp=0"
      _StyleDefs(2)   =   ":id=0,.fgpicPosition=0,.bgpicMode=0,.appearance=0,.borderSize=0,.ellipsis=0"
      _StyleDefs(3)   =   ":id=0,.borderColor=&H80000005&,.borderType=0,.bold=0,.fontsize=900,.italic=0"
      _StyleDefs(4)   =   ":id=0,.underline=0,.strikethrough=0,.charset=134"
      _StyleDefs(5)   =   ":id=0,.fontname=宋体"
      _StyleDefs(6)   =   "Style:id=1,.parent=0,.namedParent=33"
      _StyleDefs(7)   =   "CaptionStyle:id=4,.parent=2,.namedParent=37"
      _StyleDefs(8)   =   "HeadingStyle:id=2,.parent=1,.namedParent=34"
      _StyleDefs(9)   =   "FooterStyle:id=3,.parent=1,.namedParent=35"
      _StyleDefs(10)  =   "InactiveStyle:id=5,.parent=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
      _StyleDefs(11)  =   "SelectedStyle:id=6,.parent=1,.namedParent=36"
      _StyleDefs(12)  =   "EditorStyle:id=7,.parent=1"
      _StyleDefs(13)  =   "HighlightRowStyle:id=8,.parent=1,.namedParent=38"
      _StyleDefs(14)  =   "EvenRowStyle:id=9,.parent=1,.namedParent=39"
      _StyleDefs(15)  =   "OddRowStyle:id=10,.parent=1,.namedParent=40"
      _StyleDefs(16)  =   "RecordSelectorStyle:id=11,.parent=2,.namedParent=41"
      _StyleDefs(17)  =   "FilterBarStyle:id=12,.parent=1,.namedParent=42"
      _StyleDefs(18)  =   "Splits(0).Style:id=25,.parent=1"
      _StyleDefs(19)  =   "Splits(0).CaptionStyle:id=64,.parent=4"
      _StyleDefs(20)  =   "Splits(0).HeadingStyle:id=26,.parent=2"
      _StyleDefs(21)  =   "Splits(0).FooterStyle:id=27,.parent=3"
      _StyleDefs(22)  =   "Splits(0).InactiveStyle:id=28,.parent=5"
      _StyleDefs(23)  =   "Splits(0).SelectedStyle:id=30,.parent=6"
      _StyleDefs(24)  =   "Splits(0).EditorStyle:id=29,.parent=7"
      _StyleDefs(25)  =   "Splits(0).HighlightRowStyle:id=31,.parent=8"
      _StyleDefs(26)  =   "Splits(0).EvenRowStyle:id=32,.parent=9"
      _StyleDefs(27)  =   "Splits(0).OddRowStyle:id=63,.parent=10"
      _StyleDefs(28)  =   "Splits(0).RecordSelectorStyle:id=65,.parent=11"
      _StyleDefs(29)  =   "Splits(0).FilterBarStyle:id=66,.parent=12"
      _StyleDefs(30)  =   "Splits(0).Columns(0).Style:id=70,.parent=25"
      _StyleDefs(31)  =   "Splits(0).Columns(0).HeadingStyle:id=67,.parent=26,.alignment=0"
      _StyleDefs(32)  =   "Splits(0).Columns(0).FooterStyle:id=68,.parent=27"
      _StyleDefs(33)  =   "Splits(0).Columns(0).EditorStyle:id=69,.parent=29"
      _StyleDefs(34)  =   "Splits(0).Columns(1).Style:id=74,.parent=25"
      _StyleDefs(35)  =   "Splits(0).Columns(1).HeadingStyle:id=71,.parent=26,.alignment=0"
      _StyleDefs(36)  =   "Splits(0).Columns(1).FooterStyle:id=72,.parent=27"
      _StyleDefs(37)  =   "Splits(0).Columns(1).EditorStyle:id=73,.parent=29"
      _StyleDefs(38)  =   "Named:id=33:Normal"
      _StyleDefs(39)  =   ":id=33,.parent=0"
      _StyleDefs(40)  =   "Named:id=34:Heading"
      _StyleDefs(41)  =   ":id=34,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
      _StyleDefs(42)  =   ":id=34,.wraptext=-1"
      _StyleDefs(43)  =   "Named:id=35:Footing"
      _StyleDefs(44)  =   ":id=35,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
      _StyleDefs(45)  =   "Named:id=36:Selected"
      _StyleDefs(46)  =   ":id=36,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
      _StyleDefs(47)  =   "Named:id=37:Caption"
      _StyleDefs(48)  =   ":id=37,.parent=34,.alignment=2"
      _StyleDefs(49)  =   "Named:id=38:HighlightRow"
      _StyleDefs(50)  =   ":id=38,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
      _StyleDefs(51)  =   "Named:id=39:EvenRow"
      _StyleDefs(52)  =   ":id=39,.parent=33,.bgcolor=&HFFFF00&"
      _StyleDefs(53)  =   "Named:id=40:OddRow"
      _StyleDefs(54)  =   ":id=40,.parent=33"
      _StyleDefs(55)  =   "Named:id=41:RecordSelector"
      _StyleDefs(56)  =   ":id=41,.parent=34"
      _StyleDefs(57)  =   "Named:id=42:FilterBar"
      _StyleDefs(58)  =   ":id=42,.parent=33"
   End
   Begin MSComctlLib.StatusBar sb 
      Align           =   2  'Align Bottom
      Height          =   360
      Left            =   0
      TabIndex        =   5
      Top             =   6750
      Width           =   8535
      _ExtentX        =   15055
      _ExtentY        =   635
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   2
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   5292
            MinWidth        =   5292
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmBookCommonSelectResult"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'------------------------------------------------------------------------------
' 文件名称: frmCommonSelectResult.frm
' 文件说明: 通用选择对话框,显示查询结果,返回选择结果
'------------------------------------------------------------------------------
' 详细说明:
'------------------------------------------------------------------------------
' 设计思路: 根据传入的strQrySQL语句得到查询值;根据传入的strHeader得到列头标题;
'           根据strReturnCols得到返回列。
'           如果只选择了一行, 且返回列为非-1的某列,则返回值赋给varQryResult;否则
'           将返回arrResult
'------------------------------------------------------------------------------
Option Explicit

Private Const MARGIN_SIZE = 60      ' 单位为缇
' 数据绑定变量
Private adoPrimaryRS As New ADODB.Recordset
Attribute adoPrimaryRS.VB_VarHelpID = -1

' 能列排序变量
Private m_iSortCol As Integer
Private m_iSortType As Integer

Public strReturnCols As String
Public strHeader As String
Public strQrySQL As String

' 查询结果所返回的值
Public blnOK As Boolean
Public varQryResult As Variant
Public arrResult As Variant            ' 定义一个数组表格,用来返回数组

Dim X As New XArrayDB

Private Sub cmdOK_Click()
    On Error GoTo err
    
    blnOK = False
    
    varQryResult = vbNull
    If Me.grdQryResult.row < 0 Then
        Exit Sub        '只能取消
    End If
    
    ' 设置当前光标行为选择行 lzw 2002-03
    Me.grdQryResult.SelBookmarks.Add (Me.grdQryResult.GetBookmark(0))
    
    If IsNull(Me.grdQryResult.Bookmark) Then
        MsgBox "请选择需返回的数据!"
        Exit Sub
    Else
        If grdQryResult.SelBookmarks.Count = 0 Then
            MsgBox "请选择需返回的数据!"
            Exit Sub
        End If
    End If
    
    '返回值处理
    Dim lngRow As Long
    Dim lngCol As Integer
    Dim r
    
    r = Split(Trim(strReturnCols), ",")
    If UBound(r) = 0 Then
        If CLng(r(0)) <> -1 Then
            
            varQryResult = Me.grdQryResult.Columns(CLng(r(0))).CellText(Me.grdQryResult.Bookmark)
            
            ReDim arrResult(grdQryResult.SelBookmarks.Count - 1, 0)
            For lngRow = 0 To grdQryResult.SelBookmarks.Count - 1
                arrResult(lngRow, 0) = X(grdQryResult.SelBookmarks.Item(lngRow), CLng(r(0)))
            Next lngRow
        Else
            varQryResult = vbNull
            
            ReDim arrResult(grdQryResult.SelBookmarks.Count - 1, X.UpperBound(2))
            For lngRow = 0 To grdQryResult.SelBookmarks.Count - 1
                For lngCol = 0 To X.UpperBound(2)
                    arrResult(lngRow, lngCol) = X(grdQryResult.SelBookmarks.Item(lngRow), lngCol)
                Next lngCol
            Next lngRow
        End If
    Else
        varQryResult = vbNull
        
        ReDim arrResult(grdQryResult.SelBookmarks.Count - 1, UBound(r))
        For lngRow = 0 To grdQryResult.SelBookmarks.Count - 1
            For lngCol = 0 To UBound(r)
                arrResult(lngRow, lngCol) = X(grdQryResult.SelBookmarks.Item(lngRow), CLng(r(lngCol)))
            Next lngCol
        Next lngRow
    End If
    
    Unload Me
    
    blnOK = True
    
    Exit Sub
err:
    MsgBox err.Description
    blnOK = False
    
End Sub

Private Sub cmdPrint_Click()
'打印信息

    With Me.grdQryResult
        .PrintInfo.Name = "查询结果"
        .PrintInfo.PageFooter = .PrintInfo.PreviewPageOf
        .PrintInfo.PreviewCaption = "通用选择查询打印阅览……"
        .PrintInfo.PreviewMaximize = True
        .PrintInfo.RepeatColumnHeaders = True
        .PrintInfo.PreviewInitZoom = 100
        .PrintInfo.PrintPreview
    End With
        
End Sub

Private Sub cmdSort_Click()

    Dim ColIndex%, intSplit%
    
    If X.UpperBound(1) < 0 Then Exit Sub
        
    Dim intType() As Integer
    Dim i%
    Dim blnExistInGroup As Boolean   '判断选种列是否是分组列

    ReDim intType(grdQryResult.GroupColumns.Count)

    '确定分组列的数据类型
    For i = 0 To grdQryResult.GroupColumns.Count - 1
       intType(i) = 9
       If Not IsVacancy(X(0, grdQryResult.GroupColumns.Item(i).ColIndex)) Then
           If IsNumeric(X(0, grdQryResult.GroupColumns.Item(i).ColIndex)) Then
              intType(i) = 5                    '双精度
           End If
       End If

       If grdQryResult.GroupColumns.Item(i).ColIndex = ColIndex Then blnExistInGroup = True

    Next i


    If blnExistInGroup Then Exit Sub     '如果选种列是分组列,则不进行排序

    '确定被选种列的数据类型
    intType(grdQryResult.GroupColumns.Count) = 9                        '默认值:字符型9
    If Not IsVacancy(X(0, ColIndex)) Then
       If IsNumeric(X(0, ColIndex)) Then
          intType(grdQryResult.GroupColumns.Count) = 5                    '双精度
       End If
    End If

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?