I have problem on OCX Binding object, could you fixed them?
my problem are: when i implement my code in microsoft datagrid, this code is run smoothly, but if i run this code in sheridan datagrid, this code is run not like than i desire.
could you see the bugs of this code?.
thanks for your help:
Code:
'Default Property Values:
Const m_def_ConnectionString = ""
Const m_def_SourceString = ""
'Const m_def_Rst = Nothing
Const m_def_DrawBorder = True
'Property Variables:
Dim m_Rst As New ADODB.Recordset
Dim m_ConnectionString As String
Dim m_SourceString As String
Dim m_DrawBorder As Boolean
'Event Declarations:
Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown
Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
Event FirstClick()
Event PrevClick()
Event NextClick()
Event LastClick()
Private Sub oMCM_Nav_Click(Index As Integer)
Select Case Index
Case 1
If m_Rst.AbsolutePosition <> 1 Then
m_Rst.MoveFirst
PropertyChanged "Rst"
RaiseEvent FirstClick
End If
Case 2
If m_Rst.AbsolutePosition <> 1 And Not m_Rst.BOF Then
m_Rst.MovePrevious
PropertyChanged "Rst"
RaiseEvent PrevClick
End If
Case 3
If Not m_Rst.EOF And m_Rst.AbsolutePosition <> m_Rst.RecordCount Then
m_Rst.MoveNext
PropertyChanged "Rst"
RaiseEvent NextClick
End If
Case 4
If m_Rst.AbsolutePosition <> m_Rst.RecordCount Then
m_Rst.MoveLast
PropertyChanged "Rst"
RaiseEvent LastClick
End If
End Select
End Sub
Private Sub UserControl_GetDataMember(DataMember As String, Data As Object)
On Error Resume Next
If Trim(m_ConnectionString) <> "" And Trim(m_SourceString) <> "" Then
If m_Rst.State <> 0 Then m_Rst.Close
m_Rst.Open m_SourceString, m_ConnectionString, adOpenKeyset, adLockBatchOptimistic
PropertyChanged "Rst"
Set Data = Rst
End If
End Sub
Private Sub UserControl_Resize()
Dim i As Integer, j As Integer, k As Integer
With Line1(0)
.X1 = 0: .X2 = UserControl.Width
.Y1 = 0: .Y2 = 0
End With
With Line1(1)
.X1 = 10: .X2 = UserControl.Width - 10
.Y1 = 10: .Y2 = 10
End With
With Line2(0)
.X1 = UserControl.Width - 10: .X2 = UserControl.Width - 10
.Y1 = 0: .Y2 = UserControl.Height - 5
End With
With Line2(1)
.X1 = UserControl.Width - 30: .X2 = UserControl.Width - 30
.Y1 = 10: .Y2 = UserControl.Height - 15
End With
With Line3(0)
.X1 = 0: .X2 = UserControl.Width
.Y1 = UserControl.Height - 10: .Y2 = UserControl.Height - 10
End With
With Line3(1)
.X1 = 10: .X2 = UserControl.Width - 15
.Y1 = UserControl.Height - 30: .Y2 = UserControl.Height - 30
End With
With Line4(0)
.X1 = 0: .X2 = 0
.Y1 = 10: .Y2 = UserControl.Height - 5
End With
With Line4(1)
.X1 = 10: .X2 = 10
.Y1 = 10: .Y2 = UserControl.Height - 15
End With
j = (Line2(1).X1 - Line4(1).X1)
k = (Line3(1).Y1 - Line1(1).Y1)
If j >= k Then
j = CInt(j / 5)
oMCM_Nav(1).Left = Line4(1).X1 + CInt(Abs(j / 5))
oMCM_Nav(1).Width = j
oMCM_Nav(1).Top = Line1(1).Y1 + k / 12
oMCM_Nav(1).Height = Abs(k * 5 / 6)
For i = 2 To 4
oMCM_Nav(i).Width = oMCM_Nav(1).Width
oMCM_Nav(i).Left = oMCM_Nav(i - 1).Left + oMCM_Nav(i - 1).Width + CInt(j / 5)
oMCM_Nav(i).Top = oMCM_Nav(1).Top
oMCM_Nav(i).Height = oMCM_Nav(1).Height
Next
Else
k = CInt(k / 5)
oMCM_Nav(1).Left = Line4(1).X1 + CInt(Abs(j / 12))
oMCM_Nav(1).Width = Abs(j * 5 / 6)
oMCM_Nav(1).Top = Line1(1).Y1 + CInt(k / 5)
oMCM_Nav(1).Height = k
For i = 2 To 4
oMCM_Nav(i).Width = oMCM_Nav(1).Width
oMCM_Nav(i).Left = oMCM_Nav(1).Left
oMCM_Nav(i).Top = oMCM_Nav(i - 1).Top + oMCM_Nav(i - 1).Height + CInt(k / 5)
oMCM_Nav(i).Height = oMCM_Nav(1).Height
Next
End If
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=5
Public Sub Refresh()
End Sub
Private Sub UserControl_Click()
RaiseEvent Click
End Sub
Private Sub UserControl_DblClick()
RaiseEvent DblClick
End Sub
Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub UserControl_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Font
Public Property Get Font() As Font
Set Font = UserControl.Font
End Property
Public Property Set Font(ByVal New_Font As Font)
Set UserControl.Font = New_Font
PropertyChanged "Font"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,true
Public Property Get DrawBorder() As Boolean
DrawBorder = m_DrawBorder
End Property
Public Property Let DrawBorder(ByVal New_DrawBorder As Boolean)
m_DrawBorder = New_DrawBorder
PropertyChanged "DrawBorder"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=14
Public Sub onTopRec()
oMCM_Nav(1).Enabled = False
oMCM_Nav(2).Enabled = False
oMCM_Nav(3).Enabled = True
oMCM_Nav(4).Enabled = True
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=14
Public Sub onBottomRec()
oMCM_Nav(1).Enabled = True
oMCM_Nav(2).Enabled = True
oMCM_Nav(3).Enabled = False
oMCM_Nav(4).Enabled = False
End Sub
Public Sub onNormal()
oMCM_Nav(1).Enabled = True
oMCM_Nav(2).Enabled = True
oMCM_Nav(3).Enabled = True
oMCM_Nav(4).Enabled = True
End Sub
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
Set UserControl.Font = Ambient.Font
m_DrawBorder = m_def_DrawBorder
m_ConnectionString = m_def_ConnectionString
m_SourceString = m_def_SourceString
'm_Rst = m_def_Rst
End Sub
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
m_DrawBorder = PropBag.ReadProperty("DrawBorder", m_def_DrawBorder)
m_ConnectionString = PropBag.ReadProperty("ConnectionString", m_def_ConnectionString)
m_SourceString = PropBag.ReadProperty("SourceString", m_def_SourceString)
Set m_Rst = PropBag.ReadProperty("Rst", Nothing)
End Sub
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
Call PropBag.WriteProperty("DrawBorder", m_DrawBorder, m_def_DrawBorder)
Call PropBag.WriteProperty("ConnectionString", m_ConnectionString, m_def_ConnectionString)
Call PropBag.WriteProperty("SourceString", m_SourceString, m_def_SourceString)
'Call PropBag.WriteProperty("Rst", m_Rst, Nothing)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get ConnectionString() As String
ConnectionString = m_ConnectionString
End Property
Public Property Let ConnectionString(ByVal New_ConnectionString As String)
On Error Resume Next
m_ConnectionString = New_ConnectionString
If m_SourceString <> "" Then
If m_Rst.State <> 0 Then m_Rst.Close
m_Rst.Open , m_ConnectionString, adOpenKeyset, adLockBatchOptimistic
PropertyChanged "Rst"
End If
PropertyChanged "ConnectionString"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get SourceString() As String
SourceString = m_SourceString
End Property
Public Property Let SourceString(ByVal New_SourceString As String)
On Error Resume Next
m_SourceString = New_SourceString
m_Rst.Source = m_SourceString
If Trim(m_ConnectionString) <> "" Then
If m_Rst.State <> 0 Then m_Rst.Close
m_Rst.Open , m_ConnectionString, adOpenKeyset, adLockBatchOptimistic
PropertyChanged "Rst"
End If
PropertyChanged "SourceString"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=9,0,0,0
Public Property Get Rst() As ADODB.Recordset
Set Rst = m_Rst
End Property
Public Property Set Rst(ByVal New_Rst As ADODB.Recordset)
Set m_Rst = New_Rst
PropertyChanged "Rst"
End Property
OCX Binding Problem
Reply With Quote