VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CLShape"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Dim InsShp As String
Dim CpRel As String
'Public Rshape As New Recordset
'Function OpenShape(cn As Connection, TipoTrava As LockTypeEnum) As Boolean
'On Error Resume Next
'If Rshape.State = 1 Then Rshape.Close
'Rshape.Open InsShp, cn, adOpenStatic, TipoTrava
'End Function


Public Sub SetCtrls(Rs_ As Object, ParamArray Ctls())
Dim i As Integer
Dim nomechap As String
Dim rs As Recordset
If TypeName(Rs_) = "Recordset" Then
  Set rs = Rs_
Else
  Set rs = Rs_.RecordsetT
End If

For i = 0 To UBound(Ctls)
  If TypeName(Ctls(i)) = "String" Then
    nomechap = Ctls(i)
  Else
    Select Case TypeName(Ctls(i))
    Case "DataGrid", "TextBox", "Label", "OptionButton", "CheckBox"
        If nomechap = "" Then Set Ctls(i).DataSource = rs Else Set Ctls(i).DataSource = rs.Fields(nomechap).value
    Case "DataList", "DataCombo", "MSHFlexGrid"
        If nomechap = "" Then Set Ctls(i).RowSource = rs Else Set Ctls(i).RowSource = rs.Fields(nomechap).value
    End Select
  End If
Next

End Sub




'Public Sub SetControls(ParamArray Ctrls_Cursor())
'For i = 0 To UBound(Ctrls_Cursor) Step 2
'  Select Case TypeName(Ctrls_Cursor(i))
'  Case "DataGrid"
'
'  Case "TextBox", "Label"
'
'  End Select
'Next
'End Sub

Property Get GetIns() As String
 GetIns = InsShp
End Property

Sub Add(ByVal ins As String _
, Optional ByVal relate As String _
, Optional Alias As String _
, Optional Compute As String)
Dim InsShape As String
Dim InsShapeC As String
Dim relatet As Variant

Dim i As Integer
Dim t As Integer
relatet = Split(relate, ",")
If Not LCase(ins) Like "*select*" Then
  ins = " Select * from " & ins
End If
If InsShp <> "" Then
  If UBound(relatet) < 1 And CpRel = "" Then
    MsgBox " campos de relação não estão corretamente preenchidos", vbCritical, "Erro"
    Exit Sub
  Else
    If UBound(relatet) < 1 Then
      relatet = Array(CpRel, relate)
    End If
    
    If Not LCase(InsShp) Like "*append*" Then
      InsShape = " APPEND  "
    Else
      InsShape = ","
    End If
    InsShape = InsShape & " ( {" & ins & "} RELATE "
    InsShape = InsShape & relatet(0) & " TO " & relatet(1) & ")"
    If Alias <> "" Then
      InsShape = InsShape & " AS  " & Alias
    End If
    If Compute <> "" Then
      If Alias = "" Then
        MsgBox "Alias não preenchido", vbCritical, "Erro"
      Else
        Alias = Replace(Alias, " ", "")
        InsShapeC = InsShapeC & ",  (( shape  {" & ins & "} as Agr" & Alias
        InsShapeC = InsShapeC & "  compute Agr" & Alias & ", "
        Compute = Replace(Compute, "(", "(Agr" & Alias & ".")
        InsShapeC = InsShapeC & Compute & " by " & relatet(1) & ")"
        
        InsShapeC = InsShapeC & " RELATE "
        InsShapeC = InsShapeC & relatet(0) & " TO " & relatet(1) & ") as Agr" & Alias
        
      End If
    End If
      

  End If
Else
  InsShape = "Shape   {" & ins & "}"
  CpRel = relate
End If
InsShp = InsShp & InsShape & InsShapeC
End Sub


Sub Clear()
InsShp = ""
End Sub