frmcmdlookuptableproperties.frm

Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式

VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form frmCMDLookupTableProperties 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Form1"
   ClientHeight    =   3672
   ClientLeft      =   48
   ClientTop       =   288
   ClientWidth     =   5124
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3672
   ScaleWidth      =   5124
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton btnCancel 
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   3120
      TabIndex        =   2
      Top             =   3180
      Width           =   855
   End
   Begin MSDBGrid.DBGrid DBGrid1 
      Height          =   2895
      Left            =   120
      OleObjectBlob   =   "frmCMDLookupTableProperties.frx":0000
      TabIndex        =   1
      Top             =   120
      Width           =   4875
   End
   Begin VB.CommandButton btnOk 
      Caption         =   "&Ok"
      Default         =   -1  'True
      Height          =   375
      Left            =   4140
      TabIndex        =   0
      Top             =   3180
      Width           =   855
   End
End
Attribute VB_Name = "frmCMDLookupTableProperties"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' DataMonkey Data Conversion Application. Written by Theodore L. Ward
' Copyright (C) 2002 AstroComma Incorporated.
'
' This program is free software; you can redistribute it and/or
' modify it under the terms of the GNU General Public License
' as published by the Free Software Foundation; either version 2
' of the License, or (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
' The author may be contacted at:
' [e-mail] or [e-mail]

Option Explicit

Private obj As CCmdLookup
Private mDoingUpdate As Boolean

Public Sub Initialize(parent As CCmdLookup, NameForCaption As String)
    Set obj = parent
    Me.Caption = NameForCaption
End Sub

Private Function GetNewBookmark() As Variant
    GetNewBookmark = str(obj.GetNumElements)
End Function

Private Sub btnCancel_Click()
    Unload Me
End Sub

Private Sub btnOk_Click()
    GFormReturnValue = vbOK
    Unload Me
End Sub

Private Sub DBGrid1_UnboundAddData(ByVal RowBuf As MSDBGrid.RowBuffer, NewRowBookmark As Variant)
    
    ' Assume that a Visual Basic for Applications function
    ' StoreUserData(bookm, col, value)
    ' takes a row bookmark, a column index, and a variant with the
    ' appropriate data to be stored in an array or database.  The
    ' StoreUserData()function returns True if the data is
    ' acceptable and can be stored,False otherwise.

    ' First, get a bookmark for the new row. Do this with a Visual Basic
    ' for Applications  function GetNewBookmark(), which allocates a new
    ' row of data in the storage media (array or database), and
    ' returns a variant containing a bookmark for that added row.
    NewRowBookmark = GetNewBookmark()

    ' Loop over all the columns of the row, storing non-Null
    ' values
    Dim newVal As Variant, i As Integer
    For i% = 0 To RowBuf.ColumnCount - 1
        newVal = RowBuf.value(0, i%)
        If IsNull(newVal) Then
            ' the RowBuf does not contain a value for this column.
            ' A default value should be set.  A convenient value
            ' is the default value for the column.
            newVal = DBGrid1.Columns(i%).DefaultValue
        End If

        ' Now store the new values.
        If Not StoreUserData(NewRowBookmark, i%, newVal) Then
            ' storage of the data has failed.  Delete the added
            ' row using a Visual Basic for Applications function DeleteRow,
            ' which takes a bookmark as an argument. Also, fail the update
            ' by clearing the RowCount.
            DeleteRow NewRowBookmark
            RowBuf.RowCount = 0 ' tell the grid the update failed
            Exit Sub            ' it failed, so exit the event
        End If
    Next i
End Sub

Private Sub DBGrid1_UnboundReadData(ByVal RowBuf As MSDBGrid.RowBuffer, StartLocation As Variant, ByVal ReadPriorRows As Boolean)

    Dim bookm As Variant, i As Integer, j As Integer
    bookm = StartLocation

    Dim relpos As Integer
    If ReadPriorRows Then
        ' the grid is requesting data in rows prior to
     ' StartLocation
        relpos = -1
    Else
        ' the grid is requesting data in rows after to
     ' StartLocation
        relpos = 1
    End If

    Dim rowsFetched As Integer
    rowsFetched = 0

    For i% = 0 To RowBuf.RowCount - 1
        ' Get the bookmark of the next available row
        bookm = GetRelativeBookmark(bookm, relpos)

        ' If the next is BOF or EOF, then done
        If IsNull(bookm) Then Exit For

        For j% = 0 To RowBuf.ColumnCount - 1
            RowBuf.value(i%, j%) = GetUserData(bookm, j%)
        Next j%

        ' Set the bookmark for the row
        RowBuf.Bookmark(i%) = bookm

        ' Increment the count of fetched rows
        rowsFetched = rowsFetched + 1
    Next i%

    ' tell the grid how many rows were fetched
    RowBuf.RowCount = rowsFetched

End Sub

Private Function GetRelativeBookmark(bookm As Variant, relpos As Integer) As Variant

    Dim index As Long
    index = IndexFromBookmark(bookm, False) + relpos
    If index < 0 Or index >= obj.GetNumElements Then
        GetRelativeBookmark = Null
    Else
        GetRelativeBookmark = str(index)
    End If

End Function

Private Function GetUserData(bookm As Variant, colm As Integer) As Variant
    Dim index As Integer
    GetUserData = Null
    index = IndexFromBookmark(bookm, False)
    GetUserData = obj.GetElement(colm, index)
End Function

Private Function IndexFromBookmark(bookm As Variant, ReadPriorRows As Boolean) As Long

    If IsNull(bookm) Then
        If ReadPriorRows Then
            IndexFromBookmark = obj.GetNumElements
        Else
            IndexFromBookmark = -1
        End If
    Else
        Dim index As Long
        index = val(bookm)
        If index < 0 Or index > obj.GetNumElements Then index = -2000
        IndexFromBookmark = index
    End If

End Function

Private Sub DBGrid1_UnboundDeleteRow(Bookmark As Variant)

    If Not DeleteRow(Bookmark) Then Bookmark = Null

End Sub

Private Function DeleteRow(bookm As Variant) As Boolean

    DeleteRow = obj.DeleteRow(IndexFromBookmark(bookm, False))

End Function

Private Function StoreUserData(bookm As Variant, colm As Integer, userval As Variant) As Boolean

   Dim index As Integer
    index = IndexFromBookmark(bookm, False)
    StoreUserData = obj.SetElement(colm, index, userval)

End Function

Private Sub DBGrid1_UnboundWriteData(ByVal RowBuf As MSDBGrid.RowBuffer, WriteLocation As Variant)
    ' Assume that a Visual Basic for Applications function
    ' StoreUserData(bookm, col, value)
    ' takes a row bookmark, a column index, and a variant with the
    ' appropriate data to be stored in an array or database.  The
    ' returns True if the data is acceptable and can be stored,
    ' False otherwise.
    Dim i As Integer

    ' Loop over all the columns of the row, storing non-Null
    ' values
    For i% = 0 To RowBuf.ColumnCount - 1
        If Not IsNull(RowBuf.value(0, i%)) Then
            If Not StoreUserData(WriteLocation, i%, RowBuf.value(0, i%)) Then
                ' storage of the data has failed.  Fail the update
                RowBuf.RowCount = 0 ' tell the grid the update failed
                Exit Sub            ' it failed, so exit the event
            End If
        End If
    Next i%
End Sub

Private Sub Form_Load()
    GFormReturnValue = vbCancel
End Sub