clsEPACurves.cls
5.83 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsEPACurves"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Private mvarID As Long
Private mvarDESCRICAO As String
Private mvarCOORDENADA_X As String
Private mvarCOORDENADA_Y As String
Private mvarTIPO As String
Dim a As String
Dim b As String
Dim c As String
Dim d As String
Dim e As String
Dim f As String
Dim g As String
Dim h As String
Dim i As String
Dim j As String
Dim k As String
Dim l As String
Public Property Let ID(ByVal vData As Long)
mvarID = vData
End Property
Public Property Get ID() As Long
ID = mvarID
End Property
Public Property Let DESCRICAO(ByVal vData As String)
mvarDESCRICAO = vData
End Property
Public Property Get DESCRICAO() As String
DESCRICAO = mvarDESCRICAO
End Property
Public Property Let COORDENADA_X(ByVal vData As String)
mvarCOORDENADA_X = vData
End Property
Public Property Get COORDENADA_X() As String
COORDENADA_X = mvarCOORDENADA_X
End Property
Public Property Let COORDENADA_Y(ByVal vData As String)
mvarCOORDENADA_Y = vData
End Property
Public Property Get COORDENADA_Y() As String
COORDENADA_Y = mvarCOORDENADA_Y
End Property
Public Property Let tipo(ByVal vData As String)
mvarTIPO = vData
End Property
Public Property Get tipo() As String
tipo = mvarTIPO
End Property
Public Function Inserir_Curva() As Boolean
Inserir_Curva = False
On Error GoTo InsereDado_err
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
' rs.Open "x_curves", Conn, adOpenKeyset, adLockOptimistic, adCmdTable
rs.Open "x_curves", Conn, adOpenDynamic, adLockOptimistic
rs.AddNew
rs.Fields("ID").value = ID
rs.Fields("DESCRICAO").value = IIf(DESCRICAO = "", Null, DESCRICAO)
rs.Fields("COORDENADA_X").value = IIf(COORDENADA_X = "", Null, COORDENADA_X)
rs.Fields("COORDENADA_Y").value = IIf(COORDENADA_Y = "", Null, COORDENADA_Y)
rs.Fields("TIPO").value = IIf(tipo = "", Null, tipo)
rs.Update
Inserir_Curva = True
rs.Close
Set rs = Nothing
Exit Function
InsereDado_err:
If Err.Number <> 0 Then
MsgBox "Número da curva já existe", vbExclamation
End If
End Function
'/// Atualiza a Curva selecionada da instancia para o Banco
'/// ou do banco para instancia.
'/// Por Padrão atualiza/carrega a instancia com o id
'/// fornecido.
Public Function Atualizar_Curva(Curva_id As Long, Optional Banco As Boolean = False) As Boolean
Atualizar_Curva = False
On Error GoTo Atualizar_Curva_err
Dim rs As New ADODB.Recordset
If frmCanvas.TipoConexao <> 4 Then
' rs.Open "SELECT * from x_curves where id = " & Curva_id, Conn, adOpenKeyset, adLockOptimistic
rs.Open "SELECT * from x_curves where id = " & Curva_id, Conn, adOpenDynamic, adLockOptimistic
Else
a = "x_curves"
b = "id"
rs.Open "SELECT * from " + """" + a + """" + " where " + """" + b + """" + " = '" & Curva_id & "'", Conn, adOpenDynamic, adLockOptimistic
End If
If rs.EOF Then
MsgBox "Número da curva não cadastrada", vbExclamation
Else
If Banco Then
rs.Fields("DESCRICAO").value = IIf(DESCRICAO = "", Null, DESCRICAO)
rs.Fields("COORDENADA_X").value = IIf(COORDENADA_X = "", Null, COORDENADA_X)
rs.Fields("COORDENADA_Y").value = IIf(COORDENADA_Y = "", Null, COORDENADA_Y)
rs.Fields("TIPO").value = IIf(tipo = "", Null, tipo)
rs.Update
Else
ID = rs.Fields("id").value
DESCRICAO = rs.Fields("DESCRICAO").value
COORDENADA_X = rs.Fields("COORDENADA_X").value
COORDENADA_Y = rs.Fields("COORDENADA_Y").value
tipo = rs.Fields("TIPO").value
End If
Atualizar_Curva = True
End If
rs.Close
Set rs = Nothing
Exit Function
Atualizar_Curva_err:
If Err.Number <> 0 Then
MsgBox "Número da curva já existe", vbExclamation
End If
End Function
'/// Retorna um cursor com todas as curvas cadastradas
Public Function Retorna_Curvas(rsCurvas As ADODB.Recordset) As Boolean
Retorna_Curvas = False
On Error GoTo Retorna_Curvas_err
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
a = "X_CURVES"
b = "ID"
If frmCanvas.TipoConexao <> 4 Then
rs.Open "SELECT * from x_curves order by id", Conn
Else
rs.Open "SELECT * from " + """" + a + """" + " order by " + """" + b + """", Conn, adOpenDynamic, adLockOptimistic
End If
If rs.EOF Then
rs.Close
Else
Set rsCurvas = rs
Retorna_Curvas = True
End If
Set rs = Nothing
Exit Function
Retorna_Curvas_err:
If Err.Number <> 0 Then
MsgBox Err.Description & vbCrLf & "Classe:Curvas - Método: Retorna_Curvas", vbExclamation
End If
End Function
'/// Exclui um curva existente no database
Public Function Excluir_Curva(Curva_id As Long) As Boolean
Excluir_Curva = False
On Error GoTo Delete_Curva_err
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
a = "x_CURVES"
b = "ID"
If frmCanvas.TipoConexao <> 4 Then
rs.Open "SELECT * from x_curves where id = " & Curva_id, Conn, adOpenKeyset, adLockOptimistic
Else
rs.Open "SELECT * from " + """" + a + """" + " where " + """" + b + """" + " = '" & Curva_id & "'", Conn, adOpenDynamic, adLockOptimistic
End If
If rs.EOF Then
MsgBox "Número da curva não cadastrada", vbExclamation
Else
rs.Delete
rs.Update
rs.Close
Excluir_Curva = True
End If
Set rs = Nothing
Exit Function
Delete_Curva_err:
If Err.Number <> 0 Then
MsgBox "Número da curva não encontrado", vbExclamation
End If
End Function