[Resolvido] Mais um exemplo de datagrid

[xanburzum 169]

Mais um exemplo de datagrid.

 

<%
'clsDropDownMe
'Destinado a ser semelhante a um. Net combobox
Class clsDropDownMe
'~~~~~~~~~~~~~~
 'Private Fields
 Private m_ID ' String
 Private m_strCssClass ' String
 Private m_strDataSource ' String
 Private m_strDataMember ' String
 Private m_strDataTextField ' String
 Private m_strDataValueField ' String
 Private m_blnEnabled ' Boolean
 Private m_blnMultiple ' Boolean
 Private m_strOrderByField  ' Boolean
 Private m_strScript ' String
 Private m_strSelectedValue ' String
 Private m_intSize ' Integer
 Private m_intTabIndex ' Integer
 Private m_intWidth ' String


 Private m_intDataSourceType ' Integer
 Private arrTable ' Array


 Private m_cnDDM ' Adodb.Connection
 Private m_rsDDM ' Adodb.Recordset
 Private m_strSQL ' String
 Private m_strOutput ' String
 
 Private m_intInvalidDataSource ' Integer
 Private m_intNoDataSource ' Integer
 Private m_intNoDataMember ' Integer
 Private m_intNoDataValueField ' Integer
 Private m_intNoDataTextField ' Integer
 
 '~~~~~~~~~~~~~~~~~
 'Propriedades Públicas

 Public Property Get ID()
  ID = m_ID
 End Property
 Public Property Let ID(Value)
  m_ID = Value
 End Property



 Public Property Get CssClass()
  CssClass = m_strCssClass
 End Property
 Public Property Let CssClass(Value)
  m_strCssClass = Value
 End Property
 
 Public Property Get DataSource()
  DataSource = m_strDataSource
 End Property
 Public Property Let DataSource(Value)


  Select Case VarType(Value)
   Case vbArray
    m_intDataSourceType = vbArray
   Case vbString 
    m_intDataSourceType = vbString 
   Case Else
    m_intDataSourceType = vbError
    Err.Raise (vbObjectError + m_intInvalidDataSource), "clsDropDownMe", "DataSource property must be set to a database connection string"
  End Select


  m_strDataSource = Value
 End Property


 Public Property Get DataMember()
  DataMember = m_strDataMember
 End Property
 Public Property Let DataMember(Value)
  m_strDataMember = Value
 End Property


 Public Property Get DataTextField()
  DataTextField = m_strDataTextField
 End Property
 Public Property Let DataTextField(Value)
  m_strDataTextField = Value
 End Property


 Public Property Get DataValueField()
  DataValueField = m_strDataValueField
 End Property
 Public Property Let DataValueField(Value)
  m_strDataValueField = Value
 End Property


 Public Property Get Enabled()
  Enabled = m_blnEnabled
 End Property
 Public Property Let Enabled(Value)
  m_blnEnabled = Value
 End Property


 Public Property Get Multiple()
  Multiple = m_blnMultiple
 End Property
 Public Property Let Multiple(Value)
  m_blnMultiple = Value
 End Property


 Public Property Get OrderByField()
  OrderByField = m_strOrderByField
 End Property
 Public Property Let OrderByField(Value)
  m_strOrderByField = Value
 End Property
 
 Public Property Get Script()
  Script = m_strScript
 End Property
 Public Property Let Script(Value)
  m_strScript = Value
 End Property



 Public Property Get SelectedValue()
  SelectedValue = m_strSelectedValue
 End Property
 Public Property Let SelectedValue(Value)
  m_strSelectedValue = Value
 End Property
 
 Public Property Get Size()
  Size = m_intSize
 End Property
 Public Property Let Size(Value)
  m_intSize = Value
 End Property
 
 Public Property Get TabIndex()
  TabIndex = m_intTabIndex
 End Property
 Public Property Let TabIndex(Value)
  m_intTabIndex = Value
 End Property


 Public Property Get Width()
  Width = m_intWidth
 End Property
 Public Property Let Width(Value)
  m_intWidth = Value
 End Property
 
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Contructor e deconstructor 
 
  'Class_Initialize 

 Private Sub Class_Initialize() 
  'Configure o número de erro personalizada
  m_intInvalidDataSource = 6
  m_intNoDataSource  = 7
  m_intNoDataMember  = 8
  m_intNoDataValueField = 9
  m_intNoDataTextField = 10
    
    'Criar um objeto Connection e Recordset
  Set m_cnDDM = server.createobject("Adodb.Connection") 
       Set m_rsDDM = server.createobject("Adodb.Recordset") 
 End Sub 
 
 'Class_Terminate
  'Fecha Recordset e conexões se fossem deixadas em aberto após um erro
 Private Sub Class_Terminate() 
    
  m_strOutput = ""

  'Determine se objeto recordset  foi criado
  If IsObject(m_rsDDM) And (Not (m_rsDDM is Nothing)) Then
  
   'Determinar se o recordset é aberto..
   If m_rsDDM.State = adStateOpen then
    '...close
    m_rsDDM.Close
   End If
   
   'destruir a referência para o recordset
   Set m_rsDDM = Nothing
  End If

  'Determine se objeto conexão  foi criado
  If IsObject(m_cnDDM)  And (Not (m_cnDDM is Nothing)) Then
   'Determinar se a ligação está aberta ...
   If m_cnDDM.State = adStateOpen then
    '... close
    m_cnDDM.Close
   End If
   'destruir a referência para o connection
   Set m_cnDDM = Nothing
  End If
 End Sub 'Class_Terminate
 

 '~~~~~~~~~~~~~~
 'Métodos Public
 'Bind
 'liga os dados no DataSource para o controle e renders 
 Public Sub Bind()
  Dim intTableCols, intTableRows ' Integer
  Dim intCurrentRow, Columns 'Integer


  'Determinar se  propriedades foram setadas
  If (m_strDataSource = "") Then
   Err.Raise (vbObjectError + m_intNoDataSource), "clsDropDownMe", "DataSource field property have not been set"
   Exit Sub
  End If


  'Determina dados e preenche uma matriz a partir dele
  Select Case m_intDataSourceType
   
   Case vbArray
    arrTable = m_strDataSource
    
   Case vbString


    If (m_strDataMember = "") Then
     Err.Raise (vbObjectError + m_intNoDataMember), "clsDropDownMe", "DataMember field property have not been set"
     Exit Sub
    End If


    If (m_strDataTextField = "") Then
     Err.Raise(vbObjectError + m_intNoDataTextField), "clsDropDownMe", "DataText field property have not been set"
     Exit Sub
    End If


    If (m_strDataValueField = "") Then
     Err.Raise(vbObjectError + m_intNoDataValueField), "clsDropDownMe", "DataValue field property have not been set"
     Exit Sub
    End If


    'Utilize GetRows em função de criar array
    arrTable = PopulateArrayFromDataSource(m_strDataSource)
    
  End Select
  
  m_strOutput = "    <select name=""" & m_ID & """ "
  
  'Adicionar evento scripting se a propriedade está definida.
  If Lenb(m_strScript) > 0 Then
   m_strOutput = m_strOutput & m_strScript & " "
  End If


  'Determinar se propriedade esta ativada
  If m_blnEnabled <> True Then
   m_strOutput = m_strOutput & " disabled "
  End If

  'Determinar se múltiplas propriedade são definida
  If m_blnMultiple <> True Then
   m_strOutput = m_strOutput & " multiple "
  End If


  'Determina se propriedade TabIndex  é definida
  If (IsNumeric(m_intTabIndex)) And (m_intTabIndex > 0) Then
   m_strOutput = m_strOutput & " tabindex=""" & m_intTabIndex & """ "
  End If



  'Determina se propriedade Size é definida
  If (IsNumeric(m_intSize)) And (m_intSize > 0) Then
   m_strOutput = m_strOutput & " size=""" & m_intSize & """ "
  End If



 'Adicionar classe Css se a propriedade está definida.
  If Lenb(m_strCssClass) > 0 Then
   m_strOutput = m_strOutput & " class=""" & m_strCssClass & """ "
  End If
  
  'Adicionar closing tag para saída
  m_strOutput = m_strOutput & ">" & vbNewLine
  
  intTableCols = UBound(arrTable, 1) 
  intTableRows = UBound(arrTable, 2) 



  'Loop através de todas "Linhas", no array
  For intCurrentRow = 0 to intTableRows 


   m_strOutput = m_strOutput & "      <option value=""" & arrTable(0, intCurrentRow) & """ "
   
   If SelectedValue = arrTable(0, intCurrentRow) Then
     m_strOutput = m_strOutput & "selected "
    End If
   
   m_strOutput = m_strOutput & "> " & arrTable(1, intCurrentRow) & "</option>" &vbNewLine



  Next

  m_strOutput = m_strOutput & "    </select>" & vbNewLine
  
  'Escreve a saída
  Response.Write m_strOutput  



 End Sub


 '~~~~~~~~~~~~~~~
 'Métodos Private  


 'PopulateArrayFromDataSource

  'Entradas: DataSource como conexão string 
  'Retorna: Uma matriz populacional utilizando GetRows

  Private Function PopulateArrayFromDataSource(ByVal DataSource) 'As Array
  Dim arrTemp 'As Array
  
  'Preencher SQL
  m_strSQL = GetDropDownMenuSQL()
  'DebugPrintSQL(m_strSQL)
  'Response.End
 
  'Abrir a conexao
  m_cnDDM.Open(m_strDataSource)



  'Preencher recordset
  Set m_rsDDM = m_cnDDM.Execute(m_strSQL) 


  arrTemp = m_rsDDM.GetRows 

  'Determina se recordset foi criado
  If IsObject(m_rsDDM) And (Not (m_rsDDM is Nothing)) Then
  
   'Determina se o recordset é aberto ...
   If m_rsDDM.State = adStateOpen then
 
    m_rsDDM.Close
   End If
   
   'Kill na referência para o recordset
   Set m_rsDDM = Nothing
  End If




 'Determina se conexão foi criada
  If IsObject(m_cnDDM)  And (Not (m_cnDDM is Nothing)) Then
   ''Determina se o conexao foi aberta..
   If m_cnDDM.State = adStateOpen then

    m_cnDDM.Close
   End If
  'Kill na referência para a conexao
   Set m_cnDDM = Nothing
  End If



  PopulateArrayFromDataSource = arrTemp
 End Function
 
 
 Private Function GetDropDownMenuSQL()
  Dim strTempSQL ' String
  Dim strOrderBySQL ' String
  
  If LenB(m_strOrderByField) > 0 Then

   strOrderBySQL = m_strOrderByField
  Else
   '...se não usar o campo de texto
      strOrderBySQL = m_strDataTextField
  End If


  ' SQL string
  strTempSQL = _
   "SELECT " & _
    m_strDataValueField & ", " & _
    m_strDataTextField & " " & _
   "FROM " & _
    m_strDataMember & " " & _
   "ORDER BY " & _
    strOrderBySQL  & " ASC"
  
  GetDropDownMenuSQL = strTempSQL
 End Function
 
End Class
%>

Usando

 

<%Option Explicit%>
<!--#Include File="classes/clsDropDownMe.asp" -->
<%



 Dim TitleDropDown 'As clsDropDownMeSet TitleDropDown = New clsDropDownMeWith TitleDropDown
  .ID = "cboTitle"
  .DataSource  = m_strConnMain
  .CssClass  = "DropDown"
  .DataMember  = "TITLE"
  .DataValueField = "intID"
  .DataTextField = "strDescription"
  .Multiple  = True
  .SelectedValue = 3
  .Size   = 5
  .OrderByField = .DataValueField
  .Enabled  = True
  .TabIndex  = 1
  .Script   = "onChange='dothis();'"
  
  .Bind()
 End With
 Set TitleDropDown = Nothing
%>