frmlongtrans.frm

都是基于VB所做的程序集合,值得大家作为实践的参考资料.

VERSION 5.00
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.2#0"; "SuperMap.ocx"
Begin VB.Form frmLongTrans 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "SQL Server长事务测试"
   ClientHeight    =   5865
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8445
   Icon            =   "frmLongTrans.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5865
   ScaleWidth      =   8445
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin SuperMapLib.SuperMap SuperMap1 
      Height          =   4785
      Left            =   1770
      TabIndex        =   4
      Top             =   1035
      Width           =   6570
      _Version        =   327682
      _ExtentX        =   11589
      _ExtentY        =   8440
      _StockProps     =   160
      Appearance      =   1
   End
   Begin VB.CommandButton cmdLogOut 
      Caption         =   "退出长事务"
      Height          =   480
      Left            =   2745
      TabIndex        =   14
      Top             =   15
      Width           =   1155
   End
   Begin VB.CommandButton cmdSelect 
      Caption         =   "选择"
      Height          =   480
      Left            =   1800
      TabIndex        =   13
      Top             =   495
      Width           =   945
   End
   Begin VB.CommandButton cmdCheckIn 
      Caption         =   "提交数据集修改"
      Height          =   480
      Left            =   5355
      TabIndex        =   12
      Top             =   15
      Width           =   1575
   End
   Begin VB.CommandButton cmdCheckOut 
      Caption         =   "锁定数据集"
      Height          =   480
      Left            =   3900
      TabIndex        =   11
      Top             =   15
      Width           =   1455
   End
   Begin VB.CommandButton cmdUndoRecordset 
      Caption         =   "记录集回滚"
      Height          =   480
      Left            =   6930
      TabIndex        =   10
      Top             =   495
      Width           =   1455
   End
   Begin VB.CommandButton cmdChkinRecordset 
      Caption         =   "提交记录集修改"
      Height          =   480
      Left            =   5355
      TabIndex        =   9
      Top             =   495
      Width           =   1575
   End
   Begin VB.CommandButton cmdChkRecordset 
      Caption         =   "锁定记录集"
      Height          =   480
      Left            =   3900
      TabIndex        =   8
      Top             =   495
      Width           =   1455
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "增加对象"
      Height          =   480
      Left            =   2745
      TabIndex        =   7
      Top             =   495
      Width           =   1155
   End
   Begin VB.CommandButton cmdLogin 
      Caption         =   "登录"
      Height          =   480
      Left            =   1800
      TabIndex        =   6
      Top             =   15
      Width           =   945
   End
   Begin VB.CommandButton cmdUndo 
      Caption         =   "数据集回滚"
      Height          =   480
      Left            =   6930
      TabIndex        =   5
      Top             =   15
      Width           =   1455
   End
   Begin SuperMapLib.SuperWorkspace SuperWorkspace1 
      Left            =   2940
      Top             =   2220
      _Version        =   327682
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin VB.CheckBox chkEditable 
      Caption         =   "可编辑"
      Height          =   255
      Left            =   75
      TabIndex        =   3
      Top             =   765
      Width           =   1035
   End
   Begin VB.CommandButton cmdOpenDs 
      Caption         =   "打开数据源"
      Height          =   480
      Left            =   15
      TabIndex        =   2
      Top             =   15
      Width           =   1725
   End
   Begin VB.CheckBox chkAutoCheck 
      Caption         =   "自动锁定"
      Height          =   255
      Left            =   75
      TabIndex        =   1
      Top             =   525
      Width           =   1455
   End
   Begin VB.ListBox lstDatasets 
      Height          =   4740
      Left            =   30
      TabIndex        =   0
      Top             =   1050
      Width           =   1695
   End
End
Attribute VB_Name = "frmLongTrans"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=====================================SuperMap Objects示范工程说明=======================================
'
'功能简介：示范在SuperMap Objects的长事务使用
'所用控件：SuperMap 控件、SuperWorkspace 控件
'所用数据：由用户自己打开合法的数据源和工作空间
'操作说明：
'         点击"打开数据源"按钮，打开一个合法的数据源
'         "登录"按钮提供登录到长事务环境
'         "退出长事务"按钮提供退出长事务环境
'         "锁定数据集"和"锁定记录集"按钮分别提供对数据集或记录集的锁定
'         "提交数据记修改"和"提交记录集修改"按钮分别提供对数据集或记录集修改的提交
'         "数据集回滚"和"记录集回滚"按钮分别提供回滚对数据集或记录集的修改，也就是不提交修改
'
'===================================SuperMap Objects示范工程说明结束=====================================

Option Explicit
Dim objRecordset As soRecordset

Private Sub chkAutoCheck_Click() '自动锁定
    objLT.AutoCheckOut = chkAutoCheck
    If (objLT.AutoCheckOut) Then
        chkEditable.Enabled = True
        If (chkEditable) Then
            cmdAdd.Enabled = True
        End If
    Else
        If (cmdCheckOut.Enabled = False Or cmdChkRecordset.Enabled = False) Then
            If (chkEditable) Then
                cmdAdd.Enabled = True
            End If
            chkEditable.Enabled = True
        Else
            cmdAdd.Enabled = False
            chkEditable.Enabled = False
        End If
    End If
End Sub

Private Sub chkEditable_Click() '指定可编辑图层
    If (chkEditable) Then
        SuperMap1.Layers.SetEditableLayer 1
        cmdAdd.Enabled = True
    Else
        SuperMap1.Layers.DisableEdit
        cmdAdd.Enabled = False
    End If
End Sub

Private Sub cmdAdd_Click() '对数据集进行编辑
    SuperMap1.Layers.SetEditableLayer 1
    If (SuperMap1.Layers.GetEditableLayer.Dataset.Type = scdRegion) Then
        SuperMap1.Action = scaEditCreateRectangle
    ElseIf (SuperMap1.Layers.GetEditableLayer.Dataset.Type = scdLine) Then
        SuperMap1.Action = scaEditCreateLinesect
    ElseIf (SuperMap1.Layers.GetEditableLayer.Dataset.Type = scdPoint) Then
        SuperMap1.Action = scaEditCreatePoint
    End If
End Sub

Private Sub cmdCheckIn_Click() '提交对数据集所进行的修改
    objLT.CheckInDataset objDataset, False
    SuperMap1.Layers.DisableEdit
    chkEditable = False
    SuperMap1.Refresh
    cmdCheckOut.Enabled = True
    cmdCheckIn.Enabled = False
    cmdUndo.Enabled = False
    If (Not objLT.AutoCheckOut) Then
        chkEditable.Enabled = False
        cmdAdd.Enabled = False
    End If
End Sub

Private Sub cmdCheckOut_Click() '锁定指定的数据集（表、图层）
    objLT.CheckOutDataset objDataset
    cmdCheckOut.Enabled = False
    cmdCheckIn.Enabled = True
    cmdUndo.Enabled = True
    chkEditable.Enabled = True
    If (chkEditable = True) Then
        cmdAdd.Enabled = True
    End If
End Sub

Private Sub cmdChkinRecordset_Click() '提交对记录集所进行的修改
   
    Dim i As Integer

    If objRecordset Is Nothing Then
        Exit Sub
    End If
    
    objLT.CheckInRecordset objRecordset, False, False
    SuperMap1.Layers.DisableEdit
    chkEditable = False
    SuperMap1.Refresh
    cmdChkRecordset.Enabled = True
    cmdChkinRecordset.Enabled = False
    cmdUndoRecordset.Enabled = False
    
    If (Not objLT.AutoCheckOut) Then
        chkEditable.Enabled = False
        cmdAdd.Enabled = False
    End If

End Sub

Private Sub cmdChkRecordset_Click() '锁定记录集（可以是图层中某一区域）
    
    
    Set objRecordset = SuperMap1.selection.ToRecordset(False)
    If objRecordset Is Nothing Then
        MsgBox "请先选择几个对象"
        Exit Sub
    End If
    
    objLT.CheckOutRecordset objRecordset, False
    cmdChkRecordset.Enabled = False
    cmdChkinRecordset.Enabled = True
    cmdUndoRecordset.Enabled = True
    chkEditable.Enabled = True
    
    If (chkEditable) Then
        cmdAdd.Enabled = True
    End If
End Sub

Private Sub cmdSelect_Click()
    SuperMap1.Action = scaSelect
End Sub

Private Sub cmdLogin_Click() '登录长事务环境
    Set objLT = objDatasource.LongTransaction
    objLT.AutoCheckOut = False
    Load frmLogIn  '显示登陆密码框
    frmLogIn.Visible = True
    
    frmLogIn.Show
    frmLogIn.ZOrder
    
End Sub

Private Sub cmdLogOut_Click() '退出长事务环境
    objLT.LogOut
    cmdLogOut.Enabled = False
    cmdLogin.Enabled = True
    chkAutoCheck.Enabled = False
    cmdCheckIn.Enabled = False
    cmdUndo.Enabled = False
    cmdCheckOut.Enabled = False
    cmdChkRecordset.Enabled = False
    cmdChkinRecordset.Enabled = False
    cmdUndoRecordset.Enabled = False
    
End Sub

Private Sub cmdOpenDs_Click() '打开数据源
    SuperMap1.Connect SuperWorkspace1.Handle
    Load frmOpen
    frmOpen.Visible = True
    frmOpen.Show
    frmOpen.ZOrder
End Sub

Private Sub cmdUndo_Click() '回滚对数据集所进行的修改
    objLT.UndoCheckOutDataset objDataset, False
    SuperMap1.Layers.DisableEdit
    chkEditable = False
    SuperMap1.Refresh
    cmdCheckOut.Enabled = True
    cmdCheckIn.Enabled = False
    cmdUndo.Enabled = False
    
    If (Not objLT.AutoCheckOut) Then
        chkEditable.Enabled = False
        cmdAdd.Enabled = False
    End If

End Sub

Private Sub cmdUndoRecordset_Click() '回滚对记录集所进行的修改
    
    Dim i As Integer
    If objRecordset Is Nothing Then
        Exit Sub
    End If
    
    objLT.UndoCheckOutRecordset objRecordset, False, False
    SuperMap1.Layers.DisableEdit
    chkEditable = False
    SuperMap1.Refresh
    cmdChkRecordset.Enabled = True
    cmdChkinRecordset.Enabled = False
    cmdUndoRecordset.Enabled = False
    
    If (Not objLT.AutoCheckOut) Then
        chkEditable.Enabled = False
        cmdAdd.Enabled = False
    End If


End Sub

Private Sub Form_Load()

    cmdOpenDs.Enabled = True
    cmdLogin.Enabled = False
    cmdLogOut.Enabled = False
    chkAutoCheck.Enabled = False
    cmdCheckOut.Enabled = False
    cmdCheckIn.Enabled = False
    cmdUndo.Enabled = False
    cmdChkRecordset.Enabled = False
    cmdChkinRecordset.Enabled = False
    cmdUndoRecordset.Enabled = False
    chkEditable.Enabled = False
    cmdAdd.Enabled = False
    cmdSelect.Enabled = False
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If Not objDatasource Is Nothing Then
        If Not objLT Is Nothing Then
            objLT.LogOut
        End If
        
        Set objDatasource = Nothing
        Set objLT = Nothing
        Set objDataset = Nothing
        SuperMap1.Disconnect
        SuperMap1.Close
        SuperWorkspace1.Close
    End If
End Sub


Private Sub lstDatasets_DblClick() '指定图层在SuperMap窗口中显示
    SuperMap1.Layers.RemoveAll
    
    If (lstDatasets.ListIndex > 0) Then
        Set objDataset = objDatasource.Datasets(lstDatasets.ListIndex + 1)
        SuperMap1.Layers.AddDataset objDataset, True
        SuperMap1.ViewEntire
        SuperMap1.Action = scaSelect
        
        SuperMap1.Refresh
        cmdSelect.Enabled = True
        If (objLT Is Nothing) Then
            chkEditable.Enabled = True
            If (chkEditable) Then
                cmdAdd.Enabled = True
            End If
        Else
            If (objLT.Logged And Not objLT.AutoCheckOut) Then
                chkEditable = False
                chkEditable.Enabled = False
                cmdAdd.Enabled = False
                SuperMap1.Layers.DisableEdit
            Else
                chkEditable.Enabled = True
                If (chkEditable) Then
                    cmdAdd.Enabled = True
                End If
            End If
        End If
    End If
End Sub